!-------------------------------------- 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 AGGCOVERURB *SUBROUTINE AGGCOVERURB( FCOVER, TABLEN, TABLES, AGGF, LAT, 24 1 NI, NCLASSURB, NCLASS) * * #include "impnone.cdk"
* * INTEGER NI, NCLASSURB, NCLASS REAL AGGF(NI), FCOVER(NI,NCLASS+NCLASSURB), TABLEN(NCLASSURB) REAL TABLES(NCLASSURB), LAT(NI) * * *Author * Aude Lemonsu * *Revisions * 001 B. Bilodeau (Jul 2007) - Correct inconsistency caused by critmask * *Object * Aggregation of urban fields * * *Arguments * * - Input - * FCOVER Fraction of land covers (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 natural landuse classes * NCLASSURB Number of urban 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=1,nclassurb ! loop on urban classes totfract = totfract + fcover(i,m+nclass) END DO IF (totfract.GT.0.) THEN DO m=1,nclassurb ! loop on urban classes 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 + fcover(i,m+nclass) * table_val END DO aggf(i) = aggf(i) / totfract END IF END DO * * * RETURN END