c
      subroutine mkutvert
c
c Contour ut vs zp/ht:
c
      include "flxproc.h"
      include "ccm.h"
      include "pltopt.h"
      real vp(4),vputvert(4)
      pointer (pzp,zp(1)), (pplt,plt(1)), (putinc,utinc(1))
      character*80 msgout
      real htscales(3,mxvrange),zpranges(2,mxvrange)
      data vputvert /.10,.76,.29,.90/
      data ncalls/0/, nflds/0/
c
      write(6,"(/'Ut vs zp/ht contours at selected locations:')")
      if (multiadvfr.gt.0) nppf = 0
      ncalls = ncalls+1
      if (ncalls.eq.1) then
        nflds = 0
        do ip=1,mxfproc
          if (ifproc(ip).gt.0) nflds = nflds+1
        enddo
      endif
c
c Define increasing ut:
c
      call alloc(putinc,ntms)
      do it=1,ntms
        utinc(it) = float(mtimes(1,it))*24.+
     +    float(mtimes(2,it))+float(mtimes(3,it))/60.
      enddo
c
c Field 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
        ilog = 0
        if (iutvert_log10.gt.0.and.logplt(ip).gt.0) ilog = 1
c
c Define plot options (common in pltopt.h, included by pltlon)
c
        pltmin = cmin(ip) 
        pltmax = cmax(ip) 
        conint = cint(ip) 
        scfac = scalefac(ip)
	pltchsize = 0.
c
c Set up coupled vs tgcm-only field:
c (zp(nzp) = full zp range available, zpcol(ny) = range actually plotted)
c
        if (ifcpl(ip).gt.0) then
          nzp = ncplzp
          call alloc(pzp,nzp)
          do k=1,nzp
            zp(k) = cplzp(k)
          enddo
          call alloc(pplt,ntms*nzp)
        else
          nzp = kmx
          call alloc(pzp,nzp)
          do k=1,nzp
            zp(k) = gcmzp(k)
          enddo
          call alloc(pplt,ntms*nzp)
        endif
c
c Determine number of and validate zp ranges requested and transfer 
c   to local array. This must be done in field loop, since valid zpranges
c   are different for coupled vs non-coupled fields.
c
        call setyverts(utvert_zprange,zpranges,nzpranges,
     +                 utvert_htscale,htscales,nhtscales,
     +                 mxvrange,zp,nzp,dzp,spval,0)
        if (nhtscales.gt.0) then
          write(6,"('>>> Sorry, ut vs height contours not yet ',
     +      'available <<<')")
          nhtscales = 0
        endif
c
c Location loop:
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)
          if (nzpranges.le.0) goto 150
c
c Plot at zp ranges:
c
          do irange = 1,nzpranges
            izp0 = ixfind(zp,nzp,zpranges(1,irange),dzp)
            izp1 = ixfind(zp,nzp,zpranges(2,irange),dzp)
            nzplt = izp1-izp0+1
            call xferutvert(futvert,ntms,ncplzp,nloc,nflds,plt,
     +        izp0,izp1,ifproc(ip),iloc,ifcpl(ip)) 
            call setmultivp(vputvert,iadvfr,nppf+1,multiplt,ipltrowcol,
     +        vp)
            if (mkplt.gt.0) then
              ix = (iloc-1)*ncplzp*ntms+1 ! pfutvertz(ntms,ncplzp,nloc)
              call pltutvert(plt,futvertz(ix),utinc,zp,
     +          ntms,nzplt,0,utvert_locs(1,l),glon,utvert_locname(l),
     +          iutvertlocslt(l),ip,vp)
            endif
            call clearstr(msgout)
            write(msgout,"(a,' lat,lon=',f5.1,',',f6.1,' zp ',f5.1,
     +        ' to ',f5.1)") flab8(ip),utvert_locs(1,l),glon,
     +        zp(izp0),zp(izp1)
c                
c Advance frame and report to stdout:
c
            nppf = nppf+1
            call advframe(iwk_cgm,igks_cgm,iwk_ps,igks_ps,
     +        multiplt,iadvfr,nppf,msgout,'ut vs vert',iframe_plt)
          enddo		! irange=1,nzprange
c
c Plot at linear height scales (not yet available 5/96):
c
 150      if (nhtscales.le.0) goto 155



 155      continue
 50     continue	! l=1,mxloc
        call hpdeallc(pplt,ier,1)
        call hpdeallc(pzp,ier,1)
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
      call hpdeallc(putinc,ier,1)
      return
      end
c
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
      subroutine xferutvert(futvert,ntms,ncplzp,nloc,nflds,plt,
     +  izp0,izp1,ifld,iloc,iscpl)
      real futvert(ntms,ncplzp,nloc,nflds),plt(ntms,izp1-izp0+1)
      real fcol(ncplzp)
c 
c Transfer from pfutvert(ntms,ncplzp,nloc,nflds) to plt(ntms,nzp)
c Note ldutvert defined futvert at all ncplzp, but if tgcm only field,
c   then the first nccmlev-1 values are zero, and unused here.
c
      do it=1,ntms
        do k=1,ncplzp
          fcol(k) = futvert(it,k,iloc,ifld)
        enddo
        do k=izp0,izp1
          plt(it,k-izp0+1) = fcol(k)
        enddo 
c       call fminmax(fcol,ncplzp,fmin,fmax,1.e36)
c       write(6,"('xferutvert: it=',i2,' fcol fmin,max=',2e12.4)")
c    +    it,fmin,fmax
      enddo
      return
      end