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

Go to the documentation of this file.
00001 !#############################################################
00002 SUBROUTINE INIT_TEB_GARDEN_PGD_n(HPROGRAM,HINIT, OREAD_PGD,KI, KSV, HSV, KVERSION, KBUGFIX, &
00003         PCO2, PRHOA)
00004 !#############################################################
00005 !
00006 !!****  *INIT_TEB_GARDEN_PGD_n* - routine to initialize ISBA
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 !!      A. Lemonsu  *Meteo France*      
00028 !!
00029 !!    MODIFICATIONS
00030 !!    -------------
00031 !!      Original    09/2009
00032 !-------------------------------------------------------------------------------
00033 !
00034 !*       0.    DECLARATIONS
00035 !              ------------
00036 !
00037 USE MODD_TYPE_DATE_SURF
00038 USE MODD_TYPE_SNOW
00039 !
00040 USE MODD_TEB_n,           ONLY: TTIME, XGARDEN
00041 USE MODD_TEB_VEG_n,       ONLY: CISBA, CPEDOTF, CPHOTO, CSCOND, LTR_ML, NNBIOMASS,  &
00042                                 CCPSURF, CKSAT, CSOC
00043 USE MODD_TEB_GARDEN_n,    ONLY: LSTRESS, XPCPS, XPLVTT, XPLSTT,                     &
00044                                 XCLAY, XSAND, XWWILT, XWFC, XWSAT,                  &
00045                                 XVEG, XRSMIN, XGAMMA, XRGL, XCV, XLAI,              &
00046                                 XDG, XZ0, XZ0_O_Z0H, XABC, XPOI,                    &
00047                                 XALBNIR_VEG, XALBVIS_VEG, XALBUV_VEG,               &
00048                                 XEMIS, XVEGTYPE, XGMES, XRE25, XBSLAI, XLAIMIN, XGC,&
00049                                 XDMAX, XF2I, XDG2, XDROOT, NWG_LAYER,               &
00050                                 XSEFOLD, XH_TREE, XWRMAX_CF, XDZG, XDZDIF,          &
00051                                 XALBNIR_DRY, XALBVIS_DRY, XALBUV_DRY,               &
00052                                 XALBNIR_WET, XALBVIS_WET, XALBUV_WET,               &
00053                                 XALBNIR_SOIL, XALBVIS_SOIL, XALBUV_SOIL,            &
00054                                 XALBNIR, XALBVIS, XALBUV,                           &
00055                                 XROOTFRAC,XRUNOFFD, XANMAX, XFZERO, XEPSO, XGAMM,   &
00056                                 XQDGAMM, XQDGMES, XT1GMES, XT2GMES, XAMAX, XQDAMAX, &
00057                                 XT1AMAX, XT2AMAX, XAH, XBH,              &
00058                                 XCGSAT, XC1SAT, XC2REF, XC3, XC4B, XACOEF, XPCOEF,  &
00059                                 XTAUICE, XACOEF, XPCOEF, XBCOEF, XCONDSAT, &
00060                                 XHCAPSOIL, XCONDDRY, XCONDSLD, XC4REF, XMPOTSAT,    &
00061                                 XTDEEP, XGAMMAT, NGROUND_LAYER, XSOILWGHT,          &
00062                                 XCE_NITRO, XCF_NITRO, NLAYER_HORT, NLAYER_DUN,      &
00063                                 XCNA_NITRO, XBSLAI_NITRO,                           &
00064                                 XD_ICE, XKSAT_ICE,                                  &
00065                                 LPAR_GARDEN      
00066 USE MODD_CH_TEB_n,        ONLY: CSV, CCH_NAMES, NBEQ, NSV_CHSBEG, NSV_CHSEND,       &
00067                                 CCHEM_SURF_FILE, NDSTEQ, NSV_DSTBEG, NSV_DSTEND,    &
00068                                 NSV_AERBEG, NSV_AEREND, NAEREQ, CDSTNAMES,          &
00069                                 CAER_NAMES, NSLTEQ, NSV_SLTBEG,                     &
00070                                 NSV_SLTEND, CSLTNAMES, CCH_DRY_DEP, LCH_BIO_FLUX 
00071                                 
00072 USE MODD_DATA_COVER_PAR,  ONLY: NVEGTYPE
00073 USE MODD_SURF_PAR,        ONLY: XUNDEF, NUNDEF
00074 
00075 USE MODD_SGH_PAR,         ONLY: NDIMTAB, XF_DECAY
00076 !
00077 USE MODI_GET_LUOUT
00078 USE MODI_ALLOCATE_TEB_GARDEN_PGD
00079 USE MODI_READ_PGD_TEB_GARDEN_n
00080 USE MODI_CONVERT_PATCH_GARDEN
00081 USE MODI_INIT_FROM_DATA_GRDN_n
00082 USE MODI_INIT_VEG_PGD_GARDEN_n
00083 USE MODI_EXP_DECAY_SOIL_DIF
00084 USE MODI_EXP_DECAY_SOIL_FR
00085 USE MODI_ABOR1_SFX
00086 !
00087 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00088 USE PARKIND1  ,ONLY : JPRB
00089 !
00090 IMPLICIT NONE
00091 !
00092 !*       0.1   Declarations of arguments
00093 !              -------------------------
00094 !
00095  CHARACTER(LEN=6),                   INTENT(IN)  :: HPROGRAM  ! program calling surf. schemes
00096  CHARACTER(LEN=3),                   INTENT(IN)  :: HINIT     ! choice of fields to initialize
00097 LOGICAL,                            INTENT(IN)  :: OREAD_PGD ! flag to read PGD fields in the file
00098 INTEGER,                            INTENT(IN)  :: KI        ! number of points
00099 INTEGER,                            INTENT(IN)  :: KSV       ! number of scalars
00100  CHARACTER(LEN=6), DIMENSION(KSV),   INTENT(IN)  :: HSV       ! name of all scalar variables
00101 INTEGER,                            INTENT(IN)  :: KVERSION  ! version number of the file being read
00102 INTEGER,                            INTENT(IN)  :: KBUGFIX
00103 REAL,             DIMENSION(KI),    INTENT(IN)  :: PCO2        ! CO2 concentration (kg/m3)
00104 REAL,             DIMENSION(KI),    INTENT(IN)  :: PRHOA       ! air density
00105 !
00106 !
00107 !
00108 !*       0.2   Declarations of local variables
00109 !              -------------------------------
00110 !
00111 INTEGER           :: JILU     ! loop increment
00112 INTEGER           :: ILUOUT   ! unit of output listing file
00113 !
00114 INTEGER           :: IDECADE  ! decade of simulation
00115 !
00116 INTEGER :: JVEGTYPE, JLAYER  ! loop counter on vegtypes
00117 !
00118 REAL, DIMENSION(KI)               :: ZF
00119 REAL, DIMENSION(KI)               :: ZWORK
00120 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00121 !
00122 !-------------------------------------------------------------------------------
00123 !
00124 !               Initialisation for IO
00125 !
00126 IF (LHOOK) CALL DR_HOOK('INIT_TEB_GARDEN_PGD_n',0,ZHOOK_HANDLE)
00127  CALL GET_LUOUT(HPROGRAM,ILUOUT)
00128 !
00129 !-------------------------------------------------------------------------------
00130 !
00131 !*       2.     Physiographic fields
00132 !               --------------------
00133 !
00134 !* allocation of urban green area variables
00135 !
00136  CALL ALLOCATE_TEB_GARDEN_PGD(OREAD_PGD, KI, NVEGTYPE, NGROUND_LAYER, NDIMTAB)  
00137 !
00138 !
00139 !*       2.1    Cover, soil and orographic fields:
00140 !               ---------------------------------
00141 !
00142 IF (OREAD_PGD) &
00143  CALL READ_PGD_TEB_GARDEN_n(HPROGRAM,KVERSION,KBUGFIX)
00144 !
00145 !
00146 !*       2.3    Physiographic data fields from land cover:
00147 !               -----------------------------------------
00148 !
00149 IF (TTIME%TDATE%MONTH /= NUNDEF) THEN
00150   IDECADE = 3 * ( TTIME%TDATE%MONTH - 1 ) + MIN(TTIME%TDATE%DAY-1,29) / 10 + 1
00151 ELSE
00152   IDECADE = 1
00153 END IF
00154 !
00155 !
00156 IF (.NOT. LPAR_GARDEN) THEN
00157   CALL CONVERT_PATCH_GARDEN(KI,IDECADE)
00158 ELSE
00159  CALL INIT_FROM_DATA_GRDN_n(IDECADE,CPHOTO,                     &
00160                             XVEG,                               &
00161                             XLAI,XRSMIN,XGAMMA,XWRMAX_CF,       &
00162                             XRGL,XCV,XDG,XD_ICE,XZ0,XZ0_O_Z0H,  &
00163                             XALBNIR_VEG,XALBVIS_VEG,            &
00164                             XALBUV_VEG,XEMIS,                   &
00165                             XVEGTYPE,XROOTFRAC,                 &
00166                             XGMES,XBSLAI,XLAIMIN,XSEFOLD,XGC,   &
00167                             XDMAX, XF2I, LSTRESS, XH_TREE,XRE25,&
00168                             XCE_NITRO,XCF_NITRO,XCNA_NITRO      )  
00169 
00170   IF (CISBA=='DIF') THEN
00171     WHERE(XGARDEN(:)/=0.)
00172       NWG_LAYER(:)=NGROUND_LAYER 
00173       XDG2  (:)=0.0
00174       XDROOT(:)=0.0
00175     ENDWHERE
00176     DO JLAYER=NGROUND_LAYER,1,-1
00177       DO JILU=1,KI
00178         IF(XGARDEN(JILU)/=0..AND.XROOTFRAC(JILU,JLAYER)>=1.0)THEN
00179           XDG2  (JILU)=XDG(JILU,JLAYER)
00180           XDROOT(JILU)=XDG(JILU,JLAYER)
00181         ENDIF
00182       ENDDO
00183     ENDDO
00184   ENDIF
00185 
00186 END IF
00187 !
00188 
00189 WHERE (XGARDEN(:)==0.)
00190   XVEG(:)=0.
00191   XLAI(:)=0.
00192   XRSMIN(:)=40.
00193   XGAMMA(:)=0.
00194   XWRMAX_CF(:)=0.2
00195   XRGL(:)=100.
00196   XCV(:)=2.E-5
00197   XZ0(:)=0.013
00198   XZ0_O_Z0H(:)=10.
00199   XALBNIR_VEG(:)=0.30
00200   XALBVIS_VEG(:)=0.30
00201   XALBUV_VEG(:)=0.06
00202   XEMIS(:)=0.94
00203 ENDWHERE  
00204 IF (CPHOTO/='NON') THEN
00205   WHERE (XGARDEN(:)==0.)
00206     XGMES(:)=0.020
00207     XBSLAI(:)=0.36
00208     XLAIMIN(:)=0.3
00209     XSEFOLD(:)=90*86400.
00210     XH_TREE(:)=0.
00211     XRE25(:)=3.6E-7
00212     XGC(:)=0.00025
00213   END WHERE
00214   IF (CPHOTO/='AGS' .AND. CPHOTO/='LAI') THEN
00215     WHERE (XGARDEN(:)==0.) 
00216       XDMAX(:)=0.1
00217       XF2I(:)=0.3
00218     END WHERE
00219     IF (CPHOTO=='NIT' .OR. CPHOTO=='NCB') THEN
00220       WHERE (XGARDEN(:)==0.)      
00221         XCE_NITRO(:)=7.68
00222         XCF_NITRO(:)=-4.33
00223         XCNA_NITRO(:)=1.3
00224       END WHERE
00225     ENDIF
00226   ENDIF
00227 ENDIF
00228 IF(CISBA/='DIF')THEN
00229   DO JLAYER=1,NGROUND_LAYER
00230     WHERE (XGARDEN(:)==0.)
00231       XDG(:,JLAYER)=0.2*JLAYER
00232     END WHERE
00233   ENDDO
00234 ELSE
00235   WHERE (XGARDEN(:)==0.) 
00236     XDG(:,1)=0.01
00237     XDG(:,2)=0.04
00238     XROOTFRAC(:,1)=0.
00239     XROOTFRAC(:,2)=0.
00240   END WHERE        
00241   DO JLAYER=3,NGROUND_LAYER
00242     WHERE (XGARDEN(:)==0.)
00243       XDG(:,JLAYER)=0.1*(JLAYER-2)
00244       XROOTFRAC(:,JLAYER)=0.
00245     END WHERE
00246   ENDDO               
00247   WHERE (XGARDEN(:)==0.) 
00248     NWG_LAYER(:)=NGROUND_LAYER
00249     XDROOT   (:)=0.0
00250     XDG2     (:)=XDG(:,NGROUND_LAYER-1)
00251   ENDWHERE    
00252 ENDIF  
00253 WHERE (XGARDEN(:)==0.) 
00254   XD_ICE(:)=0.8*XDG(:,2)
00255 END WHERE  
00256 DO JVEGTYPE=1,NVEGTYPE
00257   WHERE (XGARDEN(:)==0.)
00258     XVEGTYPE(:,JVEGTYPE)=0.
00259     XVEGTYPE(:,1)=1.
00260   END WHERE
00261 ENDDO
00262 !
00263  CALL INIT_VEG_PGD_GARDEN_n(HPROGRAM, ILUOUT, KI, NGROUND_LAYER, TTIME%TDATE%MONTH,    &
00264                         XVEGTYPE, XTDEEP, XGAMMAT, CPHOTO, HINIT, LTR_ML,           &
00265                         NNBIOMASS, PCO2, PRHOA, XABC, XPOI,                         &
00266                         XGMES, XGC, XDMAX, XANMAX, XFZERO, XEPSO, XGAMM, XQDGAMM,   &
00267                         XQDGMES, XT1GMES, XT2GMES, XAMAX, XQDAMAX, XT1AMAX, XT2AMAX,&
00268                         XAH, XBH,                                                   &
00269                         KSV, HSV, NBEQ, CSV, NAEREQ, NSV_CHSBEG, NSV_CHSEND,        &
00270                         NSV_AERBEG, NSV_AEREND, CCH_NAMES, CAER_NAMES, NDSTEQ,      &
00271                         NSV_DSTBEG, NSV_DSTEND, NSLTEQ, NSV_SLTBEG, NSV_SLTEND,     &
00272                         CDSTNAMES, CSLTNAMES, CCHEM_SURF_FILE,                      &
00273                         XCLAY, XSAND, CPEDOTF,                                      &
00274                         XCONDSAT, XMPOTSAT, XBCOEF, XWWILT, XWFC, XWSAT,            &
00275                         XTAUICE, XCGSAT, XC1SAT, XC2REF, XC3, XC4B, XACOEF, XPCOEF, &
00276                         XC4REF, XPCPS, XPLVTT, XPLSTT,                              &
00277                         CSCOND, CISBA, XHCAPSOIL, XCONDDRY, XCONDSLD, CCPSURF,      &
00278                         XDG, XDROOT, XDG2, XROOTFRAC, XRUNOFFD, XDZG, XDZDIF,       &
00279                         XSOILWGHT, NWG_LAYER, NLAYER_HORT, NLAYER_DUN, XD_ICE,      &
00280                         XKSAT_ICE, XALBNIR_DRY, XALBVIS_DRY, XALBUV_DRY,            &
00281                         XALBNIR_WET, XALBVIS_WET, XALBUV_WET, XBSLAI_NITRO,         &
00282                         XCE_NITRO, XCNA_NITRO, XCF_NITRO                            )
00283 !
00284 !-------------------------------------------------------------------------------
00285 !
00286 IF(CISBA=='DIF'.AND.CSOC=='SGH')THEN
00287   CALL ABOR1_SFX('INIT_TEB_GARDEN_PGDn: SUBGRID Soil organic matter'//&
00288                  ' effect (CSOC) NOT YET IMPLEMENTED FOR GARDEN')
00289 ELSEIF (CISBA=='3-L'.AND.CKSAT=='EXP') THEN 
00290   CALL ABOR1_SFX('INIT_TEB_GARDEN_PGDn: topmodel exponential decay not implemented for garden')
00291 ENDIF
00292 !
00293 IF(CKSAT=='SGH' .AND. HINIT/='PRE')THEN 
00294   !
00295   ZF (:) = XUNDEF
00296   !  
00297   !Soil organic carbon effect and/or Exponential decay for DIF option 
00298   IF(CISBA=='DIF') THEN
00299     ZWORK(:) = XUNDEF
00300     ZF(:) = 4.0/MERGE(XDROOT(:),XDG2(:),XDROOT(:)>0.0) 
00301   ELSE
00302     WHERE (ZF(:)==XUNDEF) ZF(:) =  4.0/XDG(:,2)
00303   ENDIF
00304   ZF(:)=MIN(ZF(:),XF_DECAY)
00305   !
00306   IF(CISBA=='DIF') THEN
00307     !   
00308     ZWORK(:) = MERGE(XDROOT(:),XDG2(:),XDROOT(:)>0.0)      
00309     CALL EXP_DECAY_SOIL_DIF(ZF(:),XDG(:,:),NWG_LAYER(:),ZWORK(:),XCONDSAT(:,:))   
00310     !Exponential decay for ISBA-FR option
00311   ELSE
00312     !
00313     CALL EXP_DECAY_SOIL_FR(CISBA, ZF(:),XC1SAT(:),XC2REF(:),XDG(:,:),XD_ICE(:),&
00314                            XC4REF(:),XC3(:,:),XCONDSAT(:,:),XKSAT_ICE(:))  
00315     ! 
00316   ENDIF
00317   !
00318 ENDIF
00319 !
00320 !-------------------------------------------------------------------------------
00321 !
00322 IF (LHOOK) CALL DR_HOOK('INIT_TEB_GARDEN_PGD_n',1,ZHOOK_HANDLE)
00323 !
00324 !-------------------------------------------------------------------------------
00325 !
00326 !
00327 END SUBROUTINE INIT_TEB_GARDEN_PGD_n