SURFEX v7.3
General documentation of Surfex
 All Classes Files Functions Variables Typedefs
/home/dasprezs/EXPORT_v7_3/src/OFFLIN/init_io_surf_lfin.F90
Go to the documentation of this file.
00001 !     #########
00002       SUBROUTINE INIT_IO_SURF_LFI_n(HMASK,HACTION)
00003 !     ######################
00004 !
00005 !!****  *INIT_IO_SURF_LFI* Keep in memory the output files
00006 !!
00007 !!    PURPOSE
00008 !!    -------
00009 !
00010 !!
00011 !!**  IMPLICIT ARGUMENTS
00012 !!    ------------------
00013 !!      None 
00014 !!
00015 !!    REFERENCE
00016 !!    ---------
00017 !!
00018 !!    AUTHOR
00019 !!    ------
00020 !!      V. Masson   *Meteo France*
00021 !!
00022 !!    MODIFICATIONS
00023 !!    -------------
00024 !!
00025 !!      P. Le Moigne 04/2004: distinguish in and out file name
00026 !!      P. Le Moigne 04/2006: special HACTION='GTMSK' to initialize
00027 !!                            a mask different of 'FULL ' in order 
00028 !!                            to read dimensions only.
00029 !
00030 !*       0.   DECLARATIONS
00031 !             ------------
00032 !
00033 USE MODD_SURFEX_MPI, ONLY : NRANK, NINDEX, NPIO, NSIZE
00034 !
00035 USE MODD_SURF_PAR,   ONLY: NUNDEF
00036 !
00037 USE MODD_IO_SURF_LFI,ONLY: CFILE_LFI, CFILEIN_LFI,CFILEOUT_LFI,   &
00038                            NMASK,CLUOUT_LFI,NFULL,CMASK, NLUOUT,  &
00039                            NFULL_SURF,                            &
00040                            NIB, NIE, NJB, NJE, NIU, NJU,          &
00041                            NIB_SURF, NIE_SURF, NJB_SURF, NJE_SURF,&
00042                            NIU_SURF, NJU_SURF  
00043 !
00044 USE MODI_GET_LUOUT
00045 USE MODI_READ_SURF
00046 USE MODI_GET_DIM_FULL_n
00047 USE MODI_GET_SIZE_FULL_n
00048 USE MODI_GET_TYPE_DIM_n
00049 USE MODI_INIT_IO_SURF_MASK_n
00050 !
00051 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00052 USE PARKIND1  ,ONLY : JPRB
00053 !
00054 IMPLICIT NONE
00055 !
00056  CHARACTER(LEN=6),  INTENT(IN)  :: HMASK    
00057  CHARACTER(LEN=5),  INTENT(IN)  :: HACTION    
00058 !
00059 INTEGER                        :: ILU,IRET, IL
00060 INTEGER                :: INB ! number of articles in the file
00061 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00062 !------------------------------------------------------------------------------
00063 IF (LHOOK) CALL DR_HOOK('INIT_IO_SURF_LFI_N',0,ZHOOK_HANDLE)
00064 !
00065  CALL GET_LUOUT('LFI   ',NLUOUT)
00066 !
00067 !$OMP BARRIER
00068 !
00069 IF (HACTION=='GTMSK') THEN
00070   IF (NRANK==NPIO) THEN 
00071 !$OMP SINGLE          
00072     CALL FMOPEN(CFILEIN_LFI,'OLD',CLUOUT_LFI,0,1,1,INB,IRET)
00073 !$OMP END SINGLE    
00074     CFILE_LFI = CFILEIN_LFI
00075   ENDIF
00076   CMASK = HMASK
00077   IF (LHOOK) CALL DR_HOOK('INIT_IO_SURF_LFI_N',1,ZHOOK_HANDLE)
00078   RETURN
00079 ENDIF
00080 !
00081 IF (HACTION == 'READ ') THEN
00082   IF (NRANK==NPIO) THEN
00083 !$OMP SINGLE            
00084     CALL FMOPEN(CFILEIN_LFI,'OLD',CLUOUT_LFI,0,1,1,INB,IRET)
00085 !$OMP END SINGLE    
00086     CFILE_LFI = CFILEIN_LFI
00087   ENDIF
00088   CALL READ_SURF('LFI   ','DIM_FULL',NFULL,IRET,HDIR='A')
00089   IF (HMASK == 'FULL  ') THEN
00090     NFULL_SURF = NFULL
00091     NIB_SURF = NIB
00092     NIE_SURF = NIE
00093     NJB_SURF = NJB
00094     NJE_SURF = NJE
00095     NIU_SURF = NIU
00096     NJU_SURF = NJU
00097    ENDIF
00098 ELSE
00099   CALL GET_DIM_FULL_n(NFULL)
00100 ENDIF
00101 !
00102 !
00103 IF (HACTION=='WRITE' .AND. NRANK==NPIO) THEN
00104 !$OMP SINGLE        
00105   CALL FMOPEN(CFILEOUT_LFI,'UNKNOWN',CLUOUT_LFI,0,1,1,INB,IRET)
00106 !$OMP END SINGLE   
00107   CFILE_LFI = CFILEOUT_LFI
00108 ENDIF
00109 !
00110 !*       initialisation of 2D arrays
00111 ! 
00112 IF (NIB_SURF/=NUNDEF) THEN
00113   NIB = NIB_SURF
00114   NIE = NIE_SURF
00115   NJB = NJB_SURF
00116   NJE = NJE_SURF
00117   NIU = NIU_SURF
00118   NJU = NJU_SURF
00119 END IF
00120 !
00121 ! nindex is needed for call to get_size_full_n. In init_index_mpi, 
00122 ! it's not initialized for first readings.
00123 IF (.NOT.ALLOCATED(NINDEX)) THEN
00124   ALLOCATE(NINDEX(NFULL))
00125   NINDEX(:) = 0
00126 ENDIF  
00127 !
00128 !------------------------------------------------------------------------------
00129 !
00130 ! MASK is sized according to the mpi task running
00131  CALL GET_SIZE_FULL_n('LFI   ',NFULL,ILU)
00132 IF (ILU>NSIZE) NSIZE = ILU
00133 !
00134 IL = ILU
00135  CALL GET_TYPE_DIM_n(HMASK,IL)
00136  CALL INIT_IO_SURF_MASK_n(HMASK, IL, NLUOUT, ILU, NMASK)
00137 !
00138 !------------------------------------------------------------------------------
00139 CMASK = HMASK
00140 IF (LHOOK) CALL DR_HOOK('INIT_IO_SURF_LFI_N',1,ZHOOK_HANDLE)
00141 !------------------------------------------------------------------------------
00142 !
00143 END SUBROUTINE INIT_IO_SURF_LFI_n