!&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& SUBROUTINE HADZ ! ****************************************************************** !$$$ SUBPROGRAM DOCUMENTATION BLOCK ! . . . ! SUBPROGRAM: HADZ HORIZONTAL ADVECTION OF HEIGHT ! PRGRMMR: JANJIC ORG: W/NP22 DATE: 96-05-?? ! ABSTRACT: ! HADZ CALCULATES DIAGNOSTICALLY THE CONTRIBUTION OF ! THE HORIZONTAL ADVECTION OF HEIGHT ! PROGRAM HISTORY LOG: ! 96-05-?? JANJIC - ORIGINATOR ! 00-01-04 BLACK - DISTRIBUTED MEMORY AND THREADS ! USAGE: CALL HADZ FROM MAIN PROGRAM ! INPUT ARGUMENT LIST: ! NONE ! OUTPUT ARGUMENT LIST: ! NONE ! OUTPUT FILES: ! NONE ! SUBPROGRAMS CALLED: ! UNIQUE: NONE ! LIBRARY: NONE ! COMMON BLOCKS: CTLBLK ! LOOPS ! MASKS ! DYNAM ! VRBLS ! CONTIN ! NHYDRO ! INDX ! ATTRIBUTES: ! LANGUAGE: FORTRAN 90 ! MACHINE : IBM SP !$$$ !*********************************************************************** !----------------------------------------------------------------------- INCLUDE "parmeta.f90" INCLUDE "mpp.h" !----------------------------------------------------------------------- PARAMETER & (JAM=6+2*(JM-10) & ,IMJM=IM*JM-JM/2,LM1=LM-1,LP1=LM+1) PARAMETER & (G=9.8,NTSHY=2) !----------------------------------------------------------------------- LOGICAL :: & RUN,FIRST,RESTRT,SIGMA !---------------------------------------------------------------------- INCLUDE "COMM_CTLBLK.f90" !----------------------------------------------------------------------- INCLUDE "COMM_LOOPS.f90" !----------------------------------------------------------------------- INCLUDE "COMM_MASKS.f90" !----------------------------------------------------------------------- INCLUDE "COMM_DYNAM.f90" !----------------------------------------------------------------------- INCLUDE "COMM_VRBLS.f90" !----------------------------------------------------------------------- include "COMM_CONTIN.f90" !----------------------------------------------------------------------- INCLUDE "COMM_NHYDRO.f90" !----------------------------------------------------------------------- INCLUDE "COMM_INDX.f90" !----------------------------------------------------------------------- REAL :: & HBMS (IDIM1:IDIM2,JDIM1:JDIM2),DPDE (IDIM1:IDIM2,JDIM1:JDIM2) & ,UDY (IDIM1:IDIM2,JDIM1:JDIM2),VDX (IDIM1:IDIM2,JDIM1:JDIM2) & ,UNED (IDIM1:IDIM2,JDIM1:JDIM2),USED (IDIM1:IDIM2,JDIM1:JDIM2) & ,ZEW (IDIM1:IDIM2,JDIM1:JDIM2),ZNS (IDIM1:IDIM2,JDIM1:JDIM2) & ,ZNE (IDIM1:IDIM2,JDIM1:JDIM2),ZSE (IDIM1:IDIM2,JDIM1:JDIM2) !----------------------------------------------------------------------- IF(NTSD <= NTSHY .OR. HYDRO)THEN ! omp parallel do DO L=1,LM DO J=MYJS,MYJE DO I=MYIS,MYIE W(I,J,L)=0. ENDDO ENDDO ENDDO !*** RETURN !*** ENDIF !*********************************************************************** !----------------------------------------------------------------------- ! omp parallel do ! omp& private (dpde,ihh,ihl,ivh,ivl,ix,jx,udy,uned,used, ! omp& vdx,zew,zne,zns,zse) DO 200 L=1,LM !----------------------------------------------------------------------- DO J=MYJS_P3,MYJE_P3 DO I=MYIS_P3,MYIE_P3 DPDE(I,J)=PDSL(I,J)*DETA(L) ENDDO ENDDO !----------------------------------------------------------------------- !--------------MASS FLUXES AND MASS POINTS ADVECTION COMPONENTS--------- !----------------------------------------------------------------------- DO 125 J=2,JM-1 IF(J >= MY_JS_GLB-JBPAD2 .AND. J <= MY_JE_GLB+JTPAD2)THEN JX=J-MY_JS_GLB+1 IVL=2-MOD(J,2) IVH=IM-1 DO 120 I=IVL,IVH IF(I >= MY_IS_GLB-ILPAD2 .AND. I <= MY_IE_GLB+IRPAD2)THEN IX=I-MY_IS_GLB+1 UDY(IX,JX)=U(IX,JX,L)*DY ZEW(IX,JX)=UDY(IX,JX) & *(DPDE(IX+IVW(JX),JX )+DPDE(IX+IVE(JX),JX )) & *(Z (IX+IVE(JX),JX,L)-Z (IX+IVW(JX),JX,L)) VDX(IX,JX)=V(IX,JX,L)*DX(IX,JX) ZNS(IX,JX)=VDX(IX,JX) & *(DPDE(IX ,JX-1 )+DPDE(IX ,JX+1 )) & *(Z (IX ,JX+1,L)-Z (IX ,JX-1,L)) UNED(IX,JX)=UDY(IX,JX)+VDX(IX,JX) USED(IX,JX)=UDY(IX,JX)-VDX(IX,JX) ENDIF 120 END DO ENDIF 125 END DO !----------------------------------------------------------------------- !--------------DIAGONAL FLUXES AND DIAGONALLY AVERAGED WIND------------- !----------------------------------------------------------------------- DO 145 J=2,JM-2 IF(J >= MY_JS_GLB-JBPAD1 .AND. J <= MY_JE_GLB+JTPAD1)THEN JX=J-MY_JS_GLB+1 IHL=2-MOD(J+1,2) IHH=IM-2+MOD(J,2) DO 140 I=IHL,IHH IF(I >= MY_IS_GLB-ILPAD1 .AND. I <= MY_IE_GLB+IRPAD1)THEN IX=I-MY_IS_GLB+1 ZNE(IX,JX)=(UNED(IX+IHE(JX),JX) +UNED(IX ,JX+1)) & *(DPDE(IX ,JX) +DPDE(IX+IHE(JX),JX+1)) & *(Z (IX+IHE(JX),JX+1,L)-Z (IX ,JX ,L)) ENDIF 140 END DO ENDIF 145 END DO DO 165 J=3,JM-1 IF(J >= MY_JS_GLB-JBPAD1 .AND. J <= MY_JE_GLB+JTPAD1)THEN JX=J-MY_JS_GLB+1 IHL=2-MOD(J+1,2) IHH=IM-2+MOD(J,2) DO 160 I=IHL,IHH IF(I >= MY_IS_GLB-ILPAD1 .AND. I <= MY_IE_GLB+IRPAD1)THEN IX=I-MY_IS_GLB+1 ZSE(IX,JX)=(USED(IX+IHE(JX),JX ) +USED(IX ,JX-1 )) & *(DPDE(IX ,JX ) +DPDE(IX+IHE(JX),JX-1 )) & *(Z (IX+IHE(JX),JX-1,L)-Z (IX ,JX ,L)) ENDIF 160 END DO ENDIF 165 END DO !----------------------------------------------------------------------- !--------------ADVECTION OF Z------------------------------------------- !----------------------------------------------------------------------- ! DO 170 J=4,JM-3 ! IF(J.GE.MY_JS_GLB.AND.J.LE.MY_JE_GLB)THEN ! IHL=2+MOD(J,2) ! IHH=IM-2 ! DO 171 I=IHL,IHH DO 175 J=3,JM-2 IF(J >= MY_JS_GLB .AND. J <= MY_JE_GLB)THEN JX=J-MY_JS_GLB+1 IHL=2 IHH=IM-2+MOD(J,2) DO 170 I=IHL,IHH IF(I >= MY_IS_GLB .AND. I <= MY_IE_GLB)THEN IX=I-MY_IS_GLB+1 W(IX,JX,L)= & -(ZEW(IX+IHW(JX),JX )+ZEW(IX+IHE(JX),JX ) & +ZNS(IX ,JX-1)+ZNS(IX ,JX+1) & +ZNE(IX+IHW(JX),JX-1)+ZNE(IX ,JX ) & +ZSE(IX ,JX )+ZSE(IX+IHW(JX),JX+1)) & *FAD(IX,JX)*HTM(IX,JX,L)*HBM2(IX,JX)/(DPDE(IX,JX)*DT) & +W(IX,JX,L) ENDIF 170 END DO ENDIF 175 END DO !----------------------------------------------------------------------- 200 END DO !----------------------------------------------------------------------- !*********************************************************************** ! NSMUD=7 ! DO J=MYJS,MYJE ! DO I=MYIS,MYIE ! HBMS(I,J)=HBM2(I,J) ! ENDDO ! ENDDO !C !C JHL MUST BE ODD!!! ! JHL=9 ! JHH=JM-JHL+1 !C ! DO 225 J=JHL,JHH ! IF(J.GE.MY_JS_GLB.AND.J.LE.MY_JE_GLB)THEN ! JX=J-MY_JS_GLB+1 ! IHL=JHL/2+1 ! IHH=IM-IHL+MOD(J,2) ! DO I=IHL,IHH ! IF(I.GE.MY_IS_GLB.AND.I.LE.MY_IE_GLB)THEN ! IX=I-MY_IS_GLB+1 ! HBMS(IX,JX)=0. ! ENDDO ! ENDIF ! 225 CONTINUE !C----------------------------------------------------------------------- !!#omp paralle do private (ihh,ihl,ix,jx,zne,zse) ! DO 300 L=1,LM !C----------------------------------------------------------------------- ! DO KS=1,NSMUD !C ! DO J=MYJS,MYJE1 ! DO I=MYIS,MYIE1 ! ZNE(I,J)=(W(I+IHE(J),J+1,L)-W(I,J,L)) ! & *HTM(I,J,L)*HTM(I+IHE(J),J+1,L) ! ENDDO ! ENDDO !C ! DO J=MYJS1,MYJE ! DO I=MYIS,MYIE1 ! ZSE(I,J)=(W(I+IHE(J),J-1,L)-W(I,J,L)) ! & *HTM(I+IHE(J),J-1,L)*HTM(I,J,L) ! ENDDO ! ENDDO !C ! DO 250 J=3,JM-2 ! IF(J.GE.MY_JS_GLB.AND.J.LE.MY_JE_GLB)THEN ! JX=J-MY_JS_GLB+1 ! IHL=2 ! IHH=IM-2+MOD(J,2) !C ! DO 245 I=2,IM-2 ! IF(I.GE.MY_IS_GLB.AND.I.LE.MY_IE_GLB)THEN ! IX=I-MY_IS_GLB+1 ! W(IX,JX,L)=(ZNE(IX,JX)-ZNE(IX+IHW(JX),JX-1) ! & +ZSE(IX,JX)-ZSE(IX+IHW(JX),JX+1)) ! & *HBMS(IX,JX)*0.125+W(IX,JX,L) ! ENDIF ! 245 CONTINUE ! ENDIF ! 250 CONTINUE ! ENDDO !C---------------------------------------------------------------------- ! 300 CONTINUE !C---------------------------------------------------------------------- RETURN END SUBROUTINE HADZ