c c------------------------------------------------------------------ c subroutine pltloclt(utf,hts,ihtsc,l) c c Contour ut on x-axis, zp on y-axis if ihtsc <= 0; c if ihtsc > 0, then ht on y-axis at location l c include 'timesloc.h' character*56 fieldlab character*80 rec80,toplab dimension viewport(4),yaxht(kmx),rimx(imx),plt(ntms,kmx), + plt0(ntms,kmx),utf(ntms,kmx,nfplt,nloclt),hts(ntms,kmx,nloclt), + pltht(ntms,nhtscale),szlab(2) data viewport /.15,.88,.26,.91/ data szlab /.02,0./ 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 (labels.le.1) call cpsetr('ILS',.018) 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) endif c c Field loop: c do 200 ip=1,nftot if (ifplt(ip).le.0) goto 200 c c Get field and interpolate to height scale if necessary: c (Also take log10 if needed) c (note zonal and global means of ion drifts with efield not available) c if (ip.ge.ixui.and.ip.le.ixwi.and.ionvel.eq.2.and. + (gloc(1,l).eq.zmflag.or.gloc(2,l).eq.zmflag)) then write(6,"('>>> pltloclt: zonal or global mean', + ' ion drifts with efield not available')") goto 200 endif if (ihtsc.le.0) then do k=izprange(1),izprange(2) kk = k-izprange(1)+1 plt(:,kk) = utf(:,k,ifplt(ip),l) enddo ny = izprange(2)-izprange(1)+1 if (logloc.gt.0.and.logterp(ip).gt.0) + call log10f(plt,ntms*ny,1.e-20,cpspval) c c Height interpolation (if ions, then interp was done from mkfields): c else ny = nhtscale if ((ip.lt.ixui.or.ip.gt.ixwi).and.ip.ne.ixe5577.and. + ip.ne.ixe6300.and.ip.ne.ixeo200) then plt0(:,:) = utf(:,:,ifplt(ip),l) call cuthtint(plt0,hts(1,1,l),ntms,kmx,pltht,htscale, + nhtscale,logterp(ip),cpspval,ier,1) c c ion drifts with ht on y-axis c pointer htions(ntms,nhtscale,3,nloc) was defined in mkfields: c elseif (ip.ge.ixui.and.ip.le.ixwi) then do it=1,ntms do k=1,nhtscale ix = (l-1)*3*nhtscale*ntms+(ip-ixui)*nhtscale*ntms+ + (k-1)*ntms+it pltht(it,k) = htions(ix) enddo enddo c c pointer hte5577(ntms,nhtscale,nloc) was defined in mkfields: c elseif (ip.eq.ixe5577) then do it=1,ntms do k=1,nhtscale ix = (l-1)*nhtscale*ntms+(k-1)*ntms+it pltht(it,k) = hte5577(ix) enddo enddo c c pointer hte6300(ntms,nhtscale,nloc) was defined in mkfields: c elseif (ip.eq.ixe6300) then do it=1,ntms do k=1,nhtscale ix = (l-1)*nhtscale*ntms+(k-1)*ntms+it pltht(it,k) = hte6300(ix) enddo enddo c c pointer hteo200(ntms,nhtscale,nloc) was defined in mkfields: c elseif (ip.eq.ixeo200) then do it=1,ntms do k=1,nhtscale ix = (l-1)*nhtscale*ntms+(k-1)*ntms+it pltht(it,k) = hteo200(ix) enddo enddo else write(6,"('>>> warning pltloclt: unknown ip=',i3)") ip endif if (logloc.gt.0.and.logterp(ip).gt.0) + call log10f(pltht,ntms*ny,1.e-20,cpspval) endif c c Contour: if (labels.gt.1) then if (icolor.le.0) then if (ihtsc.le.0) then call contour(plt,ntms,ntms,ny,cint(ip),cmin(ip),cmax(ip)) else call contour(pltht,ntms,ntms,ny,cint(ip),cmin(ip), + cmax(ip)) endif else if (ihtsc.le.0) then call conclr(plt,ntms,ntms,ny,cint(ip),cmin(ip),cmax(ip)) else call conclr(pltht,ntms,ntms,ny,cint(ip),cmin(ip),cmax(ip)) endif endif c c "Simple" contours and labels: c else if (ihtsc.le.0) then call cpcnrc(plt,ntms,ntms,ny,0.,0.,finc,1,-1,-1634B) else call cpcnrc(pltht,ntms,ntms,ny,0.,0.,finc,1,-1,-1634B) endif endif c c Add axes 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 c c Field label at top: c call clearstr(toplab) if (logloc.gt.0.and.logterp(ip).gt.0) then write(toplab,"('LOG10 ',a)") flab(ip) else toplab = flab(ip) endif if (ip.eq.ixui.or.ip.eq.ixvi.or.ip.eq.ixwi) then len = lenstr(toplab) if (ionvel.eq.1) then write(toplab(len+1:len+11),"('(no efield)')") elseif (ionvel.eq.2) then write(toplab(len+1:len+13),"('(with efield)')") elseif (ionvel.eq.3) then write(toplab(len+1:len+13),"('(from epoten)')") endif endif call wrlab(toplab(1:lenstr(toplab)),xmid,viewport(4)+.07, + szlab(labels)) 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 if (locname(1).ne.'xxxxxxxxxxxxxxxx') then lentop = lenstr(toplab) lenlab = lenstr(locname(l)) write(toplab(lentop+1:lentop+lenlab+3),"(' (',a,')')") + locname(l)(1:lenlab) endif endif call wrlab(toplab(1:lenstr(toplab)),xmid,viewport(4)+0.03, + szlab(labels)) call clearstr(rec80) write(rec80,"(a)") toplab(1:lenstr(toplab)) c c History volume label at bottom: c if (labels.gt.1) then 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) endif c c Put height axis on right if pressure on y-axis c (global or zonal means are already in utf(...,l)) c if (ihtsc.gt.0) goto 300 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) 300 continue c c Wrap it up: c (make ascii file if needed) c call frame iframe = iframe+1 if (ihtsc.le.0) then if (iwrascii.gt.0) then call wrascii(iwrascii,luascii,plt,ntms,ny,utinc,gcmzp, + 'UT (HRS)','LN(P0/P)',histvol(ivol),fieldlab,iframe, + rec80,'timesloc',dirascii) endif if (gloc(1,l).eq.gmflag.and.gloc(2,l).eq.gmflag) then write(6,"('loc frame ',i4,' field ',a8, + ' (GLOBAL MEANS) zprange=',2f8.2)") iframe, + labshort(ip),zprange elseif (gloc(1,l).ne.gmflag.and.gloc(2,l).eq.gmflag) then write(6,"('loc frame ',i4,' field ',a8, + ' lat=',f6.1,' zonal means zprange=',2f8.2)") + iframe,labshort(ip),gloc(1,l),zprange else write(6,"('loc frame ',i4,' field ',a8, + ' lat,lon=',f6.1,',',f7.1,' zprange=',2f8.2)") + iframe,labshort(ip),gloc(1,l),gloc(2,l),zprange endif else if (iwrascii.gt.0) then call wrascii(iwrascii,luascii,pltht,ntms,ny,utinc,htscale, + 'UT (HRS)','HEIGHT (KM)',histvol(ivol),fieldlab,iframe, + rec80,'timesloc',dirascii) endif if (gloc(1,l).eq.gmflag.and.gloc(2,l).eq.gmflag) then write(6,"('loc frame ',i4,' field ',a8, + ' (GLOBAL MEANS) htscale=',f6.1,' to ',f6.1)") iframe, + labshort(ip),htscale(1),htscale(nhtscale) elseif (gloc(1,l).ne.gmflag.and.gloc(2,l).eq.gmflag) then write(6,"('loc frame ',i4,' field ',a8, + ' lat=',f6.1,' zonal means htscale=',f6.1,' to ', + f6.1)") iframe,labshort(ip),gloc(1,l),htscale(1), + htscale(nhtscale) else write(6,"('loc frame ',i4,' field ',a8, + ' lat,lon=',f6.1,',',f7.1,' htscale=',f6.1,' to ', + f6.1)") iframe,labshort(ip),gloc(1,l),gloc(2,l), + htscale(1),htscale(nhtscale) endif endif c c End field loop 200 continue c return end