A ROTINA DA ESQUERDA É A VERSÃO ANTIGA DE 2012 E A ROTINA DA DIREITA É A VERSÃO MODULAR DO Eta1km SUBROUTINE DIVHOAST | SUBROUTINE DIVHOAST C ****************************************************************** | !>---------------------------------------------------------------------------------------------- C$$$ SUBPROGRAM DOCUMENTATION BLOCK | !> SUBROUTINE DIVHOAST C . . . | !> C SUBPROGRAM: DIVHOA DIVERGENCE/HORIZONTAL OMEGA-ALPHA | !> SUBPROGRAM: DIVHOA - DIVERGENCE / HORIZONTAL OMEGA-ALPHA C PRGRMMR: JANJIC ORG: W/NP22 DATE: 93-10-28 | !> PROGRAMMER: JANJIC C | !> ORG: W/NP22 C ABSTRACT: | !> DATE: 93-10-28 C DIVHOA COMPUTES THE DIVERGENCE INCLUDING THE | !> C MODIFICATION PREVENTING GRAVITY WAVE GRID SEPARATION, AND | !> ABSTRACT: C CALCULATES THE HORIZONTAL PART OF THE OMEGA-ALPHA TERM | !> DIVHOA COMPUTES THE DIVERGENCE INCLUDING THE MODIFICATION PREVENTING GRAVITY WAVE GRID SEPARA C (THE PART PROPORTIONAL TO THE ADVECTION OF MASS ALONG | !> AND CALCULATES THE HORIZONTAL PART OF THE OMEGA-ALPHA TERM (THE PART PROPORTIONAL TO THE C ETA/SIGMA SURFACES). | !> ADVECTION OF MASS ALONG ETA / SIGMA SURFACES). C | !> C MODIFIED TO INCLUDE DIVERGENCE RESULTING FROM SLOPING STEPS | !> MODIFIED TO INCLUDE DIVERGENCE RESULTING FROM SLOPING STEPS ("S": DIVHOAST) C ("S": DIVHOAST) | !> EXPANDED TO ALSO SLANTWISE T ADVECTION ("T": DIVHOAST), ALONG WITH APPROPRIATE OMEGA-ALPHA C EXPANDED to do also Slantwise T Advection ("T": DIVHOAST), along | !> CHANGES TO THE ADVECTED T. C with appropriate omega-alpha changes to the advected T. | !> C Warning: this makes Subroutine SLADVT redundant | !> WARNING: THIS MAKES SUBROUTINE SLADVT REDUNDANT (NEEDS TO BE COMENTED OUT OR REMOVED). C (needs to be commented out or removed) | !> C*********************************************************************** | !> PROGRAM HISTORY LOG: C PROGRAM HISTORY LOG: | !> 87-06-?? JANJIC - ORIGINATOR C 87-06-?? JANJIC - ORIGINATOR | !> 95-03-25 BLACK - CONVERSION FROM 1-D TO 2-D IN HORIZONTAL C 95-03-25 BLACK - CONVERSION FROM 1-D TO 2-D IN HORIZONTAL | !> 96-03-29 BLACK - ADDED EXTERNAL EDGE C 96-03-29 BLACK - ADDED EXTERNAL EDGE | !> 97-03-17 MESINGER - SPLIT FROM PFDHT C 97-03-17 MESINGER - SPLIT FROM PFDHT | !> 98-10-30 BLACK - MODIFIED FOR DISTRIBUTED MEMORY C 98-10-30 BLACK - MODIFIED FOR DISTRIBUTED MEMORY | !> 00-10-20 BLACK - INCORPORATED PRESSURE GRADIENT METHOD FROM MESO MODEL C 00-10-20 BLACK - INCORPORATED PRESSURE GRADIENT METHOD | !> 06-04-04 MESINGER AND JOVIC - ADDED DIVERGENCE CALCULATION DUE TO SLOPES C FROM MESO MODEL | !> 06-05-?? MESINGER, AT CPTEC - EXPANDED TO INCLUDE SLANTWISE T ADV. C | !> 06-06-?? MESINGER AND JOVIC - REVISED OMEGA-ALPHA DUE TO SLOPES C 04 MESINGER and JOVIC - ADDED DIVERGENCE CALCULATION DUE TO SLOPES | !> 18-01-15 LUCCI - MODERNIZATION OF THE CODE, INCLUDING: C May 2006 MESINGER, at CPTEC - EXPANDED TO INCLUDE SLANTWISE T ADV. | !> * F77 TO F90/F95 C June 2006 MESINGER and JOVIC - REVISED OMEGA-ALPHA DUE TO SLOPES | !> * INDENTATION & UNIFORMIZATION CODE C | !> * REPLACEMENT OF COMMONS BLOCK FOR MODULES C USAGE: CALL DIVHOA FROM MAIN PROGRAM EBU | !> * DOCUMENTATION WITH DOXYGEN C INPUT ARGUMENT LIST: | !> * OPENMP FUNCTIONALITY C NONE | !> C | !> INPUT ARGUMENT LIST: C OUTPUT ARGUMENT LIST: | !> NONE C NONE | !> C | !> OUTPUT ARGUMENT LIST: C OUTPUT FILES: | !> NONE C NONE | !> C | !> INPUT/OUTPUT ARGUMENT LIST: C SUBPROGRAMS CALLED: | !> NONE C | !> C UNIQUE: NONE | !> USE MODULES: CONTIN C | !> CTLBLK C LIBRARY: NONE | !> DYNAM C | !> F77KINDS C COMMON BLOCKS: CTLBLK | !> GLB_TABLE C MASKS | !> INDX C LOOPS | !> LOOPS C DYNAM | !> MAPPINGS C VRBLS | !> MASKS C CONTIN | !> MPPCOM C INDX | !> NHYDRO C | !> PARMETA C ATTRIBUTES: | !> SLOPES C LANGUAGE: FORTRAN 90 | !> TEMPCOM C MACHINE : IBM SP | !> TOPO C$$$ | !> VRBLS C*********************************************************************** | !> C----------------------------------------------------------------------- | !> DRIVER : EBU INCLUDE "parmeta" | !> INCLUDE "mpp.h" | !> CALLS : ZERO2 C----------------------------------------------------------------------- | !>---------------------------------------------------------------------------------------------- P A R A M E T E R | USE CONTIN & (LP1=LM+1,JAM=6+2*(JM-10),RFCP=1.E0/(4.E0*1004.6E0)) | USE CTLBLK C----------------------------------------------------------------------- | USE DYNAM L O G I C A L | USE F77KINDS & RUN,FIRST,RESTRT,SIGMA | USE GLB_TABLE C---------------------------------------------------------------------- | USE INDX INCLUDE "CTLBLK.comm" | USE LOOPS c----------------------------------------------------------------------- | USE MAPOT include "LOOPS.comm" | USE MAPPINGS C----------------------------------------------------------------------- | USE MASKS INCLUDE "MASKS.comm" | USE MPPCOM C----------------------------------------------------------------------- | USE NHYDRO INCLUDE "INDX.comm" | USE PARMETA c----------------------------------------------------------------------- | USE SLOPES INCLUDE "DYNAM.comm" | USE TEMPCOM C----------------------------------------------------------------------- | USE TOPO INCLUDE "VRBLS.comm" | USE VRBLS C----------------------------------------------------------------------- | ! INCLUDE "CONTIN.comm" | IMPLICIT NONE C----------------------------------------------------------------------- | ! INCLUDE "NHYDRO.comm" | REAL (KIND=R4KIND), PARAMETER :: RFCP = 1.E0 / (4.E0 * 1004.6E0) C----------------------------------------------------------------------- | ! INCLUDE "SLOPES.comm" | REAL (KIND=R4KIND), DIMENSION(IDIM1:IDIM2, JDIM1:JDIM2, LM+1) C----------------------------------------------------------------------- | & PINTLG R E A L | & PINTLG(IDIM1:IDIM2,JDIM1:JDIM2,LM+1) | REAL (KIND=R4KIND), DIMENSION(IDIM1:IDIM2, JDIM1:JDIM2) C | & FIM , R E A L | & FILO , RDPD , & FIM (IDIM1:IDIM2,JDIM1:JDIM2) | & ADPDX , RDPDX , &,FILO (IDIM1:IDIM2,JDIM1:JDIM2),RDPD (IDIM1:IDIM2,JDIM1:JDIM2) | & ADPDY , RDPDY , &,ADPDX (IDIM1:IDIM2,JDIM1:JDIM2),RDPDX (IDIM1:IDIM2,JDIM1:JDIM2) | & ADPDNE , ADPDSE , &,ADPDY (IDIM1:IDIM2,JDIM1:JDIM2),RDPDY (IDIM1:IDIM2,JDIM1:JDIM2) | & PEW , PNS , &,ADPDNE(IDIM1:IDIM2,JDIM1:JDIM2),ADPDSE(IDIM1:IDIM2,JDIM1:JDIM2) | & PCEW , PCNS , &,PEW (IDIM1:IDIM2,JDIM1:JDIM2),PNS (IDIM1:IDIM2,JDIM1:JDIM2) | & DPFEW , DPFNS , &,PCEW (IDIM1:IDIM2,JDIM1:JDIM2),PCNS (IDIM1:IDIM2,JDIM1:JDIM2) | & FNS , TNS , &,DPFEW (IDIM1:IDIM2,JDIM1:JDIM2),DPFNS (IDIM1:IDIM2,JDIM1:JDIM2) | & HM , VM , &,FNS (IDIM1:IDIM2,JDIM1:JDIM2),TNS (IDIM1:IDIM2,JDIM1:JDIM2) | & EDIV , DIVL &,HM (IDIM1:IDIM2,JDIM1:JDIM2),VM (IDIM1:IDIM2,JDIM1:JDIM2) | ! &,EDIV (IDIM1:IDIM2,JDIM1:JDIM2),DIVL (IDIM1:IDIM2,JDIM1:JDIM2) | REAL (KIND=R4KIND), DIMENSION(IDIM1:IDIM2, JDIM1:JDIM2) C | & DPDE , R E A L | & APEL , PCXC , & DPDE (IDIM1:IDIM2,JDIM1:JDIM2) | & ALP1 , &,APEL (IDIM1:IDIM2,JDIM1:JDIM2),PCXC (IDIM1:IDIM2,JDIM1:JDIM2) | & DFDZ , &,ALP1 (IDIM1:IDIM2,JDIM1:JDIM2) | & UDY , VDX , &,DFDZ (IDIM1:IDIM2,JDIM1:JDIM2) | & TEW , FEW , &,UDY (IDIM1:IDIM2,JDIM1:JDIM2),VDX (IDIM1:IDIM2,JDIM1:JDIM2) | & TNE , TSE , &,TEW (IDIM1:IDIM2,JDIM1:JDIM2),FEW (IDIM1:IDIM2,JDIM1:JDIM2) | & FNE , FSE , &,TNE (IDIM1:IDIM2,JDIM1:JDIM2),TSE (IDIM1:IDIM2,JDIM1:JDIM2) | & PNE , PSE , &,FNE (IDIM1:IDIM2,JDIM1:JDIM2),FSE (IDIM1:IDIM2,JDIM1:JDIM2) | & CNE , CSE , &,PNE (IDIM1:IDIM2,JDIM1:JDIM2),PSE (IDIM1:IDIM2,JDIM1:JDIM2) | & PPNE , PPSE , &,CNE (IDIM1:IDIM2,JDIM1:JDIM2),CSE (IDIM1:IDIM2,JDIM1:JDIM2) | & PCNE , PCSE , &,PPNE (IDIM1:IDIM2,JDIM1:JDIM2),PPSE (IDIM1:IDIM2,JDIM1:JDIM2) | & DIVS , DPDEP1 , &,PCNE (IDIM1:IDIM2,JDIM1:JDIM2),PCSE (IDIM1:IDIM2,JDIM1:JDIM2) | & ATC , ATCP1 &,DIVS (IDIM1:IDIM2,JDIM1:JDIM2),DPDEP1(IDIM1:IDIM2,JDIM1:JDIM2) | !------------------------ &,ATC (IDIM1:IDIM2,JDIM1:JDIM2),ATCP1 (IDIM1:IDIM2,JDIM1:JDIM2) | ! IMPLICIT NONE VARIABLES C----------------------------------------------------------------------- | !------------------------ C----------------------------------------------------------------------- | INTEGER(KIND=I4KIND) CALL ZERO2(ALP1) | & I , J , K CALL ZERO2(DPDE) | ! CALL ZERO2(APEL) | REAL (KIND=R4KIND) CALL ZERO2(PCXC) | & ALP1P , ALP1X , DFI , RDPDS , FIUPK , ALP1PL , ALP2P , ALP2PL , DPNEK , CALL ZERO2(DFDZ) | & DPSEK , DCNEK , DCSEK , PVNEK , PVSEK , TOASL , OAADP1 , TFSTR , FSTR , CALL ZERO2(UDY) | & STSEP1 , STNE , STSE , STNEM1 , STEW , STNS , WDEP , DPT , WDUTD , CALL ZERO2(VDX) | & WARR CALL ZERO2(TEW) | ! CALL ZERO2(FEW) | CALL ZERO2(ALP1) CALL ZERO2(TNE) | CALL ZERO2(DPDE) CALL ZERO2(TSE) | CALL ZERO2(APEL) CALL ZERO2(FNE) | CALL ZERO2(PCXC) CALL ZERO2(FSE) | CALL ZERO2(DFDZ) CALL ZERO2(PNE) | CALL ZERO2(UDY) CALL ZERO2(PSE) | CALL ZERO2(VDX) CALL ZERO2(CNE) | CALL ZERO2(TEW) CALL ZERO2(CSE) | CALL ZERO2(FEW) CALL ZERO2(PPNE) | CALL ZERO2(TNE) CALL ZERO2(PPSE) | CALL ZERO2(TSE) CALL ZERO2(PCNE) | CALL ZERO2(FNE) CALL ZERO2(PCSE) | CALL ZERO2(FSE) C----------------------------------------------------------------------- | CALL ZERO2(PNE) C--------------PREPARATORY CALCULATIONS--------------------------------- | CALL ZERO2(PSE) C----------------------------------------------------------------------- | CALL ZERO2(CNE) IF(SIGMA)THEN | CALL ZERO2(CSE) !$omp parallel do | CALL ZERO2(PPNE) DO 50 J=MYJS_P5,MYJE_P5 | CALL ZERO2(PPSE) DO 50 I=MYIS_P5,MYIE_P5 | CALL ZERO2(PCNE) FILO(I,J)=FIS(I,J) | CALL ZERO2(PCSE) PDSL(I,J)=PD(I,J) | !------------------------- 50 CONTINUE | ! PREPARATORY CALCULATIONS ELSE | !------------------------- !$omp parallel do | IF (SIGMA) THEN DO 100 J=MYJS_P5,MYJE_P5 | !------- DO 100 I=MYIS_P5,MYIE_P5 | ! OPENMP FILO(I,J)=0.0 | !------- PDSL(I,J)=RES(I,J)*PD(I,J) | ! 100 CONTINUE | !$omp parallel do ENDIF | ! C | DO 50 J=MYJS_P5,MYJE_P5 IF(HYDRO)THEN | DO 50 I=MYIS_P5,MYIE_P5 !$omp parallel do | FILO(I,J) = FIS(I,J) DO L=1,LM+1 | PDSL(I,J) = PD(I,J) DO J=MYJS_P5,MYJE_P5 | 50 END DO DO I=MYIS_P5,MYIE_P5 | ! PINTLG(I,J,L)=ALOG(ETA(L)*PDSL(I,J)+PT) | ELSE ENDDO | !------- ENDDO | ! OPENMP ENDDO | !------- ELSE | ! !$omp parallel do | !$omp parallel do DO L=1,LM+1 | ! DO J=MYJS_P5,MYJE_P5 | DO 100 J=MYJS_P5,MYJE_P5 DO I=MYIS_P5,MYIE_P5 | DO 100 I=MYIS_P5,MYIE_P5 PINTLG(I,J,L)=ALOG(PINT(I,J,L)) | FILO(I,J) = 0.0 ENDDO | PDSL(I,J) = RES(I,J) * PD(I,J) ENDDO | 100 END DO ENDDO | ! ENDIF | END IF C | ! !$omp parallel do | IF (HYDRO) THEN DO L=1,LM | !------- DO J=MYJS_P4,MYJE_P4 | ! OPENMP DO I=MYIS_P4,MYIE_P4 | !------- OMGALF(I,J,L)=0. | ! DIV(I,J,L)=0. | !$omp parallel do ENDDO | ! ENDDO | DO K=1,LM+1 ENDDO | DO J=MYJS_P5,MYJE_P5 | DO I=MYIS_P5,MYIE_P5 DO J=MYJS_P4,MYJE_P4 | PINTLG(I,J,K) = ALOG(ETA(K) * PDSL(I,J) + PT) DO I=MYIS_P4,MYIE_P4 | END DO DIVS(I,J)=0. | END DO C DIVergence to Save is needed to collect contributions to DIV due to | END DO C slopes at h points of the layer being processed (L). They can be | ! C added only once the code moves one layer up. The reason is that the | ELSE C collection is done for points also sideways of the h point that the | !------- C code is processing, so that if added immediatelly these would be | ! OPENMP C lost when the code visits these sideways located points, and puts | !------- C the divergence "correction" into DIV (loop 270) | ! | !$omp parallel do C Accumulated T changes at L and at L+1 | ! ATC (I,J)=0.0 | DO K=1,LM+1 ATCP1(I,J)=0.0 | DO J=MYJS_P5,MYJE_P5 ENDDO | DO I=MYIS_P5,MYIE_P5 ENDDO | PINTLG(I,J,K) = ALOG(PINT(I,J,K)) | END DO C----------------------------------------------------------------------- | END DO !$omp parallel do private (alp1x) | END DO DO J=MYJS_P5,MYJE_P5 | ! DO I=MYIS_P5,MYIE_P5 | END IF ALP1X=PINTLG(I,J,LM+1) | !------- ALP1(I,J)=ALP1X | ! OPENMP ENDDO | !------- ENDDO | ! C----------------------------------------------------------------------- | !$omp parallel do C-------------------- MAIN VERTICAL INTEGRATION LOOP ------------------- | ! C----------------------------------------------------------------------- | DO K=1,LM DO 400 L=LM,1,-1 | DO J=MYJS_P4,MYJE_P4 C----------------------------------------------------------------------- | DO I=MYIS_P4,MYIE_P4 C*** | OMGALF(I,J,K) = 0. C*** INTEGRATE THE GEOPOTENTIAL | DIV(I,J,K) = 0. C*** | END DO Cmp | END DO FIM=0. | END DO Cmp | ! C | DO J=MYJS_P4,MYJE_P4 !$omp parallel do private (alp1p,dfi,fiupk,rdpds) | DO I=MYIS_P4,MYIE_P4 C write(6,*) 'FIM defined over I: ', MYIS_P5,MYIE_P5 | DIVS(I,J) = 0. C write(6,*) 'FIM defined over J: ', MYJS_P5,MYJE_P5 | !----------------------------------------------------------------------------------------------- DO 125 J=MYJS_P5,MYJE_P5 | ! DIVERGENCE TO SAVE IS NEEDED TO COLLECT CONTRIBUTIONS TO DIV DUE TO SLOPES AT H POINTS OF THE DO 125 I=MYIS_P5,MYIE_P5 | ! LAYER BEING PROCESSED (L). C | ! THEY CAN BE ADDED ONLY ONCE THE CODE MOVES ONE LAYER UP. ALP1P=PINTLG(I,J,L) | ! THE REASON IS THAT THE COLLECTION IS DONE FOR POINTS ALSO SIDEWAYS OF THE H POINT THAT THE COD C | ! IS PROCESSING, SO THAT IF ADDED IMMEDIATELLY THESE WOULD BE LOST WHEN THE CODE VISITS THESE DFI=(Q(I,J,L)*0.608+1.)*T(I,J,L)*R*(ALP1(I,J)-ALP1P)/DWDT(I,J,L) | ! SIDEWAYS LOCATED POINTS, AND PUTS THE DIVERGENCE "CORRECTION"INTO DIV (LOOP 270) C | ! RDPDS=1./(DETA(L)*PDSL(I,J)) | ! ACCUMULATED T CHANGES AT L AND AT L+1 RTOP(I,J,L)=RDPDS*DFI | !----------------------------------------------------------------------------------------------- FIUPK=FILO(I,J)+DFI | ATC(I,J) = 0.0 FIM(I,J)=FILO(I,J)+FIUPK | ATCP1(I,J) = 0.0 if (abs(FIM(I,J)) .le. 5.e+10) then | END DO else | END DO write(6,*) 'bad FIM ', I,J,FIM(I,J),FILO(I,J),DFI | !------- write(6,*) 'Q,T,ALP1,ALP1P,DWDT: ', | ! OPENMP + Q(I,J,L),T(I,J,L),ALP1(I,J),ALP1P,DWDT(I,J,L) | !------- STOP | ! endif | !$omp parallel do private (ALP1X) C | ! FILO(I,J)=(FIUPK-DFL(L))*HTM(I,J,L)+DFL(L) | DO J=MYJS_P5,MYJE_P5 ALP1(I,J)=ALP1P | DO I=MYIS_P5,MYIE_P5 125 CONTINUE | ALP1X = PINTLG(I,J,LM+1) C | ALP1(I,J) = ALP1X C----------------------------------------------------------------------- | END DO !$omp parallel do private (alp1p,alp1pl,alp2p,alp2pl,dfi) | END DO DO 205 J=MYJS_P5,MYJE_P5 | !------------------------------- DO 205 I=MYIS_P5,MYIE_P5 | ! MAIN VERTICAL INTEGRATION LOOP HM(I,J)=HTM(I,J,L)*HBM2(I,J) | !------------------------------- VM(I,J)=VTM(I,J,L)*VBM2(I,J) | DO 400 K=LM,1,-1 C | !--------------------------- ALP1P =PINTLG(I,J,L) | ! INTEGRATE THE GEOPOTENTIAL ALP1PL=PINTLG(I,J,L+1) | !--------------------------- ALP2P =ALP1P*ALP1P | FIM = 0. ALP2PL=ALP1PL*ALP1PL | !------- C | ! OPENMP DFI=(Q(I,J,L)*0.608+1.)*T(I,J,L)*R*(ALP1PL-ALP1P)/DWDT(I,J,L) | !------- DFDZ(I,J)=DFI*DWDT(I,J,L)/(ALP2PL-ALP2P) | ! APEL(I,J)=(ALP2PL+ALP2P)*0.5 | !$omp parallel do private (ALP1P , DFI , FIUPK , RDPDS) 205 CONTINUE | ! C | DO 125 J=MYJS_P5,MYJE_P5 !$omp parallel do | DO 125 I=MYIS_P5,MYIE_P5 DO 210 J=MYJS_P4,MYJE_P4 | ! DO 210 I=MYIS_P4,MYIE_P4 | ALP1P = PINTLG(I,J,K) DPDE(I,J)=DETA(L)*PDSL(I,J) | ! DIVL(I,J)=0. | DFI = (Q(I,J,K) * 0.608 + 1.) * T(I,J,K) * R * (ALP1(I,J) - ALP1P) / DWDT(I,J,K) EDIV(I,J)=0. | ! 210 CONTINUE | RDPDS = 1. / (DETA(K) * PDSL(I,J)) C | RTOP(I,J,K) = RDPDS * DFI IF (L.LT.LM) THEN | FIUPK = FILO(I,J) + DFI !$omp parallel do | FIM(I,J) = FILO(I,J) + FIUPK DO 211 J=MYJS_P4,MYJE_P4 | IF (ABS(FIM(I,J)) <= 5.E+10) THEN DO 211 I=MYIS_P4,MYIE_P4 | ! DPDEP1(I,J)=DETA(L+1)*PDSL(I,J) | ELSE 211 CONTINUE | ! END IF | WRITE(6,*) 'BAD FIM ', MYPE,I, J, K, LMH(I,J),FIM(I,J), FILO(I,J), DFI C | WRITE(6,*) 'Q,T,ALP1,ALP1P,DWDT: ', Q(I,J,K), T(I,J,K), ALP1(I,J), ALP1P, !$omp parallel do | & DWDT(I,J,K) DO 215 J=MYJS_P1,MYJE_P1 | STOP DO 215 I=MYIS_P1,MYIE_P1 | ! RDPD(I,J)=1./DPDE(I,J) | END IF 215 CONTINUE | ! C | FILO(I,J) = (FIUPK - DFL(K)) * HTM(I,J,K) + DFL(K) !$omp parallel do | ALP1(I,J) = ALP1P DO 220 J=MYJS1_P3,MYJE1_P3 | 125 END DO DO 220 I=MYIS_P3,MYIE_P3 | !------- ADPDX(I,J)=DPDE(I+IVW(J),J)+DPDE(I+IVE(J),J) | ! OPENMP ADPDY(I,J)=DPDE(I,J-1)+DPDE(I,J+1) | !------- RDPDX(I,J)=1./ADPDX(I,J) | ! RDPDY(I,J)=1./ADPDY(I,J) | !$omp parallel do private (ALP1P , ALP1PL , ALP2P , ALP2PL , DFI) 220 CONTINUE | ! C | DO 205 J=MYJS_P5,MYJE_P5 C--------------DIAGONAL CONTRIBUTIONS TO PRESSURE GRADIENT FORCE-------- | DO 205 I=MYIS_P5,MYIE_P5 C | HM(I,J) = HTM(I,J,K) * HBM2(I,J) !$omp parallel do | VM(I,J) = VTM(I,J,K) * VBM2(I,J) DO 240 J=MYJS_P4,MYJE_P4 | ! DO 240 I=MYIS_P4,MYIE_P4 | ALP1P = PINTLG(I,J,K) ADPDNE(I,J)=DPDE(I+IHE(J),J+1)+DPDE(I,J) | ALP1PL = PINTLG(I,J,K+1) PNE(I,J)=(FIM (I+IHE(J),J+1)-FIM (I,J)) | ALP2P = ALP1P * ALP1P 1 *(DWDT(I+IHE(J),J+1,L)+DWDT(I,J,L)) | ALP2PL = ALP1PL * ALP1PL if ( ABS(PNE(I,J)) .le. 5.e10) then | ! else | DFI = (Q(I,J,K) * 0.608 + 1.) * T(I,J,K) * R * (ALP1PL-ALP1P) / DWDT(I,J,K write(6,*) 'crazy PNE ',I,J,PNE(I,J) | DFDZ(I,J) = DFI * DWDT(I,J,K) / (ALP2PL - ALP2P) write(6,*) 'pieces', I+IHE(J),J+1,FIM (I+IHE(J),J+1) | APEL(I,J) = (ALP2PL + ALP2P) * 0.5 endif | 205 END DO PPNE(I,J)=PNE(I,J)*ADPDNE(I,J) | !------- CNE(I,J)=(DFDZ(I+IHE(J),J+1)+DFDZ(I,J))*2. | ! OPENMP 1 *(APEL(I+IHE(J),J+1)-APEL(I,J)) | !------- PCNE(I,J)=CNE(I,J)*ADPDNE(I,J) | ! 240 CONTINUE | !$omp parallel do C | ! !$omp parallel do | DO 210 J=MYJS_P4,MYJE_P4 DO 250 J=MYJS1_P4,MYJE_P4 | DO 210 I=MYIS_P4,MYIE_P4 DO 250 I=MYIS_P4,MYIE1_P4 | DPDE(I,J) = DETA(K) * PDSL(I,J) ADPDSE(I,J)=DPDE(I+IHE(J),J-1)+DPDE(I,J) | DIVL(I,J) = 0. PSE(I,J)=(FIM(I+IHE(J),J-1)-FIM(I,J)) | EDIV(I,J) = 0. 1 *(DWDT(I+IHE(J),J-1,L)+DWDT(I,J,L)) | 210 END DO PPSE(I,J)=PSE(I,J)*ADPDSE(I,J) | ! CSE(I,J)=(DFDZ(I+IHE(J),J-1)+DFDZ(I,J))*2. | IF (K < LM) THEN 1 *(APEL(I+IHE(J),J-1)-APEL(I,J)) | !------- PCSE(I,J)=CSE(I,J)*ADPDSE(I,J) | ! OPENMP 250 CONTINUE | !------- C | ! C--------------CONTINUITY EQUATION MODIFICATION------------------------- | !$omp parallel do C | ! !$omp parallel do | DO 211 J=MYJS_P4,MYJE_P4 DO 260 J=MYJS1_P1,MYJE1_P1 | DO 211 I=MYIS_P4,MYIE_P4 DO 260 I=MYIS_P1,MYIE_P1 | DPDEP1(I,J) = DETA(K+1) * PDSL(I,J) PCXC(I,J)=VBM3(I,J)*VTM(I,J,L)*(PNE(I+IVW(J),J) | 211 END DO 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)) | END IF 260 CONTINUE | !------- C----------------------------------------------------------------------- | ! OPENMP DO 270 J=MYJS2,MYJE2 | !------- DO 270 I=MYIS1,MYIE1 | ! DIV(I,J,L)=DETA(L)*WPDAR(I,J) | !$omp parallel do 1 *(PCXC(I+IHE(J),J)-PCXC(I,J+1) | ! 2 +PCXC(I+IHW(J),J)-PCXC(I,J-1)) | DO 215 J=MYJS_P1,MYJE_P1 270 CONTINUE | DO 215 I=MYIS_P1,MYIE_P1 C | RDPD(I,J) = 1. / DPDE(I,J) C--------------LAT & LONG PRESSURE FORCE COMPONENTS--------------------- | 215 END DO C | !------- !$omp parallel do private (dcnek,dcsek,dpnek,dpsek) | ! OPENMP DO 280 J=MYJS1_P3,MYJE1_P3 | !------- DO 280 I=MYIS_P3,MYIE_P3 | ! DPNEK=PNE(I+IVW(J),J)+PNE(I,J-1) | !$omp parallel do DPSEK=PSE(I+IVW(J),J)+PSE(I,J+1) | ! PEW(I,J)=DPNEK+DPSEK | DO 220 J=MYJS1_P3,MYJE1_P3 PNS(I,J)=DPNEK-DPSEK | DO 220 I=MYIS_P3,MYIE_P3 DCNEK=CNE(I+IVW(J),J)+CNE(I,J-1) | ADPDX(I,J) = DPDE(I+IVW(J),J ) + DPDE(I+IVE(J),J ) DCSEK=CSE(I+IVW(J),J)+CSE(I,J+1) | ADPDY(I,J) = DPDE(I ,J-1) + DPDE(I ,J+1) PCEW(I,J)=(DCNEK+DCSEK)*ADPDX(I,J) | RDPDX(I,J) = 1. / ADPDX(I,J) PCNS(I,J)=(DCNEK-DCSEK)*ADPDY(I,J) | RDPDY(I,J) = 1. / ADPDY(I,J) 280 CONTINUE | 220 END DO C | !-------------------------------------------------- C--------------LAT & LON FLUXES & OMEGA-ALPHA COMPONENTS---------------- | ! DIAGONAL CONTRIBUTIONS TO PRESSURE GRADIENT FORCE C | !-------------------------------------------------- !$omp parallel do | !------- DO 310 J=MYJS1_P3,MYJE1_P3 | ! OPENMP DO 310 I=MYIS_P3,MYIE_P3 | !------- UDY(I,J)=DY*U(I,J,L) | ! FEW(I,J)=UDY(I,J)*ADPDX(I,J) | !$omp parallel do TEW(I,J)=UDY(I,J)*PCEW(I,J) | ! VDX(I,J)=DX(I,J)*V(I,J,L) | DO 240 J=MYJS_P4,MYJE_P4 FNS(I,J)=VDX(I,J)*ADPDY(I,J) | DO 240 I=MYIS_P4,MYIE_P4 TNS(I,J)=VDX(I,J)*PCNS(I,J) | ADPDNE(I,J) = DPDE(I+IHE(J),J+1) + DPDE(I,J) 310 CONTINUE | PNE(I,J) = (FIM(I+IHE(J),J+1) - FIM(I,J)) C | & * (DWDT(I+IHE(J),J+1,K) + DWDT(I,J,K)) C--------------DIAGONAL FLUXES AND DIAGONALLY AVERAGED WIND------------- | ! C | IF (ABS(PNE(I,J)) <= 5.E10) THEN !$omp parallel do private (pvnek) | ELSE DO 320 J=MYJS1_P2,MYJE2_P2 | WRITE(6,*) 'CRAZY PNE ', I, J, PNE(I,J) DO 320 I=MYIS_P2,MYIE1_P2 | WRITE(6,*) 'PIECES', I+IHE(J), J+1, FIM(I+IHE(J),J+1) PVNEK=(UDY(I+IHE(J),J)+VDX(I+IHE(J),J))+(UDY(I,J+1)+VDX(I,J+1)) | END IF FNE(I,J)=PVNEK*ADPDNE(I,J) | ! TNE(I,J)=PVNEK*PCNE(I,J)*2. | PPNE(I,J) = PNE(I,J) * ADPDNE(I,J) 320 CONTINUE | CNE(I,J) = (DFDZ(I+IHE(J),J+1) + DFDZ(I,J)) C | & * 2. * (APEL(I+IHE(J),J+1) - APEL(I,J)) !$omp parallel do private (pvsek) | PCNE(I,J) = CNE(I,J) * ADPDNE(I,J) DO 330 J=MYJS2_P2,MYJE1_P2 | 240 END DO DO 330 I=MYIS_P2,MYIE1_P2 | !------- PVSEK=(UDY(I+IHE(J),J)-VDX(I+IHE(J),J))+(UDY(I,J-1)-VDX(I,J-1)) | ! OPENMP FSE(I,J)=PVSEK*ADPDSE(I,J) | !------- TSE(I,J)=PVSEK*PCSE(I,J)*2. | ! 330 CONTINUE | !$omp parallel do IF (L.LT.LM-1) THEN | ! DO 335 J=MYJS2_P2,MYJE2_P2 | DO 250 J=MYJS1_P4,MYJE_P4 DO 335 I=MYIS1_P2,MYIE1_P2 | DO 250 I=MYIS_P4,MYIE1_P4 DIV(I,J,L+1)=DIV(I,J,L+1)+DIVS(I,J) | ADPDSE(I,J) = DPDE(I+IHE(J),J-1) + DPDE(I,J) DIVS(I,J)=0.0 | PSE(I,J) = (FIM(I+IHE(J),J-1) - FIM(I,J)) T(I,J,L+2)=T(I,J,L+2)+ATCP1(I,J) | & * (DWDT(I+IHE(J),J-1,K) + DWDT(I,J,K)) ATCP1(I,J)=ATC(I,J) | ! ATC (I,J)=0.0 | PPSE(I,J) = PSE(I,J) * ADPDSE(I,J) 335 CONTINUE | CSE(I,J) = (DFDZ(I+IHE(J),J-1) + DFDZ(I,J)) END IF | & * 2. * (APEL(I+IHE(J),J-1) - APEL(I,J)) C | PCSE(I,J) = CSE(I,J) * ADPDSE(I,J) C--------------HORIZONTAL PART OF OMEGA-ALPHA & DIVERGENCE-------------- | 250 END DO C | !--------------------------------- !$omp parallel do | ! CONTINUITY EQUATION MODIFICATION DO 340 J=MYJS2_P1,MYJE2_P1 | !------------------------------- DO 340 I=MYIS1_P1,MYIE1_P1 | !------- OMGALF(I,J,L)=(TEW(I+IHE(J),J)+TEW(I+IHW(J),J)+TNS(I,J+1) | ! OPENMP 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) | ! IF (L.LT.3) THEN | !$omp parallel do T(I,J,L)=OMGALF(I,J,L)+T(I,J,L) | ! ELSEIF (L.LT.LM) THEN | DO 260 J=MYJS1_P1,MYJE1_P1 ATC(I,J)=ATC(I,J)+OMGALF(I,J,L) | DO 260 I=MYIS_P1,MYIE_P1 END IF | PCXC(I,J) = VBM3(I,J) * VTM(I,J,K) C | & * (PNE(I+IVW(J),J) + CNE(I+IVW(J),J ) + PSE(I+IVW(J),J ) IF (L.LT.LM .AND. (HTM(I,J,L+1)*HBM2(I,J)).GT.0) THEN | & + CSE(I+IVW(J),J) - PNE(I ,J-1) - CNE(I ,J-1) C The T point below is in the atmosphere. Should it receive | & - PSE(I ,J+1) - CSE(I ,J+1)) C omega-alpha contributions from fluxes of layer L? | 260 END DO | ! C Check each of the four surrounding V points if they are | DO 270 J=MYJS2,MYJE2 C the points just above the slope | DO 270 I=MYIS1,MYIE1 | DIV(I,J,K) = DETA(K) * WPDAR(I,J) * (PCXC(I+IHE(J),J) - PCXC(I,J+1) TOASL=0.0 | & + PCXC(I+IHW(J),J) - PCXC(I,J-1)) | 270 END DO IF (VTMS(I+IHE(J),J,L+1).EQ.1) THEN | !--------------------------------------- IF (ISLD(I+IHE(J),J).EQ.1) | ! LAT AND LONG PRESSURE FORCE COMPONENTS & TOASL=TOASL+0.50*TEW(I+IHE(J),J) | !--------------------------------------- IF (ISLD(I+IHE(J),J).EQ.8) | !------- & TOASL=TOASL+0.50*TEW(I+IHE(J),J)+0.25*TSE(I,J) | ! OPENMP IF (ISLD(I+IHE(J),J).EQ.2) | !------- & TOASL=TOASL+0.50*TEW(I+IHE(J),J)+0.25*TNE(I,J) | ! ENDIF | !$omp parallel do private (DCNEK , DCSEK , DPNEK , DPSEK) | ! IF (VTMS(I,J+1,L+1).EQ.1) THEN | DO 280 J=MYJS1_P3,MYJE1_P3 IF (ISLD(I,J+1).EQ.3) | DO 280 I=MYIS_P3,MYIE_P3 & TOASL=TOASL+0.50*TNS(I,J+1) | DPNEK = PNE(I+IVW(J),J) + PNE(I,J-1) IF (ISLD(I,J+1).EQ.2) | DPSEK = PSE(I+IVW(J),J) + PSE(I,J+1) & TOASL=TOASL+0.50*TNS(I,J+1)+0.25*TNE(I,J) | PEW(I,J) = DPNEK + DPSEK IF (ISLD(I,J+1).EQ.4) | PNS(I,J) = DPNEK - DPSEK & TOASL=TOASL+0.50*TNS(I,J+1)+0.25*TSE(I+IHW(J),J+1) | DCNEK = CNE(I+IVW(J),J) + CNE(I,J-1) ENDIF | DCSEK = CSE(I+IVW(J),J) + CSE(I,J+1) | PCEW(I,J) = (DCNEK + DCSEK) * ADPDX(I,J) IF (VTMS(I+IHW(J),J,L+1).EQ.1) THEN | PCNS(I,J) = (DCNEK - DCSEK) * ADPDY(I,J) IF (ISLD(I+IHW(J),J).EQ.5) | 280 END DO & TOASL=TOASL+0.50*TEW(I+IHW(J),J) | !----------------------------------------------- IF (ISLD(I+IHW(J),J).EQ.4) | ! LAT AND LON FLUXES AND OMEGA-ALPHA COMPONENTS & TOASL=TOASL+0.50*TEW(I+IHW(J),J)+0.25*TSE(I+IHW(J),J+1) | !----------------------------------------------- IF (ISLD(I+IHW(J),J).EQ.6) | !------- & TOASL=TOASL+0.50*TEW(I+IHW(J),J)+0.25*TNE(I+IHW(J),J-1) | ! OPENMP ENDIF | !------- | ! IF (VTMS(I,J-1,L+1).EQ.1) THEN | !$omp parallel do IF (ISLD(I,J-1).EQ.7) | ! & TOASL=TOASL+0.50*TNS(I,J-1) | DO 310 J=MYJS1_P3,MYJE1_P3 IF (ISLD(I,J-1).EQ.6) | DO 310 I=MYIS_P3,MYIE_P3 & TOASL=TOASL+0.50*TNS(I,J-1)+0.25*TNE(I+IHW(J),J-1) | UDY(I,J) = DY * U(I,J,K) IF (ISLD(I,J-1).EQ.8) | FEW(I,J) = UDY(I,J) * ADPDX(I,J) & TOASL=TOASL+0.50*TNS(I,J-1)+0.25*TSE(I,J) | TEW(I,J) = UDY(I,J) * PCEW(I,J) ENDIF | VDX(I,J) = DX(I,J) * V(I,J,K) | FNS(I,J) = VDX(I,J) * ADPDY(I,J) OAADP1 = TOASL*DETA(L+1)/DETA(L)*RDPD(I,J)*FCP(I,J) | TNS(I,J) = VDX(I,J) * PCNS(I,J) OMGALF(I,J,L+1)= OMGALF(I,J,L+1) +OAADP1 | 310 END DO IF (L.LT.3) THEN | !--------------------------------------------- T(I,J,L+1)=T(I,J,L+1) +OAADP1 | ! DIAGONAL FLUXES AND DIAGONALLY AVERAGED WIND ELSEIF (L.eq.LM-1) THEN | !--------------------------------------------- ATCP1(I,J)=ATCP1(I,J) + OMGALF(I,J,L+1) | !------- ELSE | ! OPENMP ATCP1(I,J)=ATCP1(I,J) +OAADP1 | !------- END IF | ! | !$omp parallel do private (PVNEK) ENDIF | ! C | DO 320 J=MYJS1_P2,MYJE2_P2 EDIV(I,J)=((FEW(I+IHE(J),J)+FNS(I,J+1) | DO 320 I=MYIS_P2,MYIE1_P2 1 +FNE(I,J)+FSE(I,J)) | PVNEK = (UDY(I+IHE(J),J) + VDX(I+IHE(J),J)) + (UDY(I,J+1) + VDX(I,J+1)) 2 -(FEW(I+IHW(J),J)+FNS(I,J-1) | FNE(I,J) = PVNEK * ADPDNE(I,J) 3 +FNE(I+IHW(J),J-1)+FSE(I+IHW(J),J+1)))*FDIV(I,J) | TNE(I,J) = PVNEK * PCNE(I,J) * 2. DIVL(I,J)=EDIV(I,J)*HBM2(I,J) | 320 END DO | !------- C Slantwise mass and T advection, with T increment to account for the | ! OPENMP C omega-alpha impact, T change due to the movement to a different p | !------- | ! IF (L.LT.LM .AND. L.EQ.LMV(I+IHE(J),J) | !$omp parallel do private (PVSEK) 1 .AND. ISLD(I+IHE(J),J).GT.0) THEN | ! | DO 330 J=MYJS2_P2,MYJE1_P2 TFSTR=0.5*DETA(L+1)/DETA(L) * FDIV(I,J)*HM(I,J) | DO 330 I=MYIS_P2,MYIE1_P2 FSTR=0.5*TFSTR | 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) STSEP1=FSTR*FSE(I+IHE(J),J+1) | TSE(I,J) = PVSEK * PCSE(I,J) * 2. STNE =FSTR*FNE(I,J) | 330 END DO STSE =FSTR*FSE(I,J) | ! STNEM1=FSTR*FNE(I+IHE(J),J-1) | IF (K < LM-1) THEN STEW =TFSTR*FEW(I+IHE(J),J) | DO 335 J=MYJS2_P2,MYJE2_P2 STNS =TFSTR*FNS(I+IHE(J),J) | DO 335 I=MYIS1_P2,MYIE1_P2 | DIV(I,J,K+1) = DIV(I,J,K+1) + DIVS(I,J) IF (ISLD(I+IHE(J),J).EQ.1) THEN | DIVS(I,J) = 0.0 DIV(I+IHE(J),J+1,L+1) = DIV(I+IHE(J),J+1,L+1) + STSEP1 | T(I,J,K+2) = T(I,J,K+2) + ATCP1(I,J) DIVS(I+1,J) = DIVS(I+1,J) - STSEP1 | ATCP1(I,J) = ATC(I,J) wdep=ABS( STSEP1)*DT | ATC(I,J) = 0.0 DPT=(RTOP(I+IHE(J),J+1,L+1)+RTOP(I+1,J,L))* | 335 END DO & (DPDEP1(I+IHE(J),J+1) +DPDE(I+1,J)) *RFCP | END IF WDUTD=wdep*SIGN(1.0, STSEP1) | !----------------------------------------------- & *(T(I+IHE(J),J+1,L+1)-DPT-T(I+1,J,L)) | ! HORIZONTAL PART OF OMEGA-ALPHA AND DIVERGENCE IF ( STSEP1.GT.0.0) THEN | !----------------------------------------------- warr=DPDE(I+1,J) | !------- ATC(I+1,J)=ATC(I+1,J)+WDUTD/(warr+wdep) | ! OPENMP ELSE | !------- warr=DPDEP1(I+IHE(J),J+1) | ! ATCP1(I+IHE(J),J+1)=ATCP1(I+IHE(J),J+1)+WDUTD/(warr+wdep) | !$omp parallel do END IF | ! | DO 340 J=MYJS2_P1,MYJE2_P1 DIV(I+IHE(J),J-1,L+1) = DIV(I+IHE(J),J-1,L+1) + STNEM1 | DO 340 I=MYIS1_P1,MYIE1_P1 DIVS(I+1,J) = DIVS(I+1,J) - STNEM1 | OMGALF(I,J,K) = (TEW(I+IHE(J),J ) + TEW(I+IHW(J),J ) wdep=ABS( STNEM1)*DT | & + TNS(I ,J+1) + TNS(I ,J-1) DPT=(RTOP(I+IHE(J),J-1,L+1)+RTOP(I+1,J,L))* | & + TNE(I ,J ) + TNE(I+IHW(J),J-1) & (DPDEP1(I+IHE(J),J-1) +DPDE(I+1,J)) *RFCP | & + TSE(I ,J ) + TSE(I+IHW(J),J+1)) WDUTD=wdep*SIGN(1.0, STNEM1) | & * RDPD(I,J) * FCP(I,J) * HM(I,J) & *(T(I+IHE(J),J-1,L+1)-DPT-T(I+1,J,L)) | ! IF ( STNEM1.GT.0.0) THEN | IF (K < 3) THEN warr=DPDE(I+1,J) | T(I,J,K) = OMGALF(I,J,K) + T(I,J,K) ATC(I+1,J)=ATC(I+1,J)+WDUTD/(warr+wdep) | ELSE IF (K < LM) THEN ELSE | ATC(I,J) = ATC(I,J) + OMGALF(I,J,K) warr=DPDEP1(I+IHE(J),J-1) | END IF ATCP1(I+IHE(J),J-1)=ATCP1(I+IHE(J),J-1)+WDUTD/(warr+wdep) | ! END IF | IF (K < LM) THEN | IF (HTM(I,J,K+1) * HBM2(I,J) > 0) THEN DIV(I,J,L+1) = DIV(I,J,L+1) + STEW !blue | !----------------------------------------------------------------------------------------------- DIVS(I+1,J) = DIVS(I+1,J) - STEW !blue | ! THE T POINT BELOW IS IN THE ATMOSPHERE. SHOULD IT RECEIVE OMEGA-ALPHA CONTRIBUTIONS FROM FLUXE wdep=ABS( STEW)*DT | ! OF LAYER L ? DPT=(RTOP(I,J,L+1)+RTOP(I+1,J,L))* | ! & (DPDEP1(I,J) +DPDE(I+1,J)) *RFCP | ! CHECK EACH OF THE FOUR SURROUNDING V POINTS IF THEY ARE THE POINTS JUST ABOVE THE SLOPE WDUTD=wdep*SIGN(1.0, STEW)*(T(I,J,L+1)-DPT-T(I+1,J,L)) | !----------------------------------------------------------------------------------------------- IF ( STEW.GT.0.0) THEN | TOASL = 0.0 warr=DPDE(I+1,J) | ! ATC(I+1,J)=ATC(I+1,J)+WDUTD/(warr+wdep) | IF (VTMS(I+IHE(J),J,K+1) == 1) THEN ELSE | IF (ISLD(I+IHE(J),J) == 1) warr=DPDEP1(I,J) | & TOASL = TOASL + 0.50 * TEW(I+IHE(J),J) ATCP1(I,J)=ATCP1(I,J)+WDUTD/(warr+wdep) | ! END IF | IF (ISLD(I+IHE(J),J) == 8) | & TOASL = TOASL + 0.50 * TEW(I+IHE(J),J) + 0.25 * TSE(I,J) ELSE IF (ISLD(I+IHE(J),J).EQ.2) THEN | ! DIV(I,J,L+1) = DIV(I,J,L+1) + STNE | IF (ISLD(I+IHE(J),J) == 2) DIVS(I+IHE(J),J+1) = DIVS(I+IHE(J),J+1) - STNE | & TOASL = TOASL + 0.50 * TEW(I+IHE(J),J) + 0.25 * TNE(I,J) wdep=ABS( STNE)*DT | END IF DPT=(RTOP(I,J,L+1)+RTOP(I+IHE(J),J+1,L))* | ! & (DPDEP1(I,J) +DPDE(I+IHE(J),J+1)) *RFCP | IF (VTMS(I,J+1,K+1) == 1) THEN WDUTD=wdep*SIGN(1.0, STNE)*(T(I,J,L+1)-DPT-T(I+IHE(J),J+1,L)) | IF (ISLD(I,J+1) == 3) IF ( STNE.GT.0.0) THEN | & TOASL = TOASL + 0.50 * TNS(I,J+1) warr=DPDE(I+IHE(J),J+1) | ! ATC(I+IHE(J),J+1)=ATC(I+IHE(J),J+1)+WDUTD/(warr+wdep) | IF (ISLD(I,J+1) == 2) ELSE | & TOASL = TOASL + 0.50 * TNS(I,J+1) + 0.25 * TNE(I ,J ) warr=DPDEP1(I,J) | ! ATCP1(I,J)=ATCP1(I,J)+WDUTD/(warr+wdep) | IF (ISLD(I,J+1) == 4) END IF | & TOASL = TOASL + 0.50 * TNS(I,J+1) + 0.25 * TSE(I+IHW(J),J+1) | END IF DIV(I+IHE(J),J-1,L+1) = DIV(I+IHE(J),J-1,L+1) + STNEM1 | ! DIVS(I+1,J) = DIVS(I+1,J) - STNEM1 | IF (VTMS(I+IHW(J),J,K+1) == 1) THEN wdep=ABS( STNEM1)*DT | IF (ISLD(I+IHW(J),J) == 5) DPT=(RTOP(I+IHE(J),J-1,L+1)+RTOP(I+1,J,L))* | & TOASL = TOASL + 0.50 * TEW(I+IHW(J),J) & (DPDEP1(I+IHE(J),J-1) +DPDE(I+1,J)) *RFCP | ! WDUTD=wdep*SIGN(1.0, STNEM1) | IF (ISLD(I+IHW(J),J) == 4) & *(T(I+IHE(J),J-1,L+1)-DPT-T(I+1,J,L)) | & TOASL = TOASL + 0.50 * TEW(I+IHW(J),J) + 0.25 * TSE(I+IHW(J),J+1) IF ( STNEM1.GT.0.0) THEN | IF (ISLD(I+IHW(J),J) == 6) warr=DPDE(I+1,J) | & TOASL = TOASL + 0.50 * TEW(I+IHW(J),J) + 0.25 * TNE(I+IHW(J),J-1) ATC(I+1,J)=ATC(I+1,J)+WDUTD/(warr+wdep) | END IF ELSE | ! warr=DPDEP1(I+IHE(J),J-1) | IF (VTMS(I,J-1,K+1) == 1) THEN ATCP1(I+IHE(J),J-1)=ATCP1(I+IHE(J),J-1)+WDUTD/(warr+wdep) | IF (ISLD(I,J-1) == 7) END IF | & TOASL = TOASL + 0.50 * TNS(I,J-1) | ! DIV(I,J,L+1) = DIV(I,J,L+1) + STEW !blue | IF (ISLD(I,J-1) == 6) DIVS(I+1,J) = DIVS(I+1,J) - STEW !blue | & TOASL = TOASL + 0.50 * TNS(I,J-1) + 0.25 * TNE(I+IHW(J),J-1) wdep=ABS( STEW)*DT | ! DPT=(RTOP(I,J,L+1)+RTOP(I+1,J,L))* | IF (ISLD(I,J-1) == 8) & (DPDEP1(I,J) +DPDE(I+1,J)) *RFCP | & TOASL = TOASL + 0.50 * TNS(I,J-1) + 0.25 * TSE(I ,J ) WDUTD=wdep*SIGN(1.0, STEW)*(T(I,J,L+1)-DPT-T(I+1,J,L)) | END IF IF ( STEW.GT.0.0) THEN | ! warr=DPDE(I+1,J) | OAADP1 = TOASL * DETA(K+1) / DETA(K) * RDPD(I,J) * FCP(I,J) ATC(I+1,J)=ATC(I+1,J)+WDUTD/(warr+wdep) | OMGALF(I,J,K+1) = OMGALF(I,J,K+1) + OAADP1 ELSE | ! warr=DPDEP1(I,J) | IF (K < 3) THEN ATCP1(I,J)=ATCP1(I,J)+WDUTD/(warr+wdep) | T(I,J,K+1) = T(I,J,K+1) + OAADP1 END IF | ELSE IF (K == LM-1) THEN | ATCP1(I,J) = ATCP1(I,J) + OMGALF(I,J,K+1) DIV(I+IHE(J),J-1,L+1) = DIV(I+IHE(J),J-1,L+1) + STNS !yellow | ELSE DIVS(I+IHE(J),J+1) = DIVS(I+IHE(J),J+1) - STNS !yellow | ATCP1(I,J) = ATCP1(I,J) + OAADP1 wdep=ABS( STNS)*DT | END IF DPT=(RTOP(I+IHE(J),J-1,L+1)+RTOP(I+IHE(J),J+1,L))* | ! & (DPDEP1(I+IHE(J),J-1) +DPDE(I+IHE(J),J+1)) *RFCP | END IF WDUTD=wdep*SIGN(1.0, STNS) | END IF & *(T(I+IHE(J),J-1,L+1)-DPT-T(I+IHE(J),J+1,L)) | ! IF ( STNS.GT.0.0) THEN | EDIV(I,J) = ((FEW(I+IHE(J),J) + FNS(I,J+1) + FNE(I,J) warr=DPDE(I+IHE(J),J+1) | & + FSE(I,J)) ATC(I+IHE(J),J+1)=ATC(I+IHE(J),J+1)+WDUTD/(warr+wdep) | & - (FEW(I+IHW(J),J) + FNS(I,J-1) + FNE(I+IHW(J),J-1) ELSE | & + FSE(I+IHW(J),J+1))) warr=DPDEP1(I+IHE(J),J-1) | & * FDIV(I,J) ATCP1(I+IHE(J),J-1)=ATCP1(I+IHE(J),J-1)+WDUTD/(warr+wdep) | ! END IF | DIVL(I,J) = EDIV(I,J) * HBM2(I,J) | !----------------------------------------------------------------------------------------------- ELSE IF (ISLD(I+IHE(J),J).EQ.3) THEN | ! SLANTWISE MASS AND T ADVECTION, WITH T INCREMENT TO ACCOUNT FOR THE OMEGA-ALPHA IMPACT, T CHAN DIV(I+1,J,L+1) = DIV(I+1,J,L+1) - STSEP1 | ! DUE TO MOVEMENT TO A DIFFERENT P DIVS(I+IHE(J),J+1) = DIVS(I+IHE(J),J+1) + STSEP1 | !----------------------------------------------------------------------------------------------- wdep=ABS(-STSEP1)*DT | IF (K < LM ) THEN DPT=(RTOP(I+1,J,L+1)+RTOP(I+IHE(J),J+1,L))* | IF (K == LMV(I+IHE(J),J) .AND. ISLD(I+IHE(J),J) > 0) THEN & (DPDEP1(I+1,J) +DPDE(I+IHE(J),J+1)) *RFCP | ! WDUTD=wdep*SIGN(1.0,-STSEP1) | TFSTR = 0.5 * DETA(K+1) / DETA(K) * FDIV(I,J) * HM(I,J) & *(T(I+1,J,L+1)-DPT-T(I+IHE(J),J+1,L)) | FSTR = 0.5 * TFSTR IF (-STSEP1.GT.0.0) THEN | ! warr=DPDE(I+IHE(J),J+1) | STSEP1 = FSTR * FSE(I+IHE(J),J+1) ATC(I+IHE(J),J+1)=ATC(I+IHE(J),J+1)+WDUTD/(warr+wdep) | STNE = FSTR * FNE(I ,J ) ELSE | STSE = FSTR * FSE(I ,J ) warr=DPDEP1(I+1,J) | STNEM1 = FSTR * FNE(I+IHE(J),J-1) ATCP1(I+1,J)=ATCP1(I+1,J)+WDUTD/(warr+wdep) | STEW = TFSTR * FEW(I+IHE(J),J ) END IF | STNS = TFSTR * FNS(I+IHE(J),J ) | ! DIV(I,J,L+1) = DIV(I,J,L+1) + STNE | IF (ISLD(I+IHE(J),J) == 1) THEN DIVS(I+IHE(J),J+1) = DIVS(I+IHE(J),J+1) - STNE | DIV(I+IHE(J),J+1,K+1) = DIV(I+IHE(J),J+1,K+1) + STSEP1 wdep=ABS( STNE)*DT | DIVS(I+1,J) = DIVS(I+1,J) - STSEP1 DPT=(RTOP(I,J,L+1)+RTOP(I+IHE(J),J+1,L))* | ! & (DPDEP1(I,J) +DPDE(I+IHE(J),J+1)) *RFCP | WDEP = ABS(STSEP1) * DT WDUTD=wdep*SIGN(1.0, STNE)*(T(I,J,L+1)-DPT-T(I+IHE(J),J+1,L)) | ! IF ( STNE.GT.0.0) THEN | DPT = (RTOP(I+IHE(J),J+1,K+1) + RTOP(I+1,J,K)) warr=DPDE(I+IHE(J),J+1) | & * (DPDEP1(I+IHE(J),J+1) + DPDE(I+1,J)) ATC(I+IHE(J),J+1)=ATC(I+IHE(J),J+1)+WDUTD/(warr+wdep) | & * RFCP ELSE | ! warr=DPDEP1(I,J) | WDUTD = WDEP * SIGN(1.0,STSEP1) * (T(I+IHE(J),J+1,K+1) - DPT ATCP1(I,J)=ATCP1(I,J)+WDUTD/(warr+wdep) | & - T(I+1,J,K)) END IF | ! | IF ( STSEP1 > 0.0) THEN DIV(I+IHE(J),J-1,L+1) = DIV(I+IHE(J),J-1,L+1) + STNS !yellow | WARR = DPDE(I+1,J) DIVS(I+IHE(J),J+1) = DIVS(I+IHE(J),J+1) - STNS !yellow | ATC(I+1,J) = ATC(I+1,J) + WDUTD / (WARR+WDEP) wdep=ABS( STNS)*DT | ELSE DPT=(RTOP(I+IHE(J),J-1,L+1)+RTOP(I+IHE(J),J+1,L))* | WARR = DPDEP1(I+IHE(J),J+1) & (DPDEP1(I+IHE(J),J-1) +DPDE(I+IHE(J),J+1)) *RFCP | ATCP1(I+IHE(J),J+1) = ATCP1(I+IHE(J),J+1) + WDUTD / (WARR+WDEP) WDUTD=wdep*SIGN(1.0, STNS) | END IF & *(T(I+IHE(J),J-1,L+1)-DPT-T(I+IHE(J),J+1,L)) | ! IF ( STNS.GT.0.0) THEN | DIV(I+IHE(J),J-1,K+1) = DIV(I+IHE(J),J-1,K+1) + STNEM1 warr=DPDE(I+IHE(J),J+1) | DIVS(I+1,J) = DIVS(I+1,J) - STNEM1 ATC(I+IHE(J),J+1)=ATC(I+IHE(J),J+1)+WDUTD/(warr+wdep) | ! ELSE | WDEP = ABS(STNEM1) * DT warr=DPDEP1(I+IHE(J),J-1) | DPT = (RTOP(I+IHE(J),J-1,K+1) + RTOP(I+1,J,K)) ATCP1(I+IHE(J),J-1)=ATCP1(I+IHE(J),J-1)+WDUTD/(warr+wdep) | & * (DPDEP1(I+IHE(J),J-1) + DPDE(I+1,J)) END IF | & * RFCP | WDUTD = WDEP * SIGN(1.0,STNEM1) * (T(I+IHE(J),J-1,K+1) - DPT ELSE IF (ISLD(I+IHE(J),J).EQ.4) THEN | & - T(I+1,J,K)) DIV(I+1,J,L+1) = DIV(I+1,J,L+1) - STSEP1 | ! DIVS(I+IHE(J),J+1) = DIVS(I+IHE(J),J+1) + STSEP1 | IF (STNEM1 > 0.0) THEN wdep=ABS(-STSEP1)*DT | WARR = DPDE(I+1,J) DPT=(RTOP(I+1,J,L+1)+RTOP(I+IHE(J),J+1,L))* | ATC(I+1,J) = ATC(I+1,J) + WDUTD / (WARR+WDEP) & (DPDEP1(I+1,J) +DPDE(I+IHE(J),J+1)) *RFCP | ELSE WDUTD=wdep*SIGN(1.0,-STSEP1) | WARR = DPDEP1(I+IHE(J),J-1) & *(T(I+1,J,L+1)-DPT-T(I+IHE(J),J+1,L)) | ATCP1(I+IHE(J),J-1) = ATCP1(I+IHE(J),J-1) + WDUTD / (WARR+WDEP) IF (-STSEP1.GT.0.0) THEN | END IF warr=DPDE(I+IHE(J),J+1) | ! ATC(I+IHE(J),J+1)=ATC(I+IHE(J),J+1)+WDUTD/(warr+wdep) | DIV(I,J,K+1) = DIV(I,J,K+1) + STEW !BLUE ELSE | DIVS(I+1,J) = DIVS(I+1,J) - STEW !BLUE warr=DPDEP1(I+1,J) | ! ATCP1(I+1,J)=ATCP1(I+1,J)+WDUTD/(warr+wdep) | WDEP = ABS(STEW) * DT END IF | DPT = (RTOP(I,J,K+1) + RTOP(I+1,J,K)) | & * (DPDEP1(I,J) + DPDE(I+1,J)) DIV(I+IHE(J),J-1,L+1) = DIV(I+IHE(J),J-1,L+1) - STSE | & * RFCP DIVS(I,J) = DIVS(I,J) + STSE | ! wdep=ABS( -STSE)*DT | WDUTD = WDEP * SIGN(1.0,STEW) * (T(I,J,K+1) - DPT DPT=(RTOP(I+IHE(J),J-1,L+1)+RTOP(I,J,L))* | & - T(I+1,J,K)) & (DPDEP1(I+IHE(J),J-1) +DPDE(I,J)) *RFCP | ! WDUTD=wdep*SIGN(1.0, -STSE)*(T(I+IHE(J),J-1,L+1)-DPT-T(I,J,L)) | IF (STEW > 0.0) THEN IF ( -STSE.GT.0.0) THEN | WARR = DPDE(I+1,J) warr=DPDE(I,J) | ATC(I+1,J) = ATC(I+1,J) + WDUTD / (WARR+WDEP) ATC(I,J)=ATC(I,J)+WDUTD/(warr+wdep) | ELSE ELSE | WARR = DPDEP1(I,J) warr=DPDEP1(I+IHE(J),J-1) | ATCP1(I ,J) = ATCP1(I,J) + WDUTD / (WARR+WDEP) ATCP1(I+IHE(J),J-1)=ATCP1(I+IHE(J),J-1)+WDUTD/(warr+wdep) | END IF END IF | ! | ELSE IF (ISLD(I+IHE(J),J) == 2) THEN DIV(I+IHE(J),J-1,L+1) = DIV(I+IHE(J),J-1,L+1) + STNS !yellow | DIV(I,J,K+1) = DIV(I,J,K+1) + STNE DIVS(I+IHE(J),J+1) = DIVS(I+IHE(J),J+1) - STNS !yellow | DIVS(I+IHE(J),J+1) = DIVS(I+IHE(J),J+1) - STNE wdep=ABS( STNS)*DT | ! DPT=(RTOP(I+IHE(J),J-1,L+1)+RTOP(I+IHE(J),J+1,L))* | WDEP = ABS(STNE) * DT & (DPDEP1(I+IHE(J),J-1) +DPDE(I+IHE(J),J+1)) *RFCP | DPT = (RTOP(I,J,K+1) + RTOP(I+IHE(J),J+1,K)) WDUTD=wdep*SIGN(1.0, STNS) | & * (DPDEP1(I,J) + DPDE(I+IHE(J),J+1)) & *(T(I+IHE(J),J-1,L+1)-DPT-T(I+IHE(J),J+1,L)) | & * RFCP IF ( STNS.GT.0.0) THEN | ! warr=DPDE(I+IHE(J),J+1) | WDUTD = WDEP * SIGN(1.0,STNE) * (T(I,J,K+1) - DPT ATC(I+IHE(J),J+1)=ATC(I+IHE(J),J+1)+WDUTD/(warr+wdep) | & - T(I+IHE(J),J+1,K)) ELSE | ! warr=DPDEP1(I+IHE(J),J-1) | IF (STNE > 0.0) THEN ATCP1(I+IHE(J),J-1)=ATCP1(I+IHE(J),J-1)+WDUTD/(warr+wdep) | WARR = DPDE(I+IHE(J),J+1) END IF | ATC(I+IHE(J),J+1) = ATC(I+IHE(J),J+1) + WDUTD / (WARR+WDEP) | ELSE DIV(I+1,J,L+1) = DIV(I+1,J,L+1) - STEW !green | WARR = DPDEP1(I,J) DIVS(I,J) = DIVS(I,J) + STEW !green | ATCP1(I,J) = ATCP1(I,J) + WDUTD / (WARR+WDEP) wdep=ABS( -STEW)*DT | END IF DPT=(RTOP(I+1,J,L+1)+RTOP(I,J,L))* | ! & (DPDEP1(I+1,J) +DPDE(I,J)) *RFCP | DIV(I+IHE(J),J-1,K+1) = DIV(I+IHE(J),J-1,K+1) + STNEM1 WDUTD=wdep*SIGN(1.0, -STEW)*(T(I+1,J,L+1)-DPT-T(I,J,L)) | DIVS(I+1,J) = DIVS(I+1,J) - STNEM1 IF ( -STEW.GT.0.0) THEN | ! warr=DPDE(I,J) | WDEP = ABS(STNEM1) * DT ATC(I,J)=ATC(I,J)+WDUTD/(warr+wdep) | DPT = (RTOP(I+IHE(J),J-1,K+1) + RTOP(I+1,J,K)) ELSE | & * (DPDEP1(I+IHE(J),J-1) + DPDE(I+1,J)) warr=DPDEP1(I+1,J) | & * RFCP ATCP1(I+1,J)=ATCP1(I+1,J)+WDUTD/(warr+wdep) | ! END IF | WDUTD = WDEP * SIGN(1.0,STNEM1) * (T(I+IHE(J),J-1,K+1) - DPT | & - T(I+1,J,K)) ELSE IF (ISLD(I+IHE(J),J).EQ.5) THEN | ! DIV(I+IHE(J),J+1,L+1) = DIV(I+IHE(J),J+1,L+1) - STNE | IF (STNEM1 > 0.0) THEN DIVS(I,J) = DIVS(I,J) + STNE | WARR = DPDE(I+1,J) wdep=ABS( -STNE)*DT | ATC(I+1,J) = ATC(I+1,J) + WDUTD / (WARR+WDEP) DPT=(RTOP(I+IHE(J),J+1,L+1)+RTOP(I,J,L))* | ELSE & (DPDEP1(I+IHE(J),J+1) +DPDE(I,J)) *RFCP | WARR = DPDEP1(I+IHE(J),J-1) WDUTD=wdep*SIGN(1.0, -STNE)*(T(I+IHE(J),J+1,L+1)-DPT-T(I,J,L)) | ATCP1(I+IHE(J),J-1) = ATCP1(I+IHE(J),J-1) + WDUTD / (WARR+WDEP) IF ( -STNE.GT.0.0) THEN | END IF warr=DPDE(I,J) | ! ATC(I,J)=ATC(I,J)+WDUTD/(warr+wdep) | DIV(I,J,K+1) = DIV(I,J,K+1) + STEW !BLUE ELSE | DIVS(I+1,J) = DIVS(I+1,J) - STEW !BLUE warr=DPDEP1(I+IHE(J),J+1) | ! ATCP1(I+IHE(J),J+1)=ATCP1(I+IHE(J),J+1)+WDUTD/(warr+wdep) | WDEP = ABS(STEW) * DT END IF | DPT = (RTOP(I,J,K+1) + RTOP(I+1,J,K)) | & * (DPDEP1(I,J) + DPDE(I+1,J)) DIV(I+IHE(J),J-1,L+1) = DIV(I+IHE(J),J-1,L+1) - STSE | & * RFCP DIVS(I,J) = DIVS(I,J) + STSE | ! wdep=ABS( -STSE)*DT | WDUTD = WDEP * SIGN(1.0,STEW) * (T(I,J,K+1) - DPT DPT=(RTOP(I+IHE(J),J-1,L+1)+RTOP(I,J,L))* | & - T(I+1,J,K)) & (DPDEP1(I+IHE(J),J-1) +DPDE(I,J)) *RFCP | ! WDUTD=wdep*SIGN(1.0, -STSE)*(T(I+IHE(J),J-1,L+1)-DPT-T(I,J,L)) | IF (STEW > 0.0) THEN IF ( -STSE.GT.0.0) THEN | WARR = DPDE(I+1,J) warr=DPDE(I,J) | ATC(I+1,J) = ATC(I+1,J) + WDUTD / (WARR+WDEP) ATC(I,J)=ATC(I,J)+WDUTD/(warr+wdep) | ELSE ELSE | WARR = DPDEP1(I,J) warr=DPDEP1(I+IHE(J),J-1) | ATCP1(I,J) = ATCP1(I,J) + WDUTD / (WARR+WDEP) ATCP1(I+IHE(J),J-1)=ATCP1(I+IHE(J),J-1)+WDUTD/(warr+wdep) | END IF END IF | ! | DIV(I+IHE(J),J-1,K+1) = DIV(I+IHE(J),J-1,K+1) + STNS !YELLOW DIV(I+1,J,L+1) = DIV(I+1,J,L+1) - STEW !green | DIVS(I+IHE(J),J+1) = DIVS(I+IHE(J),J+1) - STNS !YELLOW DIVS(I,J) = DIVS(I,J) + STEW !green | ! wdep=ABS( -STEW)*DT | WDEP = ABS(STNS) * DT DPT=(RTOP(I+1,J,L+1)+RTOP(I,J,L))* | DPT = (RTOP(I+IHE(J),J-1,K+1) + RTOP(I+IHE(J),J+1,K)) & (DPDEP1(I+1,J) +DPDE(I,J)) *RFCP | & * (DPDEP1(I+IHE(J),J-1) + DPDE(I+IHE(J),J+1)) WDUTD=wdep*SIGN(1.0, -STEW)*(T(I+1,J,L+1)-DPT-T(I,J,L)) | & * RFCP IF ( -STEW.GT.0.0) THEN | ! warr=DPDE(I,J) | WDUTD = WDEP * SIGN(1.0,STNS) * (T(I+IHE(J),J-1,K+1) - DPT ATC(I,J)=ATC(I,J)+WDUTD/(warr+wdep) | & - T(I+IHE(J),J+1,K)) ELSE | ! warr=DPDEP1(I+1,J) | IF (STNS > 0.0) THEN ATCP1(I+1,J)=ATCP1(I+1,J)+WDUTD/(warr+wdep) | WARR = DPDE(I+IHE(J),J+1) END IF | ATC(I+IHE(J),J+1) = ATC(I+IHE(J),J+1) + WDUTD / (WARR+WDEP) | ELSE ELSE IF (ISLD(I+IHE(J),J).EQ.6) THEN | WARR = DPDEP1(I+IHE(J),J-1) DIV(I+IHE(J),J+1,L+1) = DIV(I+IHE(J),J+1,L+1) - STNE | ATCP1(I+IHE(J),J-1) = ATCP1(I+IHE(J),J-1) + WDUTD / (WARR+WDEP) DIVS(I,J) = DIVS(I,J) + STNE | END IF wdep=ABS( -STNE)*DT | ! DPT=(RTOP(I+IHE(J),J+1,L+1)+RTOP(I,J,L))* | ELSE IF (ISLD(I+IHE(J),J) == 3) THEN & (DPDEP1(I+IHE(J),J+1) +DPDE(I,J)) *RFCP | DIV(I+1,J,K+1) = DIV(I+1,J,K+1) - STSEP1 WDUTD=wdep*SIGN(1.0, -STNE)*(T(I+IHE(J),J+1,L+1)-DPT-T(I,J,L)) | DIVS(I+IHE(J),J+1) = DIVS(I+IHE(J),J+1) + STSEP1 IF ( -STNE.GT.0.0) THEN | ! warr=DPDE(I,J) | WDEP = ABS(-STSEP1) * DT ATC(I,J)=ATC(I,J)+WDUTD/(warr+wdep) | DPT = (RTOP(I+1,J,K+1) + RTOP(I+IHE(J),J+1,K)) ELSE | & * (DPDEP1(I+1,J) + DPDE(I+IHE(J),J+1)) warr=DPDEP1(I+IHE(J),J+1) | & * RFCP ATCP1(I+IHE(J),J+1)=ATCP1(I+IHE(J),J+1)+WDUTD/(warr+wdep) | ! END IF | WDUTD = WDEP * SIGN(1.0,-STSEP1) * (T(I+1,J,K+1) - DPT | & - T(I+IHE(J),J+1,K)) DIV(I+1,J,L+1) = DIV(I+1,J,L+1) - STNEM1 | ! DIVS(I+IHE(J),J-1) = DIVS(I+IHE(J),J-1) + STNEM1 | IF (-STSEP1 > 0.0) THEN wdep=ABS(-STNEM1)*DT | WARR = DPDE(I+IHE(J),J+1) DPT=(RTOP(I+1,J,L+1)+RTOP(I+IHE(J),J-1,L))* | ATC(I+IHE(J),J+1) = ATC(I+IHE(J),J+1) + WDUTD / (WARR+WDEP) & (DPDEP1(I+1,J) +DPDE(I+IHE(J),J-1)) *RFCP | ELSE WDUTD=wdep*SIGN(1.0,-STNEM1)*(T(I+1,J,L+1)-DPT-T(I+IHE(J),J-1,L)) | WARR = DPDEP1(I+1,J) IF (-STNEM1.GT.0.0) THEN | ATCP1(I+1,J) = ATCP1(I+1,J) + WDUTD / (WARR+WDEP) warr=DPDE(I+IHE(J),J-1) | END IF ATC(I+IHE(J),J-1)=ATC(I+IHE(J),J-1)+WDUTD/(warr+wdep) | ! ELSE | DIV(I,J,K+1) = DIV(I,J,K+1) + STNE warr=DPDEP1(I+1,J) | DIVS(I+IHE(J),J+1) = DIVS(I+IHE(J),J+1) - STNE ATCP1(I+1,J)=ATCP1(I+1,J)+WDUTD/(warr+wdep) | ! END IF | WDEP = ABS(STNE) * DT | DPT = (RTOP(I,J,K+1) + RTOP(I+IHE(J),J+1,K)) DIV(I+1,J,L+1) = DIV(I+1,J,L+1) - STEW !green | & * (DPDEP1(I,J) + DPDE(I+IHE(J),J+1)) DIVS(I,J) = DIVS(I,J) + STEW !green | & * RFCP wdep=ABS( -STEW)*DT | ! DPT=(RTOP(I+1,J,L+1)+RTOP(I,J,L))* | WDUTD = WDEP * SIGN(1.0,STNE) * (T(I,J,K+1) - DPT & (DPDEP1(I+1,J) +DPDE(I,J)) *RFCP | & - T(I+IHE(J),J+1,K)) WDUTD=wdep*SIGN(1.0, -STEW)*(T(I+1,J,L+1)-DPT-T(I,J,L)) | ! IF ( -STEW.GT.0.0) THEN | IF (STNE > 0.0) THEN warr=DPDE(I,J) | WARR = DPDE(I+IHE(J),J+1) ATC(I,J)=ATC(I,J)+WDUTD/(warr+wdep) | ATC(I+IHE(J),J+1) = ATC(I+IHE(J),J+1) + WDUTD / (WARR+WDEP) ELSE | ELSE warr=DPDEP1(I+1,J) | WARR = DPDEP1(I,J) ATCP1(I+1,J)=ATCP1(I+1,J)+WDUTD/(warr+wdep) | ATCP1(I,J) = ATCP1(I,J) + WDUTD / (WARR+WDEP) END IF | END IF | ! DIV(I+IHE(J),J+1,L+1) = DIV(I+IHE(J),J+1,L+1) - STNS !pink | DIV(I+IHE(J),J-1,K+1) = DIV(I+IHE(J),J-1,K+1) + STNS !YELLOW DIVS(I+IHE(J),J-1) = DIVS(I+IHE(J),J-1) + STNS !pink | DIVS(I+IHE(J),J+1) = DIVS(I+IHE(J),J+1) - STNS !YELLOW wdep=ABS( -STNS)*DT | ! DPT=(RTOP(I+IHE(J),J+1,L+1)+RTOP(I+IHE(J),J-1,L))* | WDEP = ABS(STNS) * DT & (DPDEP1(I+IHE(J),J+1) +DPDE(I+IHE(J),J-1)) *RFCP | DPT = (RTOP(I+IHE(J),J-1,K+1) + RTOP(I+IHE(J),J+1,K)) WDUTD=wdep*SIGN(1.0, -STNS) | & * (DPDEP1(I+IHE(J),J-1) + DPDE(I+IHE(J),J+1)) & *(T(I+IHE(J),J+1,L+1)-DPT-T(I+IHE(J),J-1,L)) | & * RFCP IF ( -STNS.GT.0.0) THEN | ! warr=DPDE(I+IHE(J),J-1) | WDUTD = WDEP * SIGN(1.0,STNS) * (T(I+IHE(J),J-1,K+1) - DPT ATC(I+IHE(J),J-1)=ATC(I+IHE(J),J-1)+WDUTD/(warr+wdep) | & - T(I+IHE(J),J+1,K)) ELSE | ! warr=DPDEP1(I+IHE(J),J+1) | IF (STNS > 0.0) THEN ATCP1(I+IHE(J),J+1)=ATCP1(I+IHE(J),J+1)+WDUTD/(warr+wdep) | WARR = DPDE(I+IHE(J),J+1) END IF | ATC(I+IHE(J),J+1) = ATC(I+IHE(J),J+1) + WDUTD / (WARR+WDEP) | ELSE ELSE IF (ISLD(I+IHE(J),J).EQ.7) THEN | WARR = DPDEP1(I+IHE(J),J-1) DIV(I,J,L+1) = DIV(I,J,L+1) + STSE | ATCP1(I+IHE(J),J-1) = ATCP1(I+IHE(J),J-1) + WDUTD / (WARR+WDEP) DIVS(I+IHE(J),J-1) = DIVS(I+IHE(J),J-1) - STSE | END IF wdep=ABS( STSE)*DT | ! DPT=(RTOP(I,J,L+1)+RTOP(I+IHE(J),J-1,L))* | ELSE IF (ISLD(I+IHE(J),J) == 4) THEN & (DPDEP1(I,J) +DPDE(I+IHE(J),J-1)) *RFCP | DIV(I+1,J,K+1) = DIV(I+1,J,K+1) - STSEP1 WDUTD=wdep*SIGN(1.0, STSE)*(T(I,J,L+1)-DPT-T(I+IHE(J),J-1,L)) | DIVS(I+IHE(J),J+1) = DIVS(I+IHE(J),J+1) + STSEP1 IF ( STSE.GT.0.0) THEN | ! warr=DPDE(I+IHE(J),J-1) | WDEP = ABS(-STSEP1) * DT ATC(I+IHE(J),J-1)=ATC(I+IHE(J),J-1)+WDUTD/(warr+wdep) | DPT = (RTOP(I+1,J,K+1) + RTOP(I+IHE(J),J+1,K)) ELSE | & * (DPDEP1(I+1,J) + DPDE(I+IHE(J),J+1)) warr=DPDEP1(I,J) | & * RFCP ATCP1(I,J)=ATCP1(I,J)+WDUTD/(warr+wdep) | ! END IF | WDUTD = WDEP * SIGN(1.0,-STSEP1) * (T(I+1,J,K+1) - DPT | & - T(I+IHE(J),J+1,K)) DIV(I+1,J,L+1) = DIV(I+1,J,L+1) - STNEM1 | IF (-STSEP1 > 0.0) THEN DIVS(I+IHE(J),J-1) = DIVS(I+IHE(J),J-1) + STNEM1 | WARR = DPDE(I+IHE(J),J+1) wdep=ABS(-STNEM1)*DT | ATC(I+IHE(J),J+1) = ATC(I+IHE(J),J+1) + WDUTD / (WARR+WDEP) DPT=(RTOP(I+1,J,L+1)+RTOP(I+IHE(J),J-1,L))* | ELSE & (DPDEP1(I+1,J) +DPDE(I+IHE(J),J-1)) *RFCP | WARR = DPDEP1(I+1,J) WDUTD=wdep*SIGN(1.0,-STNEM1)*(T(I+1,J,L+1)-DPT-T(I+IHE(J),J-1,L)) | ATCP1(I+1,J) = ATCP1(I+1,J) + WDUTD / (WARR+WDEP) IF (-STNEM1.GT.0.0) THEN | END IF warr=DPDE(I+IHE(J),J-1) | ! ATC(I+IHE(J),J-1)=ATC(I+IHE(J),J-1)+WDUTD/(warr+wdep) | DIV(I+IHE(J),J-1,K+1) = DIV(I+IHE(J),J-1,K+1) - STSE ELSE | DIVS(I,J) = DIVS(I,J) + STSE warr=DPDEP1(I+1,J) | WDEP = ABS(-STSE) * DT ATCP1(I+1,J)=ATCP1(I+1,J)+WDUTD/(warr+wdep) | DPT = (RTOP(I+IHE(J),J-1,K+1) + RTOP(I,J,K)) END IF | & * (DPDEP1(I+IHE(J),J-1) + DPDE(I,J)) | & * RFCP DIV(I+IHE(J),J+1,L+1) = DIV(I+IHE(J),J+1,L+1) - STNS !pink | ! DIVS(I+IHE(J),J-1) = DIVS(I+IHE(J),J-1) + STNS !pink | WDUTD = WDEP * SIGN(1.0,-STSE) * (T(I+IHE(J),J-1,K+1) - DPT wdep=ABS( -STNS)*DT | & - T(I,J,K)) DPT=(RTOP(I+IHE(J),J+1,L+1)+RTOP(I+IHE(J),J-1,L))* | ! & (DPDEP1(I+IHE(J),J+1) +DPDE(I+IHE(J),J-1)) *RFCP | IF (-STSE > 0.0) THEN WDUTD=wdep*SIGN(1.0, -STNS) | WARR = DPDE(I,J) & *(T(I+IHE(J),J+1,L+1)-DPT-T(I+IHE(J),J-1,L)) | ATC(I,J) = ATC(I,J) + WDUTD / (WARR+WDEP) IF ( -STNS.GT.0.0) THEN | ELSE warr=DPDE(I+IHE(J),J-1) | WARR = DPDEP1(I+IHE(J),J-1) ATC(I+IHE(J),J-1)=ATC(I+IHE(J),J-1)+WDUTD/(warr+wdep) | ATCP1(I+IHE(J),J-1) = ATCP1(I+IHE(J),J-1) + WDUTD / (WARR+WDEP) ELSE | END IF warr=DPDEP1(I+IHE(J),J+1) | ! ATCP1(I+IHE(J),J+1)=ATCP1(I+IHE(J),J+1)+WDUTD/(warr+wdep) | DIV(I+IHE(J),J-1,K+1) = DIV(I+IHE(J),J-1,K+1) + STNS !YELLOW END IF | DIVS(I+IHE(J),J+1) = DIVS(I+IHE(J),J+1) - STNS !YELLOW | ! ELSE IF (ISLD(I+IHE(J),J).EQ.8) THEN | WDEP = ABS(STNS) * DT DIV(I+IHE(J),J+1,L+1) = DIV(I+IHE(J),J+1,L+1) + STSEP1 | DPT = (RTOP(I+IHE(J),J-1,K+1) + RTOP(I+IHE(J),J+1,K)) DIVS(I+1,J) = DIVS(I+1,J) - STSEP1 | & * (DPDEP1(I+IHE(J),J-1) + DPDE(I+IHE(J),J+1)) wdep=ABS( STSEP1)*DT | & * RFCP DPT=(RTOP(I+IHE(J),J+1,L+1)+RTOP(I+1,J,L))* | ! & (DPDEP1(I+IHE(J),J+1) +DPDE(I+1,J)) *RFCP | WDUTD = WDEP * SIGN(1.0,STNS) * (T(I+IHE(J),J-1,K+1) - DPT WDUTD=wdep*SIGN(1.0, STSEP1) | & - T(I+IHE(J),J+1,K)) & *(T(I+IHE(J),J+1,L+1)-DPT-T(I+1,J,L)) | ! IF ( STSEP1.GT.0.0) THEN | IF (STNS > 0.0) THEN warr=DPDE(I+1,J) | WARR = DPDE(I+IHE(J),J+1) ATC(I+1,J)=ATC(I+1,J)+WDUTD/(warr+wdep) | ATC(I+IHE(J),J+1) = ATC(I+IHE(J),J+1) + WDUTD / (WARR+WDEP) ELSE | ELSE warr=DPDEP1(I+IHE(J),J+1) | WARR = DPDEP1(I+IHE(J),J-1) ATCP1(I+IHE(J),J+1)=ATCP1(I+IHE(J),J+1)+WDUTD/(warr+wdep) | ATCP1(I+IHE(J),J-1) = ATCP1(I+IHE(J),J-1) + WDUTD / (WARR+WDEP) END IF | END IF | ! DIV(I,J,L+1) = DIV(I,J,L+1) + STSE | DIV(I+1,J,K+1) = DIV(I+1,J,K+1) - STEW !GREEN DIVS(I+IHE(J),J-1) = DIVS(I+IHE(J),J-1) - STSE | DIVS(I,J) = DIVS(I,J) + STEW !GREEN wdep=ABS( STSE)*DT | ! DPT=(RTOP(I,J,L+1)+RTOP(I+IHE(J),J-1,L))* | WDEP = ABS(-STEW) * DT & (DPDEP1(I,J) +DPDE(I+IHE(J),J-1)) *RFCP | DPT = (RTOP(I+1,J,K+1) + RTOP(I,J,K)) WDUTD=wdep*SIGN(1.0, STSE)*(T(I,J,L+1)-DPT-T(I+IHE(J),J-1,L)) | & * (DPDEP1(I+1,J) + DPDE(I,J)) IF ( STSE.GT.0.0) THEN | & * RFCP warr=DPDE(I+IHE(J),J-1) | ! ATC(I+IHE(J),J-1)=ATC(I+IHE(J),J-1)+WDUTD/(warr+wdep) | WDUTD = WDEP * SIGN(1.0,-STEW) * (T(I+1,J,K+1) - DPT ELSE | & - T(I ,J,K )) warr=DPDEP1(I,J) | ! ATCP1(I,J)=ATCP1(I,J)+WDUTD/(warr+wdep) | IF (-STEW > 0.0) THEN END IF | WARR = DPDE(I,J) | ATC(I,J) = ATC(I,J) + WDUTD / (WARR+WDEP) DIV(I,J,L+1) = DIV(I,J,L+1) + STEW !blue | ELSE DIVS(I+1,J) = DIVS(I+1,J) - STEW !blue | WARR = DPDEP1(I+1,J) wdep=ABS( STEW)*DT | ATCP1(I+1,J) = ATCP1(I+1,J) + WDUTD / (WARR+WDEP) DPT=(RTOP(I,J,L+1)+RTOP(I+1,J,L))* | END IF & (DPDEP1(I,J) +DPDE(I+1,J)) *RFCP | ! WDUTD=wdep*SIGN(1.0, STEW)*(T(I,J,L+1)-DPT-T(I+1,J,L)) | ELSE IF (ISLD(I+IHE(J),J) == 5) THEN IF ( STEW.GT.0.0) THEN | DIV(I+IHE(J),J+1,K+1) = DIV(I+IHE(J),J+1,K+1) - STNE warr=DPDE(I+1,J) | DIVS(I,J) = DIVS(I,J) + STNE ATC(I+1,J)=ATC(I+1,J)+WDUTD/(warr+wdep) | ! ELSE | WDEP = ABS(-STNE) * DT warr=DPDEP1(I,J) | DPT = (RTOP(I+IHE(J),J+1,K+1) + RTOP(I,J,K)) ATCP1(I,J)=ATCP1(I,J)+WDUTD/(warr+wdep) | & * (DPDEP1(I+IHE(J),J+1) + DPDE(I,J)) END IF | & * RFCP | ! DIV(I+IHE(J),J+1,L+1) = DIV(I+IHE(J),J+1,L+1) - STNS !pink | WDUTD = WDEP * SIGN(1.0,-STNE) * (T(I+IHE(J),J+1,K+1) - DPT DIVS(I+IHE(J),J-1) = DIVS(I+IHE(J),J-1) + STNS !pink | & - T(I ,J ,K )) wdep=ABS( -STNS)*DT | ! DPT=(RTOP(I+IHE(J),J+1,L+1)+RTOP(I+IHE(J),J-1,L))* | IF (-STNE > 0.0) THEN & (DPDEP1(I+IHE(J),J+1) +DPDE(I+IHE(J),J-1)) *RFCP | WARR = DPDE(I,J) WDUTD=wdep*SIGN(1.0, -STNS) | ATC(I,J) = ATC(I,J) + WDUTD / (WARR+WDEP) & *(T(I+IHE(J),J+1,L+1)-DPT-T(I+IHE(J),J-1,L)) | ELSE IF ( -STNS.GT.0.0) THEN | WARR = DPDEP1(I+IHE(J),J+1) warr=DPDE(I+IHE(J),J-1) | ATCP1(I+IHE(J),J+1) = ATCP1(I+IHE(J),J+1) + WDUTD / (WARR+WDEP) ATC(I+IHE(J),J-1)=ATC(I+IHE(J),J-1)+WDUTD/(warr+wdep) | END IF ELSE | ! warr=DPDEP1(I+IHE(J),J+1) | DIV(I+IHE(J),J-1,K+1) = DIV(I+IHE(J),J-1,K+1) - STSE ATCP1(I+IHE(J),J+1)=ATCP1(I+IHE(J),J+1)+WDUTD/(warr+wdep) | DIVS(I,J) = DIVS(I,J) + STSE END IF | ! END IF | WDEP = ABS(-STSE) * DT | DPT = (RTOP(I+IHE(J),J-1,K+1) + RTOP(I,J,K)) END IF !! L.LT.LM | & * (DPDEP1(I+IHE(J),J-1) + DPDE(I,J)) C | & * RFCP 340 CONTINUE | ! C | WDUTD = WDEP * SIGN(1.0,-STSE) * (T(I+IHE(J),J-1,K+1) - DPT C------------------------------------------------------------------------ | & - T(I ,J ,K )) C | ! !$omp parallel do | IF (-STSE > 0.0) THEN DO 390 J=MYJS,MYJE | WARR = DPDE(I,J) DO 390 I=MYIS,MYIE | ATC(I,J) = ATC(I,J) + WDUTD / (WARR+WDEP) DIV(I,J,L)=(DIV(I,J,L)+DIVL(I,J))*HM(I,J) | ELSE 390 CONTINUE | WARR = DPDEP1(I+IHE(J),J-1) C----------------------------------------------------------------------- | ATCP1(I+IHE(J),J-1) = ATCP1(I+IHE(J),J-1) + WDUTD / (WARR+WDEP) 400 CONTINUE | END IF C----------------------------------------------------------------------- | ! RETURN | DIV(I+1,J,K+1) = DIV(I+1,J,K+1) - STEW !GREEN END | DIVS(I,J) = DIVS(I,J) + STEW !GREEN > ! > WDEP = ABS(-STEW) * DT > DPT = (RTOP(I+1,J,K+1) + RTOP(I,J,K)) > & * (DPDEP1(I+1,J) + DPDE(I,J)) > & * RFCP > ! > WDUTD = WDEP * SIGN(1.0,-STEW) * (T(I+1,J,K+1) - DPT > & - T(I,J,K)) > ! > IF (-STEW > 0.0) THEN > WARR = DPDE(I,J) > ATC(I,J) = ATC(I,J) + WDUTD / (WARR+WDEP) > ELSE > WARR = DPDEP1(I+1,J) > ATCP1(I+1,J) = ATCP1(I+1,J) + WDUTD / (WARR+WDEP) > END IF > ! > ELSE IF (ISLD(I+IHE(J),J) == 6) THEN > DIV(I+IHE(J),J+1,K+1) = DIV(I+IHE(J),J+1,K+1) - STNE > DIVS(I,J) = DIVS(I,J) + STNE > ! > WDEP = ABS(-STNE) * DT > DPT = (RTOP(I+IHE(J),J+1,K+1) + RTOP(I,J,K)) > & * (DPDEP1(I+IHE(J),J+1) + DPDE(I,J)) > & * RFCP > ! > WDUTD = WDEP * SIGN(1.0,-STNE) * (T(I+IHE(J),J+1,K+1) - DPT > & - T(I,J,K)) > ! > IF (-STNE > 0.0) THEN > WARR = DPDE(I,J) > ATC(I,J) = ATC(I,J) + WDUTD / (WARR+WDEP) > ELSE > WARR = DPDEP1(I+IHE(J),J+1) > ATCP1(I+IHE(J),J+1) = ATCP1(I+IHE(J),J+1) + WDUTD / (WARR+WDEP) > END IF > ! > DIV(I+1,J,K+1) = DIV(I+1,J,K+1) - STNEM1 > DIVS(I+IHE(J),J-1) = DIVS(I+IHE(J),J-1) + STNEM1 > ! > WDEP = ABS(-STNEM1) * DT > ! > DPT = (RTOP(I+1,J,K+1) + RTOP(I+IHE(J),J-1,K)) > & * (DPDEP1(I+1,J) + DPDE(I+IHE(J),J-1)) > & * RFCP > ! > WDUTD = WDEP * SIGN(1.0,-STNEM1) * (T(I+1,J,K+1) - DPT > & - T(I+IHE(J),J-1,K)) > ! > IF (-STNEM1 > 0.0) THEN > WARR = DPDE(I+IHE(J),J-1) > ATC(I+IHE(J),J-1) = ATC(I+IHE(J),J-1) + WDUTD / (WARR+WDEP) > ELSE > WARR = DPDEP1(I+1,J) > ATCP1(I+1,J) = ATCP1(I+1,J) + WDUTD / (WARR+WDEP) > END IF > ! > DIV(I+1,J,K+1) = DIV(I+1,J,K+1) - STEW !GREEN > DIVS(I,J) = DIVS(I,J) + STEW !GREEN > ! > WDEP = ABS(-STEW) * DT > DPT = (RTOP(I+1,J,K+1) + RTOP(I,J,K)) > & * (DPDEP1(I+1,J) + DPDE(I,J)) > & * RFCP > ! > WDUTD = WDEP * SIGN(1.0,-STEW) * (T(I+1,J,K+1) - DPT > & - T(I,J,K)) > ! > IF (-STEW > 0.0) THEN > WARR = DPDE(I,J) > ATC(I,J) = ATC(I,J) + WDUTD / (WARR+WDEP) > ELSE > WARR = DPDEP1(I+1,J) > ATCP1(I+1,J) = ATCP1(I+1,J) + WDUTD / (WARR+WDEP) > END IF > ! > DIV(I+IHE(J),J+1,K+1) = DIV(I+IHE(J),J+1,K+1) - STNS !PINK > DIVS(I+IHE(J),J-1) = DIVS(I+IHE(J),J-1) + STNS !PINK > ! > WDEP = ABS(-STNS) * DT > DPT = (RTOP(I+IHE(J),J+1,K+1) + RTOP(I+IHE(J),J-1,K)) > & * (DPDEP1(I+IHE(J),J+1) + DPDE(I+IHE(J),J-1)) > & * RFCP > ! > WDUTD = WDEP * SIGN(1.0,-STNS) * (T(I+IHE(J),J+1,K+1) - DPT > & - T(I+IHE(J),J-1,K)) > ! > IF (-STNS > 0.0) THEN > WARR = DPDE(I+IHE(J),J-1) > ATC(I+IHE(J),J-1) = ATC(I+IHE(J),J-1) + WDUTD / (WARR+WDEP) > ELSE > WARR = DPDEP1(I+IHE(J),J+1) > ATCP1(I+IHE(J),J+1) = ATCP1(I+IHE(J),J+1) + WDUTD / (WARR+WDEP) > END IF > ! > ELSE IF (ISLD(I+IHE(J),J) == 7) THEN > DIV(I,J,K+1) = DIV(I,J,K+1) + STSE > DIVS(I+IHE(J),J-1) = DIVS(I+IHE(J),J-1) - STSE > ! > WDEP = ABS(STSE) * DT > DPT = (RTOP(I,J,K+1) + RTOP(I+IHE(J),J-1,K)) > & * (DPDEP1(I,J) + DPDE(I+IHE(J),J-1)) > & * RFCP > ! > WDUTD = WDEP * SIGN(1.0,STSE) * (T(I,J,K+1) - DPT > & - T(I+IHE(J),J-1,K)) > ! > IF (STSE > 0.0) THEN > WARR = DPDE(I+IHE(J),J-1) > ATC(I+IHE(J),J-1) = ATC(I+IHE(J),J-1) + WDUTD / (WARR+WDEP) > ELSE > WARR = DPDEP1(I,J) > ATCP1(I,J) = ATCP1(I,J) + WDUTD / (WARR+WDEP) > END IF > ! > DIV(I+1,J,K+1) = DIV(I+1,J,K+1) - STNEM1 > DIVS(I+IHE(J),J-1) = DIVS(I+IHE(J),J-1) + STNEM1 > ! > WDEP = ABS(-STNEM1) * DT > DPT = (RTOP(I+1,J,K+1) + RTOP(I+IHE(J),J-1,K)) > & * (DPDEP1(I+1,J) + DPDE(I+IHE(J),J-1)) > & * RFCP > ! > WDUTD = WDEP * SIGN(1.0,-STNEM1) * (T(I+1 ,J ,K+1) - DPT > & - T(I+IHE(J),J-1,K )) > ! > IF (-STNEM1 > 0.0) THEN > WARR = DPDE(I+IHE(J),J-1) > ATC(I+IHE(J),J-1) = ATC(I+IHE(J),J-1) + WDUTD / (WARR+WDEP) > ELSE > WARR = DPDEP1(I+1,J) > ATCP1(I+1,J) = ATCP1(I+1,J) + WDUTD / (WARR+WDEP) > END IF > ! > DIV(I+IHE(J),J+1,K+1) = DIV(I+IHE(J),J+1,K+1) - STNS !PINK > DIVS(I+IHE(J),J-1) = DIVS(I+IHE(J),J-1) + STNS !PINK > ! > WDEP = ABS(-STNS) * DT > DPT = (RTOP(I+IHE(J),J+1,K+1) + RTOP(I+IHE(J),J-1,K)) > & * (DPDEP1(I+IHE(J),J+1) + DPDE(I+IHE(J),J-1)) > & * RFCP > ! > WDUTD = WDEP * SIGN(1.0,-STNS) * (T(I+IHE(J),J+1,K+1) - DPT > & - T(I+IHE(J),J-1,K )) > ! > IF (-STNS > 0.0) THEN > WARR = DPDE(I+IHE(J),J-1) > ATC(I+IHE(J),J-1) = ATC(I+IHE(J),J-1) + WDUTD / (WARR+WDEP) > ELSE > WARR = DPDEP1(I+IHE(J),J+1) > ATCP1(I+IHE(J),J+1) = ATCP1(I+IHE(J),J+1) + WDUTD / (WARR+WDEP) > END IF > ! > ELSE IF (ISLD(I+IHE(J),J) == 8) THEN > DIV(I+IHE(J),J+1,K+1) = DIV(I+IHE(J),J+1,K+1) + STSEP1 > DIVS(I+1,J) = DIVS(I+1,J) - STSEP1 > ! > WDEP = ABS( STSEP1) * DT > DPT = (RTOP(I+IHE(J),J+1,K+1) + RTOP(I+1,J,K)) > & * (DPDEP1(I+IHE(J),J+1) + DPDE(I+1,J)) > & * RFCP > ! > WDUTD = WDEP * SIGN(1.0,STSEP1) * (T(I+IHE(J),J+1,K+1) - DPT > & - T(I+1 ,J ,K )) > ! > IF ( STSEP1 > 0.0) THEN > WARR = DPDE(I+1,J) > ATC(I+1,J) = ATC(I+1,J) + WDUTD / (WARR+WDEP) > ELSE > WARR = DPDEP1(I+IHE(J),J+1) > ATCP1(I+IHE(J),J+1) = ATCP1(I+IHE(J),J+1) + WDUTD / (WARR+WDEP) > END IF > ! > DIV(I,J,K+1) = DIV(I,J,K+1) + STSE > DIVS(I+IHE(J),J-1) = DIVS(I+IHE(J),J-1) - STSE > ! > WDEP = ABS(STSE) * DT > DPT = (RTOP(I,J,K+1) + RTOP(I+IHE(J),J-1,K)) > & * (DPDEP1(I,J) + DPDE(I+IHE(J),J-1)) > & * RFCP > ! > WDUTD = WDEP * SIGN(1.0,STSE) * (T(I,J,K+1) - DPT > & - T(I+IHE(J),J-1,K)) > ! > IF (STSE > 0.0) THEN > WARR = DPDE(I+IHE(J),J-1) > ATC(I+IHE(J),J-1) = ATC(I+IHE(J),J-1) + WDUTD / (WARR+WDEP) > ELSE > WARR = DPDEP1(I,J) > ATCP1(I,J) = ATCP1(I,J) +WDUTD / (WARR+WDEP) > END IF > ! > DIV(I,J,K+1) = DIV(I,J,K+1) + STEW !BLUE > DIVS(I+1,J) = DIVS(I+1,J) - STEW !BLUE > ! > WDEP = ABS(STEW) * DT > DPT = (RTOP(I,J,K+1) + RTOP(I+1,J,K)) > & * (DPDEP1(I,J) + DPDE(I+1,J)) > & * RFCP > ! > WDUTD = WDEP * SIGN(1.0,STEW) * (T(I ,J,K+1) - DPT > & - T(I+1,J,K )) > ! > IF (STEW > 0.0) THEN > WARR = DPDE(I+1,J) > ATC(I+1,J) = ATC(I+1,J) + WDUTD / (WARR+WDEP) > ELSE > WARR = DPDEP1(I,J) > ATCP1(I,J) = ATCP1(I,J) + WDUTD / (WARR+WDEP) > END IF > ! > DIV(I+IHE(J),J+1,K+1) = DIV(I+IHE(J),J+1,K+1) - STNS !PINK > DIVS(I+IHE(J),J-1) = DIVS(I+IHE(J),J-1) + STNS !PINK > ! > WDEP = ABS(-STNS) * DT > DPT = (RTOP(I+IHE(J),J+1,K+1) + RTOP(I+IHE(J),J-1,K)) > & * (DPDEP1(I+IHE(J),J+1) + DPDE(I+IHE(J),J-1)) > & * RFCP > ! > WDUTD = WDEP * SIGN(1.0,-STNS) * (T(I+IHE(J),J+1,K+1) - DPT > & - T(I+IHE(J),J-1,K)) > ! > IF (-STNS > 0.0) THEN > WARR = DPDE(I+IHE(J),J-1) > ATC(I+IHE(J),J-1) = ATC(I+IHE(J),J-1) + WDUTD / (WARR+WDEP) > ELSE > WARR = DPDEP1(I+IHE(J),J+1) > ATCP1(I+IHE(J),J+1) = ATCP1(I+IHE(J),J+1) + WDUTD / (WARR+WDEP) > END IF > END IF > !------- > ! K < LM > !------- > END IF > END IF > ! > 340 END DO > !------- > ! OPENMP > !------- > ! > !$omp parallel do > ! > DO 390 J=MYJS,MYJE > DO 390 I=MYIS,MYIE > DIV(I,J,K) = (DIV(I,J,K) + DIVL(I,J)) * HM(I,J) > 390 END DO > ! > 400 END DO > ! > RETURN > ! > END SUBROUTINE DIVHOAST