!-------------------------------------- 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 -------------------------------------- !subroutine lesahuo 1 #if defined (DOC) * ***S/R lesahuo - Computes perturbation to the specific humidity. * from del(T) and del(T-Td). TL of T branch of mesahuv * where ice phase is ignored. * *Author: L. Fillion - ARMA/CMC - 24 nov 98 * *Revision: * C. Charette - ARMA/SMC - Sep. 2004 * - Conversion to hybrid vertical coordinate *Arguments: * - Output - * gomq1 : perturbation to the specific humidity q * - Input - * gomt : del T * gomq : del (T-Td) * * ------------------- #endif IMPLICIT NONE *implicits #include "comlun.cdk"
#include "pardim.cdk"
#include "comdim.cdk"
#include "comgem.cdk"
#include "comdimo.cdk"
#include "comphy.cdk"
#include "commvo.cdk"
#include "commvo1.cdk"
#include "commvog.cdk"
integer jlev, jobs real*8 zdeltd,zdeles,znum1,znum2,zdenom,zpresb logical llprint * ** C LLPRINT = .FALSE. C do jlev = 1, nflev do jobs = 1, nobtot c-------del(Td) = delT - del(T-Td) zdeltd = gomt(jlev,jobs) - gomq(jlev,jobs) c------- del(es(Td) = es(Td)*fodle(Td)*del(Td) zdeles = estdg(jlev,jobs)*dlnesg(jlev,jobs)*zdeltd zpresb = ((vhybinc(jlev) - rptopinc/rprefinc) & /(1.0-rptopinc/rprefinc))**rcoefinc znum1 = eps1*rppobs(JLEV,JOBS) znum2 = eps1*estdg(jlev,jobs)*zpresb zdenom = (rppobs(JLEV,JOBS)-eps2*estdg(jlev,jobs))**2 gomq1(jlev,jobs) = rqgfac(jlev,jobs)* & (znum1*zdeles-znum2*gomps(1,jobs))/zdenom if(llprint .and. jobs.eq.1) then write(nulout,*)'lesahuo:jobs,jlev,zdeltd,zdeles,gomt,gomq ' & ,jobs,jlev,zdeltd,zdeles,gomt(jlev,jobs),gomq(jlev,jobs) write(nulout,*)'estdg,dlnesg,eps1,eps2,rppobs,vlev ' & ,estdg(jlev,jobs),dlnesg(jlev,jobs),eps1,eps2 & ,rppobs(JLEV,JOBS),vlev(jlev) write(nulout,*)'znum1,znum2,zdenom,gomq1,gomps,rqgfac ' & ,znum1,znum2,zdenom,gomq1(jlev,jobs),gomps(1,jobs) & ,rqgfac(jlev,jobs) endif enddo enddo c return end