SUBROUTINE HDIFFS C*********************************************************************** Cfm Calculaton of hdiff v at points that have a neighboring "blocked" v C-- switched on (loops 410 and 420), using velocities at points on C-- slopes, but only half of the diffusion coefficient (note Fig. 2 of C-- the "upgraded Eta" paper) C-- fm and Sandra Morelli, June-July 2013 C----------------------------------------------------------------------- P A R A M E T E R & (D00=0.E0,DEFC=08.0E0,DEFM=32.E0,SCQ2=050.E0 &, EPSQ2=0.2,FCDIF=1.0E0, D50=.5E0,RFCP=.25E0/1004.6E0) C----------------------------------------------------------------------- INCLUDE "parmeta" INCLUDE "parm.tbl" INCLUDE "mpp.h" C----------------------------------------------------------------------- P A R A M E T E R & (LDA=LM+9,LA=13,KSMUD=01) C***WARNING*** IF LM.GT.16 THEN SET LDA=LM+9 P A R A M E T E R & (IMJM=IM*JM-JM/2 &, LP1=LM+1 &, LSCRCH=4*LM+1+LA+1) C----------------------------------------------------------------------- L O G I C A L & RUN,FIRST,RESTRT,SIGMA &,SECOND,HEAT C----------------------------------------------------------------------- INCLUDE "CTLBLK.comm" C----------------------------------------------------------------------- INCLUDE "MASKS.comm" C----------------------------------------------------------------------- INCLUDE "PHYS.comm" C----------------------------------------------------------------------- INCLUDE "VRBLS.comm" C----------------------------------------------------------------------- INCLUDE "PVRBLS.comm" C----------------------------------------------------------------------- INCLUDE "INDX.comm" Cfm--------------------------------------------------------------------- INCLUDE "SLOPES.comm" C----------------------------------------------------------------------- D I M E N S I O N & Q2L (IM,JM),HKNE (IM,JM),HKSE (IM,JM) & ,VKNE (IM,JM),VKSE (IM,JM) C D I M E N S I O N & TNE (0:IM+1,0:JM+1),TSE (0:IM+1,0:JM+1) &,QNE (0:IM+1,0:JM+1),QSE (0:IM+1,0:JM+1) &,Q2NE (0:IM+1,0:JM+1),Q2SE (0:IM+1,0:JM+1) &,UNE (0:IM+1,0:JM+1),USE (0:IM+1,0:JM+1) &,VNE (0:IM+1,0:JM+1),VSE (0:IM+1,0:JM+1) &,TDIF (0:IM+1,0:JM+1),QDIF (0:IM+1,0:JM+1) &,UDIF (0:IM+1,0:JM+1),VDIF (0:IM+1,0:JM+1) &,Q2DIF (0:IM+1,0:JM+1) &,DEF (0:IM+1,0:JM+1),CKE (0:IM+1,0:JM+1) C----------------------------------------------------------------------- C----------------------------------------------------------------------- SECOND=.TRUE. HEAT=.FALSE. C----------------------------------------------------------------------- DO 600 KS=1,KSMUD C--------------MAIN VERTICAL INTEGRATION LOOP--------------------------- DO 500 L=1,LM CVVVVDIFFUSING Q2 AT GROUND LEVEL DOESN'T MATTER, USTAR2 IS RECALCULATED C----------------------------------------------------------------------- CALL ZERO2(TNE) CALL ZERO2(TSE) CALL ZERO2(QNE) CALL ZERO2(QSE) CALL ZERO2(Q2NE) CALL ZERO2(Q2SE) CALL ZERO2(UNE) CALL ZERO2(USE) CALL ZERO2(VNE) CALL ZERO2(VSE) CALL ZERO2(TDIF) CALL ZERO2(QDIF) CALL ZERO2(UDIF) CALL ZERO2(VDIF) CALL ZERO2(Q2DIF) CALL ZERO2(DEF) CALL ZERO2(CKE) C----------------------------------------------------------------------- C DO 210 J=1,JM C DO 210 I=1,IM DO 210 J=MYJS_P1,MYJE_P1 DO 210 I=MYIS_P1,MYIE_P1 Q2L(I,J)=AMAX1(Q2(I,J,L),EPSQ2) 210 CONTINUE C----------------------------------------------------------------------- Cfm Fill the v points at slopes with the wind above -------------------- IF (L.GT.1) THEN DO J=8,JM-7 DO I=4+MOD(J+1,2),IM-4 IF (VTMS(I,J,L).EQ.1) THEN U(I,J,L)=U(I,J,L-1) V(I,J,L)=V(I,J,L-1) END IF END DO END DO END IF C--------------DEFORMATIONS--------------------------------------------- C DO 220 J=2,JM-1 C DO 220 I=1,IM-1 DO 220 J=MYJS1_P1,MYJE1_P1 DO 220 I=MYIS_P1,MYIE1_P1 DEFTK =U(I+IHE(J),J,L)-U(I+IHW(J),J,L)-V(I,J+1,L)+V(I,J-1,L) DEFSK =U(I,J+1,L)-U(I,J-1,L)+V(I+IHE(J),J,L)-V(I+IHW(J),J,L) DEF (I,J)=DEFTK *DEFTK +DEFSK *DEFSK +SCQ2*Q2L(I,J) DEF (I,J)=SQRT(DEF(I,J)+DEF(I,J))*HBM2(I,J) c DEF(I,J)=AMAX1(DEF(I,J),DEFC) c DEF(I,J)=AMIN1(DEF(I,J),DEFM) 220 CONTINUE C--------------T,Q, Q2 DIAGONAL CONTRIBUTIONS--------------------------- C DO 250 J=1,JM-1 C DO 250 I=1,IM-1 DO 250 J=MYJS_P1,MYJE1_P1 DO 250 I=MYIS_P1,MYIE1_P1 HKNE(I,J)=(DEF(I,J)+DEF(I+IHE(J),J+1)) 1 *HTM(I,J,L)*HTM(I+IHE(J),J+1,L) TNE (I,J)=(T (I+IHE(J),J+1,L)-T (I,J,L))*HKNE(I,J) QNE (I,J)=(Q (I+IHE(J),J+1,L)-Q (I,J,L))*HKNE(I,J) Q2NE(I,J)=(Q2(I+IHE(J),J+1,L)-Q2(I,J,L))*HKNE(I,J) 250 CONTINUE C C DO 260 J=2,JM C DO 260 I=1,IM-1 DO 260 J=MYJS1_P1,MYJE_P1 DO 260 I=MYIS_P1,MYIE1_P1 HKSE(I,J)=(DEF(I+IHE(J),J-1)+DEF(I,J)) 1 *HTM(I+IHE(J),J-1,L)*HTM(I,J,L) TSE (I,J)=(T (I+IHE(J),J-1,L)-T (I,J,L))*HKSE(I,J) QSE (I,J)=(Q (I+IHE(J),J-1,L)-Q (I,J,L))*HKSE(I,J) Q2SE(I,J)=(Q2(I+IHE(J),J-1,L)-Q2(I,J,L))*HKSE(I,J) 260 CONTINUE C----------------------------------------------------------------------- C DO 270 J=2,JM-1 C DO 270 I=2,IM DO 270 J=MYJS1,MYJE1 DO 270 I=MYIS1,MYIE TDIF (I,J)=(TNE (I,J)-TNE (I+IHW(J),J-1) 1 +TSE (I,J)-TSE (I+IHW(J),J+1))*HDAC(I,J) QDIF (I,J)=(QNE (I,J)-QNE (I+IHW(J),J-1) 1 +QSE (I,J)-QSE (I+IHW(J),J+1))*HDAC(I,J)*FCDIF Q2DIF(I,J)=(Q2NE(I,J)-Q2NE(I+IHW(J),J-1) 1 +Q2SE(I,J)-Q2SE(I+IHW(J),J+1))*HDAC(I,J) 270 CONTINUE C--------------2-ND ORDER DIFFUSION------------------------------------- IF(SECOND)THEN C DO 280 J=3,JM-2 C DO 280 I=2,IM-1 DO 280 J=MYJS2,MYJE2 DO 280 I=MYIS1,MYIE1 T (I,J,L)=T (I,J,L)+TDIF (I,J) Q (I,J,L)=Q (I,J,L)+QDIF (I,J) 280 CONTINUE C C----------------------------------------------------------------------- C IF(L.NE.LM)THEN C DO 290 J=3,JM-2 C DO 290 I=2,IM-1 DO 290 J=MYJS2,MYJE2 DO 290 I=MYIS1,MYIE1 Q2(I,J,L)=Q2(I,J,L)+Q2DIF(I,J) 290 CONTINUE C ENDIF C GO TO 360 ENDIF C--------------4-TH ORDER DIAGONAL CONTRIBUTIONS------------------------ C DO 310 J=1,JM-1 C DO 310 I=1,IM-1 DO 310 J=MYJS,MYJE1 DO 310 I=MYIS,MYIE1 TNE (I,J)=(TDIF (I+IHE(J),J+1)-TDIF (I,J))*HKNE(I,J) QNE (I,J)=(QDIF (I+IHE(J),J+1)-QDIF (I,J))*HKNE(I,J) Q2NE(I,J)=(Q2DIF(I+IHE(J),J+1)-Q2DIF(I,J))*HKNE(I,J) 310 CONTINUE C C DO 320 J=2,JM C DO 320 I=1,IM-1 DO 320 J=MYJS1,MYJE DO 320 I=MYIS,MYIE1 TSE (I,J)=(TDIF (I+IHE(J),J-1)-TDIF (I,J))*HKSE(I,J) QSE (I,J)=(QDIF (I+IHE(J),J-1)-QDIF (I,J))*HKSE(I,J) Q2SE(I,J)=(Q2DIF(I+IHE(J),J-1)-Q2DIF(I,J))*HKSE(I,J) 320 CONTINUE C----------------------------------------------------------------------- C DO 330 J=3,JM-2 C DO 330 I=2,IM-1 DO 330 J=MYJS2,MYJE2 DO 330 I=MYIS1,MYIE1 T(I,J,L)=T(I,J,L)-(TNE (I,J)-TNE (I+IHW(J),J-1) 1 +TSE (I,J)-TSE (I+IHW(J),J+1))*HDAC(I,J) Q(I,J,L)=Q(I,J,L)-(QNE (I,J)-QNE (I+IHW(J),J-1) 1 +QSE (I,J)-QSE (I+IHW(J),J+1))*HDAC(I,J) 2 *FCDIF 330 CONTINUE C C----------------------------------------------------------------------- C IF(L.NE.LM)THEN C DO 340 J=3,JM-2 C DO 340 I=2,IM-1 DO 340 J=MYJS2,MYJE2 DO 340 I=MYIS1,MYIE1 Q2(I,J,L)=Q2(I,J,L)-(Q2NE(I,J)-Q2NE(I+IHW(J),J-1) 1 +Q2SE(I,J)-Q2SE(I+IHW(J),J+1))*HDAC(I,J) 340 CONTINUE C ENDIF C--------------U,V, DIAGONAL CONTRIBUTIONS------------------------------ C 360 DO 410 J=1,JM-1 C DO 410 I=1,IM-1 360 DO 410 J=MYJS_P1,MYJE1_P1 DO 410 I=MYIS_P1,MYIE1_P1 VKNE(I,J)=(DEF(I+IVE(J),J)+DEF(I,J+1)) Cfm 1 *VTM(I,J,L)*VTM(I+IVE(J),J+1,L) 1 *MAX(VTM(I+IVE(J),J+1,L),VTMS(I+IVE(J),J+1,L)) UNE(I,J)=(U(I+IVE(J),J+1,L)-U(I,J,L))*VKNE(I,J) VNE(I,J)=(V(I+IVE(J),J+1,L)-V(I,J,L))*VKNE(I,J) 410 CONTINUE C C DO 420 J=2,JM C DO 420 I=1,IM-1 DO 420 J=MYJS1_P1,MYJE_P1 DO 420 I=MYIS_P1,MYIE1_P1 VKSE(I,J)=(DEF(I,J-1)+DEF(I+IVE(J),J)) Cfm 1 *VTM(I+IVE(J),J-1,L)*VTM(I,J,L) 1 *MAX(VTM(I+IVE(J),J-1,L),VTMS(I+IVE(J),J-1,L)) USE(I,J)=(U(I+IVE(J),J-1,L)-U(I,J,L))*VKSE(I,J) VSE(I,J)=(V(I+IVE(J),J-1,L)-V(I,J,L))*VKSE(I,J) 420 CONTINUE C----------------------------------------------------------------------- C DO 430 J=2,JM-1 C DO 430 I=1,IM-1 DO 430 J=MYJS1,MYJE1 DO 430 I=MYIS,MYIE1 UDIF(I,J)=(UNE(I,J)-UNE(I+IVW(J),J-1) 1 +USE(I,J)-USE(I+IVW(J),J+1))*HDACV(I,J) VDIF(I,J)=(VNE(I,J)-VNE(I+IVW(J),J-1) 1 +VSE(I,J)-VSE(I+IVW(J),J+1))*HDACV(I,J) 430 CONTINUE C--------------2-ND ORDER DIFFUSION------------------------------------- IF(SECOND)THEN Cfm C At points having a neighboring wind at a slope, reduce the C diffusion coefficient to half of its value at fully open v points C C DO 440 J=3,JM-2 C DO 440 I=2,IM-1 DO 440 J=MYJS2,MYJE2 DO 440 I=MYIS1,MYIE1 NNTMP= VTM(I+IVW(J),J+1,L)*VTM(I+IVE(J),J+1,L) 1 *VTM(I+IVW(J),J-1,L)*VTM(I+IVE(J),J-1,L) DCMD=NNTMP+0.5*MOD(NNTMP+1,2) U(I,J,L)=U(I,J,L)+UDIF(I,J)*VTM(I,J,L)*DCMD V(I,J,L)=V(I,J,L)+VDIF(I,J)*VTM(I,J,L)*DCMD 440 CONTINUE C else c GO TO 500 c ENDIF C--------------4-TH ORDER DIAGONAL CONTRIBUTIONS------------------------ C DO 450 J=1,JM-1 C DO 450 I=1,IM-1 DO 450 J=MYJS,MYJE1 DO 450 I=MYIS,MYIE1 UNE(I,J)=(UDIF(I+IVE(J),J+1)-UDIF(I,J))*VKNE(I,J) VNE(I,J)=(VDIF(I+IVE(J),J+1)-VDIF(I,J))*VKNE(I,J) 450 CONTINUE C C DO 460 J=2,JM C DO 460 I=1,IM-1 DO 460 J=MYJS1,MYJE DO 460 I=MYIS,MYIE1 USE(I,J)=(UDIF(I+IVE(J),J-1)-UDIF(I,J))*VKSE(I,J) VSE(I,J)=(VDIF(I+IVE(J),J-1)-VDIF(I,J))*VKSE(I,J) 460 CONTINUE C----------------------------------------------------------------------- C DO 470 J=3,JM-2 C DO 470 I=2,IM-1 DO 470 J=MYJS2,MYJE2 DO 470 I=MYIS1,MYIE1 UTK=U(I,J,L) VTK=V(I,J,L) U(I,J,L)=U(I,J,L)-(UNE(I,J)-UNE(I+IVW(J),J-1) 1 +USE(I,J)-USE(I+IVW(J),J+1))*HDACV(I,J) V(I,J,L)=V(I,J,L)-(VNE(I,J)-VNE(I+IVW(J),J-1) 1 +VSE(I,J)-VSE(I+IVW(J),J+1))*HDACV(I,J) CKE(I,J)=D50*(U(I,J,L)*U(I,J,L)-UTK*UTK 1 +V(I,J,L)*V(I,J,L)-VTK*VTK) 470 CONTINUE C----------------------------------------------------------------------- IF(HEAT)THEN C DO 480 J=3,JM-2 C DO 480 I=2,IM-1 DO 480 J=MYJS2,MYJE2 DO 480 I=MYIS1,MYIE1 T(I,J,L)=-RFCP*(CKE(I+IHE(J),J)+CKE(I,J+1) 1 +CKE(I+IHW(J),J)+CKE(I,J-1))*HBM2(I,J) 2 +T(I,J,L) 480 CONTINUE ENDIF endif C----------------------------------------------------------------------- Cfm Fill the v points at slopes back with zeros, in case it matters ---- IF (L.GT.1) THEN DO J=8,JM-7 DO I=4+MOD(J+1,2),IM-4 IF (VTMS(I,J,L).EQ.1) THEN U(I,J,L)=0. V(I,J,L)=0. END IF END DO END DO END IF C----------------------------------------------------------------------- 500 CONTINUE 600 CONTINUE C----------------------------------------------------------------------- RETURN END