| blob | 3479a4362e76e781aa555ccb3180e66e91a02e87 |
1 !----------------------------------------------------------------------
2 !
3 MODULE MODULE_SF_MYJSFC
4 !
5 !----------------------------------------------------------------------
6 !
7 USE MODULE_MODEL_CONSTANTS
8 #ifdef DM_PARALLEL
9 USE MODULE_DM, ONLY : WRF_DM_MAXVAL
10 #endif
11 !
12 !----------------------------------------------------------------------
13 !
14 ! REFERENCES: Janjic (2002), NCEP Office Note 437
15 !
16 ! ABSTRACT:
17 ! MYJSFC GENERATES THE SURFACE EXCHANGE COEFFICIENTS FOR VERTICAL
18 ! TURBULENT EXCHANGE BASED UPON MONIN_OBUKHOV THEORY WITH
19 ! VARIOUS REFINEMENTS.
20 !
21 !----------------------------------------------------------------------
22 !
23 INTEGER :: ITRMX=5 ! Iteration count for sfc layer computations
24 !
25 REAL,PARAMETER :: VKARMAN=0.4
26 REAL,PARAMETER :: CAPA=R_D/CP,ELOCP=2.72E6/CP,RCAP=1./CAPA
27 REAL,PARAMETER :: GOCP02=G/CP*2.,GOCP10=G/CP*10.
28 ! REAL,PARAMETER :: EPSU2=1.E-4,EPSUST=0.07,EPSZT=1.E-5
29 ! ECMWF sets lower limit on ln(Z0h)=-20 --> EPSZT=2.e-9
30 REAL,PARAMETER :: EPSU2=1.E-6,EPSUST=1.e-9,EPSZT=1.E-28
31 REAL,PARAMETER :: A2S=17.2693882,A3S=273.16,A4S=35.86
32 REAL,PARAMETER :: SEAFC=0.98,PQ0SEA=PQ0*SEAFC
33 REAL,PARAMETER :: BETA=1./273.,EXCML=0.0001,EXCMS=0.0001 &
34 & ,GLKBR=10.,GLKBS=30.,PI=3.1415926 &
35 & ,QVISC=2.1E-5,RIC=0.505,SMALL=0.35 &
36 & ,SQPR=0.84,SQSC=0.84,SQVISC=258.2,TVISC=2.1E-5 &
37 & ,USTC=0.7,USTR=0.225,VISC=1.5E-5,FH=1.01 &
38 & ,WWST=1.2,ZTFC=1.,TOPOFAC=9.0e-6
39 !
40 REAL,PARAMETER :: BTG=BETA*G,CZIV=SMALL*GLKBS &
41 & ,GRRS=GLKBR/GLKBS &
42 & ,RTVISC=1./TVISC,RVISC=1./VISC &
43 & ,ZQRZT=SQSC/SQPR &
44 & ,FZQ1=RTVISC*QVISC*ZQRZT &
45 & ,FZQ2=RTVISC*QVISC*ZQRZT &
46 & ,FZT1=RVISC *TVISC*SQPR &
47 & ,FZT2=CZIV*GRRS*TVISC*SQPR &
48 & ,FZU1=CZIV*VISC &
49 & ,PIHF=0.5*PI &
50 & ,RQVISC=1./QVISC &
51 & ,USTFC=0.018/G &
52 & ,WWST2=WWST*WWST
53 !
54 !----------------------------------------------------------------------
55 INTEGER, PARAMETER :: KZTM=10001,KZTM2=KZTM-2
56 !
57 REAL :: DZETA1,DZETA2,FH01,FH02,ZTMAX1,ZTMAX2,ZTMIN1,ZTMIN2
58 !
59 REAL,DIMENSION(KZTM) :: PSIH1,PSIH2,PSIM1,PSIM2
60 !
61 !----------------------------------------------------------------------
62 !
63 CONTAINS
64 !
65 !----------------------------------------------------------------------
66 SUBROUTINE MYJSFC(ITIMESTEP,HT,DZ &
67 & ,PMID,PINT,TH,T,QV,QC,U,V,Q2 &
68 & ,TSK,QSFC,THZ0,QZ0,UZ0,VZ0 &
69 & ,LOWLYR,XLAND,IVGTYP,ISURBAN,IZ0TLND &
70 & ,USTAR,ZNT,Z0BASE,PBLH,MAVAIL,RMOL &
71 & ,AKHS,AKMS &
72 & ,RIB &
73 & ,CHS,CHS2,CQS2,HFX,QFX,FLX_LH,FLHC,FLQC &
74 & ,QGH,CPM,CT &
75 & ,U10,V10,T02,TH02,TSHLTR,TH10,Q02,QSHLTR,Q10,PSHLTR &
76 & ,P1000mb,U10E,V10E &
77 & ,IDS,IDE,JDS,JDE,KDS,KDE &
78 & ,IMS,IME,JMS,JME,KMS,KME &
79 & ,ITS,ITE,JTS,JTE,KTS,KTE)
80 !----------------------------------------------------------------------
81 !
82 IMPLICIT NONE
83 !
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 INTEGER,INTENT(IN) :: ITIMESTEP
90 !
91 INTEGER,DIMENSION(IMS:IME,JMS:JME),INTENT(IN) :: LOWLYR
92 !
93 REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(IN) :: HT,MAVAIL,TSK &
94 & ,XLAND,Z0BASE
95 !
96 REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(IN) :: DZ &
97 & ,PMID,PINT &
98 & ,Q2,QC,QV &
99 & ,T,TH &
100 & ,U,V
101 INTEGER,DIMENSION(IMS:IME,JMS:JME),INTENT(IN) :: IVGTYP
102 INTEGER, INTENT(IN) :: ISURBAN
103 INTEGER, INTENT(IN) :: IZ0TLND
104 !
105 REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(OUT) :: FLX_LH,HFX,PSHLTR &
106 & ,QFX,Q10,QSHLTR &
107 & ,TH10,TSHLTR,T02 &
108 & ,U10,V10,TH02,Q02 &
109 & ,U10E,V10E
110 !
111 REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(INOUT) :: AKHS,AKMS &
112 & ,PBLH,QSFC
113 REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(OUT) :: RIB
114 !
115 REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(INOUT) :: QZ0,RMOL,THZ0 &
116 & ,USTAR,UZ0,VZ0 &
117 & ,ZNT
118 !
119 REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(OUT) :: CHS,CHS2,CQS2 &
120 & ,CPM,CT,FLHC,FLQC &
121 & ,QGH
122 !
123 REAL,INTENT(IN) :: P1000mb
124 !----------------------------------------------------------------------
125 !***
126 !*** LOCAL VARIABLES
127 !***
128 INTEGER :: I,J,K,KFLIP,LMH,LPBL,NTSD
129 !
130 REAL :: A,APESFC,B,BTGX,CWMLOW &
131 & ,DQDT,DTDIF,DTDT,DUDT,DVDT &
132 & ,FIS &
133 & ,P02P,P10P,PLOW,PSFC,PTOP,QLOW,QS02,QS10 &
134 & ,RAPA,RAPA02,RAPA10,RATIOMX,RDZ,SEAMASK,SM &
135 & ,T02P,T10P,TEM,TH02P,TH10P,THLOW,THELOW,THM &
136 & ,TLOW,TZ0,ULOW,VLOW,ZSL
137 !
138 REAL,DIMENSION(KTS:KTE) :: CWMK,PK,Q2K,QK,THEK,THK,TK,UK,VK
139 !
140 REAL,DIMENSION(KTS:KTE-1) :: EL,ELM
141 !
142 REAL,DIMENSION(KTS:KTE+1) :: ZHK
143 !
144 REAL,DIMENSION(ITS:ITE,JTS:JTE) :: THSK
145 !
146 REAL,DIMENSION(ITS:ITE,KTS:KTE+1,JTS:JTE) :: ZINT
147 !
148 !----------------------------------------------------------------------
149 !**********************************************************************
150 !----------------------------------------------------------------------
151 !
152 !*** MAKE PREPARATIONS
153 !
154 !----------------------------------------------------------------------
155 DO J=JTS,JTE
156 DO K=KTS,KTE+1
157 DO I=ITS,ITE
158 ZINT(I,K,J)=0.
159 ENDDO
160 ENDDO
161 ENDDO
162 !
163 DO J=JTS,JTE
164 DO I=ITS,ITE
165 ZINT(I,KTE+1,J)=HT(I,J) ! Z at bottom of lowest sigma layer
166 PBLH(I,J)=-1.
167 !
168 !!!!!!!!!
169 !!!!!! UNCOMMENT THESE LINES IF USING ETA COORDINATES
170 !!!!!!!!!
171 !!!!!! ZINT(I,KTE+1,J)=1.E-4 ! Z of bottom of lowest eta layer
172 !!!!!! ZHK(KTE+1)=1.E-4 ! Z of bottom of lowest eta layer
173 !
174 ENDDO
175 ENDDO
176 !
177 DO J=JTS,JTE
178 DO K=KTE,KTS,-1
179 KFLIP=KTE+1-K
180 DO I=ITS,ITE
181 ZINT(I,K,J)=ZINT(I,K+1,J)+DZ(I,KFLIP,J)
182 ENDDO
183 ENDDO
184 ENDDO
185 !
186 NTSD=ITIMESTEP
187 !
188 #if ( NMM_CORE == 1 )
189 if(NTSD+1.eq.1) then
190 #else
191 IF(NTSD==1)THEN
192 #endif
193 !tgs IF(NTSD==1)THEN
194 DO J=JTS,JTE
195 DO I=ITS,ITE
196 USTAR(I,J)=0.1
197 FIS=HT(I,J)*G
198 SM=XLAND(I,J)-1.
199 !!! Z0(I,J)=SM*Z0SEA+(1.-SM)*(Z0(I,J)*Z0MAX+FIS*FCM+Z0LAND)
200 !!! ZNT(I,J)=SM*Z0SEA+(1.-SM)*(ZNT(I,J)*Z0MAX+FIS*FCM+Z0LAND)
201 ENDDO
202 ENDDO
203 ENDIF
204 !
205 !!!! IF(NTSD==1)THEN
206 DO J=JTS,JTE
207 DO I=ITS,ITE
208 CT(I,J)=0.
209 ENDDO
210 ENDDO
211 !!!! ENDIF
212 !
213 !----------------------------------------------------------------------
214 setup_integration: DO J=JTS,JTE
215 !----------------------------------------------------------------------
216 !
217 DO I=ITS,ITE
218 !
219 !*** LOWEST LAYER ABOVE GROUND MUST BE FLIPPED
220 !
221 LMH=KTE-LOWLYR(I,J)+1
222 !
223 PTOP=PINT(I,KTE+1,J) ! KTE+1=KME
224 PSFC=PINT(I,LOWLYR(I,J),J)
225 ! Define THSK here (for first timestep mostly)
226 ! THSK(I,J)=TSK(I,J)/(PSFC*1.E-5)**CAPA
227 THSK(I,J)=TSK(I,J)/(PSFC/P1000mb)**CAPA
228 !
229 !*** CONVERT LAND MASK (1 FOR SEA; 0 FOR LAND)
230 !
231 SEAMASK=XLAND(I,J)-1.
232 !
233 !*** FILL 1-D VERTICAL ARRAYS
234 !*** AND FLIP DIRECTION SINCE MYJ SCHEME
235 !*** COUNTS DOWNWARD FROM THE DOMAIN'S TOP
236 !
237 DO K=KTE,KTS,-1
238 KFLIP=KTE+1-K
239 THK(K)=TH(I,KFLIP,J)
240 TK(K)=T(I,KFLIP,J)
241 RATIOMX=QV(I,KFLIP,J)
242 QK(K)=RATIOMX/(1.+RATIOMX)
243 PK(K)=PMID(I,KFLIP,J)
244 CWMK(K)=QC(I,KFLIP,J)
245 THEK(K)=(CWMK(K)*(-ELOCP/TK(K))+1.)*THK(K)
246 Q2K(K)=2.*Q2(I,KFLIP,J)
247 !
248 !*** COMPUTE THE HEIGHTS OF THE LAYER INTERFACES
249 !
250 ZHK(K)=ZINT(I,K,J)
251 !
252 ENDDO
253 ZHK(KTE+1)=HT(I,J) ! Z at bottom of lowest sigma layer
254 !
255 DO K=KTE,KTS,-1
256 KFLIP=KTE+1-K
257 UK(K)=U(I,KFLIP,J)
258 VK(K)=V(I,KFLIP,J)
259 ENDDO
260 !
261 !*** FIND THE HEIGHT OF THE PBL
262 !
263 LPBL=LMH
264 DO K=LMH-1,1,-1
265 IF(Q2K(K)<=EPSQ2*FH) THEN
266 LPBL=K
267 GO TO 110
268 ENDIF
269 ENDDO
270 !
271 LPBL=1
272 !
273 !-----------------------------------------------------------------------
274 !--------------THE HEIGHT OF THE PBL------------------------------------
275 !-----------------------------------------------------------------------
276 !
277 110 PBLH(I,J)=ZHK(LPBL)-ZHK(LMH+1)
278 !
279 !----------------------------------------------------------------------
280 !***
281 !*** FIND THE SURFACE EXCHANGE COEFFICIENTS
282 !***
283 !----------------------------------------------------------------------
284 PLOW=PK(LMH)
285 TLOW=TK(LMH)
286 THLOW=THK(LMH)
287 THELOW=THEK(LMH)
288 QLOW=QK(LMH)
289 CWMLOW=CWMK(LMH)
290 ULOW=UK(LMH)
291 VLOW=VK(LMH)
292 ZSL=(ZHK(LMH)-ZHK(LMH+1))*0.5
293 ! APESFC=(PSFC*1.E-5)**CAPA
294 APESFC=(PSFC/P1000mb)**CAPA
295 !tgs - in ARW THZ0 is not initialized when MYJSFC is called first time
296 #if ( NMM_CORE == 1 )
297 if(NTSD+1.eq.1) then
298 #else
299 IF(NTSD==1)THEN
300 #endif
301 ! if(itimestep.le.1) then
302 TZ0=TSK(I,J)
303 else
304 TZ0=THZ0(I,J)*APESFC
305 endif
306 !
307 CALL SFCDIF(NTSD,SEAMASK,THSK(I,J),QSFC(I,J),PSFC &
308 & ,UZ0(I,J),VZ0(I,J),TZ0,TSK(I,J),THZ0(I,J),QZ0(I,J) &
309 & ,USTAR(I,J),ZNT(I,J),Z0BASE(I,J),CT(I,J),RMOL(I,J) &
310 & ,AKMS(I,J),AKHS(I,J),RIB(I,J),PBLH(I,J),MAVAIL(I,J) &
311 & ,IVGTYP(I,J),ISURBAN,IZ0TLND &
312 & ,CHS(I,J),CHS2(I,J),CQS2(I,J) &
313 & ,HFX(I,J),QFX(I,J),FLX_LH(I,J) &
314 & ,FLHC(I,J),FLQC(I,J),QGH(I,J),CPM(I,J) &
315 & ,ULOW,VLOW,TLOW,THLOW,THELOW,QLOW,CWMLOW &
316 & ,ZSL,PLOW &
317 & ,U10(I,J),V10(I,J),TSHLTR(I,J),TH10(I,J) &
318 & ,QSHLTR(I,J),Q10(I,J),PSHLTR(I,J) &
319 & ,U10E(I,J),V10E(I,J) &
320 & ,IDS,IDE,JDS,JDE,KDS,KDE &
321 & ,IMS,IME,JMS,JME,KMS,KME &
322 & ,ITS,ITE,JTS,JTE,KTS,KTE,i,j,ZHK(LMH+1))
323 !
324 !*** REMOVE SUPERATURATION AT 2M AND 10M
325 !
326 RAPA=APESFC
327 TH02P=TSHLTR(I,J)
328 TH10P=TH10(I,J)
329 TH02(I,J)=TSHLTR(I,J)
330 !
331 RAPA02=RAPA-GOCP02/TH02P
332 RAPA10=RAPA-GOCP10/TH10P
333 !
334 T02P=TH02P*RAPA02
335 T10P=TH10P*RAPA10
336 ! 1 may 06 tgs T02(I,J) = T02P
337 T02(I,J) = TH02(I,J)*APESFC
338 !
339 ! P02P=(RAPA02**RCAP)*1.E5
340 ! P10P=(RAPA10**RCAP)*1.E5
341 P02P=(RAPA02**RCAP)*P1000mb
342 P10P=(RAPA10**RCAP)*P1000mb
343 !
344 QS02=PQ0/P02P*EXP(A2*(T02P-A3)/(T02P-A4))
345 QS10=PQ0/P10P*EXP(A2*(T10P-A3)/(T10P-A4))
346 !
347 IF(QSHLTR(I,J)>QS02)QSHLTR(I,J)=QS02
348 IF(Q10 (I,J)>QS10)Q10 (I,J)=QS10
349 Q02(I,J)=QSHLTR(I,J)/(1.-QSHLTR(I,J))
350 !----------------------------------------------------------------------
351 !
352 ENDDO
353 !
354 !----------------------------------------------------------------------
355 ENDDO setup_integration
356 !----------------------------------------------------------------------
358 END SUBROUTINE MYJSFC
359 !XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
360 !----------------------------------------------------------------------
361 SUBROUTINE SFCDIF(NTSD,SEAMASK,THS,QS,PSFC &
362 & ,UZ0,VZ0,TZ0,TSK,THZ0,QZ0 &
363 & ,USTAR,Z0,Z0BASE,CT,RLMO,AKMS,AKHS,RIB,PBLH,WETM &
364 & ,VEGTYP,ISURBAN,IZ0TLND &
365 & ,CHS,CHS2,CQS2,HFX,QFX,FLX_LH,FLHC,FLQC,QGH,CPM &
366 & ,ULOW,VLOW,TLOW,THLOW,THELOW,QLOW,CWMLOW &
367 & ,ZSL,PLOW &
368 & ,U10,V10,TH02,TH10,Q02,Q10,PSHLTR &
369 & ,U10E,V10E &
370 & ,IDS,IDE,JDS,JDE,KDS,KDE &
371 & ,IMS,IME,JMS,JME,KMS,KME &
372 & ,ITS,ITE,JTS,JTE,KTS,KTE,i,j,ZSFC)
373 ! ****************************************************************
374 ! * *
375 ! * SURFACE LAYER *
376 ! * *
377 ! ****************************************************************
378 !----------------------------------------------------------------------
379 !
380 IMPLICIT NONE
381 !
382 !----------------------------------------------------------------------
383 INTEGER,INTENT(IN) :: IDS,IDE,JDS,JDE,KDS,KDE &
384 & ,IMS,IME,JMS,JME,KMS,KME &
385 & ,ITS,ITE,JTS,JTE,KTS,KTE,i,j
386 !
387 INTEGER,INTENT(IN) :: NTSD
388 !
389 REAL,INTENT(IN) :: CWMLOW,PBLH,PLOW,QLOW,PSFC,SEAMASK,ZSFC &
390 & ,THELOW,THLOW,THS,TSK,TLOW,TZ0,ULOW,VLOW,WETM,ZSL &
391 & ,Z0BASE
392 INTEGER, INTENT(IN) :: VEGTYP, ISURBAN, IZ0TLND
393 !
394 REAL,INTENT(OUT) :: CHS,CHS2,CPM,CQS2,CT,FLHC,FLQC,FLX_LH,HFX &
395 & ,PSHLTR,Q02,Q10,QFX,QGH,RIB,RLMO &
396 & ,TH02,TH10,U10,V10,U10E,V10E
397 !
398 REAL,INTENT(INOUT) :: AKHS,AKMS,QZ0,THZ0,USTAR,UZ0,VZ0,Z0,QS
399 !----------------------------------------------------------------------
400 !***
401 !*** LOCAL VARIABLES
402 !***
403 INTEGER :: ITR,K
404 !
405 REAL :: A,B,BTGH,BTGX,CXCHL,CXCHS,CZETMAX,DTHV,DU2,ELFC,FCT &
406 & ,HLFLX,HSFLX,HV,PSH02,PSH10,PSHZ,PSHZL,PSM10,PSMZ,PSMZL &
407 & ,RDZ,RDZT,RLMA,RLMN,RLMP &
408 & ,RLOGT,RLOGU,RWGH,RZ,RZST,RZSU,SIMH,SIMM,TEM,THM &
409 & ,UMFLX,USTARK,VMFLX,WGHT,WGHTT,WGHTQ,WSTAR2 &
410 & ,X,XLT,XLT4,XLU,XLU4,XT,XT4,XU,XU4,ZETALT,ZETALU &
411 & ,ZETAT,ZETAU,ZQ,ZSLT,ZSLU,ZT,ZU,TOPOTERM,ZZIL
412 REAL :: CZIL,ZILFC
413 !
414 !*** DIAGNOSTICS
415 !
416 REAL :: AKHS02,AKHS10,AKMS02,AKMS10,EKMS10,QSAT10,QSAT2 &
417 & ,RLNT02,RLNT10,RLNU10,SIMH02,SIMH10,SIMM10,T02,T10 &
418 & ,TERM1,RLOW,WSTAR,XLT02,XLT024,XLT10 &
419 & ,XLT104,XLU10,XLU104,XU10,XU104,ZT02,ZT10,ZTAT02,ZTAT10 &
420 & ,ZTAU,ZTAU10,ZU10,ZUUZ
421 !----------------------------------------------------------------------
422 !**********************************************************************
423 !----------------------------------------------------------------------
424 RDZ=1./ZSL
425 CXCHL=EXCML*RDZ
426 CXCHS=EXCMS*RDZ
427 !
428 BTGX=G/THLOW
429 ELFC=VKARMAN*BTGX
430 !
431 IF(PBLH>1000.)THEN
432 BTGH=BTGX*PBLH
433 ELSE
434 BTGH=BTGX*1000.
435 ENDIF
436 !
437 !----------------------------------------------------------------------
438 !
439 !*** SEA POINTS
440 !
441 !----------------------------------------------------------------------
442 !
443 IF(SEAMASK>0.5)THEN
444 !
445 !----------------------------------------------------------------------
446 DO ITR=1,ITRMX
447 !----------------------------------------------------------------------
448 Z0=MAX(USTFC*USTAR*USTAR,1.59E-5)
449 !
450 !*** VISCOUS SUBLAYER, JANJIC MWR 1994
451 !
452 !----------------------------------------------------------------------
453 IF(USTAR<USTC)THEN
454 !----------------------------------------------------------------------
455 !
456 IF(USTAR<USTR)THEN
457 !
458 #if ( NMM_CORE == 1 )
459 if(NTSD+1.eq.1) then
460 #else
461 IF(NTSD==1)THEN
462 #endif
463 !tgs IF(NTSD==1)THEN
464 AKMS=CXCHS
465 AKHS=CXCHS
466 QS=QLOW
467 ENDIF
468 !
469 ZU=FZU1*SQRT(SQRT(Z0*USTAR*RVISC))/USTAR
470 WGHT=AKMS*ZU*RVISC
471 RWGH=WGHT/(WGHT+1.)
472 UZ0=(ULOW*RWGH+UZ0)*0.5
473 VZ0=(VLOW*RWGH+VZ0)*0.5
474 !
475 ZT=FZT1*ZU
476 ZQ=FZQ1*ZT
477 WGHTT=AKHS*ZT*RTVISC
478 WGHTQ=AKHS*ZQ*RQVISC
479 !
480 #if ( NMM_CORE == 1 )
481 if(NTSD+1>1) then
482 #else
483 IF(NTSD>1)THEN
484 #endif
485 !tgs IF(NTSD>1)THEN
486 THZ0=((WGHTT*THLOW+THS)/(WGHTT+1.)+THZ0)*0.5
487 QZ0=((WGHTQ*QLOW+QS)/(WGHTQ+1.)+QZ0)*0.5
488 ELSE
489 THZ0=(WGHTT*THLOW+THS)/(WGHTT+1.)
490 QZ0=(WGHTQ*QLOW+QS)/(WGHTQ+1.)
491 ENDIF
492 !
493 ENDIF
494 !
495 IF(USTAR>=USTR.AND.USTAR<USTC)THEN
496 ZU=Z0
497 UZ0=0.
498 VZ0=0.
499 !
500 ZT=FZT2*SQRT(SQRT(Z0*USTAR*RVISC))/USTAR
501 ZQ=FZQ2*ZT
502 WGHTT=AKHS*ZT*RTVISC
503 WGHTQ=AKHS*ZQ*RQVISC
504 !
505 #if ( NMM_CORE == 1 )
506 if(NTSD+1>1) then
507 #else
508 IF(NTSD>1)THEN
509 #endif
511 !tgs IF(NTSD>1)THEN
512 THZ0=((WGHTT*THLOW+THS)/(WGHTT+1.)+THZ0)*0.5
513 QZ0=((WGHTQ*QLOW+QS)/(WGHTQ+1.)+QZ0)*0.5
514 ELSE
515 THZ0=(WGHTT*THLOW+THS)/(WGHTT+1.)
516 QZ0=(WGHTQ*QLOW+QS)/(WGHTQ+1.)
517 ENDIF
518 !
519 ENDIF
520 !----------------------------------------------------------------------
521 ELSE
522 !----------------------------------------------------------------------
523 ZU=Z0
524 UZ0=0.
525 VZ0=0.
526 !
527 ZT=Z0
528 THZ0=THS
529 !
530 ZQ=Z0
531 QZ0=QS
532 !----------------------------------------------------------------------
533 ENDIF
534 !----------------------------------------------------------------------
535 TEM=(TLOW+TZ0)*0.5
536 THM=(THELOW+THZ0)*0.5
537 !
538 A=THM*P608
539 B=(ELOCP/TEM-1.-P608)*THM
540 !
541 DTHV=((THELOW-THZ0)*((QLOW+QZ0+CWMLOW)*(0.5*P608)+1.) &
542 & +(QLOW-QZ0+CWMLOW)*A+CWMLOW*B)
543 !
544 DU2=MAX((ULOW-UZ0)**2+(VLOW-VZ0)**2,EPSU2)
545 RIB=BTGX*DTHV*ZSL/DU2
546 !----------------------------------------------------------------------
547 ! IF(RIB>=RIC)THEN
548 !----------------------------------------------------------------------
549 ! AKMS=MAX( VISC*RDZ,CXCHS)
550 ! AKHS=MAX(TVISC*RDZ,CXCHS)
551 !----------------------------------------------------------------------
552 ! ELSE ! turbulent branch
553 !----------------------------------------------------------------------
554 ZSLU=ZSL+ZU
555 ZSLT=ZSL+ZT
556 !
557 RZSU=ZSLU/ZU
558 RZST=ZSLT/ZT
559 !
560 RLOGU=LOG(RZSU)
561 RLOGT=LOG(RZST)
562 !
563 !----------------------------------------------------------------------
564 !*** 1./MONIN-OBUKHOV LENGTH
565 !----------------------------------------------------------------------
566 !
567 RLMO=ELFC*AKHS*DTHV/USTAR**3
568 !
569 ZETALU=ZSLU*RLMO
570 ZETALT=ZSLT*RLMO
571 ZETAU=ZU*RLMO
572 ZETAT=ZT*RLMO
573 !
574 ZETALU=MIN(MAX(ZETALU,ZTMIN1),ZTMAX1)
575 ZETALT=MIN(MAX(ZETALT,ZTMIN1),ZTMAX1)
576 ZETAU=MIN(MAX(ZETAU,ZTMIN1/RZSU),ZTMAX1/RZSU)
577 ZETAT=MIN(MAX(ZETAT,ZTMIN1/RZST),ZTMAX1/RZST)
578 !
579 !----------------------------------------------------------------------
580 !*** WATER FUNCTIONS
581 !----------------------------------------------------------------------
582 !
583 RZ=(ZETAU-ZTMIN1)/DZETA1
584 K=INT(RZ)
585 RDZT=RZ-REAL(K)
586 K=MIN(K,KZTM2)
587 K=MAX(K,0)
588 PSMZ=(PSIM1(K+2)-PSIM1(K+1))*RDZT+PSIM1(K+1)
589 !
590 RZ=(ZETALU-ZTMIN1)/DZETA1
591 K=INT(RZ)
592 RDZT=RZ-REAL(K)
593 K=MIN(K,KZTM2)
594 K=MAX(K,0)
595 PSMZL=(PSIM1(K+2)-PSIM1(K+1))*RDZT+PSIM1(K+1)
596 !
597 SIMM=PSMZL-PSMZ+RLOGU
598 !
599 RZ=(ZETAT-ZTMIN1)/DZETA1
600 K=INT(RZ)
601 RDZT=RZ-REAL(K)
602 K=MIN(K,KZTM2)
603 K=MAX(K,0)
604 PSHZ=(PSIH1(K+2)-PSIH1(K+1))*RDZT+PSIH1(K+1)
605 !
606 RZ=(ZETALT-ZTMIN1)/DZETA1
607 K=INT(RZ)
608 RDZT=RZ-REAL(K)
609 K=MIN(K,KZTM2)
610 K=MAX(K,0)
611 PSHZL=(PSIH1(K+2)-PSIH1(K+1))*RDZT+PSIH1(K+1)
612 !
613 SIMH=(PSHZL-PSHZ+RLOGT)*FH01
615 !----------------------------------------------------------------------
616 USTARK=USTAR*VKARMAN
617 !!!!!!!!!!!!!!!!!!!!!
618 AKMS=MAX(USTARK/SIMM,CXCHS)
619 AKHS=MAX(USTARK/SIMH,CXCHS)
620 !
621 !----------------------------------------------------------------------
622 !*** BELJAARS CORRECTION FOR USTAR
623 !----------------------------------------------------------------------
624 !
625 IF(DTHV<=0.)THEN !zj
626 WSTAR2=WWST2*ABS(BTGH*AKHS*DTHV)**(2./3.) !zj
627 ELSE !zj
628 WSTAR2=0. !zj
629 ENDIF !zj
630 USTAR=MAX(SQRT(AKMS*SQRT(DU2+WSTAR2)),EPSUST)
631 !
632 !----------------------------------------------------------------------
633 ! ENDIF ! End of turbulent branch
634 !----------------------------------------------------------------------
635 !
636 ENDDO ! End of the iteration loop over sea points
637 !
638 !----------------------------------------------------------------------
639 !
640 !*** LAND POINTS
641 !
642 !----------------------------------------------------------------------
643 !
644 ELSE
645 !
646 !----------------------------------------------------------------------
647 IF(NTSD==1)THEN
648 QS=QLOW
649 ENDIF
650 !
651 ZU=Z0
652 UZ0=0.
653 VZ0=0.
654 !
655 ZT=ZU*ZTFC
656 THZ0=THS
657 !
658 ZQ=ZT
659 QZ0=QS
660 !----------------------------------------------------------------------
661 TEM=(TLOW+TZ0)*0.5
662 THM=(THELOW+THZ0)*0.5
663 !
664 A=THM*P608
665 B=(ELOCP/TEM-1.-P608)*THM
666 !
667 DTHV=((THELOW-THZ0)*((QLOW+QZ0+CWMLOW)*(0.5*P608)+1.) &
668 & +(QLOW-QZ0+CWMLOW)*A+CWMLOW*B)
669 !
670 DU2=MAX((ULOW-UZ0)**2+(VLOW-VZ0)**2,EPSU2)
671 RIB=BTGX*DTHV*ZSL/DU2
672 !----------------------------------------------------------------------
673 ! IF(RIB>=RIC)THEN
674 ! AKMS=MAX( VISC*RDZ,CXCHL)
675 ! AKHS=MAX(TVISC*RDZ,CXCHL)
676 !----------------------------------------------------------------------
677 ! ELSE ! Turbulent branch
678 !----------------------------------------------------------------------
679 ZSLU=ZSL+ZU
680 !
681 RZSU=ZSLU/ZU
682 !
683 RLOGU=LOG(RZSU)
685 ZSLT=ZSL+ZU ! u,v and t are at the same level
687 !-- BSF on 10/19/2011: Added new IF-ELSE block but commented out until
688 ! final matter is resolved.
689 !BSF IF ( (IZ0TLND==0) .or. (VEGTYP == ISURBAN) ) THEN
690 !BSF ! Just use the original CZIL value.
691 !BSF CZIL = 0.1
692 !BSF ELSE
693 !BSF ! Modify CZIL according to Chen & Zhang, 2009
694 !BSF ! CZIL = 10 ** -0.40 H, ( where H = 10*Zo )
695 !BSF CZIL = 10.0 ** ( -0.40 * ( Z0 / 0.07 ) )
696 !BSF ENDIF
697 CZIL=0.1
698 ZILFC=-CZIL*VKARMAN*SQVISC
700 !----------------------------------------------------------------------
701 !
702 !mp Topo modification of ZILFC term
703 !
704 ! TOPOTERM=TOPOFAC*ZSFC**2.
705 ! TOPOTERM=MAX(TOPOTERM,3.0)
706 !
707 ! RIB modification to ZILFC term
708 !
709 ! CZETMAX = 20.
710 CZETMAX = 10.
711 ! stable
712 IF(DTHV>0.)THEN
713 ! ZZIL=ZILFC*TOPOTERM
714 IF (RIB<RIC) THEN
715 ZZIL=ZILFC*(1.0+(RIB/RIC)*(RIB/RIC)*CZETMAX)
716 ELSE
717 ZZIL=ZILFC*(1.0+CZETMAX)
718 ENDIF
719 ! unstable
720 ELSE
721 ZZIL=ZILFC
722 ENDIF
723 !
724 !----------------------------------------------------------------------
725 !
726 land_point_iteration: DO ITR=1,ITRMX
727 !
728 !----------------------------------------------------------------------
729 !*** ZILITINKEVITCH FIX FOR ZT
730 !----------------------------------------------------------------------
731 !
732 ! oldform ZT=MAX(EXP(ZZIL*SQRT(USTAR*ZU))*ZU,EPSZT)
733 ZT=MAX(EXP(ZZIL*SQRT(USTAR*Z0BASE))*Z0BASE,EPSZT)
734 !
735 RZST=ZSLT/ZT
736 RLOGT=LOG(RZST)
737 !
738 !----------------------------------------------------------------------
739 !*** 1./MONIN-OBUKHOV LENGTH-SCALE
740 !----------------------------------------------------------------------
741 !
742 RLMO=ELFC*AKHS*DTHV/USTAR**3
743 ZETALU=ZSLU*RLMO
744 ZETALT=ZSLT*RLMO
745 ZETAU=ZU*RLMO
746 ZETAT=ZT*RLMO
747 !
748 ZETALU=MIN(MAX(ZETALU,ZTMIN2),ZTMAX2)
749 ZETALT=MIN(MAX(ZETALT,ZTMIN2),ZTMAX2)
750 ZETAU=MIN(MAX(ZETAU,ZTMIN2/RZSU),ZTMAX2/RZSU)
751 ZETAT=MIN(MAX(ZETAT,ZTMIN2/RZST),ZTMAX2/RZST)
752 !
753 !----------------------------------------------------------------------
754 !*** LAND FUNCTIONS
755 !----------------------------------------------------------------------
756 !
757 RZ=(ZETAU-ZTMIN2)/DZETA2
758 K=INT(RZ)
759 RDZT=RZ-REAL(K)
760 K=MIN(K,KZTM2)
761 K=MAX(K,0)
762 PSMZ=(PSIM2(K+2)-PSIM2(K+1))*RDZT+PSIM2(K+1)
763 !
764 RZ=(ZETALU-ZTMIN2)/DZETA2
765 K=INT(RZ)
766 RDZT=RZ-REAL(K)
767 K=MIN(K,KZTM2)
768 K=MAX(K,0)
769 PSMZL=(PSIM2(K+2)-PSIM2(K+1))*RDZT+PSIM2(K+1)
770 !
771 SIMM=PSMZL-PSMZ+RLOGU
772 !
773 RZ=(ZETAT-ZTMIN2)/DZETA2
774 K=INT(RZ)
775 RDZT=RZ-REAL(K)
776 K=MIN(K,KZTM2)
777 K=MAX(K,0)
778 PSHZ=(PSIH2(K+2)-PSIH2(K+1))*RDZT+PSIH2(K+1)
779 !
780 RZ=(ZETALT-ZTMIN2)/DZETA2
781 K=INT(RZ)
782 RDZT=RZ-REAL(K)
783 K=MIN(K,KZTM2)
784 K=MAX(K,0)
785 PSHZL=(PSIH2(K+2)-PSIH2(K+1))*RDZT+PSIH2(K+1)
786 !
787 SIMH=(PSHZL-PSHZ+RLOGT)*FH02
788 !----------------------------------------------------------------------
789 USTARK=USTAR*VKARMAN
790 AKMS=MAX(USTARK/SIMM,CXCHL)
791 AKHS=MAX(USTARK/SIMH,CXCHL)
792 !
793 !----------------------------------------------------------------------
794 !*** BELJAARS CORRECTION FOR USTAR
795 !----------------------------------------------------------------------
796 !
797 IF(DTHV<=0.)THEN !zj
798 WSTAR2=WWST2*ABS(BTGH*AKHS*DTHV)**(2./3.) !zj
799 ELSE !zj
800 WSTAR2=0. !zj
801 ENDIF !zj
802 !
803 USTAR=MAX(SQRT(AKMS*SQRT(DU2+WSTAR2)),EPSUST)
804 !
805 !----------------------------------------------------------------------
806 ENDDO land_point_iteration
807 !----------------------------------------------------------------------
808 !
809 ! ENDIF ! End of turbulant branch over land
810 !
811 !----------------------------------------------------------------------
812 !
813 ENDIF ! End of land/sea branch
814 !
815 !----------------------------------------------------------------------
816 !*** COUNTERGRADIENT FIX
817 !----------------------------------------------------------------------
818 !
819 ! HV=-AKHS*DTHV
820 ! IF(HV>0.)THEN
821 ! FCT=-10.*(BTGX)**(-1./3.)
822 ! CT=FCT*(HV/(PBLH*PBLH))**(2./3.)
823 ! ELSE
824 CT=0.
825 ! ENDIF
826 !
827 !----------------------------------------------------------------------
828 !----------------------------------------------------------------------
829 !*** THE FOLLOWING DIAGNOSTIC BLOCK PRODUCES 2-m and 10-m VALUES
830 !*** FOR TEMPERATURE, MOISTURE, AND WINDS. IT IS DONE HERE SINCE
831 !*** THE VARIOUS QUANTITIES NEEDED FOR THE COMPUTATION ARE LOST
832 !*** UPON EXIT FROM THE ROTUINE.
833 !----------------------------------------------------------------------
834 !----------------------------------------------------------------------
835 !
836 WSTAR=SQRT(WSTAR2)/WWST
837 !
838 UMFLX=AKMS*(ULOW -UZ0 )
839 VMFLX=AKMS*(VLOW -VZ0 )
840 HSFLX=AKHS*(THLOW-THZ0)
841 HLFLX=AKHS*(QLOW -QZ0 )
842 !----------------------------------------------------------------------
843 ! IF(RIB>=RIC)THEN
844 !----------------------------------------------------------------------
845 ! IF(SEAMASK>0.5)THEN
846 ! AKMS10=MAX( VISC/10.,CXCHS)
847 ! AKHS02=MAX(TVISC/02.,CXCHS)
848 ! AKHS10=MAX(TVISC/10.,CXCHS)
849 ! ELSE
850 ! AKMS10=MAX( VISC/10.,CXCHL)
851 ! AKHS02=MAX(TVISC/02.,CXCHL)
852 ! AKHS10=MAX(TVISC/10.,CXCHL)
853 ! ENDIF
854 !----------------------------------------------------------------------
855 ! ELSE
856 !----------------------------------------------------------------------
857 ZU10=ZU+10.
858 ZT02=ZT+02.
859 ZT10=ZT+10.
860 !
861 RLNU10=LOG(ZU10/ZU)
862 RLNT02=LOG(ZT02/ZT)
863 RLNT10=LOG(ZT10/ZT)
864 !
865 ZTAU10=ZU10*RLMO
866 ZTAT02=ZT02*RLMO
867 ZTAT10=ZT10*RLMO
868 !
869 !----------------------------------------------------------------------
870 !*** SEA
871 !----------------------------------------------------------------------
872 !
873 IF(SEAMASK>0.5)THEN
874 !
875 !----------------------------------------------------------------------
876 ZTAU10=MIN(MAX(ZTAU10,ZTMIN1),ZTMAX1)
877 ZTAT02=MIN(MAX(ZTAT02,ZTMIN1),ZTMAX1)
878 ZTAT10=MIN(MAX(ZTAT10,ZTMIN1),ZTMAX1)
879 !----------------------------------------------------------------------
880 RZ=(ZTAU10-ZTMIN1)/DZETA1
881 K=INT(RZ)
882 RDZT=RZ-REAL(K)
883 K=MIN(K,KZTM2)
884 K=MAX(K,0)
885 PSM10=(PSIM1(K+2)-PSIM1(K+1))*RDZT+PSIM1(K+1)
886 !
887 SIMM10=PSM10-PSMZ+RLNU10
888 !
889 RZ=(ZTAT02-ZTMIN1)/DZETA1
890 K=INT(RZ)
891 RDZT=RZ-REAL(K)
892 K=MIN(K,KZTM2)
893 K=MAX(K,0)
894 PSH02=(PSIH1(K+2)-PSIH1(K+1))*RDZT+PSIH1(K+1)
895 !
896 SIMH02=(PSH02-PSHZ+RLNT02)*FH01
897 !
898 RZ=(ZTAT10-ZTMIN1)/DZETA1
899 K=INT(RZ)
900 RDZT=RZ-REAL(K)
901 K=MIN(K,KZTM2)
902 K=MAX(K,0)
903 PSH10=(PSIH1(K+2)-PSIH1(K+1))*RDZT+PSIH1(K+1)
904 !
905 SIMH10=(PSH10-PSHZ+RLNT10)*FH01
906 !
907 AKMS10=MAX(USTARK/SIMM10,CXCHS)
908 AKHS02=MAX(USTARK/SIMH02,CXCHS)
909 AKHS10=MAX(USTARK/SIMH10,CXCHS)
910 !
911 !----------------------------------------------------------------------
912 !*** LAND
913 !----------------------------------------------------------------------
914 !
915 ELSE
916 !
917 !----------------------------------------------------------------------
918 ZTAU10=MIN(MAX(ZTAU10,ZTMIN2),ZTMAX2)
919 ZTAT02=MIN(MAX(ZTAT02,ZTMIN2),ZTMAX2)
920 ZTAT10=MIN(MAX(ZTAT10,ZTMIN2),ZTMAX2)
921 !----------------------------------------------------------------------
922 RZ=(ZTAU10-ZTMIN2)/DZETA2
923 K=INT(RZ)
924 RDZT=RZ-REAL(K)
925 K=MIN(K,KZTM2)
926 K=MAX(K,0)
927 PSM10=(PSIM2(K+2)-PSIM2(K+1))*RDZT+PSIM2(K+1)
928 !
929 SIMM10=PSM10-PSMZ+RLNU10
930 !
931 RZ=(ZTAT02-ZTMIN2)/DZETA2
932 K=INT(RZ)
933 RDZT=RZ-REAL(K)
934 K=MIN(K,KZTM2)
935 K=MAX(K,0)
936 PSH02=(PSIH2(K+2)-PSIH2(K+1))*RDZT+PSIH2(K+1)
937 !
938 SIMH02=(PSH02-PSHZ+RLNT02)*FH02
939 !
940 RZ=(ZTAT10-ZTMIN2)/DZETA2
941 K=INT(RZ)
942 RDZT=RZ-REAL(K)
943 K=MIN(K,KZTM2)
944 K=MAX(K,0)
945 PSH10=(PSIH2(K+2)-PSIH2(K+1))*RDZT+PSIH2(K+1)
946 !
947 SIMH10=(PSH10-PSHZ+RLNT10)*FH02
948 !
949 AKMS10=MAX(USTARK/SIMM10,CXCHL)
950 AKHS02=MAX(USTARK/SIMH02,CXCHL)
951 AKHS10=MAX(USTARK/SIMH10,CXCHL)
952 !----------------------------------------------------------------------
953 ENDIF
954 !----------------------------------------------------------------------
955 ! ENDIF
956 !----------------------------------------------------------------------
957 U10 =UMFLX/AKMS10+UZ0
958 V10 =VMFLX/AKMS10+VZ0
959 TH02=HSFLX/AKHS02+THZ0
960 !
961 !*** BE CERTAIN THAT THE 2-M THETA AND 10-M THETA ARE BRACKETED BY
962 !*** THE VALUES OF THZ0 AND THLOW.
963 !
964 IF(THLOW>THZ0.AND.(TH02<THZ0.OR.TH02>THLOW).OR. &
965 THLOW<THZ0.AND.(TH02>THZ0.OR.TH02<THLOW))THEN
966 TH02=THZ0+2.*RDZ*(THLOW-THZ0)
967 ENDIF
968 !
969 TH10=HSFLX/AKHS10+THZ0
970 !
971 IF(THLOW>THZ0.AND.(TH10<THZ0.OR.TH10>THLOW).OR. &
972 THLOW<THZ0.AND.(TH10>THZ0.OR.TH10<THLOW))THEN
973 TH10=THZ0+10.*RDZ*(THLOW-THZ0)
974 ENDIF
975 !
976 Q02 =HLFLX/AKHS02+QZ0
977 Q10 =HLFLX/AKHS10+QZ0
978 TERM1=-0.068283/TLOW
979 PSHLTR=PSFC*EXP(TERM1)
980 !
981 !----------------------------------------------------------------------
982 !*** COMPUTE "EQUIVALENT" Z0 TO APPROXIMATE LOCAL SHELTER READINGS.
983 !----------------------------------------------------------------------
984 !
985 U10E=U10
986 V10E=V10
987 !
988 IF(SEAMASK<0.5)THEN
990 !1st ZUUZ=MIN(0.5*ZU,0.1)
991 !1st ZU=MAX(0.1*ZU,ZUUZ)
992 !tst ZUUZ=amin1(ZU*0.50,0.3)
993 !tst ZU=amax1(ZU*0.3,ZUUZ)
995 ZUUZ=AMIN1(ZU*0.50,0.18)
996 ZU=AMAX1(ZU*0.35,ZUUZ)
997 !
998 ZU10=ZU+10.
999 RZSU=ZU10/ZU
1000 RLNU10=LOG(RZSU)
1002 ZETAU=ZU*RLMO
1003 ZTAU10=ZU10*RLMO
1005 ZTAU10=MIN(MAX(ZTAU10,ZTMIN2),ZTMAX2)
1006 ZETAU=MIN(MAX(ZETAU,ZTMIN2/RZSU),ZTMAX2/RZSU)
1008 RZ=(ZTAU10-ZTMIN2)/DZETA2
1009 K=INT(RZ)
1010 RDZT=RZ-REAL(K)
1011 K=MIN(K,KZTM2)
1012 K=MAX(K,0)
1013 PSM10=(PSIM2(K+2)-PSIM2(K+1))*RDZT+PSIM2(K+1)
1014 SIMM10=PSM10-PSMZ+RLNU10
1015 EKMS10=MAX(USTARK/SIMM10,CXCHL)
1017 U10E=UMFLX/EKMS10+UZ0
1018 V10E=VMFLX/EKMS10+VZ0
1020 ENDIF
1021 !
1022 ! U10=U10E
1023 ! V10=V10E
1024 !
1025 !----------------------------------------------------------------------
1026 !*** SET OTHER WRF DRIVER ARRAYS
1027 !----------------------------------------------------------------------
1028 !
1029 RLOW=PLOW/(R_D*TLOW)
1030 CHS=AKHS
1031 CHS2=AKHS02
1032 CQS2=AKHS02
1033 HFX=-RLOW*CP*HSFLX
1034 QFX=-RLOW*HLFLX*WETM
1035 FLX_LH=XLV*QFX
1036 FLHC=RLOW*CP*AKHS
1037 FLQC=RLOW*AKHS*WETM
1038 !!! QGH=PQ0/PSHLTR*EXP(A2S*(TSK-A3S)/(TSK-A4S))
1039 QGH=((1.-SEAMASK)*PQ0+SEAMASK*PQ0SEA) &
1040 & /PLOW*EXP(A2S*(TLOW-A3S)/(TLOW-A4S))
1041 QGH=QGH/(1.-QGH) !Convert to mixing ratio
1042 CPM=CP*(1.+0.8*QLOW)
1043 !
1044 !*** DO NOT COMPUTE QS OVER LAND POINTS HERE SINCE IT IS
1045 !*** A PROGNOSTIC VARIABLE THERE. IT IS OKAY TO USE IT
1046 !*** AS A DIAGNOSTIC OVER WATER SINCE IT WILL CAUSE NO
1047 !*** INTERFERENCE BEFORE BEING RECOMPUTED IN MYJPBL.
1048 !
1049 IF(SEAMASK>0.5)THEN
1050 QS=PQ0SEA/PSFC &
1051 & *EXP(A2S*(TSK-A3S)/(TSK-A4S))
1052 QS=QS/(1.-QS)
1053 ENDIF
1054 !----------------------------------------------------------------------
1055 !
1056 END SUBROUTINE SFCDIF
1057 !
1058 !----------------------------------------------------------------------
1059 SUBROUTINE MYJSFCINIT(LOWLYR,USTAR,Z0 &
1060 & ,SEAMASK,XICE,IVGTYP,RESTART &
1061 & ,ALLOWED_TO_READ &
1062 & ,IDS,IDE,JDS,JDE,KDS,KDE &
1063 & ,IMS,IME,JMS,JME,KMS,KME &
1064 & ,ITS,ITE,JTS,JTE,KTS,KTE)
1065 !----------------------------------------------------------------------
1066 IMPLICIT NONE
1067 !----------------------------------------------------------------------
1068 LOGICAL,INTENT(IN) :: RESTART,ALLOWED_TO_READ
1069 !
1070 INTEGER,INTENT(IN) :: IDS,IDE,JDS,JDE,KDS,KDE &
1071 & ,IMS,IME,JMS,JME,KMS,KME &
1072 & ,ITS,ITE,JTS,JTE,KTS,KTE
1073 !
1074 INTEGER,DIMENSION(IMS:IME,JMS:JME),INTENT(IN) :: IVGTYP
1075 !
1076 INTEGER,DIMENSION(IMS:IME,JMS:JME),INTENT(INOUT) :: LOWLYR
1077 !
1078 REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(IN) :: SEAMASK,XICE
1079 !
1080 REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(INOUT) :: USTAR,Z0
1081 !
1082 REAL,DIMENSION(0:30) :: VZ0TBL
1083 REAL,DIMENSION(0:30) :: VZ0TBL_24
1084 !
1085 INTEGER :: I,IDUM,IRECV,J,JDUM,K,ITF,JTF,KTF,MAXGBL_IVGTYP &
1086 &, MAXLOC_IVGTYP,MPI_COMM_COMP
1087 !
1088 ! INTEGER :: MPI_INTEGER,MPI_MAX
1089 !
1090 REAL :: SM,X,ZETA1,ZETA2,ZRNG1,ZRNG2
1091 !
1092 REAL :: PIHF=3.1415926/2.,EPS=1.E-6
1093 !----------------------------------------------------------------------
1094 VZ0TBL= &
1095 & (/0., &
1096 & 2.653,0.826,0.563,1.089,0.854,0.856,0.035,0.238,0.065,0.076 &
1097 & ,0.011,0.035,0.011,0.000,0.000,0.000,0.000,0.000,0.000,0.000 &
1098 & ,0.000,0.000,0.000,0.000,0.000,0.000,0.000,0.000,0.000,0.000/)
1100 VZ0TBL_24= (/0., &
1101 & 1.00, 0.07, 0.07, 0.07, 0.07, 0.15, &
1102 & 0.08, 0.03, 0.05, 0.86, 0.80, 0.85, &
1103 & 2.65, 1.09, 0.80, 0.001, 0.04, 0.05, &
1104 & 0.01, 0.04, 0.06, 0.05, 0.03, 0.001, &
1105 & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000 /)
1107 !----------------------------------------------------------------------
1108 !
1109 JTF=MIN0(JTE,JDE-1)
1110 KTF=MIN0(KTE,KDE-1)
1111 ITF=MIN0(ITE,IDE-1)
1112 !
1113 !
1114 !*** FOR NOW, ASSUME SIGMA MODE FOR LOWEST MODEL LAYER
1115 !
1116 DO J=JTS,JTF
1117 DO I=ITS,ITF
1118 LOWLYR(I,J)=1
1119 ! USTAR(I,J)=EPSUST
1120 ENDDO
1121 ENDDO
1122 !----------------------------------------------------------------------
1123 #if (NMM_CORE == 1)
1124 !
1125 IF(.NOT.RESTART)THEN
1126 ! CALL WRF_GET_DM_COMMUNICATOR(MPI_COMM_COMP)
1127 ! MAXLOC_IVGTYP=MAXVAL(IVGTYP)
1128 ! CALL MPI_ALLREDUCE(MAXLOC_IVGTYP,MAXGBL_IVGTYP,1,MPI_INTEGER &
1129 ! &, MPI_MAX,MPI_COMM_COMP,IRECV)
1130 MAXGBL_IVGTYP=MAXVAL(IVGTYP)
1131 #ifdef DM_PARALLEL
1132 CALL WRF_DM_MAXVAL(MAXGBL_IVGTYP,IDUM,JDUM)
1133 #endif
1134 !
1135 IF (MAXGBL_IVGTYP<13) THEN
1136 DO J=JTS,JTE
1137 DO I=ITS,ITE
1138 SM=SEAMASK(I,J)-1.
1139 IF(SM+XICE(I,J)<0.5)THEN
1140 Z0(I,J)=VZ0TBL(IVGTYP(I,J))
1141 ENDIF
1142 ENDDO
1143 ENDDO
1144 !
1145 ELSE
1146 !
1147 DO J=JTS,JTE
1148 DO I=ITS,ITE
1149 SM=SEAMASK(I,J)-1.
1150 IF(SM+XICE(I,J)<0.5)THEN
1151 Z0(I,J)=VZ0TBL_24(IVGTYP(I,J))
1152 ENDIF
1153 ENDDO
1154 ENDDO
1155 !
1156 ENDIF ! Vegtype check
1157 !
1158 ENDIF ! Restart check
1160 #endif
1161 !----------------------------------------------------------------------
1162 IF(.NOT.RESTART)THEN
1163 DO J=JTS,JTE
1164 DO I=ITS,ITF
1165 USTAR(I,J)=0.1
1166 ENDDO
1167 ENDDO
1168 ENDIF
1169 !----------------------------------------------------------------------
1170 !
1171 !*** COMPUTE SURFACE LAYER INTEGRAL FUNCTIONS
1172 !
1173 !----------------------------------------------------------------------
1174 FH01=1.
1175 FH02=1.
1176 !
1177 ! ZTMIN1=-10.0
1178 ! ZTMAX1=2.0
1179 ! ZTMIN2=-10.0
1180 ! ZTMAX2=2.0
1181 ZTMIN1=-5.0
1182 ZTMAX1=1.0
1183 ZTMIN2=-5.0
1184 ZTMAX2=1.0
1185 !
1186 ZRNG1=ZTMAX1-ZTMIN1
1187 ZRNG2=ZTMAX2-ZTMIN2
1188 !
1189 DZETA1=ZRNG1/(KZTM-1)
1190 DZETA2=ZRNG2/(KZTM-1)
1191 !
1192 !----------------------------------------------------------------------
1193 !*** FUNCTION DEFINITION LOOP
1194 !----------------------------------------------------------------------
1195 !
1196 ZETA1=ZTMIN1
1197 ZETA2=ZTMIN2
1198 !
1199 DO K=1,KZTM
1200 !
1201 !----------------------------------------------------------------------
1202 !*** UNSTABLE RANGE
1203 !----------------------------------------------------------------------
1204 !
1205 IF(ZETA1<0.)THEN
1206 !
1207 !----------------------------------------------------------------------
1208 !*** PAULSON 1970 FUNCTIONS
1209 !----------------------------------------------------------------------
1210 X=SQRT(SQRT(1.-16.*ZETA1))
1211 !
1212 PSIM1(K)=-2.*LOG((X+1.)/2.)-LOG((X*X+1.)/2.)+2.*ATAN(X)-PIHF
1213 PSIH1(K)=-2.*LOG((X*X+1.)/2.)
1214 !
1215 !----------------------------------------------------------------------
1216 !*** STABLE RANGE
1217 !----------------------------------------------------------------------
1218 !
1219 ELSE
1220 !
1221 !----------------------------------------------------------------------
1222 !*** PAULSON 1970 FUNCTIONS
1223 !----------------------------------------------------------------------
1224 !
1225 ! PSIM1(K)=5.*ZETA1
1226 ! PSIH1(K)=5.*ZETA1
1227 !----------------------------------------------------------------------
1228 !*** HOLTSLAG AND DE BRUIN 1988
1229 !----------------------------------------------------------------------
1230 !
1231 PSIM1(K)=0.7*ZETA1+0.75*ZETA1*(6.-0.35*ZETA1)*EXP(-0.35*ZETA1)
1232 PSIH1(K)=0.7*ZETA1+0.75*ZETA1*(6.-0.35*ZETA1)*EXP(-0.35*ZETA1)
1233 !----------------------------------------------------------------------
1234 !
1235 ENDIF
1236 !
1237 !----------------------------------------------------------------------
1238 !*** UNSTABLE RANGE
1239 !----------------------------------------------------------------------
1240 !
1241 IF(ZETA2<0.)THEN
1242 !
1243 !----------------------------------------------------------------------
1244 !*** PAULSON 1970 FUNCTIONS
1245 !----------------------------------------------------------------------
1246 !
1247 X=SQRT(SQRT(1.-16.*ZETA2))
1248 !
1249 PSIM2(K)=-2.*LOG((X+1.)/2.)-LOG((X*X+1.)/2.)+2.*ATAN(X)-PIHF
1250 PSIH2(K)=-2.*LOG((X*X+1.)/2.)
1251 !----------------------------------------------------------------------
1252 !*** STABLE RANGE
1253 !----------------------------------------------------------------------
1254 !
1255 ELSE
1256 !
1257 !----------------------------------------------------------------------
1258 !*** PAULSON 1970 FUNCTIONS
1259 !----------------------------------------------------------------------
1260 !
1261 ! PSIM2(K)=5.*ZETA2
1262 ! PSIH2(K)=5.*ZETA2
1263 !
1264 !----------------------------------------------------------------------
1265 !*** HOLTSLAG AND DE BRUIN 1988
1266 !----------------------------------------------------------------------
1267 !
1268 PSIM2(K)=0.7*ZETA2+0.75*ZETA2*(6.-0.35*ZETA2)*EXP(-0.35*ZETA2)
1269 PSIH2(K)=0.7*ZETA2+0.75*ZETA2*(6.-0.35*ZETA2)*EXP(-0.35*ZETA2)
1270 !----------------------------------------------------------------------
1271 !
1272 ENDIF
1273 !
1274 !----------------------------------------------------------------------
1275 IF(K==KZTM)THEN
1276 ZTMAX1=ZETA1
1277 ZTMAX2=ZETA2
1278 ENDIF
1279 !
1280 ZETA1=ZETA1+DZETA1
1281 ZETA2=ZETA2+DZETA2
1282 !----------------------------------------------------------------------
1283 ENDDO
1284 !----------------------------------------------------------------------
1285 ZTMAX1=ZTMAX1-EPS
1286 ZTMAX2=ZTMAX2-EPS
1287 !----------------------------------------------------------------------
1288 !
1289 END SUBROUTINE MYJSFCINIT
1290 !
1291 !----------------------------------------------------------------------
1292 !
1293 END MODULE MODULE_SF_MYJSFC
1294 !
1295 !----------------------------------------------------------------------