!-------------------------------------- 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 METOX - METHANE OXIDATION *SUBROUTINE METOX (V, VSIZ, Q, PS, S, N, M, NK ) 1 * #include "impnone.cdk"
INTEGER VSIZ, N, M, NK REAL V(VSIZ), Q(M,NK), PS(N), S(N,NK) * *Author * M. Charron (RPN): November 2005 * * Modifications: * * 001 * * Object * * Produces the specific humidity tendency due to methane * oxidation (based on ECMWF scheme) * * * *Arguments * * - Input/Output - * V field of volatile physics variables * VSIZ dimension of V * * - Input - * Q specific humidity * PS surface pressure * S sigma levels * N horizontal dimension * M 1st dimension of Q * NK number of layers * *IMPLICITES * #include "indx_sfc.cdk"
#include "phy_macros_f.h"
#include "phybus.cdk"
#include "clefcon.cdk"
#include "consphy.cdk"
#include "options.cdk"
* * ** * ************************************************************************ * AUTOMATIC ARRAYS ************************************************************************ * AUTOMATIC (P ,REAL , (N,NK) ) * *********************************************************************** * ** REAL QQ REAL kmetox,alpha1 INTEGER i,k integer ik * fonction-formule pour faciliter le calcul des indices ik(i,k) = (k-1)*N + i -1 QQ=4.25E-6 alpha1=0.5431969 do k = 1,nk do i = 1,M P(i,k)=S(i,k)*PS(i) IF (P(i,k).GE.10000.) THEN kmetox=0. ELSE IF (P(i,k).GT.50..AND.P(i,k).LT.10000.) THEN kmetox=1.157407E-7/(1. + alpha1*(ALOG(P(i,k)/50.))**4/(ALOG(10000./P(i,k)))) ELSE kmetox=1.157407E-7 ENDIF v(qmetox+ik(i,k)) = kmetox*(QQ-Q(i,k)) end do end do RETURN END