Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

module_sf_idealscmsfclay.F @ 2289

Last change on this file since 2289 was 1, checked in by lfita, 11 years ago

-- --- Opening of the WRF+LMDZ coupling repository --- -- -

WRF: version v3.3
LMDZ: version v1818

More details in:

File size: 12.5 KB

Line
1	!WRF:MODEL_LAYER:PHYSICS
2	!
3	MODULE module_sf_idealscmsfclay
4
5	CONTAINS
6
7	!-------------------------------------------------------------------
8	SUBROUTINE idealscmsfclay(u3d,v3d,th3d,qv3d,p3d,pi3d,rho,z,ht, &
9	cp,g,rovcp,r,xlv,psfc,chs,chs2,cqs2,cpm, &
10	znt,ust,mavail,xland, &
11	hfx,qfx,lh,tsk,flhc,flqc,qgh,qsfc, &
12	u10,v10,th2,t2,q2, &
13	svp1,svp2,svp3,svpt0,ep1,ep2, &
14	karman,fCor,exch_temf, &
15	hfx_force, lh_force, tsk_force, &
16	hfx_force_tend, lh_force_tend, tsk_force_tend, &
17	dt,itimestep, &
18	ids,ide, jds,jde, kds,kde, &
19	ims,ime, jms,jme, kms,kme, &
20	its,ite, jts,jte, kts,kte &
21	)
22	!-------------------------------------------------------------------
23	IMPLICIT NONE
24	!-------------------------------------------------------------------
25	!-- u3d 3D u-velocity interpolated to theta points (m/s)
26	!-- v3d 3D v-velocity interpolated to theta points (m/s)
27	!-- th3d potential temperature (K)
28	!-- qv3d 3D water vapor mixing ratio (Kg/Kg)
29	!-- p3d 3D pressure (Pa)
30	!-- cp heat capacity at constant pressure for dry air (J/kg/K)
31	!-- g acceleration due to gravity (m/s^2)
32	!-- rovcp R/CP
33	!-- r gas constant for dry air (J/kg/K)
34	!-- xlv latent heat of vaporization for water (J/kg)
35	!-- psfc surface pressure (Pa)
36	!-- chs heat/moisture exchange coefficient for LSM (m/s)
37	!-- chs2
38	!-- cqs2
39	!-- cpm
40	!-- znt roughness length (m)
41	!-- ust u* in similarity theory (m/s)
42	!-- mavail surface moisture availability (between 0 and 1)
43	!-- xland land mask (1 for land, 2 for water)
44	!-- hfx upward heat flux at the surface (W/m^2)
45	!-- qfx upward moisture flux at the surface (kg/m^2/s)
46	!-- lh net upward latent heat flux at surface (W/m^2)
47	!-- tsk surface temperature (K)
48	!-- flhc exchange coefficient for heat (W/m^2/K)
49	!-- flqc exchange coefficient for moisture (kg/m^2/s)
50	!-- qgh lowest-level saturated mixing ratio
51	!-- qsfc ground saturated mixing ratio
52	!-- u10 diagnostic 10m u wind
53	!-- v10 diagnostic 10m v wind
54	!-- th2 diagnostic 2m theta (K)
55	!-- t2 diagnostic 2m temperature (K)
56	!-- q2 diagnostic 2m mixing ratio (kg/kg)
57	!-- svp1 constant for saturation vapor pressure (kPa)
58	!-- svp2 constant for saturation vapor pressure (dimensionless)
59	!-- svp3 constant for saturation vapor pressure (K)
60	!-- svpt0 constant for saturation vapor pressure (K)
61	!-- ep1 constant for virtual temperature (R_v/R_d - 1) (dimensionless)
62	!-- ep2 constant for specific humidity calculation
63	! (R_d/R_v) (dimensionless)
64	!-- karman Von Karman constant
65	!-- fCor Coriolis parameter
66	!-- ids start index for i in domain
67	!-- ide end index for i in domain
68	!-- jds start index for j in domain
69	!-- jde end index for j in domain
70	!-- kds start index for k in domain
71	!-- kde end index for k in domain
72	!-- ims start index for i in memory
73	!-- ime end index for i in memory
74	!-- jms start index for j in memory
75	!-- jme end index for j in memory
76	!-- kms start index for k in memory
77	!-- kme end index for k in memory
78	!-- its start index for i in tile
79	!-- ite end index for i in tile
80	!-- jts start index for j in tile
81	!-- jte end index for j in tile
82	!-- kts start index for k in tile
83	!-- kte end index for k in tile
84	!-------------------------------------------------------------------
85	INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde, &
86	ims,ime, jms,jme, kms,kme, &
87	its,ite, jts,jte, kts,kte
88	!
89	REAL, DIMENSION( ims:ime, kms:kme, jms:jme ) , &
90	INTENT(IN ) :: u3d, v3d, th3d, qv3d, p3d, pi3d, rho, z
91	REAL, DIMENSION( ims:ime, jms:jme ) , &
92	INTENT(IN ) :: mavail, xland, fCor, ht, psfc, znt
93	REAL, DIMENSION( ims:ime, jms:jme ) , &
94	INTENT(INOUT) :: hfx, qfx, lh, flhc, flqc, tsk
95	REAL, DIMENSION( ims:ime, jms:jme ) , &
96	INTENT(INOUT) :: ust, chs2, cqs2, chs, cpm, qgh, qsfc
97	REAL, DIMENSION( ims:ime, jms:jme ) , &
98	INTENT(OUT ) :: u10, v10, th2, t2, q2
99	REAL, DIMENSION( ims:ime, jms:jme ) , &
100	INTENT( OUT) :: exch_temf
101
102	REAL, INTENT(INOUT) :: hfx_force, lh_force, tsk_force
103	REAL, INTENT(IN ) :: hfx_force_tend, lh_force_tend, tsk_force_tend
104	REAL, INTENT(IN ) :: dt
105	INTEGER, INTENT(IN ) :: itimestep
106
107	REAL, INTENT(IN ) :: cp,g,rovcp,r,xlv
108	REAL, INTENT(IN ) :: svp1,svp2,svp3,svpt0
109	REAL, INTENT(IN ) :: ep1,ep2,karman
110	!
111	! LOCAL VARS
112
113	INTEGER :: J
114	!
115	! WA 1/6/10 This routine just populates HFX, QFX, and TSK
116	! with the suitable converted forcing values.
117	! Note that flhc,flqc are not populated, this will NOT WORK with
118	! an LSM.
119
120	! Update forcing fluxes to the current timestep
121	hfx_force = hfx_force + dt*hfx_force_tend
122	lh_force = lh_force + dt*lh_force_tend
123	tsk_force = tsk_force + dt*tsk_force_tend
124
125	DO J=jts,jte
126
127	CALL idealscmsfclay1d(j,u1d=u3d(ims,kms,j),v1d=v3d(ims,kms,j), &
128	th1d=th3d(ims,kms,j),qv1d=qv3d(ims,kms,j),p1d=p3d(ims,kms,j), &
129	pi1d=pi3d(ims,kms,j),rho=rho(ims,kms,j),z=z(ims,kms,j),&
130	zsrf=ht(ims,j), &
131	cp=cp,g=g,rovcp=rovcp,r=r,xlv=xlv,psfc=psfc(ims,j), &
132	chs=chs(ims,j),chs2=chs2(ims,j),cqs2=cqs2(ims,j), &
133	cpm=cpm(ims,j),znt=znt(ims,j),ust=ust(ims,j), &
134	mavail=mavail(ims,j),xland=xland(ims,j), &
135	hfx=hfx(ims,j),qfx=qfx(ims,j),lh=lh(ims,j),tsk=tsk(ims,j), &
136	flhc=flhc(ims,j),flqc=flqc(ims,j),qgh=qgh(ims,j), &
137	qsfc=qsfc(ims,j),u10=u10(ims,j),v10=v10(ims,j), &
138	th2=th2(ims,j),t2=t2(ims,j),q2=q2(ims,j), &
139	svp1=svp1,svp2=svp2,svp3=svp3,svpt0=svpt0, &
140	ep1=ep1,ep2=ep2,karman=karman,fCor=fCor(ims,j), &
141	exch_temfx=exch_temf(ims,j), &
142	hfx_force=hfx_force,lh_force=lh_force,tsk_force=tsk_force, &
143	hfx_force_tend=hfx_force_tend, &
144	lh_force_tend=lh_force_tend, &
145	tsk_force_tend=tsk_force_tend, &
146	dt=dt,itimestep=itimestep, &
147	ids=ids,ide=ide, jds=jds,jde=jde, kds=kds,kde=kde, &
148	ims=ims,ime=ime, jms=jms,jme=jme, kms=kms,kme=kme, &
149	its=its,ite=ite, jts=jts,jte=jte, kts=kts,kte=kte &
150	)
151	ENDDO
152
153	END SUBROUTINE idealscmsfclay
154
155
156	!-------------------------------------------------------------------
157	SUBROUTINE idealscmsfclay1d(j,u1d,v1d,th1d,qv1d,p1d, &
158	pi1d,rho,z,zsrf,cp,g,rovcp,r,xlv,psfc, &
159	chs,chs2,cqs2,cpm,znt,ust, &
160	mavail,xland,hfx,qfx,lh,tsk, &
161	flhc,flqc,qgh,qsfc,u10,v10, &
162	th2,t2,q2,svp1,svp2,svp3,svpt0, &
163	ep1,ep2,karman,fCor, &
164	exch_temfx, &
165	hfx_force,lh_force,tsk_force, &
166	hfx_force_tend,lh_force_tend,tsk_force_tend, &
167	dt,itimestep, &
168	ids,ide, jds,jde, kds,kde, &
169	ims,ime, jms,jme, kms,kme, &
170	its,ite, jts,jte, kts,kte &
171	)
172	!!-------------------------------------------------------------------
173	IMPLICIT NONE
174	!!-------------------------------------------------------------------
175	INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde, &
176	ims,ime, jms,jme, kms,kme, &
177	its,ite, jts,jte, kts,kte, &
178	j
179
180	REAL, DIMENSION( ims:ime ), INTENT(IN ) :: &
181	u1d,v1d,qv1d,p1d,th1d,pi1d,rho,z,zsrf
182	REAL, INTENT(IN ) :: cp,g,rovcp,r,xlv
183	REAL, DIMENSION( ims:ime ), INTENT(IN ) :: psfc,znt
184	REAL, DIMENSION( ims:ime ), INTENT(INOUT) :: &
185	chs,chs2,cqs2,cpm,ust
186	REAL, DIMENSION( ims:ime ), INTENT(IN ) :: mavail,xland
187	REAL, DIMENSION( ims:ime ), INTENT(INOUT) :: &
188	hfx,qfx,lh
189	REAL, DIMENSION( ims:ime ), INTENT(INOUT) :: tsk
190	REAL, DIMENSION( ims:ime ), INTENT( OUT) :: &
191	flhc,flqc
192	REAL, DIMENSION( ims:ime ), INTENT(INOUT) :: &
193	qgh,qsfc
194	REAL, DIMENSION( ims:ime ), INTENT( OUT) :: &
195	u10,v10,th2,t2,q2
196	REAL, INTENT(IN ) :: svp1,svp2,svp3,svpt0
197	REAL, INTENT(IN ) :: ep1,ep2,karman
198	REAL, DIMENSION( ims:ime ), INTENT(IN ) :: fCor
199	REAL, DIMENSION( ims:ime ), INTENT( OUT) :: exch_temfx
200	REAL, INTENT(INOUT) :: hfx_force,lh_force,tsk_force
201	REAL, INTENT(IN ) :: hfx_force_tend,lh_force_tend,tsk_force_tend
202	REAL, INTENT(IN ) :: dt
203	INTEGER, INTENT(IN ) :: itimestep
204	!
205	!! LOCAL VARS
206	! TE model constants
207	logical, parameter :: MFopt = .true. ! Use mass flux or not
208	real, parameter :: TEmin = 1e-3
209	real, parameter :: ftau0 = 0.17
210	real, parameter :: fth0 = 0.145
211	real, parameter :: Cf = 0.185
212	real, parameter :: CN = 2.0
213	! real, parameter :: Ceps = ftau0**1.5
214	real, parameter :: Ceps = 0.070
215	real, parameter :: Cgamma = Ceps
216	real, parameter :: Cphi = Ceps
217	! real, parameter :: PrT0 = Cphi/Ceps * ftau02. / 2 / fth02.
218	real, parameter :: PrT0 = Cphi/Ceps * ftau02 / 2. / fth02
219	!
220	integer :: i
221	real :: e1
222	real, dimension( its:ite) :: wstr, ang, wm
223	real, dimension( its:ite) :: z0t
224	real, dimension( its:ite) :: dthdz, dqtdz, dudz, dvdz
225	real, dimension( its:ite) :: lepsmin
226	real, dimension( its:ite) :: thetav
227	real, dimension( its:ite) :: zt,zm
228	real, dimension( its:ite) :: N2, S, Ri, beta, ftau, fth, ratio
229	real, dimension( its:ite) :: TKE, TE2
230	real, dimension( its:ite) :: ustrtilde, linv, leps
231	real, dimension( its:ite) :: km, kh
232	real, dimension( its:ite) :: qsfc_air
233	!!-------------------------------------------------------------------
234
235	!!!!!!! ******
236	! WA Known outages: None
237
238	do i = its,ite ! Main loop
239
240	! WA 1/6/10 This routine just populates HFX, QFX, and TSK
241	! with the suitable converted forcing values.
242
243	! Surface fluxes
244	ust(i) = sqrt(ftau(i)/ftau0) * sqrt(u1d(i)2. + v1d(i)2.) * leps(i) / log(zm(i)/znt(i)) / zt(i)
245	ang(i) = atan2(v1d(i),u1d(i))
246
247	! Populate surface heat and moisture fluxes
248	hfx(i) = hfx_force
249	lh(i) = lh_force
250	qfx(i) = lh(i) / xlv
251	tsk(i) = tsk_force
252
253	! Populate exchange coefficients
254	flhc(i) = hfx(i) / (tsk(i) - th1d(i)*pi1d(i))
255	exch_temfx(i) = flhc(i) / (rho(i) * cp)
256	! flqc(i) = qfx(i) / (qsfc_air(i) - qv1d(i))
257	flqc(i) = exch_temfx(i) * mavail(i)
258
259	end do ! Main loop
260
261	END SUBROUTINE idealscmsfclay1d
262
263	!====================================================================
264	SUBROUTINE idealscmsfclayinit( allowed_to_read )
265
266	LOGICAL , INTENT(IN) :: allowed_to_read
267
268	END SUBROUTINE idealscmsfclayinit
269
270	!-------------------------------------------------------------------
271
272	END MODULE module_sf_idealscmsfclay

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

Download in other formats:

Original Format