SUBROUTINE CH_SUCHEM 1,2
#if defined (DOC)
*
***s/r CH_SUCHEM - Define and initialize variables related to assimilation of
* species.
*
*Author : Y. Yang July 2003
*
*Revision:
* Y. Yang Feb. 2005
* - Removed 'OZ'.
* Y.J. Rochon ARQX/MSC May/June 2005
* - Modified list of possible vertical coordinates
* - Added NGENOPER, NTOTTRFLAG, NTRFLAG
* Y. Yang June 2005
* - Added lsplit for splitting algorithm
* - call ch_susplit for setting up the splitting analysis algorithm
* Y.J. Rochon ARQX/MSC Sept. 2005
* - Call to ch_speciesinfo.
* - Added NLOGTR default.
* - Minor structure changes
* - Added NBALOP and NBALOPER
* - Added CTRSTNID.
* Y.J. Rochon ARQX/MSC March 2006
* - Added QCFACT1 and QCFACT2
* Y. Yang ARQI April. 2006
* - move 'call ch_susplit' to outside 'if(NCMTASSI .eq. 0)' block
* Y. Yang ARQI Feb. 2007
* - added CDIROBSSTD and CFRMTOBS (see comchem.cdk for detail)
* Y.J. Rochon ARQX/EC Feb. 2007
* - Added DAYNIGHTP for use in day/night/near-terminator
* criteria for accepting obs (see comchem.cdk for detail).
* Default of DAYNIGHTP(:)<=0 for no application of criterion.
* Y.J. Rochon ARQX/EC April. 2007
* - Added parameters for balance operators (CBALOP*) and
* removed NBALOPER.
* Y.J. Rochon ARQX/EC June 2008
* - Addition of array NOBSLOS for line of sight coordinate
* parameters. Only the observing direction relative to North
* has been included at this point.
* Y.J. Rochon ARQX/EC Apr 2009
* - Added use of official descriptor 007011. Retained 007204
* for backward compatibility.
* Y.J. Rochon and Y. Yang March 2010
* - Added NTUNETRBG and NTUNETROBS
* Y.J. Rochon ARQX March 2010
* - Added CTUNETRBG
* Y.J. Rochon ARQX March 2010
* - Added NTRCOUNT,NTRLEV,RTRLEV,RTROMAP for layer dependent
* diagnostics.
*
#endif
C
IMPLICIT NONE
#include "comct0.cdk"
#include "comdim.cdk"
#include "comdimo.cdk"
#include "comcva.cdk"
#include "comchem.cdk"
#include "comlun.cdk"
#include "namchem.cdk"
#include "comsplit.cdk"
INTEGER JJ, ILEN, IERR, II, FNOM,FCLOS
EXTERNAL HPALLOC,FNOM,FCLOS
INTEGER IFLAG
C
C Parameters for use with "ch_speciesinfo"
C
integer knum,klun
C
C Default values set before reading from the namelist
C
C
C Set diagnostic layers
C
NTRLEV(1:NCMTMAX)=37
RTRLEV(1,1:NCMTMAX)=0.0001
RTRLEV(2,1:NCMTMAX)=0.0016 ! (in hPa)
RTRLEV(3,1:NCMTMAX)=0.0025
RTRLEV(4,1:NCMTMAX)=0.0040
RTRLEV(5,1:NCMTMAX)=0.0063
RTRLEV(6,1:NCMTMAX)=0.01
RTRLEV(7,1:NCMTMAX)=0.016
RTRLEV(8,1:NCMTMAX)=0.025
RTRLEV(9,1:NCMTMAX)=0.040
RTRLEV(10,1:NCMTMAX)=0.063
RTRLEV(11,1:NCMTMAX)=0.10
RTRLEV(12,1:NCMTMAX)=0.16
RTRLEV(13,1:NCMTMAX)=0.25
RTRLEV(14,1:NCMTMAX)=0.40
RTRLEV(15,1:NCMTMAX)=0.63
RTRLEV(16,1:NCMTMAX)=1.0
RTRLEV(17,1:NCMTMAX)=1.6
RTRLEV(18,1:NCMTMAX)=2.5
RTRLEV(19,1:NCMTMAX)=4.0
RTRLEV(20,1:NCMTMAX)=6.3
RTRLEV(21,1:NCMTMAX)=10.
RTRLEV(22,1:NCMTMAX)=16.
RTRLEV(23,1:NCMTMAX)=25.
RTRLEV(24,1:NCMTMAX)=40.
RTRLEV(25,1:NCMTMAX)=63.
RTRLEV(26,1:NCMTMAX)=100.
RTRLEV(27,1:NCMTMAX)=126.
RTRLEV(28,1:NCMTMAX)=160.
RTRLEV(29,1:NCMTMAX)=200.
RTRLEV(30,1:NCMTMAX)=250.
RTRLEV(31,1:NCMTMAX)=316.
RTRLEV(32,1:NCMTMAX)=400.
RTRLEV(33,1:NCMTMAX)=502.
RTRLEV(34,1:NCMTMAX)=630.
RTRLEV(35,1:NCMTMAX)=794.
RTRLEV(36,1:NCMTMAX)=891.
RTRLEV(37,1:NCMTMAX)=943.
RTRLEV(38,1:NCMTMAX)=1200.
RTRLEV(:,1:NCMTMAX)= RTRLEV(:,1:NCMTMAX)*100. ! Converted to Pa
C
C Flags for balance operators involving species
C
NBALOP=0
CBALOPSRC(:)=' '
CBALOPDEST(:)=' '
CBALOPETIK(:)=' '
CBALOPFILE='baloper.fst'
C
C Default values for restrictions on STNID for each CNAMANAL and
C NETR pair. Default (blank) implies no restriction.
C
CTRSTNID(:)=' '
C
C Set default values for quality control thresholds. See comchem.cdk
C for info.
C Note: QCFACT2 not currently used
C
QCFACT1(:)=1.0 ! Applied at backround check
QCFACT2(:)=1000.0 ! Applied at forward model and TLM stages
C (and QCvar)
C
C Set variable transformation index to 0 (no transformation).
C Note: NLOGTR=1 implies application of ln.
C
NLOGTR=0
C
C Correspondance of the species index in BURP file for desired species obs
C to the species name in the background file.
C
CNAMANAL(:) = '--'
C
C Flag indicating application (1) or not (0) of the generalized innovation
C operator for integral obs
C
NGENOPER=0
C
C Species to be assimilated
C
NCMTASSI = 0
C
C Descriptors of the species to be assimilated
C
NETR(:)= 0
C
C Initialize the scaling factor for observation error
C
SCALERRTR(:) = 1.0
C
C Initialize the flags for obs. std. dev.
C
NFLGSTDTR(:) = 0
C
C Initialize the obs. std. dev.
C
ROBSSTDTR(:) = 0.
C
C Initialize control directives on any background or TR family obs
C error std. dev. scaling to 'no scaling'
C
NTUNETRBG=0
NTUNETROBS=0
CTUNETRBG='operational'
C
C Initialize the directive for obs. std. dev. (whether to use the input
C std. dev. as actual value ('val') or as scaling factor ('fct'))
C
CDIROBSSTD(:) = ''
C
C The format of the input ASCII file containing observation error
C std. dev. or tuning factors:
C
C 'old' for 3 separate lat regions
C 'new' for one column for the entire globe.
C 'int' for an arbitrary number of latitudes from which
C interpolation in lat and vertical level is applied.
C
CFORMTOBS = 'new'
C
C Logical indicating whether or not to produce a global mean if the
C input obs. error std. dev. or tuning factors are in 3
C separate regions
C
lglobal_std_mean = .true.
C
C Max. pressure (Pa) above which to apply
C day/night/near-terminator acceptance criterion. If <= 0, not applied.
C
DAYNIGHTP(:)=-1.0
C
C ****** NTRFLAG not currently used ******
C
C Initialize quality flags for acceptable species obs.
C NTRFLAG(*) are actual flag/marker values as oppose to bit locations.
C
C While the list NLISTFLG(NFLAG) containing the bits which serves in
C screening out data (i.e. data rejection bits) for all obs families
C is also applied in CH_SUPREP, it can be less restrictive than NTRFLAG.
C NTRFLAG is applied for screening in CH_CMABDY.
C
C NOT CURRENTLY APPLIED!
C
NTRFLAG(:)=0
NTRFLAG(1)=0
NTRFLAG(2)=1
NTRFLAG(3)=2
NTRFLAG(4)=32
NTRFLAG(5)=64
NTRFLAG(6)=4096
C
C ******
C
C Solar zenith angle above which the data should be filtered out
C
MAXFILTSZA= 180.0
C
C Logical flag for splitting algorithm
C
LSPLIT = .false.
C
C Descriptors for vertical coordinates
C
NDESCVCORD(:)=0
NDESCVCORD(1) = 007193
NDESCVCORD(2) = 007004
NDESCVCORD(3) = 007011
NDESCVCORD(4) = 007204
NDESCVCORD(5) = 007001
NDESCVCORD(6) = 007002
NDESCVCORD(7) = 007006
NDESCVCORD(8) = 007007
NDESCVCORD(9) = 007009
NDESCVCORD(10) = 005042
NDESCVCORD(11) = 002150
C
C Association of above vertical coordinate descriptors
C to vertical coordinate type.
C Consistent with NVCORDTYP in resume.ftn
C
C Definitions:
C
C -1 - Integrated value with coordinate
C not provided as function of pressure or Z
C level or layer. (e.g. channel number)
C 0 - Surface value.
C 1 - Altitude (m). Final values must all be
C related to sea level.
C
C If 007001 (height of station) is present,
C its value must be correspondingly added to the
C provided altitudes (under 007002, 007006 or
C 007007) in ch_brpacma.
C
C 2 - Pressure (Pa)
C 3 - Geopotential height (m)
C 4 - Geopotential (m^2/s^2)
C
C When two or more of pressure, altitude, and
C geopotential height are provided in the BURP report,
C then the first one encountered in the list
C of elements of the BURP file block will be used.
C
NDESVTYP(:)= 0
NDESVTYP(1) = 2
NDESVTYP(2) = 2
NDESVTYP(3) = 2
NDESVTYP(4) = 2
NDESVTYP(5) = 1
NDESVTYP(6) = 1
NDESVTYP(7) = 1
NDESVTYP(8) = 1
NDESVTYP(9) = 3
NDESVTYP(10) = -1
NDESVTYP(11) = -1
C
C Observing direction coordinate parameters
C
NOBSLOS(:)=0
NOBSLOS(1)=007200 ! Observing direction clockwise relative to North (deg)
C Read the namelist to set the parameters related to chemistry
C do this only when assimilating chemistry
C
IF (LCHEM) THEN
C
CALL CH_READNML('NAMCHEM',IFLAG)
C
C Check for consistency
C
if(NCMTASSI .eq. 0) then
write(nulout, *) '*****************************************************'
write(nulout, *) ' warning! warning! warning! '
write(nulout, *) '!!! You did not specify what species to assimilate!!!'
write(nulout, *) '*****************************************************'
else
C
C Ensure that CNAMANAL was properly set.
C
do ii=1,ncmtassi
if (cnamanal(ii).eq.' '.or.cnamanal(ii).eq.'--') then
CALL ABORT3D(NULOUT,'CH_SUCHEM: CNAMANAL incomplete.')
end if
end do
C
C Given species identifier list NTRCODELIST, get corresponding list
C of molecular mass (speciesm), RPN variable names (cnamanal) and
C species formula (cspeciesn).
C
C Reads info from table file "tablespecies". This file contains a
C correspondance table associating constituents to their BURP file
C species identifier numbers, their variable names,
C their molecular mass, ...
C
klun=0
ierr=fnom(klun,'tablespecies','FTN+R/O',0)
if (ierr.lt.0) then
CALL ABORT3D(NULOUT,'CH_SUCHEM: File "tablespecies" not found.')
end if
ntrcodelist(1:ncmtassi)=0
call ch_speciesinfo(3,cspeciesn,ntrcodelist,speciesm,CNAMANAL,
& NCMTASSI,knum,klun,nulout)
ierr=fclos(klun)
endif
C
C Set up for the splitting analysis scheme
C
if (NCONF .ne. 888) then
write(nulout, *) 'CH_SUCHEM: Calling ch_susplit'
call ch_susplit(1)
endif
C
ELSE
write(nulout, *) '****************************************************'
write(nulout, *) ' warning! warning! warning! '
write(nulout, *) ' !!! No species data will be assimilated !!! '
write(nulout, *) '****************************************************'
ENDIF
C
RETURN
END