Home

Context Navigation

source: palm/trunk/SOURCE/ls_forcing_mod.f90 @ 2001

Last change on this file since 2001 was 2001, checked in by knoop, 8 years ago
last commit documented
Property svn:keywords set to `Id`
File size: 21.9 KB

Rev	Line
[1850]	1	!> @file ls_forcing_mod.f90
[2000]	2	!------------------------------------------------------------------------------!
[1239]	3	! This file is part of PALM.
	4	!
[2000]	5	! PALM is free software: you can redistribute it and/or modify it under the
	6	! terms of the GNU General Public License as published by the Free Software
	7	! Foundation, either version 3 of the License, or (at your option) any later
	8	! version.
[1239]	9	!
	10	! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
	11	! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
	12	! A PARTICULAR PURPOSE. See the GNU General Public License for more details.
	13	!
	14	! You should have received a copy of the GNU General Public License along with
	15	! PALM. If not, see <http://www.gnu.org/licenses/>.
	16	!
[1818]	17	! Copyright 1997-2016 Leibniz Universitaet Hannover
[2000]	18	!------------------------------------------------------------------------------!
[1239]	19	!
	20	! Current revisions:
	21	! ------------------
[1383]	22	!
[2001]	23	!
[1383]	24	! Former revisions:
	25	! -----------------
	26	! $Id: ls_forcing_mod.f90 2001 2016-08-20 18:41:22Z knoop $
	27	!
[2001]	28	! 2000 2016-08-20 18:09:15Z knoop
	29	! Forced header and separation lines into 80 columns
	30	!
[1851]	31	! 1850 2016-04-08 13:29:27Z maronga
	32	! Module renamed
	33	!
	34	!
[1683]	35	! 1682 2015-10-07 23:56:08Z knoop
	36	! Code annotations made doxygen readable
	37	!
[1603]	38	! 1602 2015-06-22 07:50:56Z heinze
	39	! PA0370 changed to PA0363
	40	!
[1383]	41	! 1382 2014-04-30 12:15:41Z boeske
[1382]	42	! Renamed variables which store large scale forcing tendencies
	43	! pt_lsa -> td_lsa_lpt, pt_subs -> td_sub_lpt,
	44	! q_lsa -> td_lsa_q, q_subs -> td_sub_q,
	45	! high\|lowpt_lsa -> high\|low_td_lsa_lpt, ...
[1366]	46	!
	47	! 1365 2014-04-22 15:03:56Z boeske
[1365]	48	! Usage of large scale forcing for pt and q enabled:
	49	! Added new subroutine ls_advec for horizontal large scale advection and large
	50	! scale subsidence,
	51	! error message in init_ls_forcing specified,
	52	! variable t renamed nt
[1354]	53	!
	54	! 1353 2014-04-08 15:21:23Z heinze
	55	! REAL constants provided with KIND-attribute
	56	!
[1321]	57	! 1320 2014-03-20 08:40:49Z raasch
[1320]	58	! ONLY-attribute added to USE-statements,
	59	! kind-parameters added to all INTEGER and REAL declaration statements,
	60	! kinds are defined in new module kinds,
	61	! comment fields (!:) to be used for variable explanations added to
	62	! all variable declaration statements
[1239]	63	!
[1319]	64	! 1318 2014-03-17 13:35:16Z raasch
	65	! module interfaces removed
	66	!
[1300]	67	! 1299 2014-03-06 13:15:21Z heinze
	68	! Ensure a zero large scale vertical velocity at the surface
	69	! Bugfix: typo in case of boundary condition in if-clause
	70	!
[1277]	71	! 1276 2014-01-15 13:40:41Z heinze
	72	! Use LSF_DATA also in case of Dirichlet bottom boundary condition for scalars
	73	!
[1250]	74	! 1249 2013-11-06 10:45:47Z heinze
	75	! remove call of user module
	76	! reformatting
	77	!
[1242]	78	! 1241 2013-10-30 11:36:58Z heinze
	79	! Initial revision
[1239]	80	!
	81	! Description:
	82	! ------------
[1682]	83	!> Calculates large scale forcings (geostrophic wind and subsidence velocity) as
	84	!> well as surfaces fluxes dependent on time given in an external file (LSF_DATA).
	85	!> Code is based in parts on DALES and UCLA-LES.
