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

Go to the documentation of this file.
00001 !     #########
00002       SUBROUTINE READ_TEB_GARDEN_n(HPROGRAM,HPATCH)
00003 !     ##################################
00004 !
00005 !!****  *READ_TEB_GARDEN_n* - routine to initialise ISBA variables
00006 !!                         
00007 !!
00008 !!    PURPOSE
00009 !!    -------
00010 !!
00011 !!**  METHOD
00012 !!    ------
00013 !!
00014 !!    EXTERNAL
00015 !!    --------
00016 !!
00017 !!
00018 !!    IMPLICIT ARGUMENTS
00019 !!    ------------------
00020 !!
00021 !!    REFERENCE
00022 !!    ---------
00023 !!
00024 !!
00025 !!    AUTHOR
00026 !!    ------
00027 !!      V. Masson   *Meteo France*      
00028 !!
00029 !!    MODIFICATIONS
00030 !!    -------------
00031 !!      Original    01/2003
00032 !!
00033 !!      READ_SURF for general reading : 08/2003 (S.Malardel)
00034 !!      B. Decharme  2008    : Floodplains
00035 !!      B. Decharme  01/2009 : Optional Arpege deep soil temperature read
00036 !!      B. Decharme  09/2012 : suppress NWG_LAYER (parallelization problems)
00037 !-------------------------------------------------------------------------------
00038 !
00039 !*       0.    DECLARATIONS
00040 !              ------------
00041 !
00042 !
00043 USE MODD_CO2V_PAR,       ONLY : XANFMINIT, XCONDCTMIN
00044 USE MODD_TEB_VEG_n,      ONLY : CPHOTO, CRESPSL, NNBIOMASS
00045 USE MODD_TEB_GARDEN_n,   ONLY : NGROUND_LAYER,               &
00046                                 XTG, XWG, XWGI, XWR, XLAI, TSNOW,   &
00047                                 XRESA, XANFM, XANF, XAN, XLE, XANDAY,&
00048                                 XBSLAI, XBIOMASS, XRESP_BIOMASS  
00049 !                                
00050 USE MODD_SURF_PAR,       ONLY : XUNDEF, NUNDEF
00051 USE MODD_SNOW_PAR,       ONLY : XZ0SN
00052 !
00053 USE MODI_READ_SURF
00054 !
00055 USE MODI_INIT_IO_SURF_n
00056 USE MODI_SET_SURFEX_FILEIN
00057 USE MODI_END_IO_SURF_n
00058 USE MODI_TOWN_PRESENCE
00059 USE MODI_ALLOCATE_GR_SNOW
00060 USE MODI_READ_GR_SNOW
00061 !
00062 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00063 USE PARKIND1  ,ONLY : JPRB
00064 !
00065 USE MODI_GET_TYPE_DIM_n
00066 !
00067 IMPLICIT NONE
00068 !
00069 !*       0.1   Declarations of arguments
00070 !              -------------------------
00071 !
00072  CHARACTER(LEN=6),  INTENT(IN)  :: HPROGRAM ! calling program
00073  CHARACTER(LEN=3),  INTENT(IN)  :: HPATCH   ! current TEB patch identificator
00074 !
00075 !*       0.2   Declarations of local variables
00076 !              -------------------------------
00077 !
00078 LOGICAL           :: GTOWN          ! town variables written in the file
00079 INTEGER           :: IVERSION, IBUGFIX
00080 INTEGER           :: ILU            ! 1D physical dimension
00081 INTEGER           :: IRESP          ! Error code after redding
00082  CHARACTER(LEN=12) :: YRECFM         ! Name of the article to be read
00083  CHARACTER(LEN=4)  :: YLVL
00084 REAL, DIMENSION(:),ALLOCATABLE  :: ZWORK      ! 2D array to write data in file
00085 !
00086 INTEGER :: IWORK   ! Work integer
00087 !
00088 INTEGER :: JLAYER, JNBIOMASS  ! loop counter on layers
00089 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00090 !
00091 !-------------------------------------------------------------------------------
00092 !
00093 !
00094 !* 1D physical dimension
00095 !
00096 IF (LHOOK) CALL DR_HOOK('READ_TEB_GARDEN_N',0,ZHOOK_HANDLE)
00097 YRECFM='SIZE_TOWN'
00098  CALL GET_TYPE_DIM_n('TOWN  ',ILU)
00099 !
00100 YRECFM='VERSION'
00101  CALL READ_SURF(HPROGRAM,YRECFM,IVERSION,IRESP)
00102 !
00103 YRECFM='BUG'
00104  CALL READ_SURF(HPROGRAM,YRECFM,IBUGFIX,IRESP)
00105 !
00106 !*       2.     Prognostic fields:
00107 !               -----------------
00108 !
00109 ALLOCATE(ZWORK(ILU))
00110 !* soil temperatures
00111 !
00112 IWORK=NGROUND_LAYER
00113 !
00114 ALLOCATE(XTG(ILU,IWORK))
00115 DO JLAYER=1,IWORK
00116   WRITE(YLVL,'(I2)') JLAYER
00117   IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) THEN
00118     YRECFM=HPATCH//'GD_TG'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
00119   ELSE
00120     YRECFM='TWN_TG'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
00121   ENDIF
00122   YRECFM=ADJUSTL(YRECFM)  
00123   CALL READ_SURF(HPROGRAM,YRECFM,ZWORK(:),IRESP)
00124   XTG(:,JLAYER)=ZWORK
00125 END DO
00126 !
00127 !
00128 !* soil liquid water content
00129 !
00130 ALLOCATE(XWG(ILU,IWORK))
00131 DO JLAYER=1,NGROUND_LAYER
00132   WRITE(YLVL,'(I2)') JLAYER
00133   IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) THEN
00134     YRECFM=HPATCH//'GD_WG'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
00135   ELSE
00136     YRECFM='TWN_WG'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
00137   ENDIF  
00138   YRECFM=ADJUSTL(YRECFM)
00139   CALL READ_SURF(HPROGRAM,YRECFM,ZWORK(:),IRESP)
00140   XWG(:,JLAYER)=ZWORK
00141 END DO
00142 !
00143 !* soil ice water content
00144 !
00145 ALLOCATE(XWGI(ILU,IWORK))
00146 DO JLAYER=1,NGROUND_LAYER
00147   WRITE(YLVL,'(I2)') JLAYER
00148 ! ajouter ici un test pour lire les anciens fichiers
00149   IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) THEN
00150     YRECFM=HPATCH//'GD_WGI'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
00151   ELSE
00152     YRECFM='TWN_WGI'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
00153   ENDIF  
00154   YRECFM=ADJUSTL(YRECFM)  
00155   CALL READ_SURF(HPROGRAM,YRECFM,ZWORK(:),IRESP)
00156   XWGI(:,JLAYER)=ZWORK
00157 END DO
00158 !
00159 !* water intercepted on leaves
00160 !
00161 ALLOCATE(XWR(ILU))
00162 IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) THEN
00163   YRECFM=HPATCH//'GD_WR'
00164 ELSE
00165   YRECFM='TWN_WR'
00166 ENDIF
00167 YRECFM=ADJUSTL(YRECFM)
00168  CALL READ_SURF(HPROGRAM,YRECFM,XWR(:),IRESP)
00169 !
00170 !* Leaf Area Index (if prognostic)
00171 !
00172 IF (CPHOTO=='LAI' .OR. CPHOTO=='LST' .OR. CPHOTO=='NIT' .OR. CPHOTO=='NCB') THEN
00173   IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) THEN
00174     YRECFM=HPATCH//'GD_LAI'
00175   ELSE
00176     YRECFM='TWN_LAI'
00177   ENDIF        
00178   YRECFM=ADJUSTL(YRECFM)
00179   CALL READ_SURF(HPROGRAM,YRECFM,XLAI(:),IRESP)        
00180 END IF
00181 !
00182 !* snow mantel
00183 !
00184  CALL END_IO_SURF_n(HPROGRAM)
00185  CALL SET_SURFEX_FILEIN(HPROGRAM,'PGD ')
00186  CALL INIT_IO_SURF_n(HPROGRAM,'TOWN  ','TEB   ','READ ')
00187 !
00188  CALL TOWN_PRESENCE(HPROGRAM,GTOWN)
00189 !
00190  CALL END_IO_SURF_n(HPROGRAM)
00191  CALL SET_SURFEX_FILEIN(HPROGRAM,'PREP')
00192  CALL INIT_IO_SURF_n(HPROGRAM,'TOWN  ','TEB   ','READ ')
00193 !
00194 IF (.NOT. GTOWN) THEN
00195   TSNOW%SCHEME='1-L'
00196   CALL ALLOCATE_GR_SNOW(TSNOW,ILU,1)
00197 ELSE
00198   IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) THEN
00199     CALL READ_GR_SNOW(HPROGRAM,'GD',HPATCH,ILU,1,TSNOW  )
00200   ELSE
00201     CALL READ_GR_SNOW(HPROGRAM,'GARD',HPATCH,ILU,1,TSNOW  )
00202   ENDIF
00203 ENDIF
00204 !
00205 !-------------------------------------------------------------------------------
00206 !
00207 !*       4.  Semi-prognostic variables
00208 !            -------------------------
00209 !
00210 !* aerodynamical resistance
00211 !
00212 ALLOCATE(XRESA(ILU))
00213 IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) THEN
00214   YRECFM=HPATCH//'GD_RES'
00215 ELSE
00216   YRECFM='TWN_RESA'
00217 ENDIF
00218 YRECFM=ADJUSTL(YRECFM)
00219 XRESA(:) = 100.
00220  CALL READ_SURF(HPROGRAM,YRECFM,XRESA(:),IRESP)
00221 !
00222 ALLOCATE(XLE(ILU))
00223 XLE(:) = XUNDEF
00224 !
00225 !* ISBA-AGS variables
00226 !
00227 IF (CPHOTO/='NON') THEN
00228   ALLOCATE(XAN   (ILU)) 
00229   ALLOCATE(XANDAY(ILU)) 
00230   ALLOCATE(XANFM (ILU))
00231   ALLOCATE(XANF  (ILU))
00232   XAN(:)    = 0.
00233   XANDAY(:) = 0.
00234   XANFM(:)  = XANFMINIT
00235   XLE(:)    = 0.
00236 ELSE
00237   ALLOCATE(XAN   (0)) 
00238   ALLOCATE(XANDAY(0)) 
00239   ALLOCATE(XANFM (0))
00240   ALLOCATE(XANF  (0))
00241 ENDIF
00242 !
00243 IF(CPHOTO/='NON') THEN
00244   ALLOCATE(XBIOMASS         (ILU,NNBIOMASS))
00245   ALLOCATE(XRESP_BIOMASS    (ILU,NNBIOMASS))
00246 ELSE
00247   ALLOCATE(XBIOMASS         (0,0))
00248   ALLOCATE(XRESP_BIOMASS    (0,0))
00249 END IF
00250 !
00251 IF (CPHOTO=='AGS' .OR. CPHOTO=='AST') THEN
00252   !
00253   XBIOMASS(:,:) = 0.
00254   XRESP_BIOMASS(:,:) = 0.
00255 ELSEIF (CPHOTO=='LAI' .OR. CPHOTO=='LST') THEN
00256   !
00257   XBIOMASS(:,1) = XBSLAI(:) * XLAI(:)
00258   XRESP_BIOMASS(:,:) = 0.
00259 ELSEIF (CPHOTO=='NIT' .OR. CPHOTO=='NCB') THEN
00260   !
00261   XBIOMASS(:,:) = 0.
00262   DO JNBIOMASS=1,NNBIOMASS
00263     WRITE(YLVL,'(I1)') JNBIOMASS
00264     IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) THEN
00265       YRECFM=HPATCH//'GD_BIOMA'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
00266     ELSE
00267       YRECFM='TWN_BIOMASS'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
00268     ENDIF
00269     CALL READ_SURF(HPROGRAM,YRECFM,XBIOMASS(:,JNBIOMASS),IRESP)
00270   END DO
00271 
00272   XRESP_BIOMASS(:,:) = 0.
00273   DO JNBIOMASS=2,NNBIOMASS
00274     WRITE(YLVL,'(I1)') JNBIOMASS
00275     IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) THEN
00276       YRECFM=HPATCH//'GD_RESPI'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
00277     ELSE
00278       YRECFM='TWN_RESP_BIOM'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
00279     ENDIF    
00280     CALL READ_SURF(HPROGRAM,YRECFM,XRESP_BIOMASS(:,JNBIOMASS),IRESP)
00281   END DO
00282   !
00283 ENDIF
00284 !
00285 DEALLOCATE(ZWORK)
00286 IF (LHOOK) CALL DR_HOOK('READ_TEB_GARDEN_N',1,ZHOOK_HANDLE)
00287 !
00288 !-------------------------------------------------------------------------------
00289 !
00290 END SUBROUTINE READ_TEB_GARDEN_n