SUBROUTINE DIVHOA C ****************************************************************** C$$$ SUBPROGRAM DOCUMENTATION BLOCK C . . . C SUBPROGRAM: DIVHOA DIVERGENCE/HORIZONTAL OMEGA-ALPHA C PRGRMMR: JANJIC ORG: W/NP22 DATE: 93-10-28 C C ABSTRACT: C DIVHOA COMPUTES THE DIVERGENCE INCLUDING THE C MODIFICATION PREVENTING GRAVITY WAVE GRID SEPARATION, AND C CALCULATES THE HORIZONTAL PART OF THE OMEGA-ALPHA TERM C (THE PART PROPORTIONAL TO THE ADVECTION OF MASS ALONG C ETA SURFACES). C C PROGRAM HISTORY LOG: C 87-06-?? JANJIC - ORIGINATOR C 95-03-25 BLACK - CONVERSION FROM 1-D TO 2-D IN HORIZONTAL C 96-03-29 BLACK - ADDED EXTERNAL EDGE C 97-03-17 MESINGER - SPLIT FROM PFDHT C 98-10-30 BLACK - MODIFIED FOR DISTRIBUTED MEMORY C C USAGE: CALL DIVHOA FROM MAIN PROGRAM EBU C INPUT ARGUMENT LIST: C NONE C C OUTPUT ARGUMENT LIST: C NONE C C OUTPUT FILES: C NONE C C SUBPROGRAMS CALLED: C C UNIQUE: NONE C C LIBRARY: NONE C C COMMON BLOCKS: CTLBLK C MASKS C DYNAM C VRBLS C INDX C C ATTRIBUTES: C LANGUAGE: FORTRAN 90 C MACHINE : IBM SP C$$$ C*********************************************************************** P A R A M E T E R & (CP=1004.6) C----------------------------------------------------------------------- INCLUDE "parmeta" INCLUDE "mpp.h" #include "sp.h" C----------------------------------------------------------------------- P A R A M E T E R & (IMJM=IM*JM-JM/2,JAM=6+2*(JM-10),LP1=LM+1) C----------------------------------------------------------------------- L O G I C A L & RUN,FIRST,RESTRT,SIGMA C---------------------------------------------------------------------- INCLUDE "CTLBLK.comm" C----------------------------------------------------------------------- INCLUDE "MASKS.comm" C----------------------------------------------------------------------- INCLUDE "DYNAM.comm" C----------------------------------------------------------------------- INCLUDE "VRBLS.comm" INCLUDE "PVRBLS.comm" INCLUDE "CLDWTR.comm" C----------------------------------------------------------------------- INCLUDE "CONTIN.comm" C----------------------------------------------------------------------- INCLUDE "INDX.comm" C----------------------------------------------------------------------- D I M E N S I O N & FILO (IDIM1:IDIM2,JDIM1:JDIM2),RDPD (IDIM1:IDIM2,JDIM1:JDIM2) &,ADPDX (IDIM1:IDIM2,JDIM1:JDIM2),ADPDY (IDIM1:IDIM2,JDIM1:JDIM2) &,FIUP (IDIM1:IDIM2,JDIM1:JDIM2),F0 (IDIM1:IDIM2,JDIM1:JDIM2) &,ADPDNE(IDIM1:IDIM2,JDIM1:JDIM2),ADPDSE(IDIM1:IDIM2,JDIM1:JDIM2) &,PEW (IDIM1:IDIM2,JDIM1:JDIM2),PNS (IDIM1:IDIM2,JDIM1:JDIM2) &,PCEW (IDIM1:IDIM2,JDIM1:JDIM2),PCNS (IDIM1:IDIM2,JDIM1:JDIM2) &,DPFEW (IDIM1:IDIM2,JDIM1:JDIM2),DPFNS (IDIM1:IDIM2,JDIM1:JDIM2) &,FNS (IDIM1:IDIM2,JDIM1:JDIM2),TNS (IDIM1:IDIM2,JDIM1:JDIM2) &,DPNE (IDIM1:IDIM2,JDIM1:JDIM2),DPSE (IDIM1:IDIM2,JDIM1:JDIM2) &,DCNE (IDIM1:IDIM2,JDIM1:JDIM2),DCSE (IDIM1:IDIM2,JDIM1:JDIM2) &,DPFNE (IDIM1:IDIM2,JDIM1:JDIM2),DPFSE (IDIM1:IDIM2,JDIM1:JDIM2) &,UP (IDIM1:IDIM2,JDIM1:JDIM2),VP (IDIM1:IDIM2,JDIM1:JDIM2) &,PVNE (IDIM1:IDIM2,JDIM1:JDIM2),PVSE (IDIM1:IDIM2,JDIM1:JDIM2) &,VM (IDIM1:IDIM2,JDIM1:JDIM2),HM (IDIM1:IDIM2,JDIM1:JDIM2) C D I M E N S I O N & DPDE (IDIM1:IDIM2,JDIM1:JDIM2),FIM (IDIM1:IDIM2,JDIM1:JDIM2) &,APEL (IDIM1:IDIM2,JDIM1:JDIM2),PCXC (IDIM1:IDIM2,JDIM1:JDIM2) &,UDY (IDIM1:IDIM2,JDIM1:JDIM2),VDX (IDIM1:IDIM2,JDIM1:JDIM2) &,TEW (IDIM1:IDIM2,JDIM1:JDIM2),FEW (IDIM1:IDIM2,JDIM1:JDIM2) &,TNE (IDIM1:IDIM2,JDIM1:JDIM2),TSE (IDIM1:IDIM2,JDIM1:JDIM2) &,FNE (IDIM1:IDIM2,JDIM1:JDIM2),FSE (IDIM1:IDIM2,JDIM1:JDIM2) &,PNE (IDIM1:IDIM2,JDIM1:JDIM2),PSE (IDIM1:IDIM2,JDIM1:JDIM2) &,CNE (IDIM1:IDIM2,JDIM1:JDIM2),CSE (IDIM1:IDIM2,JDIM1:JDIM2) &,PPNE (IDIM1:IDIM2,JDIM1:JDIM2),PPSE (IDIM1:IDIM2,JDIM1:JDIM2) &,PCNE (IDIM1:IDIM2,JDIM1:JDIM2),PCSE (IDIM1:IDIM2,JDIM1:JDIM2) C----------------------------------------------------------------------- C----------------------------------------------------------------------- CALL ZERO2(DPDE) CALL ZERO2(PNE) CALL ZERO2(CNE) CALL ZERO2(PSE) CALL ZERO2(CSE) CALL ZERO2(ADPDX) CALL ZERO2(ADPDY) call zero2(filo) call zero2(pdsl) c call zero3(div) C----------------------------------------------------------------------- C--------------PREPARATORY CALCULATIONS--------------------------------- C----------------------------------------------------------------------- IF(SIGMA)THEN !$omp parallel do DO 50 J=MYJS_P4,MYJE_P4 DO 50 I=MYIS_P4,MYIE_P4 FILO(I,J)=FIS(I,J) PDSL(I,J)=PD(I,J) 50 CONTINUE ELSE !$omp parallel do DO 100 J=MYJS_P4,MYJE_P4 DO 100 I=MYIS_P4,MYIE_P4 FILO(I,J)=0. PDSL(I,J)=RES(I,J)*PD(I,J) 100 CONTINUE ENDIF C !$omp parallel do DO 110 L=1,LM DO J=MYJS,MYJE DO I=MYIS,MYIE DIV(I,J,L)=0. OMGALF(I,J,L)=0. ENDDO ENDDO 110 CONTINUE C !$omp parallel do DO J=MYJS,MYJE DO I=MYIS,MYIE ADPDX(I,J)=0. ADPDY(I,J)=0. ENDDO ENDDO C--------------MAIN VERTICAL INTEGRATION LOOP--------------------------- DO 400 L=LM,1,-1 C----------------------------------------------------------------------- !$omp parallel do DO 210 J=MYJS_P4,MYJE_P4 DO 210 I=MYIS_P4,MYIE_P4 DPDE(I,J)=DETA(L)*PDSL(I,J) RDPD(I,J)=1./DPDE(I,J) 210 CONTINUE C !$omp parallel do DO 220 J=MYJS1_P2,MYJE1_P2 DO 220 I=MYIS_P2,MYIE1_P2 ADPDX(I,J)=DPDE(I+IVW(J),J)+DPDE(I+IVE(J),J) ADPDY(I,J)=DPDE(I,J-1)+DPDE(I,J+1) 220 CONTINUE C----------------------------------------------------------------------- !$omp parallel do private(fiupk) DO 230 J=MYJS_P4,MYJE_P4 DO 230 I=MYIS_P4,MYIE_P4 c if(mype.eq.12.and.i.eq.8.and.j.eq.23) then c print*,'i,j,pdsl(i,j)=',i,j,pdsl(i,j) c print*,'l,aeta(l),pt=',l,aeta(l),pt c endif APEL(I,J)=PT+AETA(L)*PDSL(I,J) c if(mype.eq.12.and.i.eq.8.and.j.eq.23) then c print*,'l,q(i,j,l)=',l,q(i,j,l) c endif RTOP(I,J,L)=R*T(I,J,L)*(1.+0.608*Q(I,J,L))/APEL(I,J) FIUPK=FILO(I,J)+RTOP(I,J,L)*DPDE(I,J) FIM(I,J)=FILO(I,J)+FIUPK FILO(I,J)=DFL(L)+HTM(I,J,L)*(FIUPK-DFL(L)) 230 CONTINUE C--------------DIAGONAL CONTRIBUTIONS TO PRESSURE GRADIENT FORCE-------- !$omp parallel do DO 240 J=MYJS_P3,MYJE1_P3 DO 240 I=MYIS_P3,MYIE1_P3 ADPDNE(I,J)=DPDE(I+IHE(J),J+1)+DPDE(I,J) PNE(I,J)=2.*(FIM(I+IHE(J),J+1)-FIM(I,J)) PPNE(I,J)=PNE(I,J)*ADPDNE(I,J) CNE(I,J)=2.*(RTOP(I+IHE(J),J+1,L)+RTOP(I,J,L)) 1 *(APEL(I+IHE(J),J+1)-APEL(I,J)) PCNE(I,J)=CNE(I,J)*ADPDNE(I,J) 240 CONTINUE C !$omp parallel do DO 250 J=MYJS1_P3,MYJE_P3 DO 250 I=MYIS_P3,MYIE1_P3 ADPDSE(I,J)=DPDE(I+IHE(J),J-1)+DPDE(I,J) PSE(I,J)=2.*(FIM(I+IHE(J),J-1)-FIM(I,J)) PPSE(I,J)=PSE(I,J)*ADPDSE(I,J) CSE(I,J)=2.*(RTOP(I+IHE(J),J-1,L)+RTOP(I,J,L)) 1 *(APEL(I+IHE(J),J-1)-APEL(I,J)) PCSE(I,J)=CSE(I,J)*ADPDSE(I,J) 250 CONTINUE C--------------CONTINUITY EQUATION MODIFICATION------------------------- !$omp parallel do DO 260 J=MYJS1_P1,MYJE1_P1 DO 260 I=MYIS_P1,MYIE_P1 PCXC(I,J)=VBM3(I,J)*VTM(I,J,L)*(PNE(I+IVW(J),J) 1 +CNE(I+IVW(J),J)+PSE(I+IVW(J),J)+CSE(I+IVW(J),J) 2 -PNE(I,J-1)-CNE(I,J-1)-PSE(I,J+1)-CSE(I,J+1)) 260 CONTINUE C----------------------------------------------------------------------- !$omp parallel do DO 270 J=MYJS2,MYJE2 DO 270 I=MYIS1,MYIE1 DIV(I,J,L)=DETA(L)*WPDAR(I,J) 1 *(PCXC(I+IHE(J),J)-PCXC(I,J+1) 2 +PCXC(I+IHW(J),J)-PCXC(I,J-1)) 270 CONTINUE C--------------LAT & LONG PRESSURE FORCE COMPONENTS--------------------- !$omp parallel do DO 280 J=MYJS1_P2,MYJE1_P2 DO 280 I=MYIS_P2,MYIE_P2 DCNEK=CNE(I+IVW(J),J)+CNE(I,J-1) DCSEK=CSE(I+IVW(J),J)+CSE(I,J+1) c if(mype.eq.12) then c print*,'i,j,dcnek,dcsek,adpdx(i,j)=',i,j,dcnek,dcsek,adpdx(i,j) c endif PCEW(I,J)=(DCNEK+DCSEK)*ADPDX(I,J) PCNS(I,J)=(DCNEK-DCSEK)*ADPDY(I,J) 280 CONTINUE C--------------LAT & LON FLUXES & OMEGA-ALPHA COMPONENTS---------------- !$omp parallel do DO 310 J=MYJS1_P2,MYJE1_P2 DO 310 I=MYIS_P2,MYIE_P2 UDY(I,J)=DY*U(I,J,L) FEW(I,J)=UDY(I,J)*ADPDX(I,J) TEW(I,J)=UDY(I,J)*PCEW(I,J) VDX(I,J)=DX(I,J)*V(I,J,L) FNS(I,J)=VDX(I,J)*ADPDY(I,J) TNS(I,J)=VDX(I,J)*PCNS(I,J) 310 CONTINUE C--------------DIAGONAL FLUXES AND DIAGONALLY AVERAGED WIND------------- !$omp parallel do DO 320 J=MYJS1_P1,MYJE2_P1 DO 320 I=MYIS_P1,MYIE1_P1 PVNEK=(UDY(I+IHE(J),J)+VDX(I+IHE(J),J))+(UDY(I,J+1)+VDX(I,J+1)) FNE(I,J)=PVNEK*ADPDNE(I,J) TNE(I,J)=PVNEK*PCNE(I,J)*2. 320 CONTINUE C !$omp parallel do DO 330 J=MYJS2_P1,MYJE1_P1 DO 330 I=MYIS_P1,MYIE1_P1 PVSEK=(UDY(I+IHE(J),J)-VDX(I+IHE(J),J))+(UDY(I,J-1)-VDX(I,J-1)) FSE(I,J)=PVSEK*ADPDSE(I,J) TSE(I,J)=PVSEK*PCSE(I,J)*2. 330 CONTINUE C--------------HORIZONTAL PART OF OMEGA-ALPHA & DIVERGENCE-------------- !$omp parallel do DO 340 J=MYJS2,MYJE2 DO 340 I=MYIS1,MYIE1 HM(I,J)=HTM(I,J,L)*HBM2(I,J) TTK=T(I,J,L) OMGALF(I,J,L)=(TEW(I+IHE(J),J)+TEW(I+IHW(J),J)+TNS(I,J+1) 1 +TNS(I,J-1)+TNE(I,J)+TNE(I+IHW(J),J-1)+TSE(I,J) 2 +TSE(I+IHW(J),J+1))*RDPD(I,J)*FCP(I,J)*HM(I,J) T(I,J,L)=OMGALF(I,J,L)+T(I,J,L) DIV(I,J,L)=(((FEW(I+IHE(J),J)+FNS(I,J+1)+FNE(I,J)+FSE(I,J)) 1 -(FEW(I+IHW(J),J)+FNS(I,J-1)+FNE(I+IHW(J),J-1) 2 +FSE(I+IHW(J),J+1)))*FDIV(I,J)+DIV(I,J,L))*HM(I,J) 340 CONTINUE C----------------------------------------------------------------------- 400 CONTINUE C----------------------------------------------------------------------- RETURN END