c subroutine mkcon(f,i0,i1,cint,log,xlab,ylab,title) c c Make simple contour plot with title at top. c (this should compile w/ f77 or f90) c xlab,ylab = x and y-axis labels c If cint > 0, force cint contour interval c real f(i0,i1),ff(i0,i1),vp(4) character*(*) xlab,ylab,title ! parameter(lrwrk=2000,liwrk=1000,liama=300000,lcra=10000) parameter(lrwrk=2000,liwrk=2000,liama=300000,lcra=10000) real rwrk(lrwrk),iwrk(liwrk),xcra(lcra),ycra(lcra) integer iama(liama),iarea(10) data nframes/0/ c data vp/.1,.90,.15,.90/ data vp /.10,.96,.45,.88/ ! like vpce in mkmaps data spval/1.e36/ external drawcl c ff(:,:) = f(:,:) if (log.gt.0) then do i=1,i1 do ii=1,i0 if (f(ii,i) > 1.e-15) then ff(ii,i) = log10(ff(ii,i)) else ff(ii,i) = spval endif enddo enddo endif nframes = nframes+1 if (nframes.eq.1) then call cpseti('SET',1) call cpseti('MAP',0) call cpsetc('HIT',' ') call cpsetc('LOT',' ') call pcsetc('FC','$') call cpseti('LLP',3) call cpsetr('LLS',.02) call cpseti('LLO',1) call cpseti('ILP',0) call cpsetr('ILS',.018) call cpsetr('ILX',.5) call cpsetr('ILY',-.15) call cpsetc('ILT','MIN, MAX=$ZMN$, $ZMX$, INTERVAL=$CIU$') call cpsetr('VPS',0.) call cpsetr('VPL',vp(1)) call cpsetr('VPR',vp(2)) call cpsetr('VPB',vp(3)) call cpsetr('VPT',vp(4)) call cpsetr('SPV -- special value',spval) endif if (cint.gt.0.) call cpsetr('CIS',cint) call cprect(ff,i0,i0,i1,rwrk,lrwrk,iwrk,liwrk) call cppkcl(ff,rwrk,iwrk) call cpgeti('NCL -- number of contour levels',ncl) c c Loop through contour levels, set dashed pattern for levels < 0: c do i=1,ncl call cpseti('PAI -- parameter array index',i) call cpgetr('CLV -- contour level',clev) if (clev.lt.0.) + call cpsetc('CLD -- contour line dash pattern', + '$$''$$''') enddo c c Draw simple perimeter, contour lines and labels: c call cpback(ff,rwrk,iwrk) call arinam(iama,liama) ! initialize area map call cplbam(ff,rwrk,iwrk,iama) ! add contour labels to am call cpcldm(ff,rwrk,iwrk,iama,drawcl) ! draw contour lines call cplbdr(ff,rwrk,iwrk) ! draw contour labels c c Get zmin,zmax: c call cpgetr('ZMN',zmin) call cpgetr('ZMX',zmax) c c Put title at top: c call getset(vpl,vpr,vpb,vpt,wl,wr,wb,wt,ll) size = amin1(.5*(1.-vpt),.017) offset = .025 y = amin1((1.+vpt)/2.+offset, offset+vpt) call set(0.,1.,0.,1.,0.,1.,0.,1.,1) call plch(.5,y,title(1:len_trim(title)),size,0.,0.) c c Axis labels: c call plch(.5*(vpl+vpr),vpb-offset,xlab(1:len_trim(xlab)), + size,0.,0.) call plch(vpl-offset,.5*(vpb+vpt),ylab(1:len_trim(ylab)), + size,90.,0.) c c Restore set and advance frame: c call frame c if (log.le.0) then c write(6,"('Contour frame ',i3,': ',a,' min,max=',2e12.4)") c + nframes,title(1:len_trim(title)),zmin,zmax c else c write(6,"('Contour frame ',i3,' (log10): ',a,' min,max=', c + 2e12.4)") c + nframes,title(1:len_trim(title)),zmin,zmax c endif call set(vpl,vpr,vpb,vpt,wl,wr,wb,wt,ll) return end c c-------------------------------------------------------------- c subroutine drawcl(xcs,ycs,ncs,iai,iag,nai) dimension xcs(*),ycs(*),iai(*),iag(*) idr=1 do i=1,nai if (iai(i).lt.0) idr=0 enddo if (idr.ne.0) call curved(xcs,ycs,ncs) return end