init_io_surf_oln.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_io_surf_ol_n (DTCO, DGU, U, &
                                    hprogram,hmask,hscheme,haction)
!     ######################
!
!!****  *INIT_IO_SURF_OL* Keep in memory the netcdf ID of the output files
!!
!!    PURPOSE
!!    -------
!
!!
!!**  IMPLICIT ARGUMENTS
!!    ------------------
!!      None 
!!
!!    REFERENCE
!!    ---------
!!
!!    AUTHOR
!!    ------
!!      F. Habets   *Meteo France*
!!
!!    MODIFICATIONS
!!    -------------
!!      modified 05/04 by P. LeMoigne *Meteo France*
!!      modified 06/10 by S. Faroux *Meteo France*
!!=================================================================
!
!*       0.   DECLARATIONS
!             ------------
!
USE modd_data_cover_n, ONLY : data_cover_t
USE modd_diag_surf_atm_n, ONLY : diag_surf_atm_t
USE modd_surf_atm_n, ONLY : surf_atm_t
!
USE modd_io_surf_ol
!
USE modd_surfex_mpi, ONLY : nrank, npio
!
USE modn_io_offline,    ONLY : xtstep_output
!
USE modi_get_luout
USE modi_read_surf
USE modi_get_dim_full_n
USE modi_get_size_full_n
USE modi_get_type_dim_n
USE modi_init_io_surf_mask_n
USE modi_write_surf
!
USE modd_surfex_mpi, ONLY : wlog_mpi
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
!
TYPE(data_cover_t), INTENT(INOUT) :: dtco
TYPE(diag_surf_atm_t), INTENT(INOUT) :: dgu
TYPE(surf_atm_t), INTENT(INOUT) :: u
!
 CHARACTER(LEN=6),  INTENT(IN)  :: hprogram 
 CHARACTER(LEN=6),  INTENT(IN)  :: hmask    
 CHARACTER(LEN=6),  INTENT(IN)  :: hscheme 
 CHARACTER(LEN=5),  INTENT(IN)  :: haction 
!
REAL              :: zden
INTEGER           :: iresp          ! IRESP  : return-code if a problem appears
 CHARACTER(LEN=100):: ycomment       ! Comment string
INTEGER           :: ilu,iret, il, ifull
INTEGER           :: iluout
REAL(KIND=JPRB)  :: zhook_handle
!------------------------------------------------------------------------------ 
IF (lhook) CALL dr_hook('INIT_IO_SURF_OL_N',0,zhook_handle)
!
lmask = .true.
!
 CALL get_luout(hprogram,iluout)
!
!$OMP BARRIER
!
IF (haction=='READ') THEN
  CALL read_surf(&
                 'OFFLIN','DIM_FULL',ifull,iret)
ELSE 
  CALL get_dim_full_n(u, &
                      ifull)
ENDIF
!
! size by MPI task. NINDEX is supposed to be initialized at this step.  
 CALL get_size_full_n(u, &
                      'OFFLIN',ifull,ilu)
!
il = ilu
 CALL get_type_dim_n(dtco, u, &
                     hmask,il)
 CALL init_io_surf_mask_n(dtco, u, &
                          hmask, il, iluout, ilu, nmask)
!
IF (haction=='READ' .AND. lhook) CALL dr_hook('INIT_IO_SURF_OL_N',1,zhook_handle)
IF (haction=='READ') RETURN
!
IF (nrank==npio) THEN
  !  
  ycomment=''
  !
  IF (xtstep_output == floor(xtstep_output/86400.)*86400) THEN 
    zden = 86400.
  ELSEIF (xtstep_output == floor(xtstep_output/3600.)*3600) THEN
    zden = 3600.
  ELSEIF (xtstep_output == floor(xtstep_output/60.)*60) THEN
    zden = 60.
  ELSE
    zden = 1.
  ENDIF
  !
  IF (.NOT.ltime_written(1)) THEN 
    xtype=1
    CALL write_surf(dgu, u, &
                    hprogram,'time',xtstep_output/zden*xstartw,iresp,hcomment=ycomment)
    ltime_written(1)=.true.
  ENDIF
  !
  IF (hscheme.NE.'NONE  ') THEN
    !
    IF (hmask=='NATURE' .AND. .NOT.ltime_written(2)) THEN
      xtype=2
      CALL write_surf(dgu, u, &
                    hprogram,'time',xtstep_output/zden*xstartw,iresp,hcomment=ycomment)
      ltime_written(2)=.true.
    ENDIF
    !
    IF (hmask=='SEA   ' .AND. .NOT.ltime_written(3)) THEN
      xtype=3
      CALL write_surf(dgu, u, &
                    hprogram,'time',xtstep_output/zden*xstartw,iresp,hcomment=ycomment)
      ltime_written(3)=.true.
    ENDIF
    !
    IF (hmask=='WATER ' .AND.  .NOT.ltime_written(4)) THEN  
      xtype=4
      CALL write_surf(dgu, u, &
                    hprogram,'time',xtstep_output/zden*xstartw,iresp,hcomment=ycomment)
      ltime_written(4)=.true.
    ENDIF
    !
    IF (hmask=='TOWN  ' .AND. .NOT.ltime_written(5)) THEN     
      xtype=5
      CALL write_surf(dgu, u, &
                    hprogram,'time',xtstep_output/zden*xstartw,iresp,hcomment=ycomment)
      ltime_written(5)=.true.
    ENDIF
    !
  ENDIF
  !
ENDIF
!
!------------------------------------------------------------------------------
IF (lhook) CALL dr_hook('INIT_IO_SURF_OL_N',1,zhook_handle)
!------------------------------------------------------------------------------
!
END SUBROUTINE init_io_surf_ol_n