Home

Context Navigation

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

Last change on this file since 1665 was 1603, checked in by heinze, 9 years ago
last commit documented
Property svn:keywords set to `Id`
File size: 20.9 KB

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |