c c------------------------------------------------------------------ c Begin file /home/sting/foster/timegcm/getinp.f c------------------------------------------------------------------ c subroutine getinp c include 'timesproc.h' dimension htsc(3) c call lexcon(histvol ,8HHISTVOL ,nhvols) call lexcon(mtimes ,8HDDHHMM ,ntimes) call lexcon(iden ,8HIDEN ,niden) call lexcon(modelhts,8HMODELHTS,nmodhts) call lexcon(icolor ,8HCOLOR ,ncolor) call lexcon(labels ,8HLABELS ,nlabels) call lexcon(iplglb ,8HPLTGLB ,npltglb) call lexcon(censlt ,8HSLTGLB ,nsltglb) call lexcon(icont ,8HICONT ,ncont) call lexcon(ituv ,8HTUV ,ntuv) call lexcon(izuv ,8HZUV ,nzuv) call lexcon(ipuv ,8HPUV ,npuv) call lexcon(uvmax ,8HUVMAX ,nuvmax) call lexcon(log10map,8HLOG10 ,nlog10) call lexcon(perimlat,8HPOLLAT ,npollat) call lexcon(censatv ,8HCENSATV ,nsatv) call lexcon(spls ,8HZP ,npls) call lexcon(shts ,8HHTS ,nhts) call lexcon(ipllon ,8HPLTLON ,npltlon) call lexcon(slon ,8HLON ,nlon) call lexcon(sslt ,8HSLT ,nslt) call lexcon(ovpollat,8HOVPOLLAT,nvpollat) call lexcon(ipllat ,8HPLTLAT ,npltlat) call lexcon(slat ,8HLAT ,nlat) call lexcon(iplloc ,8HPLTLOC ,npltloc) call lexcon(rloc ,8HLOC ,nloc) call lexcon(iplglbm ,8HPLGLBM ,npltglbm) call lexcon(iampha ,8HAMPHASE ,nampha) call lexcon(zprange ,8HZP_RANGE,nzprange) call lexcon(htsc ,8HHT_SCALE,nhtscale) call lexcon(iyax_r ,8HYAXRIGHT,nyaxr) call lexcon(logvert ,8HLOGVERT ,nlogvert) call lexcon(ifplt ,8HFIELDS ,npltime) call lexcon(ionvel ,8HIONVEL ,nionvel) call lexcon(iwrgrid ,8HWRGRID ,nwrgrid) call lexcon(iwrascii,8HWRASCII ,nwrascii) call lexcon(dirascii,8HDIRASCII,ndirdat) call lexcon(dircgm ,8HDIRCGM ,ndircgm) 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 C C Iden = 0,1,2 for mass mixing ratios, number densities, or mixing C ratios of number densities C if (niden.le.0) then write(6,"(' >>> getinp: no iden -- will default to cm-3 ', + '(iden=1)')") iden = 1 endif if (iden.lt.0.or.iden.gt.2) then write(6,"('>>> getinp: bad iden=',i3/4x,'(must be 0,1,2 for ', + ' mass mixing ratios, number densities, or mixing ratios', + ' of number densities)')") iden stop 'iden' endif c c modelhts = 1 -> use model heights rather than newhts (see gettimes.a) c if (nmodhts.le.0) modelhts = 0 c c Color option: c if (ncolor.le.0) icolor = 0 c c Labels option (labels=1 for simple, labels=2 for normal (default)) c (use simple if need to translate metacode at 9600 baud) c if (nlabels.le.0) labels = 2 if (labels.lt.2.and.icolor.gt.0) then write(6,"('>>> turning color off, since simple labels ', + 'requested')") icolor=0 endif C C Histvol(s): C if (mod(nhvols,3).ne.0) then write(6,"('>>> getinp: history volumes must be 24-chars each', + /' nhvols=',i3)") nhvols stop 'nhvols' endif nhvols = nhvols/3 if (nhvols.gt.mxvols) then write(6,"(' >>> getinp: nhvols.gt.mxvols: nhvols=',I3, + ' mxvols=',i3)") nhvols,mxvols stop 'nhvols' endif C C Number of desired times: C if (ntimes.le.0) then write(6,"('>>> getinp: need model times (DDHHMM)')") stop 'mtimes' endif if (mod(ntimes,3).ne.0) then write(6,"('>> getinp: model times should come in triplets ', + '(dd,hh,mm): ntimes=',i3)") ntimes stop 'ntimes' endif ntms = ntimes/3 if (ntms.gt.mxtms) then write(6,"('>>> getinp: too many model times (DDHHMM);', + ' ntms=',i3,' mxtms=',i3)") ntms,mxtms stop 'mxtms' endif c c Ut loop: c (mh,mm=99 means search only) c do 100 it=1,ntms if (mtimes(2,it).ne.99.and. + (mtimes(2,it).lt.0.or.mtimes(2,it).gt.23)) then write(6,"('>>> getinp: bad model hour: ',i3,' it=',i3)") + mtimes(2,it),it stop 'mhour' endif if (mtimes(3,it).ne.99.and. + (mtimes(3,it).lt.0.or.mtimes(3,it).gt.59)) then write(6,"('>>> getinp: bad model minute: ',i3,' it=',i3)") + mtimes(3,it),it stop 'mm' endif ut(it) = float(mtimes(2,it))+float(mtimes(3,it))/60. 100 continue c c Ion drifts flag: if (nionvel.le.0) ionvel = 1 c c Fields to plot: c if (npltime.le.0) then write(6,"('>>> getinp: no fields to plot? npltime=',i3)") + npltime stop 'npltime' elseif (npltime.ne.nftot) then write(6,"('>>> getinp: need ',i3,' values for FIELDS', + ' -- got ',i3)") nftot,npltime stop 'npltime' endif c c Check field dependencies, i.e., request additional history fields c that are required for certain plot field requests: c call chflds(ifget,nfhist,ifplt,nftot,ifdep,nftot-nfhist,1, + flab,1) c c modelhts = 0 -> tell gettgcm calculate hts using "newhts", otherwise c (modelhts = 1) gettgcm will get heights from history c ifget(itxz) = 1 ! always get heights if (modelhts.gt.0) ifget(itxz) = 2 ! flag gettgcm to get history hts if (ifplt(itxz).gt.0) then ! also want to plot z if (modelhts.gt.0) then ! want hts from hist (flag gettgcm) write(6,"('Heights will be returned directly from model ', + 'history')") else ! want newhts (see proclat) write(6,"('Heights will be calculated from tn and ', + 'mean mass')") endif endif c c Plot log10 on mapped projections if log10map > 0 (default is 0): if (nlog10.le.0) log10map = 0 c c log10 of vertical slices (default = 0 if doing mass mixing or c number density ratios, 1 otherwise): if (nlogvert.le.0) then logvert = 1 if (iden.eq.0.or.iden.eq.2) then logvert = 0 endif c c Plot flags: if (npltglb.le.0) iplglb = 0 ipsltglb = 0 if (nsltglb.gt.0.and.(censlt.ne.0..and.censlt.ne.12.)) then write(6,"('>>> getinp: bad SLTGLB=',f9.2,' will default to', + ' SLTGLB=12. (noon at center of x-axis)')") censlt censlt = 12. elseif (nsltglb.gt.0) then ipsltglb = 1 endif if (nsatv.le.0) nsatv = 0 if (npltlon.le.0) ipllon = 0 if (npltlat.le.0) ipllat = 0 if (npltloc.le.0) iplloc = 0 if (npltglbm.le.0) iplglbm = 0 c c Linear height scale (for pltutht): 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 Extra right-hand axes: c if (nyaxr.le.0) iyax_r = 1 c c Sat view projection(s): c (censatv(2,i) = r12flag means use local noon longitude) c if (mod(nsatv,2).ne.0) then write(6,"('>>> getinp: CENSATV must be in pairs (lat,lon)', + /' of center of sat view projections: nsatv=',i3)") nsatv stop 'nsatv' endif nsatv = nsatv/2 if (nsatv.gt.mxsatv) then write(6,"('>>> getinp warning: too many CENSATV=',i3, + ' mxsatv=',i3,' will default to the max')") nsatv,mxsatv nsatv = mxsatv endif do i=1,nsatv if (censatv(1,i).lt.gcmlat(1).or.censatv(1,i).gt.gcmlat(jmx)) + then write(6,"('>>> getinp: bad lat in censatv=',f10.2,' i=',i2)") + censatv(1,i),i stop 'censatv' endif if (censatv(2,i).ne.r12flag.and.(censatv(2,i).lt.gcmlon(1).or. + censatv(2,i).gt.gcmlon(imx))) then write(6,"('>>> getinp: bad lon in censatv=',f10.2,' i=',i2)") + censatv(2,i),i stop 'censatv' endif enddo c c Selected pressures (for CE and POL 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 and POL plots): if (nhts.gt.kmx) then write(6,"('>>> getinp: too many hts: nhts=',i3, + ' will default to ',i3)") nhts,kmx nhts = kmx endif c c Selected longitudes (for lon slices made in pltlon): if (nlon.gt.imx) then write(6,"('>>> getinp: too many lons: nlon=',i3, + ' will default to ',i3)") nlon,imx nlon = imx endif c c Selected local times (for lon slices made in pltlon): if (nslt.gt.imx) then write(6,"('>>> getinp: too many slt: nslt=',i3, + ' will default to ',i3)") nslt,imx nslt = imx endif if (nslt.gt.0) then do i=1,nslt if (sslt(i).lt.0..or.sslt(i).gt.23.99999) then write(6,"('>>> getinp: bad SLT=',f10.2)") sslt(i) stop 'SLT' endif enddo endif c c OVPOLLAT = latitudes for extreme ends of x-axis on lon slices c e.g., OVPOLLAT=45 means lon slice xaxis = 45->90>45 c if (nvpollat.gt.0) then if (nvpollat.gt.jmx) then write(6,"('>>> getinp: too many OVPOLLAT: nvpollat=',i3)") + nvpollat stop 'nvpollat' endif do i=1,nvpollat if (ovpollat(i).le.gcmlat(1).or.ovpollat(i).ge.gcmlat(jmx)) + then write(6,"('>>> getinp: bad ovpollat=',f8.2)") ovpollat(i) stop 'ovpollat' endif enddo endif 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=',i4, + ' will default to ',i4)") nloc,mxloc nloc = mxloc 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 Contour intervals: c if (ncint.le.0) then do ip=1,nftot cint(ip) = 0. enddo elseif (ncint.ne.nftot) then write(6,"('>>> Need ',i3,' contour intervals (CINT),' + ' or none: got ',i3,' -- stop ')") + nftot,ncint stop 'CINT' endif c c Contour minimums: c if (ncmin.le.0) then do ip=1,nftot cmin(ip) = 1. enddo elseif (ncmin.ne.nftot) then write(6,"('>>> Need ',i3,' contour minimums (CMIN),' + ' or none: got ',i3,' -- stop ')") + nftot,ncmin stop 'CMIN' endif c c Contour maximums: c if (ncmax.le.0) then do ip=1,nftot cmax(ip) = 0. enddo elseif (ncmax.ne.nftot) then write(6,"('>>> Need ',i3,' contour maximums (CMAX),' + ' or none: got ',i3,' -- stop ')") + nftot,ncmax stop 'CMAX' endif c c Continental outlines flag (default is to draw continental outlines): if (ncont.le.0) icont = 1 c c Default plot wind vectors over tn (do not if ituv=0) if (ntuv.le.0) ituv = 1 if (nzuv.le.0) izuv = 1 if ((ifplt(itxt).gt.0.and.ituv.gt.0).or. + (ifplt(itxz).gt.0.and.izuv.gt.0)) then ifget(itxu) = 1 ifget(itxv) = 1 endif c c Default plot ion drift vectors over epot (do not if ipuv=0) if (npuv.le.0) ipuv = 1 if (ifplt(itxpot).gt.0.and.ipuv.gt.0) then ifget(itxui) = 1 ifget(itxvi) = 1 endif c c Need several fields if ionvel>1 (adding effect of neutral atmos): c (iden must = 1 when ionvel>1. A way around that would be to use c common in proclat, but not doing that now) c if (ifplt(itxui).gt.0.or.ifplt(itxvi).gt.0.or.ifplt(itxwi).gt.0 + .or.(ifplt(itxpot).gt.0.and.ipuv.gt.0)) then if (ionvel.lt.0.or.ionvel.gt.3) then write(6,"('>>> Bad ionvel: must be 1, 2, or 3 for ', + 'ExB, ExB+unvn, or E0xB+unvn')") stop 'ionvel' endif if (ionvel.gt.1) then if (iden.ne.1) then write(6,"(/72('-')/'>>> when requesting ion drifts ', + 'ExB+neutrals (IONVEL=2 or 3), then species must be ', + 'in number density (IDEN=2)')") + write(6,"('Please resubmit with IDEN=2')") write(6,"(72('-')/)") stop 'ionvel' endif ifget(itxu) = 1 ifget(itxv) = 1 ifget(itxw) = 1 ifget(itxo1) = 1 ifget(itxo2) = 1 ifget(itxn2) = 1 if (ionvel.eq.2) then write(flab(itxui),"('UI ExB+UN,VN ')") write(flab(itxvi),"('VI ExB+UN,VN ')") write(flab(itxwi),"('WI ExB+UN,VN ')") else write(flab(itxui),"('UI E0xB+UN,VN ')") write(flab(itxvi),"('VI E0xB+UN,VN ')") write(flab(itxwi),"('WI E0xB+UN,VN ')") endif endif endif c c Max magnitude for vector scaling: if (nuvmax.le.0) uvmax = 0. c c Range of zp for y-axis (pltlon and pltlat): if (nzprange.gt.0.and.nzprange.ne.2) then write(6,"('>>> ZP_RANGE needs two values (got ',i3,')')") + nzprange stop 'zprange' elseif (nzprange.gt.0) then 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 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 else izprange(1) = 0 izprange(2) = 0 endif c c Amplitude and phases: c if (nampha.le.0) iampha = 0 c c 6/25/93: c iwrgrid = 1 -> write ascii file of entire grid for each field c and each history c if (nwrgrid.le.0) iwrgrid = 0 c c iwrascii = 0 -> do not write ascii data file c iwrascii = 1 -> write ascii data file per frame c iwrascii = 2 -> write single ascii data file (append each frame) c dirascii = remote dir for rcp of ascii files c if (nwrascii.le.0) iwrascii = 0 if (ndirdat.gt.0) then if (ndirdat.ne.7) then write(6,"('>>> DIRASCII must be 56 characters: ', + 'ndirdat=',i3)") ndirdat stop 'DIRASCII' endif else call clearstr(dirascii) endif c c dircgm = remote dir for rcp of gmeta c if (ndircgm.gt.0) then if (ndircgm.ne.7) then write(6,"('>>> DIRCGM must be 56 characters: ', + 'ndircgm=',i3)") ndircgm stop 'DIRCGM' endif else call clearstr(dircgm) endif c return end