C Copyright 1981-2012 ECMWF.
C
C This software is licensed under the terms of the Apache Licence 
C Version 2.0 which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
C
C In applying this licence, ECMWF does not waive the privileges and immunities 
C granted to it by virtue of its status as an intergovernmental organisation 
C nor does it submit to any jurisdiction.
C

       PROGRAM DECODE_CREX
C
C**** *DECODE_CREX*
C
C
C     PURPOSE.
C     --------
C         DECODE CREX CODED DATA
C
C
C**   INTERFACE.
C     ----------
C
C          NONE.
C
C     METHOD.
C     -------
C
C          NONE.
C
C
C     EXTERNALS.
C     ----------
C
C          CREXEX    
C          CREXSEL 
C          CREXPRS0 
C          CREXPRT
C          PBOPEN
C          PBCLOSE 
C          PBCREX
C          GETARG    
C         
C         
C         
C
C     REFERENCE.
C     ----------
C
C          NONE.
C
C     AUTHOR.
C     -------
C
C          M. DRAGOSAVAC    *ECMWF*       15/09/2003.
C
C
C     MODIFICATIONS.
C     --------------
C
C          NONE.
C
C
      IMPLICIT LOGICAL(L,O,G), CHARACTER*8(C,H,Y)
C
      PARAMETER(JSUP =   9,JSEC0=   3,JSEC1= 40,JSEC2=4096,JSEC3=    4,
     1          JSEC4=   2,JELEM=40000,JSUBS=400,JCVAL=150 ,JBUFL=80000,
#ifdef JBPW_64
     2          JBPW =  64,JTAB =3000,JCTAB=120,JCTST=1800,JCTEXT=1200,
#else
     2          JBPW =  32,JTAB =3000,JCTAB=120,JCTST=1800,JCTEXT=1200,
#endif
     3          JWORK=360000,JKEY=46,JBYTE=80000)
C
      PARAMETER (KELEM=8000)
      PARAMETER (KVALS=360000)
C 
      DIMENSION KBUFF(JBUFL)
      DIMENSION KSUP(JSUP)  ,KSEC0(JSEC0),KSEC1(JSEC1)
      DIMENSION KSEC3(JSEC3)
C
      REAL*8 VALUES(KVALS)
      REAL*8 RVIND
      REAL*8 EPS
C
      DIMENSION KTDLST(JELEM),KTDEXP(JELEM)
      DIMENSION KDATA(200)
C
      CHARACTER*256 CF,CARG(4)
      CHARACTER*64 CNAMES(KELEM)
      CHARACTER*24 CUNITS(KELEM)
      CHARACTER*80 CVALS(KVALS)
      CHARACTER*80 YENC
      CHARACTER*320000 YBUFF
C
      EQUIVALENCE(YBUFF,KBUFF(1))
C                                                                       
C     ------------------------------------------------------------------
C*          1. INITIALIZE CONSTANTS AND VARIABLES.
C              -----------------------------------
 100  CONTINUE
C
      NBYTPW=JBPW/8
      RVIND=1.7D38
      NVIND=2147483647
      IOBS=0
      EPS=1.D-8
      N=0
      OO=.FALSE.
      CF=' '
C
C     INPUT FILE NAME
C
C     GET INPUT AND OUTPUT FILE NAME.
C
      NARG=IARGC()
C
      IF(NARG.NE.2) THEN
         PRINT*,'USAGE -- decode_crex -i infile ' 
         STOP
      END IF
C
      DO 101 J=1,NARG
      CALL GETARG(J,CARG(J))
 101  CONTINUE
C
      IF(CARG(1).NE.'-I'.AND.CARG(1).NE.'-i'.OR.
     1   CARG(2).EQ.' ') THEN
         PRINT*,'USAGE -- decode_crex -i inpfile '
         STOP
      END IF

C
      CF=CARG(2)
      II=INDEX(CF,' ')
      II=II-1
C
C*          1.2 OPEN FILE CONTAINING CREX DATA.
C               -------------------------------
 120  CONTINUE
C
      IRET=0 
      CALL PBOPEN(IUNIT,CF(1:II),'R',IRET)
      IF(IRET.EQ.-1) STOP 'OPEN FAILED ON INPUT FILE'
      IF(IRET.EQ.-2) STOP 'INVALID FILE NAME'
      IF(IRET.EQ.-3) STOP 'INVALID OPEN MODE SPECIFIED'
C
C     ----------------------------------------------------------------- 
C*          2. SET REQUEST FOR EXPANSION.
C              --------------------------
 200  CONTINUE
