!-------------------------------------- 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 locptgomhr(kstep) 1 #if defined (DOC) * ***s/r locptgomhr - Memory allocation and loc of pointer for background * state in obs location * *Author : S. Pellerin *ARMA/SMC Sept. 2000 *Revision: * C. Charette - ARMA/SMC - Sep. 2004 * - Conversion to hybrid vertical coordinate ** *Arguments * * #endif C IMPLICIT NONE *implicits #include "comdimo.cdk"
#include "comstate.cdk"
#include "commvohr.cdk"
integer kstep,ier character*2 cdvar c integer iloc,jvar c call hpalloc(ptmobshr,nkgdimohr*nobtot,ier,8) call hpalloc(ptvlevhr,nlevtrl,ier,8) call hpalloc(ptvhybhr,nlevtrl,ier,8) call hpalloc(ptppobshr,nlevtrl*nobtot,ier,8) c call hpalloc(ptvmahr, nlevtrl,ier,8) call hpalloc(ptvmbhr, nlevtrl,ier,8) call hpalloc(ptvmchr, nlevtrl,ier,8) call hpalloc(ptvmdhr, nlevtrl,ier,8) call hpalloc(ptvmehr, nlevtrl,ier,8) call hpalloc(ptvmfhr, nlevtrl,ier,8) c ptomuhr = -1 ptomvhr = -1 ptomthr = -1 ptomqhr = -1 ptomgzhr = -1 ptomozhr = -1 ptomeshr = -1 ptomtrhr = -1 ptompshr = -1 ptomtgrhr= -1 c iloc = 1 do jvar = 1, jpnvarmax if(jvar.eq.nouu) then if(nmvoexist(nouu).eq.1) then ptomuhr = loc(gomobshr(iloc,1)) iloc = iloc + kstep endif endif if(jvar.eq.novv) then if(nmvoexist(novv).eq.1) then ptomvhr = loc(gomobshr(iloc,1)) iloc = iloc + kstep endif endif if(jvar.eq.nogz) then if(nmvoexist(nogz).eq.1) then ptomgzhr = loc(gomobshr(iloc,1)) iloc = iloc + kstep endif endif if(jvar.eq.noq) then if(nmvoexist(noq).eq.1) then ptomqhr = loc(gomobshr(iloc,1)) iloc = iloc + kstep endif endif if(jvar.eq.nott) then if(nmvoexist(nott).eq.1) then ptomthr = loc(gomobshr(iloc,1)) iloc = iloc + kstep endif endif if(jvar.eq.nooz) then if(nmvoexist(nooz).eq.1) then ptomozhr = loc(gomobshr(iloc,1)) iloc = iloc + kstep endif endif if(jvar.eq.notr) then if(nmvoexist(notr).eq.1) then ptomtrhr = loc(gomobshr(iloc,1)) iloc = iloc + kstep endif endif if(jvar.eq.noes) then if(nmvoexist(noes).eq.1) then ptomeshr = loc(gomobshr(iloc,1)) iloc = iloc + kstep endif endif if(jvar.eq.nops) then if(nmvoexist(nops).eq.1) then ptompshr = loc(gomobshr(iloc,1)) iloc = iloc + 1 endif endif if(jvar.eq.notg) then if(nmvoexist(notg).eq.1) then ptomtgrhr = loc(gomobshr(iloc,1)) iloc = iloc + 1 endif endif enddo c RETURN END