subroutine fillmvo(cdmvo,cdvar,pvar,knlev,knobs) 10 #if defined (DOC) * ***s/r fillmvo - Fill in COMMVOG and/or COMMVOHR * * * Author : S. Pellerin ARMA/AES SEPT. 2000 * Revision: * JM Belanger CMDA/SMC Oct 2000 * . 32 bits conversion (Generic LOG) * C. Charette - ARMA/SMC - Sept 2004 * . Conversion to hybrid vertical coordinate * Y. Yang July 2004 * . Added extra loop for chemical species * Y. Yang Feb. 2005 * . Removed 'OZ' part * Y.J. Rochon Oct 2011 * - Separation of 'HR' and 'BG' parts for TR family. * ** Purpose: Fill in COMMVOG/COMMVOHR with trial profiles * *Arguments * * input: * CDMVO (character*4) : HR fills COMMVOHR * BG fills COMMVOG * CDVAR (character*4) : NOMVAR of the state variable * PVAR(knlev,knobs) : Variable to transfer in COMMVO(G)(HR) * KNLEV (integer) : number of levels of PVAR * KNOBS (integer) : number of observation profiles in variable PVAR * #endif implicit none *implicits #include "pardim.cdk"
#include "comdim.cdk"
#include "comdimo.cdk"
#include "comchem.cdk"
#include "commvo.cdk"
#include "commvog.cdk"
#include "commvohr.cdk"
#include "comgem.cdk"
#include "comphy.cdk"
#include "comcst.cdk"
c integer knlev,knobs real*8 pvar(knlev,knobs) character*(*) cdvar character*(*) cdmvo integer jj c integer jobs,jlev,inlev,istep real*8 zpty(1) pointer (ptr,zpty) c if(cdmvo.eq.'HR') then inlev = nlevtrl istep = nkgdimohr else inlev = nflev istep = nkgdimo endif c if (cdvar.eq.'PP') then if(cdmvo.eq.'HR') then ptr = loc(rppobshr(1,1)) elseif(cdmvo.eq.'BG') then ptr = loc(rppobs(1,1)) endif do jobs = 1,nobtot do jlev = 1,inlev zpty((jobs-1)*inlev+jlev) = pvar(jlev,jobs) enddo enddo elseif(cdvar.eq.'LV') then if(cdmvo.eq.'HR') then ptr = loc(vlevhr(1)) elseif(cdmvo.eq.'BG') then ptr = loc(vlev(1)) endif do jlev = 1,inlev zpty(jlev) = pvar(jlev,1) enddo elseif(cdvar.eq.'HY') then if(cdmvo.eq.'HR') then ptr = loc(vhybhr(1)) elseif(cdmvo.eq.'BG') then ptr = loc(vhybinc(1)) endif do jlev = 1,inlev zpty(jlev) = pvar(jlev,1) enddo elseif(cdvar.eq.'UU') then if(cdmvo.eq.'HR') then ptr = loc(gomuhr(1,1)) elseif(cdmvo.eq.'BG') then ptr = loc(gomug(1,1)) endif do jobs = 1,nobtot do jlev = 1, inlev zpty((jobs-1)*istep+jlev)=pvar(jlev,jobs)*rmsknt enddo enddo elseif(cdvar.eq.'VV') then if(cdmvo.eq.'HR') then ptr = loc(gomvhr(1,1)) elseif(cdmvo.eq.'BG') then ptr = loc(gomvg(1,1)) endif do jobs = 1,nobtot do jlev = 1, inlev zpty((jobs-1)*istep+jlev)= pvar(jlev,jobs)*rmsknt enddo enddo elseif(cdvar.eq.'GZ') then if(cdmvo.eq.'HR') then ptr = loc(gomgzhr(1,1)) elseif(cdmvo.eq.'BG') then ptr = loc(gomgzg(1,1)) endif do jobs = 1,nobtot do jlev = 1, inlev zpty((jobs-1)*istep+jlev)=pvar(jlev,jobs)*10.*rg enddo enddo elseif(cdvar.eq.'HU') then if(cdmvo.eq.'HR') then ptr = loc(gomqhr(1,1)) elseif(cdmvo.eq.'BG') then ptr = loc(gomqg(1,1)) endif do jobs = 1,nobtot do jlev = 1, inlev zpty((jobs-1)*istep+jlev)= log(max(pvar(jlev,jobs),rhumin)) enddo enddo elseif(cdvar.eq.'LQ') then if(cdmvo.eq.'HR') then ptr = loc(gomqhr(1,1)) elseif(cdmvo.eq.'BG') then ptr = loc(gomqg(1,1)) endif do jobs = 1,nobtot do jlev = 1, inlev zpty((jobs-1)*istep+jlev) = pvar(jlev,jobs) enddo enddo elseif(cdvar.eq.'ES') then if(cdmvo.eq.'HR') then ptr = loc(gomeshr(1,1)) elseif(cdmvo.eq.'BG') then ptr = loc(gomesg(1,1)) endif do jobs = 1,nobtot do jlev = 1, inlev zpty((jobs-1)*istep+jlev)=pvar(jlev,jobs) enddo enddo elseif(cdvar.eq.'TT') then if(cdmvo.eq.'HR') then ptr = loc(gomthr(1,1)) elseif(cdmvo.eq.'BG') then ptr = loc(gomtg(1,1)) endif do jobs = 1,nobtot do jlev = 1, inlev zpty((jobs-1)*istep+jlev)=pvar(jlev,jobs) + tcdk enddo enddo elseif(cdvar.eq.'P0') then if(cdmvo.eq.'HR') then ptr = loc(gompshr(1,1)) elseif(cdmvo.eq.'BG') then ptr = loc(gompsg(1,1)) endif do jobs = 1,nobtot zpty((jobs-1)*istep+1)=pvar(1,jobs)*rmbtpa enddo elseif(cdvar.eq.'TG') then if(cdmvo.eq.'HR') then ptr = loc(gomtgrhr(1,1)) elseif(cdmvo.eq.'BG') then ptr = loc(gomtgrg(1,1)) endif do jobs = 1,nobtot zpty((jobs-1)*istep+1)=pvar(1,jobs) enddo else if(cdmvo.eq.'HR') then do jj = 1,NOCMT if (cdvar.eq.CMVOCMT(jj)) then ptr = loc(gomtrhr((jj-1)*inlev+1,1)) do jobs = 1,nobtot do jlev = 1, inlev zpty((jobs-1)*istep+jlev)=pvar(jlev,jobs) enddo enddo go to 999 end if end do elseif(cdmvo.eq.'BG') then do jj = 1,NGCMT if (cdvar.eq.CGCMT(jj)) then ptr = loc(gomtrg((jj-1)*inlev+1,1)) do jobs = 1,nobtot do jlev = 1, inlev zpty((jobs-1)*istep+jlev)=pvar(jlev,jobs) enddo enddo go to 999 end if end do endif 999 continue endif c return end