C **************************** LICENSE START ***********************************
C
C Copyright 2012 ECMWF and INPE. This software is distributed under the terms
C of the Apache License version 2.0. In applying this license, ECMWF does not
C waive the privileges and immunities granted to it by virtue of its status as
C an Intergovernmental Organization or submit itself to any jurisdiction.
C
C ***************************** LICENSE END ************************************

      SUBROUTINE SEQPOTT
C
C          COMPUTE SATURATED EQUIVALENT POTENTIAL TEMPERATURE
C
C        Input:
C          Fieldset of temperature ( and LNSP if model levels)
C              (lat/long grid)
C          Indicator for pressure levels or model levels
C
C        Output:
C          Fieldset of saturated equivalent potential temperature
C              (lat/long grid)
C
C        Author:
C          B. Norris,  March 1995
C
      use grib_api
C
      integer cputenv

#ifdef __alpha
      INTEGER*8 IGRIBT,ICNTT,IGRIBL,ICNTL,IGRIBP,JMGRIBB,IWORD
#endif

      real*8, allocatable :: TEMP(:)
      real*8, allocatable :: RLNSP(:)
      real*8, allocatable :: vertCoef(:)

      LOGICAL NLMODLV,LOK,LEVEL
      CHARACTER*4 YMODLV
      integer  igrib_id_t, igrib_id_p
      LOK=.FALSE.
c
c -------------------------------------------------------------------
c
C     GET FIELDSET OF TEMPERATURE

      CALL mfi_get_fieldset(IGRIBT,ICNTT)

C     TELLS WHETHER PRESSURE OR MODEL LEVELS

      CALL MGETS (YMODLV)
      IF(YMODLV(1:2).EQ.'ml'.OR.YMODLV(1:2).EQ.'ML') THEN
           NLMODLV=.TRUE.
      ELSEIF(YMODLV(1:2).EQ.'pl'.OR.YMODLV(1:2).EQ.'PL') THEN
           NLMODLV=.FALSE.
      !-- elseif?
      ENDIF

C     GET FIELDSET OF LNSP

      IF(NLMODLV) CALL mfi_get_fieldset(IGRIBL,ICNTL)

C     CREATE A NEW FIELDSET FOR POTENTIAL TEMPERATURE

      CALL mfi_new_fieldset(IGRIBP)
c
c -------------------------------------------------------------------
c
C     LOOP ON FIELDS

      ITCNT=0
      ILCNT=0

C       GET NEXT TEMPERATURE FROM FIELDSET

  100 CONTINUE
      ITCNT=ITCNT+1
      IF(ITCNT.GT.ICNTT) GO TO 400

      CALL mfi_load_one_grib(IGRIBT,igrib_id_t)

      CALL grib_get_int( igrib_id_t, 'gridType', iGridType )
      IF(iGridType.EQ.50) THEN
 	JJ=cputenv
     +	('POTTF_ENV=T DATA REPRESENTATION CAN NOT BE SPECTRAL')
	RETURN
      ENDIF

      CALL grib_get_int( igrib_id_t, 'level', NLVELR )

      CALL grib_get_size( igrib_id_t, 'values', NLATLON )
      allocate( TEMP( NLATLON ) )
      CALL grib_get_real8_array( igrib_id_t, 'values', TEMP )

C       GET NEXT LNSP FROM FIELDSET

  200 CONTINUE
      IF(NLMODLV.AND..NOT.LOK) THEN
         ILCNT=ILCNT+1
         IF(ILCNT.GT.ICNTL) GO TO 400

         CALL mfi_load_one_grib(IGRIBL,igrib_id_p)

         CALL grib_get_int( igrib_id_p,
     x               'numberOfVerticalCoordinateValues', ILENV1 )
         allocate( vertCoef( ILENV1 ) )
         CALL grib_get_real8_array( igrib_id_p, 'pv', vertCoef )

         CALL grib_get_size( igrib_id_p, 'values', NLATLON )
         allocate( RLNSP( NLATLON ) )
         CALL grib_get_real8_array( igrib_id_p, 'values', RLNSP )
      ENDIF

C           CHECK T AND LNSP CONSISTENT IF MODEL LEVELS

      IF(NLMODLV) THEN
         LEVEL=.FALSE.

         CALL TLVALID (igrib_id_t,igrib_id_p,
     X                 LEVEL,LOK)
         IF(LOK) THEN
              GO TO 300
         ELSE
              GO TO 200
         ENDIF
      ENDIF
  300 CONTINUE
