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" 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" C----------------------------------------------------------------------- INCLUDE "MASKS" C----------------------------------------------------------------------- INCLUDE "PHYS" C----------------------------------------------------------------------- INCLUDE "VRBLS" C----------------------------------------------------------------------- INCLUDE "PVRBLS" C----------------------------------------------------------------------- INCLUDE "INDX" Cfm--------------------------------------------------------------------- INCLUDE "SLOPES" 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----------------------------------------------------------------------- DO 210 J=1,JM DO 210 I=1,IM 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--------------------------------------------- DO 220 J=2,JM-1 DO 220 I=1,IM-1 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--------------------------- DO 250 J=1,JM-1 DO 250 I=1,IM-1 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 DO 260 J=2,JM DO 260 I=1,IM-1 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----------------------------------------------------------------------- DO 270 J=2,JM-1 DO 270 I=2,IM 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 DO 280 J=3,JM-2 DO 280 I=2,IM-1 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 DO 290 J=3,JM-2 DO 290 I=2,IM-1 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------------------------ DO 310 J=1,JM-1 DO 310 I=1,IM-1 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 DO 320 J=2,JM DO 320 I=1,IM-1 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----------------------------------------------------------------------- DO 330 J=3,JM-2 DO 330 I=2,IM-1 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 DO 340 J=3,JM-2 DO 340 I=2,IM-1 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------------------------------ 360 DO 410 J=1,JM-1 DO 410 I=1,IM-1 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 DO 420 J=2,JM DO 420 I=1,IM-1 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----------------------------------------------------------------------- DO 430 J=2,JM-1 DO 430 I=1,IM-1 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 DO 440 J=3,JM-2 DO 440 I=2,IM-1 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------------------------ DO 450 J=1,JM-1 DO 450 I=1,IM-1 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 DO 460 J=2,JM DO 460 I=1,IM-1 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----------------------------------------------------------------------- DO 470 J=3,JM-2 DO 470 I=2,IM-1 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 DO 480 J=3,JM-2 DO 480 I=2,IM-1 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