| blob | 85a5f6b30253c991873d0e6c4d8325df2b13034b |
1 !-----------------------------------------------------------------------
2 !
3 !NCEP_MESO:MODEL_LAYER: HORIZONTAL DIFFUSION
4 !
5 !-----------------------------------------------------------------------
6 !
7 #include "nmm_loop_basemacros.h"
8 #include "nmm_loop_macros.h"
9 !
10 !-----------------------------------------------------------------------
11 !
12 MODULE MODULE_DIFFUSION_NMM
13 !
14 !-----------------------------------------------------------------------
15 USE MODULE_MODEL_CONSTANTS
16 USE MODULE_CONFIGURE, ONLY : GRID_CONFIG_REC_TYPE
17 USE MODULE_STATE_DESCRIPTION
18 !-----------------------------------------------------------------------
19 !
20 LOGICAL :: SECOND=.TRUE.
21 INTEGER :: KSMUD=1
22 !
23 !-----------------------------------------------------------------------
24 !
25 CONTAINS
26 !
27 !***********************************************************************
28 SUBROUTINE HDIFF(NTSD,DT,FIS,DY,HDAC,HDACV &
29 & ,HBM2,DETA1,SIGMA &
30 #ifdef HWRF
31 & ,T,Q,U,V,Q2,Z,W,SM,SICE,h_diff &
32 #else
33 & ,T,Q,U,V,Q2,Z,W,SM,SICE &
34 #endif
35 & ,DEF3D &
36 & ,IHE,IHW,IVE,IVW &
37 & ,CONFIG_FLAGS &
38 & ,IDS,IDE,JDS,JDE,KDS,KDE &
39 & ,IMS,IME,JMS,JME,KMS,KME &
40 & ,ITS,ITE,JTS,JTE,KTS,KTE)
41 !***********************************************************************
42 !$$$ SUBPROGRAM DOCUMENTATION BLOCK
43 ! . . .
44 ! SUBPROGRAM: HDIFF HORIZONTAL DIFFUSION
45 ! PRGRMMR: JANJIC ORG: W/NP22 DATE: 93-11-17
46 !
47 ! ABSTRACT:
48 ! HDIFF CALCULATES THE CONTRIBUTION OF THE HORIZONTAL DIFFUSION
49 ! TO THE TENDENCIES OF TEMPERATURE, SPECIFIC HUMIDITY, WIND
50 ! COMPONENTS, AND TURBULENT KINETIC ENERGY AND THEN UPDATES THOSE
51 ! VARIABLES. A SECOND-ORDER NONLINEAR SCHEME SIMILAR TO
52 ! SMAGORINSKY'S IS USED WHERE THE DIFFUSION COEFFICIENT IS
53 ! A FUNCTION OF THE DEFORMATION FIELD AND OF THE TURBULENT
54 ! KINETIC ENERGY.
55 !
56 ! PROGRAM HISTORY LOG:
57 ! 87-06-?? JANJIC - ORIGINATOR
58 ! 95-03-25 BLACK - CONVERSION FROM 1-D TO 2-D IN HORIZONTAL
59 ! 96-03-28 BLACK - ADDED EXTERNAL EDGE
60 ! 98-10-30 BLACK - MODIFIED FOR DISTRIBUTED MEMORY
61 ! 02-02-07 BLACK - CONVERTED TO WRF STRUCTURE
62 ! 02-08-29 MICHALAKES -
63 ! 02-09-06 WOLFE -
64 ! 03-05-27 JANJIC - ADDED SLOPE ADJUSTMENT
65 ! 04-11-18 BLACK - THREADED
66 ! 05-12-12 BLACK - CONVERTED FROM IKJ TO IJK
67 ! 06-08-15 JANJIC - ENHANCEMENT AT SLOPING SEA COAST
68 !
69 ! USAGE: CALL HDIFF FROM SUBROUTINE SOLVE_RUNSTREAM
70 !
71 ! INPUT ARGUMENT LIST:
72 !
73 ! OUTPUT ARGUMENT LIST:
74 !
75 ! OUTPUT FILES:
76 ! NONE
77 !
78 ! SUBPROGRAMS CALLED:
79 !
80 ! UNIQUE: NONE
81 !
82 ! LIBRARY: NONE
83 !
84 ! ATTRIBUTES:
85 ! LANGUAGE: FORTRAN 90
86 ! MACHINE : IBM SP
87 !$$$
88 !***********************************************************************
89 !-----------------------------------------------------------------------
90 !
91 IMPLICIT NONE
92 !
93 !-----------------------------------------------------------------------
94 !
95 !*** STRUCTURE THAT CONTAINS RUN-TIME CONFIGURATION (NAMELIST) DATA FOR DOMAIN
96 !
97 TYPE(GRID_CONFIG_REC_TYPE),INTENT(IN) :: CONFIG_FLAGS
98 !
99 INTEGER,INTENT(IN) :: IDS,IDE,JDS,JDE,KDS,KDE &
100 & ,IMS,IME,JMS,JME,KMS,KME &
101 & ,ITS,ITE,JTS,JTE,KTS,KTE
102 !
103 INTEGER,INTENT(IN) :: NTSD
104 !
105 REAL,INTENT(IN) :: DT,DY
106 #ifdef HWRF
107 REAL,INTENT(IN) :: H_DIFF
108 #endif
109 !
110 REAL,DIMENSION(KMS:KME),INTENT(IN) :: DETA1
111 !
112 REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(IN) :: FIS,HBM2 &
113 & ,HDAC,HDACV &
114 & ,SM,SICE
115 !
116 REAL,DIMENSION(IMS:IME,JMS:JME,KMS:KME),INTENT(OUT) :: DEF3D
117 !
118 REAL,DIMENSION(IMS:IME,JMS:JME,KMS:KME),INTENT(IN) :: W,Z
119 !
120 REAL,DIMENSION(IMS:IME,JMS:JME,KMS:KME),INTENT(INOUT) :: T,Q,Q2 &
121 & ,U,V
122 !
123 INTEGER, DIMENSION(JMS:JME), INTENT(IN) :: IHE,IHW,IVE,IVW
124 !
125 !-----------------------------------------------------------------------
126 !
127 INTEGER,INTENT(IN) :: SIGMA
128 !
129 !-----------------------------------------------------------------------
130 !*** LOCAL VARIABLES
131 !-----------------------------------------------------------------------
132 !
133 INTEGER :: I,J,K,KS
134 !
135 REAL :: DEF_IJ,DEFSK,DEFTK,HKNE_IJ,HKSE_IJ,Q2L,RDY,SLOP,SLOPHC &
136 & ,UTK,VKNE_IJ,VKSE_IJ,VTK,DEF1,DEF2,DEF3,DEF4
137 !
138 REAL,DIMENSION(ITS-5:ITE+5,JTS-5:JTE+5) :: DEF,HKNE,HKSE &
139 & ,Q2DIF,Q2NE,Q2SE &
140 & ,QDIF,QNE,QSE,SNE,SSE &
141 & ,TDIF,TNE,TSE &
142 & ,UDIF,UNE,USE &
143 & ,VDIF,VKNE,VKSE,VNE,VSE
144 !
145 LOGICAL :: CILINE,WATSLOP
146 !
147 !-----------------------------------------------------------------------
148 !***********************************************************************
149 !-----------------------------------------------------------------------
150 !
151 #ifdef HWRF
152 SLOPHC=SLOPHT*SQRT(2.)*0.5*9.
153 #else
154 SLOPHC=config_flags%slophc
155 #endif
156 RDY=1./DY
157 !
158 DO J=JTS-5,JTE+5
159 DO I=ITS-5,ITE+5
160 DEF(I,J)=0.
161 TNE(I,J)=0.
162 QNE(I,J)=0.
163 Q2NE(I,J)=0.
164 HKNE(I,J)=0.
165 UNE(I,J)=0.
166 VNE(I,J)=0.
167 VKNE(I,J)=0.
168 TSE(I,J)=0.
169 QSE(I,J)=0.
170 Q2SE(I,J)=0.
171 HKSE(I,J)=0.
172 USE(I,J)=0.
173 VSE(I,J)=0.
174 VKSE(I,J)=0.
175 ENDDO
176 ENDDO
177 !
178 !-----------------------------------------------------------------------
179 !***
180 !*** DIFFUSING Q2 AT GROUND LEVEL DOES NOT MATTER
181 !*** BECAUSE USTAR2 IS RECALCULATED.
182 !***
183 !-----------------------------------------------------------------------
184 !*** ITERATION LOOP
185 !-----------------------------------------------------------------------
186 !
187 DO 600 KS=1,KSMUD
188 !
189 !-----------------------------------------------------------------------
190 !-----------------------------------------------------------------------
191 !*** MAIN INTEGRATION LOOP
192 !-----------------------------------------------------------------------
193 !-----------------------------------------------------------------------
194 !$omp parallel do &
195 !$omp& private(def1,def2,def3,def4,def_ij,defsk,deftk,hkne_ij,hkse_ij &
196 !$omp& ,i,j,k,q2dif,q2ne,q2se,qdif,qne,qse,slop,sne,sse &
197 !$omp& ,tdif,tne,tse,udif,une,use,vdif,vkne,vkne_ij &
198 !$omp& ,vkse,vkse_ij,vne,vse)
199 !-----------------------------------------------------------------------
200 !
201 main_integration : DO K=KTS,KTE
203 DO J=JMS,JME
204 DO I=IMS,IME
205 DEF3D(I,J,K)=0.
206 ENDDO
207 ENDDO
208 !
209 !-----------------------------------------------------------------------
210 !*** SLOPE SWITCHES FOR MOISTURE
211 !-----------------------------------------------------------------------
212 !
213 IF(SIGMA==1)THEN
214 !
215 !-----------------------------------------------------------------------
216 !*** PRESSURE DOMAIN
217 !-----------------------------------------------------------------------
218 !
219 IF(DETA1(K)>0.)THEN
220 DO J=MYJS_P1,MYJE1_P2
221 DO I=MYIS_P1,MYIE1_P1
222 SNE(I,J)=1.
223 ENDDO
224 ENDDO
225 !
226 DO J=MYJS1_P1,MYJE_P2
227 DO I=MYIS_P1,MYIE1_P1
228 SSE(I,J)=1.
229 ENDDO
230 ENDDO
231 !
232 !-----------------------------------------------------------------------
233 !*** SIGMA DOMAIN
234 !-----------------------------------------------------------------------
235 !
236 ELSE
237 DO J=MYJS_P1,MYJE1_P1
238 DO I=MYIS_P1,MYIE1_P1
239 SLOP=ABS((Z(I+IHE(J),J+1,K)-Z(I,J,K))*RDY)
240 !
241 CILINE=((SM(I+IHE(J),J+1)/=SM(I,J)).OR. &
242 (SICE(I+IHE(J),J+1)/=SICE(I,J)))
243 !
244 WATSLOP=(SM(I+IHE(J),J+1)==1.0.AND. &
245 SM(I,J)==1.0.AND.SLOP/=0.)
246 !
247 IF(SLOP<SLOPHC.OR.CILINE.OR.WATSLOP)THEN
248 SNE(I,J)=1.
249 ELSE
250 SNE(I,J)=0.
251 ENDIF
252 ENDDO
253 ENDDO
254 !
255 DO J=MYJS1_P1,MYJE_P1
256 DO I=MYIS_P1,MYIE1_P1
257 SLOP=ABS((Z(I+IHE(J),J-1,K)-Z(I,J,K))*RDY)
258 !
259 CILINE=((SM(I+IHE(J),J-1)/=SM(I,J)).OR. &
260 (SICE(I+IHE(J),J-1)/=SICE(I,J)))
261 !
262 WATSLOP=(SM(I+IHE(J),J-1)==1.0.AND. &
263 SM(I,J)==1.0.AND.SLOP/=0.)
264 !
265 IF(SLOP<SLOPHC.OR.CILINE.OR.WATSLOP)THEN
266 SSE(I,J)=1.
267 ELSE
268 SSE(I,J)=0.
269 ENDIF
270 ENDDO
271 ENDDO
272 ENDIF
273 !
274 ENDIF
275 !-----------------------------------------------------------------------
276 !*** DEFORMATIONS
277 !-----------------------------------------------------------------------
278 !
279 DO J=MYJS_P1,MYJE_P1
280 DO I=MYIS_P1,MYIE_P1
281 !
282 DEFTK=U(I+IHE(J),J,K)-U(I+IHW(J),J,K) &
283 & -V(I,J+1,K)+V(I,J-1,K)
284 DEFSK=U(I,J+1,K)-U(I,J-1,K) &
285 & +V(I+IHE(J),J,K)-V(I+IHW(J),J,K)
286 DEF1=(W(I+IHW(J),J-1,K)-W(I,J,K))*0.5
287 DEF2=(W(I+IHE(J),J-1,K)-W(I,J,K))*0.5
288 DEF3=(W(I+IHW(J),J+1,K)-W(I,J,K))*0.5
289 DEF4=(W(I+IHE(J),J+1,K)-W(I,J,K))*0.5
290 Q2L=Q2(I,J,K)
291 IF(Q2L<=EPSQ2)Q2L=0.
292 IF ( CONFIG_FLAGS%BL_PBL_PHYSICS == MYJPBLSCHEME) then
293 DEF_IJ=DEFTK*DEFTK+DEFSK*DEFSK+DEF1*DEF1+DEF2*DEF2 &
294 & +DEF3*DEF3+DEF4*DEF4+SCQ2*Q2L
295 else
296 DEF_IJ=DEFTK*DEFTK+DEFSK*DEFSK+DEF1*DEF1+DEF2*DEF2 &
297 & +DEF3*DEF3+DEF4*DEF4
298 ENDIF
300 DEF_IJ=SQRT(DEF_IJ+DEF_IJ)*HBM2(I,J)
301 DEF_IJ=MAX(DEF_IJ,DEFC)
302 DEF_IJ=MIN(DEF_IJ,DEFM)
303 DEF_IJ=DEF_IJ*0.1
304 DEF(I,J)=DEF_IJ
305 DEF3D(I,J,K)=DEF_IJ
306 ENDDO
307 ENDDO
308 !
309 !-----------------------------------------------------------------------
310 !*** DIAGONAL CONTRIBUTIONS
311 !-----------------------------------------------------------------------
312 !
313 DO J=MYJS_P1,MYJE1_P1
314 DO I=MYIS_P1,MYIE1_P1
315 HKNE_IJ=(DEF(I,J)+DEF(I+IHE(J),J+1))*SNE(I,J)
316 TNE (I,J)=(T (I+IHE(J),J+1,K)-T (I,J,K))*HKNE_IJ
317 QNE (I,J)=(Q (I+IHE(J),J+1,K)-Q (I,J,K))*HKNE_IJ
318 Q2NE(I,J)=(Q2(I+IHE(J),J+1,K)-Q2(I,J,K))*HKNE_IJ
319 HKNE(I,J)=HKNE_IJ
320 !
321 VKNE_IJ=DEF(I+IVE(J),J)+DEF(I,J+1)
322 UNE(I,J)=(U(I+IVE(J),J+1,K)-U(I,J,K))*VKNE_IJ
323 VNE(I,J)=(V(I+IVE(J),J+1,K)-V(I,J,K))*VKNE_IJ
324 VKNE(I,J)=VKNE_IJ
325 ENDDO
326 ENDDO
327 !
328 DO J=MYJS1_P1,MYJE_P1
329 DO I=MYIS_P1,MYIE1_P1
330 HKSE_IJ=(DEF(I+IHE(J),J-1)+DEF(I,J))*SSE(I,J)
331 TSE (I,J)=(T (I+IHE(J),J-1,K)-T (I,J,K))*HKSE_IJ
332 QSE (I,J)=(Q (I+IHE(J),J-1,K)-Q (I,J,K))*HKSE_IJ
333 Q2SE(I,J)=(Q2(I+IHE(J),J-1,K)-Q2(I,J,K))*HKSE_IJ
334 HKSE(I,J)=HKSE_IJ
335 !
336 VKSE_IJ=DEF(I,J-1)+DEF(I+IVE(J),J)
337 USE(I,J)=(U(I+IVE(J),J-1,K)-U(I,J,K))*VKSE_IJ
338 VSE(I,J)=(V(I+IVE(J),J-1,K)-V(I,J,K))*VKSE_IJ
339 VKSE(I,J)=VKSE_IJ
340 ENDDO
341 ENDDO
342 !-----------------------------------------------------------------------
343 !
344 DO J=MYJS1,MYJE1
345 DO I=MYIS1,MYIE
346 TDIF (I,J)=(TNE (I,J)-TNE (I+IHW(J),J-1) &
347 & +TSE (I,J)-TSE (I+IHW(J),J+1))*HDAC(I,J)
348 QDIF (I,J)=(QNE (I,J)-QNE (I+IHW(J),J-1) &
349 & +QSE (I,J)-QSE (I+IHW(J),J+1))*HDAC(I,J)*FCDIF
350 Q2DIF(I,J)=(Q2NE(I,J)-Q2NE(I+IHW(J),J-1) &
351 & +Q2SE(I,J)-Q2SE(I+IHW(J),J+1))*HDAC(I,J)
352 !
353 UDIF(I,J)=(UNE(I,J)-UNE(I+IVW(J),J-1) &
354 & +USE(I,J)-USE(I+IVW(J),J+1))*HDACV(I,J)
355 VDIF(I,J)=(VNE(I,J)-VNE(I+IVW(J),J-1) &
356 & +VSE(I,J)-VSE(I+IVW(J),J+1))*HDACV(I,J)
357 ENDDO
358 ENDDO
359 !
360 !-----------------------------------------------------------------------
361 !*** 2ND ORDER DIFFUSION
362 !-----------------------------------------------------------------------
363 !
364 IF(SECOND)THEN
365 DO J=MYJS2,MYJE2
366 DO I=MYIS1,MYIE1
367 T (I,J,K)=T (I,J,K)+TDIF (I,J)
368 Q (I,J,K)=Q (I,J,K)+QDIF (I,J)
369 !
370 #ifdef HWRF
371 U(I,J,K)=U(I,J,K)+UDIF(I,J)*h_diff
372 V(I,J,K)=V(I,J,K)+VDIF(I,J)*h_diff
373 #else
374 U(I,J,K)=U(I,J,K)+UDIF(I,J)
375 V(I,J,K)=V(I,J,K)+VDIF(I,J)
376 #endif
377 ENDDO
378 ENDDO
379 !
380 !-----------------------------------------------------------------------
381 IF(K>=KTS+1)THEN
382 DO J=MYJS2,MYJE2
383 DO I=MYIS1,MYIE1
384 Q2(I,J,K)=Q2(I,J,K)+Q2DIF(I,J)
385 ENDDO
386 ENDDO
387 ENDIF
388 !
389 !-----------------------------------------------------------------------
390 !*** 4TH ORDER DIAGONAL CONTRIBUTIONS
391 !-----------------------------------------------------------------------
392 !
393 ELSE
394 !
395 DO J=MYJS,MYJE1
396 DO I=MYIS,MYIE1
397 HKNE_IJ=HKNE(I,J)
398 TNE (I,J)=(TDIF (I+IHE(J),J+1)-TDIF (I,J))*HKNE_IJ
399 QNE (I,J)=(QDIF (I+IHE(J),J+1)-QDIF (I,J))*HKNE_IJ
400 Q2NE(I,J)=(Q2DIF(I+IHE(J),J+1)-Q2DIF(I,J))*HKNE_IJ
401 ENDDO
402 ENDDO
403 !
404 DO J=MYJS1,MYJE
405 DO I=MYIS,MYIE1
406 HKSE_IJ=HKSE(I,J)
407 TSE (I,J)=(TDIF (I+IHE(J),J-1)-TDIF (I,J))*HKSE_IJ
408 QSE (I,J)=(QDIF (I+IHE(J),J-1)-QDIF (I,J))*HKSE_IJ
409 Q2SE(I,J)=(Q2DIF(I+IHE(J),J-1)-Q2DIF(I,J))*HKSE_IJ
410 ENDDO
411 ENDDO
412 !
413 DO J=MYJS2,MYJE2
414 DO I=MYIS1,MYIE1
415 T(I,J,K)=T(I,J,K)-(TNE(I,J)-TNE(I+IHW(J),J-1) &
416 & +TSE(I,J)-TSE(I+IHW(J),J+1))*HDAC(I,J)
417 Q(I,J,K)=Q(I,J,K)-(QNE(I,J)-QNE(I+IHW(J),J-1) &
418 & +QSE(I,J)-QSE(I+IHW(J),J+1))*HDAC(I,J) &
419 & *FCDIF
420 ENDDO
421 ENDDO
423 !
424 IF(K>=KTS+1)THEN
425 DO J=MYJS2,MYJE2
426 DO I=MYIS1,MYIE1
427 Q2(I,J,K)=Q2(I,J,K)-(Q2NE(I,J)-Q2NE(I+IHW(J),J-1) &
428 & +Q2SE(I,J)-Q2SE(I+IHW(J),J+1)) &
429 & *HDAC(I,J)
430 ENDDO
431 ENDDO
432 ENDIF
433 !
434 !-----------------------------------------------------------------------
435 !
436 DO J=MYJS,MYJE1
437 DO I=MYIS,MYIE1
438 UNE(I,J)=(UDIF(I+IVE(J),J+1)-UDIF(I,J))*VKNE(I,J)
439 VNE(I,J)=(VDIF(I+IVE(J),J+1)-VDIF(I,J))*VKNE(I,J)
440 ENDDO
441 ENDDO
442 !
443 DO J=MYJS1,MYJE
444 DO I=MYIS,MYIE1
445 USE(I,J)=(UDIF(I+IVE(J),J-1)-UDIF(I,J))*VKSE(I,J)
446 VSE(I,J)=(VDIF(I+IVE(J),J-1)-VDIF(I,J))*VKSE(I,J)
447 ENDDO
448 ENDDO
449 !
450 DO J=MYJS2,MYJE2
451 DO I=MYIS1,MYIE1
452 #ifdef HWRF
453 U(I,J,K)=U(I,J,K)-(UNE(I,J)-UNE(I+IVW(J),J-1) &
454 & +USE(I,J)-USE(I+IVW(J),J+1))*HDACV(I,J)*h_diff
455 V(I,J,K)=V(I,J,K)-(VNE(I,J)-VNE(I+IVW(J),J-1) &
456 & +VSE(I,J)-VSE(I+IVW(J),J+1))*HDACV(I,J)*h_diff
457 #else
458 U(I,J,K)=U(I,J,K)-(UNE(I,J)-UNE(I+IVW(J),J-1) &
459 & +USE(I,J)-USE(I+IVW(J),J+1))*HDACV(I,J)
460 V(I,J,K)=V(I,J,K)-(VNE(I,J)-VNE(I+IVW(J),J-1) &
461 & +VSE(I,J)-VSE(I+IVW(J),J+1))*HDACV(I,J)
462 #endif
463 ENDDO
464 ENDDO
465 !
466 !-----------------------------------------------------------------------
467 ENDIF ! End 4th order diffusion
468 !-----------------------------------------------------------------------
469 !
470 ENDDO main_integration
471 !
472 !-----------------------------------------------------------------------
473 !
474 600 CONTINUE
475 !
476 !-----------------------------------------------------------------------
477 !
478 END SUBROUTINE HDIFF
479 !
480 !-----------------------------------------------------------------------
481 !
482 END MODULE MODULE_DIFFUSION_NMM
483 !
484 !-----------------------------------------------------------------------