!-------------------------------------- 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 SETSTCMA(KNIV,RLON,KLAT,KLEV,KPOS,KIEL,KOBTOT) 1,1 #if defined (DOC) * ***s/r SETSTCMA - Computation of Jo and the residuals to the observations * FOR UPPER AIR DATAFILES * * *Author : P. Koclas *CMC/AES December 1998 *Revision: ** Purpose: * * *Arguments * PJO: CONTRIBUTION to Jo * #endif IMPLICIT NONE *implicits #include "comdim.cdk"
#include "comdimo.cdk"
#include "comleg.cdk"
#include "comoabdy.cdk"
#include "comoahdr.cdk"
#include "comoba.cdk"
#include "cvcord.cdk"
* INTEGER IOBS,IPOS,IBEGIN,ILAST,ILA,ISRCHILA,JOBS INTEGER J,JDATA,KLEV,KPOS,KIEL,KOBTOT,KNIV(2) INTEGER KLAT(KOBTOT) REAL*8 RLON(KOBTOT) REAL*8 DLLAO,ZLAT C C C DO JOBS=1,KOBTOT MOBDATA(NCMOBS,JOBS)=JOBS MOBHDR(NCMRLN,JOBS)=1 MOBHDR(NCMNLV,JOBS)=1 END DO DO J = 1,NFILES IF ( (CFAMTYP(J) .EQ. 'ST') .AND.( NBEGINTYP(J) .GT. 0) ) THEN IBEGIN=NBEGINTYP(J) ILAST=NENDTYP(J) C C* 1. Computation of (HX - Z)/SIGMA C . ----------------------------- C 100 CONTINUE C C C Process all data within the domain of the model C DO JDATA=IBEGIN,ILAST ROBDATA8(NCMPPP,JDATA)=KNIV(1) ROBDATA8(NCMPRL,JDATA)=KNIV(2) IOBS = MOBDATA(NCMOBS,JDATA) MOBDATA(NCMPOS,JDATA)=KPOS ROBHDR(NCMLAT,IOBS) =RLATI(KLAT(JDATA)) DLLAO=DBLE(ROBHDR(NCMLAT,IOBS)) ILA = ISRCHILA
(DLLAO) MOBHDR(NCMTLA,IOBS)=ILA C MOBDATA(NCMVCO,JDATA)= 2 MOBDATA(NCMASS,JDATA)=1 MOBDATA(NCMXTR,JDATA)=0 ROBHDR(NCMLON,IOBS) = RLON(JDATA) ROBDATA8(NCMOER,JDATA)=1. ROBDATA8(NCMVAR,JDATA)=0. MOBDATA(NCMVNM,JDATA)=KIEL ROBDATA8(NCMOMA,JDATA)=1. ROBDATA8(NCMOMI,JDATA)=1. END DO C 200 CONTINUE C 300 CONTINUE C ENDIF END DO C-------------------------------------------------------------------- RETURN END