SUBROUTINE SUSTATE 1,1
#if defined (DOC)
*
***s/r SUSTATE - Definition of which variables are to be part
* . of the different model states
* Author : P. Gauthier *ARMA/AES March 3, 1995
* Revision:
* S. Pellerin *ARMA/AES Sept 97.
* Control of the different model state of the 3Dvar
* through COMSTATE, COMSTATEC and COMSTNUM common
* blocks variables (comstate.cdk).
* S. Pellerin *ARMA/AES Aug. 98.
* Add of nmvoexist et nmvoposit for ES
* M. Buehner July 98
* Switched order of tt,q in spectral and grid point vectors
* J. Halle *CMDA/AES Oct 1999.
* Add ground temperature (TG) to model state.
* Y. Yang July 2003
* Expanded notr, nstr, ngtr to vectors to accommodate
* multiple species. Added do loops accordingly.
* Y. Yang Feb. 2005
* Removed 'OZ' part and cleaned nooz, ngoz, ...
* Y.J. Rochon Feb. 2006, April 2007
* Added test on consistency of JPNVARMAX and NCMTMAX sizes
* Added CSCMT
*
** Purpose: to define which fields are allocated within
* - Spectral states: COMSP, COMSP1, COMSPG
* - Gridpoint states: COMGD0, COMGD1
* - Model states at observation locations: COMMVO, COMMVO1
* - Spectral correlations: COMSPG
* ----------------------------------
*
*ARGUMENTS
* -NONE-
#endif
IMPLICIT NONE
*implicits
#include "comlun.cdk"
#include "comdim.cdk"
#include "comdimo.cdk"
#include "comstate.cdk"
#include "comchem.cdk"
*
INTEGER JVAR, IFLAG, IPOS
character*53 clmsg
integer jj
C
C* 1. Initialize to default values
C
100 CONTINUE
C
C Initialisation of the state variable numbers
C
C Spectral model variable numbers
C
nsvor = 1
nsdiv = 2
nsgz = 3
nstt = 4
nsq = 5
DO JJ = 1,NCMTMAX
nstr(JJ) = 5+JJ
ENDDO
nsps = 6+NCMTMAX
nstg = 7+NCMTMAX
C
C Gridpoint model variable numbers
C
nguu = 1
ngvv = 2
nggz = 3
ngtt = 4
ngq = 5
DO JJ = 1,NCMTMAX
ngtr(JJ) = 5+JJ
ENDDO
ngps = 6+NCMTMAX
ngtg = 7+NCMTMAX
C
C Model state at the observation locations
C
nouu = 1
novv = 2
nogz = 3
nott = 4
noq = 5
noes = 6
DO JJ = 1,NCMTMAX
notr(JJ) = 6+JJ
ENDDO
nops = 7+NCMTMAX
notg = 8+NCMTMAX
C
C Check dimension
C
if (JPNVARMAX.lt.8+NCMTMAX) then
CLMSG = 'SUSTATE: INCONSISTENT JPNVARMAX and NCMTMAX'
CALL ABORT3D(NULOUT,CLMSG)
end if
C
C Initialisation of model state control vertors
C
DO JVAR = 1, JPNVARMAX
C
C* Existence vertors
C
NSEXIST(JVAR) = 0
NGEXIST(JVAR) = 0
NMVOEXIST(JVAR) = 0
C
END DO
C
C* . 1.1 Basic state.
C
110 CONTINUE
C
NSEXIST(NSVOR) = 1
NSEXIST(NSDIV) = 1
C
NGEXIST(NGUU) = 1
NGEXIST(NGVV) = 1
C
NMVOEXIST(NOUU) = 1
NMVOEXIST(NOVV) = 1
C
C* 2. Read NAMELIST NAMSTATE to find which fields are needed
C
200 CONTINUE
C
DO JVAR = 1, JPNVARMAX
csneed(jvar) = ' '
cgneed(jvar) = ' '
cmvoneed(jvar) = ' '
enddo
CSNEED(1) ='QQ'
CSNEED(2) ='DD'
CSNEED(3) ='TT'
CSNEED(4) ='HU'
CSNEED(5) ='P0'
cjmb CSNEED(6) ='TG'
CGNEED(1) ='UU'
CGNEED(2) ='VV'
CGNEED(3) ='TT'
CGNEED(4) ='HU'
CGNEED(5) ='P0'
cjmb CGNEED(6) ='TG'
CMVONEED(1) ='UU'
CMVONEED(2) ='VV'
CMVONEED(3) ='TT'
CMVONEED(4) ='HU'
CMVONEED(5) ='ES'
CMVONEED(6) ='GZ'
CMVONEED(7) ='P0'
cjmb CMVONEED(8) ='TG'
c
CALL READNML('NAMSTATE',IFLAG)
C
C* 3. Modify default values
C
300 CONTINUE
C
C* . 3.1 Spectral model state
C
310 CONTINUE
C
NVSP = 0
NVGD = 0
NVO3D = 0
NVSP2D = 0
NVG2D = 0
NVO2D = 0
C
C* For Chemical species
C
NSCMT = 0
NGCMT = 0
NOCMT = 0
DO JVAR = 1, JPNVARMAX
IF(CSNEED(JVAR).EQ.'QQ') THEN
NSEXIST(NSVOR) = 1
NVSP = NVSP + 1
ELSE IF(CSNEED(JVAR).EQ.'DD') THEN
NSEXIST(NSDIV) = 1
NVSP = NVSP + 1
ELSE IF(CSNEED(JVAR).EQ.'TT') THEN
NSEXIST(NSTT) = 1
NVSP = NVSP + 1
ELSE IF(CSNEED(JVAR).EQ.'HU') THEN
NSEXIST(NSQ) = 1
NVSP = NVSP + 1
ELSE IF(CSNEED(JVAR).EQ.'GZ') THEN
NSEXIST(NSGZ) = 1
NVSP = NVSP + 1
ELSE IF(CSNEED(JVAR).EQ.'P0') THEN
NSEXIST(NSPS) = 1
NVSP2D = NVSP2D + 1
ELSE IF(CSNEED(JVAR).EQ.'TG') THEN
NSEXIST(nstg) = 1
NVSP2D = NVSP2D + 1
C
C* Chemical species
C
ELSE
IF(CSNEED(JVAR).NE. ' ') THEN
NVSP = NVSP + 1
NSCMT = NSCMT+1
NSEXIST(NSTR(NSCMT)) = 1
CSCMT(NSCMT) = CSNEED(JVAR)
WRITE(NULOUT,*)'spectral ', CSNEED(JVAR), ' added'
ENDIF
END IF
C
C* . 3.2 Grid point model state
C
320 CONTINUE
C
IF(CGNEED(JVAR).EQ.'UU') THEN
NGEXIST(NGUU) = 1
NVGD = NVGD + 1
ELSE IF(CGNEED(JVAR).EQ.'VV') THEN
NGEXIST(NGVV) = 1
NVGD = NVGD + 1
ELSE IF(CGNEED(JVAR).EQ.'TT') THEN
NGEXIST(NGTT) = 1
NVGD = NVGD + 1
ELSE IF(CGNEED(JVAR).EQ.'HU') THEN
NGEXIST(NGQ) = 1
NVGD = NVGD + 1
ELSE IF(CGNEED(JVAR).EQ.'GZ') THEN
NGEXIST(NGGZ) = 1
NVGD = NVGD + 1
ELSE IF(CGNEED(JVAR).EQ.'P0') THEN
NGEXIST(NGPS) = 1
NVG2D = NVG2D + 1
ELSE IF(CGNEED(JVAR).EQ.'TG') THEN
NGEXIST(ngtg) = 1
NVG2D = NVG2D + 1
C
C* Chemical species
C
ELSE
IF(CGNEED(JVAR).NE. ' ') THEN
NVGD = NVGD + 1
NGCMT = NGCMT+1
NGEXIST(NGTR(NGCMT)) = 1
CGCMT(NGCMT) = CGNEED(JVAR)
WRITE(NULOUT,*)'grid ', CGNEED(JVAR), ' added'
ENDIF
END IF
C
C* . 3.3 Model state at the observation locations
C
330 CONTINUE
C
IF(CMVONEED(JVAR).EQ.'UU') THEN
NMVOEXIST(NOUU) = 1
NVO3D = NVO3D + 1
ELSE IF(CMVONEED(JVAR).EQ.'VV') THEN
NMVOEXIST(NOVV) = 1
NVO3D = NVO3D + 1
ELSE IF(CMVONEED(JVAR).EQ.'TT') THEN
NMVOEXIST(NOTT) = 1
NVO3D = NVO3D + 1
ELSE IF(CMVONEED(JVAR).EQ.'HU') THEN
NMVOEXIST(NOQ) = 1
NVO3D = NVO3D + 1
ELSE IF(CMVONEED(JVAR).EQ.'GZ') THEN
NMVOEXIST(NOGZ) = 1
NVO3D = NVO3D + 1
ELSE IF(CMVONEED(JVAR).EQ.'ES') THEN
NMVOEXIST(noes) = 1
NVO3D = NVO3D + 1
ELSE IF(CMVONEED(JVAR).EQ.'P0') THEN
NMVOEXIST(NOPS) = 1
NVO2D = NVO2D + 1
ELSE IF(CMVONEED(JVAR).EQ.'TG') THEN
NMVOEXIST(notg) = 1
NVO2D = NVO2D + 1
C
C* Chemical species
C
ELSE
IF(CMVONEED(JVAR).NE. ' ') THEN
NVO3D = NVO3D + 1
NOCMT = NOCMT+1
CMVOCMT(NOCMT) = CMVONEED(JVAR)
NMVOEXIST(NOTR(NOCMT)) = 1
WRITE(NULOUT,*)'obs. grid ', CMVONEED(JVAR), ' added'
ENDIF
END IF
C
END DO
C
C Final evaluation of the pseudo-indices for ...
C
C ... spectral model variable
C
IPOS = 1
DO JVAR = 1, JPNVARMAX
IF (NSVOR .EQ. JVAR) THEN
IF (NSEXIST(JVAR) .EQ. 1) THEN
NSVOR = IPOS
NSEXIST(IPOS) = 1
IPOS = IPOS + 1
ELSE
NSVOR = -9
ENDIF
ELSEIF(NSDIV .EQ. JVAR) THEN
IF (NSEXIST(JVAR) .EQ. 1) THEN
NSDIV = IPOS
NSEXIST(IPOS) = 1
IPOS = IPOS + 1
ELSE
NSDIV = -9
ENDIF
ELSEIF(NSQ .EQ. JVAR) THEN
IF (NSEXIST(JVAR) .EQ. 1) THEN
NSQ = IPOS
NSEXIST(IPOS) = 1
IPOS = IPOS + 1
ELSE
NSQ = -9
ENDIF
ELSEIF(NSGZ .EQ. JVAR) THEN
IF (NSEXIST(JVAR) .EQ. 1) THEN
NSGZ = IPOS
NSEXIST(IPOS) = 1
IPOS = IPOS + 1
ELSE
NSGZ = -9
ENDIF
ELSEIF(NSTT .EQ. JVAR) THEN
IF (NSEXIST(JVAR) .EQ. 1) THEN
NSTT = IPOS
NSEXIST(IPOS) = 1
IPOS = IPOS + 1
ELSE
NSTT = -9
ENDIF
ELSEIF(NSPS .EQ. JVAR) THEN
IF (NSEXIST(JVAR) .EQ. 1) THEN
NSPS = IPOS
NSEXIST(IPOS) = 1
IPOS = IPOS + 1
ELSE
NSPS = -9
ENDIF
elseif(nstg .eq. jvar) then
if (NSEXIST(jvar) .eq. 1) then
nstg = ipos
nsexist(ipos) = 1
ipos = ipos + 1
else
nstg = -9
endif
ELSE
DO JJ= 1,NCMTMAX
IF(NSTR(JJ) .EQ. JVAR) THEN
IF (NSEXIST(JVAR) .EQ. 1) THEN
NSTR(JJ) = IPOS
NSEXIST(IPOS) = 1
IPOS = IPOS + 1
ELSE
NSTR(JJ) = -9
ENDIF
ENDIF
ENDDO
ENDIF
ENDDO
C
IF(NSVOR .EQ. -9) THEN
NSVOR = IPOS
NSEXIST(IPOS) = 0
IPOS = IPOS + 1
ENDIF
IF(NSDIV .EQ. -9) THEN
NSDIV = IPOS
NSEXIST(IPOS) = 0
IPOS = IPOS + 1
ENDIF
IF(NSQ .EQ. -9) THEN
NSQ = IPOS
NSEXIST(IPOS) = 0
IPOS = IPOS + 1
ENDIF
IF(NSGZ .EQ. -9) THEN
NSGZ = IPOS
NSEXIST(IPOS) = 0
IPOS = IPOS + 1
ENDIF
IF(NSTT .EQ. -9) THEN
NSTT = IPOS
NSEXIST(IPOS) = 0
IPOS = IPOS + 1
ENDIF
DO JJ = 1, NCMTMAX
IF(NSTR(JJ) .EQ. -9) THEN
NSTR(JJ) = IPOS
NSEXIST(IPOS) = 0
IPOS = IPOS + 1
ENDIF
ENDDO
IF(NSPS .EQ. -9) THEN
NSPS = IPOS
NSEXIST(IPOS) = 0
IPOS = IPOS + 1
ENDIF
if(nstg .eq. -9) then
nstg = ipos
nsexist(ipos) = 0
ipos = ipos + 1
endif
C
C ... GRIDPOINT MODEL VARIABLE
C
CLMSG = 'SUSTATE: INCONSISTENT CGNEED AND CMVONEED IN NAMSTATE'
C
IPOS = 1
DO JVAR = 1, JPNVARMAX
IF (NGUU .EQ. JVAR) THEN
IF (NGEXIST(JVAR) .EQ. 1) THEN
NGUU = IPOS
NGEXIST(IPOS) = 1
IPOS = IPOS + 1
IF(NMVOEXIST(NOUU) .EQ. 0) THEN
CALL ABORT3D(NULOUT,CLMSG)
ENDIF
ELSE
NGUU = -9
ENDIF
ELSEIF(NGVV .EQ. JVAR) THEN
IF (NGEXIST(JVAR) .EQ. 1) THEN
NGVV = IPOS
NGEXIST(IPOS) = 1
IPOS = IPOS + 1
IF(NMVOEXIST(NOVV) .EQ. 0) THEN
CALL ABORT3D(NULOUT,CLMSG)
ENDIF
ELSE
NGVV = -9
ENDIF
ELSEIF(NGQ .EQ. JVAR) THEN
IF (NGEXIST(JVAR) .EQ. 1) THEN
NGQ = IPOS
NGEXIST(IPOS) = 1
IPOS = IPOS + 1
IF(NMVOEXIST(NOQ) .EQ. 0) THEN
CALL ABORT3D(NULOUT,CLMSG)
ENDIF
ELSE
NGQ = -9
ENDIF
ELSEIF(NGGZ .EQ. JVAR) THEN
IF (NGEXIST(JVAR) .EQ. 1) THEN
NGGZ = IPOS
NGEXIST(IPOS) = 1
IPOS = IPOS + 1
IF(NMVOEXIST(NOGZ) .EQ. 0) THEN
CALL ABORT3D(NULOUT,CLMSG)
ENDIF
ELSE
NGGZ = -9
ENDIF
ELSEIF(NGTT .EQ. JVAR) THEN
IF (NGEXIST(JVAR) .EQ. 1) THEN
NGTT = IPOS
NGEXIST(IPOS) = 1
IPOS = IPOS + 1
IF(NMVOEXIST(NOTT) .EQ. 0) THEN
CALL ABORT3D(NULOUT,CLMSG)
ENDIF
ELSE
NGTT = -9
ENDIF
ELSEIF(NGPS .EQ. JVAR) THEN
IF (NGEXIST(JVAR) .EQ. 1) THEN
NGPS = IPOS
NGEXIST(IPOS) = 1
IPOS = IPOS + 1
IF(NMVOEXIST(NOPS) .EQ. 0) THEN
CALL ABORT3D(NULOUT,CLMSG)
ENDIF
ELSE
NGPS = -9
ENDIF
elseif(ngtg .eq. jvar) then
if (NGEXIST(jvar) .eq. 1) then
ngtg = ipos
ngexist(ipos) = 1
ipos = ipos + 1
IF(NMVOEXIST(NOTG) .EQ. 0) THEN
CALL ABORT3D(NULOUT,CLMSG)
ENDIF
else
ngtg = -9
endif
ELSE
DO JJ= 1,NCMTMAX
IF(NGTR(JJ) .EQ. JVAR) THEN
IF (NGEXIST(JVAR) .EQ. 1) THEN
NGTR(JJ) = IPOS
NGEXIST(IPOS) = 1
IPOS = IPOS + 1
IF(NMVOEXIST(NOTR(JJ)) .EQ. 0) THEN
CALL ABORT3D(NULOUT,CLMSG)
ENDIF
ELSE
NGTR(JJ) = -9
ENDIF
ENDIF
ENDDO
ENDIF
ENDDO
C
IF(NGUU .EQ. -9) THEN
NGUU = IPOS
NGEXIST(IPOS) = 0
IPOS = IPOS + 1
ENDIF
IF(NGVV .EQ. -9) THEN
NGVV = IPOS
NGEXIST(IPOS) = 0
IPOS = IPOS + 1
ENDIF
IF(NGQ .EQ. -9) THEN
NGQ = IPOS
NGEXIST(IPOS) = 0
IPOS = IPOS + 1
ENDIF
IF(NGGZ .EQ. -9) THEN
NGGZ = IPOS
NGEXIST(IPOS) = 0
IPOS = IPOS + 1
ENDIF
IF(NGTT .EQ. -9) THEN
NGTT = IPOS
NGEXIST(IPOS) = 0
IPOS = IPOS + 1
ENDIF
DO JJ = 1, NCMTMAX
IF(NGTR(JJ) .EQ. -9) THEN
NGTR(JJ) = IPOS
NGEXIST(IPOS) = 0
IPOS = IPOS + 1
ENDIF
ENDDO
IF(NGPS .EQ. -9) THEN
NGPS = IPOS
NGEXIST(IPOS) = 0
IPOS = IPOS + 1
ENDIF
if(ngtg .eq. -9) then
ngtg = ipos
ngexist(ipos) = 0
ipos = ipos + 1
endif
C
C ... MODEL STATE AT THE OBSERVATION LOCATIONS
C
IPOS = 1
DO JVAR = 1, JPNVARMAX
IF (NOUU .EQ. JVAR) THEN
IF (NMVOEXIST(JVAR) .EQ. 1) THEN
NOUU = IPOS
NMVOEXIST(IPOS) = 1
IPOS = IPOS + 1
ELSE
NOUU = -9
ENDIF
ELSEIF(NOVV .EQ. JVAR) THEN
IF (NMVOEXIST(JVAR) .EQ. 1) THEN
NOVV = IPOS
NMVOEXIST(IPOS) = 1
IPOS = IPOS + 1
ELSE
NOVV = -9
ENDIF
ELSEIF(NOQ .EQ. JVAR) THEN
IF (NMVOEXIST(JVAR) .EQ. 1) THEN
NOQ = IPOS
NMVOEXIST(IPOS) = 1
IPOS = IPOS + 1
ELSE
NOQ = -9
ENDIF
ELSEIF(NOGZ .EQ. JVAR) THEN
IF (NMVOEXIST(JVAR) .EQ. 1) THEN
NOGZ = IPOS
NMVOEXIST(IPOS) = 1
IPOS = IPOS + 1
ELSE
NOGZ = -9
ENDIF
ELSEIF(NOTT .EQ. JVAR) THEN
IF (NMVOEXIST(JVAR) .EQ. 1) THEN
NOTT = IPOS
NMVOEXIST(IPOS) = 1
IPOS = IPOS + 1
ELSE
NOTT = -9
ENDIF
ELSEIF(NOES .EQ. JVAR) THEN
IF (NMVOEXIST(JVAR) .EQ. 1) THEN
NOES = IPOS
NMVOEXIST(IPOS) = 1
IPOS = IPOS + 1
ELSE
NOES = -9
ENDIF
ELSEIF(NOPS .EQ. JVAR) THEN
IF (NMVOEXIST(JVAR) .EQ. 1) THEN
NOPS = IPOS
NMVOEXIST(IPOS) = 1
IPOS = IPOS + 1
ELSE
NOPS = -9
ENDIF
elseif(notg .eq. jvar) then
if (NMVOEXIST(jvar) .eq. 1) then
notg = ipos
nmvoexist(ipos) = 1
ipos = ipos + 1
else
notg = -9
endif
ELSE
DO JJ= 1,NCMTMAX
IF(NOTR(JJ) .EQ. JVAR) THEN
IF (NMVOEXIST(JVAR) .EQ. 1) THEN
NOTR(JJ) = IPOS
NMVOEXIST(IPOS) = 1
IPOS = IPOS + 1
ELSE
NOTR(JJ) = -9
ENDIF
ENDIF
ENDDO
ENDIF
ENDDO
C
IF(NOUU .EQ. -9) THEN
NOUU = IPOS
NMVOEXIST(IPOS) = 0
IPOS = IPOS + 1
ENDIF
IF(NOVV .EQ. -9) THEN
NOVV = IPOS
NMVOEXIST(IPOS) = 0
IPOS = IPOS + 1
ENDIF
IF(NOQ .EQ. -9) THEN
NOQ = IPOS
NMVOEXIST(IPOS) = 0
IPOS = IPOS + 1
ENDIF
IF(NOGZ .EQ. -9) THEN
NOGZ = IPOS
NMVOEXIST(IPOS) = 0
IPOS = IPOS + 1
ENDIF
IF(NOTT .EQ. -9) THEN
NOTT = IPOS
NMVOEXIST(IPOS) = 0
IPOS = IPOS + 1
ENDIF
DO JJ = 1, NCMTMAX
IF(NOTR(JJ) .EQ. -9) THEN
NOTR(JJ) = IPOS
NMVOEXIST(IPOS) = 0
IPOS = IPOS + 1
ENDIF
ENDDO
IF(NOES .EQ. -9) THEN
NOES = IPOS
NMVOEXIST(IPOS) = 0
IPOS = IPOS + 1
ENDIF
IF(NOPS .EQ. -9) THEN
NOPS = IPOS
NMVOEXIST(IPOS) = 0
IPOS = IPOS + 1
ENDIF
if(notg .eq. -9) then
notg = ipos
nmvoexist(ipos) = 0
ipos = ipos + 1
endif
C
RETURN
END