!-------------------------------------- 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 SETUACMA(RLON,KLAT,KLEV,KPOS,KIEL,KOBTOT) 1,1 #if defined (DOC) * ***s/r SETUACMA - Setup CMA to be used by module HBHT * * *Author : P. Koclas *CMC/AES December 1998 *Revision: * C.Charette ARMA/MSC May 2002 * - Added to set cma with v9.2.0 ** 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 "commvo.cdk"
#include "cvcord.cdk"
* INTEGER IOBS,IPOS,IBEGIN,ILAST,ILA,ISRCHILA,JOBS INTEGER IDATA,ILASTOB,IBEGINOB,IDATEND,NQCVAR INTEGER J,JO,JDATA,KLEV,KPOS,KIEL,KOBTOT INTEGER KLAT(KOBTOT) REAL*8 RLON(KOBTOT) REAL*8 DLLAO,ZLAT C C C DO JOBS=1,KOBTOT MOBDATA(NCMOBS,JOBS)=JOBS MOBHDR(NCMNLV,JOBS)=1 IF ( JOBS .EQ. 1) THEN MOBHDR(NCMRLN,1)=1 ELSE MOBHDR(NCMRLN,JOBS) = MOBHDR(NCMRLN,JOBS-1) + + MOBHDR(NCMNLV,JOBS-1) ENDIF END DO DO J = 1,NFILES IF ( (CFAMTYP(J) .EQ. 'UA') .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 IBEGINOB = MOBDATA(NCMOBS,IBEGIN) ILASTOB = MOBDATA(NCMOBS,ILAST) DO JO = IBEGINOB, ILASTOB IDATA = MOBHDR(NCMRLN,JO) IDATEND = MOBHDR(NCMNLV,JO) + IDATA - 1 DO JDATA=IDATA,IDATEND 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 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(NCMPPP,JDATA)=RPPOBS(KLEV,IOBS) ROBDATA8(NCMOMA,JDATA) = 1. ROBDATA8(NCMOMI,JDATA) = 1. ROBDATA8(NCMOMN,JDATA) = 1. END DO ENDDO ENDIF END DO C-------------------------------------------------------------------- RETURN END