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

Go to the documentation of this file.
00001 !     #########
00002     SUBROUTINE VEGETATION_UPDATE(PTSTEP,TTIME,PCOVER,                 &
00003                        HISBA,OECOCLIMAP, HPHOTO, OAGRIP, HSFTYPE,     &
00004                        PLAI,PVEG,PZ0,                                 &
00005                        PALBNIR,PALBVIS,PALBUV,PEMIS,                  &
00006                        PRSMIN,PGAMMA,PWRMAX_CF,                       &
00007                        PRGL,PCV,                                      &
00008                        PGMES,PBSLAI,PLAIMIN,PSEFOLD,PGC,PDMAX,        &
00009                        PF2I,OSTRESS,                                  &
00010                        PAOSIP,PAOSIM,PAOSJP,PAOSJM,                   &
00011                        PHO2IP,PHO2IM,PHO2JP,PHO2JM,                   &
00012                        PZ0EFFIP,PZ0EFFIM,PZ0EFFJP,PZ0EFFJM,           &
00013                        HALBEDO, PALBNIR_VEG, PALBVIS_VEG, PALBUV_VEG, &
00014                        PALBNIR_SOIL, PALBVIS_SOIL, PALBUV_SOIL,       &
00015                        PCE_NITRO, PCF_NITRO, PCNA_NITRO,              &
00016                        TPSEED, TPREAP, PWATSUP, PIRRIG       )  
00017 !   ###############################################################
00018 !!****  *VEGETATION EVOL*
00019 !!
00020 !!    PURPOSE
00021 !!    -------
00022 !
00023 !     performs the time evolution of vegetation parameters
00024 !       at UTC midnight for prescribed parameters, with effective change each ten days
00025 !              
00026 !!**  METHOD
00027 !!    ------
00028 !!
00029 !!    EXTERNAL
00030 !!    --------
00031 !!    none
00032 !!
00033 !!    IMPLICIT ARGUMENTS
00034 !!    ------------------
00035 !!      
00036 !!    none
00037 !!
00038 !!    REFERENCE
00039 !!    ---------
00040 !!
00041 !!      
00042 !!    AUTHOR
00043 !!    ------
00044 !!
00045 !!      V. Masson          * Meteo-France *
00046 !!
00047 !!    MODIFICATIONS
00048 !!    -------------
00049 !!      Original    01/03/03 
00050 !!
00051 !!      P Le Moigne 09/2005 AGS modifs of L. Jarlan
00052 !-------------------------------------------------------------------------------
00053 !
00054 !*       0.     DECLARATIONS
00055 !               ------------
00056 !
00057 USE MODD_TYPE_DATE_SURF
00058 !
00059 USE MODD_TEB_n,   ONLY : XGARDEN
00060 !
00061 USE MODI_INIT_ISBA_MIXPAR
00062 USE MODI_CONVERT_PATCH_ISBA
00063 USE MODI_INIT_FROM_DATA_GRDN_n
00064 USE MODI_INIT_FROM_DATA_GREENROOF_n
00065 USE MODI_SUBSCALE_Z0EFF
00066 USE MODI_ALBEDO
00067 USE MODI_UPDATE_DATA_COVER
00068 !
00069 !
00070 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00071 USE PARKIND1  ,ONLY : JPRB
00072 !
00073 IMPLICIT NONE
00074 !
00075 !*      0.1    declarations of arguments
00076 !
00077 !
00078 REAL,                 INTENT(IN)    :: PTSTEP  ! time step
00079 TYPE(DATE_TIME),      INTENT(IN)    :: TTIME   ! UTC time
00080 REAL,   DIMENSION(:,:), INTENT(IN)  :: PCOVER  ! cover types
00081  CHARACTER(LEN=*),     INTENT(IN)    :: HISBA   ! type of soil (Force-Restore OR Diffusion)
00082  CHARACTER(LEN=*),     INTENT(IN)    :: HPHOTO  ! type of photosynthesis
00083 LOGICAL,              INTENT(IN)    :: OAGRIP
00084  CHARACTER(LEN=*),     INTENT(IN)    :: HSFTYPE ! nature / garden
00085 LOGICAL,              INTENT(IN)    :: OECOCLIMAP ! T if ecoclimap is used
00086 !
00087 REAL,   DIMENSION(:,:), INTENT(INOUT) :: PLAI    ! leaf area index (LAI) 
00088 REAL,   DIMENSION(:,:), INTENT(INOUT) :: PVEG    ! vegetation fraction
00089 REAL,   DIMENSION(:,:), INTENT(INOUT) :: PZ0     ! roughness length: momentum
00090 REAL,   DIMENSION(:,:), INTENT(INOUT) :: PALBNIR ! snow-free near-infra-red albedo
00091 REAL,   DIMENSION(:,:), INTENT(INOUT) :: PALBVIS ! snow-free visible albedo
00092 REAL,   DIMENSION(:,:), INTENT(INOUT) :: PALBUV  ! snow-free UV albedo
00093 REAL,   DIMENSION(:,:), INTENT(INOUT) :: PEMIS   ! snow-free emissivity
00094 !
00095 REAL,   DIMENSION(:,:), INTENT(INOUT) :: PRSMIN  ! minimal stomatal resistance
00096 REAL,   DIMENSION(:,:), INTENT(INOUT) :: PGAMMA  ! 
00097 REAL,   DIMENSION(:,:), INTENT(INOUT) :: PWRMAX_CF ! 
00098 REAL,   DIMENSION(:,:), INTENT(INOUT) :: PRGL
00099 REAL,   DIMENSION(:,:), INTENT(INOUT) :: PCV
00100 REAL,   DIMENSION(:,:), INTENT(INOUT) :: PGMES
00101 REAL,   DIMENSION(:,:), INTENT(INOUT) :: PCE_NITRO
00102 REAL,   DIMENSION(:,:), INTENT(INOUT) :: PCF_NITRO
00103 REAL,   DIMENSION(:,:), INTENT(INOUT) :: PCNA_NITRO
00104 REAL,   DIMENSION(:,:), INTENT(INOUT) :: PBSLAI
00105 REAL,   DIMENSION(:,:), INTENT(INOUT) :: PLAIMIN
00106 REAL,   DIMENSION(:,:), INTENT(INOUT) :: PSEFOLD
00107 REAL,   DIMENSION(:,:), INTENT(INOUT) :: PGC
00108 REAL,   DIMENSION(:,:), INTENT(INOUT) :: PF2I
00109 REAL,   DIMENSION(:,:), INTENT(INOUT) :: PDMAX
00110 LOGICAL,DIMENSION(:,:), INTENT(INOUT) :: OSTRESS
00111 !
00112  CHARACTER(LEN=4),     INTENT(IN)    :: HALBEDO ! albedo type
00113 !                                              ! 'DRY ' 
00114 !                                              ! 'EVOL' 
00115 !                                              ! 'WET ' 
00116 !                                              ! 'USER'
00117 REAL,   DIMENSION(:,:), INTENT(INOUT) :: PALBVIS_VEG ! visible, near infra-red and UV
00118 REAL,   DIMENSION(:,:), INTENT(INOUT) :: PALBNIR_VEG ! albedo of the vegetation
00119 REAL,   DIMENSION(:,:), INTENT(INOUT) :: PALBUV_VEG  !
00120 REAL,   DIMENSION(:,:), INTENT(IN)    :: PALBVIS_SOIL! visible, near infra-red and UV
00121 REAL,   DIMENSION(:,:), INTENT(IN)    :: PALBNIR_SOIL! soil albedo
00122 REAL,   DIMENSION(:,:), INTENT(IN)    :: PALBUV_SOIL !
00123 
00124 REAL, DIMENSION(:), INTENT(IN)  :: PAOSIP  ! A/S for increasing x
00125 REAL, DIMENSION(:), INTENT(IN)  :: PAOSIM  ! A/S for decreasing x
00126 REAL, DIMENSION(:), INTENT(IN)  :: PAOSJP  ! A/S for increasing y
00127 REAL, DIMENSION(:), INTENT(IN)  :: PAOSJM  ! A/S for decreasing y
00128 REAL, DIMENSION(:), INTENT(IN)  :: PHO2IP  ! h/2 for increasing x
00129 REAL, DIMENSION(:), INTENT(IN)  :: PHO2IM  ! h/2 for decreasing x
00130 REAL, DIMENSION(:), INTENT(IN)  :: PHO2JP  ! h/2 for increasing y
00131 REAL, DIMENSION(:), INTENT(IN)  :: PHO2JM  ! h/2 for decreasing y
00132 !
00133 REAL, DIMENSION(:,:), INTENT(INOUT) :: PZ0EFFIP! roughness length for increasing x
00134 REAL, DIMENSION(:,:), INTENT(INOUT) :: PZ0EFFIM! roughness length for decreasing x
00135 REAL, DIMENSION(:,:), INTENT(INOUT) :: PZ0EFFJP! roughness length for increasing y
00136 REAL, DIMENSION(:,:), INTENT(INOUT) :: PZ0EFFJM! roughness length for decreasing y
00137 !
00138 TYPE(DATE_TIME), DIMENSION(:,:), INTENT(INOUT) :: TPSEED   ! seeding date
00139 TYPE(DATE_TIME), DIMENSION(:,:), INTENT(INOUT) :: TPREAP   ! seeding date
00140 !
00141 REAL, DIMENSION(:,:), INTENT(INOUT) :: PWATSUP  ! water supply during irrigation
00142 REAL, DIMENSION(:,:), INTENT(INOUT) :: PIRRIG   ! irrigated fraction
00143 !
00144 !*      0.2    declarations of local variables
00145 !
00146 INTEGER                                  :: IDECADE, IDECADE2  ! decade of simulation
00147 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00148 !-----------------------------------------------------------------
00149 !
00150 !*      2.     Non-interactive vegetation
00151 !              --------------------------
00152 !
00153 !*      2.1    Decade
00154 !              ------
00155 !
00156 IF (LHOOK) CALL DR_HOOK('VEGETATION_UPDATE',0,ZHOOK_HANDLE)
00157 IDECADE = 3 * ( TTIME%TDATE%MONTH - 1 ) + MIN(TTIME%TDATE%DAY-1,29) / 10 + 1
00158 IDECADE2 = IDECADE
00159 !
00160 !*      2.2    From ecoclimap
00161 !              --------------
00162 !
00163 !* new decade?
00164   IF ( MOD(TTIME%TDATE%DAY,10)==1 .AND. TTIME%TIME - PTSTEP < 0.) THEN
00165 !* time varying parameters
00166     IF (OECOCLIMAP .OR. HSFTYPE=='NAT') THEN
00167 !* new year ? --> recomputes data LAI and derivated parameters (usefull in case of ecoclimap2)
00168       CALL UPDATE_DATA_COVER(TTIME%TDATE%YEAR)  
00169       IF (HSFTYPE=='NAT') CALL INIT_ISBA_MIXPAR(HISBA,IDECADE,IDECADE2,PCOVER,HPHOTO,HSFTYPE)
00170       CALL CONVERT_PATCH_ISBA(HISBA,IDECADE,IDECADE2,PCOVER,HPHOTO,     &
00171                            OAGRIP,HSFTYPE, PVEG=PVEG,                   &
00172                            PLAI=PLAI,PRSMIN=PRSMIN,PGAMMA=PGAMMA,&
00173                            PWRMAX_CF=PWRMAX_CF,                  &
00174                            PRGL=PRGL,PCV=PCV,PZ0=PZ0,            &
00175                            PALBNIR_VEG=PALBNIR_VEG,              &
00176                            PALBVIS_VEG=PALBVIS_VEG,              &
00177                            PALBUV_VEG=PALBUV_VEG,                &
00178                            PEMIS_ECO=PEMIS,PGMES=PGMES,          &
00179                            PBSLAI=PBSLAI,                        &
00180                            PLAIMIN=PLAIMIN,PSEFOLD=PSEFOLD,      &
00181                            PGC=PGC,PF2I=PF2I,                    &
00182                            OSTRESS=OSTRESS,PCE_NITRO=PCE_NITRO,  &
00183                            PCF_NITRO=PCF_NITRO,                  &
00184                            PCNA_NITRO=PCNA_NITRO,                &
00185                            TPSEED=TPSEED, TPREAP=TPREAP,         &
00186                            PWATSUP=PWATSUP,PIRRIG=PIRRIG     ) 
00187       IF (HSFTYPE=='GRD'.OR.HSFTYPE=='GNR') THEN
00188         WHERE (XGARDEN(:)==0.)
00189           PVEG       (:,1) = 0.
00190           PLAI       (:,1) = 0.
00191           PRSMIN     (:,1) = 40.
00192           PGAMMA     (:,1) = 0.
00193           PWRMAX_CF  (:,1) = 0.2
00194           PRGL       (:,1) = 100.
00195           PCV        (:,1) = 2.E-5
00196           PZ0        (:,1) = 0.013
00197           PALBNIR_VEG(:,1) = 0.30
00198           PALBVIS_VEG(:,1) = 0.30
00199           PALBUV_VEG (:,1) = 0.06
00200           PEMIS      (:,1) = 0.94                
00201         END WHERE
00202         IF (HPHOTO/='NON') THEN
00203           WHERE (XGARDEN(:)==0.)
00204             PGMES      (:,1) = 0.020
00205             PBSLAI     (:,1) = 0.36
00206             PLAIMIN    (:,1) = 0.3
00207             PSEFOLD    (:,1) = 90*86400.
00208             PGC        (:,1) = 0.00025                  
00209           END WHERE
00210           IF (HPHOTO/='AGS' .AND. HPHOTO/='LAI') THEN
00211             WHERE (XGARDEN(:)==0.) PF2I       (:,1) = 0.3
00212             IF (HPHOTO=='NIT' .OR. HPHOTO=='NCB') THEN
00213               WHERE (XGARDEN(:)==0.)
00214                 PCE_NITRO  (:,1) = 7.68
00215                 PCF_NITRO  (:,1) = -4.33
00216                 PCNA_NITRO (:,1) = 1.3                      
00217               END WHERE
00218             ENDIF
00219           ENDIF
00220         ENDIF
00221       ENDIF
00222   
00223     ELSEIF (HSFTYPE=='GRD') THEN
00224       CALL INIT_FROM_DATA_GRDN_n(IDECADE,HPHOTO,                                      &
00225                        PVEG=PVEG(:,1),PLAI=PLAI(:,1),PZ0=PZ0(:,1),PEMIS=PEMIS(:,1)    )  
00226      
00227     ELSEIF (HSFTYPE=='GNR') THEN
00228       CALL INIT_FROM_DATA_GREENROOF_n(IDECADE,HPHOTO,                                 &
00229                        PVEG=PVEG(:,1),PLAI=PLAI(:,1),PZ0=PZ0(:,1),PEMIS=PEMIS(:,1)    )  
00230 
00231     ENDIF
00232     IF (HSFTYPE=='NAT') THEN
00233 !* albedo
00234       CALL ALBEDO(HALBEDO,                                 &
00235                   PALBVIS_VEG,PALBNIR_VEG,PALBUV_VEG,PVEG,   &
00236                   PALBVIS_SOIL,PALBNIR_SOIL,PALBUV_SOIL,     &
00237                   PALBVIS ,PALBNIR, PALBUV                   )  
00238 !
00239 !* effective roughness length
00240       CALL SUBSCALE_Z0EFF(PAOSIP,PAOSIM,PAOSJP,PAOSJM,       &
00241                           PHO2IP,PHO2IM,PHO2JP,PHO2JM,PZ0,     &
00242                           PZ0EFFIP,PZ0EFFIM,PZ0EFFJP,PZ0EFFJM  )  
00243     ENDIF
00244 
00245   END IF
00246 IF (LHOOK) CALL DR_HOOK('VEGETATION_UPDATE',1,ZHOOK_HANDLE)
00247 !
00248 !*      2.3    Prescribed vegetation
00249 !              ---------------------
00250 !
00251 !-----------------------------------------------------------------
00252 !
00253 END SUBROUTINE VEGETATION_UPDATE