c ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc c subroutine pltutlat(futlat) c c Contour ut on x-axis, latitude on y-axis at zphtlon (zp/ht,lon pairs): c include 'tigcmdif.h' dimension futlat(ntms,jmx,nfplt,nzphtlon),pdiflon(imx) character*56 toplab, fieldlab character*80 rec80,histlab character*24 flnm0,flnm1 dimension vp(4),plt(ntms,jmx) data vp /.15,.89,.26,.91/ c xmid = 0.5*(vp(1)+vp(2)) call cpseti('SET',0) call cpseti('MAP',0) call cpsetr('XC1',utinc(1)) call cpsetr('XCM',utinc(ntms)) call cpsetr('ILX',xmid) call cpseti('ILP',0) call cpsetr('ILS',.016) call cpsetr('YC1',gcmlat(1)) call cpsetr('YCN',gcmlat(jmx)) call set(vp(1),vp(2),vp(3),vp(4),utinc(1),utinc(ntms),-90.,90.,1) c c Field loop: c iip = 0 do 100 ip=1,nftot if (ifplt(ip).le.0) goto 100 if (ip.eq.ixuivi.or.ip.eq.ixunvn) goto 100 iip = iip+1 c c Loop over selected zp/ht,lon: c pdiflon(:) = cpspval ndiflon = 0 do 200 l=1,nzphtlon c c If doing fof2 and/or hmf2, make plot(s) for each new longitude: c if (ip.eq.ixfof2.or.ip.eq.ixhmf2) then isame = 0 do i=1,imx if (zphtlon(2,l).eq.pdiflon(i)) isame = 1 enddo if (isame.eq.0) then ! is new lon ndiflon = ndiflon+1 pdiflon(ndiflon) = zphtlon(2,l) else ! already plotted at this lon goto 200 endif endif c c Contour: c rily = -.17 if (zphtlon(2,l).ne.zmflag) rily = -.34 call cpsetr('ILY',rily) if (icolor.le.0) then call contour(futlat(1,1,iip,l),ntms,ntms,jmx, + cint(ip),cmin(ip),cmax(ip)) else call conclr(futlat(1,1,iip,l),ntms,ntms,jmx, + cint(ip),cmin(ip),cmax(ip)) endif isltax = 0 if (zphtlon(2,l).ne.zmflag) isltax = 1 call labutxy(mtcntr,ntms,gcmlat,jmx,'LATITUDE (DEG)', + 0.,isltax,zphtlon(2,l)) c c Field label at top: c call clearstr(toplab) write(toplab,"(a,' (DIFFERENCE)')") + flab(ip)(1:lenstr(flab(ip))) call wrlab(toplab(1:lenstr(toplab)),xmid,vp(4)+.07,0.) fieldlab = toplab c call clearstr(toplab) if (ip.eq.ixfof2.or.ip.eq.ixhmf2) then if (izphtlon(2,l).ne.zmflag) then write(toplab,"(' LON=',f7.2)") zphtlon(2,l) xoff = .25 else write(toplab,"('(ZONAL MEANS)')") endif goto 205 endif c c At selected zp and longitude: if (izphtlon(1,l).gt.0.and.zphtlon(2,l).ne.zmflag) then write(toplab,"('ZP=',f5.1,' LON=',f7.2)") + (zphtlon(i,l),i=1,2) xoff = .25 c c At selected zp and zonal means: elseif (izphtlon(1,l).gt.0.and.zphtlon(2,l).eq.zmflag) then write(toplab,"('ZP=',f5.1,' (ZONAL MEANS)')") zphtlon(1,l) c c At selected height and longitude: elseif (izphtlon(1,l).le.0.and.zphtlon(2,l).ne.zmflag) then write(toplab,"('HT=',f6.2,' LON=',f7.2)") + (zphtlon(i,l),i=1,2) xoff = .25 c c At selected height and zonal means (interpolate first, then take means) elseif (izphtlon(1,l).le.0.and.zphtlon(2,l).eq.zmflag) then write(toplab,"('HT=',f6.2,' (ZONAL MEANS)')") zphtlon(1,l) endif 205 continue call wrlab(toplab(1:lenstr(toplab)),xmid,vp(4)+0.03,0.) call clearstr(rec80) write(rec80,"(a)") toplab(1:lenstr(toplab)) c c Histories label: c call clearstr(toplab) call tail(pertvol(ipvol),flnm0) call tail(cntrvol(icvol),flnm1) write(toplab,"('DIFFS OF ',a,' MINUS ',a)") + flnm0(1:lenstr(flnm0)),flnm1(1:lenstr(flnm1)) if (zphtlon(2,l).eq.zmflag) xoff = .15 call wrlab(toplab(1:lenstr(toplab)),xmid,vp(3)-xoff, + .010) call clearstr(histlab) write(histlab,"(a)") toplab(1:lenstr(toplab)) c c Wrap it up: call frame iframe = iframe+1 if (iwrascii.gt.0) then call wrascii(iwrascii,luascii,plt,ntms,jmx,utinc,gcmlat, + 'UT (HRS)','LATITUDE (DEG)',histlab,fieldlab, + iframe,rec80,'tigcmdif',dirascii) endif if (ip.eq.ixfof2.or.ip.eq.ixhmf2) then if (izphtlon(2,l).ne.zmflag) then write(6,"('utlat frame ',i3,' field ',a,9x, + ' lon=',f8.2)") iframe,labshort(ip),zphtlon(2,l) else write(6,"('utlat frame ',i3,' field ',a,9x, + ' (zonal means)')") iframe,labshort(ip) endif goto 200 endif if (izphtlon(1,l).gt.0.and.zphtlon(2,l).ne.zmflag) then write(6,"('utlat frame ',i3,' field ',a,' zp=',f5.1, + ' lon=',f8.2)") iframe,labshort(ip),zphtlon(1,l), + zphtlon(2,l) elseif (izphtlon(1,l).gt.0.and.zphtlon(2,l).eq.zmflag) then write(6,"('utlat frame ',i3,' field ',a,' zp=',f5.1, + ' (zonal means)')") iframe,labshort(ip),zphtlon(1,l) elseif (izphtlon(1,l).le.0.and.zphtlon(2,l).ne.zmflag) then write(6,"('utlat frame ',i3,' field ',a,' ht=',f5.1, + ' lon=',f8.2)") iframe,labshort(ip),zphtlon(1,l), + zphtlon(2,l) elseif (izphtlon(1,l).le.0.and.zphtlon(2,l).eq.zmflag) then write(6,"('utlat frame ',i3,' field ',a,' ht=',f5.1, + ' (zonal means)')") iframe,labshort(ip),zphtlon(1,l) endif c c end l=1,nzphtlon 200 continue c c Field loop: 100 continue return end c ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc c subroutine getutlat(it,pert,cntr,futlat) c c Update futlat(ntms,jmx,nfplt,nloc) at current ut for pltutlat contours: c zp/ht,lon pairs are in zphtlon(2,nzphtlon). If izphtlon(1,i)=0, then c interpolate to desired height zphtlon(1,i), otherwise zphtlon(1,i) is c a pressure. Getlon handles zonal means option (zphtlon(2,i)=zmflag) c include 'tigcmdif.h' dimension futlat(ntms,jmx,nfplt,nzphtlon), + pert(imx,kmx,jmx,nfget),cntr(imx,kmx,jmx,nfget), + fjk0(jmx,kmx),fjk1(jmx,kmx),fjmx0(jmx),fjmx1(jmx) pointer(pjkht,fjkht(1)) c do 100 l=1,nzphtlon iip = 0 do 200 ip=1,nftot if (ifplt(ip).le.0) goto 200 if (ip.eq.ixuivi.or.ip.eq.ixunvn) goto 200 iip = iip+1 ipercent = 0 if (idif.eq.1.and.iperc(ip).eq.1) ipercent = 1 call getlon(pert,fjk1,zphtlon(2,l),0,ip,1) call getlon(cntr,fjk0,zphtlon(2,l),0,ip,0) c c At selected pressure: c if (izphtlon(1,l).gt.0) then ! at selected zp call mkdifs(fjk1,fjk0,jmx*kmx,ipercent,cpspval) futlat(it,:,iip,l) = fjk1(:,izphtlon(1,l)) c c At selected height (interpolate pert and cntr before making c diffs): c else ! interpolate to selected ht call hpalloc(pjkht,jmx*kmx,ier,0) if (ier.ne.0) then write(6,"('getutlat: error from hpalloc for pjkht')") stop 'pjkht' endif c Perturbed: call getlon(pert,fjkht,zphtlon(2,l),0,ixz,1) call intloc(fjk1,fjkht,kmx,zphtlon(1,l),1,ilog(ip), + fjmx1,jmx,jmx,1,ier,cpspval,0) c Control: call getlon(cntr,fjkht,zphtlon(2,l),0,ixz,0) call intloc(fjk0,fjkht,kmx,zphtlon(1,l),1,ilog(ip), + fjmx0,jmx,jmx,1,ier,cpspval,0) c Make difs: call mkdifs(fjmx1,fjmx0,jmx,ipercent,cpspval) futlat(it,:,iip,l) = fjmx1(:) call hpdeallc(pjkht,ier,1) endif 200 continue 100 continue return end