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 CREX
C
C**** *CREX*
C
C
C     PURPOSE.
C     --------
C         Example of creating CREX message
C
C
C**   INTERFACE.
C     ----------
C
C          NONE.
C
C     METHOD.
C     -------
C
C          NONE.
C
C
C     EXTERNALS.
C     ----------
C
C
C     REFERENCE.
C     ----------
C
C          NONE.
C
C     AUTHOR.
C     -------
C
C          MILAN DRAGOSAVAC    *ECMWF*       07/01/2004.
C
C
C     MODIFICATIONS.
C     --------------
C
C          NONE.
C
C
      IMPLICIT LOGICAL(O,G), CHARACTER*8(C,H,Y)
C
      PARAMETER(JSUP =   9,JSEC0=   3,JSEC1= 40,JSEC3=    4,
     1          JBUFL= 8192)
C
      PARAMETER (KDLEN=200,KELEM=2000)
      PARAMETER (KVALS=80000)
C 
      DIMENSION KBUFR(JBUFL)
      DIMENSION KSEC0(JSEC0),KSEC1(JSEC1), KSEC3(JSEC3)
C
      REAL*8  VALUES(KVALS)
      REAL*8 RVIND
C
      DIMENSION KDATA(KDLEN)
C
      CHARACTER*6  CREXKTDLST(KELEM),CREXKTDEXP(KELEM)
      CHARACTER*64 CNAMES(kelem)
      CHARACTER*24 CUNITS(kelem)
      CHARACTER*80 CVALS(KVALS)
      CHARACTER*80 YENC
      CHARACTER*256 COUT, CARG(4)
C      
      CHARACTER*15000 YOUT
      EQUIVALENCE(KBUFR(1),YOUT)
C
C                                                                       
C     ------------------------------------------------------------------
C*          1. INITIALIZE CONSTANTS AND VARIABLES.
C              -----------------------------------
 100  CONTINUE
C
      RVIND=1.7D38
      NVIND=2147483647
C
C     GET INPUT AND OUTPUT FILE NAME.
C
      NARG=IARGC()
C
      IF(NARG.LT.2) THEN
         print*,'Usage -- create_crex -o outfile'
         STOP
      END IF
C
      COUT=' '
      CFIN=' '
C
      DO 101 J=1,NARG
      CALL GETARG(J,CARG(J))
 101  CONTINUE
C
      DO 102 J=1,NARG,2
        IF(CARG(J).EQ.'-o') THEN
           COUT=CARG(J+1)
        ELSE
            print*,'Usage -- create_crex -o outfile'
            STOP
        END IF
 102  CONTINUE
C
      JJ=INDEX(COUT,' ')
      JJ=JJ-1
C
      CALL PBOPEN(IUNIT1,COUT(1:JJ),'w',IRET)
      IF(IRET.EQ.-1) STOP 'open failed on bufr.dat'
      IF(IRET.EQ.-2) STOP 'Invalid file name'
      IF(IRET.EQ.-3) STOP 'Invalid open mode specified'
C
C     INITIALIZE DELAYED REPLICATION FACTORS OR REFERENCE VALUES ETD.
C
      KDATA( 1)=0
      KDATA( 2)=0
      KDATA( 3)=0
      KDATA( 4)=0
C
      DO I=5,KDLEN
       KDATA(I)=0
      END DO
C
      KDLENG=200
C
C     SET DATA DECSRIPTORS
C
      CREXKTDLST(  1)= "D07005"
c
      KTDLEN=1

      KSEC0(1)=0
      KSEC0(2)=0
      KSEC0(3)=2      ! Crex edition number
C
C     SECTION 1 CONTENT
C
      KSEC1(1)=0
      KSEC1(2)=2     ! CREX Edition number (currently)
      KSEC1(3)=98    ! Originating centre
      KSEC1(4)=0     ! Update sequence number
      KSEC1(5)=1     ! Number of subsets
      KSEC1(6)=0     ! CREX data category
      KSEC1(7)=2     ! International data sub-category
      KSEC1(8)=0     ! version number of local table used
      KSEC1(9)=2003  ! Year
      KSEC1(10)=12   ! Month
      KSEC1(11)=2   ! Day
      KSEC1(12)=12   ! Hour
      KSEC1(13)=0    ! Minute
      KSEC1(14)=0    ! CREX Master table ( 0 for standard WMO crex tables)
      KSEC1(15)=3    ! CREX table version number
      KSEC1(16)=0    ! Originating sub-centre
      KSEC1(17)=14   ! BUFR master table version number
      KSEC1(18)=0    ! BUFR local table version number
