c
      subroutine mklons(it)
c
c Prepare longitude slices and pass to conlon where contours are drawn:
c ccmf(ngcmlon,ngcmlat,nccmlev,nccmfld) (pointer pccmf is in common)
c fhist(imx,kmx,jmx,nfhist) (pointer pfhist is in common)
c
      include "flxproc.h"
      include "ccm.h"
      pointer (pplt,plt(1)), (pzpcol,zpcol(1)), (pht2d,ht2d(1))
      real slons(imx),vp(4),zpranges(2,jmx)
      data vp /.13,.87,.28,.90/
c
      write(6,"(' ')")
      write(6,"('Longitude slices at ut = ',f4.1,'  mtime = ',3i3)")
     +  ut,(mtimes(i,it),i=1,3)
      if (iyaxright.gt.1) then	! allow room on right for 2 right y-axes
        vp(1) = .12
        vp(2) = .77
      endif
c
c Determine number of selected lons, and place in local array slons:
c
      nlons = 0
      do i=1,imx
        if (flons(i).ne.spval) then
          nlons = nlons+1
          slons(nlons) = flons(i)
        endif  
      enddo
      if (nlons.le.0) return
      call alloc(pht2d,jmx*ncplzp)
c
c Field loop:
c
      do ip=1,mxflds
        if (ixfhist(ip).le.0) goto 100
        ilog = 0
        if (ilon_log10.gt.0.and.logplt(ip).gt.0) ilog = 1
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
        nzpranges = 0
        zpranges(:,:) = spval
        if (ixfcpl(ip).gt.0) then	! coupled field
          do j=1,jmx
            if (flon_zprange(1,j).ne.spval.and.
     +          flon_zprange(2,j).ne.spval) then
              izp0 = ixfind(cplzp,ncplzp,flon_zprange(1,j),dzp)
              izp1 = ixfind(cplzp,ncplzp,flon_zprange(2,j),dzp)
              if (izp0.le.0) then
                write(6,"('Reset bottom of zp axis from ',
     +            f5.1,' to bottom of coupled system at zp ',f5.1)")
     +            flon_zprange(1,j),cplzp(1)
                flon_zprange(1,j) = cplzp(1)
              endif
              if (izp1.le.0) then
                write(6,"('Reset top of zp axis from ',
     +            f5.1,' to top of coupled system at zp ',f5.1)")
     +            flon_zprange(2,j),cplzp(ncplzp)
                flon_zprange(2,j) = cplzp(ncplzp)
              endif
              nzpranges = nzpranges+1
              zpranges(1,nzpranges) = flon_zprange(1,j)
              zpranges(2,nzpranges) = flon_zprange(2,j)
            endif
          enddo
        else		! tgcm only field
          do j=1,jmx
            if (flon_zprange(1,j).ne.spval.and.
     +          flon_zprange(2,j).ne.spval) then
              izp0 = ixfind(gcmzp,kmx,flon_zprange(1,j),dzp)
              izp1 = ixfind(gcmzp,kmx,flon_zprange(2,j),dzp)
              if (izp0.le.0) then
                write(6,"('Reset bottom of zp axis from ',
     +            f5.1,' to bottom of tgcm at zp ',f5.1)")
     +            flon_zprange(1,j),gcmzp(1)
                flon_zprange(1,j) = gcmzp(1)
              endif
              if (izp1.le.0) then
                write(6,"('Reset top of zp axis from ',
     +            f5.1,' to top of tgcm at zp ',f5.1)")
     +            flon_zprange(2,j),gcmzp(kmx)
                flon_zprange(2,j) = gcmzp(kmx)
              endif
              nzpranges = nzpranges+1
              zpranges(1,nzpranges) = flon_zprange(1,j)
              zpranges(2,nzpranges) = flon_zprange(2,j)
            endif
          enddo
        endif
c
c Selected longitudes loop:
c
        do i=1,nlons
          if (slons(i).ne.zmflag) then
            ixi = ixfind(gcmlon,imx,slons(i),dlon)
            if (ixi.le.0) then
              write(6,"('>>> mklons: i=',i2,' bad slons(i)=',f10.2)")
     +          i,slons(i)
              stop 'ixi' 
            endif
            slons(i) = gcmlon(ixi)	! nearest longitude grid point
            izm = 0
          else				! zonal means
            ixi = 0
            izm = 1
          endif
c
c Get ht2d(imx,ncplzp) for right hand yaxis (yaxzpht):
c
          call xfercpl_lon(ht2d,ccmf,fhist,imx,jmx,kmx,nccmlev,
     +      ncplzp,nfhist,nccmfld,ixi,1,ncplzp,ncplzp,ixfhist(ixz),
     +      ixz2,izm,spval)
c
c Loop through specified zp ranges:
c
          do irange = 1,nzpranges
