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 POTT
C
C          COMPUTE 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 potential temperature (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=DATA REPRESENTATION CAN NOT BE SPHERICAL HARMONICS')
	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
c 	      JJ=cputenv('POTTF_ENV=FIELDS T AND LNSP NOT CONSISTENT')
c	      RETURN
         ENDIF
      ENDIF
  300 CONTINUE

c --------------------------------------------------------------------

C           COMPUTE POTENTIAL TEMPERATURE

C     It takes into consideration Pa and hPa
C     OBS: It needs to change eqpott and seqpott as well
      CALL grib_get_int( igrib_id_t, 'levtype', level_sc )
      if (level_sc .eq. 100) then
          NLVELR = NLVELR*100.0    ! convert to Pa
      endif

      CALL POTEMP (TEMP,RLNSP,NLMODLV,NLVELR,NLATLON,vertCoef,ILENV1)

      CALL grib_set_int( igrib_id_t, 'paramId', 3 )

      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

      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 --------------------------------------------------------------------

  400 CONTINUE

      IF(NLMODLV) deallocate( RLNSP )

C     SET RESULT
      CALL mfi_return_fieldset(IGRIBP)

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

      RETURN
      END

c CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC

      SUBROUTINE POTEMP(T,PS,NLMODLV,NLVELR,NLATLON,FVERTB,NVERT)
C
C    THIS SUBROUTINE CONVERTS TEMPERATURE TO POTENTIAL TEMPERATURE
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
C     OUTPUT :
C     T           : POTENTIAL TEMPERATURE
C
      INTEGER     NLVELR,NLATLON,NVERT
      DIMENSION   T(*),PS(*),FVERTB(*)
      LOGICAL     NLMODLV
      REAL  PML
C
C
      RD=287.05
      CP=1005.46

      IF (.NOT.NLMODLV) THEN
         XPK = (100000./FLOAT(NLVELR))**(RD/CP)
         DO 10 I=1,NLATLON
         T(I) = T(I) * XPK
 10      CONTINUE
      ELSE
         DO 20 I=1,NLATLON
         T(I) = T(I)*(100000./PML(PS(I),NLVELR,FVERTB,NVERT))**(RD/CP)
 20      CONTINUE
      ENDIF

      RETURN
      END
