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 * Y. Yang July 2004 * - Account for multiple species ** *Arguments * * #endif C IMPLICIT NONE *implicits #include "comdim.cdk"
#include "comdimo.cdk"
#include "comchem.cdk"
#include "comstate.cdk"
#include "commvohr.cdk"
integer kstep,ier c integer iloc,jvar integer jj 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 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.notr(1)) then if(nmvoexist(notr(1)).eq.1) then ptomtrhr = loc(gomobshr(iloc,1)) iloc = iloc + kstep endif endif do jj = 2, nocmt if(jvar.eq.notr(jj)) then if(nmvoexist(notr(jj)).eq.1) then iloc = iloc + kstep endif endif enddo 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