[1239]	86	!--------------------------------------------------------------------------------!
[1682]	87	MODULE ls_forcing_mod
	88
[1239]	89
	90	PRIVATE
[1365]	91	PUBLIC init_ls_forcing, ls_forcing_surf, ls_forcing_vert, ls_advec
[1239]	92	SAVE
	93
[1365]	94	INTERFACE ls_advec
	95	MODULE PROCEDURE ls_advec
	96	MODULE PROCEDURE ls_advec_ij
	97	END INTERFACE ls_advec
[1239]	98
	99	CONTAINS
	100
[1682]	101	!------------------------------------------------------------------------------!
	102	! Description:
	103	! ------------
	104	!> @todo Missing subroutine description.
	105	!------------------------------------------------------------------------------!
[1239]	106	SUBROUTINE init_ls_forcing
	107
[1320]	108	USE arrays_3d, &
[1382]	109	ONLY: p_surf, pt_surf, q_surf, qsws_surf, shf_surf, td_lsa_lpt, &
	110	td_lsa_q, td_sub_lpt, td_sub_q, time_surf, time_vert, &
	111	ug_vert, vg_vert, wsubs_vert, zu
[1239]	112
[1320]	113	USE control_parameters, &
	114	ONLY: end_time, lsf_surf, lsf_vert, message_string, nlsf
	115
	116	USE indices, &
[1365]	117	ONLY: ngp_sums_ls, nzb, nz, nzt
[1320]	118
	119	USE kinds
	120
[1365]	121	USE statistics, &
	122	ONLY: sums_ls_l
[1320]	123
[1365]	124
[1239]	125	IMPLICIT NONE
	126
[1682]	127	CHARACTER(100) :: chmess !<
	128	CHARACTER(1) :: hash !<
[1239]	129
[1682]	130	INTEGER(iwp) :: ierrn !<
	131	INTEGER(iwp) :: finput = 90 !<
	132	INTEGER(iwp) :: k !<
	133	INTEGER(iwp) :: nt !<
[1320]	134
[1682]	135	REAL(wp) :: fac !<
	136	REAL(wp) :: highheight !<
	137	REAL(wp) :: highug_vert !<
	138	REAL(wp) :: highvg_vert !<
	139	REAL(wp) :: highwsubs_vert !<
	140	REAL(wp) :: lowheight !<
	141	REAL(wp) :: lowug_vert !<
	142	REAL(wp) :: lowvg_vert !<
	143	REAL(wp) :: lowwsubs_vert !<
	144	REAL(wp) :: high_td_lsa_lpt !<
	145	REAL(wp) :: low_td_lsa_lpt !<
	146	REAL(wp) :: high_td_lsa_q !<
	147	REAL(wp) :: low_td_lsa_q !<
	148	REAL(wp) :: high_td_sub_lpt !<
	149	REAL(wp) :: low_td_sub_lpt !<
	150	REAL(wp) :: high_td_sub_q !<
	151	REAL(wp) :: low_td_sub_q !<
	152	REAL(wp) :: r_dummy !<
[1320]	153
[1382]	154	ALLOCATE( p_surf(0:nlsf), pt_surf(0:nlsf), q_surf(0:nlsf), &
	155	qsws_surf(0:nlsf), shf_surf(0:nlsf), &
	156	td_lsa_lpt(nzb:nzt+1,0:nlsf), td_lsa_q(nzb:nzt+1,0:nlsf), &
	157	td_sub_lpt(nzb:nzt+1,0:nlsf), td_sub_q(nzb:nzt+1,0:nlsf), &
[1365]	158	time_vert(0:nlsf), time_surf(0:nlsf), &
	159	ug_vert(nzb:nzt+1,0:nlsf), vg_vert(nzb:nzt+1,0:nlsf), &
	160	wsubs_vert(nzb:nzt+1,0:nlsf) )
[1239]	161
[1382]	162	p_surf = 0.0_wp; pt_surf = 0.0_wp; q_surf = 0.0_wp; qsws_surf = 0.0_wp
	163	shf_surf = 0.0_wp; time_vert = 0.0_wp; td_lsa_lpt = 0.0_wp
	164	td_lsa_q = 0.0_wp; td_sub_lpt = 0.0_wp; td_sub_q = 0.0_wp
	165	time_surf = 0.0_wp; ug_vert = 0.0_wp; vg_vert = 0.0_wp
	166	wsubs_vert = 0.0_wp
