init_io_surf_lfin.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_lfi_n (DTCO, U, &
                                     hmask,haction)
!     ######################
!
!!****  *INIT_IO_SURF_LFI* Keep in memory the output files
!!
!!    PURPOSE
!!    -------
!
!!
!!**  IMPLICIT ARGUMENTS
!!    ------------------
!!      None 
!!
!!    REFERENCE
!!    ---------
!!
!!    AUTHOR
!!    ------
!!      V. Masson   *Meteo France*
!!
!!    MODIFICATIONS
!!    -------------
!!
!!      P. Le Moigne 04/2004: distinguish in and out file name
!!      P. Le Moigne 04/2006: special HACTION='GTMSK' to initialize
!!                            a mask different of 'FULL ' in order 
!!                            to read dimensions only.
!
!*       0.   DECLARATIONS
!             ------------
!
!
!
!
!
USE modd_data_cover_n, ONLY : data_cover_t
USE modd_surf_atm_n, ONLY : surf_atm_t
!
USE modd_surfex_mpi, ONLY : nrank, nindex, npio, nsize
!
USE modd_surf_par,   ONLY: nundef
!
USE modd_io_surf_lfi,ONLY: cfile_lfi, cfilein_lfi,cfileout_lfi,   &
                           nmask,cluout_lfi,nfull,cmask, nluout,  &
                           nfull_surf,                            &
                           nib, nie, njb, nje, niu, nju,          &
                           nib_surf, nie_surf, njb_surf, nje_surf,&
                           niu_surf, nju_surf  
!
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 yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
!
TYPE(data_cover_t), INTENT(INOUT) :: dtco
TYPE(surf_atm_t), INTENT(INOUT) :: u
!
 CHARACTER(LEN=6),  INTENT(IN)  :: hmask    
 CHARACTER(LEN=5),  INTENT(IN)  :: haction    
!
INTEGER                        :: ilu,iret, il
INTEGER                :: inb ! number of articles in the file
REAL(KIND=JPRB) :: zhook_handle
!------------------------------------------------------------------------------
IF (lhook) CALL dr_hook('INIT_IO_SURF_LFI_N',0,zhook_handle)
!
 CALL get_luout('LFI   ',nluout)
!
!$OMP BARRIER
!
IF (haction=='GTMSK') THEN
  IF (nrank==npio) THEN 
!$OMP SINGLE          
    CALL fmopen(cfilein_lfi,'OLD',cluout_lfi,0,1,1,inb,iret)
!$OMP END SINGLE    
    cfile_lfi = cfilein_lfi
  ENDIF
  cmask = hmask
  IF (lhook) CALL dr_hook('INIT_IO_SURF_LFI_N',1,zhook_handle)
  RETURN
ENDIF
!
IF (haction == 'READ ') THEN
  IF (nrank==npio) THEN
!$OMP SINGLE            
    CALL fmopen(cfilein_lfi,'OLD',cluout_lfi,0,1,1,inb,iret)
!$OMP END SINGLE    
    cfile_lfi = cfilein_lfi
  ENDIF
  CALL read_surf(&
                 'LFI   ','DIM_FULL',nfull,iret,hdir='A')
  IF (hmask == 'FULL  ') THEN
    nfull_surf = nfull
    nib_surf = nib
    nie_surf = nie
    njb_surf = njb
    nje_surf = nje
    niu_surf = niu
    nju_surf = nju
   ENDIF
ELSE
  CALL get_dim_full_n(u, &
                      nfull)
ENDIF
!
!
IF (haction=='WRITE' .AND. nrank==npio) THEN
!$OMP SINGLE        
  CALL fmopen(cfileout_lfi,'UNKNOWN',cluout_lfi,0,1,1,inb,iret)
!$OMP END SINGLE   
  cfile_lfi = cfileout_lfi
ENDIF
!
!*       initialisation of 2D arrays
! 
IF (nib_surf/=nundef) THEN
  nib = nib_surf
  nie = nie_surf
  njb = njb_surf
  nje = nje_surf
  niu = niu_surf
  nju = nju_surf
END IF
!
! nindex is needed for call to get_size_full_n. In init_index_mpi, 
! it's not initialized for first readings.
IF (.NOT.ALLOCATED(nindex)) THEN
  ALLOCATE(nindex(nfull))
  nindex(:) = 0
ENDIF  
!
!------------------------------------------------------------------------------
!
! MASK is sized according to the mpi task running
 CALL get_size_full_n(u, &
                      'LFI   ',nfull,ilu)
IF (ilu>nsize) nsize = ilu
!
il = ilu
 CALL get_type_dim_n(dtco, u, &
                     hmask,il)
 CALL init_io_surf_mask_n(dtco, u, &
                          hmask, il, nluout, ilu, nmask)
!
!------------------------------------------------------------------------------
 cmask = hmask
IF (lhook) CALL dr_hook('INIT_IO_SURF_LFI_N',1,zhook_handle)
!------------------------------------------------------------------------------
!
END SUBROUTINE init_io_surf_lfi_n