SUBROUTINE CALTHTE(P1D,T1D,Q1D,THTE)
C$$$  SUBPROGRAM DOCUMENTATION BLOCK
C                .      .    .     
C SUBPROGRAM:    CALTHTE      COMPUTES THETA-E
C   PRGRMMR: TREADON         ORG: W/NP2      DATE: 93-06-18
C     
C ABSTRACT:  
C     THIS ROUTINE COMPUTES THE EQUIVALENT POTENTIAL TEMPERATURE
C     GIVEN PRESSURE, TEMPERATURE, AND SPECIFIC HUMIDITY.  THE
C     EQUATIONS OF BOLTON (MWR,1980) ARE USED.
C   .     
C     
C PROGRAM HISTORY LOG:
C   93-06-18  RUSS TREADON
C   98-06-16  T BLACK - CONVERSION FROM 1-D TO 2-D
C   00-01-04  JIM TUCCILLO - MPI VERSION
C     
C USAGE:    CALL CALTHTE(P1D,T1D,Q1D,THTE)
C   INPUT ARGUMENT LIST:
C     P1D      - PRESSURE (PA)
C     T1D      - TEMPERATURE (K)
C     Q1D      - SPECIFIC HUMIDITY (KG/KG)
C
C   OUTPUT ARGUMENT LIST: 
C     THTE     - THETA-E (K)
C     
C   OUTPUT FILES:
C     NONE
C     
C   SUBPROGRAMS CALLED:
C     UTILITIES:
C       VAPOR    - FUNCTION TO CALCULATE VAPOR PRESSURE.
C     LIBRARY:
C       NONE
C     
C   ATTRIBUTES:
C     LANGUAGE: FORTRAN
C     MACHINE : CRAY C-90
C$$$  
C
C     
C     INCLUDE/SET PARAMETERS.
      INCLUDE "parmeta"
      INCLUDE "params"
      INCLUDE "CTLBLK.comm"
C
      PARAMETER (KG2G=1.E3)
      PARAMETER (D35=3.5,D4805=4.805,H2840=2840.,H55=55.)
      PARAMETER (D2845=0.2845,D00028=0.00028,D3376=3.376)
      PARAMETER (D00254=0.00254,D00081=0.00081,D81=0.81)
      PARAMETER (D28=0.28,H2675=2675.)
C
C     DECLARE VARIABLES.
C     
      REAL P1D(IM,JM),T1D(IM,JM),Q1D(IM,JM),THTE(IM,JM)
C     
C***************************************************************
C     START CALTHTE.
C     
C     ZERO THETA-E ARRAY
      DO J=JSTA,JEND
      DO I=1,IM
        THTE(I,J)=D00
      ENDDO
      ENDDO
C     
C     COMPUTE THETA-E.
C
      DO J=JSTA_M,JEND_M
      DO I=2,IM-1
        P        = P1D(I,J)
        T        = T1D(I,J)
        Q        = Q1D(I,J)
        EVP      = P*Q/(EPS+ONEPS*Q)
        RMX      = EPS*EVP/(P-EVP)
        CKAPA    = D2845*(1.-D28*RMX)
        RKAPA    = 1./CKAPA
        ARG      = EVP*D01
        ARG      = AMAX1(H1M12,ARG)
        DENOM    = D35*ALOG(T) - ALOG(EVP*D01) - D4805
        TLCL     = H2840/DENOM + H55
        PLCL     = P*(TLCL/T)**RKAPA
        FAC      = (P1000/P)**CKAPA
        ETERM    = (D3376/TLCL-D00254)*(RMX*KG2G*(H1+D81*RMX))
        THETAE   = T*FAC*EXP(ETERM)
        THTE(I,J)= THETAE
      ENDDO
      ENDDO
C     
C     END OF ROUTINE.
C
      RETURN
      END