[1239]	167
[1365]	168	!
	169	!-- Array for storing large scale forcing and nudging tendencies at each
	170	!-- timestep for data output
	171	ALLOCATE( sums_ls_l(nzb:nzt+1,0:7) )
	172	sums_ls_l = 0.0_wp
[1239]	173
[1365]	174	ngp_sums_ls = (nz+2)*6
	175
[1249]	176	OPEN ( finput, FILE='LSF_DATA', STATUS='OLD', &
	177	FORM='FORMATTED', IOSTAT=ierrn )
[1239]	178
[1249]	179	IF ( ierrn /= 0 ) THEN
[1239]	180	message_string = 'file LSF_DATA does not exist'
	181	CALL message( 'ls_forcing', 'PA0368', 1, 2, 0, 6, 0 )
	182	ENDIF
	183
	184	ierrn = 0
	185	!
	186	!-- First three lines of LSF_DATA contain header
[1249]	187	READ ( finput, FMT='(a100)', IOSTAT=ierrn ) chmess
	188	READ ( finput, FMT='(a100)', IOSTAT=ierrn ) chmess
	189	READ ( finput, FMT='(a100)', IOSTAT=ierrn ) chmess
[1239]	190
[1249]	191	IF ( ierrn /= 0 ) THEN
[1239]	192	message_string = 'errors in file LSF_DATA'
	193	CALL message( 'ls_forcing', 'PA0369', 1, 2, 0, 6, 0 )
	194	ENDIF
	195
	196	!
	197	!-- Surface values are read in
[1365]	198	nt = 0
[1239]	199	ierrn = 0
	200
[1365]	201	DO WHILE ( time_surf(nt) < end_time )
	202	nt = nt + 1
	203	READ ( finput, *, IOSTAT = ierrn ) time_surf(nt), shf_surf(nt), &
	204	qsws_surf(nt), pt_surf(nt), &
	205	q_surf(nt), p_surf(nt)
[1239]	206
[1249]	207	IF ( ierrn < 0 ) THEN
[1299]	208	WRITE ( message_string, * ) 'No time dependent surface variables ',&
[1239]	209	'in&LSF_DATA for end of run found'
	210
[1602]	211	CALL message( 'ls_forcing', 'PA0363', 1, 2, 0, 6, 0 )
[1239]	212	ENDIF
	213	ENDDO
	214
	215
[1249]	216	IF ( time_surf(1) > end_time ) THEN
[1299]	217	WRITE ( message_string, * ) 'No time dependent surface variables in ',&
[1365]	218	'&LSF_DATA for end of run found - ', &
[1239]	219	'lsf_surf is set to FALSE'
	220	CALL message( 'ls_forcing', 'PA0371', 0, 0, 0, 6, 0 )
	221	lsf_surf = .FALSE.
	222	ENDIF
	223
	224	!
	225	!-- Go to the end of the list with surface variables
	226	DO WHILE ( ierrn == 0 )
[1249]	227	READ ( finput, *, IOSTAT = ierrn ) r_dummy
[1239]	228	ENDDO
	229
	230	!
	231	!-- Profiles of ug, vg and w_subs are read in (large scale forcing)
	232
[1365]	233	nt = 0
	234	DO WHILE ( time_vert(nt) < end_time )
	235	nt = nt + 1
[1239]	236	hash = "#"
	237	ierrn = 1 ! not zero
	238	!
	239	!-- Search for the next line consisting of "# time",
	240	!-- from there onwards the profiles will be read
	241	DO WHILE ( .NOT. ( hash == "#" .AND. ierrn == 0 ) )
[1365]	242	READ ( finput, *, IOSTAT=ierrn ) hash, time_vert(nt)
[1249]	243	IF ( ierrn < 0 ) THEN
[1299]	244	WRITE( message_string, * ) 'No time dependent vertical profiles',&
[1239]	245	' in&LSF_DATA for end of run found'
	246	CALL message( 'ls_forcing', 'PA0372', 1, 2, 0, 6, 0 )
	247	ENDIF
	248	ENDDO
	249
[1365]	250	IF ( nt == 1 .AND. time_vert(nt) > end_time ) EXIT
[1239]	251
[1365]	252	READ ( finput, *, IOSTAT=ierrn ) lowheight, lowug_vert, lowvg_vert, &
[1382]	253	lowwsubs_vert, low_td_lsa_lpt, &
	254	low_td_lsa_q, low_td_sub_lpt, &
	255	low_td_sub_q
