|
SURFEX v7.3
General documentation of Surfex
|
|
SURFEX v7.3
General documentation of Surfex
|
00001 ! ######### 00002 SUBROUTINE COTWOINIT_n(HPHOTO,PVEGTYPE,PGMES,PCO2,PGC,PDMAX, & 00003 PABC,PPOI,PANMAX, & 00004 PFZERO,PEPSO,PGAMM,PQDGAMM,PQDGMES,PT1GMES, & 00005 PT2GMES,PAMAX,PQDAMAX,PT1AMAX,PT2AMAX,PAH,PBH, & 00006 PTAU_WOOD ) 00007 ! ####################################################################### 00008 ! 00009 !!**** *COTWOINIT* 00010 !! 00011 !! PURPOSE 00012 !! ------- 00013 ! 00014 ! Initialize model to calculate net assimilation of 00015 ! CO2 and leaf conductance. 00016 ! 00017 !!** METHOD 00018 !! ------ 00019 ! Calvet at al (1998) [from model of Jacobs(1994)] 00020 !! 00021 !! EXTERNAL 00022 !! -------- 00023 !! none 00024 !! 00025 !! IMPLICIT ARGUMENTS 00026 !! ------------------ 00027 !! 00028 !! USE MODD_CO2V_PAR 00029 !! USE MODI_COTWO 00030 !! 00031 !! REFERENCE 00032 !! --------- 00033 !! 00034 !! Calvet et al. (1998) 00035 !! 00036 !! AUTHOR 00037 !! ------ 00038 !! 00039 !! A. Boone * Meteo-France * 00040 !! (following Belair) 00041 !! 00042 !! MODIFICATIONS 00043 !! ------------- 00044 !! Original 27/10/97 00045 !! (V. Rivalland) 10/04/02 Add: PAH and PBH coefficients for 00046 !! herbaceous water stress response 00047 !! (P. LeMoigne) 03/2004: computation of zgmest in SI units 00048 !! (P. LeMoigne) 10/2004: possibility of 2 different FZERO 00049 !! (L. Jarlan) 10/2004: initialization of DMAX 00050 !! P Le Moigne 09/2005 AGS modifs of L. Jarlan 00051 !! S. Lafont 03/2009 change unit of AMAX 00052 !! A.L. Gibelin 04/2009 TAU_WOOD for NCB option 00053 !! A.L. Gibelin 04/2009 Suppress useless GPP and RDK arguments 00054 !! A.L. Gibelin 07/2009 Suppress PPST and PPSTF as outputs 00055 !! B. Decharme 05/2012 : Optimization 00056 !! 00057 !------------------------------------------------------------------------------- 00058 ! 00059 USE MODD_DATA_COVER_PAR, ONLY : NVEGTYPE, NVT_C4, NVT_IRR, NVT_TROG, & 00060 NVT_TREE, NVT_CONI, NVT_EVER 00061 USE MODD_CSTS, ONLY : XMD 00062 USE MODD_CO2V_PAR, ONLY : XTOPT, XFZERO1, XFZERO2, XEPSO, XGAMM, XQDGAMM, & 00063 XQDGMES, XT1GMES, XT2GMES, XAMAX, & 00064 XQDAMAX, XT1AMAX, XT2AMAX, XAH, XBH, & 00065 XDSPOPT, XIAOPT, XAW, XBW, XMCO2, XMC, XTAU_WOOD 00066 ! 00067 USE MODI_COTWO 00068 ! 00069 !* 0. DECLARATIONS 00070 ! ------------ 00071 ! 00072 ! 00073 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00074 USE PARKIND1 ,ONLY : JPRB 00075 ! 00076 IMPLICIT NONE 00077 ! 00078 !* 0.1 declarations of arguments 00079 ! 00080 ! 00081 CHARACTER(LEN=3), INTENT(IN) :: HPHOTO ! type of photosynthesis 00082 REAL,DIMENSION(:,:),INTENT(IN) :: PVEGTYPE 00083 ! PVEGTYPE = fraction of each 00084 ! vegetation classification index; 00085 ! C3 =>1, C4 => 2 00086 ! 00087 REAL,DIMENSION(:),INTENT(IN) :: PGMES, PCO2 00088 ! PGMES = mesophyll conductance (m s-1) 00089 ! PCO2 = atmospheric CO2 concentration 00090 ! 00091 REAL,DIMENSION(:),INTENT(IN) :: PDMAX, PGC 00092 ! PDMAX = maximum air saturation deficit tolerate 00093 ! by vegetation 00094 ! PGC = cuticular conductance (m s-1) 00095 ! 00096 REAL, DIMENSION(:), INTENT(OUT) :: PABC, PPOI 00097 ! ZABC = abscissa needed for integration 00098 ! of net assimilation and stomatal conductance 00099 ! over canopy depth 00100 ! ZPOI = Gaussian weights (as above) 00101 ! 00102 REAL,DIMENSION(:),INTENT(OUT) :: PANMAX 00103 ! PANMAX = maximum net assimilation 00104 ! 00105 REAL,DIMENSION(:),INTENT(OUT) :: PFZERO, PEPSO, PGAMM, PQDGAMM, PQDGMES, 00106 PT1GMES, PT2GMES, PAMAX, PQDAMAX, 00107 PT1AMAX, PT2AMAX, PTAU_WOOD 00108 ! PFZERO = ideal value of F, no photorespiration or 00109 ! saturation deficit 00110 ! PEPSO = maximum initial quantum use efficiency 00111 ! (kgCO2 kgAir-1 J-1 PAR) 00112 ! PGAMM = CO2 conpensation concentration (kgCO2 kgAir-1) 00113 ! PQDGAMM = Log of Q10 function for CO2 conpensation 00114 ! concentration 00115 ! PQDGMES = Log of Q10 function for mesophyll conductance 00116 ! PT1GMES = reference temperature for computing 00117 ! compensation concentration function for 00118 ! mesophyll conductance: minimum temperature 00119 ! PT2GMES = reference temperature for computing 00120 ! compensation concentration function for 00121 ! mesophyll conductance: maximum temperature 00122 ! PAMAX = leaf photosynthetic capacity (Units of kgCO2 kgAir-1 m s-1) 00123 ! PQDAMAX = Log of Q10 function for leaf photosynthetic capacity 00124 ! PT1AMAX = reference temperature for computing 00125 ! compensation concentration function for leaf 00126 ! photosynthetic capacity: minimum temperature 00127 ! PT2AMAX = reference temperature for computing 00128 ! compensation concentration function for leaf 00129 ! photosynthetic capacity: maximum temperature 00130 ! PTAU_WOOD = residence time in woody biomass (s) 00131 ! 00132 REAL,DIMENSION(:),INTENT(OUT) :: PAH, PBH 00133 ! PAH = coeficient of universal relationship for herbaceous 00134 ! PBH = coeficient of universal relationship for herbaceous 00135 ! 00136 !* 0.2 declaration of local variables 00137 ! 00138 INTEGER :: JCLASS ! indexes for loops 00139 INTEGER :: ICO2TYPE ! type of CO2 vegetation 00140 ! 00141 REAL, DIMENSION(SIZE(PANMAX)) :: ZGS, ZGAMMT, ZTOPT, ZANMAX, ZGMEST, ZGPP, ZRDK, ZEPSO 00142 ! ZTOPT = optimum temperature for compensation 00143 ! point 00144 ! ZANMAX = maximum photosynthesis rate 00145 ! ZGS = leaf conductance 00146 ! ZGAMMT = temperature compensation point 00147 ! ZGPP = gross primary production 00148 ! ZRDK = dark respiration 00149 ! 00150 ! 00151 REAL, DIMENSION(SIZE(PANMAX)) :: ZCO2INIT3, ZCO2INIT4, ZCO2INIT5 00152 ! working arrays for initializing surface 00153 ! temperature, saturation deficit, global radiation, 00154 ! optimum temperature for determining maximum 00155 ! photosynthesis rate, and soil water stress (none) 00156 REAL, DIMENSION(SIZE(PDMAX)) :: ZDMAX 00157 REAL, DIMENSION(SIZE(PDMAX)) :: ZWORK 00158 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00159 ! Local variable in order to initialise DMAX 00160 ! following Calvet, 2000 (AST or LST cases) 00161 !------------------------------------------------------------------------------- 00162 ! 00163 IF (LHOOK) CALL DR_HOOK('COTWOINIT_N',0,ZHOOK_HANDLE) 00164 ZTOPT (:) = 0. 00165 PFZERO (:) = 0. 00166 PEPSO (:) = 0. 00167 PGAMM (:) = 0. 00168 PQDGAMM(:) = 0. 00169 PQDGMES(:) = 0. 00170 PT1GMES(:) = 0. 00171 PT2GMES(:) = 0. 00172 PAMAX (:) = 0. 00173 PQDAMAX(:) = 0. 00174 PT1AMAX(:) = 0. 00175 PT2AMAX(:) = 0. 00176 PTAU_WOOD(:) = 0. 00177 ! 00178 PAH (:) = 0. 00179 PBH (:) = 0. 00180 ! 00181 ZEPSO (:) = 0. 00182 ZGPP (:) = 0. 00183 ZRDK (:) = 0. 00184 ZGAMMT (:) = 0. 00185 ZANMAX (:) = 0. 00186 ZGMEST (:) = 0. 00187 ZCO2INIT3(:) = 0. 00188 ZCO2INIT4(:) = 0. 00189 ZCO2INIT5(:) = 0. 00190 ! 00191 !------------------------------------------------------------------------------- 00192 ! 00193 !------------------------------------------------------------------------------- 00194 ! 00195 ! DETERMINE GAUSSIAN WEIGHTS NEEDED FOR CO2 MODEL 00196 ! ----------------------------------------------- 00197 ! 00198 CALL GAULEG(0.0,1.0,PABC,PPOI,SIZE(PABC)) 00199 ! 00200 ! 00201 ! INITIALIZE VARIOUS PARAMETERS FOR CO2 MODEL: 00202 ! -------------------------------------------- 00203 ! as a function of CO2 vegetation class, C3=>1, C4=>2 00204 ! 00205 DO JCLASS=1,NVEGTYPE 00206 ! 00207 IF (JCLASS==NVT_C4 .OR. JCLASS==NVT_IRR .OR. JCLASS==NVT_TROG) THEN 00208 ICO2TYPE = 2 ! C4 type 00209 ELSE 00210 ICO2TYPE = 1 ! C3 type 00211 END IF 00212 ! 00213 ZTOPT (:) = ZTOPT (:) + XTOPT (ICO2TYPE) * PVEGTYPE(:,JCLASS) 00214 IF (HPHOTO == 'AGS' .OR. HPHOTO == 'LAI') THEN 00215 PFZERO (:) = PFZERO (:) + XFZERO1 (ICO2TYPE) * PVEGTYPE(:,JCLASS) 00216 ELSE 00217 IF((JCLASS==NVT_TREE) .OR. (JCLASS==NVT_CONI) .OR. (JCLASS==NVT_EVER)) THEN 00218 PFZERO (:) = PFZERO (:) + ((XAW - LOG(PGMES(:)*1000.0))/XBW)*PVEGTYPE(:,JCLASS) 00219 ELSE 00220 PFZERO (:) = PFZERO (:) + XFZERO2 (ICO2TYPE) * PVEGTYPE(:,JCLASS) 00221 ENDIF 00222 ENDIF 00223 ! 00224 PEPSO (:) = PEPSO (:) + XEPSO (ICO2TYPE) * PVEGTYPE(:,JCLASS) 00225 PGAMM (:) = PGAMM (:) + XGAMM (ICO2TYPE) * PVEGTYPE(:,JCLASS) 00226 PQDGAMM(:) = PQDGAMM(:) + XQDGAMM(ICO2TYPE) * PVEGTYPE(:,JCLASS) 00227 PQDGMES(:) = PQDGMES(:) + XQDGMES(ICO2TYPE) * PVEGTYPE(:,JCLASS) 00228 PT1GMES(:) = PT1GMES(:) + XT1GMES(ICO2TYPE) * PVEGTYPE(:,JCLASS) 00229 PT2GMES(:) = PT2GMES(:) + XT2GMES(ICO2TYPE) * PVEGTYPE(:,JCLASS) 00230 PAMAX (:) = PAMAX (:) + XAMAX (ICO2TYPE) * PVEGTYPE(:,JCLASS) 00231 PQDAMAX(:) = PQDAMAX(:) + XQDAMAX(ICO2TYPE) * PVEGTYPE(:,JCLASS) 00232 PT1AMAX(:) = PT1AMAX(:) + XT1AMAX(ICO2TYPE) * PVEGTYPE(:,JCLASS) 00233 PT2AMAX(:) = PT2AMAX(:) + XT2AMAX(ICO2TYPE) * PVEGTYPE(:,JCLASS) 00234 PAH (:) = PAH (:) + XAH (ICO2TYPE) * PVEGTYPE(:,JCLASS) 00235 PBH (:) = PBH (:) + XBH (ICO2TYPE) * PVEGTYPE(:,JCLASS) 00236 ! 00237 PTAU_WOOD(:) = PTAU_WOOD(:) + XTAU_WOOD(JCLASS) * PVEGTYPE(:,JCLASS) 00238 ! 00239 END DO 00240 ! 00241 PQDGAMM(:)=LOG(PQDGAMM(:)) 00242 PQDGMES(:)=LOG(PQDGMES(:)) 00243 PQDAMAX(:)=LOG(PQDAMAX(:)) 00244 ! 00245 ! 00246 ! INITIALIZE VARIOUS VARIABLES FOR CO2 MODEL: 00247 ! ------------------------------------------- 00248 ! 00249 ! 00250 ! compute temperature responses: 00251 ! 00252 !before optimization (with non log PQDGAMM) : 00253 !ZGAMMT(:) = PGAMM(:)*(PQDGAMM(:)**(0.1*(ZTOPT(:)-25.0))) 00254 ZWORK (:) = (0.1*(ZTOPT(:)-25.0)) * PQDGAMM(:) 00255 ZGAMMT(:) = PGAMM(:)*EXP(ZWORK(:)) 00256 ! 00257 !before optimization (with non log PQDAMAX) : 00258 !ZANMAX(:) = ( PAMAX(:)*PQDAMAX(:)**(0.1*(ZTOPT(:)-25.0)) ) / ... 00259 ZWORK (:) = (0.1*(ZTOPT(:)-25.0)) * PQDAMAX(:) 00260 ZANMAX(:) = ( PAMAX(:)*EXP(ZWORK(:)) ) & 00261 /( (1.0+EXP(0.3*(PT1AMAX(:)-ZTOPT(:))))* & 00262 (1.0+EXP(0.3*(ZTOPT(:)-PT2AMAX(:)))) ) 00263 ! 00264 !before optimization (with non log PQDGMES) : 00265 !ZGMEST(:) = ( PGMES(:)*PQDGMES(:)**(0.1*(ZTOPT(:)-25.0)) ) & 00266 ZWORK (:) = (0.1*(ZTOPT(:)-25.0)) * PQDGMES(:) 00267 ZGMEST(:) = ( PGMES(:)*EXP(ZWORK(:)) ) & 00268 /( (1.0+EXP(0.3*(PT1GMES(:)-ZTOPT(:))))* & 00269 (1.0+EXP(0.3*(ZTOPT(:)-PT2GMES(:)))) ) 00270 ! 00271 ! 00272 ! initialize other variables: (using optimum values for some variables) 00273 ! 00274 ZCO2INIT3(:) = XDSPOPT 00275 ZCO2INIT4(:) = XIAOPT 00276 ZCO2INIT5(:) = 1.0 00277 ! 00278 ! Add soil moisture stress effect to leaf conductance: 00279 ! 00280 ZGMEST(:) = ZGMEST(:)*ZCO2INIT5(:) 00281 ! 00282 ! Initialise DMAX following Calvet (2000) in the case of 'AST' or 'LST' photosynthesis option 00283 ! 00284 IF((HPHOTO=='AST').OR.(HPHOTO=='LST').OR.(HPHOTO=='NIT').OR.(HPHOTO=='NCB')) THEN 00285 ZDMAX(:) = EXP((LOG(ZGMEST(:)*1000.)-PAH(:))/PBH(:))/1000. 00286 ELSE 00287 ZDMAX(:) = PDMAX(:) 00288 ENDIF 00289 ! 00290 ! Compute maximum/initial/optimum net assimilation of CO2: 00291 ! 00292 ! Unit conversion with a constant value of 1.2 for PRHOA as it is not known here 00293 ! ZANMAX and ZEPSO from kgCO2/m2/s to kgCO2/kgair m/s by dividing by RHOA (kgair/m3) 00294 ! ZGAMMT from ppm to kgCO2/kgair 00295 ZANMAX(:)=ZANMAX(:)/1.2 00296 ZEPSO(:)=PEPSO(:)/1.2 00297 ZGAMMT(:)=ZGAMMT(:)*XMCO2/XMD*1e-6 00298 ! 00299 CALL COTWO(PCO2, ZCO2INIT5, ZCO2INIT4, ZCO2INIT3, ZGAMMT, & 00300 PFZERO, ZEPSO, ZANMAX, ZGMEST, PGC, ZDMAX, & 00301 PANMAX, ZGS, ZRDK ) 00302 ! change by sebastien PEPSO change into ZEPSO for units consistency 00303 ! 00304 ! 00305 ! 00306 IF (LHOOK) CALL DR_HOOK('COTWOINIT_N',1,ZHOOK_HANDLE) 00307 CONTAINS 00308 ! 00309 ! 00310 SUBROUTINE GAULEG(PX1,PX2,PX,PW,KN) 00311 ! 00312 ! 00313 !!**** *GAULEG* 00314 !! 00315 !! PURPOSE 00316 !! ------- 00317 ! 00318 ! Calculates the Gaussian weights for integration of net assimilation 00319 ! and stomatal conductance over the canopy depth 00320 ! 00321 ! 00322 !!** METHOD 00323 !! ------ 00324 ! 00325 ! 1) Calculate the weights and abscissa using Gaussian Quadrature 00326 ! 00327 !! EXTERNAL 00328 !! -------- 00329 !! none 00330 !! 00331 !! IMPLICIT ARGUMENTS 00332 !! ------------------ 00333 !! MODD_CST 00334 !! 00335 !! REFERENCE 00336 !! --------- 00337 !! 00338 !! Calvet et al. (1998) For. Agri. Met. 00339 !! 00340 !! AUTHOR 00341 !! ------ 00342 !! 00343 !! A. Boone * Meteo-France * 00344 !! (following Belair) 00345 !! 00346 !! MODIFICATIONS 00347 !! ------------- 00348 !! Original 27/10/97 00349 !! 00350 !------------------------------------------------------------------------------- 00351 ! 00352 ! 00353 !* 0. DECLARATIONS 00354 ! ------------ 00355 ! 00356 USE MODD_CSTS, ONLY : XPI 00357 ! 00358 ! 00359 !* 0.1 declarations of arguments 00360 ! 00361 INTEGER, INTENT(IN) :: KN 00362 ! number of points at which Gaussian 00363 ! weights are evaluated/needed 00364 ! 00365 REAL, INTENT(IN) :: PX1, PX2 00366 ! mathematical/numerical values needed for 00367 ! weight computation 00368 ! 00369 REAL, DIMENSION(KN), INTENT(OUT) :: PX, PW 00370 ! PX = abscissa 00371 ! PW = Gaussian weights 00372 ! 00373 ! 00374 !* 0.2 declarations of local variables 00375 ! 00376 REAL, PARAMETER :: PPEPS = 3.0E-14 00377 ! convergence criteria 00378 ! 00379 INTEGER JI,JJ,JK ! loop indexes 00380 ! 00381 INTEGER IM ! 00382 ! 00383 REAL ZXM, ZXL, ZZ, ZP1, ZP2, ZP3, ZPP, ZZ1 ! dummy variables needed for 00384 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00385 ! computation of the gaussian weights 00386 ! 00387 !------------------------------------------------------------------------------- 00388 ! 00389 ! calcul des poids et abscisses par la methode de quad de Gauss 00390 ! 00391 IF (LHOOK) CALL DR_HOOK('GAULEG',0,ZHOOK_HANDLE) 00392 IM = (KN+1)/2 00393 ZXM = 0.50*(PX2+PX1) 00394 ZXL = 0.50*(PX2-PX1) 00395 ! 00396 IM_POINT_LOOP: DO JI = 1,IM 00397 ZZ = COS(XPI*(FLOAT(JI)-.250)/(FLOAT(KN)+.50)) 00398 ! 00399 ! begin iteration: 00400 ! 00401 ITERATION_LOOP: DO JK = 1,100 00402 ZP1 = 1. 00403 ZP2 = 0. 00404 DO JJ = 1,KN 00405 ZP3 = ZP2 00406 ZP2 = ZP1 00407 ZP1 = ((2.*(JJ)-1.)*ZZ*ZP2-(FLOAT(JJ)-1.)*ZP3)/JJ 00408 END DO 00409 ZPP = FLOAT(KN)*(ZZ*ZP1-ZP2)/(ZZ*ZZ-1.) 00410 ZZ1 = ZZ 00411 ZZ = ZZ1-ZP1/ZPP 00412 IF(ABS(ZZ-ZZ1).LE.PPEPS)EXIT 00413 END DO ITERATION_LOOP 00414 ! 00415 ! end iteration. 00416 ! 00417 ! compute abscissa 00418 ! 00419 PX(JI) = ZXM - ZXL*ZZ 00420 PX(KN+1-JI) = ZXM + ZXL*ZZ 00421 ! 00422 ! compute weights 00423 ! 00424 PW(JI) = 2.0*ZXL/((1.0-ZZ*ZZ)*ZPP*ZPP) 00425 PW(KN+1-JI) = PW(JI) 00426 END DO IM_POINT_LOOP 00427 IF (LHOOK) CALL DR_HOOK('GAULEG',1,ZHOOK_HANDLE) 00428 ! 00429 ! 00430 END SUBROUTINE GAULEG 00431 ! 00432 ! 00433 ! 00434 END SUBROUTINE COTWOINIT_n
1.8.0