c
c Is a coupled field:
c
            if (ixfcpl(ip).gt.0) then	! coupled field
              izp0 = ixfind(cplzp,ncplzp,zpranges(1,irange),dzp)
              izp1 = ixfind(cplzp,ncplzp,zpranges(2,irange),dzp)
              ny = izp1-izp0+1
              call alloc(pplt,jmx*ny)
              call alloc(pzpcol,ny)
              do k=1,ny
                zpcol(k) = cplzp(izp0+k-1)
              enddo
              call xfercpl_lon(plt,ccmf,fhist,imx,jmx,kmx,nccmlev,
     +          ncplzp,nfhist,nccmfld,ixi,izp0,izp1,ny,ixfhist(ip),
     +          ixfcpl(ip),izm,spval)
              if (ilog.gt.0) call log10f(plt,jmx*ny,1.e-20,spval)
              call conlon(plt,gcmlat,zpcol,jmx,ny,vp,
     +          0.,0.,0.,1.,0,0,0,gkswid,zmin,zmax,ciu)
c
c Add extra right hand axes:
c     subroutine yaxzpht(hts1d,hts2d,gcmzp,id1,kmx,dzp,yy,ny,p0,
c    +  iht,iyax)
c     real  hts2d(id1,kmx), where ht2d=hts(imx,ncplzp), 
c           gcmzp(kmx),     where gcmzp=cplzp(ncplzp),
c           yy(ny),         where yy=zpcol(ny)
c
              if (iyaxright.gt.0)
     +          call yaxzpht(dum,ht2d,cplzp,jmx,ncplzp,dzp,zpcol,ny,
     +            p0,0,iyaxright)
c
c Info label and advance frame:
c
              call lablon(1,slons(i),zmin,zmax,ciu,ilog,it,ip)
              call frame
              iframe = iframe+1
              if (slons(i).ne.zmflag) then
                write(6,"('Frame ',i3,' coupled field ',a,' lon=',f7.2,
     +            ' zp=',f6.1,' to ',f6.1)") iframe,flab8(ip),slons(i),
     +            zpcol(1),zpcol(ny)
              else
                write(6,"('Frame ',i3,' coupled field ',a,
     +            ' (zonal means)  zp=',f6.1,' to ',f6.1)") 
     +            iframe,flab8(ip),zpcol(1),zpcol(ny)
              endif
c
c Is a non-coupled field (tgcm only):
c
            else				! tgcm field only
              izp0 = ixfind(gcmzp,kmx,zpranges(1,irange),dzp)
              izp1 = ixfind(gcmzp,kmx,zpranges(2,irange),dzp)
              ny = izp1-izp0+1
         
              call alloc(pzpcol,ny)
              do k=1,ny
                zpcol(k) = gcmzp(izp0+k-1)
              enddo
              call xfergcm_lon(pltgcm,fhist,imx,jmx,kmx,nfhist,ixi,
     +          izp0,izp1,ny,ixfhist(ip),izm,spval)
              if (ilog.gt.0) call log10f(pltgcm,jmx*ny,1.e-20,spval)
              call conlon(pltgcm,gcmlat,zpcol,jmx,ny,vp,
     +          0.,0.,0.,1.,0,0,0,gkswid,zmin,zmax,ciu)
              call lablon(0,slons(i),zmin,zmax,ciu,ilog,it,ip)
              call frame
              iframe = iframe+1
              if (slons(i).ne.zmflag) then
                write(6,"('Frame ',i3,' tgcm field ',a,' lon=',f8.2,
     +            ' min,max=',2e12.4,' zp=',f6.1,' to ',f6.1)") 
     +            iframe,flab8(ip),slons(i),zpcol(1),zpcol(ny)
              else
                write(6,"('Frame ',i3,' tgcm field ',a,
     +            ' (zonal means)  min,max=',2e12.4,' zp=',f6.1,
     +            ' to ',f6.1)") iframe,flab8(ip),zpcol(1),zpcol(ny)
              endif
            endif
            call hpdeallc(pplt,ier,1)
            call hpdeallc(pzpcol,ier,1)
 200        continue
          enddo		! irange=1,nzprange
        enddo		! j=1,nlons
 100    continue
      enddo		! ip=1,mxflds
      call hpdeallc(pht2d,ier,1)
      return
      end
c
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
      subroutine xfercpl_lon(pltcpl,fccm,fgcm,imx,jmx,kmx,nccmlev,
     +  ncplzp,nfgcm,nfccm,ixi,izp0,izp1,nzp,ipgcm,ipccm,izm,spv)
c
c Define pltcpl coupled longitude slice from fccm and fgcm at levels 
c corresponding to izp0 to izp1 (where izp0,izp1 are bottom and top
c of zprange within cplzp):
c
      real pltcpl(jmx,nzp),fccm(imx,jmx,nccmlev,nfccm),
     +  fgcm(imx,kmx,jmx,nfgcm)
