init_write_bin.F90

Go to the documentation of this file.

!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt  
!SFX_LIC for details. version 1.
!     #########
      SUBROUTINE init_write_bin (HSELECT, KDIM_FULL, &
                                 HREC,KPATCH,OWFL)
!     ######################
!
!!****  *INIT_WRITE_BIN_n* Initialize array name to be written and associated
!!                         unit number
!!
!!    PURPOSE
!!    -------
!
!!
!!**  IMPLICIT ARGUMENTS
!!    ------------------
!!      None 
!!
!!    REFERENCE
!!    ---------
!!
!!    AUTHOR
!!    ------
!!      A. LEMONSU     *Meteo France*
!!
!!    MODIFICATIONS
!!    -------------
!!
!
!*       0.   DECLARATIONS
!             ------------
!
USE modd_io_surf_bin,ONLY:nmask, nfull, cmask
USE modd_write_bin,  ONLY:nunit0, nvar, cvar, jpvar, nind
!
USE modi_abor1_sfx
!USE MODI_TEST_RECORD_LEN
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
 CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) :: HSELECT
 INTEGER, INTENT(IN) :: KDIM_FULL
!
 CHARACTER(LEN=12),   INTENT(IN)     :: HREC    
INTEGER,             INTENT(IN)     :: KPATCH    
LOGICAL,             INTENT(INOUT)  :: OWFL
INTEGER                             :: IP, IVAR, IFIELD, JFIELD
INTEGER                             :: IRECLEN
!LOGICAL                             :: LMATCH
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!------------------------------------------------------------------------------
IF (lhook) CALL dr_hook('INIT_WRITE_BIN',0,zhook_handle)
ireclen=kdim_full*kpatch*4
!
ivar=nunit0
DO ip=1, jpvar
  IF (hrec==cvar(ip)) THEN
    ivar=nvar(ip)
    EXIT
  ENDIF
ENDDO
!
!
IF (ivar.NE.nunit0) THEN
!
  owfl=.true.
!
ELSE
!
  IF (cvar(1).NE.'                ') ivar=maxval(nvar(:))
!
!
  IF (SIZE(hselect)==0) THEN
!
    IF ( (hrec(1:2)/='D_'                          ) .AND.  &
          (hrec(1:2)/='DX'                           ) .AND.  &
          (hrec(1:2)/='DY'                           ) .AND.  &
          (hrec(1:4)/='CLAY'                         ) .AND.  &
          (hrec(1:4)/='SAND'                         ) .AND.  &
          (hrec(1:2)/='ZS'                           ) .AND.  &
          (hrec(1:4)/='SSO_'                         ) .AND.  &
          (hrec(1:4)/='Q2M_'                         ) .AND.  &
          (hrec(1:4)/='RESA'                         ) .AND.  &
          (hrec(1:3)/='RI_'                          ) .AND.  &
          (hrec(1:5)/='REG_L'                        ) .AND.  &
          (hrec(1:3)/='AOS'                          ) .AND.  &
          (hrec(1:3)/='HO2'                          ) .AND.  &
          (hrec(1:3)/='RGL'                          ) .AND.  &
          (hrec(1:3)/='SWD'                          ) .AND.  &
          (hrec(1:3)/='SWU'                          ) .AND.  &
          (hrec(1:3)/='LWD'                          ) .AND.  &
          (hrec(1:3)/='LWU'                          ) .AND.  &
          (hrec(1:3)/='ALB'                          ) .AND.  &
          (hrec(1:2)/='DG'                           ) .AND.  &
          (hrec(1:2)/='CV'                           ) .AND.  &
          (hrec(1:5)/='GAMMA'                        ) .AND.  &
          (hrec(1:5)/='RSMIN'                        ) .AND.  &
          (hrec(1:5)/='WRMAX'                        ) .AND.  &
          (hrec(1:5)/='Z0REL'                        ) .AND.  &
          (hrec(1:5)/='Z0SEA'                        ) .AND.  &
          (hrec(1:7)/='Z0WATER'                      ) .AND.  &
          (hrec(4:6)/='_ZS'                          ) .AND.  &
          (hrec(1:7)/='VEGTYPE'                      ) .AND.  &
          (hrec(1:5)/='COVER'                        ) .AND.  &
          (hrec(1:5)/='IRRIG'                        ) .AND.  &
          (hrec(1:4)/='TI_R'                         ) .AND.  &
          (hrec(1:3)/='CD_'                          ) .AND.  &
          (hrec(1:3)/='CE_'                          ) .AND.  &
          (hrec(1:3)/='CH_'                          ) .AND.  &
          (hrec(1:4)/='FMU_'                         ) .AND.  &
          (hrec(1:4)/='FMV_'                         ) .AND.  &
          (hrec(1:5)/='DRAIN'                        ) .AND.  &
          (hrec(1:4)/='EVAP'                         ) .AND.  &
          (hrec(1:6)/='GFLUXC'                       ) .AND.  &
          (hrec(1:6)/='GFLUX_'                       ) .AND.  &
          (hrec(1:6)/='HORTON'                       ) .AND.  &
          (hrec(1:6)/='RUNOFF'                       ) .AND.  &
          (hrec(1:6)/='SNMELT'                       ) .AND.  &
          (hrec(1:6)/='DRIVEG'                       ) .AND.  &
          (hrec(1:2)/='Z0'                           )        ) THEN  

      ivar = ivar+1
      IF (ivar-nunit0>jpvar) THEN
        CALL abor1_sfx('TOO MANY FIELDS TO BE WRITTEN IN THE "BINARY" TYPE TIMESERIES')
      END IF
      cvar(ivar-nunit0) = hrec
      nvar(ivar-nunit0) = ivar
      OPEN(unit=ivar,file=trim(hrec)//'.BIN',form='UNFORMATTED',access='DIRECT',recl=ireclen)
      owfl=.true.
   
    ELSE
      owfl=.false.
    ENDIF
!
  ELSE
!        
    ifield=0
    DO jfield=1,SIZE(hselect)
      IF (hselect(jfield)== '            ') EXIT
      ifield=ifield+1
    ENDDO
  
    !CALL TEST_RECORD_LEN("ASCII ",HREC,HSELECT,LMATCH)

    !IF (.NOT. LMATCH ) THEN

      ivar = ivar+1
      IF (ivar-nunit0>jpvar) THEN
        CALL abor1_sfx('TOO MANY FIELDS TO BE WRITTEN IN THE "BINARY" TYPE TIMESERIES')
      END IF
      cvar(ivar-nunit0) = hrec
      nvar(ivar-nunit0) = ivar
      OPEN(unit=ivar,file=trim(hrec)//'.BIN',form='UNFORMATTED',access='DIRECT',recl=ireclen)
      owfl=.true.

    !ELSE
    !  OWFL=.FALSE.
    !ENDIF

  ENDIF
ENDIF

nind=ivar
IF (lhook) CALL dr_hook('INIT_WRITE_BIN',1,zhook_handle)
!
!------------------------------------------------------------------------------
!
END SUBROUTINE init_write_bin