!-------------------------------------- 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 AGGVEG *SUBROUTINE AGGVEG( FRACT, TABLEN, TABLES, AGGF, LAT, NI, NCLASS) * * #include "impnone.cdk"
* * INTEGER NI, NCLASS REAL AGGF(NI), FRACT(NI,NCLASS), TABLEN(NCLASS), TABLES(NCLASS), LAT(NI) * * *Author * Stephane Belair *Revision * 001 B. Bilodeau and S. Belair - Adaptation for southern hemisphere * * *Object * Aggregation of vegetation fields (veg fraction, lai, rsmin, etc...) * from the vegetation fraction mask. * * *Arguments * * - Input - * FRACT Fraction of vegetation (masks) * TABLEN Geophysical fields values for each type of vegetation (northern hemisphere) * TABLES Geophysical fields values for each type of vegetation (southern hemisphere) * LAT Latitude * * - Output - * AGGF Aggretated geophysical field representative of an entire * grid area * * - Input - * NI Horizontal dimension * NCLASS Number of landuse classes * * #include "surfacepar.cdk"
* * INTEGER I,M * REAL totfract, table_val * * DO i=1,ni aggf(i) = 0.0 END DO * * * DO i=1,ni totfract = 0. DO m=4,nclass totfract = totfract + fract(i,m) END DO IF (totfract.GE.critmask) THEN DO m=4,nclass if (lat(i).ge.0.0) then * northern hemisphere table_val = tablen(m) else * southern hemisphere table_val = tables(m) endif aggf(i) = aggf(i) 1 + fract(i,m) * table_val END DO aggf(i) = aggf(i) / totfract END IF END DO * * * RETURN END