module_DIFFUSION_NMM.F
References to this file elsewhere.
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 !-----------------------------------------------------------------------
17 !
18 LOGICAL :: SECOND=.TRUE.
19 INTEGER :: KSMUD=1
20 !
21 !-----------------------------------------------------------------------
22 !
23 CONTAINS
24 !
25 !***********************************************************************
26 SUBROUTINE HDIFF(NTSD,DT,FIS,DY,HDAC,HDACV &
27 & ,HTM,HBM2,VTM,DETA1,SIGMA &
28 & ,T,Q,U,V,Q2,Z,W,SM,SICE &
29 & ,IHE,IHW,IVE,IVW,INDX3_WRK &
30 & ,IDS,IDE,JDS,JDE,KDS,KDE &
31 & ,IMS,IME,JMS,JME,KMS,KME &
32 & ,ITS,ITE,JTS,JTE,KTS,KTE)
33 !***********************************************************************
34 !$$$ SUBPROGRAM DOCUMENTATION BLOCK
35 ! . . .
36 ! SUBPROGRAM: HDIFF HORIZONTAL DIFFUSION
37 ! PRGRMMR: JANJIC ORG: W/NP22 DATE: 93-11-17
38 !
39 ! ABSTRACT:
40 ! HDIFF CALCULATES THE CONTRIBUTION OF THE HORIZONTAL DIFFUSION
41 ! TO THE TENDENCIES OF TEMPERATURE, SPECIFIC HUMIDITY, WIND
42 ! COMPONENTS, AND TURBULENT KINETIC ENERGY AND THEN UPDATES THOSE
43 ! VARIABLES. A SECOND-ORDER NONLINEAR SCHEME SIMILAR TO
44 ! SMAGORINSKY'S IS USED WHERE THE DIFFUSION COEFFICIENT IS
45 ! A FUNCTION OF THE DEFORMATION FIELD AND OF THE TURBULENT
46 ! KINETIC ENERGY.
47 !
48 ! PROGRAM HISTORY LOG:
49 ! 87-06-?? JANJIC - ORIGINATOR
50 ! 95-03-25 BLACK - CONVERSION FROM 1-D TO 2-D IN HORIZONTAL
51 ! 96-03-28 BLACK - ADDED EXTERNAL EDGE
52 ! 98-10-30 BLACK - MODIFIED FOR DISTRIBUTED MEMORY
53 ! 02-02-07 BLACK - CONVERTED TO WRF STRUCTURE
54 ! 02-08-29 MICHALAKES -
55 ! 02-09-06 WOLFE -
56 ! 03-05-27 JANJIC - ADDED SLOPE ADJUSTMENT
57 ! 04-11-18 BLACK - THREADED
58 ! 06-08-15 JANJIC - ENHANCEMENT AT SLOPING SEA COAST
59 !
60 ! USAGE: CALL HDIFF FROM SUBROUTINE SOLVE_RUNSTREAM
61 !
62 ! INPUT ARGUMENT LIST:
63 !
64 ! OUTPUT ARGUMENT LIST:
65 !
66 ! OUTPUT FILES:
67 ! NONE
68 !
69 ! SUBPROGRAMS CALLED:
70 !
71 ! UNIQUE: NONE
72 !
73 ! LIBRARY: NONE
74 !
75 ! ATTRIBUTES:
76 ! LANGUAGE: FORTRAN 90
77 ! MACHINE : IBM SP
78 !$$$
79 !***********************************************************************
80 !-----------------------------------------------------------------------
81 !
82 IMPLICIT NONE
83 !
84 !-----------------------------------------------------------------------
85 !
86 INTEGER,INTENT(IN) :: IDS,IDE,JDS,JDE,KDS,KDE &
87 & ,IMS,IME,JMS,JME,KMS,KME &
88 & ,ITS,ITE,JTS,JTE,KTS,KTE
89 !
90 INTEGER,INTENT(IN) :: NTSD
91 !
92 REAL,INTENT(IN) :: DT,DY
93 !
94 REAL,DIMENSION(KMS:KME),INTENT(IN) :: DETA1
95 !
96 REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(IN) :: FIS,HBM2 &
97 & ,HDAC,HDACV &
98 & ,SM,SICE
99 !
100 REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(IN) :: HTM,VTM,Z,W
101 !
102 REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(INOUT) :: T,Q,Q2 &
103 & ,U,V
104 !
105 INTEGER, DIMENSION(JMS:JME), INTENT(IN) :: IHE,IHW,IVE,IVW
106 !
107 !-----------------------------------------------------------------------
108 !!!!!!!!!!!!!!!!!!!!!!!!!!!! IMPORTANT !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
109 !*** NMM_MAX_DIM is set in configure.wrf and must agree with
110 !*** the value of dimspec q in the Registry/Registry.
111 !!!!!!!!!!!!!!!!!!!!!!!!!!!! IMPORTANT !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
112 !-----------------------------------------------------------------------
113 !
114 INTEGER,DIMENSION(-3:3,NMM_MAX_DIM,0:6),INTENT(IN) :: INDX3_WRK
115 !
116 INTEGER,INTENT(IN) :: SIGMA
117 !
118 !-----------------------------------------------------------------------
119 !
120 !*** LOCAL VARIABLES
121 !
122 LOGICAL :: CILINE,WATSLOP
123 !
124 INTEGER :: I,J,J1_P1,J1_P2,J2_00,J2_M1,J2_P1,J3_00,J3_P1,J3_P2 &
125 & ,J4_00,J4_M1,J4_M2,J4_P1,J4_P2,JJ,JKNT,JSTART,K,KS
126 !
127 REAL :: DEF_J,DEFSK,DEFTK,HKNE_J,HKSE_J,Q2L,RDY,SLOP,SLOPHC &
128 & ,UTK,VKNE_J,VKSE_J,VTK,DEF1,DEF2,DEF3,DEF4
129 !
130 REAL,DIMENSION(ITS-5:ITE+5,KTS:KTE) :: Q2L_IK,SNE,SSE
131 !
132 !*** TYPE 1 WORKING ARRAY (SEE PFDHT)
133 !
134 REAL,DIMENSION(ITS-5:ITE+5,KTS:KTE,-2:2) :: DEF
135 !
136 !*** TYPE 2 WORKING ARRAY (SEE PFDHT)
137 !
138 REAL,DIMENSION(ITS-5:ITE+5,KTS:KTE,-2:1) :: HKNE,QNE,Q2NE,TNE &
139 & ,UNE,VKNE,VNE
140 !
141 !*** TYPE 3 WORKING ARRAY (SEE PFDHT)
142 !
143 REAL,DIMENSION(ITS-5:ITE+5,KTS:KTE,-1:2) :: HKSE,QSE,Q2SE,TSE &
144 & ,USE,VKSE,VSE
145 !
146 !*** TYPE 4 WORKING ARRAY (SEE PFDHT)
147 !
148 REAL,DIMENSION(ITS-5:ITE+5,KTS:KTE,-1:1) :: CKE,QDIF,Q2DIF &
149 & ,TDIF,UDIF,VDIF
150 !
151 !-----------------------------------------------------------------------
152 !***********************************************************************
153 !-----------------------------------------------------------------------
154 !
155 JSTART=MYJS2
156 !-----------------------------------------------------------------------
157 !
158 SLOPHC=SLOPHT*SQRT(2.)*0.5*9.
159 RDY=1./DY
160 !
161 !-----------------------------------------------------------------------
162 !***
163 !*** DIFFUSING Q2 AT GROUND LEVEL DOES NOT MATTER
164 !*** BECAUSE USTAR2 IS RECALCULATED
165 !***
166 !-----------------------------------------------------------------------
167 !*** MARCH NORTHWARD THROUGH THE SOUTHERNMOST SLABS TO BEGIN
168 !*** FILLING THE MAIN WORKING ARRAYS WHICH ARE MULTI-DIMENSIONED
169 !*** IN J BECAUSE THEY ARE DIFFERENCED OR AVERAGED IN J.
170 !-----------------------------------------------------------------------
171 !
172 DO J=-2,2
173 DO K=KTS,KTE
174 DO I=ITS-5,ITE+5
175 DEF(I,K,J)=0.
176 ENDDO
177 ENDDO
178 ENDDO
179 !
180 DO J=-2,1
181 DO K=KTS,KTE
182 DO I=ITS-5,ITE+5
183 TNE(I,K,J)=0.
184 QNE(I,K,J)=0.
185 Q2NE(I,K,J)=0.
186 HKNE(I,K,J)=0.
187 UNE(I,K,J)=0.
188 VNE(I,K,J)=0.
189 VKNE(I,K,J)=0.
190 ENDDO
191 ENDDO
192 ENDDO
193 !
194 DO J=-1,2
195 DO K=KTS,KTE
196 DO I=ITS-5,ITE+5
197 TSE(I,K,J)=0.
198 QSE(I,K,J)=0.
199 Q2SE(I,K,J)=0.
200 HKSE(I,K,J)=0.
201 USE(I,K,J)=0.
202 VSE(I,K,J)=0.
203 VKSE(I,K,J)=0.
204 ENDDO
205 ENDDO
206 ENDDO
207 !-----------------------------------------------------------------------
208 !
209 !$omp parallel do &
210 !$omp& private(def_j,def1,def2,def3,def4,defsk,deftk,i,j,jj,k,q2l)
211 DO J=-2,1
212 JJ=JSTART+J
213 !
214 DO K=KTS,KTE
215
216 DO I=MYIS_P1,MYIE_P1
217 DEFTK=U(I+IHE(JJ),K,JJ)-U(I+IHW(JJ),K,JJ) &
218 & -V(I,K,JJ+1)+V(I,K,JJ-1)
219 DEFSK=U(I,K,JJ+1)-U(I,K,JJ-1) &
220 & +V(I+IHE(JJ),K,JJ)-V(I+IHW(JJ),K,JJ)
221 Q2L=MAX(Q2(I,K,JJ),EPSQ2)
222 IF(Q2L<=EPSQ2)Q2L=0.
223 !
224 DEF1=W(I+IHW(JJ),K,JJ-1)-W(I,K,JJ)
225 DEF2=W(I+IHE(JJ),K,JJ-1)-W(I,K,JJ)
226 DEF3=W(I+IHW(JJ),K,JJ+1)-W(I,K,JJ)
227 DEF4=W(I+IHE(JJ),K,JJ+1)-W(I,K,JJ)
228 !
229 DEF_J=DEFTK*DEFTK+DEFSK*DEFSK+DEF1*DEF1+DEF2*DEF2+ &
230 & DEF3*DEF3+DEF4*DEF4+SCQ2*Q2L
231 DEF_J=SQRT(DEF_J+DEF_J)*HBM2(I,JJ)
232 DEF_J=MAX(DEF_J,DEFC)
233 DEF_J=MIN(DEF_J,DEFM)
234 DEF_J=DEF_J*0.1
235 DEF(I,K,J)=DEF_J
236 ENDDO
237 ENDDO
238 !
239 ENDDO
240 !-----------------------------------------------------------------------
241 !
242 !$omp parallel do &
243 !$omp& private(hkne_j,i,j,jj,k,slop,sne,vkne_j)
244 DO J=-2,0
245 JJ=JSTART+J
246 !
247 !-----------------------------------------------------------------------
248 !*** SLOPE SWITCHES FOR MOISTURE
249 !-----------------------------------------------------------------------
250 !
251 IF(SIGMA==1)THEN
252 DO K=KTS,KTE
253 !
254 !-----------------------------------------------------------------------
255 !*** PRESSURE DOMAIN
256 !-----------------------------------------------------------------------
257 !
258 IF(DETA1(K)>0.)THEN
259 DO I=MYIS_P1,MYIE1_P1
260 SNE(I,K)=1.
261 ENDDO
262 !
263 !-----------------------------------------------------------------------
264 !*** SIGMA DOMAIN
265 !-----------------------------------------------------------------------
266 !
267 ELSE
268 DO I=MYIS_P1,MYIE1_P1
269 SLOP=ABS((Z(I+IHE(JJ),K,JJ+1)-Z(I,K,JJ))*RDY)
270 !
271 CILINE=((SM(I+IHE(JJ),JJ+1)/=SM(I,JJ)) .OR. &
272 (SICE(I+IHE(JJ),JJ+1)/=SICE(I,JJ)))
273 !
274 WATSLOP=(SM(I+IHE(JJ),JJ+1)==1.0 .AND. &
275 SM(I,JJ)==1.0 .AND. SLOP/=0.)
276 !
277 IF(SLOP<SLOPHC .OR. CILINE .OR. WATSLOP)THEN
278 SNE(I,K)=1.
279 ELSE
280 SNE(I,K)=0.
281 ENDIF
282 !
283 ENDDO
284 ENDIF
285 !
286 ENDDO
287 ENDIF
288 !
289 DO K=KTS,KTE
290 DO I=MYIS_P1,MYIE1_P1
291 HKNE_J=(DEF(I,K,J)+DEF(I+IHE(JJ),K,J+1)) &
292 & *HTM(I,K,JJ)*HTM(I+IHE(JJ),K,JJ+1)*SNE(I,K)
293 TNE (I,K,J)=(T (I+IHE(JJ),K,JJ+1)-T (I,K,JJ))*HKNE_J
294 QNE (I,K,J)=(Q (I+IHE(JJ),K,JJ+1)-Q (I,K,JJ))*HKNE_J
295 Q2NE(I,K,J)=(Q2(I+IHE(JJ),K,JJ+1)-Q2(I,K,JJ))*HKNE_J
296 HKNE(I,K,J)=HKNE_J
297 !
298 VKNE_J=(DEF(I+IVE(JJ),K,J)+DEF(I,K,J+1)) &
299 & *VTM(I,K,JJ)*VTM(I+IVE(JJ),K,JJ+1)
300 UNE(I,K,J)=(U(I+IVE(JJ),K,JJ+1)-U(I,K,JJ))*VKNE_J
301 VNE(I,K,J)=(V(I+IVE(JJ),K,JJ+1)-V(I,K,JJ))*VKNE_J
302 VKNE(I,K,J)=VKNE_J
303 ENDDO
304 ENDDO
305 !
306 ENDDO
307 !-----------------------------------------------------------------------
308 !
309 !$omp parallel do &
310 !$omp& private(hkse_j,i,j,jj,k,slop,sse,vkse_j)
311 DO J=-1,1
312 JJ=JSTART+J
313 !
314 !-----------------------------------------------------------------------
315 !*** SLOPE SWITCHES FOR MOISTURE
316 !-----------------------------------------------------------------------
317 !
318 IF(SIGMA==1)THEN
319 DO K=KTS,KTE
320 !
321 !-----------------------------------------------------------------------
322 !*** PRESSURE DOMAIN
323 !-----------------------------------------------------------------------
324 !
325 IF(DETA1(K)>0.)THEN
326 DO I=MYIS_P1,MYIE1_P1
327 SSE(I,K)=1.
328 ENDDO
329 !
330 !-----------------------------------------------------------------------
331 !*** SIGMA DOMAIN
332 !-----------------------------------------------------------------------
333 !
334 ELSE
335 DO I=MYIS_P1,MYIE1_P1
336 SLOP=ABS((Z(I+IHE(JJ),K,JJ-1)-Z(I,K,JJ))*RDY)
337 !
338 CILINE=((SM(I+IHE(JJ),JJ-1)/=SM(I,JJ)) .OR. &
339 (SICE(I+IHE(JJ),JJ-1)/=SICE(I,JJ)))
340 !
341 WATSLOP=(SM(I+IHE(JJ),JJ-1)==1.0 .AND. &
342 SM(I,JJ)==1.0 .AND. SLOP/=0.)
343 !
344 IF(SLOP<SLOPHC .OR. CILINE .OR. WATSLOP)THEN
345 SSE(I,K)=1.
346 ELSE
347 SSE(I,K)=0.
348 ENDIF
349 ENDDO
350 !
351 ENDIF
352 !
353 ENDDO
354 ENDIF
355 !
356 DO K=KTS,KTE
357 DO I=MYIS_P1,MYIE1_P1
358 HKSE_J=(DEF(I+IHE(JJ),K,J-1)+DEF(I,K,J)) &
359 & *HTM(I+IHE(JJ),K,JJ-1)*HTM(I,K,JJ)*SSE(I,K)
360 TSE (I,K,J)=(T (I+IHE(JJ),K,JJ-1)-T (I,K,JJ))*HKSE_J
361 QSE (I,K,J)=(Q (I+IHE(JJ),K,JJ-1)-Q (I,K,JJ))*HKSE_J
362 Q2SE(I,K,J)=(Q2(I+IHE(JJ),K,JJ-1)-Q2(I,K,JJ))*HKSE_J
363 HKSE(I,K,J)=HKSE_J
364 !
365 VKSE_J=(DEF(I,K,J-1)+DEF(I+IVE(JJ),K,J)) &
366 & *VTM(I+IVE(JJ),K,JJ-1)*VTM(I,K,JJ)
367 USE(I,K,J)=(U(I+IVE(JJ),K,JJ-1)-U(I,K,JJ))*VKSE_J
368 VSE(I,K,J)=(V(I+IVE(JJ),K,JJ-1)-V(I,K,JJ))*VKSE_J
369 VKSE(I,K,J)=VKSE_J
370 ENDDO
371 ENDDO
372 !
373 ENDDO
374 !-----------------------------------------------------------------------
375 !
376 !$omp parallel do &
377 !$omp& private(i,j,jj,k)
378 DO J=-1,0
379 JJ=JSTART+J
380 !
381 DO K=KTS,KTE
382 DO I=MYIS1_P1,MYIE1
383 TDIF (I,K,J)=(TNE (I,K,J)-TNE (I+IHW(JJ),K,J-1) &
384 & +TSE (I,K,J)-TSE (I+IHW(JJ),K,J+1)) &
385 & *HDAC(I,JJ)
386 QDIF (I,K,J)=(QNE (I,K,J)-QNE (I+IHW(JJ),K,J-1) &
387 & +QSE (I,K,J)-QSE (I+IHW(JJ),K,J+1)) &
388 & *HDAC(I,JJ)*FCDIF
389 Q2DIF(I,K,J)=(Q2NE(I,K,J)-Q2NE(I+IHW(JJ),K,J-1) &
390 & +Q2SE(I,K,J)-Q2SE(I+IHW(JJ),K,J+1)) &
391 & *HDAC(I,JJ)
392 !
393 UDIF (I,K,J)=(UNE (I,K,J)-UNE (I+IVW(JJ),K,J-1) &
394 & +USE (I,K,J)-USE (I+IVW(JJ),K,J+1)) &
395 & *HDACV(I,JJ)
396 VDIF (I,K,J)=(VNE (I,K,J)-VNE (I+IVW(JJ),K,J-1) &
397 & +VSE (I,K,J)-VSE (I+IVW(JJ),K,J+1)) &
398 & *HDACV(I,JJ)
399 ENDDO
400 ENDDO
401 !
402 ENDDO
403 !
404 !-----------------------------------------------------------------------
405 !*** ITERATION LOOP
406 !-----------------------------------------------------------------------
407 !
408 DO 600 KS=1,KSMUD
409
410 !
411 JKNT=0
412
413 !-----------------------------------------------------------------------
414 !-----------------------------------------------------------------------
415 !*** MAIN VERTICAL INTEGRATION LOOP
416 !-----------------------------------------------------------------------
417 !-----------------------------------------------------------------------
418 main_integration : DO J=MYJS2,MYJE2
419 !-----------------------------------------------------------------------
420 !
421 !***
422 !*** SET THE 3RD INDEX IN THE WORKING ARRAYS (SEE SUBROUTINE INIT
423 !*** AND DIAGRAMS IN PFDHT)
424 !***
425 !*** J[TYPE]_NN WHERE "TYPE" IS THE WORKING ARRAY TYPE SEEN IN THE
426 !*** LOCAL DECLARATION ABOVE (DEPENDENT UPON THE J EXTENT) AND
427 !*** NN IS THE NUMBER OF ROWS NORTH OF THE CENTRAL ROW WHOSE J IS
428 !*** THE CURRENT VALUE OF THE main_integration LOOP.
429 !*** (P2 denotes +2, etc.)
430 !***
431 JKNT=JKNT+1
432 !
433 J1_P2=INDX3_WRK(2,JKNT,1)
434 J1_P1=INDX3_WRK(1,JKNT,1)
435 !
436 J2_P1=INDX3_WRK(1,JKNT,2)
437 J2_00=INDX3_WRK(0,JKNT,2)
438 J2_M1=INDX3_WRK(-1,JKNT,2)
439 !
440 J3_P2=INDX3_WRK(2,JKNT,3)
441 J3_P1=INDX3_WRK(1,JKNT,3)
442 J3_00=INDX3_WRK(0,JKNT,3)
443 !
444 J4_P2=INDX3_WRK(2,JKNT,4)
445 J4_P1=INDX3_WRK(1,JKNT,4)
446 J4_00=INDX3_WRK(0,JKNT,4)
447 J4_M1=INDX3_WRK(-1,JKNT,4)
448 !
449 !-----------------------------------------------------------------------
450 !*** SLOPE SWITCHES FOR MOISTURE
451 !-----------------------------------------------------------------------
452 IF(SIGMA==1)THEN
453 !
454 !$omp parallel do &
455 !$omp& private(i,k,slop)
456 DO K=KTS,KTE
457 !
458 !-----------------------------------------------------------------------
459 !*** PRESSURE DOMAIN
460 !-----------------------------------------------------------------------
461 !
462 IF(DETA1(K)>0.)THEN
463 DO I=MYIS_P1,MYIE1_P1
464 SNE(I,K)=1.
465 SSE(I,K)=1.
466 ENDDO
467 !
468 !-----------------------------------------------------------------------
469 !*** SIGMA DOMAIN
470 !-----------------------------------------------------------------------
471 !
472 ELSE
473 DO I=MYIS_P1,MYIE1_P1
474 SLOP=ABS((Z(I+IHE(J+1),K,J+2)-Z(I,K,J+1))*RDY)
475 !
476 CILINE=((SM(I+IHE(J+1),J+2)/=SM(I,J+1)) .OR. &
477 (SICE(I+IHE(J+1),J+2)/=SICE(I,J+1)))
478 !
479 WATSLOP=(SM(I+IHE(J+1),J+2)==1.0 .AND. &
480 SM(I,J+1)==1.0 .AND. SLOP/=0.)
481 !
482 IF(SLOP<SLOPHC .OR. CILINE .OR. WATSLOP)THEN
483 SNE(I,K)=1.
484 ELSE
485 SNE(I,K)=0.
486 ENDIF
487 !
488 SLOP=ABS((Z(I+IHE(J+2),K,J+1)-Z(I,K,J+2))*RDY)
489 !
490 CILINE=((SM(I+IHE(J+2),J+1)/=SM(I,J+2)) .OR. &
491 (SICE(I+IHE(J+2),J+1)/=SICE(I,J+2)))
492 !
493 WATSLOP=(SM(I+IHE(J+2),J+1)==1.0 .AND. &
494 SM(I,J+2)==1.0 .AND. SLOP/=0.)
495
496 IF(SLOP<SLOPHC .OR. CILINE .OR. WATSLOP)THEN
497 SSE(I,K)=1.
498 ELSE
499 SSE(I,K)=0.
500 ENDIF
501 ENDDO
502 ENDIF
503 !
504 ENDDO
505 ENDIF
506 !-----------------------------------------------------------------------
507 !*** DEFORMATIONS
508 !-----------------------------------------------------------------------
509 !
510 !$omp parallel do &
511 !$omp& private(i,k,q2l)
512 DO K=KTS,KTE
513 DO I=MYIS_P1,MYIE_P1
514 Q2L=Q2(I,K,J+2)
515 IF(Q2L<=EPSQ2)Q2L=0.
516 Q2L_IK(I,K)=Q2L
517 ENDDO
518 ENDDO
519 !
520 !$omp parallel do &
521 !$omp& private(def_j,def1,def2,def3,def4,defsk,deftk,i,k,q2l)
522 DO K=KTS,KTE
523 DO I=MYIS_P1,MYIE_P1
524 !
525 DEFTK=U(I+IHE(J+2),K,J+2)-U(I+IHW(J+2),K,J+2) &
526 & -V(I,K,J+3)+V(I,K,J+1)
527 DEFSK=U(I,K,J+3)-U(I,K,J+1) &
528 & +V(I+IHE(J+2),K,J+2)-V(I+IHW(J+2),K,J+2)
529 DEF1=W(I+IHW(J+2),K,J+1)-W(I,K,J+2)
530 DEF2=W(I+IHE(J+2),K,J+1)-W(I,K,J+2)
531 DEF3=W(I+IHW(J+2),K,J+3)-W(I,K,J+2)
532 DEF4=W(I+IHE(J+2),K,J+3)-W(I,K,J+2)
533 DEF_J=DEFTK*DEFTK+DEFSK*DEFSK+DEF1*DEF1+DEF2*DEF2 &
534 & +DEF3*DEF3+DEF4*DEF4+SCQ2*Q2L_IK(I,K)
535 DEF_J=SQRT(DEF_J+DEF_J)*HBM2(I,J+2)
536 DEF_J=MAX(DEF_J,DEFC)
537 DEF_J=MIN(DEF_J,DEFM)
538 DEF_J=DEF_J*0.1
539 DEF(I,K,J1_P2)=DEF_J
540 ENDDO
541 ENDDO
542 !
543 !-----------------------------------------------------------------------
544 !*** DIAGONAL CONTRIBUTIONS
545 !-----------------------------------------------------------------------
546 !
547 !$omp parallel do &
548 !$omp& private(hkne_j,hkse_j,i,k,vkne_j,vkse_j)
549 DO K=KTS,KTE
550 DO I=MYIS_P1,MYIE1_P1
551 HKNE_J=(DEF(I,K,J1_P1)+DEF(I+IHE(J+1),K,J1_P2)) &
552 & *HTM(I,K,J+1)*HTM(I+IHE(J+1),K,J+2)*SNE(I,K)
553 TNE (I,K,J2_P1)=(T (I+IHE(J+1),K,J+2)-T (I,K,J+1))*HKNE_J
554 QNE (I,K,J2_P1)=(Q (I+IHE(J+1),K,J+2)-Q (I,K,J+1))*HKNE_J
555 Q2NE(I,K,J2_P1)=(Q2(I+IHE(J+1),K,J+2)-Q2(I,K,J+1))*HKNE_J
556 HKNE(I,K,J2_P1)=HKNE_J
557 !
558 VKNE_J=(DEF(I+IVE(J+1),K,J1_P1)+DEF(I,K,J1_P2)) &
559 & *VTM(I,K,J+1)*VTM(I+IVE(J+1),K,J+2)
560 UNE(I,K,J2_P1)=(U(I+IVE(J+1),K,J+2)-U(I,K,J+1))*VKNE_J
561 VNE(I,K,J2_P1)=(V(I+IVE(J+1),K,J+2)-V(I,K,J+1))*VKNE_J
562 VKNE(I,K,J2_P1)=VKNE_J
563 !
564 HKSE_J=(DEF(I+IHE(J+2),K,J1_P1)+DEF(I,K,J1_P2)) &
565 & *HTM(I+IHE(J+2),K,J+1)*HTM(I,K,J+2)*SSE(I,K)
566 TSE (I,K,J3_P2)=(T (I+IHE(J+2),K,J+1)-T (I,K,J+2))*HKSE_J
567 QSE (I,K,J3_P2)=(Q (I+IHE(J+2),K,J+1)-Q (I,K,J+2))*HKSE_J
568 Q2SE(I,K,J3_P2)=(Q2(I+IHE(J+2),K,J+1)-Q2(I,K,J+2))*HKSE_J
569 HKSE(I,K,J3_P2)=HKSE_J
570 !
571 VKSE_J=(DEF(I,K,J1_P1)+DEF(I+IVE(J+2),K,J1_P2)) &
572 & *VTM(I+IVE(J+2),K,J+1)*VTM(I,K,J+2)
573 USE I,K,J3_P2)=(U (I+IVE(J+2),K,J+1)-U (I,K,J+2))*VKSE_J
574 VSE (I,K,J3_P2)=(V (I+IVE(J+2),K,J+1)-V (I,K,J+2))*VKSE_J
575 VKSE(I,K,J3_P2)=VKSE_J
576 ENDDO
577 ENDDO
578 !-----------------------------------------------------------------------
579 !
580 !$omp parallel do &
581 !$omp& private(i,k)
582 DO K=KTS,KTE
583 DO I=MYIS_P1,MYIE
584 TDIF (I,K,J4_P1)=(TNE (I,K,J2_P1)-TNE (I+IHW(J+1),K,J2_00) &
585 & +TSE (I,K,J3_P1)-TSE (I+IHW(J+1),K,J3_P2)) &
586 & *HDAC(I,J+1)
587 QDIF (I,K,J4_P1)=(QNE (I,K,J2_P1)-QNE (I+IHW(J+1),K,J2_00) &
588 & +QSE (I,K,J3_P1)-QSE (I+IHW(J+1),K,J3_P2)) &
589 & *HDAC(I,J+1)*FCDIF
590 Q2DIF(I,K,J4_P1)=(Q2NE(I,K,J2_P1)-Q2NE(I+IHW(J+1),K,J2_00) &
591 & +Q2SE(I,K,J3_P1)-Q2SE(I+IHW(J+1),K,J3_P2)) &
592 & *HDAC(I,J+1)
593 !
594 UDIF (I,K,J4_P1)=(UNE (I,K,J2_P1)-UNE (I+IVW(J+1),K,J2_00) &
595 & +USE (I,K,J3_P1)-USE (I+IVW(J+1),K,J3_P2)) &
596 & *HDACV(I,J+1)
597 VDIF (I,K,J4_P1)=(VNE (I,K,J2_P1)-VNE (I+IVW(J+1),K,J2_00) &
598 & +VSE (I,K,J3_P1)-VSE (I+IVW(J+1),K,J3_P2)) &
599 & *HDACV(I,J+1)
600 ENDDO
601 ENDDO
602 !
603 !-----------------------------------------------------------------------
604 !*** 2ND ORDER DIFFUSION
605 !-----------------------------------------------------------------------
606 !
607 IF(SECOND)THEN
608 !$omp parallel do &
609 !$omp& private(i,k)
610 DO K=KTS,KTE
611 DO I=MYIS1,MYIE1
612 T(I,K,J)=T(I,K,J)+TDIF(I,K,J4_00)
613 Q(I,K,J)=Q(I,K,J)+QDIF(I,K,J4_00)
614 !
615 U(I,K,J)=U(I,K,J)+UDIF(I,K,J4_00)
616 V(I,K,J)=V(I,K,J)+VDIF(I,K,J4_00)
617 ENDDO
618 ENDDO
619 !
620 !-----------------------------------------------------------------------
621 !$omp parallel do &
622 !$omp& private(i,k)
623 DO K=KTS+1,KTE
624 DO I=MYIS1,MYIE1
625 Q2(I,K,J)=Q2(I,K,J)+Q2DIF(I,K,J4_00)*HTM(I,K-1,J)
626 ENDDO
627 ENDDO
628 !
629 !-----------------------------------------------------------------------
630 !*** 4TH ORDER DIAGONAL CONTRIBUTIONS
631 !-----------------------------------------------------------------------
632 !
633 ELSE
634 !
635 !$omp parallel do &
636 !$omp& private(hkne_j,hkse_j,i,k,vkne_j,vkse_j)
637 DO K=KTS,KTE
638 DO I=MYIS_P1,MYIE1
639 HKNE_J=HKNE(I,K,J2_00)
640 TNE (I,K,J2_00)=(TDIF (I+IHE(J),K,J4_P1)-TDIF (I,K,J4_00)) &
641 & *HKNE_J
642 QNE (I,K,J2_00)=(QDIF (I+IHE(J),K,J4_P1)-QDIF (I,K,J4_00)) &
643 & *HKNE_J
644 Q2NE(I,K,J2_00)=(Q2DIF(I+IHE(J),K,J4_P1)-Q2DIF(I,K,J4_00)) &
645 & *HKNE_J
646 !
647 VKNE_J=VKNE(I,K,J2_00)
648 UNE (I,K,J2_00)=(UDIF (I+IVE(J),K,J4_P1)-UDIF (I,K,J4_00)) &
649 & *VKNE_J
650 VNE (I,K,J2_00)=(VDIF (I+IVE(J),K,J4_P1)-VDIF (I,K,J4_00)) &
651 & *VKNE_J
652 !
653 HKSE_J=HKSE(I,K,J3_P1)
654 TSE (I,K,J3_P1)=(TDIF (I+IHE(J+1),K,J4_00) &
655 & -TDIF (I ,K,J4_P1))*HKSE_J
656 QSE (I,K,J3_P1)=(QDIF (I+IHE(J+1),K,J4_00) &
657 & -QDIF (I ,K,J4_P1))*HKSE_J
658 Q2SE(I,K,J3_P1)=(Q2DIF(I+IHE(J+1),K,J4_00) &
659 & -Q2DIF(I ,K,J4_P1))*HKSE_J
660
661 !
662 VKSE_J=VKSE(I,K,J3_P1)
663 USE I,K,J3_P1)=(UDIF (I+IVE(J+1),K,J4_00) &
664 & -UDIF (I ,K,J4_P1))*VKSE_J
665 VSE (I,K,J3_P1)=(VDIF (I+IVE(J+1),K,J4_00) &
666 & -VDIF (I ,K,J4_P1))*VKSE_J
667 ENDDO
668 ENDDO
669 !
670 IF(J==MYJS2)THEN
671 !$omp parallel do &
672 !$omp& private(hkne_j,hkse_j,i,k,vkne_j,vkse_j)
673 DO K=KTS,KTE
674 DO I=MYIS_P1,MYIE1
675 HKNE_J=HKNE(I,K,J2_M1)
676 TNE (I,K,J2_M1)=(TDIF (I+IHE(J-1),K,J4_00) &
677 & -TDIF (I ,K,J4_M1))*HKNE_J
678 QNE (I,K,J2_M1)=(QDIF (I+IHE(J-1),K,J4_00) &
679 & -QDIF (I ,K,J4_M1))*HKNE_J
680 Q2NE(I,K,J2_M1)=(Q2DIF(I+IHE(J-1),K,J4_00) &
681 & -Q2DIF(I ,K,J4_M1))*HKNE_J
682 !
683 VKNE_J=VKNE(I,K,J2_M1)
684 UNE (I,K,J2_M1)=(UDIF (I+IVE(J-1),K,J4_00) &
685 & -UDIF (I ,K,J4_M1))*VKNE_J
686 VNE (I,K,J2_M1)=(VDIF (I+IVE(J-1),K,J4_00) &
687 & -VDIF (I ,K,J4_M1))*VKNE_J
688 !
689 HKSE_J=HKSE(I,K,J3_00)
690 TSE (I,K,J3_00)=(TDIF (I+IHE(J),K,J4_M1) &
691 & -TDIF (I ,K,J4_00))*HKSE_J
692 QSE (I,K,J3_00)=(QDIF (I+IHE(J),K,J4_M1) &
693 & -QDIF (I ,K,J4_00))*HKSE_J
694 Q2SE(I,K,J3_00)=(Q2DIF(I+IHE(J),K,J4_M1) &
695 & -Q2DIF(I ,K,J4_00))*HKSE_J
696
697 !
698 VKSE_J=VKSE(I,K,J3_00)
699 USE I,K,J3_00)=(UDIF (I+IVE(J),K,J4_M1) &
700 & -UDIF (I ,K,J4_00))*VKSE_J
701 VSE (I,K,J3_00)=(VDIF (I+IVE(J),K,J4_M1) &
702 & -VDIF (I ,K,J4_00))*VKSE_J
703 ENDDO
704 ENDDO
705 ENDIF
706 !
707 IF(J==MYJE2)THEN
708 !
709 DO K=KTS,KTE
710 DO I=MYIS_P1,MYIE1
711 TNE (I,K,J2_P1)=0.
712 QNE (I,K,J2_P1)=0.
713 Q2NE(I,K,J2_P1)=0.
714 UNE (I,K,J2_P1)=0.
715 VNE (I,K,J2_P1)=0.
716 ENDDO
717 ENDDO
718 !
719 ENDIF
720 !
721 !-----------------------------------------------------------------------
722 !
723 !$omp parallel do &
724 !$omp& private(i,k,utk,vtk)
725 DO K=KTS,KTE
726 DO I=MYIS1,MYIE1
727 T(I,K,J)=T(I,K,J)-(TNE (I,K,J2_00)-TNE (I+IHW(J),K,J2_M1) &
728 & +TSE (I,K,J3_00)-TSE (I+IHW(J),K,J3_P1)) &
729 & *HDAC(I,J)
730 Q(I,K,J)=Q(I,K,J)-(QNE (I,K,J2_00)-QNE (I+IHW(J),K,J2_M1) &
731 & +QSE (I,K,J3_00)-QSE (I+IHW(J),K,J3_P1)) &
732 & *HDAC(I,J)*FCDIF
733 !
734 UTK=U(I,K,J)
735 VTK=V(I,K,J)
736 U(I,K,J)=U(I,K,J)-(UNE (I,K,J2_00)-UNE (I+IVW(J),K,J2_M1) &
737 & +USE (I,K,J3_00)-USE (I+IVW(J),K,J3_P1)) &
738 & *HDACV(I,J)
739 V(I,K,J)=V(I,K,J)-(VNE (I,K,J2_00)-VNE (I+IVW(J),K,J2_M1) &
740 & +VSE (I,K,J3_00)-VSE (I+IVW(J),K,J3_P1)) &
741 & *HDACV(I,J)
742 CKE(I,K,J4_00)=0.5*(U(I,K,J)*U(I,K,J)-UTK*UTK &
743 & +V(I,K,J)*V(I,K,J)-VTK*VTK)
744 ENDDO
745 ENDDO
746 !
747 !-----------------------------------------------------------------------
748 !
749 !$omp parallel do &
750 !$omp& private(i,k)
751 DO K=KTS,KTE-1
752 DO I=MYIS1,MYIE1
753 Q2(I,K,J)=Q2(I,K,J)-(Q2NE(I,K,J2_00)-Q2NE(I+IHW(J),K,J2_M1) &
754 & +Q2SE(I,K,J3_00)-Q2SE(I+IHW(J),K,J3_P1)) &
755 & *HDAC(I,J)*HTM(I,K+1,J)
756 ENDDO
757 ENDDO
758 !
759 !-----------------------------------------------------------------------
760 ENDIF ! End 4th order diffusion
761 !-----------------------------------------------------------------------
762 !
763 ENDDO main_integration
764 !
765 !-----------------------------------------------------------------------
766 !
767 600 CONTINUE
768 !
769 !-----------------------------------------------------------------------
770 END SUBROUTINE HDIFF
771 !-----------------------------------------------------------------------
772 END MODULE MODULE_DIFFUSION_NMM
773 !-----------------------------------------------------------------------