c
      subroutine ldutvert(it)
c
c Define futvert(it,kmx,nloc,nfproc) at current time it:
c
      include "flxproc.h"
      include "ccm.h"
      real fcol(ncplzp)
c
c Allocate memory for plot array:
c
      if (it.eq.1) then
        if (nfproc.gt.0) then
          call alloc(pfutvert,ntms*ncplzp*nloc*nfproc)
          write(6,"('ldutvert alloc pfutvert: ntms=',i2,' ncplzp=',
     +      i2,' nloc=',i2,' nfproc=',i2)") ntms,ncplzp,nloc,nfproc
        endif
        call alloc(pfutvertz,ntms*ncplzp*nloc)
        write(6,"('ldutvert alloc pfutvertz: ntms=',i2,' ncplzp=',i2,
     +    ' nloc=',i2)") ntms,ncplzp,nloc
      endif
c
c Get heights futvertz(ntms,ncplzp,nloc) at desired longitude:
c
      iloc = 0
      do 50 l=1,mxlocs
        if (utvert_locs(1,l).eq.spval.or.
     +      utvert_locs(2,l).eq.spval) goto 50
        iloc = iloc+1
        glon = utvert_locs(2,l)                 ! is lon
        ixlon = ixfind(gcmlon,imx,glon,dlon)
        glon = gcmlon(ixlon)
        if (iutvertlocslt(l).gt.0)              ! is slt
     +    glon = fslt(utvert_locs(2,l),ut,dum,3)
        call getfldutcol(ifcpl(ixz),fcol,imx,jmx,ncplzp,mxfproc,
     +    utvert_locs(1,l),glon,logplt(ixz),ixz,
     +    fhist,kmx    ,nfhist ,gcmzp ,ixfhist,
     +    fccm ,nccmlev,nccmfld,cplzp ,ixfccm)
        do k=1,ncplzp
          ix = (iloc-1)*ncplzp*ntms+(k-1)*ntms+it
          futvertz(ix) = fcol(k)
        enddo
 50   continue
      if (nfproc.eq.0) return
c
c
c Fields loop:
c (non-zero values of ifproc are numbered in user defined order)
c (common nfproc is number of fields to be plotted (max of ifproc values),
c  and local nplt is current field in user defined order)
c
      nplt = 1
 101  continue
      do ip=1,mxfproc
        if (ifproc(ip).ne.nplt) goto 100
        if (ihtindep(ip).gt.0) goto 100
        iloc = 0
        do 200 l=1,mxlocs
          if (utvert_locs(1,l).eq.spval.or.
     +        utvert_locs(2,l).eq.spval) goto 200
          iloc = iloc+1
          glon = utvert_locs(2,l)                 ! is lon
          ixlon = ixfind(gcmlon,imx,glon,dlon)
          glon = gcmlon(ixlon)
          if (iutvertlocslt(l).gt.0)              ! is slt
     +      glon = fslt(utvert_locs(2,l),ut,dum,3)
          call getfldutcol(ifcpl(ip),fcol,imx,jmx,ncplzp,
     +      mxfproc,utvert_locs(1,l),glon,logplt(ip),ip,
     +      fhist,kmx    ,nfhist ,gcmzp ,ixfhist,
     +      fccm ,nccmlev,nccmfld,cplzp ,ixfccm)
c
c Transfer to pfutvert(ntms,ncplzp,nloc,nfproc)
c
          do k=1,ncplzp
            ix = (ifproc(ip)-1)*nloc*ncplzp*ntms+(iloc-1)*ncplzp*ntms+
     +           (k-1)*ntms+it
            futvert(ix) = fcol(k)
          enddo
 200    continue	! l=1,mxlocs
c
c Increment field count:
c
        nplt = nplt+1
        if (nplt.gt.nfproc) then        ! done with all fields
          goto 102
        else
          goto 101                      ! go back for next field
        endif
 100    continue
      enddo     ! ip=1,mxfproc
 102  continue  ! nplt = 1,nfproc
      return
      end
c
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
      subroutine getfldutcol(icpl,fout,imx,jmx,nzpout,mxfproc,
     +  glat,glon,log,ip,
     +  fgcm,ngcmzp,nfgcm,gcmzp,ixfgcm,
     +  fccm,nccmzp,nfccm,ccmzp,ixfccm)
c
c Call getfld to return tgcm column in fout(ncplzp) if icpl <= 0, 
c   or coupled column if icpl > 0. Bottom and top of zp scale is from
c   izp0 to izp1
c
      real fout(nzpout),fgcmcol(ngcmzp),fccmcol(nccmzp)
      real fgcm(imx,ngcmzp,jmx,nfgcm),gcmzp(ngcmzp)
      real fccm(imx,nccmzp,jmx,nfccm),ccmzp(nccmzp)
      integer ixfgcm(mxfproc),ixfccm(mxfproc)
c
c Coupled slice:
c
      if (icpl.gt.0) then
        call getfld(fgcm,imx,ngcmzp,jmx,nfgcm,fgcmcol,ngcmzp,1,
     +    'VERTPROF',glat,glon,gcmzp,dum,log,ixfgcm,ip,ier)
        call getfld(fccm,imx,nccmzp,jmx,nfccm,fccmcol,nccmzp,1,
     +    'VERTPROF',glat,glon,ccmzp,dum,log,ixfccm,ip,ier)
        do k=1,nzpout
          if (k.le.nccmzp) then
            fout(k) = fccmcol(k)
          else
            fout(k) = fgcmcol(k-nccmzp+1)
          endif
        enddo
c
c Tgcm only slice:
c
      else
        call getfld(fgcm,imx,ngcmzp,jmx,nfgcm,fgcmcol,ngcmzp,1,
     +    'VERTPROF',glat,glon,gcmzp,dum,log,ixfgcm,ip,ier)
        do k=1,nzpout
          if (k.gt.ngcmzp) then
            fout(k) = 0.
          else
            fout(k) = fgcmcol(k)
          endif
        enddo
      endif
      return
      end