[1249]	256	IF ( ierrn /= 0 ) THEN
[1239]	257	message_string = 'errors in file LSF_DATA'
[1299]	258	CALL message( 'ls_forcing', 'PA0369', 1, 2, 0, 6, 0 )
[1239]	259	ENDIF
	260
[1365]	261	READ ( finput, *, IOSTAT=ierrn ) highheight, highug_vert, &
	262	highvg_vert, highwsubs_vert, &
[1382]	263	high_td_lsa_lpt, high_td_lsa_q, &
	264	high_td_sub_lpt, high_td_sub_q
[1239]	265
[1249]	266	IF ( ierrn /= 0 ) THEN
[1239]	267	message_string = 'errors in file LSF_DATA'
[1299]	268	CALL message( 'ls_forcing', 'PA0369', 1, 2, 0, 6, 0 )
[1239]	269	ENDIF
	270
[1241]	271
[1239]	272	DO k = nzb, nzt+1
[1249]	273	IF ( highheight < zu(k) ) THEN
[1382]	274	lowheight = highheight
	275	lowug_vert = highug_vert
	276	lowvg_vert = highvg_vert
	277	lowwsubs_vert = highwsubs_vert
	278	low_td_lsa_lpt = high_td_lsa_lpt
	279	low_td_lsa_q = high_td_lsa_q
	280	low_td_sub_lpt = high_td_sub_lpt
	281	low_td_sub_q = high_td_sub_q
[1239]	282
	283	ierrn = 0
[1365]	284	READ ( finput, *, IOSTAT=ierrn ) highheight, highug_vert, &
	285	highvg_vert, highwsubs_vert, &
[1382]	286	high_td_lsa_lpt, &
	287	high_td_lsa_q, &
	288	high_td_sub_lpt, high_td_sub_q
[1239]	289
[1249]	290	IF ( ierrn /= 0 ) THEN
[1365]	291	WRITE( message_string, * ) 'zu(nzt+1) = ', zu(nzt+1), 'm ', &
	292	'is higher than the maximum height in LSF_DATA which ',&
	293	'is ', lowheight, 'm. Interpolation on PALM ', &
	294	'grid is not possible.'
	295	CALL message( 'ls_forcing', 'PA0395', 1, 2, 0, 6, 0 )
[1239]	296	ENDIF
	297
	298	ENDIF
	299
	300	!
	301	!-- Interpolation of prescribed profiles in space
	302	fac = (highheight-zu(k))/(highheight - lowheight)
	303
[1382]	304	ug_vert(k,nt) = fac * lowug_vert &
	305	+ ( 1.0_wp - fac ) * highug_vert
	306	vg_vert(k,nt) = fac * lowvg_vert &
	307	+ ( 1.0_wp - fac ) * highvg_vert
	308	wsubs_vert(k,nt) = fac * lowwsubs_vert &
	309	+ ( 1.0_wp - fac ) * highwsubs_vert
[1239]	310
[1382]	311	td_lsa_lpt(k,nt) = fac * low_td_lsa_lpt &
	312	+ ( 1.0_wp - fac ) * high_td_lsa_lpt
	313	td_lsa_q(k,nt) = fac * low_td_lsa_q &
	314	+ ( 1.0_wp - fac ) * high_td_lsa_q
	315	td_sub_lpt(k,nt) = fac * low_td_sub_lpt &
	316	+ ( 1.0_wp - fac ) * high_td_sub_lpt
	317	td_sub_q(k,nt) = fac * low_td_sub_q &
	318	+ ( 1.0_wp - fac ) * high_td_sub_q
[1365]	319
[1239]	320	ENDDO
	321
	322	ENDDO
	323
[1299]	324	!
	325	!-- Large scale vertical velocity has to be zero at the surface
[1353]	326	wsubs_vert(nzb,:) = 0.0_wp
[1299]	327
[1249]	328	IF ( time_vert(1) > end_time ) THEN
[1365]	329	WRITE ( message_string, * ) 'Time dependent large scale profile ', &
	330	'forcing from&LSF_DATA sets in after end of ' , &
