c c------------------------------------------------------------------ c Begin file /home/sting/foster/timesdif/getinp.f c------------------------------------------------------------------ c subroutine getinp c include 'gettime.h' include 'timesdif.h' dimension htsc(3) c call lexcon(pertvol ,8HPERTVOL ,npvol) call lexcon(cntrvol ,8HCNTRVOL ,ncvol) call lexcon(chtmpert,8HPERTTIME,ntmspert) call lexcon(chtmcntr,8HCNTRTIME,ntmscntr) call lexcon(iden ,8HIDEN ,niden) call lexcon(icolor ,8HCOLOR ,ncolor) call lexcon(icont ,8HICONT ,ncont) call lexcon(iplglb ,8HPLTGLB ,npltglb) call lexcon(perimlat,8HPOLLAT ,npollat) call lexcon(spls ,8HZP ,npls) call lexcon(shts ,8HHT ,nhts) call lexcon(iplloc ,8HPLTLOC ,npltloc) call lexcon(rloc ,8HLOC ,nloc) call lexcon(ipllon ,8HPLTLON ,npltlon) call lexcon(slon ,8HLON ,nlon) call lexcon(ipllat ,8HPLTLAT ,npltlat) call lexcon(slat ,8HLAT ,nlat) call lexcon(htsc ,8HHT_SCALE,nhtscale) call lexcon(zprange ,8HZP_RANGE,nzprange) call lexcon(iplglbm ,8HPLGLBM ,npltglbm) call lexcon(ipltime ,8HPLTIME ,npltime) call lexcon(cint ,8HCINT ,ncint) call lexcon(cmin ,8HCMIN ,ncmin) call lexcon(cmax ,8HCMAX ,ncmax) call readlx(5,ierr) if (ierr.ne.1) then write(6,"(' ')") write(6,"('>>> getinp readlx ierr=',i10)") ierr write(6,"(' ')") stop 'readlx' endif if (ncont.le.0) icont = 1 C C Iden = 1,2 for mass mixing ratios or number densities C if (niden.le.0) then write(6,"(' >>> getinp: no iden -- will default to cm-3')") iden = 1 endif if (iden.lt.0.or.iden.gt.2) then write(6,"(' >>> getinp: bad iden = ',i5,' -- will default ', + 'to cm-3')") iden iden = 1 endif c c Color option: c if (ncolor.le.0) icolor = 0 C C Perturbed histvol(s): C if (mod(npvol,4).ne.0) then write(6,"(' >>> getinp: need 1 32-char filename for ', + 'each perturbed histvol: npvol=',i5)") npvol stop 'npvol' endif npvol = npvol/4 if (npvol.gt.mxvols) then write(6,"('>>> getinp: npvol.gt.mxvols: npvol=',i3, + ' mxvols=',i3)") npvol,mxvols stop 'npvol' endif C C Control histvol(s): C if (mod(ncvol,4).ne.0) then write(6,"(' >>> getinp: need 1 32-char filename for ', + 'each perturbed histvol: ncvol=',i5)") ncvol stop 'ncvol' endif ncvol = ncvol/4 if (ncvol.gt.mxvols) then write(6,"('>>> getinp: ncvol.gt.mxvols: ncvol=',i3, + ' mxvols=',i3)") ncvol,mxvols stop 'ncvol' endif C C Number of desired times: C if (ntmspert.ne.ntmscntr) then c c Allow ntmspert.ne.ntmscntr only if they are multiple days, c and if ntmspert > ntmscntr. This allows multiple perturbed c days to be differenced with the same base case day c if (mod(ntmscntr-1,24).ne.0.and.mod(ntmspert-1,24).ne.0) then write(6,"('>>> getinp: need same number of perturbed', + ' and control times ',/' (or multiples of 24 (+1 at end)):', + /' ntmspert=',i3,' ntmscntr=',i3)") ntmspert,ntmscntr stop 'ntms' else if (ntmscntr.gt.ntmspert) then write(6,"('>>> getinp: bad ntms: ntmscntr=',i3, + ' ntmspert=',i3)") ntmscntr,ntmspert stop 'ntms' endif ntms = ntmspert if (ntms.gt.mxtms) then write(6,"(' >>> getinp: too many times: mxtms=',I2,' ntms=', + I3)") mxtms,ntms stop 'ntms1' endif chtmcntr(ntms) = chtmcntr(ntmscntr) c c Control times will repeat same day for each perturbed day: c do i=ntmscntr,ntms-1 chtmcntr(i) = chtmcntr(i-24) enddo endif else ntms = ntmspert endif if (ntms.gt.mxtms) then write(6,"(' >>> getinp: too many times: mxtms=',I2,' ntms=', + I3)") mxtms,ntms stop 'ntms' endif if (ntms.le.0) then write(6,"(' >>> getinp: need at least one time: ntms=',I3)") + ntms stop 'ntms' endif c c Ut loop: c do 100 it=1,ntms c c Get perturbed times: read(chtmpert(it),"(2(i2,1x),i2)") + mdpert(it),mhpert(it),mmpert(it) if (mhpert(it).lt.0.or.mhpert(it).gt.23) then write(6,"(' >>> getinp: bad mhpert(',I2,') = ',I4)") + it,mhpert(it) stop 'mhpert' endif if (mmpert(it).lt.0.or.mmpert(it).gt.59) then write(6,"(' >>> getinp: bad mmpert(',i2,') = ',i4)") + it,mmpert(it) stop 'mmpert' endif c c Get control times: read(chtmcntr(it),"(2(i2,1x),i2)") + mdcntr(it),mhcntr(it),mmcntr(it) if (mhcntr(it).lt.0.or.mhcntr(it).gt.23) then write(6,"(' >>> getinp: bad mhcntr(',I2,') = ',I4)") + it,mhcntr(it) stop 'mhcntr' endif if (mmcntr(it).lt.0.or.mmcntr(it).gt.59) then write(6,"(' >>> getinp: bad mmcntr(',i2,') = ',i4)") + it,mmcntr(it) stop 'mmcntr' endif 100 continue c c Fields to plot: c nplfld = number of fields to plot c Always need height (for altyax), so set ipltime(itxz)=1, but save c ipltime(itxz) first as iplz to know whether or not to plot height c if (npltime.le.0) then write(6,"('>>> getinp: no fields to plot? npltime=',i3)") + npltime stop 'npltime' elseif (npltime.ne.ntimefld) then write(6,"('>>> getinp: need ',i3,' values for PLTIME', + ' -- got ',i3)") ntimefld,npltime stop 'npltime' endif nplfld = 0 iplz = 0 if (ipltime(itxz).gt.0) iplz = 1 ipltime(itxz) = 1 do ip=1,ntimefld if (ipltime(ip).gt.0) nplfld = nplfld+1 enddo write(6,"('getinp: nplfld=',i3)") nplfld c c Plot flags: if (npltglb.le.0) iplglb = 0 if (npltlon.le.0) ipllon = 0 if (npllonht.le.0) ipllonht = 0 if (npltlat.le.0) ipllat = 0 if (npltglbm.le.0) iplglbm = 0 if (npltloc.le.0) iplloc = 0 c c Selected pressures (for CE plots): if (npls.gt.kmx) then write(6,"('>>> getinp: too many spls: npls=',i3, + ' will default to ',i3)") npls,kmx npls = kmx endif c c Selected heights (for CE plots): if (nhts.gt.kmx) then write(6,"('>>> getinp: too many nhts: nhts=',i3, + ' will default to ',i3)") nhts,kmx nhts = kmx endif c c Perimeter latitudes (for polars) c if (npollat.gt.mxpolat) then write(6,"('>>> getinp: too many perim lats (POLLAT)=',i3 + ' will default to ',i3)") npollat,mxpolat npollat = mxpolat endif if (npollat.gt.0) then do i=1,npollat ixlat = ixfind(gcmlat,jmx,perimlat(i),dlat) if (ixlat.le.0) then write(6,"('>>> getinp: bad perimlat (POLLAT)=',f10.3, + ' i=',i3)") perimlat(i),i stop 'perimlat' endif perimlat(i) = gcmlat(ixlat) enddo endif c c Range of zp for y-axis (pltlon and pltlat): c if (nzprange.le.0) then zprange(1) = gcmzp(1) zprange(2) = gcmzp(kmx) elseif (nzprange.ne.2) then write(6,"('>>> ZP_RANGE needs two values (got ',i3,')')") + nzprange stop 'zprange' else if (zprange(1).lt.gcmzp(1).or.zprange(2).gt.gcmzp(kmx).or. + zprange(1).ge.zprange(2)) then write(6,"('>>> BAD ZP_RANGE = ',2f10.2,' gcmzp=',/(6e12.4))") + zprange,gcmzp stop 'zprange' endif endif izprange(1) = ixfind(gcmzp,kmx,zprange(1),dzp) if (izprange(1).lt.0) then write(6,"('>>> error from ixfind for zprange(1): zprange(1)=', + f10.2,' kmx=',i3,' gcmzp=',/(6e12.4))") zprange(1),kmx,gcmzp stop 'izprange' endif izprange(2) = ixfind(gcmzp,kmx,zprange(2),dzp) if (izprange(2).lt.0) then write(6,"('>>> error from ixfind for zprange(2): zprange(2)=', + f10.2,' kmx=',i3,' gcmzp=',/(6e12.4))") zprange(2),kmx,gcmzp stop 'izprange' endif write(6,"('getinp: zprange=',2f8.2,' izprange=',2i3)") zprange, + izprange c c Locations for line plots: if (mod(nloc,2).ne.0) then write(6,"('>>> getinp: need even number of locs (lat,lon)', + ' nloc=',i3)") nloc stop 'nloc' else nloc = nloc/2 endif if (nloc.gt.mxloc) then write(6,"('>>> getinp: too many locs: nloc=',i3, + ' will default to ',i3)") nloc,mxloc stop 'nloc' endif c c Linear height scale (for pltlat,pltlon): c User specifies bottom, top, and delta in that order: c if (nhtscale.gt.0.and.nhtscale.ne.3) then write(6,"('>>> getinp: HTSCALE should be = htbot,httop,delht ', + 'e.g., 50.,500.,25.')") stop 'htscale' endif if (nhtscale.gt.0) then if (htsc(1).ge.htsc(2)) then write(6,"('>>> getinp: HTSCALE: top must be > bot: bot=', + f10.2,' top=',f10.2)") htsc(1),htsc(2) stop 'htscale' endif if (htsc(3).le.0.) then write(6,"('>>> getinp: HTSCALE: bad delta ht=',f10.2)")htsc(3) stop 'htscale' endif htbot = htsc(1) httop = htsc(2) delht = htsc(3) else delht = 0. endif c c Set up linear height scale, if needed: c nhtscale = 0 if (delht.gt.0.) then nhtscale = ifix((httop-htbot) / delht + 1.0000001) call hpalloc(phtscale,nhtscale,ier,1) if (ier.ne.0) then write(6,"('hpalloc error = ',i6,' for phtscale')") ier stop 'phtscale' endif do i=1,nhtscale htscale(i) = htbot + (i-1)*delht enddo if (nlon.gt.0.or.nslt.gt.0.or.nloc.gt.0) + write(6,"('getinp: nhtscale=',i2,' linear height scale = ', + /(6e10.3))") nhtscale,(htscale(i),i=1,nhtscale) endif c c Contour intervals: c if (ncint.le.0) then do ip=1,ntimefld cint(ip) = 0. enddo elseif (ncint.ne.ntimefld) then write(6,"('>>> Need ',i3,' contour intervals (CINT),' + ' or none: got ',i3,' -- stop ')") + ntimefld,ncint stop 'CINT' endif c c Contour minimums: c if (ncmin.le.0) then do ip=1,ntimefld cmin(ip) = 1. enddo elseif (ncmin.ne.ntimefld) then write(6,"('>>> Need ',i3,' contour minimums (CMIN),' + ' or none: got ',i3,' -- stop ')") + ntimefld,ncmin stop 'CMIN' endif c c Contour maximums: c if (ncmax.le.0) then do ip=1,ntimefld cmax(ip) = 0. enddo elseif (ncmax.ne.ntimefld) then write(6,"('>>> Need ',i3,' contour maximums (CMAX),' + ' or none: got ',i3,' -- stop ')") + ntimefld,ncmax stop 'CMAX' endif c return end