!&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& SUBROUTINE PDTEDT ! ****************************************************************** !$$$ SUBPROGRAM DOCUMENTATION BLOCK ! . . . ! SUBPROGRAM: PDTEDT SURFACE PRESSURE TENDENCY CALC ! PRGRMMR: JANJIC ORG: W/NMC2 DATE: 96-07-?? ! ABSTRACT: ! PDTEDT VERTICALLY INTEGRATES THE MASS FLUX DIVERGENCE TO ! OBTAIN THE SURFACE PRESSURE TENDENCY AND ETADOT ON THE ! LAYER INTERFACES. THEN IT UPDATES THE HYDROSTATIC SURFACE ! PRESSURE, THE NONHYDROSTATIC PRESSURE, AND ADDS THE LOCAL TIME ! DERIVATIVE AND VERTICAL ADVECTION OF NONHYDROSTATIC PRESSURE ! CONTRIBUTION TO THE OMEGA-ALPHA TERM OF THE THERMODYNAMIC ! EQUATION. ALSO, THE OMEGA-ALPHA TERM IS COMPUTED FOR DIAGNOSTICS. ! PROGRAM HISTORY LOG: ! 87-06-?? JANJIC - ORIGINATOR ! 95-03-25 BLACK - CONVERSION FROM 1-D TO 2-D IN HORIZONTAL ! 96-05-?? JANJIC - ADDED NONHYDROSTATIC EFFECTS & MERGED THE ! PREVIOUS SUBROUTINES PDTE & PDNEW ! 00-01-03 BLACK - DISTRIBUTED MEMORY AND THREADS ! USAGE: CALL PDTEDT 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 ! CONTIN ! VRBLS ! NHYDRO ! INDX ! ATTRIBUTES: ! LANGUAGE: FORTRAN 90 ! MACHINE : IBM SP !$$$ !*********************************************************************** !----------------------------------------------------------------------- INCLUDE "EXCHM.h" INCLUDE "parmeta.f90" INCLUDE "mpp.h" !----------------------------------------------------------------------- PARAMETER & (IMJM=IM*JM-JM/2,JAM=6+2*(JM-10) & ,LM1=LM-1,LP1=LM+1 & ,ITRMX=0,WC=2./3.,RWCQ=(1.-WC)*0.25,RWC=1./WC) PARAMETER & (KSMUD=7,LNSDT=7) !----------------------------------------------------------------------- LOGICAL :: & RUN,FIRST,RESTRT,SIGMA !----------------------------------------------------------------------- INCLUDE "COMM_CTLBLK.f90" !----------------------------------------------------------------------- INCLUDE "COMM_LOOPS.f90" !----------------------------------------------------------------------- INCLUDE "COMM_MASKS.f90" !----------------------------------------------------------------------- INCLUDE "COMM_INDX.f90" !----------------------------------------------------------------------- INCLUDE "COMM_DYNAM.f90" !----------------------------------------------------------------------- INCLUDE "COMM_VRBLS.f90" !----------------------------------------------------------------------- INCLUDE "COMM_NHYDRO.f90" !----------------------------------------------------------------------- INCLUDE "COMM_CONTIN.f90" !----------------------------------------------------------------------- REAL :: & PRET (IDIM1:IDIM2,JDIM1:JDIM2),RPSL (IDIM1:IDIM2,JDIM1:JDIM2) & ,FNE (IDIM1:IDIM2,JDIM1:JDIM2),FSE (IDIM1:IDIM2,JDIM1:JDIM2) & ,HBMS (IDIM1:IDIM2,JDIM1:JDIM2) & ,TTB (IDIM1:IDIM2,JDIM1:JDIM2) & ,APDT (IDIM1:IDIM2,JDIM1:JDIM2),PPDT (IDIM1:IDIM2,JDIM1:JDIM2) & ,TPM (IDIM1:IDIM2,JDIM1:JDIM2) !----------------------------------------------------------------------- !----------------------------------------------------------------------- !*** !*** THE FOLLOWING ARE USED FOR TIMIMG PURPOSES ONLY !*** real*8 :: timef real :: nhb_tim,mpp_tim,init_tim common/timing/surfce_tim,nhb_tim,res_tim,exch_tim !*********************************************************************** !----------------------------------------------------------------------- CALL ZERO2(PDSLO) !--------------COMPUTATION OF PRESSURE TENDENCY & PREPARATIONS---------- DO 100 L=2,LM ! omp parallel do DO J=MYJS_P2,MYJE_P2 DO I=MYIS_P2,MYIE_P2 DIV(I,J,L)=DIV(I,J,L-1)+DIV(I,J,L) ENDDO ENDDO 100 END DO !----------------------------------------------------------------------- ! omp parallel do DO J=MYJS_P2,MYJE_P2 DO I=MYIS_P2,MYIE_P2 PSDT(I,J)=-DIV(I,J,LM) APDT(I,J)=PSDT(I,J) PPDT(I,J)=PSDT(I,J) PDSLO(I,J)=PDSL(I,J) RPSL(I,J)=1./PDSL(I,J) ENDDO ENDDO !----------------------------------------------------------------------- !--------------HARD+SOFT AIR DEAVERAGING BLOCK-------------------------- !----------------------------------------------------------------------- ! IF(ITRMX.GT.0)THEN !---------------------------------------------------------------------- ! DO 220 ITR=1,ITRMX !----------------------------------------------------------------------- !!$omp parallel do ! DO J=MYJS2_P4,MYJE2_P4 ! IHL=2 ! IHH=IM-2+MOD(J,2) ! DO I=MYIS1_P4,MYIE1_P4 ! PPDT(I,J)=(APDT(I,J) ! 2 -(PSDT(I+IHW(J),J-1)+PSDT(I+IHE(J),J-1) ! 3 +PSDT(I+IHW(J),J+1)+PSDT(I+IHE(J),J+1))*RWCQ) ! 4 *RWC ! ENDDO ! ENDDO !!$omp parallel do ! DO J=MYJS2_P4,MYJE2_P4 ! DO I=MYIS1_P4,MYIE1_P4 ! PSDT(I,J)=PPDT(I,J)*HBM2(I,J)+(1.-HBM2(I,J))*PSDT(I,J) ! ENDDO ! ENDDO !----------------------------------------------------------------------- ! 220 CONTINUE !----------------------------------------------------------------------- ! ENDIF !----------------------------------------------------------------------- ! omp parallel do DO J=MYJS_P2,MYJE_P2 DO I=MYIS_P2,MYIE_P2 PRET(I,J)=PSDT(I,J)*RES(I,J) PDSL(I,J)=PD(I,J)*RES(I,J) PINT(I,J,1)=PT TPM(I,J)=PT+PINT(I,J,2) TTB(I,J)=0. ENDDO ENDDO !----------------------------------------------------------------------- !--------------COMPUTATION OF ETADT------------------------------------- !----------------------------------------------------------------------- ! omp parallel do DO 300 L=1,LM1 DO J=MYJS_P2,MYJE_P2 DO I=MYIS_P2,MYIE_P2 ETADT(I,J,L)=-(PRET(I,J)*ETA(L+1)+DIV(I,J,L)) & *HTM(I,J,L+1)*HBM2(I,J)*RPSL(I,J) ENDDO ENDDO 300 END DO !----------------------------------------------------------------------- !--------------KINETIC ENERGY GENERATION TERMS IN T EQUATION------------ !----------------------------------------------------------------------- ! omp parallel do private (dwdtp,rhs,tpmp,ttal) DO J=MYJS,MYJE DO I=MYIS,MYIE DWDTP=DWDT(I,J,1) TPMP=PINT(I,J,2)+PINT(I,J,3) ! TTAL=(T(I,J,2)-T(I,J,1))*ETADT(I,J,1)*F4D*0.5 ! TTAL=(T(I,J,2)-T(I,J,1))*ETADT(I,J,1)*F4D TTAL=0. RHS=-DIV(I,J,1)*RTOP(I,J,1)*HTM(I,J,1)*DWDTP*EF4T OMGALF(I,J,1)=OMGALF(I,J,1)+RHS T(I,J,1)=(TTAL*RDETA(1)+RHS)*HBM2(I,J)+T(I,J,1) PINT(I,J,2)=PRET(I,J)*(ETA(1)+ETA(2))*DWDTP*DT & +TPM(I,J)-PINT(I,J,1) TPM(I,J)=TPMP TTB(I,J)=TTAL ENDDO ENDDO !----------------------------------------------------------------------- DO 410 L=2,LM1 ! omp parallel do private (dwdtp,rhs,tpmp,ttal) DO J=MYJS,MYJE DO I=MYIS,MYIE DWDTP=DWDT(I,J,L) TPMP=PINT(I,J,L+1)+PINT(I,J,L+2) ! TTAL=(T(I,J,L+1)-T(I,J,L))*ETADT(I,J,L)*F4D*0.5 ! TTAL=(T(I,J,L+1)-T(I,J,L))*ETADT(I,J,L)*F4D TTAL=0. RHS=-(DIV(I,J,L-1)+DIV(I,J,L))*RTOP(I,J,L)*HTM(I,J,L)*DWDTP & *EF4T OMGALF(I,J,L)=OMGALF(I,J,L)+RHS T(I,J,L)=((TTAL+TTB(I,J))*RDETA(L)+RHS)*HBM2(I,J)+T(I,J,L) PINT(I,J,L+1)=PRET(I,J)*(ETA(L)+ETA(L+1))*DWDTP*DT & +TPM(I,J)-PINT(I,J,L) TPM(I,J)=TPMP TTB(I,J)=TTAL ENDDO ENDDO 410 END DO !----------------------------------------------------------------------- ! omp parallel do private (dwdtp,rhs) DO J=MYJS,MYJE DO I=MYIS,MYIE DWDTP=DWDT(I,J,LM) RHS=-(DIV(I,J,LM1)+DIV(I,J,LM))*RTOP(I,J,LM)*HTM(I,J,LM)*DWDTP & *EF4T OMGALF(I,J,LM)=OMGALF(I,J,LM)+RHS T (I,J,LM)=(TTB(I,J)*RDETA(LM)+RHS)*HBM2(I,J)+T(I,J,LM) PINT(I,J,LM+1)=PRET(I,J)*(ETA(LM)+ETA(LM+1))*DWDTP*DT & +TPM(I,J)-PINT(I,J,LM) ENDDO ENDDO !----------------------------------------------------------------------- !-------------- REGENERATE THE UNINTEGRATED DIVERGENCE --------------- !----------------------------------------------------------------------- DO 425 L=LM,2,-1 ! omp parallel do DO J=MYJS,MYJE2 DO I=MYIS,MYIE DIV(I,J,L)=DIV(I,J,L)-DIV(I,J,L-1) ENDDO ENDDO 425 END DO !----------------------------------------------------------------------- !--------------SMOOTHING VERTICAL VELOCITY ALONG BOUNDARIES------------- !----------------------------------------------------------------------- IF( .NOT. HYDRO .AND. KSMUD > 0)THEN !----------------------------------------------------------------------- NSMUD=KSMUD ! omp parallel do DO J=MYJS,MYJE DO I=MYIS,MYIE HBMS(I,J)=HBM2(I,J) ENDDO ENDDO JHL=LNSDT JHH=JM-JHL+1 DO J=JHL,JHH IF(J >= MY_JS_GLB .AND. J <= MY_JE_GLB)THEN IHL=JHL/2+1 IHH=IM-IHL+MOD(J,2) DO I=IHL,IHH IF(I >= MY_IS_GLB .AND. I <= MY_IE_GLB)THEN IX=I-MY_IS_GLB+1 JX=J-MY_JS_GLB+1 HBMS(IX,JX)=0. ENDIF ENDDO ENDIF ENDDO !----------------------------------------------------------------------- DO KS=1,NSMUD !----------------------------------------------------------------------- ! omp parallel do private (etadtl,fne,fse) DO 450 L=1,LM-1 DO J=MYJS_P1,MYJE1_P1 DO I=MYIS_P1,MYIE1_P1 FNE(I,J)=(ETADT(I+IHE(J),J+1,L)-ETADT(I,J,L)) & *HTM(I,J,L+1)*HTM(I+IHE(J),J+1,L+1) ENDDO ENDDO DO J=MYJS1_P1,MYJE_P1 DO I=MYIS_P1,MYIE1_P1 FSE(I,J)=(ETADT(I+IHE(J),J-1,L)-ETADT(I,J,L)) & *HTM(I+IHE(J),J-1,L+1)*HTM(I,J,L+1) ENDDO ENDDO DO J=MYJS2,MYJE2 DO I=MYIS1,MYIE1 ETADTL=(FNE(I,J)-FNE(I+IHW(J),J-1) & +FSE(I,J)-FSE(I+IHW(J),J+1))*HBM2(I,J) ETADT(I,J,L)=ETADTL*HBMS(I,J)*0.125+ETADT(I,J,L) ENDDO ENDDO 450 END DO btim=timef() CALL EXCH(ETADT,LM-1,2,2) exch_tim=exch_tim+timef()-btim ENDDO !----------------------------------------------------------------------- ENDIF !----------------------------------------------------------------------- RETURN END SUBROUTINE PDTEDT