SUBROUTINE SUCMA(KULOUT) 1,1
#if defined (DOC)
*
***s/r SUCMA - Definition of pseudo-addresses for positioning
* . within the CMA array ROBSAR/MOBSAR
*
*Author : P. Gauthier *ARMA/AES June 9, 1992
* . (based on subroutines written by D.Vasiljewic of ECMWF)
*Revision:
* P. KOCLAS CMC AUGUST 93.
* Purpose:
*
* -ADAPTATION FOR BURP VARIABLE TYPES
* -NEW COMDECK COMSTDEV CONTAINS OBSERVATION
* STANDARD DEVIATION ERRORS
*
* P. KOCLAS CMC FEBRUARY 94..
* . Change observation standard deviation errors to be
* similar to OI code.
*
* P. KOCLAS CMC SEPTEMBER 94.
* . Additional variables added to CMA to allow efficient
* . vectorization of 3d-var code (vertical interpolation
* . routnes VINT3D and VINT3DA)
*
* P. KOCLAS CMC February 95.
* -Removal of XSTDEV vector.
*
* P. KOCLAS CMC August 95.
* -ALLOW T-Td DATA (NVNUMB(9)=12192 INSTEAD OF -1).
*
* P. KOCLAS CMC April 96.
* . Additional variables added to CMA
* -NCMLOBS RELATIVE POSTION OF DATA WITH RESPECT TO A FULL SOUNDING
*
* . G. Deblonde *ARMA/AES JUne 17, 1996 :temporary SSMI burp format
* -set NVNUMB(6)=013016 for SSM/I Integ. Water Vapor
* . G. Deblonde *ARMA/AES Oct 22, 1996: permanent SSMI burp format
* -set NVNUMB(6)=013208 for SSM/I Integ. Water Vapor
* . S. Pellerin *ARMA/AES Sept 97: Add of Total ozone from TOVS
* . J. Halle *CMDA/AES Oct 99: Allow NVNUMB(50)=012062 and
* NVNUMB(7)=012063 radiances from TOVS
* . P. KOCLAS *CMC/CMDA JAn 2000
* -ADDED 12004 8001 8004 ELEMENTS
* . C.CHARETTe *ARMA/AES Jun 2000
* -ADDED surface elements 10051,11215,11216,12203
*
* JM Belanger CMDA/SMC Jul 2000
* . 32 bits conversion
* (Switch order of ROBDATA pointers NCMPOB,NCMPPP,NCMPRL
* in order for ROBDATA8 elements to be contiguous in memory)
* . J. Halle *CMDA/AES dec 2000
* -adapt to TOVS level 1b.
* . D. Anselmo *ARMA/MSC October 2004
* - Added 13210,13220 elements for atmospheric and surface ln q.
* . J. Halle *CMDA/MSC May 2006
* -inserted one additionnal body related parameter, i.e. NCMPRM, which
* contains Z" = H(xb_lr) + Z'
* = H(xb_lr) - H(xb_hr) + Z
* A. Beaulne *CMDA/SMC June 2006
* -inserted 3 additional header related parameter. i.e. NCMAZA,
* NCMSUN and NCMCLF which contain satellite azimuthal angle,
* sun zenith angle and cloud fraction
* J.M. Aparicio *ARMA/MSC* October 2006
* - Adapt for GPSRO
*
* Y. Yang (UofT) and Y.J. Rochon (ARQX/MSC), Jan 2005
* - Added pointers for new elements in the header and body of CMA.
* Expanded NCMLET accordingly.
* - Added call to ch_kadd2list to add the observation descriptors
* read in from the namelist into the
* vector NVNUMB if it is not already there. This makes it easy
* to accommodate new observations.
* Y. Yang (UofT) Feb. 2005
* - Removed 'OZ' part and 'NEOZ'
* Y.J. Rochon *ARQX/MSC May/Aug 2005
* - Changed numbering for NCMCORD1, NCMSPEC, and NCMCONV
* - Moved pointers NCMSPEC and NCMCONV from header
* to body related parameters.
* - Added NCMNUM to header related parameters
* - Added NCMNUM1 to body elements
* - Moved NCMCORD1 to body elements.
* Y.J. Rochon *ARQX/EC June 2008
* - Added 011200 and NCMDWN (for 007200)
* 011200: Doppler wind speed (m/s)
* 007200: Observing direction clockwise relative to North (deg)
* Y.J. Rochon *ARQX/EC Aug 2010
* - Added:
* NCMKER: Averaging kernel matrix index
* NCMCOR: Correlation/covariance matrix index
* which refer to matrices in commatrix.cdk
* NCMPPX: Derived pressure at obs point (when NCMPPP does not
* contain pressure). For storage in output BURP files
*
*
*Arguments
* i KULOUT: unit used for optional printing
*
#endif
C
IMPLICIT NONE
*implicits
#include "comoahdr.cdk"
#include "comoabdy.cdk"
#include "comnumbr.cdk"
#include "comdim.cdk"
#include "comchem.cdk"
#include "comct0.cdk"
*
INTEGER KULOUT
INTEGER JJ, kindex, ch_kadd2list
C
WRITE(KULOUT,FMT='(//,6('' ***********''))')
WRITE(KULOUT,9000)
9000 FORMAT(' SUCMA: Initialisation of observation',
S ' parameters',/,10x,'(e.g., Obs. types, Header and Body ',
S 'pseudo-addresses, etc.)')
WRITE(KULOUT,FMT='(6('' ***********''))')
C
*
* 1. Initialize header related parameters
*
100 CONTINUE
C
NCMLET = 25 ! Number of elements in the following list
C
NCMRLN = 1
NCMONM = 2
NCMBOX = 3
NCMOTP = 4
NCMITY = 5
NCMLAT = 6
NCMLON = 7
NCMDAT = 8
NCMETM = 9
NCMSID = 10
NCMALT = 11
NCMNLV = 12
NCMOEC = 13
NCMOFL = 14
NCMST1 = 15
NCMTLA = 16
NCMTLO = 17
NCMSI2 = 18
NCMSI3 = 19
NCMAZA = 20
NCMSUN = 21
NCMCLF = 22
C
C Additional header related parameters
C
NCMNUM = 23 ! Number of distinct obs profiles in report
NCMKER = 24 ! See above revision list...
NCMCOR = 25
C
WRITE(KULOUT,*)' Pseudo-addresses of the CMA header'
WRITE(UNIT=KULOUT,FMT=9100)
S NCMLET,NCMRLN,NCMONM,NCMBOX,NCMOTP,NCMITY,NCMLAT,NCMLON
S ,NCMDAT,NCMETM,NCMSID,NCMALT,NCMNLV,NCMOEC,NCMOFL, NCMST1
S ,NCMTLA,NCMTLO,NCMSI2,NCMSI3,NCMAZA,NCMSUN,NCMCLF,NCMNUM
$ ,NCMKER,NCMCOR
9100 FORMAT(1X
S ,' NCMLET = ',I6,' NCMRLN = ',I6,' NCMONM = ',I6
S ,' NCMBOX = ',I6,' NCMOTP = ',I6,' NCMITY = ',I6,/
S ,' NCMLAT = ',I6,' NCMLON = ',I6,' NCMDAT = ',I6
S ,' NCMETM = ',I6,' NCMSID = ',I6,' NCMALT = ',I6,/
S ,' NCMNLV = ',I6,' NCMOEC = ',I6,' NCMOFL = ',I6
S ,' NCMST1 = ',I6,' NCMTLA = ',I6,' NCMTLO = ',I6,/
S ,' NCMSI2 = ',I6,' NCMSI3 = ',I6,' NCMAZA = ',I6
S ,' NCMSUN = ',I6,' NCMCLF = ',I6,' NCMNUM = ',I6,/
S ,' NCMKER = ',I6,' NCMCOR = ',I6)
C
*
* 2. Initialize body related parameters
*
200 CONTINUE
C
NCMLBO = 28 ! Number of body elements in the following list
C
NCMVNM = 1
NCMPOB = 2
NCMPRL = 3
NCMPPP = 4
NCMVAR = 5
NCMOMF = 6
NCMOMA = 7
NCMOMI = 8
NCMOMN = 9
NCMOER = 10
NCMPRM = 11
NCMRER = 12
NCMFGE = 13
NCMPER = 14
NCMFLG = 15
NCMPOS = 16
NCMLYR = 17
NCMASS = 18
NCMXTR = 19
NCMOBS = 20
NCMLOBS = 21
NCMVCO = 22
C
C Additional body related parameters
C
NCMSPEC = 23 ! species type
NCMCONV = 24 ! molecular mass of species
NCMCORD1 = 25 ! Observation handling flag
NCMNUM1 = 26 ! Number of elements in profile (in the event
C of multiple profile of different length in report)
NCMDWN = 27 ! Observing direction clockwise relative to North (deg)
! referring to location descriptor 007200 (and obs
! descriptor 011200)
NCMPPX = 28 ! Derived pressure at obs point (when NCMPPP does not
! contain pressure). For storage in output BURP files.
C
WRITE(KULOUT,*)' Pseudo-addresses of the CMA data body'
WRITE(UNIT=KULOUT,FMT=9200)
S NCMLBO,NCMVNM,NCMPPP,NCMPRL,NCMPOB,NCMVAR,NCMOMF,NCMOMA
S ,NCMOMI,NCMOMN,NCMOER,NCMPRM,NCMRER,NCMFGE,NCMPER,NCMFLG
S ,NCMPOS,NCMLYR,NCMASS,NCMXTR,NCMOBS,NCMLOBS,NCMVCO
S ,NCMSPEC,NCMCONV,NCMCORD1,NCMNUM1,NCMDWN
9200 FORMAT(
S ' NCMLBO = ',I6,' NCMVNM = ',I6,' NCMPPP = ',I6
S ,' NCMPRL = ',I6,' NCMPOB = ',I6,' NCMVAR = ',I6,/
S ,' NCMOMF = ',I6,' NCMOMA = ',I6,' NCMOMI = ',I6
S ,' NCMOMN = ',I6,' NCMOER = ',I6,' NCMPRM = ',I6,/
S ,' NCMRER = ',I6
S ,' NCMFGE = ',I6,' NCMPER = ',I6,' NCMFLG = ',I6
S ,' NCMPOS = ',I6,' NCMLYR = ',I6,' NCMASS = ',I6,/
S ,' NCMXTR = ',I6,' NCMOBS = ',I6,' NCMLOBS= ',I6
S ,' NCMVCO = ',I6,' NCMSPEC= ',I6,' NCMCONV= ',I6,/
S ,' NCMCORD1=',I6,' NCMNUM1= ',I6,' NCMDWN = ',I6,
S ,' NCMPPX =',I6)
C
*
* 3. Initialize observational type descriptors
*
300 CONTINUE
C
NVNUMB = 0
C
NVNUMB( 1) = 011003
NVNUMB( 2) = 011004
NVNUMB( 3) = 010194
NVNUMB( 4) = 57
NVNUMB( 4) = 010192
NVNUMB( 5) = 29
NVNUMB( 6) = 013208
NVNUMB( 7) = 012063
NVNUMB( 8) = 012001
NVNUMB( 9) = 012192
NVNUMB(10) = 012004
NVNUMB(11) = 012203
NVNUMB(12) = 011215
NVNUMB(13) = 011216
NVNUMB(14) = 013210
NVNUMB(15) = 013220
NVNUMB(16) = 62
NVNUMB(17) = 015001
NVNUMB(18) = 64
NVNUMB(19) = 65
NVNUMB(20) = 015036
NVNUMB(21) = 67
NVNUMB(22) = 68
NVNUMB(23) = 69
NVNUMB(24) = 70
NVNUMB(25) = 71
NVNUMB(26) = 72
NVNUMB(27) = 73
NVNUMB(28) = 74
NVNUMB(29) = 75
NVNUMB(30) = 76
NVNUMB(31) = 77
NVNUMB(32) = 78
NVNUMB(33) = 79
NVNUMB(34) = 80
NVNUMB(35) = 81
NVNUMB(36) = 82
NVNUMB(37) = 83
NVNUMB(38) = 84
NVNUMB(39) = 85
NVNUMB(40) = 86
NVNUMB(41) = 87
NVNUMB(42) = 88
NVNUMB(43) = 89
NVNUMB(44) = 90
NVNUMB(45) = 91
NVNUMB(46) = 012163
NVNUMB(47) = 010004
NVNUMB(48) = 011001
NVNUMB(49) = 011002
NVNUMB(50) = 012062
NVNUMB(51) = 008001
NVNUMB(52) = 008004
NVNUMB(53) = 010051
NVNUMB(54) = 011011
NVNUMB(55) = 011012
NVNUMB(56) = 41
NVNUMB(57) = 42
NVNUMB(58) = 011200
NVNUMB(59) = 015005
*
400 CONTINUE
*
ccc
NETT=12001
ccc
NEUU=11003
NEVV=11004
NEGZ=10194
NEES=12192
NEDZ=10192
NEPP=07004
NEFF=11002
NEDD=11001
NEUS=11215
NEVS=11216
NETS=12004
NESS=12203
NEPS=10004
NEFS=11012
NEDS=11011
NEPN=10051
NBT1=12062
NBT2=12063
NBT3=12163
NEHU=13210
NEHS=13220
NERF=15036
C
NEDW=11200
C
IF(LCHEM) THEN
C
C Check whether the species obs descriptor is already in NVNUMB
C If not, add it to the end of nvnumb list (the first place that has 0)
DO JJ = 1, NCMTASSI
kindex = ch_kadd2list(NETR(jj))
ENDDO
C
ENDIF
C
RETURN
END