!-------------------------------------- LICENCE BEGIN ------------------------------------
!Environment Canada - Atmospheric Science and Technology License/Disclaimer,
! version 3; Last Modified: May 7, 2008.
!This is free but copyrighted software; you can use/redistribute/modify it under the terms
!of the Environment Canada - Atmospheric Science and Technology License/Disclaimer
!version 3 or (at your option) any later version that should be found at:
!http://collaboration.cmc.ec.gc.ca/science/rpn.comm/license.html
!
!This software is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY;
!without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
!See the above mentioned License/Disclaimer for more details.
!You should have received a copy of the License/Disclaimer along with this software;
!if not, you can write to: EC-RPN COMM Group, 2121 TransCanada, suite 500, Dorval (Quebec),
!CANADA, H9P 1J3; or send e-mail to service.rpn@ec.gc.ca
!-------------------------------------- LICENCE END --------------------------------------
!
SUBROUTINE SUALOBSB(KULOUT) 2
! 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
#if defined (DOC)
*
***s/r SUALOBS - Memory allocation for obs. related arrays
*
*Author : P. Gauthier *ARMA/AES June 9, 1992
*Revision: Bin HE *ARMA/MRB Oct. 2009
* - Implemented MPI to 3DVAR
*
*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 "commvo.cdk"
#include "commvo1.cdk"
#include "commvog.cdk"
#include "comoba.cdk"
#include "comstate.cdk"
*
INTEGER KULOUT, IERR
INTEGER ILEN, ILENU, ilen8
INTEGER iloc, jvar
EXTERNAL HPALLOC
C
WRITE(KULOUT,FMT='(//,6(" ***********"))')
WRITE(KULOUT,*)' SUALOBSB: Memory allocation of the',
S ' observation arrays'
WRITE(KULOUT,FMT='(6(" ***********"))')
C
C* 1. Model state at observation stations
C . -----------------------------------
C
100 CONTINUE
call hpalloc( ptmtag,max(nmxobs,1),ierr,0)
call hpalloc( ptpexy,max(nmxobs,1),ierr,0)
ILEN = NFLEV*NOBTOT
CALL HPALLOC( PTPPOBS,MAX(ILEN,1),IERR,8)
ILEN = NKGDIMO*NOBTOT
CALL HPALLOC( PTMTHOBS,MAX(NMXOBS,1),IERR,8)
CALL HPALLOC( PTMTMOBS,MAX(NMXOBS,1),IERR,8)
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*nobtot*2
call hpalloc(ptltv,max(ilen,1),IERR,8)
ilen = nflev*nobtot
call hpalloc(pttapfac,max(ilen,1),IERR,8)
if(chum.eq.'ES') then
ilen = nflev*nobtot
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*nobtot*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
PTOMOZ = -1
PTOMOZ1 = -1
PTOMOZG = -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. nooz) then
NMVOPOSIT(nooz) = iloc
if(NMVOEXIST(nooz).eq.1) then
PTOMOZ = LOC(GOMOBS(iloc,1))
PTOMOZ1 = LOC(GOMOBS1(iloc,1))
PTOMOZG = LOC(GOMOBSG(iloc,1))
iloc = iloc + nflev
end if
elseif(jvar .eq. notr) then
NMVOPOSIT(notr) = iloc
if(NMVOEXIST(notr).eq.1) then
PTOMTR = LOC(GOMOBS(iloc,1))
PTOMTR1 = LOC(GOMOBS1(iloc,1))
PTOMTRG = LOC(GOMOBSG(iloc,1))
iloc = iloc + nflev
end if
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 :",I6,10x
S ," (GOMU, GOMV,GOMGZ,GOMQ):",I10
S ," (GOMPS,GOMTGR):",I10)
C
RETURN
END