| 1 | !$Header: /home/ssipsl/CVSREP/ORCHIDEE/src_parameters/constantes_veg.f90,v 1.32 2008/04/10 16:09:40 ssipsl Exp $ |
|---|
| 2 | !IPSL (2006) |
|---|
| 3 | ! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC |
|---|
| 4 | !- |
|---|
| 5 | MODULE constantes_veg |
|---|
| 6 | !!-------------------------------------------------------------------- |
|---|
| 7 | !! "constantes_soil" module contains public physical constantes |
|---|
| 8 | !! and public tools functions like qsat, dev_qsat |
|---|
| 9 | !!-------------------------------------------------------------------- |
|---|
| 10 | USE IOIPSL |
|---|
| 11 | USE constantes_soil |
|---|
| 12 | !- |
|---|
| 13 | IMPLICIT NONE |
|---|
| 14 | !- |
|---|
| 15 | LOGICAL,SAVE :: l_qsat_first=.TRUE. |
|---|
| 16 | !- |
|---|
| 17 | ! Flags that (de)activate parts of the model |
|---|
| 18 | TYPE(control_type),SAVE :: control |
|---|
| 19 | !- |
|---|
| 20 | ! Number of vegetation types |
|---|
| 21 | INTEGER(i_std),PARAMETER :: nvm=13 |
|---|
| 22 | ! Number of other surface types: land ice (lakes,cities, ...) |
|---|
| 23 | INTEGER(i_std),PARAMETER :: nnobio=1 |
|---|
| 24 | !- |
|---|
| 25 | ! Index for land ice (see nnobio) |
|---|
| 26 | INTEGER(i_std),PARAMETER :: iice = 1 |
|---|
| 27 | ! The maximum mass (kg/m^2) of a glacier. |
|---|
| 28 | REAL(r_std),PARAMETER :: maxmass_glacier = 3000. |
|---|
| 29 | !- |
|---|
| 30 | ! Minimal fraction of mesh a vegetation type can occupy |
|---|
| 31 | REAL(r_std),PARAMETER :: min_vegfrac=0.001 |
|---|
| 32 | !- |
|---|
| 33 | ! Constant in the computation of surface resistance |
|---|
| 34 | REAL(r_std),PARAMETER :: defc_plus=23.E-3 |
|---|
| 35 | ! Constant in the computation of surface resistance |
|---|
| 36 | REAL(r_std),PARAMETER :: defc_mult=1.5 |
|---|
| 37 | !- |
|---|
| 38 | ! Limit of air temperature for snow |
|---|
| 39 | REAL(r_std),PARAMETER :: tsnow=273. |
|---|
| 40 | !- |
|---|
| 41 | ! Sets the amount above which only sublimation occures [Kg/m^2] |
|---|
| 42 | REAL(r_std),PARAMETER :: snowcri=1.5 |
|---|
| 43 | ! Critical value for computation of snow albedo [Kg/m^2] |
|---|
| 44 | REAL(r_std),PARAMETER :: snowcri_alb=10. |
|---|
| 45 | ! Lower limit of snow amount |
|---|
| 46 | REAL(r_std),PARAMETER :: sneige=snowcri/1000._r_std |
|---|
| 47 | ! Latent heat of sublimation |
|---|
| 48 | REAL(r_std),PARAMETER :: chalsu0 = 2.8345E06 |
|---|
| 49 | ! Latent heat of evaporation |
|---|
| 50 | REAL(r_std),PARAMETER :: chalev0 = 2.5008E06 |
|---|
| 51 | ! Latent heat of evaporation 2 (?) |
|---|
| 52 | REAL(r_std),PARAMETER :: chalev1 = 2.5008E06 |
|---|
| 53 | ! Latent heat of fusion |
|---|
| 54 | REAL(r_std),PARAMETER :: chalfu0 = chalsu0-chalev0 |
|---|
| 55 | !- |
|---|
| 56 | ! Stefan-Boltzman constant |
|---|
| 57 | REAL(r_std),PARAMETER :: c_stefan = 5.6697E-8 |
|---|
| 58 | ! Specific heat of air |
|---|
| 59 | REAL(r_std),PARAMETER :: cp_air = 1004.675 |
|---|
| 60 | ! Constante molere |
|---|
| 61 | REAL(r_std),PARAMETER :: cte_molr = 287.05 |
|---|
| 62 | ! Kappa |
|---|
| 63 | REAL(r_std),PARAMETER :: kappa = cte_molr/cp_air |
|---|
| 64 | ! in -- Kg/mole |
|---|
| 65 | REAL(r_std),PARAMETER :: msmlr_air = 28.964E-03 |
|---|
| 66 | ! in -- Kg/mole |
|---|
| 67 | REAL(r_std),PARAMETER :: msmlr_h2o = 18.02E-03 |
|---|
| 68 | ! |
|---|
| 69 | REAL(r_std),PARAMETER :: cp_h2o = & |
|---|
| 70 | & cp_air*(4._r_std*msmlr_air)/( 3.5_r_std*msmlr_h2o) |
|---|
| 71 | ! |
|---|
| 72 | REAL(r_std),PARAMETER :: cte_molr_h2o = cte_molr/4._r_std |
|---|
| 73 | ! |
|---|
| 74 | REAL(r_std),PARAMETER :: retv = msmlr_air/msmlr_h2o-1._r_std |
|---|
| 75 | ! |
|---|
| 76 | REAL(r_std),PARAMETER :: rvtmp2 = cp_h2o/cp_air-1._r_std |
|---|
| 77 | ! |
|---|
| 78 | REAL(r_std),PARAMETER :: cepdu2 = (0.1_r_std) **2 |
|---|
| 79 | ! Van Karmann Constante |
|---|
| 80 | REAL(r_std),PARAMETER :: ct_karman = 0.35_r_std |
|---|
| 81 | ! g acceleration |
|---|
| 82 | REAL(r_std),PARAMETER :: cte_grav = 9.80665_r_std |
|---|
| 83 | ! Constantes of the Louis scheme |
|---|
| 84 | REAL(r_std),PARAMETER :: cb = 5._r_std |
|---|
| 85 | REAL(r_std),PARAMETER :: cc = 5._r_std |
|---|
| 86 | REAL(r_std),PARAMETER :: cd = 5._r_std |
|---|
| 87 | ! The minimum wind |
|---|
| 88 | REAL(r_std),PARAMETER :: min_wind = 0.1 |
|---|
| 89 | ! Transform pascal into hectopascal |
|---|
| 90 | REAL(r_std),PARAMETER :: pa_par_hpa = 100._r_std |
|---|
| 91 | ! Time constant of the albedo decay of snow |
|---|
| 92 | REAL(r_std),PARAMETER :: tcst_snowa = 5._r_std |
|---|
| 93 | ! Maximum period of snow aging |
|---|
| 94 | REAL(r_std),PARAMETER :: max_snow_age = 50._r_std |
|---|
| 95 | ! Transformation time constant for snow (m) |
|---|
| 96 | REAL(r_std),PARAMETER :: snow_trans = 0.3_r_std |
|---|
| 97 | ! bare soil roughness length (m) |
|---|
| 98 | REAL(r_std),PARAMETER :: z0_bare = 0.01 |
|---|
| 99 | ! ice roughness length (m) |
|---|
| 100 | REAL(r_std),PARAMETER :: z0_ice = 0.001 |
|---|
| 101 | !- |
|---|
| 102 | ! allow agricultural PFTs |
|---|
| 103 | LOGICAL,SAVE :: agriculture = .TRUE. |
|---|
| 104 | !! |
|---|
| 105 | !! The following tables of parameters for SECHIBA |
|---|
| 106 | !! are in the following order : |
|---|
| 107 | !! |
|---|
| 108 | !! 1 - Bare soil |
|---|
| 109 | !! 2 - tropical broad-leaved evergreen |
|---|
| 110 | !! 3 - tropical broad-leaved raingreen |
|---|
| 111 | !! 4 - temperate needleleaf evergreen |
|---|
| 112 | !! 5 - temperate broad-leaved evergreen |
|---|
| 113 | !! 6 - temperate broad-leaved summergreen |
|---|
| 114 | !! 7 - boreal needleleaf evergreen |
|---|
| 115 | !! 8 - boreal broad-leaved summergreen |
|---|
| 116 | !! 9 - boreal needleleaf summergreen |
|---|
| 117 | !! 10 - C3 grass |
|---|
| 118 | !! 11 - C4 grass |
|---|
| 119 | !! 12 - C3 agriculture |
|---|
| 120 | !! 13 - C4 agriculture |
|---|
| 121 | !! |
|---|
| 122 | ! Value for veget_ori for tests in 0-dim simulations |
|---|
| 123 | REAL(r_std),DIMENSION(nvm),SAVE :: veget_ori_fixed_test_1 = & |
|---|
| 124 | & (/ 0.2, 0.0, 0.0, 0.0, 0.0, & |
|---|
| 125 | & 0.0, 0.0, 0.0, 0.0, 0.8, & |
|---|
| 126 | & 0.0, 0.0, 0.0 /) |
|---|
| 127 | ! Value for frac_nobio for tests in 0-dim simulations |
|---|
| 128 | ! laisser ca tant qu'il n'y a que de la glace (pas de lacs) |
|---|
| 129 | REAL(r_std),SAVE :: frac_nobio_fixed_test_1 = 0.0 |
|---|
| 130 | ! REAL(r_std), DIMENSION(nnobio),SAVE :: frac_nobio_fixed_test_1=(/0.0/) |
|---|
| 131 | !- |
|---|
| 132 | ! laimax for maximum lai see also type of lai interpolation |
|---|
| 133 | REAL(r_std),DIMENSION(nvm),SAVE :: llaimax = & |
|---|
| 134 | & (/ 0., 8., 8., 4., 4.5, 4.5, 4., 4.5, 4., 2., 2., 2., 2./) |
|---|
| 135 | ! laimin for minimum lai see also type of lai interpolation |
|---|
| 136 | REAL(r_std),DIMENSION(nvm),SAVE :: llaimin = & |
|---|
| 137 | & (/ 0., 8., 0., 4., 4.5, 0., 4., 0., 0., 0., 0., 0., 0./) |
|---|
| 138 | !- |
|---|
| 139 | ! prescribed height of vegetation. |
|---|
| 140 | ! Value for height_presc : one for each vegetation type |
|---|
| 141 | REAL(r_std),DIMENSION(nvm),SAVE :: height_presc = & |
|---|
| 142 | & (/ 0.,30.,30.,20.,20.,20.,15.,15.,15.,.5,.6,1.,1./) |
|---|
| 143 | !- |
|---|
| 144 | ! Structural resistance. |
|---|
| 145 | ! Value for rstruct_const : one for each vegetation type |
|---|
| 146 | REAL(r_std),DIMENSION(nvm),SAVE :: rstruct_const = & |
|---|
| 147 | & (/ 0.0, 25.0, 25.0, 25.0, 25.0, 25.0, 25.0,& |
|---|
| 148 | & 25.0, 25.0, 2.5, 2.0, 2.0, 2.0 /) |
|---|
| 149 | !- |
|---|
| 150 | ! A vegetation dependent constant used in the calculation |
|---|
| 151 | ! of the surface resistance. |
|---|
| 152 | ! Value for kzero one for each vegetation type |
|---|
| 153 | REAL(r_std),DIMENSION(nvm),SAVE :: kzero = & |
|---|
| 154 | & (/0.0, 12.E-5, 12.E-5, 12.e-5, 12.e-5, 25.e-5, 12.e-5,& |
|---|
| 155 | & 25.e-5, 25.e-5, 30.e-5, 30.e-5, 30.e-5, 30.e-5 /) |
|---|
| 156 | !- |
|---|
| 157 | ! Maximum field capacity for each of the vegetations (Temporary). |
|---|
| 158 | ! Value of wmax_veg : max quantity of water : |
|---|
| 159 | ! one for each vegetation type en Kg/M3 |
|---|
| 160 | REAL(r_std),DIMENSION(nvm),SAVE :: wmax_veg = & |
|---|
| 161 | & (/ 150., 150., 150., 150., 150., 150., 150.,& |
|---|
| 162 | & 150., 150., 150., 150., 150., 150. /) |
|---|
| 163 | !- |
|---|
| 164 | ! Root profile description for the different vegetation types. |
|---|
| 165 | ! These are the factor in the exponential which gets |
|---|
| 166 | ! the root density as a function of depth |
|---|
| 167 | REAL(r_std),DIMENSION(nvm), SAVE :: humcste = & |
|---|
| 168 | & (/5., .8, .8, 1., .8, .8, 1., 1., .8, 4., 4., 4., 4./) |
|---|
| 169 | !- |
|---|
| 170 | ! Type of behaviour of the LAI evolution algorithm |
|---|
| 171 | ! for each vegetation type. |
|---|
| 172 | ! Value of type_of_lai, one for each vegetation type : mean or interp |
|---|
| 173 | !!$ CHARACTER(len=5),DIMENSION(nvm),SAVE :: type_of_lai = & |
|---|
| 174 | !!$ & (/ 'mean ', 'mean ', 'inter', 'mean ', 'mean ', & |
|---|
| 175 | !!$ & 'inter', 'mean ', 'inter', 'inter', 'inter', & |
|---|
| 176 | !!$ & 'inter', 'inter', 'inter' /) |
|---|
| 177 | ! Test Nathalie : Even Sempervirens vegetation is allowed to have a small seasonal cycle. |
|---|
| 178 | CHARACTER(len=5),DIMENSION(nvm),SAVE :: type_of_lai = & |
|---|
| 179 | & (/ 'inter', 'inter', 'inter', 'inter', 'inter', & |
|---|
| 180 | & 'inter', 'inter', 'inter', 'inter', 'inter', & |
|---|
| 181 | & 'inter', 'inter', 'inter' /) |
|---|
| 182 | !- |
|---|
| 183 | ! Is the vegetation type a tree ? |
|---|
| 184 | LOGICAL, DIMENSION(nvm),SAVE :: is_tree = & |
|---|
| 185 | & (/ .FALSE., .TRUE., .TRUE., .TRUE., .TRUE., & |
|---|
| 186 | & .TRUE., .TRUE., .TRUE., .TRUE., .FALSE., & |
|---|
| 187 | & .FALSE., .FALSE., .FALSE. /) |
|---|
| 188 | !- |
|---|
| 189 | ! Initial snow albedo value for each vegetation type |
|---|
| 190 | ! as it will be used in condveg_snow |
|---|
| 191 | ! Values are from the Thesis of S. Chalita (1992) |
|---|
| 192 | ! REAL(r_std),DIMENSION(nvm),SAVE :: snowa_ini = & |
|---|
| 193 | ! & (/ 0.55, 0., 0., 0.14, 0.15, & |
|---|
| 194 | ! & 0.15, 0.14, 0.15, 0.14, 0.18, & |
|---|
| 195 | ! & 0.18, 0.18, 0.18 /) |
|---|
| 196 | ! Nathalie - Decembre 2006 - on limite les albedos de sol nu en presence de neige, ainsi que ceux de la vegetation |
|---|
| 197 | ! les valeurs choisies sont proches de celles que nous avions prises dans LMD5.3 avec Delphine Texier |
|---|
| 198 | REAL(r_std),DIMENSION(nvm),SAVE :: snowa_ini = & |
|---|
| 199 | & (/ 0.35, 0., 0., 0.14, 0.14, & |
|---|
| 200 | & 0.14, 0.14, 0.14, 0.14, 0.18, & |
|---|
| 201 | & 0.18, 0.18, 0.18 /) |
|---|
| 202 | ! Decay rate of snow albedo value for each vegetation type |
|---|
| 203 | ! as it will be used in condveg_snow |
|---|
| 204 | ! Values are from the Thesis of S. Chalita (1992) |
|---|
| 205 | ! REAL(r_std),DIMENSION(nvm),SAVE :: snowa_dec = & |
|---|
| 206 | ! & (/ 0.30, 0., 0., 0.06, 0.14, & |
|---|
| 207 | ! & 0.14, 0.06, 0.25, 0.06, 0.63, & |
|---|
| 208 | ! & 0.63, 0.63, 0.63 /) |
|---|
| 209 | ! Nathalie - Decembre 2006 - on limite les albedos de sol nu en presence de neige, ainsi que ceux de la vegetation |
|---|
| 210 | ! les valeurs choisies sont proches de celles que nous avions prises dans LMD5.3 avec Delphine Texier |
|---|
| 211 | !- |
|---|
| 212 | REAL(r_std),DIMENSION(nvm),SAVE :: snowa_dec = & |
|---|
| 213 | & (/ 0.45, 0., 0., 0.06, 0.06, & |
|---|
| 214 | & 0.11, 0.06, 0.11, 0.11, 0.52, & |
|---|
| 215 | & 0.52, 0.52, 0.52 /) |
|---|
| 216 | |
|---|
| 217 | ! leaf albedo of vegetation type, VIS+NIR |
|---|
| 218 | REAL(r_std),DIMENSION(nvm*2),SAVE :: alb_leaf = & |
|---|
| 219 | & (/ .00, .04, .06, .06, .06, & |
|---|
| 220 | & .06, .06, .06, .06, .10, & |
|---|
| 221 | & .10, .10, .10, & |
|---|
| 222 | & .00, .20, .22, .22, .22, & |
|---|
| 223 | & .22, .22, .22, .22, .30, & |
|---|
| 224 | & .30, .30, .30 /) |
|---|
| 225 | !- |
|---|
| 226 | ! Table which contains the correlation between the soil types |
|---|
| 227 | ! and vegetation type. Two modes exist : |
|---|
| 228 | ! 1) pref_soil_veg = 0 then we have an equidistribution |
|---|
| 229 | ! of vegetation on soil types |
|---|
| 230 | ! 2) Else for each pft the prefered soil type is given : |
|---|
| 231 | ! 1=sand, 2=loan, 3=clay |
|---|
| 232 | ! The variable is initialized in slowproc. |
|---|
| 233 | INTEGER(i_std),DIMENSION(nvm,nstm) :: pref_soil_veg |
|---|
| 234 | !- |
|---|
| 235 | ! albedo of dead leaves, VIS+NIR |
|---|
| 236 | REAL(r_std),DIMENSION(2),SAVE :: alb_deadleaf = (/ .12, .35/) |
|---|
| 237 | ! albedo of ice, VIS+NIR |
|---|
| 238 | REAL(r_std),DIMENSION(2),SAVE :: alb_ice = (/ .60, .20/) |
|---|
| 239 | !- |
|---|
| 240 | ! Is veget_ori array stored in restart file |
|---|
| 241 | LOGICAL,PARAMETER :: ldveget_ori_on_restart = .TRUE. |
|---|
| 242 | !- |
|---|
| 243 | ! Set to .TRUE. if you want q_cdrag coming from GCM |
|---|
| 244 | LOGICAL,SAVE :: ldq_cdrag_from_gcm = .FALSE. |
|---|
| 245 | !- |
|---|
| 246 | ! Constant in the computation of surface resistance |
|---|
| 247 | REAL(r_std),PARAMETER :: rayt_cste = 125. |
|---|
| 248 | !- |
|---|
| 249 | ! Size of local array to keep saturated humidity |
|---|
| 250 | ! at each temperature level |
|---|
| 251 | INTEGER(i_std),PARAMETER :: max_temp=370 |
|---|
| 252 | ! Minimum temperature for saturated humidity |
|---|
| 253 | INTEGER(i_std),PARAMETER :: min_temp=100 |
|---|
| 254 | ! Local array to keep saturated humidity at each temperature level |
|---|
| 255 | REAL(r_std),DIMENSION(max_temp),SAVE :: qsfrict |
|---|
| 256 | !- |
|---|
| 257 | !=== |
|---|
| 258 | CONTAINS |
|---|
| 259 | !=== |
|---|
| 260 | SUBROUTINE qsatcalc (kjpindex,temp_in,pres_in,qsat_out) |
|---|
| 261 | !--------------------------------------------------------------------- |
|---|
| 262 | ! input value |
|---|
| 263 | ! Domain size |
|---|
| 264 | INTEGER(i_std),INTENT(in) :: kjpindex |
|---|
| 265 | ! Temperature in degre Kelvin |
|---|
| 266 | REAL(r_std),DIMENSION(kjpindex),INTENT(in) :: temp_in |
|---|
| 267 | ! Pressure |
|---|
| 268 | REAL(r_std),DIMENSION(kjpindex),INTENT(in) :: pres_in |
|---|
| 269 | ! output value |
|---|
| 270 | ! Result |
|---|
| 271 | REAL(r_std),DIMENSION(kjpindex),INTENT(out) :: qsat_out |
|---|
| 272 | !- |
|---|
| 273 | ! local variables |
|---|
| 274 | INTEGER(i_std), DIMENSION(kjpindex) :: jt |
|---|
| 275 | INTEGER(i_std) :: ji |
|---|
| 276 | REAL(r_std),DIMENSION(kjpindex) :: zz_a, zz_b, zz_f |
|---|
| 277 | INTEGER(i_std) :: nbad |
|---|
| 278 | INTEGER(i_std),DIMENSION(1) :: lo |
|---|
| 279 | !--------------------------------------------------------------------- |
|---|
| 280 | IF (l_qsat_first) THEN |
|---|
| 281 | CALL qsfrict_init |
|---|
| 282 | l_qsat_first = .FALSE. |
|---|
| 283 | ENDIF |
|---|
| 284 | !- |
|---|
| 285 | ! 1. computes qsat interpolation into two successive temperature |
|---|
| 286 | !- |
|---|
| 287 | jt = INT(temp_in(:)) |
|---|
| 288 | !- |
|---|
| 289 | nbad = COUNT(jt(:) >= max_temp-1) |
|---|
| 290 | IF (nbad > 0) THEN |
|---|
| 291 | WRITE(numout,*) ' qsatcalc: temperature too high at ', & |
|---|
| 292 | & nbad, ' points.' |
|---|
| 293 | IF (.NOT.diag_qsat) THEN |
|---|
| 294 | CALL ipslerr(2,'qsatcalc','diffuco', '', & |
|---|
| 295 | & 'temperature incorect.') |
|---|
| 296 | ELSE |
|---|
| 297 | lo = MAXLOC(temp_in(:)) |
|---|
| 298 | WRITE(numout,*) & |
|---|
| 299 | & 'Maximum temperature ( ',MAXVAL(temp_in),') found at ',lo(1) |
|---|
| 300 | WHERE (jt(:) >= max_temp-1) jt(:) = max_temp-1 |
|---|
| 301 | ENDIF |
|---|
| 302 | ENDIF |
|---|
| 303 | !- |
|---|
| 304 | nbad = COUNT(jt(:) <= min_temp) |
|---|
| 305 | IF (nbad > 0) THEN |
|---|
| 306 | WRITE(numout,*) ' qsatcalc: temperature too low at ', & |
|---|
| 307 | & nbad, ' points.' |
|---|
| 308 | IF (.NOT.diag_qsat) THEN |
|---|
| 309 | CALL ipslerr(2,'qsatcalc','diffuco', '', & |
|---|
| 310 | & 'temperature incorect.') |
|---|
| 311 | ELSE |
|---|
| 312 | lo = MINLOC(temp_in(:)) |
|---|
| 313 | WRITE(numout,*) & |
|---|
| 314 | & 'Minimum temperature ( ',MINVAL(temp_in),') found at ',lo(1) |
|---|
| 315 | WHERE (jt(:) <= min_temp) jt(:) = min_temp |
|---|
| 316 | ENDIF |
|---|
| 317 | ENDIF |
|---|
| 318 | !- |
|---|
| 319 | DO ji = 1, kjpindex |
|---|
| 320 | zz_f(ji) = temp_in(ji)-FLOAT(jt(ji)) |
|---|
| 321 | zz_a(ji) = qsfrict(jt(ji)) |
|---|
| 322 | zz_b(ji) = qsfrict(jt(ji)+1) |
|---|
| 323 | ENDDO |
|---|
| 324 | !- |
|---|
| 325 | ! 2. interpolates between this two values |
|---|
| 326 | !- |
|---|
| 327 | DO ji = 1, kjpindex |
|---|
| 328 | qsat_out(ji) = ((zz_b(ji)-zz_a(ji))*zz_f(ji)+zz_a(ji))/pres_in(ji) |
|---|
| 329 | ENDDO |
|---|
| 330 | !---------------------- |
|---|
| 331 | END SUBROUTINE qsatcalc |
|---|
| 332 | !=== |
|---|
| 333 | FUNCTION qsat (temp_in,pres_in) RESULT (qsat_result) |
|---|
| 334 | !!-------------------------------------------------------------------- |
|---|
| 335 | !! FUNCTION qsat (temp_in, pres_in) RESULT (qsat_result) |
|---|
| 336 | !!-------------------------------------------------------------------- |
|---|
| 337 | REAL(r_std),INTENT(in) :: temp_in ! Temperature in degre Kelvin |
|---|
| 338 | REAL(r_std),INTENT(in) :: pres_in ! Pressure |
|---|
| 339 | REAL(r_std) :: qsat_result |
|---|
| 340 | !- |
|---|
| 341 | INTEGER(i_std) :: jt |
|---|
| 342 | REAL(r_std) :: zz_a,zz_b,zz_f |
|---|
| 343 | !--------------------------------------------------------------------- |
|---|
| 344 | IF (l_qsat_first) THEN |
|---|
| 345 | CALL qsfrict_init |
|---|
| 346 | l_qsat_first = .FALSE. |
|---|
| 347 | ENDIF |
|---|
| 348 | !- |
|---|
| 349 | ! 1. computes qsat interpolation into two successive temperature |
|---|
| 350 | !- |
|---|
| 351 | jt = INT(temp_in) |
|---|
| 352 | !- |
|---|
| 353 | IF (jt >= max_temp-1) THEN |
|---|
| 354 | WRITE(numout,*) & |
|---|
| 355 | & ' We stop. temperature too BIG : ',temp_in, & |
|---|
| 356 | & ' approximation for : ',jt |
|---|
| 357 | IF (.NOT.diag_qsat) THEN |
|---|
| 358 | CALL ipslerr(2,'qsat','', '',& |
|---|
| 359 | & 'temperature incorect.') |
|---|
| 360 | ELSE |
|---|
| 361 | qsat_result = 999999. |
|---|
| 362 | RETURN |
|---|
| 363 | ENDIF |
|---|
| 364 | ENDIF |
|---|
| 365 | !- |
|---|
| 366 | IF (jt <= min_temp ) THEN |
|---|
| 367 | WRITE(numout,*) & |
|---|
| 368 | & ' We stop. temperature too SMALL : ',temp_in, & |
|---|
| 369 | & ' approximation for : ',jt |
|---|
| 370 | IF (.NOT.diag_qsat) THEN |
|---|
| 371 | CALL ipslerr(2,'qsat','', '',& |
|---|
| 372 | & 'temperature incorect.') |
|---|
| 373 | ELSE |
|---|
| 374 | qsat_result = -999999. |
|---|
| 375 | RETURN |
|---|
| 376 | ENDIF |
|---|
| 377 | ENDIF |
|---|
| 378 | !- |
|---|
| 379 | zz_f = temp_in-FLOAT(jt) |
|---|
| 380 | zz_a = qsfrict(jt) |
|---|
| 381 | zz_b = qsfrict(jt+1) |
|---|
| 382 | !- |
|---|
| 383 | ! 2. interpolates between this two values |
|---|
| 384 | !- |
|---|
| 385 | qsat_result = ((zz_b-zz_a)*zz_f+zz_a)/pres_in |
|---|
| 386 | !---------------- |
|---|
| 387 | END FUNCTION qsat |
|---|
| 388 | !=== |
|---|
| 389 | SUBROUTINE dev_qsatcalc (kjpindex,temp_in,pres_in,dev_qsat_out) |
|---|
| 390 | !--------------------------------------------------------------------- |
|---|
| 391 | ! Domain size |
|---|
| 392 | INTEGER(i_std),INTENT(in) :: kjpindex |
|---|
| 393 | ! Temperature in degre Kelvin |
|---|
| 394 | REAL(r_std),DIMENSION(kjpindex),INTENT(in) :: temp_in |
|---|
| 395 | ! Pressure |
|---|
| 396 | REAL(r_std),DIMENSION(kjpindex),INTENT(in) :: pres_in |
|---|
| 397 | ! Result |
|---|
| 398 | REAL(r_std),DIMENSION(kjpindex),INTENT(out) :: dev_qsat_out |
|---|
| 399 | !- |
|---|
| 400 | INTEGER(i_std),DIMENSION(kjpindex) :: jt |
|---|
| 401 | INTEGER(i_std) :: ji |
|---|
| 402 | REAL(r_std),DIMENSION(kjpindex) :: zz_a, zz_b, zz_c, zz_f |
|---|
| 403 | INTEGER(i_std) :: nbad |
|---|
| 404 | !--------------------------------------------------------------------- |
|---|
| 405 | IF (l_qsat_first) THEN |
|---|
| 406 | CALL qsfrict_init |
|---|
| 407 | l_qsat_first = .FALSE. |
|---|
| 408 | ENDIF |
|---|
| 409 | !- |
|---|
| 410 | ! 1. computes qsat interpolation into two successive temperature |
|---|
| 411 | !- |
|---|
| 412 | jt = INT(temp_in(:)+undemi) |
|---|
| 413 | !- |
|---|
| 414 | nbad = COUNT( jt(:) >= max_temp-1 ) |
|---|
| 415 | IF (nbad > 0) THEN |
|---|
| 416 | WRITE(numout,*) & |
|---|
| 417 | & ' dev_qsatcalc: temperature too high at ',nbad,' points.' |
|---|
| 418 | IF (.NOT.diag_qsat) THEN |
|---|
| 419 | CALL ipslerr(3,'dev_qsatcalc','', '', & |
|---|
| 420 | & 'temperature incorect.') |
|---|
| 421 | ELSE |
|---|
| 422 | WHERE (jt(:) >= max_temp-1) jt(:) = max_temp-1 |
|---|
| 423 | ENDIF |
|---|
| 424 | ENDIF |
|---|
| 425 | !- |
|---|
| 426 | nbad = COUNT( jt(:) <= min_temp ) |
|---|
| 427 | IF (nbad > 0) THEN |
|---|
| 428 | WRITE(numout,*) & |
|---|
| 429 | & ' dev_qsatcalc: temperature too low at ',nbad,' points.' |
|---|
| 430 | IF (.NOT.diag_qsat) THEN |
|---|
| 431 | CALL ipslerr(3,'dev_qsatcalc', '', '',& |
|---|
| 432 | & 'temperature incorect.') |
|---|
| 433 | ELSE |
|---|
| 434 | WHERE (jt(:) <= min_temp) jt(:) = min_temp |
|---|
| 435 | ENDIF |
|---|
| 436 | ENDIF |
|---|
| 437 | !- |
|---|
| 438 | DO ji=1,kjpindex |
|---|
| 439 | zz_f(ji) = temp_in(ji)+undemi-FLOAT(jt(ji)) |
|---|
| 440 | zz_a(ji) = qsfrict(jt(ji)-1) |
|---|
| 441 | zz_b(ji) = qsfrict(jt(ji)) |
|---|
| 442 | zz_c(ji) = qsfrict(jt(ji)+1) |
|---|
| 443 | ENDDO |
|---|
| 444 | !- |
|---|
| 445 | ! 2. interpolates between this two values |
|---|
| 446 | !- |
|---|
| 447 | DO ji = 1, kjpindex |
|---|
| 448 | dev_qsat_out(ji) = & |
|---|
| 449 | & ((zz_c(ji)-deux*zz_b(ji)+zz_a(ji))*(zz_f(ji)-un) + & |
|---|
| 450 | & zz_c(ji)-zz_b(ji))/pres_in(ji) |
|---|
| 451 | ENDDO |
|---|
| 452 | !-------------------------- |
|---|
| 453 | END SUBROUTINE dev_qsatcalc |
|---|
| 454 | !=== |
|---|
| 455 | FUNCTION dev_qsat (temp_in,pres_in) RESULT (dev_qsat_result) |
|---|
| 456 | !!-------------------------------------------------------------------- |
|---|
| 457 | !! FUNCTION dev_qsat (temp_in, pres_in) RESULT (dev_qsat_result) |
|---|
| 458 | !! computes deviation of qsat |
|---|
| 459 | !!-------------------------------------------------------------------- |
|---|
| 460 | REAL(r_std),INTENT(in) :: pres_in ! Pressure |
|---|
| 461 | REAL(r_std),INTENT(in) :: temp_in ! Temperture in degre Kelvin |
|---|
| 462 | REAL(r_std) :: dev_qsat_result |
|---|
| 463 | !- |
|---|
| 464 | INTEGER(i_std) :: jt |
|---|
| 465 | REAL(r_std) :: zz_a, zz_b, zz_c, zz_f |
|---|
| 466 | !--------------------------------------------------------------------- |
|---|
| 467 | IF (l_qsat_first) THEN |
|---|
| 468 | CALL qsfrict_init |
|---|
| 469 | l_qsat_first = .FALSE. |
|---|
| 470 | ENDIF |
|---|
| 471 | !- |
|---|
| 472 | ! 1. computes qsat deviation interpolation |
|---|
| 473 | ! into two successive temperature |
|---|
| 474 | !- |
|---|
| 475 | jt = INT(temp_in+undemi) |
|---|
| 476 | !- |
|---|
| 477 | IF (jt >= max_temp-1) THEN |
|---|
| 478 | WRITE(numout,*) & |
|---|
| 479 | & ' We stop. temperature too HIGH : ',temp_in, & |
|---|
| 480 | & ' approximation for : ',jt |
|---|
| 481 | IF (.NOT.diag_qsat) THEN |
|---|
| 482 | CALL ipslerr(3,'dev_qsat','', '',& |
|---|
| 483 | & 'temperature incorect.') |
|---|
| 484 | ELSE |
|---|
| 485 | dev_qsat_result = 999999. |
|---|
| 486 | RETURN |
|---|
| 487 | ENDIF |
|---|
| 488 | ENDIF |
|---|
| 489 | !- |
|---|
| 490 | IF (jt <= min_temp ) THEN |
|---|
| 491 | WRITE(numout,*) & |
|---|
| 492 | & ' We stop. temperature too LOW : ',temp_in, & |
|---|
| 493 | & ' approximation for : ',jt |
|---|
| 494 | IF (.NOT.diag_qsat) THEN |
|---|
| 495 | CALL ipslerr(3,'dev_qsat','', '',& |
|---|
| 496 | & 'temperature incorect.') |
|---|
| 497 | ELSE |
|---|
| 498 | dev_qsat_result = -999999. |
|---|
| 499 | RETURN |
|---|
| 500 | ENDIF |
|---|
| 501 | ENDIF |
|---|
| 502 | !- |
|---|
| 503 | zz_f = temp_in+undemi-FLOAT(jt) |
|---|
| 504 | zz_a = qsfrict(jt-1) |
|---|
| 505 | zz_b = qsfrict(jt) |
|---|
| 506 | zz_c = qsfrict(jt+1) |
|---|
| 507 | !- |
|---|
| 508 | ! 2. interpolates |
|---|
| 509 | !- |
|---|
| 510 | dev_qsat_result=((zz_c-deux*zz_b+zz_a)*(zz_f-un)+zz_c-zz_b)/pres_in |
|---|
| 511 | !-------------------- |
|---|
| 512 | END FUNCTION dev_qsat |
|---|
| 513 | !=== |
|---|
| 514 | SUBROUTINE qsfrict_init |
|---|
| 515 | !!-------------------------------------------------------------------- |
|---|
| 516 | !! The qsfrict_init routine initialises qsfrict array |
|---|
| 517 | !! to store precalculated value for qsat |
|---|
| 518 | !!-------------------------------------------------------------------- |
|---|
| 519 | INTEGER(i_std) :: ji |
|---|
| 520 | REAL(r_std) :: zrapp,zcorr,ztemperature,zqsat |
|---|
| 521 | !--------------------------------------------------------------------- |
|---|
| 522 | ! initialisation |
|---|
| 523 | zrapp = msmlr_h2o/msmlr_air |
|---|
| 524 | zcorr = 0.00320991_r_std |
|---|
| 525 | ! computes saturated humidity one time and store in qsfrict local array |
|---|
| 526 | DO ji=100,max_temp |
|---|
| 527 | ztemperature = FLOAT(ji) |
|---|
| 528 | IF (ztemperature < 273._r_std) THEN |
|---|
| 529 | zqsat = zrapp*10.0_r_std**(2.07023_r_std-zcorr*ztemperature & |
|---|
| 530 | & -2484.896/ztemperature+3.56654*LOG10(ztemperature)) |
|---|
| 531 | ELSE |
|---|
| 532 | zqsat = zrapp*10.0**(23.8319-2948.964/ztemperature & |
|---|
| 533 | & -5.028*LOG10(ztemperature) & |
|---|
| 534 | & -29810.16*EXP(-0.0699382*ztemperature) & |
|---|
| 535 | & +25.21935*EXP(-2999.924/ztemperature)) |
|---|
| 536 | ENDIF |
|---|
| 537 | qsfrict (ji) = zqsat |
|---|
| 538 | ENDDO |
|---|
| 539 | !- |
|---|
| 540 | qsfrict(1:100) = zero |
|---|
| 541 | !- |
|---|
| 542 | IF (long_print) WRITE (numout,*) ' qsfrict_init done' |
|---|
| 543 | !-------------------------- |
|---|
| 544 | END SUBROUTINE qsfrict_init |
|---|
| 545 | !=== |
|---|
| 546 | FUNCTION tempfunc (temp_in) RESULT (tempfunc_result) |
|---|
| 547 | !!-------------------------------------------------------------------- |
|---|
| 548 | !! FUNCTION tempfunc (temp_in) RESULT (tempfunc_result) |
|---|
| 549 | !! this function interpolates value between ztempmin and ztempmax |
|---|
| 550 | !! used for lai detection |
|---|
| 551 | !!-------------------------------------------------------------------- |
|---|
| 552 | REAL(r_std),INTENT(in) :: temp_in !! Temperature in degre Kelvin |
|---|
| 553 | REAL(r_std) :: tempfunc_result |
|---|
| 554 | !- |
|---|
| 555 | REAL(r_std),PARAMETER :: ztempmin=273._r_std !! Temperature for laimin |
|---|
| 556 | REAL(r_std),PARAMETER :: ztempmax=293._r_std !! Temperature for laimax |
|---|
| 557 | REAL(r_std) :: zfacteur !! Interpolation factor |
|---|
| 558 | !--------------------------------------------------------------------- |
|---|
| 559 | zfacteur = un/(ztempmax-ztempmin)**2 |
|---|
| 560 | IF (temp_in > ztempmax) THEN |
|---|
| 561 | tempfunc_result = un |
|---|
| 562 | ELSEIF (temp_in < ztempmin) THEN |
|---|
| 563 | tempfunc_result = zero |
|---|
| 564 | ELSE |
|---|
| 565 | tempfunc_result = un-zfacteur*(ztempmax-temp_in)**2 |
|---|
| 566 | ENDIF |
|---|
| 567 | !-------------------- |
|---|
| 568 | END FUNCTION tempfunc |
|---|
| 569 | !=== |
|---|
| 570 | SUBROUTINE get_vegcorr (nolson,vegcorr,nobiocorr) |
|---|
| 571 | !--------------------------------------------------------------------- |
|---|
| 572 | INTEGER(i_std),INTENT(in) :: nolson |
|---|
| 573 | REAL(r_std),DIMENSION(nolson,nvm),INTENT(out) :: vegcorr(nolson,nvm) |
|---|
| 574 | REAL(r_std),DIMENSION(nolson,nnobio),INTENT(out) :: nobiocorr |
|---|
| 575 | !- |
|---|
| 576 | INTEGER(i_std) :: ib |
|---|
| 577 | INTEGER(i_std),PARAMETER :: nolson94 = 94 |
|---|
| 578 | INTEGER(i_std),PARAMETER :: nvm13 = 13 |
|---|
| 579 | !--------------------------------------------------------------------- |
|---|
| 580 | IF (nolson /= nolson94) THEN |
|---|
| 581 | WRITE(numout,*) nolson,nolson94 |
|---|
| 582 | CALL ipslerr(3,'get_vegcorr', '', '',& |
|---|
| 583 | & 'wrong number of OLSON vegetation types.') |
|---|
| 584 | ENDIF |
|---|
| 585 | IF (nvm /= nvm13) THEN |
|---|
| 586 | WRITE(numout,*) nvm,nvm13 |
|---|
| 587 | CALL ipslerr(3,'get_vegcorr', '', '',& |
|---|
| 588 | & 'wrong number of SECHIBA vegetation types.') |
|---|
| 589 | ENDIF |
|---|
| 590 | !- |
|---|
| 591 | ! 1 set the indices of non-biospheric surface types to 0. |
|---|
| 592 | !- |
|---|
| 593 | nobiocorr(:,:) = 0. |
|---|
| 594 | !- |
|---|
| 595 | ! 2 Here we construct the correspondance table |
|---|
| 596 | ! between Olson and the following SECHIBA Classes. |
|---|
| 597 | ! vegcorr(i,:)+nobiocorr(i,:) = 1. for all i. |
|---|
| 598 | !- |
|---|
| 599 | ! The modified OLSON types found in file carteveg5km.nc |
|---|
| 600 | ! created by Nicolas Viovy : |
|---|
| 601 | ! 1 Urban |
|---|
| 602 | vegcorr( 1,:) = & |
|---|
| 603 | & (/1.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/) |
|---|
| 604 | ! 2 Cool low sparse grassland |
|---|
| 605 | vegcorr( 2,:) = & |
|---|
| 606 | & (/0.2, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.8, 0.0, 0.0, 0.0/) |
|---|
| 607 | ! 3 Cold conifer forest |
|---|
| 608 | vegcorr( 3,:) = & |
|---|
| 609 | & (/0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 1.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/) |
|---|
| 610 | ! 4 Cold deciduous conifer forest |
|---|
| 611 | vegcorr( 4,:) = & |
|---|
| 612 | & (/0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 1.0, 0.0, 0.0, 0.0, 0.0/) |
|---|
| 613 | ! 5 Cool Deciduous broadleaf forest |
|---|
| 614 | vegcorr( 5,:) = & |
|---|
| 615 | & (/0.0, 0.0, 0.0, 0.0, 0.0, 1.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/) |
|---|
| 616 | ! 6 Cool evergreen broadleaf forests |
|---|
| 617 | vegcorr( 6,:) = & |
|---|
| 618 | & (/0.0, 0.0, 0.0, 0.0, 1.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/) |
|---|
| 619 | ! 7 Cool tall grasses and shrubs |
|---|
| 620 | vegcorr( 7,:) = & |
|---|
| 621 | & (/0.1, 0.0, 0.0, 0.0, 0.1, 0.0, 0.0, 0.0, 0.0, 0.8, 0.0, 0.0, 0.0/) |
|---|
| 622 | ! 8 Warm C3 tall grasses and shrubs |
|---|
| 623 | vegcorr( 8,:) = & |
|---|
| 624 | & (/0.1, 0.0, 0.1, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.8, 0.0, 0.0, 0.0/) |
|---|
| 625 | ! 9 Warm C4 tall grases and shrubs |
|---|
| 626 | vegcorr( 9,:) = & |
|---|
| 627 | & (/0.1, 0.0, 0.1, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.8, 0.0, 0.0/) |
|---|
| 628 | ! 10 Bare desert |
|---|
| 629 | vegcorr(10,:) = & |
|---|
| 630 | & (/1.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/) |
|---|
| 631 | ! 11 Cold upland tundra |
|---|
| 632 | vegcorr(11,:) = & |
|---|
| 633 | & (/0.2, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.8, 0.0, 0.0, 0.0/) |
|---|
| 634 | ! 12 Cool irrigated grassland |
|---|
| 635 | vegcorr(12,:) = & |
|---|
| 636 | & (/0.1, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.9, 0.0, 0.0, 0.0/) |
|---|
| 637 | ! 13 Semi desert |
|---|
| 638 | vegcorr(13,:) = & |
|---|
| 639 | & (/0.7, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.3, 0.0, 0.0, 0.0/) |
|---|
| 640 | ! 14 Glacier ice |
|---|
| 641 | vegcorr(14,:) = & |
|---|
| 642 | & (/0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/) |
|---|
| 643 | nobiocorr(14,iice) = 1. |
|---|
| 644 | ! 15 Warm wooded wet swamp |
|---|
| 645 | vegcorr(15,:) = & |
|---|
| 646 | & (/0.2, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.8, 0.0, 0.0/) |
|---|
| 647 | ! 16 Inland water |
|---|
| 648 | vegcorr(16,:) = & |
|---|
| 649 | & (/1.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/) |
|---|
| 650 | ! 17 sea water |
|---|
| 651 | vegcorr(17,:) = & |
|---|
| 652 | & (/1.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/) |
|---|
| 653 | ! 18 cool shrub evergreen |
|---|
| 654 | vegcorr(18,:) = & |
|---|
| 655 | & (/0.1, 0.0, 0.0, 0.0, 0.3, 0.0, 0.0, 0.0, 0.0, 0.6, 0.0, 0.0, 0.0/) |
|---|
| 656 | ! 19 cold shrub deciduous |
|---|
| 657 | vegcorr(19,:) = & |
|---|
| 658 | & (/0.2, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.2, 0.0, 0.6, 0.0, 0.0, 0.0/) |
|---|
| 659 | ! 20 Cold evergreen forest and fields |
|---|
| 660 | vegcorr(20,:) = & |
|---|
| 661 | & (/0.0, 0.0, 0.0, 0.0, 0.5, 0.0, 0.0, 0.0, 0.0, 0.5, 0.0, 0.0, 0.0/) |
|---|
| 662 | ! 21 cool rain forest |
|---|
| 663 | vegcorr(21,:) = & |
|---|
| 664 | & (/0.0, 0.0, 0.0, 0.0, 0.8, 0.0, 0.0, 0.0, 0.0, 0.2, 0.0, 0.0, 0.0/) |
|---|
| 665 | ! 22 cold conifer boreal forest |
|---|
| 666 | vegcorr(22,:) = & |
|---|
| 667 | & (/0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.8, 0.0, 0.0, 0.2, 0.0, 0.0, 0.0/) |
|---|
| 668 | ! 23 cool conifer forest |
|---|
| 669 | vegcorr(23,:) = & |
|---|
| 670 | & (/0.0, 0.0, 0.0, 0.8, 0.0, 0.0, 0.0, 0.0, 0.0, 0.2, 0.0, 0.0, 0.0/) |
|---|
| 671 | ! 24 warm mixed forest |
|---|
| 672 | vegcorr(24,:) = & |
|---|
| 673 | & (/0.0, 0.4, 0.4, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.2, 0.0, 0.0/) |
|---|
| 674 | ! 25 cool mixed forest |
|---|
| 675 | vegcorr(25,:) = & |
|---|
| 676 | & (/0.0, 0.0, 0.0, 0.4, 0.0, 0.4, 0.0, 0.0, 0.0, 0.2, 0.0, 0.0, 0.0/) |
|---|
| 677 | ! 26 cool broadleaf forest |
|---|
| 678 | vegcorr(26,:) = & |
|---|
| 679 | & (/0.0, 0.0, 0.0, 0.0, 0.0, 0.9, 0.0, 0.0, 0.0, 0.1, 0.0, 0.0, 0.0/) |
|---|
| 680 | ! 27 cool deciduous broadleaf forest |
|---|
| 681 | vegcorr(27,:) = & |
|---|
| 682 | & (/0.0, 0.0, 0.0, 0.0, 0.3, 0.5, 0.0, 0.0, 0.0, 0.2, 0.0, 0.0, 0.0/) |
|---|
| 683 | ! 28 warm montane tropical forest |
|---|
| 684 | vegcorr(28,:) = & |
|---|
| 685 | & (/0.0, 0.9, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.1, 0.0, 0.0/) |
|---|
| 686 | ! 29 warm seasonal tropical forest |
|---|
| 687 | vegcorr(29,:) = & |
|---|
| 688 | & (/0.0, 0.5, 0.2, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.3, 0.0, 0.0/) |
|---|
| 689 | ! 30 cool crops and towns |
|---|
| 690 | vegcorr(30,:) = & |
|---|
| 691 | & (/0.2, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.8, 0.0/) |
|---|
| 692 | ! 31 warm crops and towns |
|---|
| 693 | vegcorr(31,:) = & |
|---|
| 694 | & (/0.2, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.8/) |
|---|
| 695 | ! 32 cool crops and towns |
|---|
| 696 | vegcorr(32,:) = & |
|---|
| 697 | & (/0.2, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.8, 0.0/) |
|---|
| 698 | ! 33 warm dry tropical woods |
|---|
| 699 | vegcorr(33,:) = & |
|---|
| 700 | & (/0.2, 0.0, 0.5, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.3, 0.0, 0.0, 0.0/) |
|---|
| 701 | ! 34 warm tropical rain forest |
|---|
| 702 | vegcorr(34,:) = & |
|---|
| 703 | & (/0.0, 1.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/) |
|---|
| 704 | ! 35 warm tropical degraded forest |
|---|
| 705 | vegcorr(35,:) = & |
|---|
| 706 | & (/0.1, 0.6, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.3, 0.0, 0.0/) |
|---|
| 707 | ! 36 warm corn and beans cropland |
|---|
| 708 | vegcorr(36,:) = & |
|---|
| 709 | & (/0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 1.0/) |
|---|
| 710 | ! 37 cool corn and bean cropland |
|---|
| 711 | vegcorr(37,:) = & |
|---|
| 712 | & (/0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 1.0, 0.0/) |
|---|
| 713 | ! 38 warm rice paddy and field |
|---|
| 714 | vegcorr(38,:) = & |
|---|
| 715 | & (/0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 1.0/) |
|---|
| 716 | ! 39 hot irrigated cropland |
|---|
| 717 | vegcorr(39,:) = & |
|---|
| 718 | & (/0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 1.0/) |
|---|
| 719 | ! 40 cool irrigated cropland |
|---|
| 720 | vegcorr(40,:) = & |
|---|
| 721 | & (/0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 1.0, 0.0/) |
|---|
| 722 | ! 41 cold irrigated cropland |
|---|
| 723 | vegcorr(41,:) = & |
|---|
| 724 | & (/0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 1.0, 0.0/) |
|---|
| 725 | ! 42 cool grasses and shrubs |
|---|
| 726 | vegcorr(42,:) = & |
|---|
| 727 | & (/0.1, 0.0, 0.0, 0.0, 0.0, 0.2, 0.0, 0.0, 0.0, 0.7, 0.0, 0.0, 0.0/) |
|---|
| 728 | ! 43 hot and mild grasses and shrubs |
|---|
| 729 | vegcorr(43,:) = & |
|---|
| 730 | & (/0.2, 0.0, 0.1, 0.0, 0.0, 0.1, 0.0, 0.0, 0.0, 0.0, 0.6, 0.0, 0.0/) |
|---|
| 731 | ! 44 cold grassland |
|---|
| 732 | vegcorr(44,:) = & |
|---|
| 733 | & (/0.1, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.9, 0.0, 0.0, 0.0/) |
|---|
| 734 | ! 45 Savanna (woods) C3 |
|---|
| 735 | vegcorr(45,:) = & |
|---|
| 736 | & (/0.1, 0.2, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.7, 0.0, 0.0, 0.0/) |
|---|
| 737 | ! 46 Savanna woods C4 |
|---|
| 738 | vegcorr(46,:) = & |
|---|
| 739 | & (/0.1, 0.2, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.7, 0.0, 0.0/) |
|---|
| 740 | ! 47 Mire, bog, fen |
|---|
| 741 | vegcorr(47,:) = & |
|---|
| 742 | & (/0.1, 0.0, 0.0, 0.2, 0.0, 0.0, 0.0, 0.0, 0.0, 0.7, 0.0, 0.0, 0.0/) |
|---|
| 743 | ! 48 Warm marsh wetland |
|---|
| 744 | vegcorr(48,:) = & |
|---|
| 745 | & (/0.0, 0.0, 0.0, 0.0, 0.2, 0.0, 0.0, 0.0, 0.0, 0.8, 0.0, 0.0, 0.0/) |
|---|
| 746 | ! 49 cold marsh wetland |
|---|
| 747 | vegcorr(49,:) = & |
|---|
| 748 | & (/0.0, 0.0, 0.0, 0.1, 0.1, 0.0, 0.0, 0.0, 0.0, 0.8, 0.0, 0.0, 0.0/) |
|---|
| 749 | ! 50 mediteraean scrub |
|---|
| 750 | vegcorr(50,:) = & |
|---|
| 751 | & (/0.1, 0.0, 0.0, 0.0, 0.1, 0.0, 0.0, 0.0, 0.0, 0.8, 0.0, 0.0, 0.0/) |
|---|
| 752 | ! 51 Cool dry woody scrub |
|---|
| 753 | vegcorr(51,:) = & |
|---|
| 754 | & (/0.3, 0.0, 0.0, 0.0, 0.1, 0.0, 0.0, 0.0, 0.0, 0.6, 0.0, 0.0, 0.0/) |
|---|
| 755 | ! 52 Warm dry evergreen woods |
|---|
| 756 | vegcorr(52,:) = & |
|---|
| 757 | & (/0.1, 0.9, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/) |
|---|
| 758 | ! 53 Volcanic rocks |
|---|
| 759 | vegcorr(53,:) = & |
|---|
| 760 | & (/1.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/) |
|---|
| 761 | ! 54 sand desert |
|---|
| 762 | vegcorr(54,:) = & |
|---|
| 763 | & (/1.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/) |
|---|
| 764 | ! 55 warm semi desert shrubs |
|---|
| 765 | vegcorr(55,:) = & |
|---|
| 766 | & (/0.7, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.3, 0.0, 0.0, 0.0/) |
|---|
| 767 | ! 56 cool semi desert shrubs |
|---|
| 768 | vegcorr(56,:) = & |
|---|
| 769 | & (/0.6, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.4, 0.0, 0.0, 0.0/) |
|---|
| 770 | ! 57 semi desert sage |
|---|
| 771 | vegcorr(57,:) = & |
|---|
| 772 | & (/0.4, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.6, 0.0, 0.0, 0.0/) |
|---|
| 773 | ! 58 Barren tundra |
|---|
| 774 | vegcorr(58,:) = & |
|---|
| 775 | & (/0.6, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.4, 0.0, 0.0, 0.0/) |
|---|
| 776 | ! 59 cool southern hemisphere mixed forest |
|---|
| 777 | vegcorr(59,:) = & |
|---|
| 778 | & (/0.1, 0.0, 0.0, 0.0, 0.3, 0.3, 0.0, 0.0, 0.0, 0.3, 0.0, 0.0, 0.0/) |
|---|
| 779 | ! 60 cool fields and woods |
|---|
| 780 | vegcorr(60,:) = & |
|---|
| 781 | & (/0.0, 0.0, 0.0, 0.0, 0.0, 0.4, 0.0, 0.0, 0.0, 0.0, 0.0, 0.6, 0.0/) |
|---|
| 782 | ! 61 warm forest and filed |
|---|
| 783 | vegcorr(61,:) = & |
|---|
| 784 | & (/0.0, 0.4, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.6/) |
|---|
| 785 | ! 62 cool forest and field |
|---|
| 786 | vegcorr(62,:) = & |
|---|
| 787 | & (/0.0, 0.0, 0.0, 0.0, 0.0, 0.4, 0.0, 0.0, 0.0, 0.0, 0.0, 0.6, 0.0/) |
|---|
| 788 | ! 63 warm C3 fields and woody savanna |
|---|
| 789 | vegcorr(63,:) = & |
|---|
| 790 | & (/0.1, 0.0, 0.3, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.6, 0.0/) |
|---|
| 791 | ! 64 warm C4 fields and woody savanna |
|---|
| 792 | vegcorr(64,:) = & |
|---|
| 793 | & (/0.1, 0.0, 0.3, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.6/) |
|---|
| 794 | ! 65 cool fields and woody savanna |
|---|
| 795 | vegcorr(65,:) = & |
|---|
| 796 | & (/0.0, 0.0, 0.4, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.6, 0.0/) |
|---|
| 797 | ! 66 warm succulent and thorn scrub |
|---|
| 798 | vegcorr(66,:) = & |
|---|
| 799 | & (/0.1, 0.0, 0.0, 0.0, 0.1, 0.0, 0.0, 0.0, 0.0, 0.8, 0.0, 0.0, 0.0/) |
|---|
| 800 | ! 67 cold small leaf mixed woods |
|---|
| 801 | vegcorr(67,:) = & |
|---|
| 802 | & (/0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.2, 0.3, 0.0, 0.5, 0.0, 0.0, 0.0/) |
|---|
| 803 | ! 68 cold deciduous and mixed boreal fores |
|---|
| 804 | vegcorr(68,:) = & |
|---|
| 805 | & (/0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.7, 0.0, 0.0, 0.3, 0.0, 0.0, 0.0/) |
|---|
| 806 | ! 69 cold narrow conifers |
|---|
| 807 | vegcorr(69,:) = & |
|---|
| 808 | & (/0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.9, 0.0, 0.0, 0.1, 0.0, 0.0, 0.0/) |
|---|
| 809 | ! 70 cold wooded tundra |
|---|
| 810 | vegcorr(70,:) = & |
|---|
| 811 | & (/0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.3, 0.0, 0.7, 0.0, 0.0, 0.0/) |
|---|
| 812 | ! 71 cold heath scrub |
|---|
| 813 | vegcorr(71,:) = & |
|---|
| 814 | & (/0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.3, 0.0, 0.7, 0.0, 0.0, 0.0/) |
|---|
| 815 | ! 72 Polar and alpine desert |
|---|
| 816 | vegcorr(72,:) = & |
|---|
| 817 | & (/0.9, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.1, 0.0, 0.0, 0.0/) |
|---|
| 818 | ! 73 warm Mangrove |
|---|
| 819 | vegcorr(73,:) = & |
|---|
| 820 | & (/0.0, 1.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/) |
|---|
| 821 | ! 74 cool crop and water mixtures |
|---|
| 822 | vegcorr(74,:) = & |
|---|
| 823 | & (/0.1, 0.0, 0.0, 0.0, 0.0, 0.3, 0.0, 0.0, 0.0, 0.0, 0.0, 0.6, 0.0/) |
|---|
| 824 | ! 75 cool southern hemisphere mixed forest |
|---|
| 825 | vegcorr(75,:) = & |
|---|
| 826 | & (/0.0, 0.0, 0.0, 0.0, 0.4, 0.4, 0.0, 0.0, 0.0, 0.2, 0.0, 0.0, 0.0/) |
|---|
| 827 | ! 76 cool moist eucalyptus |
|---|
| 828 | vegcorr(76,:) = & |
|---|
| 829 | & (/0.0, 0.0, 0.0, 0.0, 0.8, 0.0, 0.0, 0.0, 0.0, 0.2, 0.0, 0.0, 0.0/) |
|---|
| 830 | ! 77 warm rain green tropical forest |
|---|
| 831 | vegcorr(77,:) = & |
|---|
| 832 | & (/0.0, 1.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/) |
|---|
| 833 | ! 78 warm C3 woody savanna |
|---|
| 834 | vegcorr(78,:) = & |
|---|
| 835 | & (/0.0, 0.0, 0.4, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.6, 0.0, 0.0, 0.0/) |
|---|
| 836 | ! 79 warm C4 woody savanna |
|---|
| 837 | vegcorr(79,:) = & |
|---|
| 838 | & (/0.0, 0.0, 0.4, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.6, 0.0, 0.0, 0.0/) |
|---|
| 839 | ! 80 cool woody savanna |
|---|
| 840 | vegcorr(80,:) = & |
|---|
| 841 | & (/0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.4, 0.0, 0.6, 0.0, 0.0, 0.0/) |
|---|
| 842 | ! 81 cold woody savanna |
|---|
| 843 | vegcorr(81,:) = & |
|---|
| 844 | & (/0.0, 0.0, 0.0, 0.4, 0.0, 0.0, 0.0, 0.0, 0.0, 0.6, 0.0, 0.0, 0.0/) |
|---|
| 845 | ! 82 warm broadleaf crops |
|---|
| 846 | vegcorr(82,:) = & |
|---|
| 847 | & (/0.1, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.9, 0.0/) |
|---|
| 848 | ! 83 warm C3 grass crops |
|---|
| 849 | vegcorr(83,:) = & |
|---|
| 850 | & (/0.1, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.9, 0.0/) |
|---|
| 851 | ! 84 warm C4 grass crops |
|---|
| 852 | vegcorr(84,:) = & |
|---|
| 853 | & (/0.1, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.9/) |
|---|
| 854 | ! 85 cool grass crops |
|---|
| 855 | vegcorr(85,:) = & |
|---|
| 856 | & (/0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 1.0, 0.0/) |
|---|
| 857 | ! 86 warm C3 crops grass,shrubs |
|---|
| 858 | vegcorr(86,:) = & |
|---|
| 859 | & (/0.0, 0.0, 0.0, 0.0, 0.2, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.8, 0.0/) |
|---|
| 860 | ! 87 cool crops,grass,shrubs |
|---|
| 861 | vegcorr(87,:) = & |
|---|
| 862 | & (/0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.5, 0.0, 0.5, 0.0/) |
|---|
| 863 | ! 88 warm evergreen tree crop |
|---|
| 864 | vegcorr(88,:) = & |
|---|
| 865 | & (/0.0, 0.8, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.2/) |
|---|
| 866 | ! 89 cool evergreen tree crop |
|---|
| 867 | vegcorr(89,:) = & |
|---|
| 868 | & (/0.0, 0.0, 0.0, 0.0, 0.8, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.2, 0.0/) |
|---|
| 869 | ! 90 cold evergreen tree crop |
|---|
| 870 | vegcorr(90,:) = & |
|---|
| 871 | & (/0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.8, 0.0, 0.0, 0.0, 0.0, 0.2, 0.0/) |
|---|
| 872 | ! 91 warm deciduous tree crop |
|---|
| 873 | vegcorr(91,:) = & |
|---|
| 874 | & (/0.0, 0.0, 0.8, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.2/) |
|---|
| 875 | ! 92 cool deciduous tree crop |
|---|
| 876 | vegcorr(92,:) = & |
|---|
| 877 | & (/0.0, 0.0, 0.0, 0.0, 0.0, 0.8, 0.0, 0.0, 0.0, 0.0, 0.0, 0.2, 0.0/) |
|---|
| 878 | ! 93 cold deciduous tree crop |
|---|
| 879 | vegcorr(93,:) = & |
|---|
| 880 | & (/0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.8, 0.0, 0.0, 0.0, 0.2, 0.0/) |
|---|
| 881 | ! 94 wet sclerophylic forest |
|---|
| 882 | vegcorr(94,:) = & |
|---|
| 883 | & (/0.0, 0.0, 1.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/) |
|---|
| 884 | !- |
|---|
| 885 | ! 3 Check the mapping for the Olson types which are going into the |
|---|
| 886 | ! the veget and nobio array. |
|---|
| 887 | !- |
|---|
| 888 | DO ib=1,nolson |
|---|
| 889 | IF ( ABS(SUM(vegcorr(ib,:))+SUM(nobiocorr(ib,:))-1.0) & |
|---|
| 890 | & > EPSILON(1.0)) THEN |
|---|
| 891 | WRITE(numout,*) 'Wrong correspondance for Olson type :', ib |
|---|
| 892 | CALL ipslerr(3,'get_vegcorr', '', '',& |
|---|
| 893 | & 'Wrong correspondance for Olson type.') |
|---|
| 894 | ENDIF |
|---|
| 895 | ENDDO |
|---|
| 896 | !------------------------- |
|---|
| 897 | END SUBROUTINE get_vegcorr |
|---|
| 898 | !=== |
|---|
| 899 | SUBROUTINE get_soilcorr (nzobler,textfrac_table) |
|---|
| 900 | !!-------------------------------------------------------------------- |
|---|
| 901 | !! The "get_soilcorr" routine defines the table of correspondence |
|---|
| 902 | !! between the Zobler types and the three texture |
|---|
| 903 | !! types known by SECHIBA & STOMATE : silt, sand and clay |
|---|
| 904 | !!-------------------------------------------------------------------- |
|---|
| 905 | INTEGER(i_std),INTENT(in) :: nzobler |
|---|
| 906 | REAL(r_std),DIMENSION(nzobler,nstm),INTENT(out) :: textfrac_table |
|---|
| 907 | !- |
|---|
| 908 | INTEGER(i_std),PARAMETER :: nbtypes_zobler = 7 |
|---|
| 909 | INTEGER(i_std) :: ib |
|---|
| 910 | !--------------------------------------------------------------------- |
|---|
| 911 | IF (nzobler /= nbtypes_zobler) THEN |
|---|
| 912 | CALL ipslerr(3,'get_soilcorr', 'nzobler /= nbtypes_zobler',& |
|---|
| 913 | & 'We do not have the correct number of classes', & |
|---|
| 914 | & ' in the code for the file.') |
|---|
| 915 | ENDIF |
|---|
| 916 | !- |
|---|
| 917 | ! Textural fraction for : silt sand clay |
|---|
| 918 | !- |
|---|
| 919 | textfrac_table(1,:) = (/ 0.12, 0.82, 0.06 /) |
|---|
| 920 | textfrac_table(2,:) = (/ 0.32, 0.58, 0.10 /) |
|---|
| 921 | textfrac_table(3,:) = (/ 0.39, 0.43, 0.18 /) |
|---|
| 922 | textfrac_table(4,:) = (/ 0.15, 0.58, 0.27 /) |
|---|
| 923 | textfrac_table(5,:) = (/ 0.34, 0.32, 0.34 /) |
|---|
| 924 | textfrac_table(6,:) = (/ 0.00, 1.00, 0.00 /) |
|---|
| 925 | textfrac_table(7,:) = (/ 0.39, 0.43, 0.18 /) |
|---|
| 926 | |
|---|
| 927 | DO ib=1,nzobler |
|---|
| 928 | IF (ABS(SUM(textfrac_table(ib,:))-1.0) > EPSILON(1.0)) THEN |
|---|
| 929 | WRITE(numout,*) & |
|---|
| 930 | & 'Error in the correspondence table', & |
|---|
| 931 | & ' sum is not equal to 1 in', ib |
|---|
| 932 | WRITE(numout,*) textfrac_table(ib,:) |
|---|
| 933 | CALL ipslerr(3,'get_soilcorr', 'SUM(textfrac_table(ib,:)) /= 1.0',& |
|---|
| 934 | & '', 'Error in the correspondence table') |
|---|
| 935 | ENDIF |
|---|
| 936 | ENDDO |
|---|
| 937 | !-------------------------- |
|---|
| 938 | END SUBROUTINE GET_soilcorr |
|---|
| 939 | !=== |
|---|
| 940 | !------------------------ |
|---|
| 941 | END MODULE constantes_veg |
|---|
