SURFEX v7.3: /home/dasprezs/EXPORT_v7_3/src/SURFEX/init_io_surf

Go to the documentation of this file.
00001 !     ######################
00002       SUBROUTINE INIT_IO_SURF_FA_n(HPROGRAM,HMASK,HACTION)
00003 !     ######################
00004 !
00005 !!****  *INIT_IO_SURF_FA* 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 !!      B. Decharme   2008  : Change to switch between offline and online run
00030 !!                            In online run, the mask must be always global
00031 !
00032 !*       0.   DECLARATIONS
00033 !             ------------
00034 !
00035 USE MODD_SURFEX_MPI, ONLY : NRANK, NINDEX, NPIO, NSIZE
00036 !
00037 USE MODD_CSTS, ONLY : XPI
00038 !
00039 USE MODD_IO_SURF_FA,ONLY: NUNIT_FA, CFILEIN_FA,CFILEOUT_FA,CDNOMC,IVERBFA,  &
00040                           NLUOUT,NFULL,NFULL_EXT, CMASK, LOPEN,             &
00041                           NDGL, NDLON, NDLUX, NDGUX, PERPK, PEBETA,         &
00042                           PELON0, PELAT0, PEDELX, PEDELY, PELON1, PELAT1 
00043 !
00044 USE MODD_SURF_ATM_n, ONLY: NDIM_FULL
00045 !
00046 USE MODI_ABOR1_SFX
00047 USE MODI_GET_LUOUT
00048 USE MODI_READ_SURF
00049 USE MODI_GET_DIM_FULL_n
00050 USE MODI_GET_SIZE_FULL_n
00051 USE MODI_GET_TYPE_DIM_n
00052 USE MODI_GET_SURF_MASK_n
00053 USE MODI_GET_1D_MASK
00054 !
00055 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00056 USE PARKIND1  ,ONLY : JPRB
00057 !
00058 IMPLICIT NONE
00059 !
00060  CHARACTER(LEN=6),  INTENT(IN)  :: HPROGRAM
00061  CHARACTER(LEN=6),  INTENT(IN)  :: HMASK    
00062  CHARACTER(LEN=5),  INTENT(IN)  :: HACTION    
00063 !
00064 INTEGER                        :: ILU, IRET, IL
00065 !
00066 INTEGER                :: INB ! number of articles in the file
00067 INTEGER                :: ITYPTR, ITRONC, INLATI, INXLON, INIVER
00068 INTEGER, DIMENSION (1000) :: INLOPA, INOZPA
00069 !
00070 REAL, DIMENSION (1000)  :: ZSINLA
00071 REAL, DIMENSION (200)   :: ZAHYBR, ZBHYBR
00072 REAL                    :: ZSLAPO, ZCLOPO, ZSLOPO, ZCODIL, ZREFER
00073 LOGICAL                 :: LOUTFAC
00074 !
00075 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00076 !
00077 !------------------------------------------------------------------------------
00078 !
00079 IF (LHOOK) CALL DR_HOOK('INIT_IO_SURF_FA_N',0,ZHOOK_HANDLE)
00080 !
00081 IF(HPROGRAM/='FA    '.AND.HPROGRAM/='AROME ') THEN
00082   CALL ABOR1_SFX('INIT_IO_SURF_FA_N -- HPROGRAM should be FA or AROME')
00083 ENDIF
00084 !
00085  CALL GET_LUOUT(HPROGRAM,NLUOUT)
00086 !
00087 !$OMP BARRIER
00088 !
00089 IF (NRANK==NPIO) LOPEN=.FALSE.
00090 !
00091 IF (HACTION=='GTMSK') THEN
00092   IF (NRANK==NPIO) THEN
00093 !$OMP SINGLE          
00094     CALL FAITOU(IRET,NUNIT_FA,.TRUE.,CFILEIN_FA,'OLD',.TRUE.,.FALSE.,IVERBFA,0,INB,CDNOMC)
00095     WRITE(NLUOUT,*)'HPROGRAM ',HPROGRAM,' IO_INIT HACTION==GTMSK',NUNIT_FA,CFILEIN_FA
00096 !$OMP END SINGLE    
00097     LOPEN=.TRUE.
00098   ENDIF
00099   CMASK = HMASK
00100   IF (LHOOK) CALL DR_HOOK('INIT_IO_SURF_FA_N',1,ZHOOK_HANDLE)
00101   RETURN
00102 ENDIF
00103 !
00104 IF (HACTION == 'READ ') THEN
00105   IF (NRANK==NPIO) THEN
00106 !$OMP SINGLE          
00107     CALL FAITOU(IRET,NUNIT_FA,.TRUE.,CFILEIN_FA,'OLD',.TRUE.,.FALSE.,IVERBFA,0,INB,CDNOMC)
00108     WRITE(NLUOUT,*)'HPROGRAM ',HPROGRAM,' IO_INIT HACTION==READ',NUNIT_FA,CFILEIN_FA
00109     CALL FACAGE(CDNOMC,.TRUE.)
00110 !$OMP END SINGLE    
00111     LOPEN=.TRUE.
00112   ENDIF
00113   !
00114   IF (HMASK /= 'EXTZON') THEN
00115     CMASK = 'FULL '
00116     CALL READ_SURF(HPROGRAM,'DIM_FULL',NFULL,IRET,HDIR='A')
00117     !  
00118     NFULL_EXT = NFULL
00119     IF (HPROGRAM=='AROME ') THEN
00120       NDIM_FULL = NFULL
00121     ENDIF
00122   ENDIF
00123   !
00124 ELSE
00125   ! NFULL must be known in every case. 
00126   CALL GET_DIM_FULL_n(NFULL)
00127 ENDIF
00128 !
00129 IF (HMASK == 'EXTZON') THEN
00130   IF (NRANK==NPIO) THEN
00131 !$OMP SINGLE           
00132     CALL FACIES(CDNOMC, ITYPTR, ZSLAPO, ZCLOPO, ZSLOPO,       &
00133                       ZCODIL, ITRONC, INLATI, INXLON, INLOPA, &
00134                       INOZPA, ZSINLA, INIVER, ZREFER, ZAHYBR, &
00135                       ZBHYBR, LOUTFAC) 
00136     NFULL_EXT = INLATI*INXLON
00137     NDGL   = INLATI
00138     NDLON  = INXLON
00139     NFULL  = INLOPA(4)*INLOPA(6)
00140     NDLUX  = INLOPA(4)
00141     NDGUX  = INLOPA(6)
00142     PEBETA = ZSLAPO
00143     PERPK  = ZSINLA(2)
00144     PELON0 = ZSINLA(3)*180./XPI
00145     PELAT0 = ZSINLA(4)*180./XPI
00146     PEDELX = ZSINLA(7)
00147     PEDELY = ZSINLA(8)
00148     PELON1 = ZSINLA(13)*180./XPI 
00149     PELAT1 = ZSINLA(14)*180./XPI
00150 !$OMP END SINGLE    
00151   ENDIF 
00152 ENDIF
00153 !
00154 IF (.NOT.ALLOCATED(NINDEX)) THEN
00155   ALLOCATE(NINDEX(NFULL))
00156   NINDEX(:) = 0
00157 ENDIF
00158 !
00159 !------------------------------------------------------------------------------
00160 CMASK=HMASK
00161 !------------------------------------------------------------------------------
00162 !
00163 IF (HPROGRAM=='AROME ') THEN
00164   NFULL = NDIM_FULL
00165   ILU = NFULL
00166   IL  = NFULL
00167 ELSE
00168   CALL GET_SIZE_FULL_n(HPROGRAM,NFULL,ILU)
00169   IF (ILU>NSIZE) NSIZE = ILU
00170   IL = ILU
00171   CALL GET_TYPE_DIM_n(HMASK,IL)
00172 ENDIF
00173 !
00174  CALL GET_MASK(ILU,IL)
00175 !
00176 !------------------------------------------------------------------------------
00177 IF (LHOOK) CALL DR_HOOK('INIT_IO_SURF_FA_N',1,ZHOOK_HANDLE)
00178 !------------------------------------------------------------------------------
00179 !
00180 CONTAINS
00181 !
00182 SUBROUTINE GET_MASK(KLU,KL)
00183 !
00184 USE MODD_MASK,       ONLY: NMASK_FULL
00185 USE MODD_IO_SURF_FA, ONLY: NMASK
00186 !
00187 IMPLICIT NONE
00188 !
00189 INTEGER, INTENT(INOUT) :: KLU
00190 INTEGER, INTENT(IN) :: KL
00191 !
00192 REAL, DIMENSION(KL) :: ZFULL
00193 INTEGER, DIMENSION(KL) :: IMASK
00194 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00195 !
00196 IF (LHOOK) CALL DR_HOOK('INIT_IO_SURF_FA_N:GET_MASK',0,ZHOOK_HANDLE)
00197 !
00198 IF (HPROGRAM=='AROME ') THEN
00199   ZFULL = 1.
00200   CALL GET_1D_MASK(KLU,KLU,ZFULL,IMASK)
00201 ELSE
00202   CALL GET_SURF_MASK_n(HMASK,KL,IMASK,KLU,NLUOUT)
00203 ENDIF
00204 !
00205 IF (.NOT.ALLOCATED(NMASK_FULL)) ALLOCATE(NMASK_FULL(KLU))
00206 NMASK_FULL(:)=0
00207 !
00208 NMASK => NMASK_FULL(1:KL)
00209 NMASK(:) = IMASK(:)
00210 !
00211 IF (LHOOK) CALL DR_HOOK('INIT_IO_SURF_FA_N:GET_MASK',1,ZHOOK_HANDLE)
00212 !
00213 END SUBROUTINE GET_MASK
00214 !
00215 END SUBROUTINE INIT_IO_SURF_FA_n
00216