c c------------------------------------------------------------------ c Begin file /home/sting/foster/timesproc/pltsatv.f c------------------------------------------------------------------ c subroutine pltsatv(fields,utc) c c Contour on sat view projections at selected zp and/or hts: c include 'timesproc.h' character*56 toplab,fieldlab character*80 rec80 dimension plt(imx,jmx),viewport(4) dimension fields(imx,kmx,jmx,nfget) data viewport /.15,.85,.15,.85/, dum/0./, eradii/6.631/, + dgrid/30./ 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('YC1',gcmlat(1)) call cpsetr('YCN',gcmlat(jmx)) call cpsetr('ILX',xmid) call cpsetr('ILY',-.08) call cpsetr('ILS',.018) call cpseti('ILP',0) call mapstr('GR',dgrid) if (labels.le.1) call cpsetr('ILS',.025) c c Field loop: c do 100 ip=1,nftot if (ifplt(ip).le.0) goto 100 c c Projection loop (projection orientations): c do 200 iproj=1,nsatv plat = censatv(1,iproj) plon = censatv(2,iproj) if (plon.eq.r12flag) + ixlon = ixslt(12.,utc,plon,gcmlon,imx,dlon) call mkproj('SV',viewport,plat,plon,0.,dum,eradii) c c Selected pressure/height loop: do 300 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,"('>>> pltsatv: bad selected pressure=',f10.3, + ' izp=',i3)") spls(izp),izp goto 300 endif else ht = shts(izp-npls) endif c c Get snapshot data and contour: c Note getglb handles selected pressure vs selected constant height c and does interpolation in case of the latter. c call getglb(fields,plt,ixpl,ht,ip) 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 call cpcnrc(plt,imx,imx,jmx,0.,0.,finc,1,-1,-1634B) endif c c Add continental outlines and grid lines (black if color): if (icont.gt.0) call maplot call mapgrd call maplbl 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) c uvmax = 0. 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) if (icolor.gt.0) then call sflush call gsplci(1) call gspmci(1) endif endif c c Add drift vectors if plotting epot (black if color): if (ip.eq.itxpot.and.ipuv.gt.0) then call getglb(fields,udat,ixpl,ht,itxui) call getglb(fields,vdat,ixpl,ht,itxvi) c uvmax = 0. 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) if (icolor.gt.0) then call sflush call gsplci(1) call gspmci(1) endif endif c c Top labels: c 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,' UT = ',f6.2)") + flab(ip),spls(izp),utc else write(toplab,"(a8,' ZP=',f5.1,' UT = ',f6.2)") + flab(ip),spls(izp),utc endif else if (log10map.gt.0.and.itimelog(ip).gt.0) then write(toplab,"('LOG10 ',a8,' HT=',f5.1,' UT = ',f6.2)") + flab(ip),ht,utc else write(toplab,"(a8,' HT=',f5.1,' UT = ',f6.2)") + flab(ip),ht,utc endif endif if (iwrascii.gt.0) then call clearstr(rec80) write(rec80,"(a)") toplab(1:lenstr(toplab)) call clearstr(fieldlab) write(fieldlab,"(a)") flab(ip) endif if (labels.gt.1) then call wrlab(toplab(1:lenstr(toplab)),xmid,viewport(4)+0.06, + 0.) call clearstr(toplab) write(toplab,"('HISTORY=',a)") histvol(ivol) call wrlab(toplab(1:lenstr(toplab)),xmid,viewport(3)-0.10, + .012) else call wrlablq(toplab(1:lenstr(toplab)),xmid, + viewport(4)+0.06,.02) endif call frame iframe = iframe+1 c c Write ascii data file if desired: if (iwrascii.gt.0) then call wrascii(iwrascii,luascii,plt,imx,jmx,gcmlon,gcmlat, + 'LONGITUDE','LATITUDE',histvol(ivol),fieldlab, + iframe,rec80,'timesproc',dirascii) endif if (izp.le.npls) then write(6,"('pltsatv: frame ',i4,' field ',a8,' zp=',f5.1, + ' censatv=',2f9.2)") iframe,flab(ip),spls(izp), + plat,plon else write(6,"('pltsatv: frame ',i4,' field ',a8,' ht=',f5.1, + ' censatv=',2f9.2)") iframe,flab(ip),ht,plat, + plon endif c c End selected pressure/height loop: izp=1,npls+nhts 300 continue c c End projection loop: iproj=1,nsatv 200 continue c c End field loop: ip=1,nftot 100 continue c return end