Home

Context Navigation

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

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |