A ROTINA DA ESQUERDA É A VERSÃO ANTIGA DE 2012 E A ROTINA DA DIREITA É A VERSÃO MODULAR DO Eta1km C&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& | SUBROUTINE PDTEDT SUBROUTINE PDTEDT | !>---------------------------------------------------------------------------------------------- C ****************************************************************** | !> SUBROUTINE PDTEDT C$$$ SUBPROGRAM DOCUMENTATION BLOCK | !> C . . . | !> SUBROUTINE: PDTEDT - SURFACE PRESSURE TENDENCY CALC C SUBPROGRAM: PDTEDT SURFACE PRESSURE TENDENCY CALC | !> PROGRAMMER: JANJIC C PRGRMMR: JANJIC ORG: W/NMC2 DATE: 96-07-?? | !> ORG: W/NMC2 C | !> DATE: 96-07-?? C ABSTRACT: | !> C PDTEDT VERTICALLY INTEGRATES THE MASS FLUX DIVERGENCE TO | !> ABSTRACT: C OBTAIN THE SURFACE PRESSURE TENDENCY AND ETADOT ON THE | !> PDTEDT VERTICALLY INTEGRATES THE MASS FLUX DIVERGENCE TO OBTAIN THE SURFACE PRESSURE TENDENCY C LAYER INTERFACES. THEN IT UPDATES THE HYDROSTATIC SURFACE | !> ETADOT ON THE LAYER INTERFACES. C PRESSURE, THE NONHYDROSTATIC PRESSURE, AND ADDS THE LOCAL TIME | !> THEN IT UPDATES THE HYDROSTATIC SURFACE PRESSURE, THE NONHYDROSTATIC PRESSURE, AND ADDS THE L C DERIVATIVE AND VERTICAL ADVECTION OF NONHYDROSTATIC PRESSURE | !> TIME DERIVATIVE AND VERTICAL ADVECTION OF NONHYDROSTATIC PRESSURE CONTRIBUTION TO THE OMEGA-A C CONTRIBUTION TO THE OMEGA-ALPHA TERM OF THE THERMODYNAMIC | !> TERM OF THE THERMODYNAMIC EQUATION. C EQUATION. ALSO, THE OMEGA-ALPHA TERM IS COMPUTED FOR DIAGNOSTICS. | !> ALSO, THE OMEGA-ALPHA TERM IS COMPUTED FOR DIAGNOSTICS. C | !> C PROGRAM HISTORY LOG: | !> PROGRAM HISTORY LOG: C 87-06-?? JANJIC - ORIGINATOR | !> 87-06-?? JANJIC - ORIGINATOR C 95-03-25 BLACK - CONVERSION FROM 1-D TO 2-D IN HORIZONTAL | !> 95-03-25 BLACK - CONVERSION FROM 1-D TO 2-D IN HORIZONTAL C 96-05-?? JANJIC - ADDED NONHYDROSTATIC EFFECTS & MERGED THE | !> 96-05-?? JANJIC - ADDED NONHYDROSTATIC EFFECTS & MERGED THE PREVIOUS SUBROUTINES PDTE AN C PREVIOUS SUBROUTINES PDTE & PDNEW | !> PDNEW C 00-01-03 BLACK - DISTRIBUTED MEMORY AND THREADS | !> 00-01-03 BLACK - DISTRIBUTED MEMORY AND THREADS C | !> 18-01-15 LUCCI - MODERNIZATION OF THE CODE, INCLUDING: C USAGE: CALL PDTEDT FROM MAIN PROGRAM | !> * F77 TO F90/F95 C INPUT ARGUMENT LIST: | !> * INDENTATION & UNIFORMIZATION CODE C NONE | !> * REPLACEMENT OF COMMONS BLOCK FOR MODULES C | !> * DOCUMENTATION WITH DOXYGEN C OUTPUT ARGUMENT LIST: | !> * OPENMP FUNCTIONALITY C NONE | !> C | !> C OUTPUT FILES: | !> INPUT ARGUMENT LIST: C NONE | !> NONE C | !> C SUBPROGRAMS CALLED: | !> OUTPUT ARGUMENT LIST: C | !> NONE C UNIQUE: NONE | !> C | !> INPUT/OUTPUT ARGUMENT LIST: C LIBRARY: NONE | !> NONE C | !> C COMMON BLOCKS: CTLBLK | !> OUTPUT FILES: C LOOPS | !> NONE C MASKS | !> C DYNAM | !> USE MODULES: CONTIN C CONTIN | !> CTLBLK C VRBLS | !> DYNAM C NHYDRO | !> EXCHM C INDX | !> F77KINDS C | !> GLB_TABLE C ATTRIBUTES: | !> INDX C LANGUAGE: FORTRAN 90 | !> LOOPS C MACHINE : IBM SP | !> MAPPINGS C$$$ | !> MASKS C*********************************************************************** | !> MPPCOM C----------------------------------------------------------------------- | !> NHYDRO INCLUDE "EXCHM.h" | !> PARMETA INCLUDE "parmeta" | !> TEMPCOM INCLUDE "mpp.h" | !> TIMMING C----------------------------------------------------------------------- | !> TOPO P A R A M E T E R | !> VRBLS &(IMJM=IM*JM-JM/2,JAM=6+2*(JM-10) | !> &,LM1=LM-1,LP1=LM+1 | !> DRIVER : DIGFLT &,ITRMX=0,WC=2./3.,RWCQ=(1.-WC)*0.25,RWC=1./WC) | !> EBU C | !> P A R A M E T E R | !> CALLS : EXCH & (KSMUD=7,LNSDT=7) | !> ZERO2 C----------------------------------------------------------------------- | !>---------------------------------------------------------------------------------------------- L O G I C A L | USE CONTIN & RUN,FIRST,RESTRT,SIGMA | USE CTLBLK C----------------------------------------------------------------------- | USE DYNAM INCLUDE "CTLBLK.comm" | USE EXCHM C----------------------------------------------------------------------- | USE F77KINDS INCLUDE "LOOPS.comm" | USE GLB_TABLE C----------------------------------------------------------------------- | USE INDX INCLUDE "MASKS.comm" | USE LOOPS C----------------------------------------------------------------------- | USE MAPOT INCLUDE "INDX.comm" | USE MAPPINGS C----------------------------------------------------------------------- | USE MASKS INCLUDE "DYNAM.comm" | USE MPPCOM C----------------------------------------------------------------------- | USE NHYDRO INCLUDE "VRBLS.comm" | USE PARMETA C----------------------------------------------------------------------- | USE TEMPCOM INCLUDE "NHYDRO.comm" | USE TIMMING c----------------------------------------------------------------------- | USE TOPO INCLUDE "CONTIN.comm" | USE VRBLS C----------------------------------------------------------------------- | ! R E A L | IMPLICIT NONE & PRET (IDIM1:IDIM2,JDIM1:JDIM2),RPSL (IDIM1:IDIM2,JDIM1:JDIM2) | ! &,FNE (IDIM1:IDIM2,JDIM1:JDIM2),FSE (IDIM1:IDIM2,JDIM1:JDIM2) | INCLUDE "EXCHM.h" &,HBMS (IDIM1:IDIM2,JDIM1:JDIM2) | ! &,TTB (IDIM1:IDIM2,JDIM1:JDIM2) | INTEGER(KIND=I4KIND), PARAMETER :: IMJM = IM * JM - JM / 2 &,APDT (IDIM1:IDIM2,JDIM1:JDIM2),PPDT (IDIM1:IDIM2,JDIM1:JDIM2) | INTEGER(KIND=I4KIND), PARAMETER :: ITRMX = 0 &,TPM (IDIM1:IDIM2,JDIM1:JDIM2) | ! C----------------------------------------------------------------------- | REAL (KIND=R4KIND), PARAMETER :: WC = 2. / 3. C----------------------------------------------------------------------- | REAL (KIND=R4KIND), PARAMETER :: RWCQ = (1. - WC) * 0.25 C*** | REAL (KIND=R4KIND), PARAMETER :: RWC = 1. / WC C*** THE FOLLOWING ARE USED FOR TIMIMG PURPOSES ONLY | ! C*** | INTEGER(KIND=I4KIND), PARAMETER :: KSMUD = 7 real*8 timef | INTEGER(KIND=I4KIND), PARAMETER :: LNSDT = 7 real nhb_tim,mpp_tim,init_tim | ! common/timing/surfce_tim,nhb_tim,res_tim,exch_tim | REAL (KIND=R4KIND), DIMENSION(IDIM1:IDIM2, JDIM1:JDIM2) C*********************************************************************** | & PRET , RPSL , C----------------------------------------------------------------------- | & FNE , FSE , C | & HBMS , CALL ZERO2(PDSLO) | & TTB , C | & APDT , PPDT , C--------------COMPUTATION OF PRESSURE TENDENCY & PREPARATIONS---------- | & TPM C | !------------------------------------------------ DO 100 L=2,LM | ! THE FOLLOWING ARE USED FOR TIMIMG PURPOSES ONLY C | !------------------------------------------------ !$omp parallel do | REAL (KIND=R8KIND) DO J=MYJS_P2,MYJE_P2 | & TIMEF DO I=MYIS_P2,MYIE_P2 | !------------------------ DIV(I,J,L)=DIV(I,J,L-1)+DIV(I,J,L) | ! IMPLICIT NONE VARIABLES ENDDO | !------------------------ ENDDO | INTEGER(KIND=I4KIND) C | & I , J , K , 100 CONTINUE | & IX , JX , C----------------------------------------------------------------------- | & KS , !$omp parallel do | & NSMUD , DO J=MYJS_P2,MYJE_P2 | & JHL , JHH , DO I=MYIS_P2,MYIE_P2 | & IHL , IHH PSDT(I,J)=-DIV(I,J,LM) | ! APDT(I,J)=PSDT(I,J) | REAL (KIND=R4KIND) PPDT(I,J)=PSDT(I,J) | & DWDTP , TPMP , TTAL , RHS , ETADTL , BTIM PDSLO(I,J)=PDSL(I,J) | ! RPSL(I,J)=1./PDSL(I,J) | CALL ZERO2(PDSLO) ENDDO | !------------------------------------------------ ENDDO | ! COMPUTATION OF PRESSURE TENDENCY & PREPARATIONS C----------------------------------------------------------------------- | !------------------------------------------------ C--------------HARD+SOFT AIR DEAVERAGING BLOCK-------------------------- | DO 100 K=2,LM C----------------------------------------------------------------------- | ! C IF(ITRMX.GT.0)THEN | !$omp parallel do C---------------------------------------------------------------------- | ! C DO 220 ITR=1,ITRMX | DO J=MYJS_P2,MYJE_P2 C----------------------------------------------------------------------- | DO I=MYIS_P2,MYIE_P2 C | DIV(I,J,K) = DIV(I,J,K-1) + DIV(I,J,K) c!$omp parallel do | END DO c DO J=MYJS2_P4,MYJE2_P4 | END DO c IHL=2 | ! c IHH=IM-2+MOD(J,2) | 100 END DO c | ! c DO I=MYIS1_P4,MYIE1_P4 | !$omp parallel do c PPDT(I,J)=(APDT(I,J) | ! c 2 -(PSDT(I+IHW(J),J-1)+PSDT(I+IHE(J),J-1) | DO J=MYJS_P2,MYJE_P2 c 3 +PSDT(I+IHW(J),J+1)+PSDT(I+IHE(J),J+1))*RWCQ) | DO I=MYIS_P2,MYIE_P2 c 4 *RWC | PSDT(I,J) = -DIV(I,J,LM) c ENDDO | APDT(I,J) = PSDT(I,J) c ENDDO | PPDT(I,J) = PSDT(I,J) c | PDSLO(I,J) = PDSL(I,J) c!$omp parallel do | RPSL(I,J) = 1. / PDSL(I,J) c DO J=MYJS2_P4,MYJE2_P4 | END DO c DO I=MYIS1_P4,MYIE1_P4 | END DO c PSDT(I,J)=PPDT(I,J)*HBM2(I,J)+(1.-HBM2(I,J))*PSDT(I,J) | ! c ENDDO | !$omp parallel do c ENDDO | ! C----------------------------------------------------------------------- | DO J=MYJS_P2,MYJE_P2 c 220 CONTINUE | DO I=MYIS_P2,MYIE_P2 C----------------------------------------------------------------------- | PRET(I,J) = PSDT(I,J) * RES(I,J) c ENDIF | PDSL(I,J) = PD(I,J) * RES(I,J) C----------------------------------------------------------------------- | ! !$omp parallel do | PINT(I,J,1) = PT DO J=MYJS_P2,MYJE_P2 | ! DO I=MYIS_P2,MYIE_P2 | TPM(I,J) = PT + PINT(I,J,2) PRET(I,J)=PSDT(I,J)*RES(I,J) | TTB(I,J) = 0. PDSL(I,J)=PD(I,J)*RES(I,J) | END DO C | END DO PINT(I,J,1)=PT | !--------------------- C | ! COMPUTATION OF ETADT TPM(I,J)=PT+PINT(I,J,2) | !--------------------- TTB(I,J)=0. | ! ENDDO | !$omp parallel do ENDDO | ! C----------------------------------------------------------------------- | DO 300 K=1,LM1 C--------------COMPUTATION OF ETADT------------------------------------- | ! C----------------------------------------------------------------------- | DO J=MYJS_P2,MYJE_P2 !$omp parallel do | DO I=MYIS_P2,MYIE_P2 DO 300 L=1,LM1 | ETADT(I,J,K) = - (PRET(I,J) * ETA(K+1) + DIV(I,J,K)) C | & * HTM(I,J,K+1) * HBM2(I,J) * RPSL(I,J) DO J=MYJS_P2,MYJE_P2 | END DO DO I=MYIS_P2,MYIE_P2 | END DO ETADT(I,J,L)=-(PRET(I,J)*ETA(L+1)+DIV(I,J,L)) | 300 END DO 1 *HTM(I,J,L+1)*HBM2(I,J)*RPSL(I,J) | !---------------------------------------------- ENDDO | ! KINETIC ENERGY GENERATION TERMS IN T EQUATION ENDDO | !---------------------------------------------- 300 CONTINUE | ! C----------------------------------------------------------------------- | !$omp parallel do private (DWDTP , RHS , TPMP , TTAL) C--------------KINETIC ENERGY GENERATION TERMS IN T EQUATION------------ | ! C----------------------------------------------------------------------- | DO J=MYJS,MYJE !$omp parallel do private (dwdtp,rhs,tpmp,ttal) | DO I=MYIS,MYIE DO J=MYJS,MYJE | DWDTP = DWDT(I,J,1) DO I=MYIS,MYIE | TPMP = PINT(I,J,2) + PINT(I,J,3) DWDTP=DWDT(I,J,1) | ! TPMP=PINT(I,J,2)+PINT(I,J,3) | TTAL = 0. c | ! c TTAL=(T(I,J,2)-T(I,J,1))*ETADT(I,J,1)*F4D*0.5 | RHS = -DIV(I,J,1) * RTOP(I,J,1) * HTM(I,J,1) * DWDTP * EF4T c TTAL=(T(I,J,2)-T(I,J,1))*ETADT(I,J,1)*F4D | ! c | OMGALF(I,J,1) = OMGALF(I,J,1) + RHS TTAL=0. | T(I,J,1) = (TTAL * RDETA(1) + RHS) * HBM2(I,J) + T(I,J,1) C | PINT(I,J,2) = PRET(I,J) * (ETA(1) + ETA(2)) * DWDTP * DT + TPM(I,J) - PINT(I,J,1) RHS=-DIV(I,J,1)*RTOP(I,J,1)*HTM(I,J,1)*DWDTP*EF4T | ! OMGALF(I,J,1)=OMGALF(I,J,1)+RHS | TPM(I,J) = TPMP T(I,J,1)=(TTAL*RDETA(1)+RHS)*HBM2(I,J)+T(I,J,1) | TTB(I,J) = TTAL PINT(I,J,2)=PRET(I,J)*(ETA(1)+ETA(2))*DWDTP*DT | END DO 1 +TPM(I,J)-PINT(I,J,1) | END DO C | ! TPM(I,J)=TPMP | DO 410 K=2,LM1 TTB(I,J)=TTAL | ! ENDDO | !$omp parallel do private (DWDTP , RHS , TPMP , TTAL) ENDDO | ! C----------------------------------------------------------------------- | DO J=MYJS,MYJE DO 410 L=2,LM1 | DO I=MYIS,MYIE C | DWDTP = DWDT(I,J,K ) !$omp parallel do private (dwdtp,rhs,tpmp,ttal) | TPMP = PINT(I,J,K+1) + PINT(I,J,K+2) DO J=MYJS,MYJE | ! DO I=MYIS,MYIE | TTAL = 0. DWDTP=DWDT(I,J,L) | ! TPMP=PINT(I,J,L+1)+PINT(I,J,L+2) | RHS = -(DIV(I,J,K-1) + DIV(I,J,K)) * RTOP(I,J,K) * HTM(I,J,K) * DWDTP * EF4T c | ! c TTAL=(T(I,J,L+1)-T(I,J,L))*ETADT(I,J,L)*F4D*0.5 | OMGALF(I,J,K ) = OMGALF(I,J,K) + RHS c TTAL=(T(I,J,L+1)-T(I,J,L))*ETADT(I,J,L)*F4D | T(I,J,K ) = ((TTAL + TTB(I,J)) * RDETA(L) + RHS) * HBM2(I,J) + T(I,J,K) c | PINT(I,J,K+1) = PRET(I,J) * (ETA(K) + ETA(K+1)) * DWDTP * DT + TPM(I,J) TTAL=0. | & - PINT(I,J,K) C | RHS=-(DIV(I,J,L-1)+DIV(I,J,L))*RTOP(I,J,L)*HTM(I,J,L)*DWDTP | TPM(I,J) = TPMP 2 *EF4T | TTB(I,J) = TTAL OMGALF(I,J,L)=OMGALF(I,J,L)+RHS | END DO T(I,J,L)=((TTAL+TTB(I,J))*RDETA(L)+RHS)*HBM2(I,J)+T(I,J,L) | END DO PINT(I,J,L+1)=PRET(I,J)*(ETA(L)+ETA(L+1))*DWDTP*DT | 2 +TPM(I,J)-PINT(I,J,L) | 410 END DO C | ! TPM(I,J)=TPMP | !$omp parallel do private (DWDTP , RHS) TTB(I,J)=TTAL | ! ENDDO | DO J=MYJS,MYJE ENDDO | DO I=MYIS,MYIE C | DWDTP = DWDT(I,J,LM) 410 CONTINUE | ! c----------------------------------------------------------------------- | RHS = -(DIV(I,J,LM1) + DIV(I,J,LM)) * RTOP(I,J,LM) * HTM(I,J,LM) * DWDTP * EF4T !$omp parallel do private (dwdtp,rhs) | ! DO J=MYJS,MYJE | OMGALF(I,J,LM ) = OMGALF(I,J,LM) + RHS DO I=MYIS,MYIE | T(I,J,LM ) = (TTB(I,J) * RDETA(LM) + RHS) * HBM2(I,J) + T(I,J,LM) DWDTP=DWDT(I,J,LM) | PINT(I,J,LM+1) = PRET(I,J) * (ETA(LM) + ETA(LM+1)) * DWDTP * DT + TPM(I,J) C | & - PINT(I,J,LM) RHS=-(DIV(I,J,LM1)+DIV(I,J,LM))*RTOP(I,J,LM)*HTM(I,J,LM)*DWDTP | END DO 1 *EF4T | END DO 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) | ! REGENERATE THE UNINTEGRATED DIVERGENCE PINT(I,J,LM+1)=PRET(I,J)*(ETA(LM)+ETA(LM+1))*DWDTP*DT | !--------------------------------------- 1 +TPM(I,J)-PINT(I,J,LM) | DO 425 K=LM,2,-1 ENDDO | ! ENDDO | !$omp parallel do C----------------------------------------------------------------------- | ! C-------------- REGENERATE THE UNINTEGRATED DIVERGENCE --------------- | DO J=MYJS2,MYJE2 C----------------------------------------------------------------------- | DO I=MYIS,MYIE DO 425 L=LM,2,-1 | DIV(I,J,K) = DIV(I,J,K) - DIV(I,J,K-1) !$omp parallel do | END DO DO J=MYJS,MYJE2 | END DO DO I=MYIS,MYIE | ! DIV(I,J,L)=DIV(I,J,L)-DIV(I,J,L-1) | 425 END DO ENDDO | !--------------------------------------------- ENDDO | ! SMOOTHING VERTICAL VELOCITY ALONG BOUNDARIES C | !--------------------------------------------- 425 CONTINUE | IF (.NOT. HYDRO .AND. KSMUD > 0) THEN C----------------------------------------------------------------------- | ! C--------------SMOOTHING VERTICAL VELOCITY ALONG BOUNDARIES------------- | NSMUD = KSMUD C----------------------------------------------------------------------- | ! IF(.NOT.HYDRO.AND.KSMUD.GT.0)THEN | !$omp parallel do C----------------------------------------------------------------------- | ! NSMUD=KSMUD | DO J=MYJS,MYJE C | DO I=MYIS,MYIE !$omp parallel do | HBMS(I,J) = HBM2(I,J) DO J=MYJS,MYJE | END DO DO I=MYIS,MYIE | END DO HBMS(I,J)=HBM2(I,J) | ! ENDDO | JHL = LNSDT ENDDO | JHH = JM - JHL + 1 C | ! JHL=LNSDT | DO J=JHL,JHH JHH=JM-JHL+1 | IF (J >= MY_JS_GLB .AND. J <= MY_JE_GLB) THEN C | IHL = JHL / 2 + 1 DO J=JHL,JHH | IHH = IM - IHL + MOD(J,2) IF(J.GE.MY_JS_GLB.AND.J.LE.MY_JE_GLB)THEN | ! IHL=JHL/2+1 | DO I=IHL,IHH IHH=IM-IHL+MOD(J,2) | IF (I >= MY_IS_GLB .AND. I <= MY_IE_GLB) THEN C | IX = I - MY_IS_GLB + 1 DO I=IHL,IHH | JX = J - MY_JS_GLB + 1 IF(I.GE.MY_IS_GLB.AND.I.LE.MY_IE_GLB)THEN | HBMS(IX,JX) = 0. IX=I-MY_IS_GLB+1 | END IF JX=J-MY_JS_GLB+1 | END DO HBMS(IX,JX)=0. | ! ENDIF | END IF ENDDO | END DO C | ! ENDIF | DO KS=1,NSMUD ENDDO | ! C | !$omp parallel do (ETADTL , FNE , FSE) C----------------------------------------------------------------------- | ! DO KS=1,NSMUD | DO 450 K=1,LM-1 C----------------------------------------------------------------------- | ! C | DO J=MYJS_P1,MYJE1_P1 !$omp parallel do private (etadtl,fne,fse) | DO I=MYIS_P1,MYIE1_P1 DO 450 L=1,LM-1 | FNE(I,J) = (ETADT(I+IHE(J),J+1,K ) - ETADT(I ,J ,K )) C | & * HTM(I ,J ,K+1) * HTM(I+IHE(J),J+1,K+1) DO J=MYJS_P1,MYJE1_P1 | END DO DO I=MYIS_P1,MYIE1_P1 | END DO FNE(I,J)=(ETADT(I+IHE(J),J+1,L)-ETADT(I,J,L)) | ! 1 *HTM(I,J,L+1)*HTM(I+IHE(J),J+1,L+1) | DO J=MYJS1_P1,MYJE_P1 ENDDO | DO I=MYIS_P1,MYIE1_P1 ENDDO | FSE(I,J) = (ETADT(I+IHE(J),J-1,K ) - ETADT(I ,J ,K )) C | & * HTM(I+IHE(J),J-1,K+1) * HTM(I ,J ,K+1) DO J=MYJS1_P1,MYJE_P1 | END DO DO I=MYIS_P1,MYIE1_P1 | END DO FSE(I,J)=(ETADT(I+IHE(J),J-1,L)-ETADT(I,J,L)) | ! 1 *HTM(I+IHE(J),J-1,L+1)*HTM(I,J,L+1) | DO J=MYJS2,MYJE2 ENDDO | DO I=MYIS1,MYIE1 ENDDO | ETADTL = (FNE(I,J) - FNE(I+IHW(J),J-1) + FSE(I,J) C | & - FSE(I+IHW(J),J+1)) * HBM2(I,J) DO J=MYJS2,MYJE2 | ! DO I=MYIS1,MYIE1 | ETADT(I,J,K) = ETADTL * HBMS(I,J) * 0.125 + ETADT(I,J,K) ETADTL=(FNE(I,J)-FNE(I+IHW(J),J-1) | END DO 1 +FSE(I,J)-FSE(I+IHW(J),J+1))*HBM2(I,J) | END DO ETADT(I,J,L)=ETADTL*HBMS(I,J)*0.125+ETADT(I,J,L) | ! ENDDO | 450 END DO ENDDO | ! C | BTIM = TIMEF() 450 CONTINUE | ! C | CALL EXCH(ETADT, LM-1, 2, 2) btim=timef() | ! CALL EXCH(ETADT,LM-1,2,2) | EXCH_TIM = EXCH_TIM + TIMEF() - BTIM exch_tim=exch_tim+timef()-btim | ! C | END DO ENDDO | ! C | END IF C----------------------------------------------------------------------- | ! ENDIF | RETURN C----------------------------------------------------------------------- | ! RETURN | END SUBROUTINE PDTEDT END <