!-------------------------------------- LICENCE BEGIN ------------------------------------
!Environment Canada - Atmospheric Science and Technology License/Disclaimer,
! version 3; Last Modified: May 7, 2008.
!This is free but copyrighted software; you can use/redistribute/modify it under the terms
!of the Environment Canada - Atmospheric Science and Technology License/Disclaimer
!version 3 or (at your option) any later version that should be found at:
!http://collaboration.cmc.ec.gc.ca/science/rpn.comm/license.html
!
!This software is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY;
!without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
!See the above mentioned License/Disclaimer for more details.
!You should have received a copy of the License/Disclaimer along with this software;
!if not, you can write to: EC-RPN COMM Group, 2121 TransCanada, suite 500, Dorval (Quebec),
!CANADA, H9P 1J3; or send e-mail to service.rpn@ec.gc.ca
!-------------------------------------- LICENCE END --------------------------------------
***S/P INICOVER
**
*
#include "phy_macros_f.h"
SUBROUTINE INICOVER( F, FSIZ, KOUNT, NI ) 3,58
*
#include "impnone.cdk"
*
INTEGER NI, KOUNT
INTEGER FSIZ
REAL F(FSIZ)
integer i,j
*
*
*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
* 003 Y. Delage (June 2004)
* Include recipes for CLASS
* 004 A. Lemonsu (June 2005)
* Replace vegf by covf
* Change the name
* 005 A. Lemonsu (June 2005)
* Invert class 25 and class 26 (according to GENGEO classes)
* 006 B. Bilodeau and S. Chamberland (Sept 2007)
* Modify Z0MDAT to be consistent with gengeo
*
*
*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 INICOVER. The former calls the latter.
*
*
#include "nclassvg.cdk"
#include "classlvls.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 (salt) 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 wood forests
* 26 mixed shrubs
*
*
*
*********************************************************************
* TABLES FOR THE VEG CHARACTERISTICS FOR EACH VEG TYPE
*********************************************************************
*
*
REAL ALDAT(NCLASS), D2DAT(NCLASS), RSMINXDAT(NCLASS)
REAL LAIDAT(NCLASS), VEGDAT(NCLASS)
REAL CVDAT(NCLASS), RGLDAT(NCLASS), GAMMADAT(NCLASS)
REAL ALVSDAT(NCLASS), ALNIDAT(NCLASS),RSMINDAT(NCLASS)
REAL QA50DAT(NCLASS),VPDADAT(NCLASS),VPDBDAT(NCLASS)
REAL PSGADAT(NCLASS),PSGBDAT(NCLASS),Z0MDAT(NCLASS)
REAL LAIMXDAT(NCLASS),LAIMNDAT(NCLASS),VGMASDAT(NCLASS)
REAL ROOTDAT(NCLASS),FVEG(4)
INTEGER VGCLASS(NCLASS),VG000(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 RSMINXDAT/
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. , 250. ,
1 150. /
DATA LAIDAT/
1 0.00 , 0.00 , 0.00 , 5.00 , 6.00 ,
1 -99. , -99. , 6.00 , 4.00 , 3.00 ,
1 -99. , 3.00 , 1.00 , -99. , -99. ,
1 -99. , -99. , -99. , -99. , 1.00 ,
1 1.00 , -99. , 4.00 , 0.00 , -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.0E-5 , 2.0E-5 , 2.0E-5 , 1.0E-5 , 1.0E-5 ,
1 1.0E-5 , 1.0E-5 , 1.0E-5 , 1.0E-5 , 2.0E-5 ,
1 2.0E-5 , 2.0E-5 , 2.0E-5 , 2.0E-5 , 2.0E-5 ,
1 2.0E-5 , 2.0E-5 , 2.0E-5 , 2.0E-5 , 2.0E-5 ,
1 2.0E-5 , 2.0E-5 , 2.0E-5 , 2.0E-5 , 2.0E-5 ,
1 2.0E-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. /
*
DATA RSMINDAT/
1 0.0 , 0.0 , 0.0 , 250. , 250. ,
1 263. , 130. , 130. , 122. , 323. ,
1 855. , 500. , 150. , 150. , 100. ,
1 120. , 278. , 90. , 112. , 86. ,
1 0.0 , 200. , 200. , 0.0 , 165. ,
1 855. /
*
DATA QA50DAT/
1 30. , 30. , 30. , 30. , 30. ,
1 30. , 50. , 30. , 30. , 30. ,
1 30. , 30. , 35. , 30. , 30. ,
1 30. , 30. , 30. , 30. , 30. ,
1 30. , 50. , 30. , 30. , 30. ,
1 30. /
*
DATA VPDADAT/
1 0.0 , 0.0 , 0.0 , 0.57 , 0.5 ,
1 0.5 , 0.60 , 0.45 , 0.5 , 0.5 ,
1 0.5 , 0.5 , 0.5 , 0.5 , 0.5 ,
1 0.5 , 0.5 , 0.5 , 0.5 , 0.5 ,
1 0.5 , 0.62 , 0.5 , 0.5 , 0.40 ,
1 0.5 /
*
DATA VPDBDAT/
1 1.0 , 1.0 , 1.0 , 1.0 , 1.0 ,
1 1.0 , 0.5 , 0.0 , 1.0 , 1.0 ,
1 1.0 , 1.0 , 1.0 , 1.0 , 1.0 ,
1 1.0 , 1.0 , 1.0 , 1.0 , 1.0 ,
1 1.0 , 0.4 , 1.0 , 1.0 , 0.6 ,
1 1.0 /
*
DATA PSGADAT/
1 100 , 100 , 100 , 100 , 100 ,
1 100 , 100 , 100 , 100 , 100 ,
1 100 , 100 , 100 , 100 , 100 ,
1 100 , 100 , 100 , 100 , 100 ,
1 100 , 100 , 100 , 100 , 100 ,
1 100 /
*
DATA PSGBDAT/
1 5. , 5. , 5. , 5. , 5. ,
1 5. , 5. , 5. , 5. , 5. ,
1 5. , 5. , 5. , 5. , 5. ,
1 5. , 5. , 5. , 5. , 5. ,
1 5. , 5. , 5. , 5. , 5. ,
1 5. /
*
DATA ALVSDAT/
1 0.0 , 0.0 , 0.0 , 0.03 , 0.03 ,
1 0.03 , 0.05 , 0.03 , 0.05 , 0.03 ,
1 0.05 , 0.06 , 0.06 , 0.05 , 0.06 ,
1 0.06 , 0.05 , 0.05 , 0.07 , 0.06 ,
1 0.09 , 0.05 , 0.03 , 0.30 , 0.04 ,
1 0.04 /
*
DATA ALNIDAT/
1 0.0 , 0.0 , 0.0 , 0.19 , 0.23 ,
1 0.19 , 0.29 , 0.23 , 0.29 , 0.19 ,
1 0.29 , 0.32 , 0.34 , 0.31 , 0.34 ,
1 0.36 , 0.31 , 0.31 , 0.43 , 0.36 ,
1 0.15 , 0.29 , 0.25 , 0.30 , 0.26 ,
1 0.26 /
*
DATA Z0MDAT /
1 0.001 , 0.001 , 0.001 , 1.5 , 3.5 ,
1 1.0 , 2.0 , 3.0 , 0.8 , 0.05 ,
1 0.15 , 0.15 , 0.02 , 0.08 , 0.08 ,
1 0.08 , 0.35 , 0.25 , 0.10 , 0.08 ,
1 1.35 , 0.01 , 0.05 , 0.05 , 1.5 ,
1 0.05 /
*
DATA LAIMXDAT/
1 0.0 , 0.0 , 0.0 , 2.0 , 10. ,
1 2.0 , 6.0 , 10. , 4.0 , 2.0 ,
1 4.0 , 3.0 , 3.0 , 4.0 , 4.0 ,
1 6.5 , 5.0 , 4.0 , 5.0 , 4.0 ,
1 0.0 , 1.5 , 1.5 , 0.0 , 5.5 ,
1 3.0 /
*
DATA LAIMNDAT/
1 0.0 , 0.0 , 0.0 , 1.6 , 10. ,
1 0.5 , 0.5 , 10. , 4.0 , 2.0 ,
1 0.5 , 3.0 , 3.0 , 4.0 , 0.0 ,
1 0.0 , 0.0 , 0.0 , 0.0 , 0.0 ,
1 0.0 , 1.5 , 1.5 , 0.0 , 1.0 ,
1 3.0 /
*
DATA VGMASDAT/
1 0.0 , 0.0 , 0.0 , 25. , 50. ,
1 15. , 20. , 40. , 15. , 2. ,
1 8. , 8. , 1.5 , 3. , 2. ,
1 2. , 5. , 5. , 2. , 2. ,
1 0. , 0.2 , 1.0 , 0. , 20. ,
1 8. /
*
DATA ROOTDAT/
1 0.0 , 0.0 , 0.0 , 1.0 , 5.0 ,
1 1.0 , 2.0 , 5.0 , 5.0 , 0.2 ,
1 1.0 , 5.0 , 1.2 , 1.2 , 1.2 ,
1 1.2 , 1.0 , 1.5 , 2.0 , 5.0 ,
1 0. , 0.1 , 5.0 , 0. , 1.2 ,
1 1.2 /
*
DATA VGCLASS/
1 0 , 0 , 0 , 1 , 2 ,
1 1 , 2 , 2 , 2 , 4 ,
1 4 , 4 , 4 , 4 , 3 ,
1 3 , 3 , 3 , 3 , 3 ,
1 5 , 4 , 4 , 5 , 2 ,
1 4 /
*
DATA VG000 /
1 1 , 1 , 1 , 1 , 1 ,
1 1 , 1 , 1 , 1 , 1 ,
1 1 , 1 , 1 , 1 , 1 ,
1 1 , 1 , 1 , 1 , 1 ,
1 1 , 1 , 1 , 1 , 1 ,
1 1 /
*
DATA FVEG/ 0.90, 0.90, 0.70, 0.60 /
*
*
*********************************************************************
* 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, AGGCOVERNAT, 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) )
*
************************************************************************
*
*
****
*
if(ischmsol.eq.3) then
*
*
* 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) = RSMINXDAT(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 aggcovernat( f(covf), laidatdn , laidatds , f(lai) ,
1 f(dlat), ni, nclass, nclassurb )
CALL aggcovernat( f(covf), vegdatdn , vegdatds , f(vegfrac),
1 f(dlat), ni, nclass, nclassurb )
CALL aggcovernat( f(covf), aldatd , aldatd , f(alveg) ,
1 f(dlat), ni, nclass, nclassurb )
CALL aggcovernat( f(covf), d2datd , d2datd , f(rootdp) ,
1 f(dlat), ni, nclass, nclassurb )
CALL aggcovernat( f(covf), rsmindatd , rsmindatd , f(stomr) ,
1 f(dlat), ni, nclass, nclassurb )
CALL aggcovernat( f(covf), cvdatd , cvdatd , f(cveg) ,
1 f(dlat), ni, nclass, nclassurb )
CALL aggcovernat( f(covf), rgldatd , rgldatd , f(rgl) ,
1 f(dlat), ni, nclass, nclassurb )
CALL aggcovernat( f(covf), gammadatd , gammadatd , f(gamveg) ,
1 f(dlat), ni, nclass, nclassurb )
*
*
elseif(ischmsol.eq.2) then
*
call agvgclas(f(covf),ALVSDAT, VGCLASS,f(ALVSC), NI,class_ic+1,
1 NCLASS+NCLASSURB)
call agvgclas(f(covf),ALNIDAT, VGCLASS,f(ALIRC), NI,class_ic+1,
1 NCLASS+NCLASSURB)
call agvgclas(f(covf),LAIMXDAT,VGCLASS,f(LAIMAX),NI,class_ic ,
1 NCLASS+NCLASSURB)
call agvgclas(f(covf),LAIMNDAT,VGCLASS,f(LAIMIN),NI,class_ic ,
1 NCLASS+NCLASSURB)
call agvgclas(f(covf),VGMASDAT,VGCLASS,f(VEGMA), NI,class_ic ,
1 NCLASS+NCLASSURB)
call agvgclas(f(covf),ROOTDAT, VGCLASS,f(ROOTDP),NI,class_ic ,
1 NCLASS+NCLASSURB)
call agvgclas(f(covf),Z0MDAT, VGCLASS,f(ZOLN), NI,class_ic+1,
1 NCLASS+NCLASSURB)
call agvgclas(f(covf),RSMINDAT,VGCLASS,f(STOMR), NI,class_ic ,
1 NCLASS+NCLASSURB)
call agvgclas(f(covf),QA50DAT, VGCLASS,f(QA50), NI,class_ic ,
1 NCLASS+NCLASSURB)
call agvgclas(f(covf),VPDADAT, VGCLASS,f(VPDA), NI,class_ic ,
1 NCLASS+NCLASSURB)
call agvgclas(f(covf),VPDBDAT, VGCLASS,f(VPDB), NI,class_ic ,
1 NCLASS+NCLASSURB)
call agvgclas(f(covf),PSGADAT, VGCLASS,f(PSIGA), NI,class_ic ,
1 NCLASS+NCLASSURB)
call agvgclas(f(covf),PSGBDAT, VGCLASS,f(PSIGB), NI,class_ic ,
1 NCLASS+NCLASSURB)
call agvgclas(f(covf),ROOTDAT, VG000 ,f(SDEPTH),NI,1 ,
1 NCLASS+NCLASSURB)
call agvgmask(f(covf), VGCLASS,f(FCANMX),NI,class_ic+1,
1 NCLASS+NCLASSURB)
*
DO J=1,4
DO i=0,ni-1
f(FCANMX + i +(j-1)*ni) = f(FCANMX + i +(j-1)*ni)*fveg(j)
end do
END DO
*
endif
*
*
RETURN
END