C&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
                             SUBROUTINE PDTE
CFPP$ NOCONCUR R
C     ******************************************************************
C     *                                                                *
C     *  ROUTINE FOR CALCULATING PRESSURE TENDENCY, VERTICAL VELOCITY, *
C     *  UPDATING PRESSURE DIFFERENCE & CALCULATING THE CONTRIBUTION   *
C     *  OF THE VERTICAL PART OF THE OMEGA-ALPHA TERM                  *
C     *                                                                *
C     ******************************************************************
C
C     13/05/98  DEDT       d \eta/ dt
C
C     ******************************************************************
                             P A R A M E T E R
     & (H1=1.0,CP=1004.6,D00=0.)
C-----------------------------------------------------------------------
      INCLUDE "parmeta"
C-----------------------------------------------------------------------
                             P A R A M E T E R
     & (LDA=LM+9,LA=13)
C***WARNING***  IF LM.GT.16 THEN SET LDA=LM+9
                             P A R A M E T E R
     & (IMJM=IM*JM-JM/2,JAM=6+2*(JM-10)
     &, KHL00=1,KHL02=2*IM
     &, KHH02=IM*(JM-2)-(JM-2)/2
     &, LM1=LM-1,LP1=LM+1
     &, LSCRCH=4*LM+1+LA +1,L1=LDA+1,L3=LDA+1+LM
     &, L4=LDA+1+2*LM,L5=L4+1
     &, L7=L5+2)
C-----------------------------------------------------------------------
                             L O G I C A L
     & RUN,FIRST,RESTRT,SIGMA
C-----------------------------------------------------------------------
      INCLUDE "CTLBLK"
C-----------------------------------------------------------------------
      INCLUDE "MASKS"
C-----------------------------------------------------------------------
      INCLUDE "DYNAM"
C-----------------------------------------------------------------------
      INCLUDE "SCRCH"
C-----------------------------------------------------------------------
      INCLUDE "VRBLS"
      INCLUDE "DIANOS"
C-----------------------------------------------------------------------
      
      COMMON/ETATM/ ETADOT(IMJM,LM),ETAZ(IMJM,LP1),
     *             ETAKH(IMJM,LM1),ETAKHS(IMJM),
     *             ETAPR(IMJM),ETACPR(IMJM)             
           
C-----------------------------------------------------------------------
                             D I M E N S I O N
     & PDSL  (IMJM),PSDT  (IMJM),PRET  (IMJM),RPSL  (IMJM)
     &,TT    (IMJM),CPEV  (IMJM),DPDE  (IMJM)
C
     &,ETADT (IMJM,LM),DIV   (IMJM,LM),SDIV  (IMJM,LM),RTOP  (IMJM,LM)
     &,OMGALF(IMJM,LM)
C-----------------------------------------------------------------------
                             E Q U I V A L E N C E
     & (DUM   (1,01),PDSL  (1)                                        )
     &,(DUM   (1,02),PSDT  (1)                                        )
                             E Q U I V A L E N C E
     & (DUM   (1,03),PRET  (1)                                        )
     &,(DUM   (1,04),RPSL  (1)                                        )
     &,(DUM   (1,05),DPDE  (1)                                        )
     &,(DUM   (1,10),ETADT (1,1)                                      )
     &,(DUM   (1,L1),DIV   (1,1),SDIV  (1,1)                          )
     &,(DUM   (1,L3),RTOP  (1,1)                                      )
     &,(DUM   (1,L4),TT    (1)                                        )
     &,(DUM   (1,L5),CPEV  (1)                                        )
     &,(DUM   (1,L7),OMGALF(1,1)                                     )
C--------------COMPUTATION OF PRESSURE TENDENCY & PREPARATIONS----------
                             DO 100 L=2,LM
CMIC$ DO ALL VECTOR AUTOSCOPE
          DO 100 K=KHL00,KHH02
 100  SDIV(K,L)=SDIV(K,L-1)+SDIV(K,L)
CMIC$ DO ALL VECTOR AUTOSCOPE
          DO 110 K=KHL02,KHH02
      PSDT(K)=-SDIV(K,LM)
      PRET(K)=PSDT(K)*RES(K)
 110  RPSL(K)=H1/PDSL(K)
C--------------COMPUTATION OF ETADT-------------------------------------
CMIC$ DO ALL AUTOSCOPE
                             DO 120 L=1,LM1
          DO 120 K=KHL02,KHH02
 120  ETADT(K,L)=-(PRET(K)*ETA(L+1)+SDIV(K,L))*HTM(K,L+1)*RPSL(K)
C-----------------------------------------------------------------------
C xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
      DO L=1,LM
      DO K=KHL02,KHH02
      ETADOT(K,L)=ETADT(K,L)
      ENDDO
      
      DO K=1,KHL02-1
      ETADOT(K,L)=0.
      ENDDO
      
      DO K=KHH02+1,IMJM
      ETADOT(K,L)=0.      
      ENDDO
      
      ENDDO     
C xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx      
C--------------KINETIC ENERGY GENERATION TERMS IN T EQUATION------------
CMIC$ DO ALL VECTOR AUTOSCOPE
          DO 130 K=KHL02,KHH02
C     DPDE(K)=DETA(1)*PDSL(K)
C     TT(K)=T(K,1)
      OMGALF(K,1)=OMGALF(K,1)-SDIV(K,1)*RTOP(K,1)*EF4T
 130  T     (K,1)=T     (K,1)-SDIV(K,1)*RTOP(K,1)*EF4T
