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 SPECCONT (MTRUNCS,ILEV,ILVL,A,LNOCYC,NTMIN,
     +                     NTLIM,L24INT,IERROR)
C
C     F. II             ECMWF           AUG-96
C     SEND SPECTRA (CONTOUR MODE) TO MAIN APPLICATION
C
C     INPUT :
C       MTRUNCS         : TRUNCATE OUTPUT VALUE
C       ILEV            : NUMBER OF CURVES TO BE PLOTTED
C       ILVL            : STEPS VALUES
C       A               : ARRAY OF DATA
C       LNOCYC          : T - SUBTRACTS OUT THE DIURNAL CYCLE
C       NTMIN           : Y-AXIS MIN VALUE
C       NTLIM           : Y-AXIS MAX VALUE
C       L24INT          : T - PLOTS ONLY EVERY 24 HOURS
C
C     OUTPUT :
C       IERROR          : 0 - NO ERROR,  1 - ERROR

      IMPLICIT NONE

#include <grbsh.h>

      integer cputenv

      REAL            A(JLEV*JMTRUNC)
      INTEGER         MTRUNCS,ILEV,ILVL(JLEV),NTMIN,NTLIM,IERROR
      LOGICAL         LNOCYC,L24INT

      INTEGER         ITRUNC          !MTRUNCS+1
      INTEGER         ILVLN(JLEV)     !ILVL SUBSET
      INTEGER         IILVL(JLEV)     !ILVLN SUBSET
      INTEGER         ILEVN           !NEW ILEV VALUE
      INTEGER         IILEV           !NEW ILEV VALUE
      INTEGER         INC             !AXIS INCREMENT
      INTEGER         II,JJ,III,JJJ   !AUXILIARIES VARIABLES
      REAL            B(JLEV*JMTRUNC) !ARRAY TO BE PLOTTED
      REAL            BMAX,BMAG       !AUXILIARIES VARIABLES
      REAL            BSCALE          !SCALE
C
C               1.0 INITIALIZE DATA
C
      IERROR = 0
      ITRUNC = MTRUNCS + 1
      IF (ILEV.GT.JLEV .OR. ITRUNC.GT.JMTRUNC) THEN
         WRITE(*,'(4X,''ARRAYS TOO SMALL; ILEV,MTRUNCS = '',
     +             I4,1X,I4)')ILEV,MTRUNCS
         JJ=cputenv('SPECTRA_ENV=MEMORY ERROR - SUBROUTINE SPECCONT')
         IERROR = 1
         RETURN
      ENDIF
      IF(LNOCYC) THEN         !SUBTRACT OUT THE DAILY CYCLE
         ILEVN = 0
         II = 0
         DO 10 JJ=1,ILEV
            IF(MOD(ILVL(JJ),12).NE.0) GOTO 10
            IF(MOD(ILVL(JJ),24).EQ.0) THEN
               III = 1
            ELSE
               III = 2
            ENDIF
            ILEVN = ILEVN + 1
            ILVLN(ILEVN) = ILVL(JJ)
            DO 12 JJJ=1,ITRUNC
               II  =  II + 1
               A(II) = A(ITRUNC*(JJ  -1)+JJJ) -
     @                 A(ITRUNC*(ILEV-III)+JJJ)
 12         CONTINUE
 10      CONTINUE

C        DONT PLOT THE LAST 2 COLUMNS (THE LAST TWO COLUMNS ARE ZEROS)
         ILEVN = ILEVN - 2
      ELSE
         ILEVN = ILEV
         DO 14 JJ=1,ILEV
            ILVLN(JJ) = ILVL(JJ)
 14      CONTINUE
      ENDIF
C
C               2.0 RE-ORDER THE INPUT DATA SO THAT THE FASTEST
C                   INDEX IS THE HORIZONTAL AXIS
C
      IF(L24INT) THEN
         IILEV = 0
         DO 20 JJ=1,ILEVN
            IF(MOD(ILVLN(JJ),24).NE.0) GOTO 20
            IILEV = IILEV + 1
            IILVL(IILEV) = ILVLN(JJ)
 20      CONTINUE
      ELSE
         IILEV = ILEVN
         DO 22 JJ=1,ILEVN
            IILVL(JJ) = ILVLN(JJ)
 22      CONTINUE
      ENDIF

      BMAX =-1.e21
      II = 0
      DO 24 JJ=1,ILEVN
         IF(L24INT .AND. MOD(ILVLN(JJ),24).NE.0) GOTO 24
         II = II + 1
         DO 26 JJJ=1,ITRUNC
            B(IILEV*(JJJ-1)+II) = A(ITRUNC*(JJ-1)+JJJ)
            BMAX=MAX(BMAX,B(IILEV*(JJJ-1)+II))
 26      CONTINUE
 24   CONTINUE

      BMAG = ALOG10(ABS(BMAX))
      BSCALE=0.
      IF (BMAG.LT.0) THEN
         BMAG = 1.- AINT(BMAG)
         BSCALE = 10**BMAG
         DO 28 JJJ=1,ITRUNC
            DO 29  II=1,ILEVN
               B(IILEV*(JJJ-1)+II) = B(IILEV*(JJJ-1)+II)*BSCALE
 29         CONTINUE
 28      CONTINUE
      ENDIF

      CALL MSETN(BMAG)   ! SEND FIELD SCALE FACTOR
C
C        3.0 SEND DATA AXIS TO APPLICATION
C
      ITRUNC = MIN0(ITRUNC,NTLIM+1)   ! SEND Y-AXIS VALUES
      INC = ITRUNC - NTMIN
      IF(INC.LE.10) THEN
         INC =  1
      ELSE IF(INC.LE.50) THEN
         INC =  5
      ELSE IF(INC.LE.110) THEN
         INC = 10
      ELSE
         INC = 20
      ENDIF

      CALL MSETN(REAL(NTMIN))
      CALL MSETN(REAL(ITRUNC-1))
      CALL MSETN(REAL(INC))

      CALL MSETN(REAL(IILEV))   ! SEND X-AXIS VALUES
      DO JJ=1,IILEV
         CALL MSETN(REAL(IILVL(JJ)))
      ENDDO
C
C       4.0 SEND DATA TO APPLICATION
C
      CALL MSETN(REAL(ITRUNC-NTMIN))
      CALL MSETN(REAL(IILEV))
      III=NTMIN*IILEV
      DO II=1,ITRUNC-NTMIN   ! SEND SPECTRA VALUES
         DO JJ=1,IILEV
            III=III+1
            CALL MSETN(B(III))
         ENDDO
      ENDDO

      RETURN
      END
