c c------------------------------------------------------------------ c Begin file /home/sting/foster/tigcmdif/pltloc.f c------------------------------------------------------------------ c subroutine pltloc(utc,ihtsc,pert,cntr) c c Make line plots at selected locations, for current ut, with zp or ht c on y-axis, field on x-axis: c include 'tigcmdif.h' dimension pltcol(kmx),pltcol0(kmx),htcol(kmx),htcol0(kmx), + hts(kmx),vp(4) dimension pert(imx,kmx,jmx,nfget), cntr(imx,kmx,jmx,nfget) character*24 flnm0,flnm1 pointer(pplt,plt(1)), (pplt0,plt0(1)) character*56 toplab,toplab0 character*80 rec80,histlab c data vp /.12, .87, .1, .92/ c data vp /.12, .87, .05, .87/ data vp /.12, .87, .08, .86/ c if (ihtsc.le.0) then call hpalloc(pplt,kmx,ier,1) call hpalloc(pplt0,kmx,ier,1) else call hpalloc(pplt,nhtscale,ier,1) call hpalloc(pplt0,nhtscale,ier,1) endif c c Location loop: c call aggetf('FR.',frsave) do 100 l=1,nloc iglbm = 0 if (gloc(1,l).eq.gmflag.and.gloc(2,l).eq.gmflag) iglbm = 1 call clearstr(toplab0) if (iglbm.le.0) then write(toplab0,"('UT =',f5.1,' LAT,LON =',f5.1,',',f6.1)") + utc,gloc(1,l),gloc(2,l) if (locname(1).ne.'xxxxxxxxxxxxxxxx') then lentop = lenstr(toplab0) lenlab = lenstr(locname(l)) write(toplab0(lentop+1:lentop+lenlab+3),"(' (',a,')')") + locname(l)(1:lenlab) endif else write(toplab0,"('UT =',f5.1,' GLOBAL MEANS')") utc endif call clearstr(rec80) write(rec80,"(a)") toplab0(1:lenstr(toplab0)) c c Get heights for altyax (use average of pert and cntr): c if (ihtsc.le.0) then if (iglbm.le.0) then call getloc(pert,htcol,gloc(1,l),gloc(2,l),0,ixz,1) call getloc(cntr,htcol0,gloc(1,l),gloc(2,l),0,ixz,0) else call getloc(pert,htcol,gmflag,gmflag,0,ixz,1) call getloc(cntr,htcol0,gmflag,gmflag,0,ixz,0) endif do k=izprange(1),izprange(2) hts(k-izprange(1)+1) = .5*(htcol(k)+htcol0(k)) enddo endif c c Field loop: c getloc will return global means if ilat=ilon=0 c write(6,"(' ')") do 200 ip=1,nftot if (ifplt(ip).le.0) goto 200 if (ip.eq.ixfof2.or.ip.eq.ixhmf2) goto 200 if (ip.eq.ixuivi.or.ip.eq.ixunvn) goto 200 ipercent = 0 if (idif.eq.1.and.iperc(ip).eq.1) ipercent = 1 c c At selected location (get hts if ht on y-axis): if (iglbm.le.0) then call getloc(pert,pltcol,gloc(1,l),gloc(2,l),0,ip,1) call getloc(cntr,pltcol0,gloc(1,l),gloc(2,l),0,ip,0) if (ihtsc.gt.0) then call getloc(pert,htcol,gloc(1,l),gloc(2,l),0,ixz,1) call getloc(cntr,htcol0,gloc(1,l),gloc(2,l),0,ixz,0) endif c c At global means (get hts if ht on y-axis): else call getloc(pert,pltcol,gmflag,gmflag,0,ip,1) call getloc(cntr,pltcol0,gmflag,gmflag,0,ip,0) if (ihtsc.gt.0) then call getloc(pert,htcol,gmflag,gmflag,0,ixz,1) call getloc(cntr,htcol0,gmflag,gmflag,0,ixz,0) endif endif c c Height scale on y-axis (interpolate and make diffs): if (ihtsc.gt.0) then call intloc(pltcol,htcol,kmx,htscale,nhtscale,ilog(ip), + plt,1,1,nhtscale,ier,cpspval,0) call intloc(pltcol0,htcol0,kmx,htscale,nhtscale,ilog(ip), + plt0,1,1,nhtscale,ier,cpspval,0) call mkdifs(plt,plt0,nhtscale,ipercent,cpspval) ny = nhtscale c c Pressure scale on y-axis (make diffs and get zp range): else call mkdifs(pltcol,pltcol0,kmx,ipercent,cpspval) do k=izprange(1),izprange(2) plt(k-izprange(1)+1) = pltcol(k) enddo ny = izprange(2)-izprange(1)+1 endif c c linetyp = 1 -> x-linear, y-linear c linetyp = 3 -> x-log, y-linear c (hardwire no log scale for differences) c linetyp = 1 c c LSET=2 (4th arg to anotat) means AG will use only 1st 4 (and 9th) c args of last set call (i.e., the fractional coords, and lin/log) c call set(vp(1),vp(2),vp(3),vp(4), .1,.9,.1,.9, linetyp) call displa(2,1,linetyp) if (ihtsc.le.0) then call anotat(labshort(ip),'ZP',0,2,-1,L) call ezxy(plt,gcmzp(izprange(1)),ny,' ') else call anotat(labshort(ip),'HEIGHT (KM)',0,2,-1,L) call ezxy(plt,htscale,ny,' ') endif call fminmax(plt,ny,rmin,rmax,cpspval) if (rmin.lt.0..and.rmax.gt.0.) then if (ihtsc.le.0) call line(0.,gcmzp(izprange(1)), + 0.,gcmzp(izprange(2))) if (ihtsc.gt.0) call line(0.,htscale(1), + 0.,htscale(nhtscale)) endif c c Add right hand y-axis with height if zp is on y-axis: c if (ihtsc.le.0) then rnd = 10. if (gcmzp(izprange(2))-gcmzp(izprange(1)).le.5.) rnd = 5. call altyax(ny,hts,gcmzp(izprange(1)),rnd,6) endif xmid = 0.5*(vp(1)+vp(2)) c c Location label: c call wrlab(toplab0(1:lenstr(toplab0)),xmid,vp(4)+.03,.012) c c Difference label: c call clearstr(toplab) if (ipercent.gt.0) then write(toplab,"('PERCENT DIFFERENCE FIELD')") else write(toplab,"('RAW DIFFERENCE FIELD')") endif call wrlab(toplab(1:lenstr(toplab)),xmid,vp(4)+.07,.012) c call clearstr(histlab) call tail(pertvol(ipvol),flnm0) call tail(cntrvol(icvol),flnm1) write(histlab,"('DIFFS FROM ',a,' MINUS ',a)") + flnm0(1:lenstr(flnm0)),flnm1(1:lenstr(flnm1)) c c Field label at top: c call wrlab(flab(ip)(1:lenstr(flab(ip))),xmid,vp(4)+.11,.012) c c Wrap it up: c call frame iframe = iframe+1 if (ihtsc.le.0) then if (iwrascii.gt.0) then call wrascii(iwrascii,luascii,plt,1,ny,dum, + gcmzp(izprange(1)),' ','LN(P0/P)', + histlab,flab(ip),iframe,rec80,'tigcmdif', + dirascii) endif if (iglbm.le.0) then write(6,"('pltloc: frame ',i4,' lat,lon=', + f6.2,f7.2,' field ',a,' zprange = ',2f5.1)") + iframe,gloc(1,l),gloc(2,l),labshort(ip),zprange else write(6,"('pltloc: frame ',i4,' (global means)', + ' field ',a,' zprange = ',2f5.1)") + iframe,labshort(ip),zprange endif else if (iwrascii.gt.0) then call wrascii(iwrascii,luascii,plt,1,ny,dum, + htscale,' ','HEIGHT (KM)',histlab,flab(ip), + iframe,rec80,'tigcmdif',dirascii) endif if (iglbm.le.0) then write(6,"('pltloc: frame ',i4,' lat,lon=', + f6.2,f7.2,' field ',a,' htscale= ',f5.1,' to ',f5.1)") + iframe,gloc(1,l),gloc(2,l),labshort(ip),htscale(1), + htscale(nhtscale) else write(6,"('pltloc: frame ',i4,' (global means)', + ' field ',a,' htscale= ',f6.2,' to ',f6.2)") + iframe,labshort(ip),htscale(1),htscale(nhtscale) endif endif c c End fields loop: 200 continue c c End location loop 100 continue c call agsetf('FR.',frsave) call agsetf('SET.',1.) call hpdeallc(pplt,ier,1) call hpdeallc(pplt0,ier,1) return end