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

Go to the documentation of this file.
00001 !     #########
00002       SUBROUTINE CONVERT_PATCH_ISBA(HISBA,KDECADE,KDECADE2,PCOVER,HPHOTO,&
00003                                   OAGRIP,HSFTYPE,PVEG,PLAI,PRSMIN,PGAMMA,&
00004                                   PWRMAX_CF,PRGL,PCV,                    &
00005                                   PSOILGRID,PDG,KWG_LAYER,PDROOT,PDG2,   &
00006                                   PZ0,PZ0_O_Z0H,                         &
00007                                   PALBNIR_VEG,PALBVIS_VEG,PALBUV_VEG,    &
00008                                   PEMIS_ECO,PVEGTYPE,PROOTFRAC,          &
00009                                   PGMES,PBSLAI,PLAIMIN,PSEFOLD,PGC,      &
00010                                   PDMAX, PF2I, OSTRESS, PH_TREE, PRE25,  &
00011                                   PCE_NITRO, PCF_NITRO, PCNA_NITRO,      &
00012                                   PD_ICE, PWG1,                          &
00013                                   PALBNIR_SOIL,PALBVIS_SOIL,PALBUV_SOIL, &
00014                                   TPSEED, TPREAP, PWATSUP, PIRRIG    )
00015 !     ##############################################################
00016 !
00017 !!**** *CONVERT_PATCH_ISBA* 
00018 !!
00019 !!    PURPOSE
00020 !!    -------
00021 !!
00022 !!    METHOD
00023 !!    ------
00024 !!   
00025 !
00026 !!    EXTERNAL
00027 !!    --------
00028 !!
00029 !!    IMPLICIT ARGUMENTS
00030 !!    ------------------
00031 !!
00032 !!    REFERENCE
00033 !!    ---------
00034 !!
00035 !!    AUTHOR
00036 !!    ------
00037 !!
00038 !!    S. Faroux        Meteo-France
00039 !!
00040 !!    MODIFICATION
00041 !!    ------------
00042 !!
00043 !!    Original    16/11/10
00044 !!
00045 !----------------------------------------------------------------------------
00046 !
00047 !*    0.     DECLARATION
00048 !            -----------
00049 !
00050 USE MODD_DATA_COVER_PAR, ONLY : NVEGTYPE, NVT_GRAS
00051 USE MODD_ISBA_GRID_n,    ONLY : NDIM
00052 !
00053 USE MODD_TYPE_DATE_SURF
00054 !
00055 USE MODD_SURF_ATM_n,     ONLY : LGARDEN
00056 ! 
00057 USE MODD_ISBA_n,         ONLY : CALBEDO,                                  &
00058                                 XALBNIR_DRY, XALBVIS_DRY, XALBUV_DRY,     &
00059                                 XALBNIR_WET, XALBVIS_WET, XALBUV_WET,     &
00060                                 XWSAT, LPERM, XPERM
00061 !
00062 USE MODD_DATA_COVER,     ONLY : XDATA_LAI, XDATA_H_TREE, XDATA_VEGTYPE, &
00063                                 XDATA_VEG, XDATA_Z0, XDATA_Z0_O_Z0H,    &
00064                                 XDATA_EMIS_ECO, XDATA_GAMMA, XDATA_CV,  &
00065                                 XDATA_RGL, XDATA_RSMIN,                 &
00066                                 XDATA_ALBNIR_VEG, XDATA_ALBVIS_VEG,     &
00067                                 XDATA_ALBUV_VEG,                        &
00068                                 XDATA_ALB_VEG_NIR, XDATA_ALB_VEG_VIS,   &
00069                                 XDATA_ALB_SOIL_NIR, XDATA_ALB_SOIL_VIS, &
00070                                 XDATA_GMES, XDATA_BSLAI, XDATA_LAIMIN,  &
00071                                 XDATA_SEFOLD, XDATA_GC, XDATA_WRMAX_CF, &
00072                                 XDATA_STRESS,                           &
00073                                 XDATA_DMAX, XDATA_F2I, XDATA_RE25,      &
00074                                 XDATA_CE_NITRO, XDATA_CF_NITRO,         &
00075                                 XDATA_CNA_NITRO, XDATA_DICE,            &
00076                                 XDATA_GMES_ST, XDATA_BSLAI_ST,          &
00077                                 XDATA_SEFOLD_ST, XDATA_GC_ST,           &
00078                                 XDATA_DMAX_ST, XDATA_WATSUP,            &
00079                                 TDATA_SEED, TDATA_REAP,XDATA_IRRIG,     &
00080                                 XDATA_GARDEN, XDATA_NATURE,             &
00081                                 XDATA_ROOT_DEPTH, XDATA_GROUND_DEPTH,   &
00082                                 XDATA_ROOT_EXTINCTION, XDATA_ROOT_LIN
00083 !   
00084 USE MODD_DATA_ISBA_n,   ONLY : XPAR_VEGTYPE,  XPAR_LAI, XPAR_H_TREE, XPAR_DG, XPAR_ROOTFRAC,     &
00085                                 XPAR_VEG, XPAR_Z0, XPAR_EMIS,                                    &
00086                                 XPAR_RSMIN, XPAR_GAMMA, XPAR_WRMAX_CF, XPAR_RGL,                 &
00087                                 XPAR_CV, XPAR_Z0_O_Z0H,                                          &
00088                                 XPAR_ALBNIR_VEG, XPAR_ALBVIS_VEG, XPAR_ALBUV_VEG,                &
00089                                 XPAR_ALBNIR_SOIL, XPAR_ALBVIS_SOIL, XPAR_ALBUV_SOIL,             &
00090                                 XPAR_GMES, XPAR_BSLAI, XPAR_SEFOLD, XPAR_GC, XPAR_DMAX,          &
00091                                 XPAR_RE25, XPAR_LAIMIN, XPAR_F2I,                                &
00092                                 XPAR_CE_NITRO,XPAR_CF_NITRO,XPAR_CNA_NITRO,XPAR_DICE,            &
00093                                 XPAR_GROUND_DEPTH, XPAR_ROOT_DEPTH,                              &
00094                                 XPAR_ROOT_EXTINCTION, XPAR_ROOT_LIN,                             &
00095                                 LPAR_STRESS, XPAR_IRRIG, XPAR_WATSUP,                            &
00096                                 LDATA_VEGTYPE, LDATA_LAI, LDATA_H_TREE, LDATA_DG, LDATA_ROOTFRAC,&  
00097                                 LDATA_VEG, LDATA_Z0, LDATA_EMIS,                                 &
00098                                 LDATA_RSMIN, LDATA_GAMMA, LDATA_WRMAX_CF, LDATA_RGL,             &
00099                                 LDATA_CV, LDATA_Z0_O_Z0H,                                        &
00100                                 LDATA_ALBNIR_VEG, LDATA_ALBVIS_VEG, LDATA_ALBUV_VEG,             &
00101                                 LDATA_ALBVIS_SOIL, LDATA_ALBNIR_SOIL, LDATA_ALBUV_SOIL,          &
00102                                 LDATA_GMES, LDATA_BSLAI, LDATA_SEFOLD, LDATA_GC, LDATA_DMAX,     &
00103                                 LDATA_RE25, LDATA_LAIMIN, LDATA_F2I,                             &
00104                                 LDATA_CE_NITRO,LDATA_CF_NITRO, LDATA_CNA_NITRO, LDATA_DICE,      &
00105                                 LDATA_STRESS, LDATA_IRRIG, LDATA_WATSUP,                         &
00106                                 LDATA_GROUND_DEPTH, LDATA_ROOT_DEPTH,                            &
00107                                 LDATA_ROOT_EXTINCTION, LDATA_ROOT_LIN
00108 !
00109 USE MODI_AV_PGD_PARAM
00110 USE MODI_AV_PGD
00111 USE MODI_SOIL_ALBEDO
00112 !
00113 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00114 USE PARKIND1  ,ONLY : JPRB
00115 !
00116 IMPLICIT NONE
00117 !
00118 !*    0.1    Declaration of arguments
00119 !            ------------------------
00120 !
00121  CHARACTER(LEN=*),       INTENT(IN)    :: HISBA   ! type of soil (Force-Restore OR Diffusion)
00122 INTEGER,                INTENT(IN)    :: KDECADE
00123 INTEGER,                INTENT(IN)    :: KDECADE2
00124 REAL, DIMENSION(:,:),   INTENT(IN)    :: PCOVER
00125  CHARACTER(LEN=*),       INTENT(IN)    :: HPHOTO  ! type of photosynthesis
00126 LOGICAL,                INTENT(IN)    :: OAGRIP
00127  CHARACTER(LEN=*),       INTENT(IN)    :: HSFTYPE ! nature / garden
00128 !
00129 REAL, DIMENSION(:,:),   OPTIONAL, INTENT(IN)   :: PWG1
00130 !
00131 REAL, DIMENSION(:)  ,   OPTIONAL, INTENT(IN)    :: PSOILGRID
00132 REAL, DIMENSION(:,:),   OPTIONAL, INTENT(OUT)   :: PVEG
00133 REAL, DIMENSION(:,:),   OPTIONAL, INTENT(OUT)   :: PLAI
00134 REAL, DIMENSION(:,:),   OPTIONAL, INTENT(OUT)   :: PRSMIN
00135 REAL, DIMENSION(:,:),   OPTIONAL, INTENT(OUT)   :: PGAMMA
00136 REAL, DIMENSION(:,:),   OPTIONAL, INTENT(OUT)   :: PWRMAX_CF
00137 REAL, DIMENSION(:,:),   OPTIONAL, INTENT(OUT)   :: PRGL
00138 REAL, DIMENSION(:,:),   OPTIONAL, INTENT(OUT)   :: PCV
00139 REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(OUT)   :: PDG
00140 INTEGER, DIMENSION(:,:),OPTIONAL, INTENT(OUT)   :: KWG_LAYER
00141 REAL, DIMENSION(:,:),   OPTIONAL, INTENT(OUT)   :: PDROOT
00142 REAL, DIMENSION(:,:),   OPTIONAL, INTENT(OUT)   :: PDG2
00143 REAL, DIMENSION(:,:),   OPTIONAL, INTENT(OUT)   :: PZ0
00144 REAL, DIMENSION(:,:),   OPTIONAL, INTENT(OUT)   :: PZ0_O_Z0H
00145 REAL, DIMENSION(:,:),   OPTIONAL, INTENT(OUT)   :: PALBNIR_VEG
00146 REAL, DIMENSION(:,:),   OPTIONAL, INTENT(OUT)   :: PALBVIS_VEG
00147 REAL, DIMENSION(:,:),   OPTIONAL, INTENT(OUT)   :: PALBUV_VEG
00148 REAL, DIMENSION(:,:),   OPTIONAL, INTENT(OUT)   :: PEMIS_ECO
00149 !
00150 REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT)   :: PVEGTYPE
00151 REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(OUT)   :: PROOTFRAC
00152 !
00153 REAL, DIMENSION(:,:),   OPTIONAL, INTENT(OUT)   :: PGMES
00154 REAL, DIMENSION(:,:),   OPTIONAL, INTENT(OUT)   :: PBSLAI
00155 REAL, DIMENSION(:,:),   OPTIONAL, INTENT(OUT)   :: PLAIMIN
00156 REAL, DIMENSION(:,:),   OPTIONAL, INTENT(OUT)   :: PSEFOLD
00157 REAL, DIMENSION(:,:),   OPTIONAL, INTENT(OUT)   :: PGC
00158 REAL, DIMENSION(:,:),   OPTIONAL, INTENT(OUT)   :: PDMAX
00159 REAL, DIMENSION(:,:),   OPTIONAL, INTENT(OUT)   :: PF2I
00160 LOGICAL, DIMENSION(:,:),OPTIONAL, INTENT(OUT)   :: OSTRESS
00161 !
00162 REAL, DIMENSION(:,:),   OPTIONAL, INTENT(OUT)   :: PH_TREE
00163 REAL, DIMENSION(:,:),   OPTIONAL, INTENT(OUT)   :: PRE25
00164 !
00165 REAL, DIMENSION(:,:),   OPTIONAL, INTENT(OUT)   :: PCE_NITRO
00166 REAL, DIMENSION(:,:),   OPTIONAL, INTENT(OUT)   :: PCF_NITRO
00167 REAL, DIMENSION(:,:),   OPTIONAL, INTENT(OUT)   :: PCNA_NITRO
00168 REAL, DIMENSION(:,:),   OPTIONAL, INTENT(OUT)   :: PD_ICE
00169 REAL, DIMENSION(:,:),   OPTIONAL, INTENT(OUT)   :: PALBNIR_SOIL
00170 REAL, DIMENSION(:,:),   OPTIONAL, INTENT(OUT)   :: PALBVIS_SOIL
00171 REAL, DIMENSION(:,:),   OPTIONAL, INTENT(OUT)   :: PALBUV_SOIL
00172 !
00173 TYPE(DATE_TIME), DIMENSION(:,:),   OPTIONAL, INTENT(OUT)   :: TPSEED
00174 TYPE(DATE_TIME), DIMENSION(:,:),   OPTIONAL, INTENT(OUT)   :: TPREAP
00175 !
00176 REAL, DIMENSION(:,:),   OPTIONAL, INTENT(OUT)   :: PWATSUP
00177 REAL, DIMENSION(:,:),   OPTIONAL, INTENT(OUT)   :: PIRRIG
00178 !
00179 !*    0.2    Declaration of local variables
00180 !            ------------------------------
00181 !
00182  CHARACTER(LEN=3)  :: YTREE, YNAT, YLAI, YVEG, YBAR, YDIF
00183 !
00184 INTEGER               :: JLAYER    ! loop counter on layers
00185 INTEGER               :: JVEGTYPE  ! loop counter on vegtypes
00186 !
00187 !*    0.3    Declaration of namelists
00188 !            ------------------------
00189 !
00190 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00191 !-------------------------------------------------------------------------------
00192 !
00193 !*    1.      Initializations
00194 !             ---------------
00195 !
00196 IF (LHOOK) CALL DR_HOOK('CONVERT_PATCH_ISBA',0,ZHOOK_HANDLE)
00197 !
00198 IF (HSFTYPE=='NAT') THEN
00199   YNAT='NAT'
00200   YTREE='TRE'
00201   YLAI='LAI'
00202   YVEG='VEG'
00203   YBAR='BAR'
00204   YDIF='DVG'
00205 ELSEIF (HSFTYPE=='GRD') THEN
00206   YNAT='GRD'
00207   YTREE='GRT'
00208   YLAI='GRL'
00209   YVEG='GRV'
00210   YBAR='GRB'
00211   YDIF='GDV'
00212 ENDIF
00213 !
00214 !
00215 ! vegtypes fraction
00216 ! -----------------
00217 !
00218 IF (PRESENT(PVEGTYPE)) THEN
00219   IF (LDATA_VEGTYPE) THEN
00220     PVEGTYPE=XPAR_VEGTYPE
00221   ELSE
00222     !classical ecoclimap case
00223     DO JVEGTYPE=1,NVEGTYPE
00224       CALL AV_PGD (PVEGTYPE(:,JVEGTYPE),PCOVER ,XDATA_VEGTYPE(:,JVEGTYPE),YNAT,'ARI')
00225     END DO
00226   ENDIF
00227 ENDIF
00228 !
00229 !   VEG
00230 !   ----
00231 IF (PRESENT(PVEG)) THEN
00232   IF (LDATA_VEG) THEN
00233     CALL AV_PGD_PARAM(PVEG,XPAR_VEGTYPE,XPAR_VEG(:,KDECADE2,:),YNAT,'ARI')
00234   ELSE
00235     CALL AV_PGD (PVEG,PCOVER,XDATA_VEG(:,KDECADE,:),YNAT,'ARI')
00236   ENDIF
00237 ENDIF
00238 !
00239 !   LAI
00240 !   ----
00241 IF (PRESENT(PLAI)) THEN
00242   IF (LDATA_LAI) THEN
00243     CALL AV_PGD_PARAM(PLAI,XPAR_VEGTYPE,XPAR_LAI(:,KDECADE2,:),YVEG,'ARI',KDECADE=KDECADE2)
00244   ELSE
00245     CALL AV_PGD(PLAI,PCOVER,XDATA_LAI(:,KDECADE,:),YVEG,'ARI',KDECADE=KDECADE)
00246   ENDIF
00247 ENDIF
00248 !
00249 !           EMIS
00250 !           ----
00251 !emis needs VEG by vegtypes is changed at this step
00252 IF (PRESENT(PEMIS_ECO)) THEN    
00253   IF (LDATA_EMIS) THEN
00254     CALL AV_PGD_PARAM(PEMIS_ECO,XPAR_VEGTYPE,XPAR_EMIS(:,KDECADE2,:),YNAT,'ARI')
00255   ELSE
00256     CALL AV_PGD (PEMIS_ECO ,PCOVER ,XDATA_EMIS_ECO (:,KDECADE,:),YNAT,'ARI')
00257   ENDIF
00258 ENDIF
00259 !
00260 !    Z0V
00261 !    ----
00262 IF (PRESENT(PZ0)) THEN
00263   IF (LDATA_Z0) THEN
00264     CALL AV_PGD_PARAM(PZ0,XPAR_VEGTYPE,XPAR_Z0(:,KDECADE2,:),YNAT,'CDN')
00265   ELSE
00266     CALL AV_PGD (PZ0 ,PCOVER ,XDATA_Z0 (:,KDECADE,:),YNAT,'CDN')
00267   ENDIF
00268 ENDIF
00269 !
00270 !* soil layers and root fraction
00271 !  -----------------------------
00272 !
00273 IF ( PRESENT(PDG)) THEN
00274   !
00275   !   compute soil layers (and root fraction if DIF)
00276   !
00277   CALL SET_GRID_PARAM(SIZE(PDG,1),SIZE(PDG,2),SIZE(PDG,3),PRESENT(PDG2),&
00278                       PRESENT(PDROOT),PRESENT(KWG_LAYER),PRESENT(PROOTFRAC))
00279   !    
00280 ENDIF
00281 !
00282 !        D ICE
00283 !        -----
00284 !
00285 IF (PRESENT(PD_ICE).AND.HISBA/='DIF') THEN
00286   IF (LDATA_DICE) THEN
00287     CALL AV_PGD_PARAM(PD_ICE,XPAR_VEGTYPE,XPAR_DICE,YNAT,'ARI')
00288   ELSE
00289     CALL AV_PGD (PD_ICE,PCOVER,XDATA_DICE(:,:),YNAT,'ARI')
00290   ENDIF
00291 ENDIF
00292 
00293 !
00294 !        Other parameters
00295 !        ----------------
00296 IF (PRESENT(PRSMIN)) THEN
00297   IF( SIZE(PRSMIN)>0) THEN
00298     IF (LDATA_RSMIN) THEN
00299       CALL AV_PGD_PARAM(PRSMIN,XPAR_VEGTYPE,XPAR_RSMIN,YLAI,'INV',KDECADE=KDECADE2)
00300     ELSE
00301       CALL AV_PGD (PRSMIN,PCOVER,XDATA_RSMIN,YLAI,'INV',KDECADE=KDECADE)  
00302     ENDIF
00303   ENDIF
00304 ENDIF
00305 
00306 IF (PRESENT(PGAMMA)) THEN
00307   IF (LDATA_GAMMA) THEN
00308     CALL AV_PGD_PARAM(PGAMMA,XPAR_VEGTYPE,XPAR_GAMMA,YVEG,'ARI',KDECADE=KDECADE2)
00309   ELSE
00310     CALL AV_PGD (PGAMMA,PCOVER,XDATA_GAMMA,YVEG,'ARI',KDECADE=KDECADE)  
00311   ENDIF
00312 ENDIF
00313 
00314 IF (PRESENT(PWRMAX_CF)) THEN
00315   IF (LDATA_WRMAX_CF) THEN
00316     CALL AV_PGD_PARAM(PWRMAX_CF,XPAR_VEGTYPE,XPAR_WRMAX_CF,YVEG,'ARI',KDECADE=KDECADE2)
00317   ELSE
00318     CALL AV_PGD (PWRMAX_CF,PCOVER,XDATA_WRMAX_CF,YVEG,'ARI',KDECADE=KDECADE)  
00319   ENDIF
00320 ENDIF
00321 
00322 IF (PRESENT(PRGL)) THEN
00323   IF (LDATA_RGL) THEN
00324     CALL AV_PGD_PARAM(PRGL,XPAR_VEGTYPE,XPAR_RGL,YVEG,'ARI',KDECADE=KDECADE2)
00325   ELSE
00326     CALL AV_PGD (PRGL,PCOVER,XDATA_RGL,YVEG,'ARI',KDECADE=KDECADE)  
00327   ENDIF
00328 ENDIF
00329 
00330 IF (PRESENT(PCV)) THEN
00331   IF (LDATA_CV) THEN
00332     CALL AV_PGD_PARAM(PCV,XPAR_VEGTYPE,XPAR_CV,YVEG,'INV',KDECADE=KDECADE2)
00333   ELSE
00334     CALL AV_PGD (PCV,PCOVER,XDATA_CV,YVEG,'INV',KDECADE=KDECADE)  
00335   ENDIF
00336 ENDIF
00337 
00338 IF (PRESENT(PZ0_O_Z0H)) THEN
00339   IF (LDATA_Z0_O_Z0H) THEN
00340     CALL AV_PGD_PARAM(PZ0_O_Z0H,XPAR_VEGTYPE,XPAR_Z0_O_Z0H,YNAT,'ARI')
00341   ELSE
00342     CALL AV_PGD (PZ0_O_Z0H,PCOVER,XDATA_Z0_O_Z0H,YNAT,'ARI')
00343   ENDIF
00344 ENDIF
00345 !
00346 IF (PRESENT(PALBNIR_VEG)) THEN
00347   IF (LDATA_ALBNIR_VEG) THEN
00348     CALL AV_PGD_PARAM(PALBNIR_VEG,XPAR_VEGTYPE,XPAR_ALBNIR_VEG,YVEG,'ARI',KDECADE=KDECADE2)
00349   ELSEIF (CALBEDO=='CM13') THEN
00350     CALL AV_PGD (PALBNIR_VEG,PCOVER,XDATA_ALB_VEG_NIR(:,KDECADE,:),YVEG,'ARI',KDECADE=KDECADE)    
00351   ELSE
00352     CALL AV_PGD (PALBNIR_VEG,PCOVER,XDATA_ALBNIR_VEG,YVEG,'ARI',KDECADE=KDECADE)  
00353   ENDIF
00354 ENDIF
00355 !
00356 IF (PRESENT(PALBVIS_VEG)) THEN
00357   IF (LDATA_ALBVIS_VEG) THEN
00358     CALL AV_PGD_PARAM(PALBVIS_VEG,XPAR_VEGTYPE,XPAR_ALBVIS_VEG,YVEG,'ARI',KDECADE=KDECADE2)
00359   ELSEIF (CALBEDO=='CM13') THEN
00360     CALL AV_PGD (PALBVIS_VEG,PCOVER,XDATA_ALB_VEG_VIS(:,KDECADE,:),YVEG,'ARI',KDECADE=KDECADE)      
00361   ELSE
00362     CALL AV_PGD (PALBVIS_VEG,PCOVER,XDATA_ALBVIS_VEG,YVEG,'ARI',KDECADE=KDECADE)  
00363   ENDIF
00364 ENDIF
00365 !
00366 IF (PRESENT(PALBUV_VEG)) THEN
00367   IF (LDATA_ALBUV_VEG) THEN
00368     CALL AV_PGD_PARAM(PALBUV_VEG,XPAR_VEGTYPE,XPAR_ALBUV_VEG,YVEG,'ARI',KDECADE=KDECADE2)
00369   ELSE
00370     CALL AV_PGD (PALBUV_VEG,PCOVER,XDATA_ALBUV_VEG,YVEG,'ARI',KDECADE=KDECADE)  
00371   ENDIF
00372 ENDIF
00373 !
00374 IF (HPHOTO/='NON') THEN
00375   !
00376   IF (PRESENT(PH_TREE)) THEN
00377     IF (LDATA_H_TREE) THEN
00378       CALL AV_PGD_PARAM(PH_TREE,XPAR_VEGTYPE,XPAR_H_TREE,YTREE,'ARI')
00379     ELSE
00380       CALL AV_PGD (PH_TREE,PCOVER,XDATA_H_TREE(:,:),YTREE,'ARI')
00381     ENDIF
00382   ENDIF
00383   !
00384   IF (PRESENT(PRE25)) THEN
00385     IF (SIZE(PRE25)>0) THEN
00386       IF (LDATA_RE25) THEN
00387         CALL AV_PGD_PARAM(PRE25,XPAR_VEGTYPE,XPAR_RE25,YNAT,'ARI')      
00388       ELSE
00389         CALL AV_PGD (PRE25,PCOVER,XDATA_RE25,YNAT,'ARI')  
00390       ENDIF
00391     ENDIF
00392   ENDIF
00393   !
00394   IF (PRESENT(PLAIMIN)) THEN
00395     IF (SIZE(PLAIMIN)>0) THEN
00396       IF (LDATA_LAIMIN) THEN
00397         CALL AV_PGD_PARAM(PLAIMIN,XPAR_VEGTYPE,XPAR_LAIMIN,YVEG,'ARI',KDECADE=KDECADE2)
00398       ELSE
00399         CALL AV_PGD (PLAIMIN,PCOVER,XDATA_LAIMIN,YVEG,'ARI',KDECADE=KDECADE)  
00400       ENDIF
00401     ENDIF
00402   ENDIF        
00403   !
00404   IF (PRESENT(PBSLAI)) THEN
00405     IF( SIZE(PBSLAI)>0) THEN
00406       IF (LDATA_BSLAI) THEN
00407         CALL AV_PGD_PARAM(PBSLAI,XPAR_VEGTYPE,XPAR_BSLAI,YVEG,'ARI',KDECADE=KDECADE2)
00408       ELSE
00409         IF (HPHOTO == 'AST' .OR. HPHOTO == 'LST' .OR. HPHOTO == 'NIT' .OR. HPHOTO == 'NCB') THEN
00410           CALL AV_PGD (PBSLAI,PCOVER,XDATA_BSLAI_ST,YVEG,'ARI',KDECADE=KDECADE)  
00411         ELSE
00412           CALL AV_PGD (PBSLAI,PCOVER,XDATA_BSLAI,YVEG,'ARI',KDECADE=KDECADE)
00413         ENDIF
00414       ENDIF
00415     ENDIF
00416   ENDIF
00417   !  
00418   IF (PRESENT(PSEFOLD)) THEN
00419     IF (SIZE(PSEFOLD)>0) THEN
00420       IF (LDATA_SEFOLD) THEN
00421         CALL AV_PGD_PARAM(PSEFOLD,XPAR_VEGTYPE,XPAR_SEFOLD,YVEG,'ARI',KDECADE=KDECADE2)
00422       ELSE
00423         IF (HPHOTO == 'AST' .OR. HPHOTO == 'LST' .OR. HPHOTO == 'NIT' .OR. HPHOTO == 'NCB') THEN
00424           CALL AV_PGD (PSEFOLD,PCOVER,XDATA_SEFOLD_ST,YVEG,'ARI',KDECADE=KDECADE)  
00425         ELSE
00426           CALL AV_PGD (PSEFOLD,PCOVER,XDATA_SEFOLD,YVEG,'ARI',KDECADE=KDECADE)
00427         ENDIF
00428       ENDIF
00429     ENDIF
00430   ENDIF
00431   !
00432   IF (PRESENT(PGMES)) THEN
00433     IF ( SIZE(PGMES)>0) THEN
00434       IF (LDATA_GMES) THEN
00435         CALL AV_PGD_PARAM(PGMES,XPAR_VEGTYPE,XPAR_GMES,YVEG,'ARI',KDECADE=KDECADE2)
00436       ELSE
00437         IF (HPHOTO == 'AST' .OR. HPHOTO == 'LST' .OR. HPHOTO == 'NIT' .OR. HPHOTO == 'NCB') THEN
00438           CALL AV_PGD (PGMES,PCOVER,XDATA_GMES_ST,YVEG,'ARI',KDECADE=KDECADE)  
00439         ELSE
00440           CALL AV_PGD (PGMES,PCOVER,XDATA_GMES,YVEG,'ARI',KDECADE=KDECADE)
00441         ENDIF
00442       ENDIF
00443     ENDIF
00444   ENDIF
00445   !
00446   IF (PRESENT(PGC)) THEN
00447     IF ( SIZE(PGC)>0) THEN
00448       IF (LDATA_GC) THEN
00449         CALL AV_PGD_PARAM(PGC,XPAR_VEGTYPE,XPAR_GC,YVEG,'ARI',KDECADE=KDECADE2)
00450       ELSE
00451         IF (HPHOTO == 'AST' .OR. HPHOTO == 'LST' .OR. HPHOTO == 'NIT' .OR. HPHOTO == 'NCB') THEN
00452           CALL AV_PGD (PGC,PCOVER,XDATA_GC_ST,YVEG,'ARI',KDECADE=KDECADE)  
00453         ELSE
00454           CALL AV_PGD (PGC,PCOVER,XDATA_GC,YVEG,'ARI',KDECADE=KDECADE)
00455         ENDIF
00456       ENDIF
00457     ENDIF
00458   ENDIF
00459   !
00460   IF (HPHOTO/='AGS' .AND. HPHOTO/='LAI') THEN
00461     !
00462     IF (PRESENT(PF2I)) THEN
00463       IF (SIZE(PF2I)>0) THEN
00464         IF (LDATA_F2I) THEN
00465           CALL AV_PGD_PARAM(PF2I,XPAR_VEGTYPE,XPAR_F2I,YVEG,'ARI',KDECADE=KDECADE2)
00466         ELSE
00467           CALL AV_PGD (PF2I,PCOVER,XDATA_F2I,YVEG,'ARI',KDECADE=KDECADE)  
00468         ENDIF
00469       ENDIF
00470     ENDIF
00471     !
00472     IF (PRESENT(PDMAX)) THEN
00473       IF (SIZE(PDMAX)>0) THEN
00474         IF (LDATA_DMAX) THEN
00475           CALL AV_PGD_PARAM(PDMAX,XPAR_VEGTYPE,XPAR_DMAX,YTREE,'ARI')
00476         ELSE
00477           IF (HPHOTO == 'AST' .OR. HPHOTO == 'LST' .OR. HPHOTO == 'NIT' .OR. HPHOTO == 'NCB') THEN
00478             CALL AV_PGD (PDMAX,PCOVER,XDATA_DMAX_ST,YTREE,'ARI')  
00479           ELSE
00480             CALL AV_PGD (PDMAX,PCOVER,XDATA_DMAX,YTREE,'ARI')
00481           ENDIF
00482         ENDIF
00483       ENDIF
00484     ENDIF
00485     !
00486     IF (HPHOTO=='NIT' .OR. HPHOTO=='NCB') THEN
00487       !
00488       IF (PRESENT(PCE_NITRO)) THEN
00489         IF (SIZE(PCE_NITRO)>0) THEN
00490           IF (LDATA_CE_NITRO) THEN
00491             CALL AV_PGD_PARAM(PCE_NITRO,XPAR_VEGTYPE,XPAR_CE_NITRO,YVEG,'ARI',KDECADE=KDECADE2)
00492           ELSE
00493             CALL AV_PGD (PCE_NITRO,PCOVER,XDATA_CE_NITRO,YVEG,'ARI',KDECADE=KDECADE)  
00494           ENDIF
00495         ENDIF
00496       ENDIF
00497       !
00498       IF (PRESENT(PCF_NITRO)) THEN
00499         IF (SIZE(PCF_NITRO)>0) THEN
00500           IF (LDATA_CF_NITRO) THEN
00501             CALL AV_PGD_PARAM(PCF_NITRO,XPAR_VEGTYPE,XPAR_CF_NITRO,YVEG,'ARI',KDECADE=KDECADE2)
00502           ELSE
00503             CALL AV_PGD (PCF_NITRO,PCOVER,XDATA_CF_NITRO,YVEG,'ARI',KDECADE=KDECADE)  
00504           ENDIF
00505         ENDIF
00506       ENDIF
00507       !
00508       IF (PRESENT(PCNA_NITRO)) THEN
00509         IF (SIZE(PCNA_NITRO)>0) THEN
00510           IF (LDATA_CNA_NITRO) THEN
00511             CALL AV_PGD_PARAM(PCNA_NITRO,XPAR_VEGTYPE,XPAR_CNA_NITRO,YVEG,'ARI',KDECADE=KDECADE2)
00512           ELSE
00513             CALL AV_PGD (PCNA_NITRO,PCOVER,XDATA_CNA_NITRO,YVEG,'ARI',KDECADE=KDECADE)  
00514           ENDIF
00515         ENDIF
00516       ENDIF
00517       !
00518     ENDIF
00519   ENDIF
00520 ENDIF
00521 !
00522 IF ((HPHOTO == 'LAI' .OR. HPHOTO == 'LST' .OR. HPHOTO == 'NIT' .OR. HPHOTO=='NCB') .AND. OAGRIP)  THEN
00523   !
00524   ! date of seeding
00525   ! ---------------
00526   !
00527   IF (PRESENT(TPSEED)) THEN
00528      IF(SIZE(TPSEED)>0) THEN
00529       CALL AV_PGD (TPSEED ,PCOVER ,TDATA_SEED(:,:),YVEG,'MAJ',KDECADE=KDECADE)  
00530      ENDIF
00531   END IF
00532   !
00533   ! date of reaping
00534   ! ---------------
00535   !
00536   IF (PRESENT(TPREAP)) THEN
00537     IF (SIZE(TPREAP)>0) THEN
00538       CALL AV_PGD (TPREAP ,PCOVER ,TDATA_REAP(:,:),YVEG,'MAJ',KDECADE=KDECADE)  
00539     ENDIF
00540   END IF
00541   !
00542   IF (PRESENT(PIRRIG)) THEN 
00543     IF (SIZE(PIRRIG)>0) THEN
00544       IF (LDATA_IRRIG) THEN
00545         CALL AV_PGD_PARAM(PIRRIG,XPAR_VEGTYPE,XPAR_IRRIG(:,KDECADE2,:),YVEG,'ARI',KDECADE=KDECADE2)
00546       ELSE
00547         CALL AV_PGD (PIRRIG,PCOVER,XDATA_IRRIG,YVEG,'ARI',KDECADE=KDECADE)  
00548       ENDIF
00549     ENDIF
00550   ENDIF
00551 
00552   IF (PRESENT(PWATSUP)) THEN  
00553     IF (SIZE(PWATSUP)>0) THEN
00554       IF (LDATA_WATSUP) THEN
00555         CALL AV_PGD_PARAM(PWATSUP,XPAR_VEGTYPE,XPAR_WATSUP(:,KDECADE2,:),YVEG,'ARI',KDECADE=KDECADE2)
00556       ELSE
00557         CALL AV_PGD (PWATSUP,PCOVER,XDATA_WATSUP,YVEG,'ARI',KDECADE=KDECADE)  
00558       ENDIF
00559     ENDIF
00560   ENDIF
00561 
00562 ENDIF
00563 !
00564 IF (PRESENT(PALBNIR_SOIL)) THEN
00565   IF (LDATA_ALBNIR_SOIL) THEN
00566     CALL AV_PGD_PARAM(PALBNIR_SOIL,XPAR_VEGTYPE,XPAR_ALBNIR_SOIL,YBAR,'ARI',KDECADE=KDECADE2)
00567   ELSEIF (CALBEDO=='CM13') THEN
00568     CALL AV_PGD (PALBNIR_SOIL,PCOVER,XDATA_ALB_SOIL_NIR(:,KDECADE,:),YBAR,'ARI',KDECADE=KDECADE)
00569   ELSE
00570     CALL SOIL_ALBEDO (CALBEDO, XWSAT(:,1),PWG1, XALBVIS_DRY,XALBNIR_DRY,XALBUV_DRY,     &
00571                       XALBVIS_WET,XALBNIR_WET,XALBUV_WET, PALBNIR_SOIL=PALBNIR_SOIL )
00572   ENDIF
00573 ENDIF
00574 !
00575 IF (PRESENT(PALBVIS_SOIL)) THEN
00576   IF (LDATA_ALBVIS_SOIL) THEN
00577     CALL AV_PGD_PARAM(PALBVIS_SOIL,XPAR_VEGTYPE,XPAR_ALBVIS_SOIL,YBAR,'ARI',KDECADE=KDECADE2)
00578   ELSEIF (CALBEDO=='CM13') THEN
00579     CALL AV_PGD (PALBVIS_SOIL,PCOVER,XDATA_ALB_SOIL_VIS(:,KDECADE,:),YBAR,'ARI',KDECADE=KDECADE)    
00580   ELSE
00581    CALL SOIL_ALBEDO (CALBEDO, XWSAT(:,1),PWG1, XALBVIS_DRY,XALBVIS_DRY,XALBUV_DRY,     &
00582                      XALBVIS_WET,XALBNIR_WET,XALBUV_WET, PALBVIS_SOIL=PALBVIS_SOIL )
00583   ENDIF
00584 ENDIF
00585 !
00586 IF (PRESENT(PALBUV_SOIL)) THEN
00587   IF (LDATA_ALBUV_SOIL) THEN
00588     CALL AV_PGD_PARAM(PALBUV_SOIL,XPAR_VEGTYPE,XPAR_ALBUV_SOIL,YNAT,'ARI',KDECADE=KDECADE2)
00589   ELSE
00590     CALL SOIL_ALBEDO (CALBEDO, XWSAT(:,1),PWG1, XALBVIS_DRY,XALBUV_DRY,XALBUV_DRY,     &
00591                       XALBVIS_WET,XALBNIR_WET,XALBUV_WET,PALBUV_SOIL=PALBUV_SOIL )
00592   ENDIF
00593 ENDIF
00594 !
00595 !       STRESS
00596 !       --------
00597 IF (PRESENT(OSTRESS)) THEN
00598   IF (SIZE(OSTRESS)>0) THEN
00599     CALL SET_STRESS(SIZE(OSTRESS,1),SIZE(OSTRESS,2))      
00600   ENDIF
00601 ENDIF
00602 !
00603 IF (LHOOK) CALL DR_HOOK('CONVERT_PATCH_ISBA',1,ZHOOK_HANDLE)
00604 !
00605 !-------------------------------------------------------------------------------
00606 CONTAINS
00607 !-------------------------------------------------------------------------------
00608 !
00609 SUBROUTINE SET_STRESS(KSIZE1,KSIZE2)
00610 !
00611 IMPLICIT NONE
00612 !
00613 INTEGER, INTENT(IN) :: KSIZE1
00614 INTEGER, INTENT(IN) :: KSIZE2
00615 !
00616 REAL, DIMENSION(KSIZE1,KSIZE2)   :: ZWORK
00617 REAL, DIMENSION(KSIZE1,NVEGTYPE) :: ZSTRESS
00618 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00619 !
00620 IF (LHOOK) CALL DR_HOOK('CONVERT_PATCH_ISBA:SET_STRESS',0,ZHOOK_HANDLE)
00621 !
00622 IF (LDATA_STRESS) THEN
00623   ZSTRESS(:,:)=0.
00624   DO JVEGTYPE=1,NVEGTYPE
00625     WHERE (LPAR_STRESS(:,JVEGTYPE)) ZSTRESS(:,JVEGTYPE)=1.
00626   ENDDO
00627   CALL AV_PGD_PARAM(ZWORK,XPAR_VEGTYPE,ZSTRESS,YVEG,'ARI',KDECADE=KDECADE2)
00628 ELSE
00629   CALL AV_PGD (ZWORK,PCOVER,XDATA_STRESS(:,:),YVEG,'ARI',KDECADE=KDECADE)
00630 ENDIF
00631 !
00632 WHERE (ZWORK(:,:)<0.5)
00633   OSTRESS(:,:) = .FALSE.
00634 ELSEWHERE
00635   OSTRESS(:,:) = .TRUE.
00636 END WHERE
00637 !
00638 IF (LHOOK) CALL DR_HOOK('CONVERT_PATCH_ISBA:SET_STRESS',1,ZHOOK_HANDLE)
00639 END SUBROUTINE SET_STRESS
00640 !
00641 !-------------------------------------------------------------------------------
00642 SUBROUTINE SET_GRID_PARAM(KNI,KGROUND,KPATCH,LDG2,LDROOT,LWG_LAYER,LROOTFRAC)
00643 !
00644 USE MODD_SURF_PAR,       ONLY : XUNDEF, NUNDEF
00645 !
00646 USE MODI_INI_DATA_ROOTFRAC
00647 USE MODI_INI_DATA_SOIL
00648 USE MODI_PERMAFROST_DEPTH
00649 USE MODI_ABOR1_SFX
00650 !
00651 IMPLICIT NONE
00652 !
00653 REAL, PARAMETER     :: ZPREC=1.0E+6
00654 !
00655 INTEGER, INTENT(IN) :: KNI
00656 INTEGER, INTENT(IN) :: KGROUND
00657 INTEGER, INTENT(IN) :: KPATCH
00658 LOGICAL, INTENT(IN) :: LDG2
00659 LOGICAL, INTENT(IN) :: LDROOT
00660 LOGICAL, INTENT(IN) :: LWG_LAYER
00661 LOGICAL, INTENT(IN) :: LROOTFRAC
00662 !
00663 REAL, DIMENSION (KNI,KGROUND,KPATCH) :: ZROOTFRAC
00664 REAL, DIMENSION (KNI,KPATCH) :: ZDTOT, ZDG2, ZROOT_EXT, ZROOT_LIN, ZWORK_EXT
00665 !--------------waiting for new vegtypes-----------------------------------!
00666 REAL, DIMENSION (NDIM,NVEGTYPE)   :: ZPAR_ROOT_EXTINCTION
00667 REAL, DIMENSION (SIZE(XDATA_ROOT_EXTINCTION,1),NVEGTYPE) :: ZDATA_ROOT_EXTINCTION
00668 !--------------waiting for new vegtypes-----------------------------------!
00669 INTEGER, DIMENSION(KNI,KPATCH) :: IWG_LAYER
00670 INTEGER :: JJ, JL, JPATCH
00671 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00672 !
00673 IF (LHOOK) CALL DR_HOOK('CONVERT_PATCH_ISBA:SET_GRID_PARAM',0,ZHOOK_HANDLE)
00674 !
00675 IF(HISBA=='DIF')THEN
00676   IF(.NOT.LWG_LAYER) CALL ABOR1_SFX('CONVERT_PATCH_ISBA: SET_GRID_PARAM: KWG_LAYER must be present with DIF')
00677   IF(.NOT.LDROOT   ) CALL ABOR1_SFX('CONVERT_PATCH_ISBA: SET_GRID_PARAM:  PDROOT must be present with DIF')
00678   IF(.NOT.LDG2     ) CALL ABOR1_SFX('CONVERT_PATCH_ISBA: SET_GRID_PARAM: PDG2 must be present with DIF')   
00679 ENDIF
00680 !
00681 ZROOTFRAC(:,:,:) = XUNDEF
00682 ZDTOT    (:,:) = XUNDEF
00683 ZDG2     (:,:) = XUNDEF
00684 IWG_LAYER(:,:) = NUNDEF
00685 !
00686 !DG IN NAMELIST => GROUND_DEPTH KNOWN, ROOT_DEPTH UNKNOWN 
00687 IF (LDATA_DG) THEN
00688   !
00689   DO JLAYER=1,KGROUND
00690     CALL AV_PGD_PARAM(PDG(:,JLAYER,:),XPAR_VEGTYPE,XPAR_DG(:,JLAYER,:),YNAT,'ARI')
00691   ENDDO
00692   !
00693 ENDIF
00694 !
00695 !CALCULATION OF GROUND_DEPTH IN ZDTOT : ECOCLIMAP OR LDATA_GROUND_DEPTH
00696 IF (HISBA/='2-L') THEN 
00697   !
00698   IF (LDATA_GROUND_DEPTH .AND. (HISBA=='DIF' .OR. .NOT.LDATA_DG)) THEN
00699     !GROUND DEPTH IN NAMELIST
00700     CALL AV_PGD_PARAM(ZDTOT(:,:),XPAR_VEGTYPE,XPAR_GROUND_DEPTH(:,:),YNAT,'ARI')
00701     !Error Due to machine precision
00702     WHERE(ZDTOT(:,:)/=XUNDEF)
00703           ZDTOT(:,:)=INT(ZDTOT(:,:)*ZPREC)/ZPREC
00704     ENDWHERE
00705     !CONSISTENCY CHECK
00706     IF (LDATA_DG) ZDTOT(:,:) = MIN(ZDTOT(:,:),PDG(:,KGROUND,:))
00707   ELSEIF (LDATA_DG) THEN
00708     !GROUND DEPTH FROM NAMELIST DG
00709     ZDTOT(:,:) = PDG(:,KGROUND,:)
00710   ELSE
00711     !GROUND DEPTH FROM ECOCLIMAP
00712     CALL AV_PGD (ZDTOT(:,:),PCOVER,XDATA_GROUND_DEPTH(:,:),YNAT,'ARI')
00713   ENDIF
00714   !
00715 ENDIF
00716 !
00717 !CALCULATION OF GROUND_DEPTH : Permafrost depth put to 12m
00718 IF(HISBA=='DIF'.AND.LPERM)THEN
00719   CALL PERMAFROST_DEPTH(KNI,KPATCH,XPERM,ZDTOT)
00720 ENDIF
00721 !
00722 !IN BOTH CASES, ROOT_DEPTH IS NEEDED: PUT IN DG2
00723 IF (HISBA=='DIF' .OR. .NOT.LDATA_DG) THEN
00724   !
00725   IF ( LDATA_ROOT_DEPTH .AND. .NOT.LDATA_ROOTFRAC ) THEN
00726     !ROOT_DEPTH IN NAMELIST
00727     CALL AV_PGD_PARAM(ZDG2(:,:),XPAR_VEGTYPE,XPAR_ROOT_DEPTH(:,:),YNAT,'ARI')
00728     !Error Due to machine precision
00729     WHERE(ZDG2(:,:)/=XUNDEF)
00730           ZDG2(:,:)=INT(ZDG2(:,:)*ZPREC)/ZPREC
00731     ENDWHERE    
00732     !CONSISTENCY CHECKS
00733     IF (LDATA_DG) ZDG2(:,:) = MIN(ZDG2(:,:),PDG(:,KGROUND,:))
00734     ZDTOT(:,:) = MAX(ZDG2(:,:),ZDTOT(:,:))
00735     IF (HISBA=='DIF') THEN
00736       CALL AV_PGD_PARAM(PDROOT(:,:),XPAR_VEGTYPE,XPAR_ROOT_DEPTH(:,:),YDIF,'ARI')
00737      !Error Due to machine precision
00738       WHERE(PDROOT(:,:)/=XUNDEF)
00739           PDROOT(:,:)=INT(PDROOT(:,:)*ZPREC)/ZPREC
00740       ENDWHERE      
00741      !CONSISTENCY CHECKS
00742       IF (LDATA_DG) WHERE (PDROOT(:,:).NE.XUNDEF) PDROOT(:,:) = MIN(PDROOT(:,:),PDG(:,KGROUND,:))   
00743     ENDIF
00744   ELSE 
00745     !ROOT_DEPTH FROM ECOCLIMAP
00746     CALL AV_PGD (ZDG2(:,:),PCOVER,XDATA_ROOT_DEPTH(:,:),YNAT,'ARI')  
00747     IF (HISBA=='DIF') CALL AV_PGD (PDROOT(:,:),PCOVER,XDATA_ROOT_DEPTH(:,:),YDIF,'ARI')
00748     IF ( LDATA_GROUND_DEPTH .OR. LDATA_DG ) THEN
00749       ZDG2  (:,:) = MIN(ZDG2  (:,:),ZDTOT(:,:))
00750       IF (HISBA=='DIF') WHERE (PDROOT(:,:).NE.XUNDEF) PDROOT(:,:) = MIN(PDROOT(:,:),ZDTOT(:,:))
00751     ENDIF
00752   ENDIF
00753   !
00754   !CALCULATION OF DG IF NOT IN NAMELIST
00755   IF (.NOT.LDATA_DG) THEN
00756     !
00757     IF (HISBA=='DIF') THEN
00758       IF( MAXVAL(ZDTOT,ZDTOT/=XUNDEF)>PSOILGRID(KGROUND) ) THEN
00759         CALL ABOR1_SFX('CONVERT_PATCH_ISBA: not enough soil layer with optimized grid')
00760       ENDIF
00761     ENDIF
00762     !
00763     WHERE(ZDG2(:,:)==XUNDEF.AND.ZDTOT(:,:)/=XUNDEF) ZDG2(:,:)=0.0 !No vegetation
00764     !
00765     !IF CISBA=DIF CALCULATES ALSO KWG_LAYER WITH USE OF SOILGRID $
00766     CALL INI_DATA_SOIL(HISBA, PDG,PROOTDEPTH=ZDG2, PSOILDEPTH=ZDTOT,&
00767                        PSOILGRID=PSOILGRID, KWG_LAYER=IWG_LAYER )
00768     !
00769   ELSEIF ( HISBA=='DIF') THEN
00770     !
00771     !CALCULATION OF KWG_LAYER IF DG IN NAMELIST
00772     IF(LDATA_GROUND_DEPTH)THEN
00773       DO JPATCH=1,KPATCH
00774         DO JJ=1,KNI
00775           DO JL=1,KGROUND
00776             IF( PDG(JJ,JL,JPATCH) <= ZDTOT(JJ,JPATCH) .AND. ZDTOT(JJ,JPATCH) < XUNDEF ) &
00777                 IWG_LAYER(JJ,JPATCH) = JL
00778           ENDDO
00779         ENDDO
00780       ENDDO                
00781     ELSE
00782       IWG_LAYER(:,:) = KGROUND
00783     ENDIF
00784     !
00785   ENDIF
00786   !
00787   ! DROOT AND DG2 LIMITED BY KWG_LAYER
00788   IF (HISBA=='DIF' .AND. .NOT.LDATA_ROOTFRAC) THEN
00789     !
00790     DO JPATCH=1,KPATCH
00791       DO JJ=1,KNI
00792         IF(IWG_LAYER(JJ,JPATCH)/=NUNDEF) THEN
00793           JL = IWG_LAYER(JJ,JPATCH)
00794           ZDG2  (JJ,JPATCH)=MIN(ZDG2  (JJ,JPATCH),PDG(JJ,JL,JPATCH))
00795           IF (PDROOT(JJ,JPATCH)/=XUNDEF) PDROOT(JJ,JPATCH)=MIN(PDROOT(JJ,JPATCH),PDG(JJ,JL,JPATCH))    
00796         ENDIF
00797       ENDDO
00798     ENDDO
00799     !
00800   ENDIF
00801   !
00802 ENDIF
00803 !
00804 !CALCULATION OF ROOTFRAC
00805 IF (HISBA=='DIF') THEN
00806   !
00807   IF (LDATA_ROOTFRAC .AND. (LDG2 .OR. LDROOT .OR. LROOTFRAC)) THEN
00808     !
00809     !ROOTFRAC IN NAMELIST
00810     DO JL=1,KGROUND
00811       CALL AV_PGD_PARAM(ZROOTFRAC(:,JL,:),XPAR_VEGTYPE,XPAR_ROOTFRAC(:,JL,:),YNAT,'ARI')
00812     ENDDO
00813     IF (LROOTFRAC) PROOTFRAC(:,:,:) = ZROOTFRAC(:,:,:)
00814     !    
00815     ZDG2  (:,:)=0.0
00816     PDROOT(:,:)=0.0    
00817     DO JPATCH=1,KPATCH
00818       DO JJ=1,KNI
00819         !
00820         !DROOT DEPENDS ON ROOTFRAC
00821         DO JL=KGROUND,1,-1
00822           IF( ZROOTFRAC(JJ,JL,JPATCH)>=1.0 )THEN
00823             ZDG2  (JJ,JPATCH) = PDG(JJ,JL,JPATCH)
00824             PDROOT(JJ,JPATCH) = PDG(JJ,JL,JPATCH)
00825           ELSEIF (JL<KGROUND.AND.ZROOTFRAC(JJ,JL,JPATCH)>0.0) THEN
00826             IF (IWG_LAYER(JJ,JPATCH)<=JL) IWG_LAYER(JJ,JPATCH) = JL+1
00827             EXIT
00828           ENDIF
00829         ENDDO
00830         !
00831         IF(PDROOT(JJ,JPATCH)==0.0.AND.ZDG2(JJ,JPATCH)==0.0)THEN
00832           JL=IWG_LAYER(JJ,JPATCH)
00833           ZDG2(JJ,JPATCH)=MIN(0.6,PDG(JJ,JL,JPATCH))
00834         ENDIF
00835         !
00836       ENDDO
00837     ENDDO
00838     !
00839   ELSEIF (LROOTFRAC) THEN
00840     !
00841     !DEPENDS ON DROOT
00842     IF (LDATA_ROOT_EXTINCTION) THEN
00843       CALL AV_PGD_PARAM(ZROOT_EXT(:,:),XPAR_VEGTYPE,XPAR_ROOT_EXTINCTION(:,:),YDIF,'ARI')
00844     ELSE
00845       CALL AV_PGD (ZROOT_EXT(:,:),PCOVER,XDATA_ROOT_EXTINCTION(:,:),YDIF,'ARI')
00846     ENDIF
00847     !--------------waiting for new vegtypes-----------------------------------!
00848     !Jackson parameter for tundra
00849     IF(LPERM)THEN
00850       IF (LDATA_ROOT_EXTINCTION) THEN
00851         ZPAR_ROOT_EXTINCTION(:,:)       =XPAR_ROOT_EXTINCTION(:,:)
00852         ZPAR_ROOT_EXTINCTION(:,NVT_GRAS)=0.914
00853         CALL AV_PGD_PARAM(ZWORK_EXT(:,:),XPAR_VEGTYPE,ZPAR_ROOT_EXTINCTION(:,:),YDIF,'ARI')
00854       ELSE
00855         ZDATA_ROOT_EXTINCTION(:,:)       =XDATA_ROOT_EXTINCTION(:,:)
00856         ZDATA_ROOT_EXTINCTION(:,NVT_GRAS)=0.914
00857         CALL AV_PGD (ZWORK_EXT(:,:),PCOVER,ZDATA_ROOT_EXTINCTION(:,:),YDIF,'ARI')
00858       ENDIF        
00859       DO JPATCH=1,KPATCH
00860         DO JJ=1,KNI
00861            IF(XPERM(JJ)>=0.25.AND.ZROOT_EXT(JJ,JPATCH)/=XUNDEF)THEN
00862               ZROOT_EXT(JJ,JPATCH)=ZWORK_EXT(JJ,JPATCH)
00863            ENDIF
00864         ENDDO
00865       ENDDO
00866     ENDIF
00867     !--------------waiting for new vegtypes-----------------------------------!
00868     IF (LDATA_ROOT_LIN) THEN
00869       CALL AV_PGD_PARAM(ZROOT_LIN(:,:),XPAR_VEGTYPE,XPAR_ROOT_LIN(:,:),YDIF,'ARI')
00870     ELSE
00871       CALL AV_PGD (ZROOT_LIN(:,:),PCOVER,XDATA_ROOT_LIN(:,:),YDIF,'ARI')
00872     ENDIF
00873     !
00874     CALL INI_DATA_ROOTFRAC(PDG,PDROOT,ZROOT_EXT,ZROOT_LIN,PROOTFRAC)
00875     !
00876   ENDIF
00877   !
00878   IF (LDG2)      PDG2     (:,:) = ZDG2     (:,:)
00879   IF (LWG_LAYER) KWG_LAYER(:,:) = IWG_LAYER(:,:)
00880   !
00881 ENDIF
00882 !     
00883 IF (LHOOK) CALL DR_HOOK('CONVERT_PATCH_ISBA:SET_GRID_PARAM',1,ZHOOK_HANDLE)
00884 !
00885 END SUBROUTINE SET_GRID_PARAM
00886 !
00887 !-------------------------------------------------------------------------------
00888 END SUBROUTINE CONVERT_PATCH_ISBA