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

Go to the documentation of this file.
00001 !     #########
00002       SUBROUTINE CONVERT_COVER_ISBA   (HISBA,KDECADE,PCOVER,HPHOTO,          &
00003                                          HSFTYPE,PVEG,                       &
00004                                          PLAI,PRSMIN,PGAMMA,PWRMAX_CF,       &
00005                                          PRGL,PCV,PSOILGRID,PPERM,           &
00006                                          PDG,KWG_LAYER,PDROOT,PDG2,          &
00007                                          PD_ICE,PZ0,PZ0_O_Z0H,               &
00008                                          PALBNIR_VEG,PALBVIS_VEG,PALBUV_VEG, &
00009                                          PEMIS_ECO,                          &
00010                                          PVEGTYPE,PROOTFRAC,                 &
00011                                          PGMES,PBSLAI,PLAIMIN,PSEFOLD,PGC,   &
00012                                          PDMAX, PF2I, OSTRESS, PH_TREE,PRE25,&
00013                                          PCE_NITRO, PCF_NITRO, PCNA_NITRO,   &
00014                                          TPSEED, TPREAP, PWATSUP, PIRRIG     )  
00015 !     ##############################################################
00016 !
00017 !!**** *CONVERT_COVER* convert surface cover classes into secondary 
00018 !!                     physiographic variables for ISBA
00019 !!
00020 !!    PURPOSE
00021 !!    -------
00022 !!
00023 !!    METHOD
00024 !!    ------
00025 !!   
00026 !!    EXTERNAL
00027 !!    --------
00028 !!
00029 !!    IMPLICIT ARGUMENTS
00030 !!    ------------------
00031 !!
00032 !!    REFERENCE
00033 !!    ---------
00034 !!
00035 !!    AUTHOR
00036 !!    ------
00037 !!
00038 !!    V. Masson        Meteo-France
00039 !!
00040 !!    MODIFICATION
00041 !!    ------------
00042 !!
00043 !!    Original   01/2004
00044 !!    
00045 !!      P Le Moigne 09/2005 AGS modifs of L. Jarlan
00046 !----------------------------------------------------------------------------
00047 !
00048 !*    0.     DECLARATION
00049 !            -----------
00050 !
00051 USE MODD_DATA_COVER,     ONLY : XDATA_LAI, XDATA_H_TREE, XDATA_VEGTYPE,   &
00052                                   XDATA_VEG, XDATA_Z0, XDATA_Z0_O_Z0H,    &
00053                                   XDATA_EMIS_ECO, XDATA_GAMMA, XDATA_CV,  &
00054                                   XDATA_RGL, XDATA_RSMIN,                 &
00055                                   XDATA_ALBNIR_VEG, XDATA_ALBVIS_VEG,     &
00056                                   XDATA_ALBUV_VEG, XDATA_DICE,            &
00057                                   XDATA_ALB_VEG_NIR, XDATA_ALB_VEG_VIS,   &
00058                                   XDATA_ALB_SOIL_NIR, XDATA_ALB_SOIL_VIS, &                                  
00059                                   XDATA_GMES, XDATA_BSLAI, XDATA_LAIMIN,  &
00060                                   XDATA_SEFOLD, XDATA_GC, XDATA_WRMAX_CF, &
00061                                   XDATA_STRESS,                           &
00062                                   XDATA_DMAX, XDATA_F2I, XDATA_RE25,      &
00063                                   XDATA_CE_NITRO, XDATA_CF_NITRO,         &
00064                                   XDATA_CNA_NITRO,                        &
00065                                   XDATA_GMES_ST, XDATA_BSLAI_ST,          &
00066                                   XDATA_SEFOLD_ST, XDATA_GC_ST,           &
00067                                   XDATA_DMAX_ST, XDATA_WATSUP,            &
00068                                   TDATA_SEED, TDATA_REAP,XDATA_IRRIG,     &
00069                                   XDATA_ROOT_DEPTH, XDATA_GROUND_DEPTH,   &
00070                                   XDATA_ROOT_EXTINCTION, XDATA_ROOT_LIN  
00071 
00072 USE MODD_DATA_COVER_PAR, ONLY : NVEGTYPE, JPCOVER
00073 USE MODD_TYPE_DATE_SURF
00074 !
00075 USE MODD_ISBA_n,         ONLY : CALBEDO
00076 !
00077 USE MODI_AV_PGD
00078 !
00079 !
00080 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00081 USE PARKIND1  ,ONLY : JPRB
00082 !
00083 IMPLICIT NONE
00084 !
00085 !*    0.1    Declaration of arguments
00086 !            ------------------------
00087 !
00088  CHARACTER(LEN=*),       INTENT(IN)    :: HISBA   ! type of soil (Force-Restore OR Diffusion)
00089 INTEGER,                INTENT(IN)    :: KDECADE
00090 REAL, DIMENSION(:,:),   INTENT(IN)    :: PCOVER
00091  CHARACTER(LEN=*),       INTENT(IN)    :: HPHOTO  ! type of photosynthesis
00092  CHARACTER(LEN=*),       INTENT(IN)    :: HSFTYPE ! nature / garden
00093 !
00094 REAL, DIMENSION(:)  ,   OPTIONAL, INTENT(IN)    :: PSOILGRID
00095 REAL, DIMENSION(:)  ,   OPTIONAL, INTENT(IN)    :: PPERM
00096 REAL, DIMENSION(:,:),   OPTIONAL, INTENT(OUT)   :: PVEG
00097 REAL, DIMENSION(:,:),   OPTIONAL, INTENT(OUT)   :: PLAI
00098 REAL, DIMENSION(:,:),   OPTIONAL, INTENT(OUT)   :: PRSMIN
00099 REAL, DIMENSION(:,:),   OPTIONAL, INTENT(OUT)   :: PGAMMA
00100 REAL, DIMENSION(:,:),   OPTIONAL, INTENT(OUT)   :: PWRMAX_CF
00101 REAL, DIMENSION(:,:),   OPTIONAL, INTENT(OUT)   :: PRGL
00102 REAL, DIMENSION(:,:),   OPTIONAL, INTENT(OUT)   :: PCV
00103 REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(OUT)   :: PDG
00104 INTEGER, DIMENSION(:,:),OPTIONAL, INTENT(OUT)   :: KWG_LAYER
00105 REAL, DIMENSION(:,:),   OPTIONAL, INTENT(OUT)   :: PDROOT
00106 REAL, DIMENSION(:,:),   OPTIONAL, INTENT(OUT)   :: PDG2
00107 REAL, DIMENSION(:,:),   OPTIONAL, INTENT(OUT)   :: PD_ICE
00108 REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(OUT)   :: PROOTFRAC
00109 REAL, DIMENSION(:,:),   OPTIONAL, INTENT(OUT)   :: PZ0
00110 REAL, DIMENSION(:,:),   OPTIONAL, INTENT(OUT)   :: PZ0_O_Z0H
00111 REAL, DIMENSION(:,:),   OPTIONAL, INTENT(OUT)   :: PALBNIR_VEG
00112 REAL, DIMENSION(:,:),   OPTIONAL, INTENT(OUT)   :: PALBVIS_VEG
00113 REAL, DIMENSION(:,:),   OPTIONAL, INTENT(OUT)   :: PALBUV_VEG
00114 REAL, DIMENSION(:,:),   OPTIONAL, INTENT(OUT)   :: PEMIS_ECO
00115 !
00116 REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT)   :: PVEGTYPE
00117 !
00118 REAL, DIMENSION(:,:),   OPTIONAL, INTENT(OUT)   :: PGMES
00119 REAL, DIMENSION(:,:),   OPTIONAL, INTENT(OUT)   :: PRE25
00120 REAL, DIMENSION(:,:),   OPTIONAL, INTENT(OUT)   :: PBSLAI
00121 REAL, DIMENSION(:,:),   OPTIONAL, INTENT(OUT)   :: PLAIMIN
00122 REAL, DIMENSION(:,:),   OPTIONAL, INTENT(OUT)   :: PSEFOLD
00123 REAL, DIMENSION(:,:),   OPTIONAL, INTENT(OUT)   :: PGC
00124 REAL, DIMENSION(:,:),   OPTIONAL, INTENT(OUT)   :: PDMAX
00125 REAL, DIMENSION(:,:),   OPTIONAL, INTENT(OUT)   :: PF2I
00126 LOGICAL, DIMENSION(:,:),OPTIONAL, INTENT(OUT)   :: OSTRESS
00127 !
00128 REAL, DIMENSION(:,:),   OPTIONAL, INTENT(OUT)   :: PH_TREE
00129 !
00130 REAL, DIMENSION(:,:),   OPTIONAL, INTENT(OUT)   :: PCE_NITRO
00131 REAL, DIMENSION(:,:),   OPTIONAL, INTENT(OUT)   :: PCF_NITRO
00132 REAL, DIMENSION(:,:),   OPTIONAL, INTENT(OUT)   :: PCNA_NITRO
00133 !
00134 TYPE(DATE_TIME), DIMENSION(:,:),   OPTIONAL, INTENT(OUT)   :: TPSEED
00135 TYPE(DATE_TIME), DIMENSION(:,:),   OPTIONAL, INTENT(OUT)   :: TPREAP
00136 !
00137 REAL, DIMENSION(:,:),   OPTIONAL, INTENT(OUT)   :: PWATSUP
00138 REAL, DIMENSION(:,:),   OPTIONAL, INTENT(OUT)   :: PIRRIG
00139 !
00140 !*    0.2    Declaration of local variables
00141 !            ------------------------------
00142 ! calculation of veg from lai in the pixel
00143 !
00144 REAL, DIMENSION (:,:), ALLOCATABLE           :: ZWORK      ! work array
00145 !
00146  CHARACTER(LEN=3)  :: YTREE, YNAT, YLAI, YVEG, YDIF
00147 !
00148 INTEGER :: JLAYER ! loop counter on surface layers
00149 INTEGER :: JVEG   ! loop counter on vegetation types
00150 !
00151 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00152 !-------------------------------------------------------------------------------
00153 !
00154 !*    2.      SECONDARY VARIABLES
00155 !             -------------------
00156 !
00157 IF (LHOOK) CALL DR_HOOK('CONVERT_COVER_ISBA',0,ZHOOK_HANDLE)
00158 IF (HSFTYPE=='NAT') THEN
00159   YNAT='NAT'
00160   YTREE='TRE'
00161   YLAI='LAI'
00162   YVEG='VEG'
00163   YDIF='DVG'
00164 ELSEIF (HSFTYPE=='GRD') THEN
00165   YNAT='GRD'
00166   YTREE='GRT'
00167   YLAI='GRL'
00168   YVEG='GRV'
00169   YDIF='GDV'
00170 ENDIF
00171 !
00172 !*    2.1     fields on natural surfaces only, taking into account patches/ 
00173 !             -------------------------------
00174 !
00175 !
00176 IF (PRESENT(PH_TREE)) &
00177   CALL AV_PGD (PH_TREE ,PCOVER ,XDATA_H_TREE (:,:) ,YTREE,'ARI')  
00178 !
00179 DO JVEG=1,NVEGTYPE
00180   IF (PRESENT(PVEGTYPE)) &
00181     CALL AV_PGD (PVEGTYPE(:,JVEG),PCOVER ,XDATA_VEGTYPE(:,JVEG),YNAT,'ARI')  
00182 END DO
00183 !
00184 ! vegetation fraction
00185 ! -------------------
00186 !
00187 IF (PRESENT(PVEG)) &
00188   CALL AV_PGD (PVEG ,PCOVER ,XDATA_VEG (:,KDECADE,:),YNAT,'ARI')  
00189 !
00190 ! Leaf Aera Index
00191 ! ---------------
00192 !
00193 IF (PRESENT(PLAI)) &
00194   CALL AV_PGD (PLAI ,PCOVER ,XDATA_LAI (:,KDECADE,:),YVEG,'ARI',KDECADE=KDECADE)  
00195 !
00196 ! roughness length
00197 ! ----------------
00198 !
00199 IF (PRESENT(PZ0)) &
00200   CALL AV_PGD (PZ0 ,PCOVER ,XDATA_Z0 (:,KDECADE,:),YNAT,'CDN')  
00201 !
00202 IF (PRESENT(PZ0_O_Z0H)) &
00203   CALL AV_PGD (PZ0_O_Z0H ,PCOVER ,XDATA_Z0_O_Z0H (:,:),YNAT,'ARI')  
00204 !
00205 !
00206 !emis-eco
00207 !--------
00208 !
00209 IF (PRESENT(PEMIS_ECO)) &
00210   CALL AV_PGD (PEMIS_ECO ,PCOVER ,XDATA_EMIS_ECO (:,KDECADE,:),YNAT,'ARI')  
00211 ! 
00212 !---------------------------------------------------------------------------------
00213 ! 
00214 !* 1/Rsmin
00215 !
00216 IF (PRESENT(PRSMIN)) THEN
00217   IF (SIZE(PRSMIN)>0) &
00218     CALL AV_PGD (PRSMIN,PCOVER ,XDATA_RSMIN,YLAI,'INV',KDECADE=KDECADE)  
00219 END IF
00220 !
00221 !* other vegetation parameters
00222 !
00223 IF (PRESENT(PGAMMA)) &
00224   CALL AV_PGD (PGAMMA     ,PCOVER ,XDATA_GAMMA   (:,:),YVEG,'ARI',KDECADE=KDECADE)  
00225 IF (PRESENT(PWRMAX_CF)) &
00226   CALL AV_PGD (PWRMAX_CF  ,PCOVER ,XDATA_WRMAX_CF(:,:),YVEG,'ARI',KDECADE=KDECADE)  
00227 !
00228 !
00229 IF (PRESENT(PRGL)) &
00230   CALL AV_PGD (PRGL       ,PCOVER ,XDATA_RGL   (:,:),YVEG,'ARI',KDECADE=KDECADE)  
00231 IF (PRESENT(PCV)) &
00232   CALL AV_PGD (PCV        ,PCOVER ,XDATA_CV    (:,:),YVEG,'INV',KDECADE=KDECADE)  
00233 !
00234 !---------------------------------------------------------------------------------
00235 !
00236 !* soil layers
00237 !  -----------
00238 !
00239 IF (PRESENT(PDG)) THEN
00240 !
00241 !* soil layers (and cumulative root fraction for DIF only)
00242 !
00243   CALL SET_COVER_DG(SIZE(PDG,1),SIZE(PDG,2),SIZE(PDG,3),PRESENT(PPERM),&
00244                    PRESENT(PDG2),PRESENT(PDROOT),PRESENT(KWG_LAYER),   &
00245                    PRESENT(PROOTFRAC)                                  )
00246 !
00247 END IF
00248 !
00249 !---------------------------------------------------------------------------------
00250 !
00251 !* soil ice for runoff
00252 !  -------------------
00253 !
00254 IF (PRESENT(PD_ICE)) &
00255  CALL AV_PGD (PD_ICE,PCOVER ,XDATA_DICE(:,:),YNAT,'ARI')
00256 !
00257 !---------------------------------------------------------------------------------
00258 !
00259 IF (PRESENT(PALBNIR_VEG)) THEN
00260   IF (CALBEDO=='CM13') THEN
00261     CALL AV_PGD (PALBVIS_VEG,PCOVER,XDATA_ALB_VEG_NIR(:,KDECADE,:),YVEG,'ARI',KDECADE=KDECADE)      
00262   ELSE   
00263     CALL AV_PGD (PALBNIR_VEG,PCOVER ,XDATA_ALBNIR_VEG(:,:),YVEG,'ARI',KDECADE=KDECADE)  
00264   ENDIF
00265 ENDIF
00266 !
00267 IF (PRESENT(PALBVIS_VEG)) THEN
00268   IF (CALBEDO=='CM13') THEN
00269     CALL AV_PGD (PALBVIS_VEG,PCOVER,XDATA_ALB_VEG_VIS(:,KDECADE,:),YVEG,'ARI',KDECADE=KDECADE)      
00270   ELSE     
00271     CALL AV_PGD (PALBVIS_VEG,PCOVER ,XDATA_ALBVIS_VEG(:,:),YVEG,'ARI',KDECADE=KDECADE)  
00272   ENDIF
00273 ENDIF
00274 !
00275 IF (PRESENT(PALBUV_VEG)) &
00276   CALL AV_PGD (PALBUV_VEG, PCOVER ,XDATA_ALBUV_VEG (:,:),YVEG,'ARI',KDECADE=KDECADE)
00277 !  
00278 ! parameters for "stress option"
00279 IF (HPHOTO == 'AST' .OR. HPHOTO == 'LST' .OR. HPHOTO == 'NIT' .OR.  HPHOTO == 'NCB')  THEN
00280 
00281    IF (PRESENT(PGMES)) THEN
00282      IF (SIZE(PGMES)>0) &
00283        CALL AV_PGD (PGMES  ,PCOVER ,XDATA_GMES_ST  (:,:),YVEG,'ARI',KDECADE=KDECADE)  
00284    END IF
00285 
00286    IF (PRESENT(PBSLAI)) THEN
00287      IF (SIZE(PBSLAI)>0) &
00288        CALL AV_PGD (PBSLAI ,PCOVER ,XDATA_BSLAI_ST (:,:),YVEG,'ARI',KDECADE=KDECADE)  
00289    END IF
00290 
00291    IF (PRESENT(PSEFOLD)) THEN
00292      IF (SIZE(PSEFOLD)>0) &
00293        CALL AV_PGD (PSEFOLD,PCOVER ,XDATA_SEFOLD_ST(:,:),YVEG,'ARI',KDECADE=KDECADE)  
00294    END IF
00295 
00296    IF (PRESENT(PGC)) THEN
00297      IF (SIZE(PGC)>0) &
00298        CALL AV_PGD (PGC    ,PCOVER ,XDATA_GC_ST    (:,:),YVEG,'ARI',KDECADE=KDECADE)  
00299    END IF
00300 
00301    IF (PRESENT(PDMAX)) THEN
00302      IF (SIZE(PDMAX)>0) &
00303        CALL AV_PGD (PDMAX  ,PCOVER ,XDATA_DMAX_ST  (:,:),YTREE,'ARI',KDECADE=KDECADE)  
00304    END IF
00305 
00306 ELSE
00307 
00308    IF (PRESENT(PGMES)) THEN
00309      IF (SIZE(PGMES)>0) &
00310        CALL AV_PGD (PGMES  ,PCOVER ,XDATA_GMES  (:,:),YVEG,'ARI',KDECADE=KDECADE)  
00311    END IF
00312 
00313    IF (PRESENT(PBSLAI)) THEN
00314      IF (SIZE(PBSLAI)>0) &
00315        CALL AV_PGD (PBSLAI ,PCOVER ,XDATA_BSLAI (:,:),YVEG,'ARI',KDECADE=KDECADE)  
00316    END IF
00317 
00318    IF (PRESENT(PSEFOLD)) THEN
00319      IF (SIZE(PSEFOLD)>0) &
00320        CALL AV_PGD (PSEFOLD,PCOVER ,XDATA_SEFOLD(:,:),YVEG,'ARI',KDECADE=KDECADE)  
00321    END IF
00322 
00323    IF (PRESENT(PGC)) THEN
00324      IF (SIZE(PGC)>0) &
00325        CALL AV_PGD (PGC    ,PCOVER ,XDATA_GC    (:,:),YVEG,'ARI',KDECADE=KDECADE)  
00326    END IF
00327 
00328    IF (PRESENT(PDMAX)) THEN
00329      IF (SIZE(PDMAX)>0) &
00330        CALL AV_PGD (PDMAX  ,PCOVER ,XDATA_DMAX  (:,:),YTREE,'ARI',KDECADE=KDECADE)  
00331    END IF
00332 
00333 ENDIF
00334 
00335 IF (PRESENT(PRE25)) THEN
00336   IF (SIZE(PRE25)>0) &
00337     CALL AV_PGD (PRE25  ,PCOVER ,XDATA_RE25  (:,:),YNAT,'ARI')  
00338 END IF
00339 
00340 IF (PRESENT(PLAIMIN)) THEN
00341   IF (SIZE(PLAIMIN)>0) &
00342     CALL AV_PGD (PLAIMIN,PCOVER ,XDATA_LAIMIN(:,:),YVEG,'ARI',KDECADE=KDECADE)  
00343 END IF
00344 
00345 IF (PRESENT(PCE_NITRO)) THEN
00346   IF (SIZE(PCE_NITRO)>0) &
00347     CALL AV_PGD (PCE_NITRO  ,PCOVER ,XDATA_CE_NITRO  (:,:),YVEG,'ARI',KDECADE=KDECADE)  
00348 END IF
00349 
00350 IF (PRESENT(PCF_NITRO)) THEN
00351   IF (SIZE(PCF_NITRO)>0) &
00352     CALL AV_PGD (PCF_NITRO  ,PCOVER ,XDATA_CF_NITRO  (:,:),YVEG,'ARI',KDECADE=KDECADE)  
00353 END IF
00354 
00355 IF (PRESENT(PCNA_NITRO)) THEN
00356   IF (SIZE(PCNA_NITRO)>0) &
00357     CALL AV_PGD (PCNA_NITRO  ,PCOVER ,XDATA_CNA_NITRO(:,:),YVEG,'ARI',KDECADE=KDECADE)  
00358 END IF
00359 
00360 IF (PRESENT(PF2I)) THEN
00361   IF (SIZE(PF2I)>0) &
00362     CALL AV_PGD (PF2I   ,PCOVER ,XDATA_F2I   (:,:),YVEG,'ARI',KDECADE=KDECADE)  
00363 END IF
00364 !
00365 IF (PRESENT(OSTRESS)) THEN
00366   IF (SIZE(OSTRESS)>0) THEN
00367     ALLOCATE(ZWORK(SIZE(OSTRESS,1),SIZE(OSTRESS,2)))
00368     CALL AV_PGD (ZWORK,PCOVER ,XDATA_STRESS(:,:),YVEG,'ARI',KDECADE=KDECADE)
00369     WHERE (ZWORK<0.5) 
00370       OSTRESS = .FALSE.
00371     ELSEWHERE
00372       OSTRESS = .TRUE.
00373     END WHERE
00374     DEALLOCATE(ZWORK)
00375   END IF
00376 END IF
00377 !
00378 IF (HPHOTO == 'LAI' .OR. HPHOTO == 'LST' .OR. HPHOTO == 'NIT')  THEN
00379    !
00380    ! date of seeding
00381    ! ---------------
00382    !
00383    IF (PRESENT(TPSEED)) THEN
00384      IF (SIZE(TPSEED)>0) &
00385        CALL AV_PGD (TPSEED ,PCOVER ,TDATA_SEED(:,:),YVEG,'MAJ',KDECADE=KDECADE)  
00386    END IF
00387    !
00388    ! date of reaping
00389    ! ---------------
00390    !
00391    IF (PRESENT(TPREAP)) THEN
00392      IF (SIZE(TPREAP)>0) &
00393        CALL AV_PGD (TPREAP ,PCOVER ,TDATA_REAP(:,:),YVEG,'MAJ',KDECADE=KDECADE)  
00394    END IF
00395    !
00396    ! fraction of irrigated surface
00397    ! ---------------------------
00398    !
00399    IF (PRESENT(PIRRIG)) THEN
00400      IF (SIZE(PIRRIG)>0) &
00401        CALL AV_PGD (PIRRIG ,PCOVER ,XDATA_IRRIG(:,:),YVEG,'ARI',KDECADE=KDECADE)  
00402    END IF
00403    !
00404    ! water supply for irrigation
00405    ! ---------------------------
00406    !
00407    IF (PRESENT(PWATSUP)) THEN
00408      IF (SIZE(PWATSUP)>0) &
00409        CALL AV_PGD (PWATSUP ,PCOVER ,XDATA_WATSUP(:,:),YVEG,'ARI',KDECADE=KDECADE)  
00410    END IF
00411 !
00412 END IF
00413 IF (LHOOK) CALL DR_HOOK('CONVERT_COVER_ISBA',1,ZHOOK_HANDLE)
00414 !
00415 !-------------------------------------------------------------------------------
00416 CONTAINS
00417 !-------------------------------------------------------------------------------
00418 !
00419 SUBROUTINE SET_COVER_DG(KNI,KGROUND,KPATCH,LPERM,LDG2,LDROOT,LWG_LAYER,LROOTFRAC)
00420 !
00421 USE MODD_SURF_PAR, ONLY : XUNDEF
00422 USE MODD_DATA_COVER_n,   ONLY : XDATA_NATURE, XDATA_GARDEN
00423 !
00424 USE MODI_INI_DATA_ROOTFRAC
00425 USE MODI_INI_DATA_SOIL
00426 USE MODI_PERMAFROST_DEPTH
00427 !
00428 IMPLICIT NONE
00429 !
00430 INTEGER, INTENT(IN) :: KNI
00431 INTEGER, INTENT(IN) :: KGROUND
00432 INTEGER, INTENT(IN) :: KPATCH
00433 LOGICAL, INTENT(IN) :: LPERM
00434 LOGICAL, INTENT(IN) :: LDG2
00435 LOGICAL, INTENT(IN) :: LDROOT
00436 LOGICAL, INTENT(IN) :: LWG_LAYER
00437 LOGICAL, INTENT(IN) :: LROOTFRAC
00438 !
00439 REAL, DIMENSION (SIZE(XDATA_ROOT_DEPTH,1),3,SIZE(XDATA_ROOT_DEPTH,2)):: ZDATA_DG
00440 !
00441 INTEGER, DIMENSION (KNI,KPATCH) :: IWG_LAYER
00442 REAL, DIMENSION (KNI,KPATCH) :: ZDTOT, ZDROOT      !  work array
00443 REAL, DIMENSION (KNI,KPATCH) :: ZROOT_EXT  !        "
00444 REAL, DIMENSION (KNI,KPATCH) :: ZROOT_LIN  !        "
00445 REAL, DIMENSION (KNI)        :: ZPERM
00446 !
00447 INTEGER :: JPATCH, JJ
00448 !
00449 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00450 !
00451 IF (LHOOK) CALL DR_HOOK('CONVERT_COVER_ISBA:SET_COVER_DG',0,ZHOOK_HANDLE)
00452 !
00453 IF(HISBA/='DIF')THEN
00454   !  
00455   CALL INI_DATA_SOIL(HISBA, ZDATA_DG,                             &
00456                      PSURF      = XDATA_NATURE,                   &
00457                      PSURF2     = XDATA_GARDEN,                   &
00458                      PROOTDEPTH = XDATA_ROOT_DEPTH,               &
00459                      PSOILDEPTH = XDATA_GROUND_DEPTH              )
00460   !
00461   DO JLAYER=1,KGROUND
00462      CALL AV_PGD (PDG(:,JLAYER,:),PCOVER,ZDATA_DG(:,JLAYER,:),YNAT,'ARI')
00463   ENDDO
00464   !
00465 ELSE
00466 !
00467   CALL AV_PGD (ZDTOT (:,:),PCOVER,XDATA_GROUND_DEPTH,YNAT,'ARI')
00468 !  
00469 ! CALCULATION OF GROUND_DEPTH over Permafrost area
00470   IF(LPERM)THEN
00471     CALL PERMAFROST_DEPTH(KNI,KPATCH,PPERM,ZDTOT)
00472   ENDIF
00473 !  
00474   IF (LDG2) CALL AV_PGD (PDG2  (:,:),PCOVER,XDATA_ROOT_DEPTH,YNAT,'ARI')
00475   IF (LDROOT .OR. LROOTFRAC) THEN
00476     CALL AV_PGD (ZDROOT(:,:),PCOVER,XDATA_ROOT_DEPTH,YDIF,'ARI')
00477     IF (LDROOT) PDROOT(:,:) = ZDROOT(:,:)
00478   ENDIF
00479 !
00480   CALL INI_DATA_SOIL(HISBA, PDG, PSOILDEPTH=ZDTOT, PSOILGRID=PSOILGRID, &
00481                      KWG_LAYER=IWG_LAYER  )
00482   IF (LWG_LAYER) KWG_LAYER(:,:) = IWG_LAYER(:,:)
00483 !
00484   IF (LROOTFRAC) THEN
00485 !      
00486     CALL AV_PGD (ZROOT_EXT(:,:),PCOVER,XDATA_ROOT_EXTINCTION(:,:),YDIF,'ARI')
00487     CALL AV_PGD (ZROOT_LIN(:,:),PCOVER,XDATA_ROOT_LIN(:,:),YDIF,'ARI')
00488     CALL INI_DATA_ROOTFRAC(PDG,PDROOT,ZROOT_EXT,ZROOT_LIN,PROOTFRAC)
00489 !
00490   ENDIF
00491 !
00492 ENDIF
00493 !
00494 IF (LHOOK) CALL DR_HOOK('CONVERT_COVER_ISBA:SET_COVER_DG',1,ZHOOK_HANDLE)
00495 END SUBROUTINE SET_COVER_DG
00496 !
00497 !-------------------------------------------------------------------------------
00498 !
00499 END SUBROUTINE CONVERT_COVER_ISBA