c c------------------------------------------------------------------ c Begin file /home/sting/foster/timegcm/pltglb.f c------------------------------------------------------------------ c subroutine pltglb(fields,mtime) c include 'timesproc.h' character*56 toplab,fieldlab character*80 rec80 dimension plt(imx,jmx),viewport(4),mtime(3) dimension fields(imx,kmx,jmx,nfget),lonsim(5),latsim(5) data viewport /.14,.92,.32,.82/, dum/0./, dgrid/15./ data lonsim/-180,-90,0,90,180/, latsim/-90,-45,0,45,90/ c utc = float(mtime(2)) isltxax = 0 if (labels.gt.1) isltxax = 1 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('YC1',gcmlat(1)) call cpsetr('YCN',gcmlat(jmx)) call cpsetr('ILX',xmid) rily = -.48 vlaboff = -.8 if (isltxax.le.0) then rily = -.25 vlaboff = -.46 endif call cpsetr('ILY',rily) call cpsetr('ILS',.015) call cpseti('ILP',0) call mapstr('GR',dgrid) call mkproj('CE',viewport,0.,0.,0.,dum,dum) if (labels.le.1) then call cpsetr('ILY',-.3) call cpsetr('ILS',.02) endif c c Field loop: do 200 ip=1,nftot if (ifplt(ip).le.0) goto 200 c c Selected pressure/height loop: do 100 izp = 1,npls+nhts ixpl = 0 ht = 0. if (izp.le.npls) then ixpl = ixfind(gcmzp,kmx,spls(izp),dzp) if (ixpl.le.0) then write(6,"('>>> pltglb: bad selected pressure=',f10.3, + ' izp=',i3)") spls(izp),izp goto 100 endif else ht = shts(izp-npls) endif c call getglb(fields,plt,ixpl,ht,ip) call fminmax(plt,imx*jmx,rmin,rmax,cpspval) if (labels.gt.1) then if (icolor.le.0) then call contour(plt,imx,imx,jmx,cint(ip),cmin(ip),cmax(ip)) else call conclr(plt,imx,imx,jmx,cint(ip),cmin(ip),cmax(ip)) call sflush call gsplci(0) call gspmci(0) endif else c c 1634B = 1110011100 10-bit pattern to be used for neg values c call cpcnrc(plt,imx,imx,jmx,0.,0.,finc,1,-1,-1634B) endif if (icont.gt.0) call maplot if (icolor.gt.0) then call sflush call gsplci(1) call gspmci(1) endif c c Add vectors if plotting tn (black if color): if ((ip.eq.itxt.and.ituv.gt.0).or.(ip.eq.itxz.and.izuv.gt.0)) + then call getglb(fields,udat,ixpl,ht,itxu) call getglb(fields,vdat,ixpl,ht,itxv) m = 1 ispvec = 0 spvec = 1.e36 iskip = 0 ixcolor = 1 if (icolor.gt.0) then call sflush call gsplci(0) call gspmci(0) ixcolor = 0 endif incx = 3 incy = 3 vlc = 0. vhc = uvmax call pltvect(udat,vdat,imx,jmx,gcmlon(1),gcmlon(imx), + gcmlat(1),gcmlat(jmx),incx,incy,vlaboff,vlc,vhc,cpspval) if (icolor.gt.0) then call sflush call gsplci(1) call gspmci(1) endif endif c c Plot ui+vi vectors if contouring potential (black if color): c if (ip.eq.itxpot.and.ipuv.gt.0) then call getglb(fields,udat,ixpl,ht,itxui) call getglb(fields,vdat,ixpl,ht,itxvi) m = 1 ispvec = 0 spvec = 1.e36 iskip = 0 ixcolor = 1 if (icolor.gt.0) then call sflush call gsplci(0) call gspmci(0) ixcolor = 0 endif call getset(vl,vr,vb,vt,wl,wr,wb,wt,l) call pltvec(udat,vdat,uvmax,imx,jmx,jmx,iskip,gcmlat(1), + gcmlat(jmx),m,ispvec,spvec,ixcolor) call set(vl,vr,vb,vt,wl,wr,wb,wt,l) endif c c Add local time axis: if (isltxax.gt.0) call sltxax(utc) c c Add labels: if (labels.gt.1) then call labrect(gcmlon,imx,gcmlat,jmx,'LONGITUDE','LATITUDE', + .04) else call labaxes(5,lonsim,1,'LON',5,latsim,1,'LAT',0.) endif call clearstr(toplab) if (izp.le.npls) then if (log10map.gt.0.and.itimelog(ip).gt.0) then write(toplab,"('LOG10 ',a8,' ZP=',f5.1,' DD:HH:MM=', + i3,':',i2,':',i2)") + flab(ip),spls(izp),mtime else write(toplab,"(a8,' ZP=',f5.1,' DD:HH:MM=',i3,':',i2,':', + i2)") flab(ip),spls(izp),mtime endif else if (log10map.gt.0.and.itimelog(ip).gt.0) then write(toplab,"('LOG10 ',a8,' HT=',f5.1,' DD:HH:MM=', + i3,':',i2,':',i2)") flab(ip),ht,mtime else write(toplab,"(a8,' HT=',f5.1,' DD:HH:MM=',i3,':',i2,':', + i2)") flab(ip),ht,mtime endif endif if (labels.gt.1) then call wrlab(toplab(1:lenstr(toplab)),xmid,viewport(4)+.01, + 0.) else call wrlablq(toplab(1:lenstr(toplab)),xmid, + viewport(4)+.013,.02) endif call clearstr(fieldlab) write(fieldlab,"(a)") flab(ip)(1:lenstr(flab(ip))) call clearstr(rec80) write(rec80,"(a)") toplab(1:lenstr(toplab)) c c History volume label: c if (labels.gt.1) then call clearstr(toplab) write(toplab,"('HISTORY=',a)") histvol(ivol) call wrlab(toplab(1:lenstr(toplab)),xmid,viewport(3)-0.19, + .012) endif call frame iframe = iframe+1 if (izp.le.npls) then write(6,"('pltglb: frame ',i4,' field ',a8,' zp=',f5.1, + ' min,max=',2e12.4)") iframe,flab(ip), + spls(izp),rmin,rmax else write(6,"('pltglb: frame ',i4,' field ',a8,' ht=',f5.1, + ' min,max=',2e12.4)") iframe,flab(ip),ht, + rmin,rmax endif c c Write ascii data file if desired: c if (iwrascii.gt.0) then call wrascii(iwrascii,luascii,plt,imx,jmx,gcmlon,gcmlat, + 'LONGITUDE','LATITUDE',histvol(ivol),fieldlab, + iframe,rec80,'timesproc',dirascii) endif c c End selected pressure/height loop: izp=1,npls+nhts 100 continue c c End field loop: ip=1,nftot 200 continue return end