SUBROUTINE CSIMOBS1 1,4
#if defined (DOC)
*
***s/r CSE1  - Create a set of simulated observations
*     .        Control at level 1
*
*
*Author  : P. Gauthier *ARMA/AES  May 8, 1995
*Revision:
*     P. KOCLAS   CMC/CMSV  June 98
*                 - Y2K conversion
*     S. Pellerin *ARMA/SMC May 2000
*                 - Logical unit clean up
*
*
*    -------------------
**    Purpose: to simulate observations by using a model state
*     .        to which noise is simulated and added to the
*     .        synthetic observation. This configuration can also
*     .        be employed to transfer observation in grid format
*     .        to a CMA format (NCONF/100 = 4)
*Arguments
*    -NONE-
#endif
      IMPLICIT NONE
*implicits
#include "pardim.cdk"
#include "comdimo.cdk"
#include "comlun.cdk"
#include "comgdpar.cdk"
#include "compost.cdk"
C
      INTEGER IERR, IULSTATE, IULCMA, IENS, JENS, jo

C
C*    RPN Standard files parameters
C
      REAL*8 ZDEET
      INTEGER FNOM, FSTOUV, FSTFRM, FCLOS, FSTPRM, FSTINF, FSTINL
      INTEGER INI,INJ,INK, INPAS, INBITS, IDATYP, IDEET
     +     ,IP1,IP2,IP3,IG1,IG2,IG3,IG4,ISWA,ILENGTH,IDLTF
     +     ,IUBC,IEXTR1,IEXTR2,IEXTR3
      INTEGER ILISTE(100),IDATE(100),IDATV(100),IDIMAX,INFON,IFSTRUN,IHH
      REAL*8 DHEURES
      CHARACTER*2 CLTYPVAR
      CHARACTER*1 CLGRTYP
      CHARACTER*4 CLNOMVAR
      CHARACTER*12 CLETIKET
      EXTERNAL FNOM, FSTOUV, FSTFRM, FCLOS, FSTPRM, FSTINF,FSTINL
C
      WRITE(NULOUT,FMT=9000)
 9000 FORMAT(//,3(" *****************"),/,6X
     S     ," CSIMOBS1- Creation of simulated observations",/
     S     ,3(" *****************"),/
     S     ,"  -- Revised version 6.09 --")
C
*
*     1. Set-up of miscellaneous parameters and open files
*
 100  CONTINUE
C
      IULSTATE = 56
      IULCMA   = 57
      IDIMAX   = 100
C
      CALL READNML('NAMGDPAR',IERR)
*
      IERR =  FNOM  (IULSTATE,'FSTOBS','RND',0)
      IF(IERR.GE.0)THEN
         IERR =  FSTOUV(IULSTATE,'RND')
      ELSE
         CALL ABORT3D(NULOUT,'CSIMOBS1')
      END IF
*
*
*     1.1  Determine the number of model states to be processed
*     .    and find out the related parameters
*
 110  CONTINUE
      IERR = FSTINL (IULSTATE,INI,INJ,INK
     S     ,-1,CETIKETN,-1,-1,-1,' '
     S     ,'DU',ILISTE,INFON,IDIMAX)
      WRITE(NULOUT,9110)INFON
 9110 FORMAT(//,4X,"Ensemble of ",I4," cases")
      IENS = INFON
*
C
      CALL READNML('NAMGDPAR',IERR)
      DO JENS = 1, IENS
         IERR = FSTPRM(ILISTE(JENS),IDATE(JENS),IDEET,INPAS
     +        ,INI,INJ,INK, INBITS, IDATYP
     +        ,IP1,IP2,IP3,CLTYPVAR,CLNOMVAR,CLETIKET,CLGRTYP
     +        ,IG1,IG2,IG3,IG4,ISWA,ILENGTH,IDLTF
     +        ,IUBC,IEXTR1,IEXTR2,IEXTR3)
         DHEURES = DBLE(INPAS*IDEET/3600)
*
         CALL INCDATR(IDATV(JENS),IDATE(JENS),DHEURES)
         CALL NEWDATE(IDATV(JENS),IFSTRUN,IHH,-3)
         WRITE(NULOUT,9111)JENS, IFSTRUN,IHH
      END DO
 9111 FORMAT(5X,"Case No. ",I3,5x,"Date and time: ",I10,5x,I8)
*
*     3. Start processing the model states
*
 300  CONTINUE
      DO 301 JENS = 1, 1
*
*     .  3.1 Read in the model state
*
         CTYPVARN = CLTYPVAR
         NSTAMPN  = IDATE(JENS)
         CALL GETFST(IULSTATE,'G','N')
         NSTAMP = NSTAMPN
         CALL POSTPROC(NULSTD,JENS,'GRID','OBSO3   ')
*
*     .  3.2. Define the observations arrays (ROBHDR and ROBDATA)
*
 320     CONTINUE
*
         CALL CSIMOBS2(NSTAMPN)
         IERR =  FNOM  (IULCMA,'CMAFILE','RND',0)
         IF(IERR.GE.0)THEN
            IERR =  FSTOUV(IULCMA,'RND')
         ELSE
            CALL ABORT3D(NULOUT,'CSIMOBS1')
         END IF
*
         CALL WRITECMA(IULCMA)
*         CALL READCMA(IULCMA)
*
         DO JO=1, NOBTOT,1000
            CALL PRNTHDR(JO,NULOUT)
            CALL PRNTBDY(JO,NULOUT)
         END DO

*
*     .  3.3  Write the data arrays on a RPN standard file
*
 330     CONTINUE
 301  CONTINUE
*
*     9. Close all files
*
 900  CONTINUE
      IERR =  FSTFRM(IULSTATE)
      IERR =  FCLOS (IULSTATE)
      RETURN
      END