Home

Context Navigation

source: palm/trunk/SOURCE/ls_forcing.f90 @ 1682

Last change on this file since 1682 was 1682, checked in by knoop, 9 years ago
Code annotations made doxygen readable
Property svn:keywords set to `Id`
File size: 21.7 KB

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |