c c------------------------------------------------------------------ c Begin file /home/sting/foster/tigcm/pltlonzp.f c------------------------------------------------------------------ c subroutine pltlonzp(utc) c c Contour tgcm latitude slices (including dynamo fields): c (longitude 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(imx,kmx),tncol(kmx),htcol(kmx) character*56 toplab,lab,lab1 c c Declarations for axes labeling: c parameter (nx=7,ny=7) dimension numx(nx),numy(ny) data numx/-180,-120,-60,0,60,120,180/ data numy/-7,-5,-3,-1,1,3,5/ character*8 fmtx,fmty character*16 labx,laby data fmtx/'(i4) '/, fmty/'(i2) '/ data nfmtx/4/, nfmty/2/, mnrx/3/, mnry/2/ data laby/' ZP (LN P/P0) '/ data labx/' LONGITUDE (DEG)'/ data xc/-180./,xd/180./ 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, + -180.,180.,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,"('Latitude slices (lon on x-axis, zp on y-axis):')") do 100 ip=1,ntigcmf+ntiegcmf ipp = ip-ntigcmf if (ip.le.ntigcmf) then if (iptigcm(ip).le.0) goto 100 endif c c Only first 4 dynamo fields available (no heelis): if (ip.gt.ntigcmf) then if (idyn.le.0.or.iptiegcm(ipp).le.0.or.ipp.ge.5) goto 100 endif c c Height independent fields are skipped: if (ip.eq.ixfof2.or.ip.eq.ixhmf2) then write(6,"(' pltlonzp: skipping ',a8,' because ', + 'this field is height independent')") labtigcm_short(ip) goto 100 endif c c Selected latitude loop: c do 105 j=1,nlat c c Find index to selected latitude c ilat = ixlat(slat(j)) c c Set up top label: if (ndays.eq.1) then write(toplab,"('UT = ',f5.2,' LAT = ',f7.2, + ' DAY = ',i5,20x)") utc,slat(j),iyd(1) else write(toplab,"('UT = ',f5.2,' LAT = ',f7.2,32x)") + utc,slat(j) endif c c Define plot array: if (ip.le.ntigcmf) then if (ip.le.ngcmflds) then do 110 k=1,kmx do 110 i=1,imx 110 plotp(i,k) = pnt(i,k,ilat,ip) elseif (ip.eq.ixrho) then do 115 k=1,kmx do 115 i=1,imx plotp(i,k) = td(i,k,ilat) 115 continue elseif (ip.eq.ixrat) then do 120 k=1,kmx do 120 i=1,imx plotp(i,k) = pnt(i,k,ilat,ixo1) / + (pnt(i,k,ilat,ixo2) + pnt(i,k,ilat,ixn2)) 120 continue endif else c c Dynamo fields: do k=1,kmx do i=1,imx plotp(i,k) = dynpnt(i,k,ilat,ipp) enddo enddo endif c c Always take logs of appropriate fields, since ht on y-axis: c if (ip.le.ntigcmf) then if (igcmlog(ip).le.0) goto 126 else if (idynlog(ipp).le.0) goto 126 endif do 125 k=1,kmx do 125 i=1,imx if (plotp(i,k).eq.cpspval.or.plotp(i,k).le.1.e-30) then plotp(i,k) = cpspval else plotp(i,k) = alog10(plotp(i,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) 127 goto 128 126 continue if (ip.le.ntigcmf) lab = labtigcm(ip) if (ip.gt.ntigcmf) lab = labtiegcm(ipp) 128 continue 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,imx,imx,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,imx,imx,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 call altyax(999) c c Top labels: call top2lab(lab,0.10,toplab,0.05,.017) c c Bottom runlab label and history label: write(lab1,"(8x,'TIGCM History = ',3a8,8x)") + (histvol(ii,ivf),ii=1,3) 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 write(6,"(' pltlonzp frame ',i3,': ',a,' ut=',f4.1, + ' lat=',f6.1)") iframe,lab(1:36),utc,slat(j) c c End selected lat 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 j=1,nlat c c Find index to selected latitude: write(toplab,"('UT = ',f5.2,' LON = ',f7.2,32x)") + utc,slon(i) jlat = islat(j) jx = jlat do 215 i=1,imx tncol(:) = pnt(i,:,jx,ixt) htcol(:) = pnt(i,:,jx,ixz) do 220 k=1,kmx tn = pnt(i,k,jx,ixt) xo2 = pnt(i,k,jx,ixo2) xo = pnt(i,k,jx,ixo1) xn4s = pnt(i,k,jx,ixn4s) xno = pnt(i,k,jx,ixno) xn2d = pnt(i,k,jx,ixn2d) xn2 = pnt(i,k,jx,ixn2) xne = pnt(i,k,jx,ixne) plotp(i,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 i=1,imx if (plotp(i,k).le.1.e-20) plotp(i,k) = cpspval if (plotp(i,k).gt.1.e-20) + plotp(i,k) = alog10(plotp(i,k)) 210 continue write(lab,"('LOG10 ',a50)") labcool(ip)(1:50) else lab = labcool(ip) endif call bwcon(plotp,imx,imx,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 write(6,"(' pltlonzp frame ',i3,': ',a,' ut=',f4.1, + ' lat=',f6.1)") iframe,lab(1:38),utc,slat(j) c c End selected lat loop: 205 continue c c End cooling terms field loop: 200 continue c c End cooling terms conditional: endif c return end