[1249]	331	'simulation - lsf_vert is set to FALSE'
[1239]	332	CALL message( 'ls_forcing', 'PA0373', 0, 0, 0, 6, 0 )
	333	lsf_vert = .FALSE.
	334	ENDIF
	335
	336	CLOSE( finput )
	337
	338
	339	END SUBROUTINE init_ls_forcing
	340
	341
[1682]	342	!------------------------------------------------------------------------------!
	343	! Description:
	344	! ------------
	345	!> @todo Missing subroutine description.
	346	!------------------------------------------------------------------------------!
[1239]	347	SUBROUTINE ls_forcing_surf ( time )
	348
[1320]	349	USE arrays_3d, &
	350	ONLY: p_surf, pt_surf, q_surf, qsws, qsws_surf, shf, shf_surf, &
	351	time_surf, time_vert, ug, ug_vert, vg, vg_vert
[1239]	352
[1320]	353	USE control_parameters, &
	354	ONLY: bc_q_b, ibc_pt_b, ibc_q_b, pt_surface, q_surface, &
	355	surface_pressure
	356
	357	USE kinds
	358
[1239]	359	IMPLICIT NONE
	360
[1682]	361	INTEGER(iwp) :: nt !<
[1239]	362
[1682]	363	REAL(wp) :: fac !<
	364	REAL(wp), INTENT(in) :: time !<
[1320]	365
[1239]	366	!
	367	!-- Interpolation in time of LSF_DATA at the surface
[1365]	368	nt = 1
	369	DO WHILE ( time > time_surf(nt) )
	370	nt = nt + 1
[1239]	371	ENDDO
[1365]	372	IF ( time /= time_surf(nt) ) THEN
	373	nt = nt - 1
[1239]	374	ENDIF
	375
[1365]	376	fac = ( time -time_surf(nt) ) / ( time_surf(nt+1) - time_surf(nt) )
[1239]	377
[1276]	378	IF ( ibc_pt_b == 0 ) THEN
	379	!
	380	!-- In case of Dirichlet boundary condition shf must not
	381	!-- be set - it is calculated via MOST in prandtl_fluxes
[1365]	382	pt_surface = pt_surf(nt) + fac * ( pt_surf(nt+1) - pt_surf(nt) )
[1276]	383
	384	ELSEIF ( ibc_pt_b == 1 ) THEN
	385	!
	386	!-- In case of Neumann boundary condition pt_surface is needed for
	387	!-- calculation of reference density
[1365]	388	shf = shf_surf(nt) + fac * ( shf_surf(nt+1) - shf_surf(nt) )
	389	pt_surface = pt_surf(nt) + fac * ( pt_surf(nt+1) - pt_surf(nt) )
[1276]	390
	391	ENDIF
	392
	393	IF ( ibc_q_b == 0 ) THEN
	394	!
	395	!-- In case of Dirichlet boundary condition qsws must not
	396	!-- be set - it is calculated via MOST in prandtl_fluxes
[1365]	397	q_surface = q_surf(nt) + fac * ( q_surf(nt+1) - q_surf(nt) )
[1276]	398
[1299]	399	ELSEIF ( ibc_q_b == 1 ) THEN
[1276]	400
[1365]	401	qsws = qsws_surf(nt) + fac * ( qsws_surf(nt+1) - qsws_surf(nt) )
[1276]	402
	403	ENDIF
	404
[1365]	405	surface_pressure = p_surf(nt) + fac * ( p_surf(nt+1) - p_surf(nt) )
[1239]	406
	407	END SUBROUTINE ls_forcing_surf
	408
	409
[1682]	410	!------------------------------------------------------------------------------!
	411	! Description:
	412	! ------------
	413	!> @todo Missing subroutine description.
	414	!------------------------------------------------------------------------------!
[1239]	415	SUBROUTINE ls_forcing_vert ( time )
	416
[1320]	417	USE arrays_3d, &
	418	ONLY: time_vert, ug, ug_vert, vg, vg_vert, w_subs, wsubs_vert
[1239]	419
[1320]	420	USE control_parameters, &
	421	ONLY: large_scale_subsidence
	422
	423	USE kinds
	424
[1239]	425	IMPLICIT NONE
	426
[1682]	427	INTEGER(iwp) :: nt !<
[1239]	428
[1682]	429	REAL(wp) :: fac !<
	430	REAL(wp), INTENT(in) :: time !<
[1320]	431
[1239]	432	!
	433	!-- Interpolation in time of LSF_DATA for ug, vg and w_subs
