|
SURFEX v7.3
General documentation of Surfex
|
|
SURFEX v7.3
General documentation of Surfex
|
00001 ! ######### 00002 SUBROUTINE RADIATIVE_TRANSFERT(PVEGTYPE, & 00003 PALBVIS_VEG, PALBVIS_SOIL, PALBNIR_VEG, PALBNIR_SOIL, & 00004 PSW_RAD, PLAI, PZENITH, PABC, & 00005 PFAPARC, PFAPIRC, PMUS, PLAI_EFFC, OSHADE, PIACAN, & 00006 PIACAN_SUNLIT, PIACAN_SHADE, PFRAC_SUN, & 00007 PFAPAR, PFAPIR, PFAPAR_BS, PFAPIR_BS ) 00008 ! ######################################################################### 00009 ! 00010 !!**** *RADIATIVE_TRANSFERT* 00011 !! 00012 !! PURPOSE 00013 !! ------- 00014 !! 00015 !! Calculates net assimilation of CO2 and leaf conductance. 00016 !! 00017 !!** METHOD 00018 !! ------ 00019 !! Calvet et al. 1998 Forr. Agri. Met. [from model of Jacobs(1994)] 00020 !! 00021 !! EXTERNAL 00022 !! -------- 00023 !! none 00024 !! 00025 !! IMPLICIT ARGUMENTS 00026 !! ------------------ 00027 !! 00028 !! USE MODD_CST 00029 !! USE MODD_CO2V_PAR 00030 !! USE MODI_COTWO 00031 !! USE MODI_CCETR 00032 !! USE MODE_THERMOS 00033 !! 00034 !! REFERENCE 00035 !! --------- 00036 !! 00037 !! Calvet et al. 1998 Forr. Agri. Met. 00038 !! 00039 !! AUTHOR 00040 !! ------ 00041 !! 00042 !! A. Boone * Meteo-France * 00043 !! (following Belair) 00044 !! 00045 !! MODIFICATIONS 00046 !! ------------- 00047 !! Original 27/10/97 00048 !! V. Masson and V. Rivailland 12/2003 modificatino of ISBA routines order 00049 !! L. Jarlan 27/10/04 : add of T2 to calculate soil respiration and use 00050 !! of CRESPSL key to manage the calculation of soil 00051 !! respiration 00052 !! PAN et PPST in kgCO2 m-2 s-1 to be fully 00053 !! compatible with vegetation growth module (lailoss.f90) 00054 !! P Le Moigne 09/2005 AGS modifs of L. Jarlan 00055 !! S. Lafont 03/09 : change units of EPSO GAMM ANDAY 00056 !! A.L. Gibelin 06/09 : suppress evolution of [CO2] in canopy 00057 !! A.L. Gibelin 06/09 : move calculations of some CO2 fluxes 00058 !! A.L. Gibelin 06/09 : add RESP_LEAF 00059 !! A.L. Gibelin 07/09 : ensure coherence between cotwores and cotworestress 00060 !! A.L. Gibelin 07/09 : Suppress PPST and PPSTF as outputs, and diagnose GPP 00061 !! S. Lafont 03/11 : Correct a bug fopr grassland below wilting point 00062 !! D. Carrer 04/11 : new radiative transfert 00063 !! 00064 !------------------------------------------------------------------------------- 00065 ! 00066 USE MODD_CO2V_PAR, ONLY : XPARCF, XLAI_SHADE, & 00067 XXB_SUP, XXB_INF, XSSA_SUP, XSSA_INF, & 00068 XSSA_SUP_PIR, XSSA_INF_PIR 00069 USE MODD_SURF_PAR, ONLY : XUNDEF 00070 ! 00071 USE MODI_FAPAIR 00072 ! 00073 !* 0. DECLARATIONS 00074 ! ------------ 00075 ! 00076 ! 00077 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00078 USE PARKIND1 ,ONLY : JPRB 00079 ! 00080 IMPLICIT NONE 00081 ! 00082 !* 0.1 declarations of arguments 00083 ! 00084 REAL, DIMENSION(:,:),INTENT(IN) :: PVEGTYPE ! PVEGTYPE = type de vegetation (1 a 9) 00085 ! 00086 REAL, DIMENSION(:), INTENT(IN) :: PALBVIS_VEG ! visible snow free albedo of vegetation 00087 REAL, DIMENSION(:), INTENT(IN) :: PALBVIS_SOIL ! visible snow free albedo of soil 00088 REAL, DIMENSION(:), INTENT(IN) :: PALBNIR_VEG ! NIR snow free albedo of vegetation 00089 REAL, DIMENSION(:), INTENT(IN) :: PALBNIR_SOIL ! NIR snow free albedo of soil 00090 ! 00091 REAL,DIMENSION(:), INTENT(IN) :: PSW_RAD 00092 REAL,DIMENSION(:), INTENT(IN) :: PLAI ! PLAI = leaf area index 00093 ! 00094 REAL,DIMENSION(:), INTENT(IN) :: PZENITH 00095 ! PZENITH = solar zenith angle needed 00096 ! for computation of diffusuion of solar 00097 ! radiation: for CO2 model. 00098 ! 00099 REAL,DIMENSION(:), INTENT(INOUT) :: PABC 00100 ! PABC = abscissa needed for integration 00101 ! of net assimilation and stomatal 00102 ! conductance over canopy depth 00103 ! 00104 REAL, DIMENSION(:), INTENT(INOUT) :: PFAPARC ! Fapar of vegetation (cumul) 00105 REAL, DIMENSION(:), INTENT(INOUT) :: PFAPIRC ! Fapir of vegetation (cumul) 00106 REAL, DIMENSION(:), INTENT(INOUT) :: PMUS 00107 REAL, DIMENSION(:), INTENT(INOUT) :: PLAI_EFFC ! Effective LAI (cumul) 00108 ! 00109 LOGICAL, DIMENSION(:),INTENT(OUT) :: OSHADE ! OSHADE = if 1 shading activated 00110 REAL, DIMENSION(:,:), INTENT(OUT) :: PIACAN ! PAR in the canopy at different gauss level 00111 REAL, DIMENSION(:,:), INTENT(OUT) :: PIACAN_SUNLIT, PIACAN_SHADE 00112 ! ! absorbed PAR of each level within the 00113 ! ! canopy - Split into shaded and SUNLIT 00114 REAL, DIMENSION(:,:), INTENT(OUT) :: PFRAC_SUN ! fraction of sunlit leaves 00115 ! 00116 REAL, DIMENSION(:), INTENT(OUT) :: PFAPAR, PFAPIR, PFAPAR_BS, PFAPIR_BS 00117 ! 00118 !* 0.2 declarations of local variables 00119 ! 00120 ! 00121 REAL, DIMENSION(SIZE(PLAI)) :: ZIA, ZLAI, ZLAI_EFF, ZXMUS 00122 ! ZXMUS = cosine of solar zenith angle 00123 ! 00124 REAL, DIMENSION(SIZE(PLAI)) :: ZB_INF, ZB_SUP 00125 INTEGER, DIMENSION(1) :: IDMAX 00126 ! 00127 INTEGER :: JJ ! index for loops 00128 ! 00129 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00130 !------------------------------------------------------------------------------- 00131 ! 00132 IF (LHOOK) CALL DR_HOOK('RADIATIVE_TRANSFERT',0,ZHOOK_HANDLE) 00133 ! 00134 ZLAI(:) = PLAI(:) 00135 ! 00136 ! Net assimilation of the canopy (Ac) is limitted to 7 points of LAI 00137 WHERE (PLAI(:)==XUNDEF) ZLAI(:) = 0.0 00138 ! 00139 ! Geometrical configuration and density of leaves induce different 00140 ! min value of LAI to start the shading. 00141 OSHADE(:)= .TRUE. 00142 DO JJ = 1, SIZE(PLAI) 00143 IDMAX = MAXLOC(PVEGTYPE(JJ,:)) 00144 IF (PLAI(JJ).LT.XLAI_SHADE(IDMAX(1))) OSHADE(JJ) = .FALSE. 00145 ZB_INF(JJ) = XXB_INF(IDMAX(1)) 00146 ZB_SUP(JJ) = XXB_SUP(IDMAX(1)) 00147 ENDDO 00148 ! 00149 !to consider all the tickness of the canopy 00150 PABC(1) = 0. 00151 ! 00152 ! cosine of solar zenith angle 00153 ! 00154 ZXMUS(:) = MAX(COS(PZENITH(:)),0.01) 00155 ! 00156 ! 00157 ZIA(:) = PSW_RAD(:)*(1.-XPARCF) 00158 CALL FAPAIR(PABC, ZIA, ZLAI, ZXMUS, XSSA_SUP_PIR, XSSA_INF_PIR, & 00159 ZB_SUP, ZB_INF, PALBNIR_VEG, PALBNIR_SOIL, OSHADE, & 00160 PFAPIR, PFAPIR_BS ) 00161 ! 00162 ZIA(:) = PSW_RAD(:)*XPARCF 00163 CALL FAPAIR(PABC, ZIA, ZLAI, ZXMUS, XSSA_SUP, XSSA_INF, & 00164 ZB_SUP, ZB_INF, PALBVIS_VEG, PALBVIS_SOIL, OSHADE, & 00165 PFAPAR, PFAPAR_BS, PLAI_EFF=ZLAI_EFF, PIACAN=PIACAN, & 00166 PIACAN_SHADE=PIACAN_SHADE, PIACAN_SUNLIT=PIACAN_SUNLIT, & 00167 PFRAC_SUN=PFRAC_SUN ) 00168 ! 00169 ! 00170 DO JJ = 1,SIZE(PLAI) 00171 IF (ZIA(JJ).NE.0.) THEN 00172 PFAPIRC(JJ) = PFAPIRC(JJ) + PFAPIR(JJ) * ZXMUS(JJ) 00173 PFAPARC(JJ) = PFAPARC(JJ) + PFAPAR(JJ) * ZXMUS(JJ) 00174 PLAI_EFFC(JJ) = PLAI_EFFC(JJ) + ZLAI_EFF(JJ) * ZXMUS(JJ) 00175 PMUS(JJ) = PMUS(JJ) + ZXMUS(JJ) 00176 ENDIF 00177 ENDDO 00178 ! 00179 IF (LHOOK) CALL DR_HOOK('RADIATIVE_TRANSFERT',1,ZHOOK_HANDLE) 00180 ! 00181 END SUBROUTINE RADIATIVE_TRANSFERT
1.8.0
