c
c------------------------------------------------------------------
c Begin file /home/sting/foster/timesdif/pltpol.f
c------------------------------------------------------------------
c
      subroutine pltpol(utc,fld)
c
      include 'gettime.h'
      include 'timesdif.h'
      character*56 toplab,lab
      character*1 hem
      dimension plt(imx,jmx),viewport(4),fld(imx,kmx,jmx,nplfld)
      data viewport /.125,.875,.150,.900/
c
      xmid = 0.5*(viewport(1)+viewport(2))
      call cpseti('SET',0)
      call cpseti('MAP',1)
      call cpsetr('XC1',gcmlon(1))
      call cpsetr('XCM',gcmlon(imx))
      call cpsetr('ILX',0.5)
      call cpsetr('ILY',-.15)
c
c Perimeter latitude loop:
c
      do ih=1,npollat
        nlats = (90.-abs(perimlat(ih))+dlat/2.)/dlat
        if (perimlat(ih).ge.0.) then 
          hem = 'N'
          yc1 = perimlat(ih)
          ycn = gcmlat(jmx)
          iskip = jmx-nlats
          rot = -utc*15.
          plat = 90.
        else              
          hem = 'S'
          yc1 = gcmlat(1)
          ycn = perimlat(ih)
          iskip = 0
          rot = utc*15.-180.
          plat = -90.
        endif
        call mkproj('ST',viewport,plat,0.,rot,perimlat(ih),dum)
c
c Field loop: 
        ixp = 0
        do 200 ip=1,ntimefld
          if (ipltime(ip).le.0) goto 200
          ixp = ixp+1
c
c Selected pressure loop:
          do 100 izp = 1,npls
            ixpl = ixfind(gcmzp,kmx,spls(izp),dzp)
            if (ixpl.le.0) then
              write(6,"('>>> pltpol: bad selected pressure=',f10.3,
     +          ' izp=',i3)") spls(izp),izp
              goto 100
            endif
c
            do j=iskip+1,jmx
              plt(:,j-iskip) = fld(:,ixpl,j,ixp)
            enddo
            call cpsetr('YC1',yc1)
            call cpsetr('YCN',ycn)
            if (icolor.le.0) then
              call contour(plt,imx,imx,nlats,cint(ip),cmin(ip),cmax(ip))
            else
              call conclr(plt,imx,imx,nlats,cint(ip),cmin(ip),cmax(ip))
            endif
            if (icont.gt.0) call maplot
            call labpolar(viewport(1),viewport(2),viewport(3),
     +        viewport(4),hem)
c
c Top label:
            if (wtime(ip).gt.0.) then
              write(toplab,"(a8,' (% DIFFERENCE) ZP=',f5.1,' UT=',
     +          f5.2,' PERIMLAT=',f5.1)")
     +          timelab_short(ip),spls(izp),utc,perimlat(ih)
            else
              write(toplab,"(a8,' (RAW DIFFERENCE) ZP=',f5.1,' UT=',
     +          f5.2,' PERIM=',f5.1,1x)")
     +          timelab_short(ip),spls(izp),utc,perimlat(ih)
            endif
            call wrlab(toplab(1:lenstr(toplab)),xmid,
     +        viewport(4)+0.05,0.)
c
c History vols label:
            write(lab,"(2x,'Difference of TIGCM histories ',a8,
     +        ' minus ',a8,1x)") cpertvol,ccntrvol
            call wrlab(lab(1:lenstr(lab)),xmid,viewport(3)-.08,.012)
            call frame
            iframe = iframe+1
            write(6,"('pltpol diffs: frame ',i4,' field ',a8,
     +        ' zp=',f5.1,' perimlat=',f6.2)") 
     +        iframe,timelab_short(ip),spls(izp),perimlat(ih)
c
c End selected pressure loop: izp=1,npls
 100      continue
c
c End field loop: ip=1,ntimefld
 200    continue
c
c End hemisphere loop
      enddo
c
      return
      end