[1365]	434	nt = 1
	435	DO WHILE ( time > time_vert(nt) )
	436	nt = nt + 1
[1239]	437	ENDDO
[1365]	438	IF ( time /= time_vert(nt) ) THEN
	439	nt = nt - 1
[1239]	440	ENDIF
	441
[1365]	442	fac = ( time-time_vert(nt) ) / ( time_vert(nt+1)-time_vert(nt) )
[1239]	443
[1365]	444	ug = ug_vert(:,nt) + fac * ( ug_vert(:,nt+1) - ug_vert(:,nt) )
	445	vg = vg_vert(:,nt) + fac * ( vg_vert(:,nt+1) - vg_vert(:,nt) )
[1239]	446
[1249]	447	IF ( large_scale_subsidence ) THEN
[1365]	448	w_subs = wsubs_vert(:,nt) &
	449	+ fac * ( wsubs_vert(:,nt+1) - wsubs_vert(:,nt) )
[1239]	450	ENDIF
	451
	452	END SUBROUTINE ls_forcing_vert
	453
	454
[1365]	455	!------------------------------------------------------------------------------!
[1682]	456	! Description:
	457	! ------------
	458	!> Call for all grid points
[1365]	459	!------------------------------------------------------------------------------!
	460	SUBROUTINE ls_advec ( time, prog_var )
	461
	462	USE arrays_3d, &
[1382]	463	ONLY: td_lsa_lpt, td_lsa_q, td_sub_lpt, td_sub_q, tend, time_vert
[1365]	464
	465	USE control_parameters, &
	466	ONLY: large_scale_subsidence, use_subsidence_tendencies
	467
	468	USE indices
	469
	470	USE kinds
	471
	472	IMPLICIT NONE
	473
[1682]	474	CHARACTER (LEN=*) :: prog_var !<
[1365]	475
[1682]	476	REAL(wp), INTENT(in) :: time !<
	477	REAL(wp) :: fac !<
[1365]	478
[1682]	479	INTEGER(iwp) :: i !<
	480	INTEGER(iwp) :: j !<
	481	INTEGER(iwp) :: k !<
	482	INTEGER(iwp) :: nt !<
[1365]	483
	484	!
	485	!-- Interpolation in time of LSF_DATA
	486	nt = 1
	487	DO WHILE ( time > time_vert(nt) )
	488	nt = nt + 1
	489	ENDDO
	490	IF ( time /= time_vert(nt) ) THEN
	491	nt = nt - 1
	492	ENDIF
	493
	494	fac = ( time-time_vert(nt) ) / ( time_vert(nt+1)-time_vert(nt) )
	495
	496	!
	497	!-- Add horizontal large scale advection tendencies of pt and q
	498	SELECT CASE ( prog_var )
	499
	500	CASE ( 'pt' )
	501
	502	DO i = nxl, nxr
	503	DO j = nys, nyn
	504	DO k = nzb_u_inner(j,i)+1, nzt
[1382]	505	tend(k,j,i) = tend(k,j,i) + td_lsa_lpt(k,nt) + fac * &
	506	( td_lsa_lpt(k,nt+1) - td_lsa_lpt(k,nt) )
[1365]	507	ENDDO
	508	ENDDO
	509	ENDDO
	510
	511	CASE ( 'q' )
	512
	513	DO i = nxl, nxr
	514	DO j = nys, nyn
	515	DO k = nzb_u_inner(j,i)+1, nzt
[1382]	516	tend(k,j,i) = tend(k,j,i) + td_lsa_q(k,nt) + fac * &
	517	( td_lsa_q(k,nt+1) - td_lsa_q(k,nt) )
[1365]	518	ENDDO
	519	ENDDO
	520	ENDDO
	521
	522	END SELECT
	523
	524	!
	525	!-- Subsidence of pt and q with prescribed subsidence tendencies
	526	IF ( large_scale_subsidence .AND. use_subsidence_tendencies ) THEN
	527
	528	SELECT CASE ( prog_var )
	529
	530	CASE ( 'pt' )
	531
	532	DO i = nxl, nxr
	533	DO j = nys, nyn
	534	DO k = nzb_u_inner(j,i)+1, nzt
[1382]	535	tend(k,j,i) = tend(k,j,i) + td_sub_lpt(k,nt) + fac * &
	536	( td_sub_lpt(k,nt+1) - td_sub_lpt(k,nt) )