c
c -------------------------------------------------------------------
c
C           COMPUTE SATURATED EQUIVALENT POTENTIAL TEMPERATURE

      CALL grib_get_int( igrib_id_t, 'dataDate', IDATE )

C
      CALL SATEQT (TEMP,RLNSP,NLMODLV,NLVELR,NLATLON,vertCoef,
     X             ILENV1,IDATE)

      CALL grib_set_int( igrib_id_t, 'paramId', 5 )

      TMIN=1.0E10
      TMAX=-1.0E10
      DO 302 KD=1,NLATLON
      IF(TEMP(KD).LT.TMIN) TMIN=TEMP(KD)
      IF(TEMP(KD).GT.TMAX) TMAX=TEMP(KD)
  302 CONTINUE
      WRITE (*,*) ' TMIN ',TMIN,' TMAX ',TMAX

!     -- encode the computed field TEMP --

      CALL grib_set_real8_array( igrib_id_t, 'values', TEMP )

C          ADD TO FIELDSET

      CALL mfi_save_grib(IGRIBP,igrib_id_t)

      deallocate( TEMP )

      GO TO 100
c
c -------------------------------------------------------------------
c
  400 CONTINUE


      IF(NLMODLV) deallocate( RLNSP )


C     SET RESULT
      CALL mfi_return_fieldset(IGRIBP)

C      WRITE (*,'(A)') '  END OF SEQPOTT '

      RETURN
      END

c CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC

      SUBROUTINE SATEQT(T,PS,NLMODLV,NLVELR,NLATLON,FVERTB,
     +                  NVERT,IDATE)
C
C     THIS SUBROUTINE CALCULATES THE SATURATION EQUIVALENT POTENTIAL
C     TEMPERATURE FROM THE TEMPERATURE ON PRESSURE LEVELS.
C     THE VALUE FOR CI IS FROM MARTIN MILLER & ALAN BETTS
C
C     INPUT :
C     T           : TEMPERATURE
C     PS          : LOG SURFACE PRESSURE
C     NLMODLV     : T - MODEL LEVELS, F - PRESSURE LEVELS
C     NLVELR      : LEVEL
C     NLATLON     : GRID POINTS (LAT X LON)
C     FVERTB      : VERTICAL COORDINATE ARRAY
C     NVERT       : LENGTH OF THE DATA IN THE ARRAY FVERTB
C     IDATE       : DATE (YYMMDD)
C
C     OUTPUT :
C     T           : SATURATION EQUIVALENT POTENTIAL TEMPERATURE
C
C     MODIFICATION:
C     B. NORRIS  13/07/94  CONVERT MODEL LEVEL TO PRESSURE IN
C                            COMPUTATION
C
      INTEGER     NLVELR,NLATLON,NVERT
      DIMENSION   T(*),PS(*),FVERTB(*)
      LOGICAL     NLMODLV

      REAL  PML,SSHM
      LOGICAL     ILOLDM
C
C
      CI=2710.
      RD=287.05
      CP=1005.46

      ILOLDM = .FALSE.
      IF(IDATE.LT.19830421) ILOLDM = .TRUE.

      IF (.NOT.NLMODLV) THEN
         XPK = (1000./FLOAT(NLVELR))**(RD/CP)
         DO 10 J=1,NLATLON
C           CALCULATE THE SATURATION SPECIFIC HUMIDITY
            SATHUM = SSHM(T(J),FLOAT(NLVELR),ILOLDM)
C           CALCULATE THE SATURATION EQUIVALENT POTENTIAL TEMPERATURE
            T(J) = T(J)*XPK*EXP(SATHUM*CI/T(J))
 10      CONTINUE
      ELSE
         DO 20 J=1,NLATLON
            PMB=PML(PS(J),NLVELR,FVERTB,NVERT)*.01
            XPK = (1000./PMB)**(RD/CP)
C           CALCULATE THE SATURATION SPECIFIC HUMIDITY
            SATHUM = SSHM(T(J),PMB,ILOLDM)
C           CALCULATE THE SATURATION EQUIVALENT POTENTIAL TEMPERATURE
            T(J) = T(J)*XPK*EXP(SATHUM*CI/T(J))
 20      CONTINUE
      ENDIF
C
      RETURN
      END
