SUBROUTINE SETSTCMA(KNIV,RLON,KLAT,KLEV,KPOS,KIEL,KOBTOT) 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: * Y. Yang - Oct. 2004 * - Added include "comnumbr.cdk" * due to the dependence of the "cvcord.cdk" on JPNBRELEM * ** 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 "comnumbr.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