c c------------------------------------------------------------------ c subroutine pltloc(utc,mt,fields) c c Make line plots at selected locations, zp or ht on y-axis, c field on x-axis: c include 'tigcmproc.h' dimension pltcol(kmx),htcol(kmx),hts(kmx), + fields(imx,kmx,jmx,nfget),vp(4),mt(3) pointer(pplt,plt(1)) character*56 toplab character*80 rec80 character*56 fieldlab data vp /.12, .87, .15, .87/, dum/0./ c call setag call aggetf('FR.',frsave) c c Field loop: c getloc will return global means if ilat=ilon=0 c write(6,"(' ')") do 100 ip=1,nftot if (ifplt(ip).le.0) goto 100 if (ip.eq.ixfof2.or.ip.eq.ixhmf2) goto 100 if (ip.eq.ixunvn.or.ip.eq.ixuivi) goto 100 c c Location loop: ((lat,lon), (lat, zonal means), or (global means)) c do 150 l=1,nloc ixlat = 0 ixlon = 0 iglbm = 0 if (gloc(1,l).eq.gmflag.and.gloc(2,l).eq.gmflag) iglbm = 1 izm = 0 if (gloc(1,l).ne.gmflag.and.gloc(2,l).eq.gmflag) izm = 1 call clearstr(toplab) if (iglbm.le.0) then ixlat = ixfind(gcmlat,jmx,gloc(1,l),dlat) if (ixlat.le.0) then write(6,"('>>> pltloc: bad lat=',f10.3,' l=',i3, + ' skipping this location')") gloc(1,l),l goto 150 endif rlat = gcmlat(ixlat) rlon = 0. if (gloc(2,l).ne.gmflag) then ixlon = ixfind(gcmlon,imx,gloc(2,l),dlon) if (ixlon.le.0) then write(6,"('>>> pltloc: bad lon=',f10.3,' l=',i3, + ' skipping this location')") gloc(2,l),l goto 150 endif rlon = gcmlon(ixlon) write(toplab,"('LAT,LON = ',f6.2,',',f7.2, + ' DAY:HR:MIN = ',i2,':',i2,':',i2)") rlat,rlon,mt else izm = 1 write(toplab,"('LAT = ',f6.2,', (ZONAL MEANS)', + ' DAY:HR:MIN = ',i2,':',i2,':',i2)") rlat,mt endif else write(toplab,"('GLOBAL MEANS')") endif call clearstr(rec80) write(rec80,"(a)") toplab(1:lenstr(toplab)) c c ihtsc = 1,2 for pressure,height on y-axis: c ib = 0 ie = 0 if (nzprange.le.0.and.nhtscale.gt.0) then ib = 2 ie = 2 elseif (nzprange.gt.0.and.nhtscale.gt.0) then ib = 1 ie = 2 elseif (nzprange.gt.0.and.nhtscale.le.0) then ib = 1 ie = 1 endif if (ib.eq.0.or.ie.eq.0) then write(6,"('>>> pltlon: nzprange=',i3,' nhtscale=',i3, + ' need vertical scale for lon plots -- returning')") + nzprange,nhtscale return endif do 200 iht = ib,ie ihtsc = iht-1 c c Get heights for altyax: c if (ihtsc.le.0) then call alloc(pplt,kmx) call getloc(fields,htcol,ixlat,ixlon,0,ixz) do k=izprange(1),izprange(2) hts(k-izprange(1)+1) = htcol(k) enddo else call alloc(pplt,nhtscale) endif call getloc(fields,pltcol,ixlat,ixlon,0,ip) if (ihtsc.gt.0) call getloc(fields,htcol,ixlat,ixlon,0, + ixz) if (ihtsc.le.0) then do k=izprange(1),izprange(2) plt(k-izprange(1)+1) = pltcol(k) enddo ny = izprange(2)-izprange(1)+1 else call intloc(pltcol,htcol,kmx,htscale,nhtscale,ilog(ip), + plt,1,1,nhtscale,ier,cpspval,0) ny = nhtscale endif call fminmax(plt,ny,rmin,rmax,cpspval) c c linetyp = 1 -> x-linear, y-linear c linetyp = 3 -> x-log, y-linear c linetyp = 1 if (ilog(ip).gt.0) linetyp = 3 c c Check for low values anyway (e.g., no.dens mix ratio of ox from c a source history can go to 0): c if (linetyp.eq.3) then do k=1,ny if (plt(k).le.1.e-20) linetyp = 1 enddo endif 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) lentop = lenstr(toplab) lenfield = lenstr(labshort(ip)) if (ihtsc.le.0) then call anotat(labshort(ip)(1:lenfield),'ZP',0,2,-1,L) call ezxy(plt,gcmzp(izprange(1)),ny,toplab(1:lentop)) else call anotat(labshort(ip)(1:lenfield),'HEIGHT (KM)',0,2,-1, + L) call ezxy(plt,htscale,ny,toplab(1:lentop)) endif if (rmin.lt.0..and.rmax.gt.0.) then call getset(vl,vr,vb,vt, wl,wr,wb,wt, lty) call line(0.,wb,0.,wt) endif c c Add right hand y-axis with height if zp is on y-axis: c subroutine altyax(kmx,height,zp,rndval,nval) 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 c c Field label at top: c call clearstr(fieldlab) if (ilog(ip).gt.0) then write(fieldlab,"('LOG10 ',a)") + flab(ip)(1:lenstr(flab(ip))) else fieldlab = flab(ip) endif xmid = 0.5*(vp(1)+vp(2)) call wrlab(fieldlab(1:lenstr(fieldlab)),xmid,vp(4)+.06,.012) c c Wrap it up (Write ascii data file if needed): 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)', + histvol(ivol),flab(ip),iframe,rec80,'tigcmproc', + dirascii) endif if (iglbm.gt.0) then write(6,"('pltloc: frame ',i4,' (global means)', + ' field ',a,' zprange = ',2f5.1)") + iframe,labshort(ip),zprange elseif (izm.gt.0) then write(6,"('pltloc: frame ',i4,' lat=', + f6.2,' (ZONAL MEANS) field ',a,' zprange = ',2f5.1)") + iframe,rlat,labshort(ip),zprange else write(6,"('pltloc: frame ',i4,' lat,lon=', + f6.2,f7.2,' field ',a,' zprange = ',2f5.1)") + iframe,rlat,rlon,labshort(ip),zprange endif else if (iwrascii.gt.0) then call wrascii(iwrascii,luascii,plt,1,ny,dum, + htscale,' ','HEIGHT (KM)',histvol(ivol),flab(ip), + iframe,rec80,'tigcmproc',dirascii) endif if (iglbm.gt.0) then write(6,"('pltloc: frame ',i4,' (global means)', + ' field ',a,' htscale= ',f6.2,' to ',f6.2)") + iframe,labshort(ip),htscale(1),htscale(nhtscale) elseif (izm.gt.0) then write(6,"('pltloc: frame ',i4,' lat=', + f6.2,' (ZONAL MEANS) field ',a,' htscale= ',f5.1, + ' to ',f5.1)") iframe,rlat,labshort(ip),htscale(1), + htscale(nhtscale) else write(6,"('pltloc: frame ',i4,' lat,lon=', + f6.2,f7.2,' field ',a,' htscale= ',f5.1,' to ',f5.1)") + iframe,rlat,rlon,labshort(ip),htscale(1), + htscale(nhtscale) endif endif c c Pressure/height on y-axis: call hpdeallc(pplt,ier,1) 200 continue c c End location loop 150 continue c c End fields loop: 100 continue c call agsetf('FR.',frsave) call agsetf('SET.',1.) return end