!-------------------------------------- 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 PHY_ZERACCSUBROUTINE PHY_ZERACC (F,LISTE,NOMBRE) 3 * #include "impnone.cdk"
* REAL F(*) INTEGER NOMBRE CHARACTER*(*) LISTE(NOMBRE) * *Author * B. Dugas (Oct 1996) *Revision * 001 B. Dugas (May 1999) - Correct first line in PERMIS * 002 B. Dugas (May 2000) - Adaption to v3.66 physics * 003 B. Dugas (Feb 2001) - Add S7 and S8 * 004 B. Dugas (Dec 2001) - Replace RN by AE. Add PE, FR, * RN and SN. Redefine N2 * 005 K. Winger (Nov 2004) - Adaption to physics v4.2 * 006 B. Dugas (Jun 2005) - Adaption to physics v4.3 * 007 K. Winger (May 2006) - Put variable declaration and initialization * of accumulators in comdeck 'acclist.cdk' * * *Object * Puts to zero some variables of the "permanent bus", * namely the variables which are used to accumulate * fluxes or precipitation amounts in time. Used when * the model is run in climate mode. The list of * variables processed may be given as an input. * *Arguments * * - Input/Output - * F permanent bus * * - Input - * LISTE list of variables to be processed * NOMBRE number of variables in LISTE. A null value * implies that all valid variables should treated * ** * #include "acclist.cdk"
* CHARACTER*4 NOMIN INTEGER LOCAL(NBR,2),I,J,K * DATA LOCAL / NBR*0,NBR*-1 / SAVE LOCAL * #include "buses.cdk"
* *MODULES *---------------------------------------------------------------- * * Trouver les positions des champs permis * au premier appel seulement. * IF(LOCAL(1,1)*LOCAL(1,2).EQ.0) THEN DO I=1,MAXBUS DO J=1,NBR IF(PERNM(I,2).EQ.PERMIS(1,J) .AND. + LOCAL(J,1).EQ. 0 .AND. + LOCAL(J,2).EQ. -1 ) THEN LOCAL(J,1) = PERPAR(I,1) LOCAL(J,2) = PERPAR(I,1)+PERPAR(I,2)-1 ENDIF ENDDO ENDDO ENDIF * * Mise a zero. * IF(NOMBRE.NE.0) THEN DO I=1,NOMBRE NOMIN = LISTE(I) DO J=1,NBR IF(NOMIN.EQ.PERMIS(1,J)) THEN DO K=LOCAL(J,1),LOCAL(J,2) F(K) = 0.0 ENDDO ENDIF ENDDO ENDDO ELSE DO J=1,NBR DO K=LOCAL(J,1),LOCAL(J,2) F(K) = 0.0 ENDDO ENDDO ENDIF * RETURN END