SUBROUTINE SUALOBS(KULOUT) 1
use modmask, only : lmaskpp_in, lmaskpp_out,lmasksf_in,lmasksf_out
use modmask, only : lmask,lmaskto,lmaskgo,lmaskro,lmaskzp,ldiagpp
use modmask, only : ldiagsf, ldiag
use modmask, only : lmasktr, lmasktr_all
#if defined (DOC)
*
***s/r SUALOBS - Memory allocation for obs. related arrays
*
*Author : P. Gauthier *ARMA/AES June 9, 1992
*Revision:
* L.Fillion *RPN/AES Feb 93 - Allocation for auxiliary fields
* 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.
* - Allocation (loc) for GOMES
* L.Fillion *ARMA/AES 25 nov 98 - Allocation for background fiels needed in TL and ADJ
* observation operators.
* J.Halle *CMDA/AES Oct 99
* - Added ground temperature to(TG) to model state
* P. KOCLAS CMC NOV 99
* added stnid field
* S. Pellerin *ARMA/SMC May 2000
* - Fix for F90 conversion:
* .Illimination of pointer to character*9 CSTNID
* .Introduction of distinc pointer for integer
* and real cma arrays (ptmobhdr,ptrobhdr,ptmobdata,ptrobdata)
* JM Belanger CMDA/SMC Jul 2000
* - 32 bits conversion
* (Memory allocation for ROBDATA8 array declared
* in comoba.cdk)
* S. Pellerin *ARMA/SMC nov. 2001
* - Allocation of mvar and pexy vertors for 4Dvar book keeping
* Y. Yang July 2003
* - Added loops to accommodate multiple species
* - Expanded size of CMA for 2 additional entries in ROBDASTA8
* Y. Yang Feb. 2005
* - Replaced 'OZ' related parts with that of 'TR' family.
* J. Halle *CMDA/SMC mai 2006
* - Added one additionnal entry for ROBDATA8 (now 9 itemss instead of 8)
* S. Pellerin *ARMA/SMC jan. 2009
* - Allocation of data assimilated mask
* Y. Yang ARQI/AQRD Jan 2010
* - Added additionnal entries on top of J. Halle's modification for
* ROBDATA8 (now 11 itemss instead of 10)
* - Allocation of masks related to constituents
* Y.J.Rochon *ARQX March 2011
* - Increased ROBDATA8 allocation to 14xNDATAMX for
* consistency with dimension in comoba.cdk
*
*Arguments
* i KULOUT: unit used for optional printing
*
#endif
C
IMPLICIT NONE
*implicits
#include "comdim.cdk"
#include "comcva.cdk"
#include "comdimo.cdk"
#include "comoahdr.cdk"
#include "comoabdy.cdk"
#include "comchem.cdk"
#include "commvo.cdk"
#include "commvo1.cdk"
#include "commvog.cdk"
#include "comoba.cdk"
#include "comstate.cdk"
*
INTEGER KULOUT, IERR
INTEGER ILEN, ILENU, ilen8
INTEGER iloc, jvar
INTEGER JJ
EXTERNAL HPALLOC
C
WRITE(KULOUT,FMT='(//,6(" ***********"))')
WRITE(KULOUT,*)' SUALOBS: Memory allocation of the',
S ' observation arrays'
WRITE(KULOUT,FMT='(6(" ***********"))')
C
C* 1. Model state at observation stations
C . -----------------------------------
C
100 CONTINUE
ILEN = NFLEV*NMXOBS
CALL HPALLOC( PTPPOBS,MAX(ILEN,1),IERR,8)
ILEN = NKGDIMO*NMXOBS
CALL HPALLOC( PTMTHOBS,MAX(NMXOBS,1),IERR,8)
CALL HPALLOC( PTMTMOBS,MAX(NMXOBS,1),IERR,8)
call hpalloc( ptmtag,max(nmxobs,1),ierr,0)
call hpalloc( ptpexy,max(nmxobs,1),ierr,0)
CALL HPALLOC( PTMOBS,MAX(ILEN,1),IERR,8)
CALL HPALLOC(PTMOBS1,MAX(ILEN,1),IERR,8)
CALL HPALLOC(PTMOBSG,MAX(ILEN,1),IERR,8)
ilen = nflev*nmxobs*2
call hpalloc(ptltv,max(ilen,1),IERR,8)
ilen = nflev*nmxobs
call hpalloc(pttapfac,max(ilen,1),IERR,8)
if(chum.eq.'ES') then
ilen = nflev*nmxobs
call hpalloc(ptestdg,max(ilen,1),IERR,8)
call hpalloc(ptdlnesg,max(ilen,1),IERR,8)
call hpalloc(ptrqgfac,max(ilen,1),IERR,8)
else
ilen = nflev*nmxobs*3
call hpalloc(ptlq2es,max(ilen,1),IERR,8)
endif
C
PTOMU = -1
PTOMU1 = -1
PTOMUG = -1
C
PTOMV = -1
PTOMV1 = -1
PTOMVG = -1
C
PTOMT = -1
PTOMT1 = -1
PTOMTG = -1
C
PTOMQ = -1
PTOMQ1 = -1
PTOMQG = -1
C
PTOMGZ = -1
PTOMGZ1 = -1
PTOMGZG = -1
c
PTOMTR = -1
PTOMTR1 = -1
PTOMTRG = -1
c
ptomes = -1
ptomes1 = -1
PTOMESG = -1
C
PTOMPS = -1
PTOMPS1 = -1
PTOMPSG = -1
C
PTOMTGR = -1
PTOMTGR1 = -1
PTOMTGRG = -1
C
iloc = 1
do jvar = 1,jpnvarmax
if(jvar .eq. nouu) then
NMVOPOSIT(nouu) = iloc
if(NMVOEXIST(nouu).eq.1) then
PTOMU = LOC(GOMOBS(iloc,1))
PTOMU1 = LOC(GOMOBS1(iloc,1))
PTOMUG = LOC(GOMOBSG(iloc,1))
iloc = iloc + nflev
end if
elseif(jvar .eq. novv) then
NMVOPOSIT(novv) = iloc
if(NMVOEXIST(novv).eq.1) then
PTOMV = LOC(GOMOBS(iloc,1))
PTOMV1 = LOC(GOMOBS1(iloc,1))
PTOMVG = LOC(GOMOBSG(iloc,1))
iloc = iloc + nflev
end if
elseif(jvar .eq. nogz) then
NMVOPOSIT(nogz) = iloc
if(NMVOEXIST(nogz).eq.1) then
PTOMGZ = LOC(GOMOBS(iloc,1))
PTOMGZ1 = LOC(GOMOBS1(iloc,1))
PTOMGZG = LOC(GOMOBSG(iloc,1))
iloc = iloc + nflev
end if
elseif(jvar .eq. noq) then
NMVOPOSIT(noq) = iloc
if(NMVOEXIST(noq).eq.1) then
PTOMQ = LOC(GOMOBS(iloc,1))
PTOMQ1 = LOC(GOMOBS1(iloc,1))
PTOMQG = LOC(GOMOBSG(iloc,1))
iloc = iloc + nflev
end if
elseif(jvar .eq. nott) then
NMVOPOSIT(nott) = iloc
if(NMVOEXIST(nott).eq.1) then
PTOMT = LOC(GOMOBS(iloc,1))
PTOMT1 = LOC(GOMOBS1(iloc,1))
PTOMTG = LOC(GOMOBSG(iloc,1))
iloc = iloc + nflev
end if
elseif(jvar .eq. notr(1)) then
NMVOPOSIT(notr(1)) = iloc
if(NMVOEXIST(notr(1)).eq.1) then
PTOMTR = LOC(GOMOBS(iloc,1))
PTOMTR1 = LOC(GOMOBS1(iloc,1))
PTOMTRG = LOC(GOMOBSG(iloc,1))
iloc = iloc + nflev
end if
DO JJ = 2,NOCMT
NMVOPOSIT(notr(JJ)) = iloc
if(NMVOEXIST(notr(JJ)).eq.1) then
iloc = iloc + nflev
end if
ENDDO
elseif(jvar .eq. noes) then
NMVOPOSIT(noes) = iloc
if(NMVOEXIST(noes).eq.1) then
PTOMES = LOC(GOMOBS(iloc,1))
PTOMES1 = LOC(GOMOBS1(iloc,1))
PTOMESG = LOC(GOMOBSG(iloc,1))
iloc = iloc + nflev
end if
elseif(jvar .eq. nops) then
NMVOPOSIT(nops) = iloc
if(NMVOEXIST(nops).eq.1) then
PTOMPS = LOC(GOMOBS(iloc,1))
PTOMPS1 = LOC(GOMOBS1(iloc,1))
PTOMPSG = LOC(GOMOBSG(iloc,1))
iloc = iloc + 1
end if
elseif(jvar .eq. notg) then
NMVOPOSIT(notg) = iloc
if(NMVOEXIST(notg).eq.1) then
PTOMTGR = LOC(GOMOBS(iloc,1))
PTOMTGR1 = LOC(GOMOBS1(iloc,1))
PTOMTGRG = LOC(GOMOBSG(iloc,1))
iloc = iloc + 1
end if
endif
enddo
C
C* . 1.1 Auxiliary state
C . ---------------
C
110 CONTINUE
C
ILENU = NMXOBS*NFLEV
WRITE(KULOUT,FMT='(/,"Arrays in COMMVO (COMMVO1) are allocated",
S " the following space:")')
WRITE(KULOUT,FMT=9100)ILEN,ILENU, NMXOBS
9100 FORMAT(" GOMOBS :",I10,10x
S ," (GOMU, GOMV,GOMGZ,GOMQ):",I10
S ," (GOMPS,GOMTGR):",I10)
C
C
C* 2. Arrays containing the observations themselves
C . (COMDECK COMOBA)
C . ---------------------------------------------
C
ILEN = NCMLET*NMXOBS
ILENU = NCMLBO*NDATAMX
WRITE(KULOUT,FMT=9101) NCMLET,NCMLBO,ILEN,ILENU
9101 FORMAT(" NCMLET :",I10,10x," NCMLBO :",I10,10x
$ ," NCMLET*NMXOBS :",I10,10x
S ," NCMLBO*NDATAMX:",I10)
C
CALL HPALLOC(ptrobhdr,MAX(ILEN,1),IERR,1)
ptmobhdr = ptrobhdr
CALL HPALLOC(PTROBDATA,MAX(ILENU,1),IERR,1)
ptmobdata = ptrobdata
* Memory allocation for ROBDATA8.
C
C Expand the CMA size since the definition of ROBDATA8 was modified.
C
c ilen8=8*NDATAMX
c ilen8=9*NDATAMX
c ilen8=11*NDATAMX
ilen8=14*NDATAMX
CALL HPALLOC(ptrobdata8,MAX(ilen8,1),IERR,8)
C
allocate(lmaskpp_in(ndatamx),lmaskpp_out(ndatamx))
lmaskpp_in = .false.
lmaskpp_out = .false.
allocate(lmasksf_in(ndatamx),lmasksf_out(ndatamx))
lmasksf_in = .false.
lmasksf_out = .false.
allocate(lmask(ndatamx),lmaskto(ndatamx),lmaskgo(ndatamx))
lmaskto = .false.
lmaskgo = .false.
allocate(lmaskro(ndatamx),lmaskzp(ndatamx),ldiagpp(ndatamx))
lmaskzp = .false.
lmaskro = .false.
ldiagpp = .false.
allocate(ldiagsf(ndatamx),ldiag(ndatamx))
ldiagsf = .false.
ldiag = .false.
allocate(lmasktr(NCMTMAX,ndatamx),lmasktr_all(ndatamx))
lmasktr= .false.
lmasktr_all= .false.
WRITE(KULOUT,FMT='(/," Arrays in COMOBA are allocated",
S " the following space:")')
WRITE(KULOUT,FMT=9200)ILEN,ILENU,ilen8
9200 FORMAT(" ROBHDR/MOBHDR: ",I10,10x
S ," ROBDATA/MOBDATA : ",I10,10x
S ," ROBDATA8 : ",I10,10x)
RETURN
END