SUBROUTINE ch_oda_masktr(CDFAM) 1,1
use modmask, only : lmasktr, lmasktr_all, lmask
C
IMPLICIT NONE
C
C Argument declarations
C
CHARACTER *2 CDFAM ! Family code to process (expected to be 'TR')
C
#if defined (DOC)
*
*Purpose : Defines a mask of assimilated and diagnosed data for species
* according to observation type
*
*Author : Y. Yang following S. Pellerin's masking routines like oda_maskpp
* as well as definitions in Y. J. Rochon and Y. Yang's code ch_jocalc
*
*Revision:
* Y.J. Rochon, ARQX, Aug 2010
* - Change in call to CH_KGETPOS, addition of test
* on MODDATA(NCMXTR,*), and additional updates
*
*comments
*
* observation type is defined by MOBHDR(NCMCORD1, IOBS)
*
* 1: Observation to be treated as point by point
* profile -- lmasktr_pp set true
* 2: Observation to be treated as piecewise
* constant profile (layer averages). -- lmasktr_lav set true
* 3: Observation to be treated as total or
* partial column amounts -- lmasktr_col set true
*
#endif
C
C* Global variables
C
#include "pardim.cdk"
#include "comdim.cdk"
#include "comdimo.cdk"
#include "comgem.cdk"
#include "comnumbr.cdk"
#include "comoabdy.cdk"
#include "comoahdr.cdk"
#include "comoba.cdk"
#include "comchem.cdk"
#include "comstate.cdk"
#include "commvo.cdk"
#include "commvog.cdk"
#include "commvohr.cdk"
#include "comct0.cdk"
#include "cvcord.cdk"
#include "comlun.cdk"
C
C* Declaration of local variables
C
INTEGER JDATA,J,IBEGIN,ILAST
INTEGER IOBSNMB, IOBSTYP,IIFLAG,ITRCODE
INTEGER JOBS, IDATA, IDATEND,J1
INTEGER IBEGIN1, ILAST1
INTEGER JL,JLT,ILMAX
INTEGER INUMS,INUM
C
INTEGER CH_KGETPOS
EXTERNAL CH_KGETPOS
C
C* Loop over obs familes.
C
DO J=1,NFILES
C
C Check for target family
C
IF (CFAMTYP(J).EQ.cdfam.AND.NBEGINTYP(J).GT.0.AND.
1 NENDTYP(J).GE.NBEGINTYP(J)) THEN
C
C Identify range of observation reports
C
IBEGIN=NBEGINTYP(J)
ILAST=NENDTYP(J)
IBEGIN1 = MOBDATA(NCMOBS,IBEGIN)
ILAST1 = MOBDATA(NCMOBS,ILAST)
C
C Loop over obs reports in a family
C
DO JOBS = IBEGIN1, ILAST1
C
C Loop over obs (profiles) in a report.
C
INUM=MOBHDR(NCMNUM,JOBS)
INUMS=MOBHDR(NCMNLV,JOBS)
DO J1=1,INUM
C
C Identify range of elements for an obs in the report
C
IF (J1.EQ.1) THEN
IDATA = MOBHDR(NCMRLN,JOBS)
IF (INUM.GT.1) INUMS=MOBDATA(NCMNUM1,IDATA)
IDATEND = INUMS + IDATA - 1
ELSE
IDATA=IDATA+INUMS
IF (INUM.GT.1) INUMS=MOBDATA(NCMNUM1,IDATA)
IDATEND=INUMS+IDATA-1
END IF
C
IOBSTYP = MOBDATA(NCMCORD1,IDATA)
IF ((IOBSTYP.NE.1.AND.IOBSTYP.NE.2.AND.
& IOBSTYP.NE.3.AND.IOBSTYP.NE.4).OR.
& SUM(MOBDATA(NCMASS,IDATA:IDATEND)).EQ.0) GO TO 150
C
C Obtain obs type info.
C
IOBSNMB = MOBDATA(NCMVNM,IDATA)
ITRCODE = MOBDATA(NCMSPEC,IDATA)
JLT = CH_KGETPOS
(IOBSNMB,ITRCODE,CSTNID(JOBS))
IF (JLT .GT. 0) THEN
c
C Loop through levels of one obs. profile
C
DO JDATA=IDATA,IDATEND
lmasktr(JLT,JDATA)=(MOBDATA(NCMASS,JDATA) .EQ. 1)
& .and. (MOBDATA(NCMXTR,JDATA) .EQ. 0)
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C Point profiles.
C
CCC lmasktr_pp(JDATA)= (MOBDATA(NCMASS,JDATA) .EQ. 1) .and. (iobstyp.eq.1)
C
C Layer average observation elements.
C
CCCC lmasktr_lav(JDATA)= (MOBDATA(NCMASS,JDATA) .EQ. 1) .and. (iobstyp.eq.2)
C
C Total or partial column amounts.
C
CCC lmasktr_col(JDATA)= (MOBDATA(NCMASS,JDATA) .EQ. 1) .and. (iobstyp.eq.3)
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
END DO
ENDIF
C
150 CONTINUE
END DO ! (J1)
END DO ! (JOBS)
END IF
END DO ! (NFILES)
C
DO J=1,NCMTASSI
lmasktr_all(:)= lmasktr_all(:) .or. lmasktr(J, :)
END DO
lmask = lmask .or. lmasktr_all
RETURN
END