!copyright (C) 2001 MSC-RPN COMM %%%RPNPHY%%%
***S/P INIVEG
**
*
#include "phy_macros_f.h"
SUBROUTINE INIVEG( F, FSIZ, KOUNT, NI ) 2,43
*
#include "impnone.cdk"
*
INTEGER NI, KOUNT
INTEGER FSIZ
REAL F(FSIZ)
*
*
*Author
* Bernard Bilodeau and Stephane Belair (May 2000)
*
*Revision
* 001 B. Dugas (June 2000)
* Get it to work
* 002 B. Bilodeau (June 2001)
* Automatic arrays
*
*
*Object
* Initialize vegetation fields for the surface schemes
*
*
*Arguments
*
* - Input/Ouput -
* F field for permanent physics variables
* - Input -
* FSIZ dimension of F
* KOUNT current timestep number
* NI horizontal slice dimension
*
*
*NOTES INISURF has been split in two subroutines:
* INISURF and INIVEG. The former calls the latter.
*
*
#include "nclassvg.cdk"
*
**
*#include "indx_sfc.cdk"
*#include "consphy.cdk"
*#include "isbapar.cdk"
*#include "surfacepar.cdk"
*
#include "options.cdk"
#include "phybus.cdk"
*
*
* the geophysical fields determined from
* vegetation are done so using the following
* classification:
*
* Class Vegetation type
* ===== ===============
* 1 water
* 2 ice
* 3 inland lake
* 4 evergreen needleleaf trees
* 5 evergreen broadleaf trees
* 6 deciduous needleleaf trees
* 7 deciduous broadleaf trees
* 8 tropical broadleaf trees
* 9 drought deciduous trees
* 10 evergreen broadleaf shrub
* 11 deciduous shrubs
* 12 thorn shrubs
* 13 short grass and forbs
* 14 long grass
* 15 crops
* 16 rice
* 17 sugar
* 18 maize
* 19 cotton
* 20 irrigated crops
* 21 urban
* 22 tundra
* 23 swamp
* 24 desert
* 25 mixed shrubs
* 26 mixed wood forests
*
*
*
*********************************************************************
* TABLES FOR THE VEG CHARACTERISTICS FOR EACH VEG TYPE
*********************************************************************
*
*
REAL ALDAT(NCLASS), D2DAT(NCLASS), RSMINDAT(NCLASS)
REAL LAIDAT(NCLASS), VEGDAT(NCLASS)
REAL CVDAT(NCLASS), RGLDAT(NCLASS), GAMMADAT(NCLASS)
*
DATA ALDAT/
1 0.13 , 0.70 , 0.13 , 0.14 , 0.12 ,
1 0.14 , 0.18 , 0.13 , 0.17 , 0.14 ,
1 0.18 , 0.19 , 0.20 , 0.19 , 0.20 ,
1 0.21 , 0.18 , 0.18 , 0.25 , 0.18 ,
1 0.12 , 0.17 , 0.12 , 0.30 , 0.15 ,
1 0.15 /
*
DATA D2DAT/
1 1.0 , 1.0 , 1.0 , 3.0 , 3.0 ,
1 1.0 , 3.0 , 5.0 , 5.0 , 2.0 ,
1 2.0 , 2.0 , 1.5 , 2.0 , 2.0 ,
1 1.2 , 1.0 , 1.5 , 2.0 , 1.5 ,
1 1.0 , 1.0 , 2.0 , 1.0 , 2.0 ,
1 2.0 /
*
DATA RSMINDAT/
1 500. , 500. , 500. , 250. , 250. ,
1 250. , 250. , 250. , 250. , 150. ,
1 150. , 150. , 40. , 40. , 40. ,
1 40. , 40. , 40. , 40. , 150. ,
1 150. , 150. , 150. , 500. , 150. ,
1 250. /
DATA LAIDAT/
1 0.0 , 0.0 , 0.0 , 5.0 , 6.0 ,
1 -99. , -99. , 6.0 , 4.0 , 3.0 ,
1 -99. , 3.0 , 1.0 , -99. , -99. ,
1 -99. , -99. , -99. , -99. , 1.0 ,
1 1.0 , -99. , 4.0 , 0.0 , -99. ,
1 -99. /
DATA VEGDAT/
1 0.00 , 0.00 , 0.00 , 0.90 , 0.99 ,
1 0.90 , 0.90 , 0.99 , 0.90 , 0.50 ,
1 0.50 , 0.50 , 0.85 , 0.30 , -99. ,
1 -99. , -99. , -99. , -99. , 0.85 ,
1 0.10 , 0.50 , 0.60 , 0.00 , 0.90 ,
1 0.90 /
DATA CVDAT/
1 2.E-5 , 2.E-5 , 2.E-5 , 1.E-5 , 1.E-5 ,
1 1.E-5 , 1.E-5 , 1.E-5 , 1.E-5 , 2.E-5 ,
1 2.E-5 , 2.E-5 , 2.E-5 , 2.E-5 , 2.E-5 ,
1 2.E-5 , 2.E-5 , 2.E-5 , 2.E-5 , 2.E-5 ,
1 2.E-5 , 2.E-5 , 2.E-5 , 2.E-5 , 2.E-5 ,
1 2.E-5 /
DATA RGLDAT/
1 100. , 100. , 100. , 30. , 30. ,
1 30. , 30. , 30. , 30. , 100. ,
1 100. , 100. , 100. , 100. , 100. ,
1 100. , 100. , 100. , 100. , 100. ,
1 100. , 100. , 100. , 100. , 100. ,
1 100. /
DATA GAMMADAT/
1 0. , 0. , 0. , 0.04 , 0.04 ,
1 0.04 , 0.04 , 0.04 , 0.04 , 0. ,
1 0. , 0. , 0. , 0. , 0. ,
1 0. , 0. , 0. , 0. , 0. ,
1 0. , 0. , 0. , 0. , 0. ,
1 0. /
*
*
*
*********************************************************************
* TABLES DESCRIBING THE ANNUAL EVOLUTION OF VEG FIELDS
*********************************************************************
*
*
REAL VEGCROPS(13)
DATA VEGCROPS/
1 0.05 , 0.05 , 0.05 , 0.10 , 0.20 ,
1 0.40 , 0.80 , 0.80 , 0.90 , 0.05 ,
1 0.05 , 0.05 , 0.05 /
SAVE VEGCROPS
*
*
REAL LAI6(13), LAI7(13), LAI11(13), LAI14(13), LAI15(13),
1 LAI16(13), LAI17(13), LAI18(13), LAI19(13), LAI22(13),
1 LAI25(13), LAI26(13)
*
DATA LAI6 /
1 0.1 , 0.1 , 0.5 , 1.0 , 2.0 ,
1 4.0 , 5.0 , 5.0 , 4.0 , 2.0 ,
1 1.0 , 0.1 , 0.1 /
DATA LAI7 /
1 0.1 , 0.1 , 0.5 , 1.0 , 2.0 ,
1 4.0 , 5.0 , 5.0 , 4.0 , 2.0 ,
1 1.0 , 0.1 , 0.1 /
DATA LAI11/
1 0.5 , 0.5 , 1.0 , 1.0 , 1.5 ,
1 2.0 , 3.0 , 3.0 , 2.0 , 1.5 ,
1 1.0 , 0.5 , 0.5 /
DATA LAI14/
1 0.5 , 0.5 , 0.5 , 0.5 , 0.5 ,
1 0.5 , 1.0 , 2.0 , 2.0 , 1.5 ,
1 1.0 , 1.0 , 0.5 /
DATA LAI15/
1 0.1 , 0.1 , 0.1 , 0.5 , 1.0 ,
1 2.0 , 3.0 , 3.5 , 4.0 , 0.1 ,
1 0.1 , 0.1 , 0.1 /
DATA LAI16/
1 0.1 , 0.1 , 0.1 , 0.5 , 1.0 ,
1 2.5 , 4.0 , 5.0 , 6.0 , 0.1 ,
1 0.1 , 0.1 , 0.1 /
DATA LAI17/
1 0.1 , 0.1 , 0.1 , 0.5 , 1.0 ,
1 3.0 , 4.0 , 4.5 , 5.0 , 0.1 ,
1 0.1 , 0.1 , 0.1 /
DATA LAI18/
1 0.1 , 0.1 , 0.1 , 0.5 , 1.0 ,
1 2.0 , 3.0 , 3.5 , 4.0 , 0.1 ,
1 0.1 , 0.1 , 0.1 /
DATA LAI19/
1 0.1 , 0.1 , 0.1 , 0.5 , 1.0 ,
1 3.0 , 4.0 , 4.5 , 5.0 , 0.1 ,
1 0.1 , 0.1 , 0.1 /
DATA LAI22/
1 1.0 , 1.0 , 0.5 , 0.1 , 0.1 ,
1 0.1 , 0.1 , 1.0 , 2.0 , 1.5 ,
1 1.5 , 1.0 , 1.0 /
DATA LAI25/
1 3.0 , 3.0 , 3.0 , 4.0 , 4.5 ,
1 5.0 , 5.0 , 5.0 , 4.0 , 3.0 ,
1 3.0 , 3.0 , 3.0 /
DATA LAI26/
1 3.0 , 3.0 , 3.0 , 4.0 , 4.5 ,
1 5.0 , 5.0 , 5.0 , 4.0 , 3.0 ,
1 3.0 , 3.0 , 3.0 /
*
*
SAVE LAI6, LAI7, LAI11, LAI14, LAI15, LAI16, LAI17,
1 LAI18, LAI19, LAI22, LAI25, LAI26
*
*
*********************************************************************
*
*
REAL JULIAND
REAL JULIEN, JULIENS
REAL INTERPVEG
*
EXTERNAL JULIAND, INTERPVEG, AGGVEG, INISOILI
*
************************************************************************
* AUTOMATIC ARRAYS
************************************************************************
*
AUTOMATIC (ALDATD , REAL , (NCLASS) )
AUTOMATIC (D2DATD , REAL , (NCLASS) )
AUTOMATIC (RSMINDATD , REAL , (NCLASS) )
AUTOMATIC (LAIDATDN , REAL , (NCLASS) )
AUTOMATIC (LAIDATDS , REAL , (NCLASS) )
AUTOMATIC (VEGDATDN , REAL , (NCLASS) )
AUTOMATIC (VEGDATDS , REAL , (NCLASS) )
AUTOMATIC (CVDATD , REAL , (NCLASS) )
AUTOMATIC (RGLDATD , REAL , (NCLASS) )
AUTOMATIC (GAMMADATD , REAL , (NCLASS) )
*
************************************************************************
*
*
INTEGER I
*
****
*
*
*
* Determine the current julian day
*
julien = JULIAND( delt, kount, date )
*
*
*
* Do the aggregation
*
DO i=1,nclass
aldatd(i) = aldat(i)
d2datd(i) = d2dat(i)
rsmindatd(i) = rsmindat(i)
laidatdn(i) = laidat(i)
laidatds(i) = laidat(i)
vegdatdn(i) = vegdat(i)
vegdatds(i) = vegdat(i)
cvdatd(i) = cvdat(i)
rgldatd(i) = rgldat(i)
gammadatd(i) = gammadat(i)
END DO
*
*
* Fill the LAIDATD and VEGDATD fields for
* land use classes varying with seasons
* (i.e., replace the -99 values in the table
* with temporal interpolations from the
* tables above)
*
* tables for northern hemisphere
*
laidatdn( 6) = interpveg(julien , lai6 )
laidatdn( 7) = interpveg(julien , lai7 )
laidatdn(11) = interpveg(julien , lai11)
laidatdn(14) = interpveg(julien , lai14)
laidatdn(15) = interpveg(julien , lai15)
laidatdn(16) = interpveg(julien , lai16)
laidatdn(17) = interpveg(julien , lai17)
laidatdn(18) = interpveg(julien , lai18)
laidatdn(19) = interpveg(julien , lai19)
laidatdn(22) = interpveg(julien , lai22)
laidatdn(25) = interpveg(julien , lai25)
laidatdn(26) = interpveg(julien , lai26)
*
vegdatdn(15) = interpveg(julien , vegcrops)
vegdatdn(16) = interpveg(julien , vegcrops)
vegdatdn(17) = interpveg(julien , vegcrops)
vegdatdn(18) = interpveg(julien , vegcrops)
vegdatdn(19) = interpveg(julien , vegcrops)
*
* tables for southern hermisphere
juliens = julien - 183
if (juliens.lt.0)
+ juliens = juliens + 366
*
laidatds( 6) = interpveg(juliens, lai6 )
laidatds( 7) = interpveg(juliens, lai7 )
laidatds(11) = interpveg(juliens, lai11)
laidatds(14) = interpveg(juliens, lai14)
laidatds(15) = interpveg(juliens, lai15)
laidatds(16) = interpveg(juliens, lai16)
laidatds(17) = interpveg(juliens, lai17)
laidatds(18) = interpveg(juliens, lai18)
laidatds(19) = interpveg(juliens, lai19)
laidatds(22) = interpveg(juliens, lai22)
laidatds(25) = interpveg(juliens, lai25)
laidatds(26) = interpveg(juliens, lai26)
*
vegdatds(15) = interpveg(juliens, vegcrops)
vegdatds(16) = interpveg(juliens, vegcrops)
vegdatds(17) = interpveg(juliens, vegcrops)
vegdatds(18) = interpveg(juliens, vegcrops)
vegdatds(19) = interpveg(juliens, vegcrops)
*
*
*
CALL aggveg( f(vegf), laidatdn , laidatds , f(lai) ,
1 f(dlat) , ni, nclass )
CALL aggveg( f(vegf), vegdatdn , vegdatds , f(vegfrac),
1 f(dlat) , ni, nclass )
CALL aggveg( f(vegf), aldatd , aldatd , f(alveg) ,
1 f(dlat) , ni, nclass )
CALL aggveg( f(vegf), d2datd , d2datd , f(rootdp) ,
1 f(dlat) , ni, nclass )
CALL aggveg( f(vegf), rsmindatd, rsmindatd , f(stomr) ,
1 f(dlat) , ni, nclass )
CALL aggveg( f(vegf), cvdatd , cvdatd , f(cveg) ,
1 f(dlat) , ni, nclass )
CALL aggveg( f(vegf), rgldatd , rgldatd , f(rgl) ,
1 f(dlat) , ni, nclass )
CALL aggveg( f(vegf), gammadatd, gammadatd , f(gamveg) ,
1 f(dlat) , ni, nclass )
*
*
*
*
RETURN
END