c c------------------------------------------------------------------ c subroutine pltlon(utc,fields) c c Contour longitude slices (or zonal means): c (lat on x-axis, zp on y-axis if ihtsc <=0, c linear height scale if ihtsc > 0) c include 'tigcmproc.h' character*56 toplab,fieldlab character*80 rec80 dimension viewport(4),yaxht(kmx),rimx(imx),plt(jmx,kmx), + plt0(jmx,kmx),fields(imx,kmx,jmx,nfget),hts(jmx,kmx) pointer(ppltht,pltht(1)) data viewport /.15,.89,.26,.91/ c if (nlon+nslt.le.0) then write(6,"('pltlon: no selected longitudes or local ', + 'times -- returning')") return endif xmid = 0.5*(viewport(1)+viewport(2)) call cpseti('SET',0) call cpseti('MAP',0) call cpsetr('XC1',gcmlat(1)) call cpsetr('XCM',gcmlat(jmx)) call cpsetr('ILX',xmid) call cpsetr('ILY',-.16) call cpseti('ILP',0) call cpsetr('ILS',.016) c c Field loop: c Note getlon() handles zonal mean or selected longitude, and c log10 or no log10 of field. 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 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 150 iht = ib,ie ihtsc = iht-1 if (ihtsc.le.0) then call cpsetr('YC1',gcmzp(izprange(1))) call cpsetr('YCN',gcmzp(izprange(2))) call set(viewport(1),viewport(2),viewport(3),viewport(4), + -90.,90.,gcmzp(izprange(1)),gcmzp(izprange(2)),1) else call cpsetr('YC1',htscale(1)) call cpsetr('YCN',htscale(nhtscale)) call set(viewport(1),viewport(2),viewport(3),viewport(4), + -90.,90.,htscale(1),htscale(nhtscale),1) call alloc(ppltht,jmx*nhtscale) endif c c Selected longitude/local time loop: c do 200 i=1,nlon+nslt c c Longitude or zonal means: if (i.le.nlon) then if (slon(i).ne.zmflag) then ixlon = ixfind(gcmlon,imx,slon(i),dlon) if (ixlon.le.0) then write(6,"('>>> pltlon: bad longitude=',f10.3,' i=',i3, + ' skipping this lon')") slon(i),i goto 100 endif rlon = gcmlon(ixlon) else ixlon = ifix(zmflag) rlon = slon(i) endif c c Solar local time: else islt = i-nlon ixlon = ixslt(sslt(islt),utc,rlon,gcmlon,imx,dlon) endif c c Get field and interpolate to height scale if necessary: c if (ihtsc.le.0) then call getlon(fields,plt0,ixlon,ilog(ip),ip) do k=izprange(1),izprange(2) kk = k-izprange(1)+1 plt(:,kk) = plt0(:,k) enddo ny = izprange(2)-izprange(1)+1 else call getlon(fields,plt0,ixlon,0,ip) call getlon(fields,hts,ixlon,0,ixz) call cuthtint(plt0,hts,jmx,kmx,pltht,htscale,nhtscale, + ilog(ip),cpspval,ier,1) if (ilog(ip).gt.0) call log10f(pltht,jmx*nhtscale,1.e-20, + cpspval) ny = nhtscale endif c c Contour: c if (icolor.le.0) then if (ihtsc.le.0) then call contour(plt,jmx,jmx,ny,cint(ip),cmin(ip),cmax(ip)) else call contour(pltht,jmx,jmx,ny,cint(ip),cmin(ip), + cmax(ip)) endif else if (ihtsc.le.0) then call conclr(plt,jmx,jmx,ny,cint(ip),cmin(ip),cmax(ip)) else call conclr(pltht,jmx,jmx,ny,cint(ip),cmin(ip),cmax(ip)) endif endif c c Add axes labels: c if (ihtsc.le.0) then call labrect(gcmlat,jmx,gcmzp(izprange(1)),ny,'LATITUDE', + 'ZP',0.) else call labrect(gcmlat,jmx,htscale(1),ny,'LATITUDE', + 'HEIGHT (KM)',0.) endif c c Field label at top: c call clearstr(toplab) if (ilog(ip).gt.0) then write(toplab,"('LOG10 ',a)") flab(ip)(1:lenstr(flab(ip))) else toplab = flab(ip) endif call wrlab(toplab(1:lenstr(toplab)),xmid, + viewport(4)+.07,0.) fieldlab = toplab c c lon, ut at top below field label: c call clearstr(toplab) if (i.le.nlon) then if (slon(i).ne.zmflag) then write(toplab,"('LON=',f8.2,' UT=',f6.2)") rlon,utc else write(toplab,"('ZONAL MEANS UT=',f6.2)") utc endif else write(toplab,"('SLT=',f5.1,' UT=',f6.2)") sslt(islt),utc endif call wrlab(toplab(1:lenstr(toplab)),xmid,viewport(4)+0.03, + 0.) call clearstr(rec80) write(rec80,"(a)") toplab(1:lenstr(toplab)) c c History volume label at bottom: c call clearstr(toplab) write(toplab,"('HISTORY=',a)") histvol(ivol) call wrlab(toplab(1:lenstr(toplab)),xmid,viewport(3)-0.15, + .012) c c Put height axis on right if pressure on y-axis c (use latitudinally averaged heights): c if (ixfld(ixz).le.0.or.ihtsc.gt.0) goto 300 yaxht(:) = 0. do k=izprange(1),izprange(2) izp = k-izprange(1)+1 if (slon(i).ne.zmflag) then do j=1,jmx yaxht(izp) = yaxht(izp) + fields(ixlon,k,j,ixfld(ixz)) enddo else ! zonal means -- use global mean hts do j=1,jmx rimx(:) = fields(:,k,j,ixfld(ixz)) yaxht(izp) = yaxht(izp) + + calcmean(rimx,imx,0,1.e-20,cpspval) enddo endif yaxht(izp) = yaxht(izp) / float(jmx) enddo rnd = 10. if (gcmzp(izprange(2))-gcmzp(izprange(1)).le.5.) rnd = 5. call altyax(ny,yaxht,gcmzp(izprange(1)),rnd,6) c c Wrap it up: 300 continue call frame iframe = iframe+1 c c Pressure on y-axis: if (ihtsc.le.0) then if (iwrascii.gt.0) then call wrascii(iwrascii,luascii,plt,jmx,ny,gcmlat, + gcmzp(izprange(1)),'LATITUDE','LN(P0/P)', + histvol(ivol),fieldlab,iframe,rec80,'tigcmproc', + dirascii) endif if (i.le.nlon) then if (slon(i).ne.zmflag) then write(6,"('pltlon: frame ',i4,' field ',a8,' lon=', + f8.2,' zprange=',2f8.2)") iframe,labshort(ip), + rlon,zprange else write(6,"('pltlon: frame ',i4,' field ',a8, + ' (zonal means) zprange=',2f8.2)") + iframe,labshort(ip),zprange endif else write(6,"('pltlon: frame ',i4,' field ',a8,' slt=',f8.2, + ' zprange=',2f8.2)") iframe,labshort(ip),sslt(islt), + zprange endif else c c Height on y-axis: if (iwrascii.gt.0) then call wrascii(iwrascii,luascii,pltht,jmx,ny,gcmlat, + htscale,'LATITUDE','HEIGHT (KM)',histvol(ivol), + fieldlab,iframe,rec80,'tigcmproc',dirascii) endif if (i.le.nlon) then if (slon(i).ne.zmflag) then write(6,"('pltlon: frame ',i4,' field ',a8,' lon=', + f8.2,' ht scale=',f7.2,' to ',f7.2)") iframe, + labshort(ip),rlon,htscale(1),htscale(nhtscale) else write(6,"('pltlon: frame ',i4,' field ',a8, + ' (zonal means) ht scale=',f7.2,' to ',f7.2)") + iframe,labshort(ip),htscale(1),htscale(nhtscale) endif else write(6,"('pltlon: frame ',i4,' field ',a8,' slt=',f8.2, + ' ht scale=',f7.2,' to ',f7.2)") iframe, + labshort(ip),sslt(islt),htscale(1),htscale(nhtscale) endif endif c c End selected longitude loop 200 continue c c Height/pressure: if (ihtsc.gt.0) call hpdeallc(ppltht,ier,1) 150 continue c c End field loop: ip=1,ntimefld 100 continue c return end