c
      kk = 0
      do k=1,nccmlev
        if (k.ge.izp0.and.k.le.izp1) then
          kk = kk+1
          if (izm.le.0) then
            pltcpl(:,kk) = fccm(ixi,:,k,ipccm)
          else		! zonal means
            do j=1,jmx
              pltcpl(j,kk) = fmean(fccm(1,j,k,ipccm),imx,0,1.e-20,
     +          spv,0)
            enddo
          endif
        endif
      enddo
      do k=nccmlev+1,ncplzp
        if (k.ge.izp0.and.k.le.izp1) then
          kk = kk+1
          if (izm.le.0) then
            pltcpl(:,kk) = fgcm(ixi,k-nccmlev+1,:,ipgcm)
          else		! zonal means
            do j=1,jmx
              pltcpl(j,kk) = fmean(fgcm(1,k-nccmlev+1,j,ipgcm),
     +          imx,0,1.e-20,spv,0)
            enddo
          endif
        endif
      enddo
      return
      end 
c
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
      subroutine xfergcm_lon(pltgcm,fgcm,imx,jmx,kmx,nfgcm,ixi,
     +  ny,izp0,izp1,ipgcm,izm)
      real pltgcm(jmx,ny),fgcm(imx,kmx,jmx,nfgcm)
c
      kk = 0
      do k=1,kmx
        if (k.ge.izp0.and.k.le.izp1) then
          kk = kk+1
          if (izm.le.0) then
            pltgcm(:,kk) = fgcm(ixi,k,:,ipgcm)
          else		! zonal means
            do j=1,jmx
              pltgcm(j,kk) = fmean(fgcm(1,k,j,ipgcm),imx,0,1.e-20,
     +          spv,0)
            enddo
          endif
        endif
      enddo
      return
      end
c
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
      subroutine lablon(icpl,slon,zmin,zmax,ciu,ilog,it,ip)
c
c Add info labels to lon slice contour plot:
c
      include "flxproc.h"
      include "ccm.h"
      character*120 blab0,blab1,blab2,tlab0,tlab1
      data toffset/.025/, boffset/.10/
c
c ccm history (bottom of 3 bottom labels):
c
      call clearstr(blab0)
      write(blab0,"('CCM FILE ',a,' (DAY ',f7.3,')')") 
     +  ccmlsd(1:lenstr(ccmlsd)),ccmday
c
c tgcm history (middle of 3 bottom labels):
c
      call clearstr(blab1)
      write(blab1,"('TGCM HISTORY ',a,' (',i3,', ',i2,', ',i2,')')")
     +  histvols(ivol)(1:lenstr(histvols(ivol))),
     +  (mtimes(i,it),i=1,3)
c
c Min,max label (top of 3 bottom labels):
c
      call clearstr(blab2)
      write(blab2,"('MIN,MAX=',2(1pe12.4),' INTERVAL=',1pe12.4)")
     +  zmin,zmax,ciu
c     if (scalefac(ip).eq.1.) then
c       write(blab2,"('MIN,MAX=',2(1pe12.4),' INTERVAL=',1pe12.4)")
c    +    zmin,zmax,ciu
c     else
c       write(blab2,"('MIN,MAX=',2(1pe12.4),' INTERVAL=',1pe12.4,
c    +    ' (X',1pe8.2,')')") zmin,zmax,ciu,scalefac(ip)
c     endif
c
c Info label with time and selected longitude:
c (bottom of 2 top labels)
c
      call clearstr(tlab0)
      if (slon.ne.zmflag) then
        slt = fslt(dum,ut,slon,1)
        write(tlab0,"('UT=',f4.1,'  LON=',f8.2,' (DEG)  SLT=',f5.2,
     +    ' (HRS)')") ut,slon,slt
      else
        write(tlab0,"('UT=',f4.1,'  ZONAL MEANS')") ut
      endif
c
c Field label:
c (top of 2 top labels)
c
      call clearstr(tlab1)
      if (icpl.gt.0) then
        if (ilog.le.0) then
          write(tlab1,"('FIELD ',a,' (COUPLED ',a,'/',a,')')") 
     +      flab8(ip)(1:lenstr(flab8(ip))),model(1:lenstr(model)),
     +      ccmres(1:lenstr(ccmres))
        else
          write(tlab1,"('LOG10 ',a,' (COUPLED ',a,'/',a,')')") 
     +      flab8(ip)(1:lenstr(flab8(ip))),model(1:lenstr(model)),
     +      ccmres(1:lenstr(ccmres))
        endif
      else
        if (ilog.le.0) then
          write(tlab1,"('FIELD ',a,' (',a,' ONLY)')") 
     +      flab8(ip)(1:lenstr(flab8(ip))),model(1:lenstr(model))
        else
          write(tlab1,"('LOG10 ',a,' (',a,' ONLY)')") 
     +      flab8(ip)(1:lenstr(flab8(ip))),model(1:lenstr(model))
        endif
      endif
c
c Add the 5 labels to the plot:
c
      call wrlab5(tlab0,tlab1,toffset, blab0,blab1,blab2,boffset,
     +  .015,.015,.014,.014,.014,0)
      return
      end