C
      OPRT=.FALSE.
      OENC=.FALSE.
      WRITE(*,'(A,$)') ' DO YOU WANT TO PRINT( Y/N ) : '
      READ (*,'(A)') YENC
      IF(YENC(1:1).EQ.'Y'.OR.YENC(1:1).EQ.'y') THEN
         OPRT=.TRUE.
      END IF
C
 201  CONTINUE
C
      WRITE(*,'(A,$)') ' DO YOU WANT TO PRINT SECTION 0-3( Y/N ) : '
      READ (*,'(A,$)') YENC
      OSEC3=.FALSE.
      IF(YENC(1:1).EQ.'Y'.OR.YENC(1:1).EQ.'y') OSEC3=.TRUE.
C
 210  CONTINUE
C
C
C     -----------------------------------------------------------------
C*          3.  READ CREX MESSAGE.
C               ------------------
 300  CONTINUE
C
      IERR=0
      IRET=0
C
      YBUFF(1:15000)=' '
      CALL PBCREX(IUNIT,KBUFF,JBUFL,KBUFL,IRET)
      IF(IRET.LT.0) THEN
         IF(IRET.EQ.-1) THEN
            PRINT*,'NUMBER OF CREX MESSAGES PROCESSED ',N
            PRINT*,'NUMBER OF CREX OBSERVATIONS       ',IOBS
            STOP 'END OF FILE '
         END IF
         IF(IRET.EQ.-2) STOP 'ERROR IN HANDLING THE FILE'
         IF(IRET.EQ.-3) STOP 'ERROR DURING READ CREX FILE.'
      END IF
C
      N=N+1
      PRINT*,'----------------------------------',N
      print*,YBUFF(1:KBUFL)
C
C     -----------------------------------------------------------------
C*          4. EXPAND CREX MESSAGE.
C              --------------------
 400  CONTINUE
C
     
      IERR=0
      CALL CREXEX(KBUFL,YBUFF,KSUP,KSEC0 ,KSEC1,KSEC3 ,
     1            KELEM,CNAMES,CUNITS,KVALS,VALUES,CVALS,IERR)
C
      IF(IERR.NE.0) THEN
         PRINT*,'CREX ERROR ', IERR
         GO TO 300
      END IF
C
C
      IOBS=IOBS+KSEC3(3)
C
      ISUBSET=1
      CALL CREXSEL2(ISUBSET,KELEM,KTDLEN,KTDLST,KTDEXL,KTDEXP,
     1              CNAMES,CUNITS,KERR)
      IF(KERR.NE.0) THEN
         PRINT*,'CREXSEL: ERROR.'
         CALL EXIT(2)
      END IF
C
C*          4.1 PRINT CONTENT OF EXPANDED DATA.
C               -------------------------------
 410  CONTINUE
C
      IF(.NOT.OPRT) GO TO 300
      IF(.NOT.OSEC3) GO TO 450
C
C*          4.2 PRINT SECTION ZERO OF CREX MESSAGE.
C               -----------------------------------
 420  CONTINUE
C
      CALL CREXPRS0(KSEC0)
C
C*          4.3 PRINT SECTION ONE OF CREX MESSAGE.
C               -----------------------------------
 430  CONTINUE
C
      ISUBSET=1
      CALL CREXSEL2(ISUBSET,KELEM,KTDLEN,KTDLST,KTDEXL,KTDEXP,
     1              CNAMES,CUNITS,KERR)
      IF(KERR.NE.0) CALL EXIT(2)
C
      CALL CREXPRS1(KSEC1,KSEC3,KTDLEN,KTDLST,KTDEXL,
     1              KTDEXP,KELEM,CNAMES)
C
C
C
C*          4.5 PRINT SECTION 2 OF CREX MESSAGE.
C               -----------------------------------
 450  CONTINUE
C
C
C*         4.6 PRINT SECTION 2 (DATA).
C              -----------------------
 460  CONTINUE
C
C          IN THE CASE OF MANY SUBSETS DEFINE RANGE OF SUBSETS
C
      IF(.NOT.OO) THEN
      WRITE(*,'(A,$)') ' STARTING SUBSET TO BE PRINTED : '
      READ(*,'(BN,I4)')   IST
      WRITE(*,'(A,$)') ' ENDING SUBSET TO BE PRINTED : '
      READ(*,'(BN,I4)')   IEND
      OO=.FALSE.
      END IF
C
C              PRINT DATA
C
      ICODE=0
      CALL CREXPRT(ICODE,IST,IEND,KELEM,CNAMES,CUNITS,CVALS,
     1             KVALS,VALUES,KSUP,KSEC1,IERR)
C
C
      GO TO 300
C
    
C     -----------------------------------------------------------------
 900  CONTINUE
C
      END
