!-------------------------------------- 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 SETFGETT 3 #if defined (DOC) * ***s/r SETFGETT - Interpolation of THE FIRST GUESS ERROR VARIANCES FOR TEMPERATURE * * *Author : P. Koclas *CMC/CMSV November 1998 *Revision: * ** Purpose: -Interpolate vertically the contents of commvo to * the pressure levels of the observations. Then * compute THE FIRST GUESS ERROR VARIANCES * A linear interpolation in ln(p) is performed. * * * #endif IMPLICIT NONE *implicits #include "comdim.cdk"
#include "comdimo.cdk"
#include "comoabdy.cdk"
#include "comoahdr.cdk"
#include "comoba.cdk"
#include "commvo.cdk"
#include "cvcord.cdk"
* INTEGER IPB,IPT INTEGER IOBS,IPOS,IK,IBEGIN,ILAST INTEGER J,JDATA REAL*8 ZWB,ZWT REAL*8 ZLEV,ZPB,ZPT C DO J = 1,NFILES IF ( NBEGINTYP(J) .GT. 0 ) THEN IBEGIN=NBEGINTYP(J) ILAST=NENDTYP(J) C C* 1. Computation of sigmap C . ----------------------------- C 100 CONTINUE C DO JDATA=IBEGIN,ILAST IF ( MOBDATA(NCMASS,JDATA) .EQ. 1) then IF ( MOBDATA(NCMVNM,JDATA).EQ. 12001 ) THEN cpik IF ( MOBDATA(NCMXTR,JDATA) .NE. 0 .and. MOBDATA(NCMVCO,JDATA) .EQ. 2) THEN IK=NFLEV-1 IOBS = MOBDATA(NCMOBS,JDATA) IPOS = MOBDATA(NCMPOS,JDATA) IPT = IK + IPOS*NFLEV IPB = IPT +1 ROBDATA(NCMFGE,JDATA) = GOMOBS(IPB,IOBS) ELSE IOBS = MOBDATA(NCMOBS,JDATA) IPOS = MOBDATA(NCMPOS,JDATA) ZLEV = ROBDATA8(NCMPPP,JDATA) IK = ROBDATA(NCMLYR,JDATA) IPT = IK IPB = IPT+1 ZPT = RPPOBS(IK,IOBS) ZPB = RPPOBS(IK+1,IOBS) ZWB = LOG(ZLEV/ZPT)/LOG(ZPB/ZPT) ZWT = 1.0D0 - ZWB C C FIRST GUESS ERROR VARIANCE ROBDATA(NCMFGE,JDATA) = + ( ZWB*GOMT(IPB,IOBS) + ZWT*GOMT(IPT,IOBS) ) ENDIF ENDIF ENDIF C END DO 200 CONTINUE C ENDIF END DO C RETURN END