C **************************** LICENSE START ***********************************
C
C Copyright 2014 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 ************************************

C COMPUTE SPECTRA
C
      SUBROUTINE SPECTRA
      USE grib_api

C IMPLICIT NONE

#include "grbsh.hf"

      integer cputenv


#ifdef __alpha
      INTEGER*8 IGRIB1,ICNT,ISIZE
#endif

      INTEGER ISPECGRAPH,ISPECCONTOUR
      PARAMETER (ISPECGRAPH=1,ISPECCONTOUR=0)

      INTEGER JTP,IRET,KWORD,IERROR,JJ  ! AUXILIARY VARIABLES
      INTEGER IPTS                      ! NUMBER OF STEPS
      INTEGER GRIB_ID                   ! GRIB_API ID FOR A SINGLE GRIB MESSAGE
      INTEGER ISIZE                     ! NUMBER OF VALUES IN THE FIELD
      INTEGER ISTATUS                   ! RETURN STATUS FROM GRIB_API
      INTEGER IVALUE                    ! INTEGER VALUE RETURNED FROM GRIB_API
      INTEGER ISTEPS(JNS)               ! LIST OF STEP VALUES
      INTEGER MT                        ! TRUNCATE INPUT (ORIGINAL) VALUE
      REAL    NTMIN,NTLIM               ! AXIS MIN/MAX
      REAL    MTRUNC                    ! TRUNCATION VALUE
      REAL    ITYPE                     ! PLOT TYPE
      REAL    IDAILY                    ! 1 - SUBTRACTS OUT THE DIURNAL CYCLE
      REAL    I24INT                    ! 1 - PLOTS ONLY EVERY 24 HOURS
      REAL, ALLOCATABLE :: FIELD(:)     ! GRIB FIELD
      REAL, ALLOCATABLE :: SPEC(:)      ! SPECTRA
      LOGICAL LDAILY                    ! T - SUBTRACTS OUT THE DIURNAL CYCLE
      LOGICAL L24INT                    ! T - PLOTS ONLY EVERY 24 HOURS

      CHARACTER errmsg*80
      CHARACTER GRID_TYPE*80
C
C    -----------------------------------------------------------------------
C
C          GET ARGUMENTS FROM APPLICATION
C

      CALL MFI_GET_FIELDSET(IGRIB1,ICNT)  !GET FIELDSET
      CALL MFI_GET_NUMBER(MTRUNC)         !GET TRUNCATION VALUE
      CALL MFI_GET_NUMBER(ITYPE)          !GET PLOT TYPE
      CALL MFI_GET_NUMBER(IDAILY)         !GET DIURNAL CYCLE VALUE
      CALL MFI_GET_NUMBER(I24INT)         !GET PLOT STEP
      CALL MFI_GET_NUMBER(NTMIN)          !GET LOWER VALUE OF THE AXIS
      CALL MFI_GET_NUMBER(NTLIM)          !GET UPPER VALUE OF THE AXIS


      IF(IDAILY.EQ.1.) THEN
         LDAILY=.TRUE.
      ELSE
         LDAILY=.FALSE.
      ENDIF

      IF(I24INT.EQ.1.) THEN
         L24INT=.TRUE.
      ELSE
         L24INT=.FALSE.
      ENDIF
C
C      COMPUTE SPECTRA, LOOP ON FIELDS
C
      ISIZE = JMUAF
      IPTS = 0
      DO 100 JTP=1,ICNT

C        GET NEXT FIELD FROM FIELDSET AND EXPAND IT
         CALL MFI_LOAD_ONE_GRIB(IGRIB1,GRIB_ID)
         IRET = 1

         CALL GRIB_GET_SIZE(GRIB_ID, 'values', ISIZE)
         ALLOCATE(SPEC(ISIZE), FIELD(ISIZE))
         CALL GRIB_GET_REAL8_ARRAY( GRIB_ID, 'values', FIELD, ISTATUS )

         IF(ISTATUS.NE.0) THEN
            WRITE(errmsg,'(A,I5)') 'SPECTRA_ENV=GRIB_API ERROR', ISTATUS
            JJ=cputenv(errmsg)
            RETURN
         ENDIF

         CALL GRIB_GET_STRING(GRIB_ID, 'gridType', GRID_TYPE)
         IF(GRID_TYPE.NE.'sh') THEN
            JJ=cputenv
     +         ('SPECTRA_ENV=DATA IS NOT IN SPHERICAL HARMONICS FORMAT')
            RETURN
         ENDIF

C        GET STEP VALUE
         IPTS = IPTS + 1
         CALL GRIB_GET_INT(GRIB_ID, 'mars.step', IVALUE)
         ISTEPS(IPTS) = IVALUE
C        IF(KSEC1(15).EQ.1) THEN
C           ISTEPS(IPTS) = KSEC1(16)
C        ELSE
C           ISTEPS(IPTS) = KSEC1(16) * 24
C        ENDIF

C        COMPUTE SPECTRA
C        MT = KSEC2(2)
         CALL GRIB_GET_INT(GRIB_ID, 'J', MT)
         CALL SPECPRO (FIELD,ISIZE,SPEC,ISIZE,INT(MTRUNC),MT,
     +                 IPTS,IERROR)
         IF(IERROR.NE.0) RETURN

 100  CONTINUE

C     SEND TITLE INFORMATION TO APPLICATION
C     KWORD = KSEC1(10)*10000 + KSEC1(11)*100 + KSEC1(12)	! DATE (YYMMDD)
C     CALL GRIB_GET_INT(GRIB_ID, 'yearOfCentury', IVALUE)
C     KWORD = IVALUE*10000
C     CALL GRIB_GET_INT(GRIB_ID, 'month', IVALUE)
C     KWORD = KWORD + (IVALUE*100)
C     CALL GRIB_GET_INT(GRIB_ID, 'day', IVALUE)
C     KWORD = KWORD + IVALUE
      CALL GRIB_GET_INT(GRIB_ID, 'date', KWORD)
      KWORD = MOD(KWORD, 1000000)

      CALL GRIB_GET_INT(GRIB_ID, 'levelType', IVALUE)
      CALL MFI_RETURN_NUMBER(REAL(IVALUE))
      CALL GRIB_GET_INT(GRIB_ID, 'level', IVALUE)
      CALL MFI_RETURN_NUMBER(REAL(IVALUE))
      CALL GRIB_GET_INT(GRIB_ID, 'hour', IVALUE)
      CALL MFI_RETURN_NUMBER(REAL(IVALUE))
      CALL MFI_RETURN_NUMBER(REAL(KWORD))
      CALL GRIB_GET_INT(GRIB_ID, 'paramId', IVALUE)
      CALL MFI_RETURN_NUMBER(REAL(IVALUE))

C     CALL MSETN(REAL(KSEC1(8)))
C     CALL MSETN(REAL(KSEC1(13)))
C     CALL MSETN(REAL(KWORD))
C     CALL MSETN(REAL(KSEC1(6)))

C     SEND SPECTRA VALUES TO APPLICATION
      IF (ITYPE.EQ.ISPECGRAPH) THEN
         CALL SPECGRAPH(INT(MTRUNC),IPTS,ISTEPS,SPEC,LDAILY,
     +                  INT(NTMIN),INT(NTLIM),IERROR)
      ELSE
         CALL SPECCONT(INT(MTRUNC),IPTS,ISTEPS,SPEC,LDAILY,
     +                 INT(NTMIN),INT(NTLIM),L24INT,IERROR)
      ENDIF

      IF (IERROR.NE.0) RETURN		!ERROR

      RETURN
      END
