c subroutine pltdop(l,htutkmx) c c Make line plots with ut on x-axis at selected zp and/or ht, c at location l: c (htutkmx will be passed to contver to access heights when ver is c contoured with linear height scale on y-axis) c include 'tigcmloc.h' include 'doppler.h' dimension vp(4),plt(ntms),xax(ntms) dimension htutkmx(ntms,kmx,nloc) character*56 toplab character*80 rec80 character*16 ylab,doplab(ndopline) data vp /0.17,0.95,0.20,0.90/ data doplab /'DOPPLER TN ','DOPPLER UN ', + 'DOPPLER VN ','DOPPLER RAY '/ c c Set up AG: c call agsetf('DASH/PATTERNS/1.',65535.) call agsetc ('LABEL/NAME.','T') call agsetr("AXIS/TOP/CONTROL.",-1.) call agseti ('LINE/NUMBER.', 100) call agsetf ('LINE/CHARACTER.', .025) call agsetc("LABEL/NAME.","B") call agsetr("LABEL/DEF/SUPPRESSION.",1.) call agsetr("AXIS/BOT/CONTROL.",-1.) c c Set up x axis and do set call: c do i=1,ntms xax(i) = utinc(i) enddo call set(vp(1),vp(2),vp(3),vp(4),0.,1.,0.,1.,1) c c lset=2 -> AG will use only fractional from set call lset = 2 c call clearstr(toplab) if (gloc(1,l).eq.gmflag.and.gloc(2,l).eq.gmflag) then write(toplab,"('GLOBAL MEANS')") elseif (gloc(1,l).ne.gmflag.and.gloc(2,l).eq.gmflag) then write(toplab,"('LAT= ',f6.2,' LON=ZONAL MEANS')") gloc(1,l) else write(toplab,"('LAT,LON = ',f6.2,',',f7.2)") + gloc(1,l),gloc(2,l) endif len = lenstr(toplab) call clearstr(rec80) write(rec80,"(a)") toplab(1:len) c c Field loop: c do 200 ip=1,ndopline do i=1,ntms plt(i) = dopline(i,l,ip) enddo call clearstr(ylab) write(ylab,"(a)") doplab(ip) call displa(2,1,1) call anotat('UT (HRS)',ylab(1:lenstr(ylab)),0,lset,-1,l) call ezxy(xax,plt,ntms,' ') isltax = 0 if (gloc(1,l).ne.gmflag.and.gloc(2,l).ne.gmflag) isltax=1 call labutxy(mtimes,ntms,0.,0,' ',0.,1,gloc(2,l)) call wrlab(doplab(ip)(1:lenstr(doplab(ip))),0.5*(vp(1)+vp(2)), + vp(4)+.07,0.) call wrlab(toplab(1:len),0.5*(vp(1)+vp(2)),vp(4)+.034,0.) call fminmax(plt,ntms,rmin,rmax,cpspval) if (rmin.le.0..and.rmax.ge.0.) + call line(xax(1),0.,xax(ntms),0.) call frame iframe = iframe+1 if (iwrascii.gt.0) then call wrascii(iwrascii,luascii,plt,ntms,1,utinc,dum, + 'UT (HRS)',' ',histvol(ivol),ylab,iframe,rec80, + 'tigcmloc',dirascii) endif write(6,"('pltdop frame ',i4,' field ',a,' ',a)") iframe, + ylab(1:lenstr(ylab)),toplab(1:len) c End ht-independent doppler field loop: 200 continue c c Contour volume emission rate: c nzprange = izprange(2)-izprange(1) if (nzprange.gt.0) call contver(0,l,htutkmx) if (nhtscale.gt.0) call contver(1,l,htutkmx) c return end c cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc c subroutine contver(ihtsc,l,hts) include 'tigcmloc.h' include 'doppler.h' dimension viewport(4),pltver(ntms,kmx),hts(ntms,kmx,nloc), + yaxht(kmx) pointer(ppltht,pltht(1)) character*56 toplab,fieldlab character*80 rec80 data viewport /.12,.86,.26,.91/ data logver/1/ c c Contour doppler volume emission rate: c xmid = 0.5*(viewport(1)+viewport(2)) call cpseti('SET',0) call cpseti('MAP',0) call cpsetr('XC1',utinc(1)) call cpsetr('XCM',utinc(ntms)) call cpsetr('ILX',xmid) rily = -.17 if (gloc(1,l).ne.gmflag.and.gloc(2,l).ne.gmflag) rily = -.34 call cpsetr('ILY',rily) call cpseti('ILP',0) call cpsetr('ILS',.016) 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), + utinc(1),utinc(ntms),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), + utinc(1),utinc(ntms),htscale(1),htscale(nhtscale),1) call hpalloc(ppltht,ntms*nhtscale,ier,1) if (ier.ne.0) then write(6,"('contver: hpalloc error = ',i6,' for pltht')") ier stop 'ppltht' endif endif c c Zp on y-axis: c if (ihtsc.le.0) then do k=izprange(1),izprange(2) kk = k-izprange(1)+1 do i=1,ntms pltver(i,kk) = ver(i,k,l) enddo enddo ny = izprange(2)-izprange(1)+1 if (logver.gt.0) call log10f(pltver,ntms*ny,1.e-20,cpspval) if (icolor.le.0) then call contour(pltver,ntms,ntms,ny,0.,1.,0.) else call conclr(pltver,ntms,ntms,ny,0.,1.,0.) endif c c Height on y-axis: c subroutine cuthtint(fin,fht,idim1,nzp,fout,hts,nhts,logint,spval, c + ier,iprnt) c dimension fin(idim1,nzp),fht(idim1,nzp),fout(idim1,nhts), c + hts(nhts) c else do i=1,ntms pltver(i,:) = ver(i,:,l) enddo call cuthtint(pltver,hts(1,1,l),ntms,kmx,pltht,htscale, + nhtscale,logver,cpspval,ier,1) ny = nhtscale if (logver.gt.0) call log10f(pltht,ntms*ny,1.e-20,cpspval) if (icolor.le.0) then call contour(pltht,ntms,ntms,ny,0.,1.,0.) else call conclr(pltht,ntms,ntms,ny,0.,1.,0.) endif endif c c Add axes and field labels: c isltax = 0 if (gloc(1,l).ne.gmflag.and.gloc(2,l).ne.gmflag) isltax = 1 if (ihtsc.le.0) then call labutxy(mtimes,ntms,gcmzp(izprange(1)),ny,'ZP', + 0.,isltax,gloc(2,l)) else call labutxy(mtimes,ntms,htscale,nhtscale,'HEIGHT (KM)', + 0.,isltax,gloc(2,l)) endif call clearstr(toplab) if (logver.le.0) then write(toplab,"('VOLUME EMISSION (6300A) (PHOTONS CM-3 S-1)')") else write(toplab,"('LOG10 VOLUME EMISSION (6300A) ', + '(PHOTONS CM-3 S-1)')") endif call wrlab(toplab(1:lenstr(toplab)),xmid,viewport(4)+.07,0.) fieldlab = toplab c c Location label (may be at selected lat,lon, or at global means, or c zonal means at selected latitude): c call clearstr(toplab) if (gloc(1,l).eq.gmflag.and.gloc(2,l).eq.gmflag) then write(toplab,"('GLOBAL MEANS')") xoff = .15 elseif (gloc(1,l).ne.gmflag.and.gloc(2,l).eq.gmflag) then write(toplab,"('LAT= ',f6.2,' LON=ZONAL MEANS')") gloc(1,l) xoff = .15 else write(toplab,"('LAT,LON = ',f6.2,',',f7.2)") + gloc(1,l),gloc(2,l) xoff = .25 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) if (nhvols.eq.1) then write(toplab,"('HISTORY=',a)") histvol(ivol) else write(toplab,"('FIRST HISTORY VOL=',a)") histvol(ivol) endif call wrlab(toplab(1:lenstr(toplab)),xmid,viewport(3)-xoff,.010) c c Put height axis on right if pressure on y-axis c if (ihtsc.le.0) then yaxht(:) = 0. do k=izprange(1),izprange(2) izp = k-izprange(1)+1 do i=1,ntms yaxht(izp) = yaxht(izp) + hts(i,k,l) enddo yaxht(izp) = yaxht(izp) / float(ntms) enddo rnd = 10. if (gcmzp(izprange(2))-gcmzp(izprange(1)).le.5.) rnd = 5. call altyax(ny,yaxht,gcmzp(izprange(1)),rnd,6) endif c c Report frame and write ascii file if necessary: c call frame iframe = iframe+1 write(6,"('contver frame ',i3,' ',a,' ',a)") iframe, + fieldlab(1:lenstr(fieldlab)),rec80(1:lenstr(rec80)) if (ihtsc.le.0) then if (iwrascii.gt.0) + call wrascii(iwrascii,luascii,pltver,ntms,ny,utinc, + gcmzp,'UT (HTS)','LN(P0/P)',histvol(ivol),fieldlab, + iframe,rec80,'tigcmloc',dirascii) else if (iwrascii.gt.0) + call wrascii(iwrascii,luascii,pltht,ntms,ny,utinc,htscale, + 'UT (HRS)','HEIGHT (KM)',histvol(ivol),fieldlab,iframe, + rec80,'tigcmloc',dirascii) endif return end