C

      K=1
      CALL CREXDES(K,KSEC1,KTDLEN,CREXKTDLST,KDLEN,KDATA,KELEM,
     1            KTDEXL,CREXKTDEXP,CNAMES,CUNITS,KERR)
      IF(KERR.NE.0) THEN
         print*,'CREXDES: error'
         STOP
      END IF

C
C     SET VALUES TO BE PACKED
C
      K=1
      KSUBSETS=1
c
      DO J=1,KSUBSETS

      IK=(J-1)*KELEM
      N=1
      VALUES(N+IK)=13.         ! Block number
      N=N+1                    !
      VALUES(N+IK)=274.        ! station number
      N=N+1                    !
      VALUES(N+IK)=0.          ! type of station
      N=N+1                    !
      VALUES(N+IK)=2003.       ! year
      N=N+1                    !
      VALUES(N+IK)=12.         ! month
      N=N+1                    !
      VALUES(N+IK)=2.          ! day
      N=N+1                    !
      VALUES(N+IK)=12.         ! hour
      N=N+1                    !
      VALUES(N+IK)=0.          ! minute
      N=N+1
      VALUES(N+IK)=45.2        ! lat
      N=N+1                    !
      VALUES(N+IK)=20.5        ! lon
      N=N+1                    !
      VALUES(N+IK)=170.        ! station height
      N=N+1                    !
      VALUES(N+IK)=102000.     ! station level pressure
      N=N+1
      VALUES(N+IK)=102500.     ! msl pressure
      N=N+1                    !
      VALUES(N+IK)=100.        ! pressure change
      N=N+1                    !
      VALUES(N+IK)=rvind       ! characteristic of pressure change
      N=N+1                    !
      VALUES(N+IK)=300.        ! wind dir
      N=N+1                    !
      VALUES(N+IK)=8.5         ! wind speed
      N=N+1                    !
      VALUES(N+IK)=-5.0        ! T
      N=N+1                    !
      VALUES(N+IK)=-7.0        ! Td
      N=N+1                    !
      VALUES(N+IK)=70.         ! RH
      N=N+1                    !
      VALUES(N+IK)=1000.       ! visibility
      N=N+1                    !
      VALUES(N+IK)=rvind          
      N=N+1                    !
      VALUES(N+IK)=rvind
      N=N+1                    !
      VALUES(N+IK)=rvind         
      N=N+1                    !
      VALUES(N+IK)=rvind
      N=N+1                    !
      VALUES(N+IK)=rvind
c
      DO I=N,47
      N=N+1                    !
      VALUES(N+IK)=rvind        
      END DO
C                    !
      END DO                    !
C
C     SET CCITTIA5 CALL SIGN 
C
      DO I=1,200
      CVALS( I )=' '
      END DO
C
C
C     SECTION 3 CONTENT
C
      KSEC3(1)=0         ! TOTAL LENGTH OF SECTION 3
      KSEC3(2)=0         ! RESERVED
      KSEC3(3)= ksubsets ! NUMBER OF SUBSETS
      KSEC3(4)=0
C
      IREP=0
C
C
C*          6. PACK CREX MESSAGE
C              -----------------
 600  CONTINUE
C
C
      KERR=0
      CALL CREXEN( KSEC0,KSEC1,KSEC3,
     1             KTDLEN,crexKTDLST,KDLENG,KDATA,KELEM,
     2             KVALS,VALUES,CVALS,KBUFL,KBUFR,KERR)
C

      IF(KERR.GT.0) THEN
         CALL EXIT(2)
      ELSEIF(KERR.lt.0) then
         print*,'Encoding return_code=',kerr
      END IF 
C
C
      ILEN=KBUFL
C     ILEN=KSEC0(2)
C
      IERR=0
      CALL PBWRITE(IUNIT1,KBUFR,ILEN,IERR)
      IF(IERR.LT.0) THEN
         print*,'Error writing into target file.'
         CALL EXIT(2)
      END IF
C
C     Print CREX message on screen
      print*,yout(1:ilen)
C
C     -----------------------------------------------------------------
C
 900  CONTINUE
C
      STOP
      END
