1 !-----------------------------------------------------------------------
3 !NCEP_MESO:MODEL_LAYER: HORIZONTAL DIFFUSION
5 !-----------------------------------------------------------------------
7 #include "nmm_loop_basemacros.h"
8 #include "nmm_loop_macros.h"
10 !-----------------------------------------------------------------------
12 MODULE MODULE_DIFFUSION_NMM
14 !-----------------------------------------------------------------------
15 USE MODULE_MODEL_CONSTANTS
16 USE MODULE_CONFIGURE, ONLY : GRID_CONFIG_REC_TYPE
17 USE MODULE_STATE_DESCRIPTION
18 !-----------------------------------------------------------------------
20 LOGICAL :: SECOND=.TRUE.
23 !-----------------------------------------------------------------------
27 !***********************************************************************
28 SUBROUTINE HDIFF(NTSD,DT,FIS,DY,HDAC,HDACV &
31 & ,T,Q,U,V,Q2,Z,W,SM,SICE,h_diff &
33 & ,T,Q,U,V,Q2,Z,W,SM,SICE &
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
44 ! SUBPROGRAM: HDIFF HORIZONTAL DIFFUSION
45 ! PRGRMMR: JANJIC ORG: W/NP22 DATE: 93-11-17
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
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 -
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
69 ! USAGE: CALL HDIFF FROM SUBROUTINE SOLVE_RUNSTREAM
71 ! INPUT ARGUMENT LIST:
73 ! OUTPUT ARGUMENT LIST:
85 ! LANGUAGE: FORTRAN 90
88 !***********************************************************************
89 !-----------------------------------------------------------------------
93 !-----------------------------------------------------------------------
95 !*** STRUCTURE THAT CONTAINS RUN-TIME CONFIGURATION (NAMELIST) DATA FOR DOMAIN
97 TYPE(GRID_CONFIG_REC_TYPE),INTENT(IN) :: CONFIG_FLAGS
99 INTEGER,INTENT(IN) :: IDS,IDE,JDS,JDE,KDS,KDE &
100 & ,IMS,IME,JMS,JME,KMS,KME &
101 & ,ITS,ITE,JTS,JTE,KTS,KTE
103 INTEGER,INTENT(IN) :: NTSD
105 REAL,INTENT(IN) :: DT,DY
107 REAL,INTENT(IN) :: H_DIFF
110 REAL,DIMENSION(KMS:KME),INTENT(IN) :: DETA1
112 REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(IN) :: FIS,HBM2 &
116 REAL,DIMENSION(IMS:IME,JMS:JME,KMS:KME),INTENT(OUT) :: DEF3D
118 REAL,DIMENSION(IMS:IME,JMS:JME,KMS:KME),INTENT(IN) :: W,Z
120 REAL,DIMENSION(IMS:IME,JMS:JME,KMS:KME),INTENT(INOUT) :: T,Q,Q2 &
123 INTEGER, DIMENSION(JMS:JME), INTENT(IN) :: IHE,IHW,IVE,IVW
125 !-----------------------------------------------------------------------
127 INTEGER,INTENT(IN) :: SIGMA
129 !-----------------------------------------------------------------------
131 !-----------------------------------------------------------------------
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
138 REAL,DIMENSION(ITS-5:ITE+5,JTS-5:JTE+5) :: DEF,HKNE,HKSE &
140 & ,QDIF,QNE,QSE,SNE,SSE &
143 & ,VDIF,VKNE,VKSE,VNE,VSE
145 LOGICAL :: CILINE,WATSLOP
147 !-----------------------------------------------------------------------
148 !***********************************************************************
149 !-----------------------------------------------------------------------
152 SLOPHC=SLOPHT*SQRT(2.)*0.5*9.
154 SLOPHC=config_flags%slophc
178 !-----------------------------------------------------------------------
180 !*** DIFFUSING Q2 AT GROUND LEVEL DOES NOT MATTER
181 !*** BECAUSE USTAR2 IS RECALCULATED.
183 !-----------------------------------------------------------------------
185 !-----------------------------------------------------------------------
189 !-----------------------------------------------------------------------
190 !-----------------------------------------------------------------------
191 !*** MAIN INTEGRATION LOOP
192 !-----------------------------------------------------------------------
193 !-----------------------------------------------------------------------
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 !-----------------------------------------------------------------------
201 main_integration : DO K=KTS,KTE
209 !-----------------------------------------------------------------------
210 !*** SLOPE SWITCHES FOR MOISTURE
211 !-----------------------------------------------------------------------
215 !-----------------------------------------------------------------------
217 !-----------------------------------------------------------------------
220 DO J=MYJS_P1,MYJE1_P2
221 DO I=MYIS_P1,MYIE1_P1
226 DO J=MYJS1_P1,MYJE_P2
227 DO I=MYIS_P1,MYIE1_P1
232 !-----------------------------------------------------------------------
234 !-----------------------------------------------------------------------
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)
241 CILINE=((SM(I+IHE(J),J+1)/=SM(I,J)).OR. &
242 (SICE(I+IHE(J),J+1)/=SICE(I,J)))
244 WATSLOP=(SM(I+IHE(J),J+1)==1.0.AND. &
245 SM(I,J)==1.0.AND.SLOP/=0.)
247 IF(SLOP<SLOPHC.OR.CILINE.OR.WATSLOP)THEN
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)
259 CILINE=((SM(I+IHE(J),J-1)/=SM(I,J)).OR. &
260 (SICE(I+IHE(J),J-1)/=SICE(I,J)))
262 WATSLOP=(SM(I+IHE(J),J-1)==1.0.AND. &
263 SM(I,J)==1.0.AND.SLOP/=0.)
265 IF(SLOP<SLOPHC.OR.CILINE.OR.WATSLOP)THEN
275 !-----------------------------------------------------------------------
277 !-----------------------------------------------------------------------
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
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
296 DEF_IJ=DEFTK*DEFTK+DEFSK*DEFSK+DEF1*DEF1+DEF2*DEF2 &
297 & +DEF3*DEF3+DEF4*DEF4
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)
309 !-----------------------------------------------------------------------
310 !*** DIAGONAL CONTRIBUTIONS
311 !-----------------------------------------------------------------------
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
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
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
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
342 !-----------------------------------------------------------------------
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)
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)
360 !-----------------------------------------------------------------------
361 !*** 2ND ORDER DIFFUSION
362 !-----------------------------------------------------------------------
367 T (I,J,K)=T (I,J,K)+TDIF (I,J)
368 Q (I,J,K)=Q (I,J,K)+QDIF (I,J)
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
374 U(I,J,K)=U(I,J,K)+UDIF(I,J)
375 V(I,J,K)=V(I,J,K)+VDIF(I,J)
380 !-----------------------------------------------------------------------
384 Q2(I,J,K)=Q2(I,J,K)+Q2DIF(I,J)
389 !-----------------------------------------------------------------------
390 !*** 4TH ORDER DIAGONAL CONTRIBUTIONS
391 !-----------------------------------------------------------------------
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
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
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) &
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)) &
434 !-----------------------------------------------------------------------
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)
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)
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
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)
466 !-----------------------------------------------------------------------
467 ENDIF ! End 4th order diffusion
468 !-----------------------------------------------------------------------
470 ENDDO main_integration
472 !-----------------------------------------------------------------------
476 !-----------------------------------------------------------------------
480 !-----------------------------------------------------------------------
482 END MODULE MODULE_DIFFUSION_NMM
484 !-----------------------------------------------------------------------