open_close_bin_asc_forc.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 open_close_bin_asc_forc(HACTION,HFORCING,HACTION2)
!     ################################################################
!
!!****  *OPEN_CLOSE_BIN_ASC_FORC* - routine to open and close atmospheric forcing files
!!
!!    PURPOSE
!!    -------
!!
!!**  METHOD
!!    ------
!!
!!    EXTERNAL
!!    --------
!!
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!
!!    REFERENCE
!!    ---------
!!
!!
!!    AUTHOR
!!    ------
!!      A. Lemonsu  *Meteo France*
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    04/2008
!!      Modified by P. Le Moigne 07/2008: HACTION2 added
!-------------------------------------------------------------------------------
!
!*       0.    DECLARATIONS
!              ------------
!
USE modd_surfex_omp, ONLY : nblock
USE modd_surfex_mpi, ONLY : nrank, npio
!
USE modd_io_surf_asc,ONLY : nni_forc
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
USE modi_abor1_sfx
!
IMPLICIT NONE
!
!*       0.1   Declarations of arguments
!              -------------------------
!
 CHARACTER(LEN=5),  INTENT(IN)  :: haction  ! action to do
 CHARACTER(LEN=6),  INTENT(IN)  :: hforcing ! forcing file type
 CHARACTER(LEN=1),  INTENT(IN)  :: haction2 ! 'R': read, 'W': write
 CHARACTER(LEN=7)               :: ystatus  ! file status (OLD/NEW)
!
!*       0.2   Declarations of local variables
!              -------------------------------
!
INTEGER :: ini
REAL(KIND=JPRB) :: zhook_handle
!-------------------------------------------------------------------------------
!
IF (lhook) CALL dr_hook('OPEN_CLOSE_BIN_ASC_FORC',0,zhook_handle)
!
IF (haction2=='R') THEN
   ystatus='UNKNOWN'
ELSE IF (haction2=='W') THEN
   ystatus='NEW    '
ELSE
   CALL abor1_sfx('OPEN_CLOSE_BIN_ASC_FORC: UNKNOWN FILE STATUS, '//ystatus)      
ENDIF
!      
IF (haction=='CONF ') THEN
  IF (nrank==npio) OPEN(unit=21,file='Params_config.txt',form='FORMATTED',status=ystatus)
  IF (lhook) CALL dr_hook('OPEN_CLOSE_BIN_ASC_FORC',1,zhook_handle)
  RETURN
END IF
!
IF (haction=='OPEN ') THEN
  IF (hforcing=='ASCII ') THEN
    IF (nrank==npio) THEN
      OPEN(unit=22,file='Forc_TA.txt      ',form='FORMATTED',status=ystatus)
      OPEN(unit=23,file='Forc_QA.txt      ',form='FORMATTED',status=ystatus)
      OPEN(unit=24,file='Forc_WIND.txt    ',form='FORMATTED',status=ystatus)
      OPEN(unit=25,file='Forc_LW.txt      ',form='FORMATTED',status=ystatus)
      OPEN(unit=26,file='Forc_DIR_SW.txt  ',form='FORMATTED',status=ystatus)
      OPEN(unit=27,file='Forc_SCA_SW.txt  ',form='FORMATTED',status=ystatus)
      OPEN(unit=28,file='Forc_RAIN.txt    ',form='FORMATTED',status=ystatus)
      OPEN(unit=29,file='Forc_SNOW.txt    ',form='FORMATTED',status=ystatus)
      OPEN(unit=30,file='Forc_PS.txt      ',form='FORMATTED',status=ystatus)
      OPEN(unit=31,file='Forc_DIR.txt     ',form='FORMATTED',status=ystatus)
      OPEN(unit=32,file='Forc_CO2.txt     ',form='FORMATTED',status=ystatus)
    ENDIF
  ELSE IF (hforcing=='BINARY') THEN
    IF (nrank==npio) THEN   
      OPEN(unit=22,file='Forc_TA.bin      ',form='UNFORMATTED',status=ystatus,access='DIRECT',recl=nni_forc*4)
      OPEN(unit=23,file='Forc_QA.bin      ',form='UNFORMATTED',status=ystatus,access='DIRECT',recl=nni_forc*4)
      OPEN(unit=24,file='Forc_WIND.bin    ',form='UNFORMATTED',status=ystatus,access='DIRECT',recl=nni_forc*4)
      OPEN(unit=25,file='Forc_LW.bin      ',form='UNFORMATTED',status=ystatus,access='DIRECT',recl=nni_forc*4)
      OPEN(unit=26,file='Forc_DIR_SW.bin  ',form='UNFORMATTED',status=ystatus,access='DIRECT',recl=nni_forc*4)
      OPEN(unit=27,file='Forc_SCA_SW.bin  ',form='UNFORMATTED',status=ystatus,access='DIRECT',recl=nni_forc*4)
      OPEN(unit=28,file='Forc_RAIN.bin    ',form='UNFORMATTED',status=ystatus,access='DIRECT',recl=nni_forc*4)
      OPEN(unit=29,file='Forc_SNOW.bin    ',form='UNFORMATTED',status=ystatus,access='DIRECT',recl=nni_forc*4)
      OPEN(unit=30,file='Forc_PS.bin      ',form='UNFORMATTED',status=ystatus,access='DIRECT',recl=nni_forc*4)
      OPEN(unit=31,file='Forc_DIR.bin     ',form='UNFORMATTED',status=ystatus,access='DIRECT',recl=nni_forc*4)
      OPEN(unit=32,file='Forc_CO2.bin     ',form='UNFORMATTED',status=ystatus,access='DIRECT',recl=nni_forc*4)
    ENDIF
  ENDIF
ENDIF
!
IF (haction=='CLOSE') THEN
  IF (nrank==npio) THEN
    CLOSE(21)
    CLOSE(22)
    CLOSE(23)
    CLOSE(24)
    CLOSE(25)
    CLOSE(26)
    CLOSE(27)
    CLOSE(28)
    CLOSE(29)
    CLOSE(30)
    CLOSE(31)
    CLOSE(32)
  ENDIF
END IF
IF (lhook) CALL dr_hook('OPEN_CLOSE_BIN_ASC_FORC',1,zhook_handle)
!-------------------------------------------------------------------------------
!
END SUBROUTINE open_close_bin_asc_forc