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