c c------------------------------------------------------------------ c Begin file /home/sting/foster/tigcm/pltlatzp.f c------------------------------------------------------------------ c subroutine pltlatzp(utc) c c Contour tgcm longitude slices (including dynamo fields): c (latitude on x-axis, zp on y-axis) c include 'tgcmparam.h' include 'input.h' include 'tigcm.h' include 'tgcmhdr.h' include 'tigcmfld.h' include 'tiegcmfld.h' include 'selgrid.h' include 'tgcmlab.h' include 'cool.h' include 'plt.h' include 'color.h' dimension plotp(jmx,kmx),tncol(kmx),htcol(kmx) character*56 toplab,lab,lab1 c c Declarations for axes labeling: c parameter (nx=7,ny=8) dimension numx(nx),numy(ny) data numx/-90,-60,-30,0,30,60,90/ c data numy/-7,-5,-3,-1,1,3,5/ data numy/-7,-5,-3,-1,1,3,5,7/ character*8 fmtx,fmty character*16 labx,laby data fmtx/'(i3) '/, fmty/'(i2) '/ data nfmtx/3/, nfmty/2/, mnrx/3/, mnry/2/ data laby/' ZP (LN P/P0) '/ data labx/' LATITUDE (DEG) '/ data xc/-87.5/,xd/87.5/ c c Set up conpack: c call cpseti('SET',0) call cpseti('MAP - mapping flag',0) slmapl = 0.10 slmapr = 0.88 slmapb = 0.26 slmapt = 0.91 rilx = 0.5*(slmapl+slmapr) rily = -.30 call cpsetr('ILX - info label x-coord',rilx) call cpsetr('ILY - info label y-coord',rily) call set(slmapl,slmapr,slmapb,slmapt, + -90.,90.,gcmzp(1),gcmzp(kmx),1) yc = gcmzp(1) yd = gcmzp(kmx) c c Take year-day from header: c This is not reliable -- removed c iyrday = (date(1)-1900.)*1000.+date(2) c c Field loop: c write(6,"(' ')") write(6,"('Longitude slices (lat on x-axis, zp on y-axis):')") do 100 ip=1,ntigcmf+ntiegcmf ipp = ip-ntigcmf if (ip.le.ntigcmf.and.iptigcm(ip).le.0) goto 100 if (ip.gt.ntigcmf.and.(idyn.le.0.or.iptiegcm(ipp).le.0)) + goto 100 c c Height independent fields are skipped: if (ip.eq.ixfof2.or.ip.eq.ixhmf2) then write(6,"(' pltlatzp: skipping ',a8,' because ', + 'this field is height independent')") labtigcm_short(ip) goto 100 endif c c Selected longitude loop: c do 105 i=1,nlon+nslt c c Find index to selected longitude, or local time: if (i.le.nlon) then if (slon(i).eq.r12flag) then ilon = ixslt(12.,utc,slon(i)) else ilon = islon(i) endif else ilon = ixslt(sslt(i-nlon),utc,dum) endif c c Set up top label: if (ndays.eq.1) then if (i.le.nlon) then if (ilon.ne.izmflag) then write(toplab,"('UT = ',f5.2,' LON = ',f7.2, + ' DAY = ',i5,20x)") utc,slon(i),iyd(1) else write(toplab,"('UT = ',f5.2,' ZONAL MEAN', + ' DAY = ',i5,23x)") utc,iyd(1) endif else write(toplab,"('UT = ',f5.2,' SLT = ',f7.2, + ' DAY = ',i5,20x)") utc,sslt(i-nlon),iyd(1) endif else if (i.le.nlon) then if (ilon.ne.izmflag) then write(toplab,"('UT = ',f5.2,' LON = ',f7.2,32x)") + utc,slon(i) else write(toplab,"('UT = ',f5.2,' ZONAL MEAN',35x)") utc endif else write(toplab,"('UT = ',f5.2,' SLT = ',f7.2,32x)") + utc,sslt(i-nlon) endif endif c c Define plot array: if (ilon.eq.izmflag) plotp(:,:) = 0. if (ip.le.ntigcmf) then if (ip.le.ngcmflds) then if (ilon.eq.izmflag) then do k=1,kmx do j=1,jmx do ii=1,imx-1 plotp(j,k) = plotp(j,k)+pnt(ii,k,j,ip) enddo plotp(j,k) = plotp(j,k) / (imx-1) enddo enddo else do 110 k=1,kmx do 110 j=1,jmx 110 plotp(j,k) = pnt(ilon,k,j,ip) endif elseif (ip.eq.ixrho) then if (ilon.eq.izmflag) then do k=1,kmx do j=1,jmx do ii=1,imx-1 plotp(j,k) = plotp(j,k)+td(ii,k,j) enddo plotp(j,k) = plotp(j,k) / (imx-1) enddo enddo else do 115 k=1,kmx do 115 j=1,jmx plotp(j,k) = td(ilon,k,j) 115 continue endif elseif (ip.eq.ixrat) then if (ilon.eq.izmflag) then do k=1,kmx do j=1,jmx do ii=1,imx-1 plotp(j,k) = plotp(j,k) + (pnt(ii,k,j,ixo1) / + (pnt(ii,k,j,ixo2) + pnt(ii,k,j,ixn2))) enddo plotp(j,k) = plotp(j,k) / (imx-1) enddo enddo else do 120 k=1,kmx do 120 j=1,jmx plotp(j,k) = pnt(ilon,k,j,ixo1) / + (pnt(ilon,k,j,ixo2) + pnt(ilon,k,j,ixn2)) 120 continue endif endif else c c Dynamo fields: if (ilon.eq.izmflag) then do k=1,kmx do j=1,jmx plotp(j,k) = dynpnt(ilon,k,j,ipp) enddo enddo else do k=1,kmx do j=1,jmx do ii=1,imx-1 plotp(j,k) = plotp(j,k) + dynpnt(ii,k,j,ipp) enddo plotp(j,k) = plotp(j,k) / (imx-1) enddo enddo endif endif c c Always take logs of appropriate fields, since ht on y-axis: c if ((ip.le.ntigcmf.and.igcmlog(ip).gt.0).or. + (ip.gt.ntigcmf.and.idynlog(ipp).gt.0)) then do 125 k=1,kmx do 125 j=1,jmx if (plotp(j,k).eq.cpspval.or.plotp(j,k).le.1.e-30) + then plotp(j,k) = cpspval else plotp(j,k) = alog10(plotp(j,k)) endif 125 continue if (ip.le.ntigcmf) + write(lab,"('LOG10 ',a50)") labtigcm(ip)(1:50) if (ip.gt.ntigcmf) + write(lab,"('LOG10 ',a50)") labtiegcm(ipp)(1:50) else if (ip.le.ntigcmf) lab = labtigcm(ip) if (ip.gt.ntigcmf) lab = labtiegcm(ipp) endif c c Contour it: if (ip.le.ntigcmf) then cint = conints(ip) cmin = conmins(ip) cmax = conmaxs(ip) ipfm = ip else cint = cintdyn(ipp) cmin = cmindyn(ipp) cmax = cmaxdyn(ipp) ipfm = ip+ntigcmf endif if (iclrfill.le.0) then call bwcon(plotp,jmx,jmx,kmx,xc,xd,yc,yd, + cint,cmin,cmax, + 1,nx,numx,mnrx,labx,fmtx,nfmtx, + ny,numy,mnry,laby,fmty,nfmty) else lbar = 2 call clrcon(plotp,jmx,jmx,kmx,xc,xd,yc,yd, + cint,cmin,cmax, + 1,nx,numx,mnrx,labx,fmtx,nfmtx, + ny,numy,mnry,laby,fmty,nfmty, + lbar,slmapl,slmapr,.09,.18,ipfm) endif c call box(1) c c Add extra right hand axis in height: c 3/13/91: izmflag=-999 in this code, but altyax uses +999 as c the zonal mean flag -- this needs to be globalized c so there is only one izmflag for all codes c if (ilon.ne.izmflag) then call altyax(ilon) else call altyax(abs(ilon)) endif c c Top labels: call top2lab(lab,0.10,toplab,0.05,.017) c c Bottom runlab label and history label: write(lab1,"(7x,'TGCM History = ',4a8,2x)") + (output(ii,1),ii=1,3),output(3,2) if (iclrfill.le.0) then call botlab(runlab(1:lnblnk2(runlab)), + 0.5*(slmapl+slmapr),0.15) call botlab(lab1,0.5,.11) else call botlab(runlab(1:lnblnk2(runlab)), + 0.5*(slmapl+slmapr),0.05) call botlab(lab1,0.5,.02) endif c c Finish up the frame: c call box(0) call frame iframe=iframe+1 if (i.le.nlon) then if (ilon.ne.izmflag) then write(6,"(' pltlatzp frame ',i3,': ',a,' ut=',f4.1, + ' lon=',f6.1)") iframe,lab(1:36),utc,slon(i) else write(6,"(' pltlatzp frame ',i3,': ',a,' ut=',f4.1, + ' Zonal Mean')") iframe,lab(1:36),utc endif else write(6,"(' pltlatzp frame ',i3,': ',a,' ut=',f4.1, + ' slt=',f6.1)") iframe,lab(1:36),utc,sslt(i-nlon) endif c c End selected lon loop: 105 continue c c End field loop: 100 continue c c Contour calculated cooling terms: c (there are ncoolt terms: c no heat, no cool, no heat-cool, co2 cool, o3p cool, irt) c if (iplcool.gt.0) then do 200 ip=1,ncoolt do 205 i=1,nlon+nslt c c Find index to selected longitude, or local time: if (i.le.nlon) then write(toplab,"('UT = ',f5.2,' LON = ',f7.2,32x)") + utc,slon(i) ilon = islon(i) else write(toplab,"('UT = ',f5.2,' SLT = ',f7.2,32x)") + utc,sslt(i-nlon) ilon = ixslt(sslt(i-nlon),utc,dum) endif ix = ilon do 215 j=1,jmx tncol(:) = pnt(ix,:,j,ixt) htcol(:) = pnt(ix,:,j,ixz) do 220 k=1,kmx tn = pnt(ix,k,j,ixt) xo2 = pnt(ix,k,j,ixo2) xo = pnt(ix,k,j,ixo1) xn4s = pnt(ix,k,j,ixn4s) xno = pnt(ix,k,j,ixno) xn2d = pnt(ix,k,j,ixn2d) xn2 = pnt(ix,k,j,ixn2) xne = pnt(ix,k,j,ixne) plotp(j,k) = cool(tn,xo2,xo,xn4s,xno,xn2d,xn2,xne,k, + tncol,htcol,ip) 220 continue 215 continue if (log10pl.gt.0.and.icoolog(ip).gt.0) then do 210 k=1,kmx do 210 j=1,jmx if (plotp(j,k).le.1.e-20) plotp(j,k) = cpspval if (plotp(j,k).gt.1.e-20) + plotp(j,k) = alog10(plotp(j,k)) 210 continue write(lab,"('LOG10 ',a50)") labcool(ip)(1:50) else lab = labcool(ip) endif call bwcon(plotp,jmx,jmx,kmx,xc,xd,yc,yd,0.,1.,0., + 1,nx,numx,mnrx,labx,fmtx,nfmtx, + ny,numy,mnry,laby,fmty,nfmty) call top2lab(lab,0.10,toplab,0.05,.017) write(lab1,"(12x,a,12x)") runlab call botlab(lab1,0.5,.15) call frame iframe=iframe+1 if (i.le.nlon) then write(6,"(' pltlatzp frame ',i3,': ',a,' ut=',f4.1, + ' lon=',f6.1)") iframe,lab(1:38),utc,slon(i) else write(6,"(' pltlatzp frame ',i3,': ',a,' ut=',f4.1, + ' slt=',f6.1)") iframe,lab(1:38),utc,sslt(i-nlon) endif c c End selected lon loop: 205 continue c c End cooling terms field loop: 200 continue c c End cooling terms conditional: endif c return end