C130  CPEV(K)=CP*(T(K,1)-TT(K))*DPDE(K)
C-----------------------------------------------------------------------
CMIC$ PARALLEL AUTOSCOPE
CMIC$ DO PARALLEL
                             DO 145 L=2,LM1
          DO 140 K=KHL02,KHH02
C     DPDE(K)=DETA(L)*PDSL(K)
C     TT(K)=T(K,L)
      OMGALF(K,L)=OMGALF(K,L)-(SDIV(K,L-1)+SDIV(K,L))*RTOP(K,L)*EF4T
      T     (K,L)=T     (K,L)-(SDIV(K,L-1)+SDIV(K,L))*RTOP(K,L)*EF4T
C140  CPEV(K)=CP*(T(K,L)-TT(K))*DPDE(K)
 140      CONTINUE
 145                         CONTINUE
CMIC$ END PARALLEL
C-----------------------------------------------------------------------
CMIC$ PARALLEL AUTOSCOPE
CMIC$ DO PARALLEL VECTOR
          DO 150 K=KHL02,KHH02
C     DPDE(K)=DETA(LM)*PDSL(K)
C     TT(K)=T(K,LM)
      OMGALF(K,LM)=OMGALF(K,LM)+(PRET(K)-SDIV(K,LM1))*RTOP(K,LM)*EF4T
      T     (K,LM)=T     (K,LM)+(PRET(K)-SDIV(K,LM1))*RTOP(K,LM)*EF4T
C150  CPEV(K)=CP*(T(K,LM)-TT(K))*DPDE(K)
 150      CONTINUE
CMIC$ END PARALLEL
C-----------------------------------------------------------------------
CDIA
C     START DIAGNOSTIC BLOCK.
C
C     SURFACE PRESSURE TENDENCY AND ETA-DOT.
          IF ( ((DIASFC).AND.(MOD(NTSD-1,NSFC).EQ.0)) .OR.
     X         ((DIAALL).AND.(MOD(NTSD-1,NALL).EQ.0)) ) THEN
         TITLE = 'PSFC/DT - PDTE'
         FTIME = (NTSD-1)*DT
         DO IPT = 1,NUMDIA
            KPT       = KDIAX(IPT)
            IDSTA     = IDDIA(IPT)
            RLAT      = DIALAT(IPT)
            RLON      = DIALON(IPT)
            DIAFLD(1) = PSDT(KPT)
            IF (DIASFC) 
     X       CALL DWRITE(TITLE,IDSTA,RLAT,RLON,FTIME,1,DIAFLD,LUNSFC)
            IF (DIAALL)
     X       CALL DWRITE(TITLE,IDSTA,RLAT,RLON,FTIME,1,DIAFLD,LUNALL)
         END DO
      END IF
C
C     TEMPERATURE.
      IF ( ((DIATMP).AND.(MOD(NTSD-1,NTMP).EQ.0)) .OR.
     X     ((DIAALL).AND.(MOD(NTSD-1,NALL).EQ.0)) ) THEN
         TITLE = 'T AFTER KINETIC ENERGY UPDATE - PDTE'
         FTIME = (NTSD-1)*DT
         DO IPT = 1,NUMDIA
            KPT   = KDIAX(IPT)
            IDSTA = IDDIA(IPT)
            RLAT  = DIALAT(IPT)
            RLON  = DIALON(IPT)
            DO L = 1,LM
               DIAFLD(L) = T(KPT,L)
            END DO
            IF (DIATMP)
     X       CALL DWRITE(TITLE,IDSTA,RLAT,RLON,FTIME,LM,DIAFLD,LUNTMP)
            IF (DIAALL)
     X       CALL DWRITE(TITLE,IDSTA,RLAT,RLON,FTIME,LM,DIAFLD,LUNALL)
         END DO
         TITLE = 'ETA-DOT - PDTE'
         FTIME = (NTSD-1)*DT
         DO IPT = 1,NUMDIA
            KPT   = KDIAX(IPT)
            IDSTA = IDDIA(IPT)
            RLAT  = DIALAT(IPT)
            RLON  = DIALON(IPT)
            DO L = 1,LM
               DIAFLD(L) = ETADT(KPT,L)
            END DO
            IF (DIATMP)
     X       CALL DWRITE(TITLE,IDSTA,RLAT,RLON,FTIME,LM,DIAFLD,LUNTMP)
            IF (DIAALL)
     X       CALL DWRITE(TITLE,IDSTA,RLAT,RLON,FTIME,LM,DIAFLD,LUNALL)
         END DO
         TITLE = 'OMEGA-ALPHA TERM - PDTE'
         FTIME = (NTSD-1)*DT
         DO IPT = 1,NUMDIA
            KPT   = KDIAX(IPT)
            IDSTA = IDDIA(IPT)
            RLAT  = DIALAT(IPT)
            RLON  = DIALON(IPT)
            DO L = 1,LM
               DIAFLD(L) = OMGALF(KPT,L)
            END DO
            IF (DIATMP) 
     X       CALL DWRITE(TITLE,IDSTA,RLAT,RLON,FTIME,LM,DIAFLD,LUNTMP)
            IF (DIAALL)
     X       CALL DWRITE(TITLE,IDSTA,RLAT,RLON,FTIME,LM,DIAFLD,LUNALL)
         END DO
      ENDIF
C
C     END DIAGNOSTIC BLOCK.
CDIA
C-----------------------------------------------------------------------
                             RETURN
                             END