[1365]	537	ENDDO
	538	ENDDO
	539	ENDDO
	540
	541	CASE ( 'q' )
	542
	543	DO i = nxl, nxr
	544	DO j = nys, nyn
	545	DO k = nzb_u_inner(j,i)+1, nzt
[1382]	546	tend(k,j,i) = tend(k,j,i) + td_sub_q(k,nt) + fac * &
	547	( td_sub_q(k,nt+1) - td_sub_q(k,nt) )
[1365]	548	ENDDO
	549	ENDDO
	550	ENDDO
	551
	552	END SELECT
	553
	554	ENDIF
	555
	556	END SUBROUTINE ls_advec
	557
	558
	559	!------------------------------------------------------------------------------!
[1682]	560	! Description:
	561	! ------------
	562	!> Call for grid point i,j
[1365]	563	!------------------------------------------------------------------------------!
	564	SUBROUTINE ls_advec_ij ( i, j, time, prog_var )
	565
	566	USE arrays_3d, &
[1382]	567	ONLY: td_lsa_lpt, td_lsa_q, td_sub_lpt, td_sub_q, tend, time_vert
[1365]	568
	569	USE control_parameters, &
	570	ONLY: large_scale_subsidence, use_subsidence_tendencies
	571
	572	USE indices
	573
	574	USE kinds
	575
	576	IMPLICIT NONE
	577
[1682]	578	CHARACTER (LEN=*) :: prog_var !<
[1365]	579
[1682]	580	REAL(wp), INTENT(in) :: time !<
	581	REAL(wp) :: fac !<
[1365]	582
[1682]	583	INTEGER(iwp) :: i !<
	584	INTEGER(iwp) :: j !<
	585	INTEGER(iwp) :: k !<
	586	INTEGER(iwp) :: nt !<
[1365]	587
	588	!
	589	!-- Interpolation in time of LSF_DATA
	590	nt = 1
	591	DO WHILE ( time > time_vert(nt) )
	592	nt = nt + 1
	593	ENDDO
	594	IF ( time /= time_vert(nt) ) THEN
	595	nt = nt - 1
	596	ENDIF
	597
	598	fac = ( time-time_vert(nt) ) / ( time_vert(nt+1)-time_vert(nt) )
	599
	600	!
	601	!-- Add horizontal large scale advection tendencies of pt and q
	602	SELECT CASE ( prog_var )
	603
	604	CASE ( 'pt' )
	605
	606	DO k = nzb_u_inner(j,i)+1, nzt
[1382]	607	tend(k,j,i) = tend(k,j,i) + td_lsa_lpt(k,nt) &
	608	+ fac * ( td_lsa_lpt(k,nt+1) - td_lsa_lpt(k,nt) )
[1365]	609	ENDDO
	610
	611	CASE ( 'q' )
	612
	613	DO k = nzb_u_inner(j,i)+1, nzt
[1382]	614	tend(k,j,i) = tend(k,j,i) + td_lsa_q(k,nt) &
	615	+ fac * ( td_lsa_q(k,nt+1) - td_lsa_q(k,nt) )
[1365]	616	ENDDO
	617
	618	END SELECT
	619
	620	!
	621	!-- Subsidence of pt and q with prescribed profiles
	622	IF ( large_scale_subsidence .AND. use_subsidence_tendencies ) THEN
	623
	624	SELECT CASE ( prog_var )
	625
	626	CASE ( 'pt' )
	627
	628	DO k = nzb_u_inner(j,i)+1, nzt
[1382]	629	tend(k,j,i) = tend(k,j,i) + td_sub_lpt(k,nt) + fac * &
	630	( td_sub_lpt(k,nt+1) - td_sub_lpt(k,nt) )
[1365]	631	ENDDO
	632
	633	CASE ( 'q' )
	634
	635	DO k = nzb_u_inner(j,i)+1, nzt
[1382]	636	tend(k,j,i) = tend(k,j,i) + td_sub_q(k,nt) + fac * &
	637	( td_sub_q(k,nt+1) - td_sub_q(k,nt) )
[1365]	638	ENDDO
	639
	640	END SELECT
	641
	642	ENDIF
	643
	644	END SUBROUTINE ls_advec_ij
	645
	646
[1239]	647	END MODULE ls_forcing_mod

Note: See TracBrowser for help on using the repository browser.

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |