c c------------------------------------------------------------------ c Begin file /home/sting/foster/tigcm/getinp.f c------------------------------------------------------------------ c subroutine getinp c include 'tgcmparam.h' include 'input.h' include 'tigcm.h' include 'selgrid.h' include 'color.h' data nlat/0/,nlon/0/,npls/0/,nslt/0/ c call lexcon(runlab ,8HLABEL ,nrunlab) call lexcon(idyn ,8HDYN ,ndyn) call lexcon(histvol ,8HHISTVOL ,nhvols) call lexcon(chtms ,8HDDHHMM ,ntms) call lexcon(iyd ,8HIYD ,ndays) call lexcon(iden ,8HIDEN ,niden) call lexcon(log10pl ,8HLOG10PL ,nlog10) call lexcon(iclrfill,8HCOLOR ,nclrfill) call lexcon(iplglb ,8HPLGLB ,nplglb) call lexcon(polperim,8HPOLPERIM,nplpol) call lexcon(iplsatv ,8HPLSATV ,nplsatv) call lexcon(ipllatzp,8HPLLATZP ,npllatzp) call lexcon(ipllatht,8HPLLATHT ,npllatht) call lexcon(ipllonzp,8HPLLONZP ,npllonzp) call lexcon(iplutlat,8HPLUTLAT ,nplutlat) call lexcon(iplutzpm,8HPLUTZPM ,nplutzpm) call lexcon(ipluthtm,8HPLUTHTM ,npluthtm) call lexcon(iplcool ,8HPLCOOL ,nplcool) call lexcon(slon ,8HSLON ,nlon) call lexcon(sslt ,8HSSLT ,nslt) call lexcon(slat ,8HSLAT ,nlat) call lexcon(spls ,8HSPLS ,npls) call lexcon(shts ,8HSHTS ,nhts) call lexcon(htub ,8HHTUB ,nhtub) call lexcon(rloc ,8HLATLON ,nloc) call lexcon(iptigcm ,8HPLTIGCM ,nptigcm) call lexcon(conmins ,8HCONMINS ,nconmins) call lexcon(conmaxs ,8HCONMAXS ,nconmaxs) call lexcon(conints ,8HCONINTS ,nconints) call lexcon(iptiegcm,8HPLTIEGCM,nptiegcm) call lexcon(cmindyn ,8HCMINDYN ,ncmindyn) call lexcon(cmaxdyn ,8HCMAXDYN ,ncmaxdyn) call lexcon(cintdyn ,8HCINTDYN ,ncintdyn) 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 Dynamo case: c if (ndyn.le.0) idyn = 0 C C Iden = 1,2,3 for mass mixing ratios, number densities, or mass densities: C if (niden.le.0) then write(6,"(' >>> getinp: no iden -- will default to iden=2')") iden = 2 endif if (iden.lt.0.or.iden.gt.3) then write(6,"(' >>> getinp: bad iden = ',i5,' -- will to default ', + 'to iden=2')") iden iden = 2 endif c c iclrfill = 1 -> do color fill contours: if (nclrfill.le.0) iclrfill = 0 C C Histvol(s): C if (mod(nhvols,3).ne.0) then write(6,"(' >>> getinp: need 3 names for each histvol: ', + ' nhvols=',i5)") nhvols stop 'histvol' 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 (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 Number of days: c if (ndays.gt.mxdays) then write(6,"('>>> GCMINP: too many days (iyd): ndays=',i3, + ' mxdays=',i3)") ndays,mxdays stop 'ndays' elseif (ndays.le.0) then write(6,"('>>> GCMINP: need at least one day (iyd):', + ' ndays=',i3)") ndays stop 'ndays' endif c c Ut loop: c do 100 it=1,ntms read(chtms(it),"(2(i2,1x),i2)") md(it),mh(it),mm(it) c c Model day 99 flags a search only: if (mh(it).eq.99) then mdut(it) = 99 mhut(it) = 99 mmut(it) = 99 ut(it) = 99. goto 100 endif if (mh(it).lt.0.or.mh(it).gt.23) then write(6,"(' >>> getinp: bad mh(',I2,') = ',I4)") it,mh(it) stop 'mh' endif if (mm(it).lt.0.or.mm(it).gt.59) then write(6,"(' >>> getinp: bad mm(',i2,') = ',i4)") it,mm(it) stop 'mm' endif mdut(it) = md(it) mhut(it) = mh(it) mmut(it) = mm(it) ut(it) = float(mhut(it))+float(mm(it))/60. 100 continue c c Plot flags: c if (nplglb.le.0) iplglb = 0 iplpol = nplpol if (nplsatv.le.0) iplsatv = 0 if (npllatzp.le.0) ipllatzp = 0 if (npllatht.le.0) ipllatht = 0 if (npllonzp.le.0) ipllonzp = 0 if (nplutlat.le.0) iplutlat = 0 if (nplutzpm.le.0) iplutzpm = 0 if (npluthtm.le.0) ipluthtm = 0 if (iplcool.le.0) iplcool = 0 if (nlog10.le.0) log10pl = 0 if (nptigcm.ne.ntigcmf) then write(6,"('>>> Getinp: need ',i3,' values for PLTIGCM')") + ntigcmf stop 'ntigcmf' endif if (idyn.gt.0.and.nptiegcm.ne.ntiegcmf) then write(6,"('>>> Getinp warning: got only ',i3, + ' values for PLTIEGCM -- expected ',i3)") + nptiegcm,ntiegcmf do i=nptiegcm,ntiegcmf iptiegcm(i) = 0 enddo endif c c Selected grid: c call selgrid(slat,islat,nlat,slon,islon,nlon,spls,ispls,npls) if (nhts.gt.mxhts) then write(6,"('>>> getinp: nhts > mxhts: nhts mxhts=',2i4, + /,' will use only the first ',i2,' heights')") + nhts,mxhts,mxhts nhts = mxhts endif c write(6,"('getinp: nslt=',i3,' sslt=',5f10.3)") nslt, c + (sslt(i),i=1,nslt) c c Location lat/lon for center of sat view projections: c if (iplsatv.gt.0) then if (nloc.le.0) then write(6,"('>>> GETINP: need lat/lons for center', + ' of sat view projection: nloc=',i3, + /' -- will default to lat 67.5 and local noon lon')") + nloc nloc = 1 rloc(1,1) = 67.5 rloc(2,1) = r12flag ! flag for local noon longitude endif if (mod(nloc,2).ne.0) then write(6,"('>>> GETINP: need lat/lon for each sat view ', + 'location: nloc=',i3)") nloc stop 'nloc' endif nloc = nloc/2 c c Find nearest tgcm grid points at each location: c (index to noon lon will be recalculated in pltsatv, when c ut is known) c do 25 l=1,nloc ixloc(1,l) = ixlat(rloc(1,l)) ixloc(2,l) = ixlon(rloc(2,l)) 25 continue write(6,"(' ')") write(6,"('For sat view: ', + 'The following locations will be used:')") do 30 l=1,nloc if (rloc(2,l).eq.r12flag) then write(6,"(' Loc ',i2,': lat/lon=',f8.2, + ' (local noon longitude) indices=',2i4)") + l,rloc(1,l),(ixloc(i,l),i=1,2) else write(6,"(' Loc ',i2,': lat/lon=',2f8.2,' indices=',2i4)") + l,(rloc(i,l),i=1,2),(ixloc(i,l),i=1,2) endif 30 continue endif c c Contour intervals: if (nconints.le.0) then do 40 ip=1,ntigcmf 40 conints(ip) = 0. elseif (nconints.ne.ntigcmf) then write(6,"('>>> Need ',i3,' contour intervals (CONINTS),' + ' or none: got ',i3,' -- will let conpack choose intervals')") + ntigcmf,nconints do 41 ip=1,ntigcmf 41 conints(ip) = 0. endif if (ncintdyn.le.0) then do 42 ip=1,ntiegcmf 42 cintdyn(ip) = 0. elseif (ncintdyn.ne.ntiegcmf) then write(6,"('>>> Need ',i3,' dyn contour intervals (CINTDYN),' + ' or none: got ',i3,' -- will let conpack choose intervals')") + ntiegcmf,ncintdyn do 43 ip=1,ntiegcmf 43 cintdyn(ip) = 0. endif c c Contour minimums: if (nconmins.le.0) then do 55 ip=1,ntigcmf 55 conmins(ip) = 1. elseif (nconmins.ne.ntigcmf) then write(6,"('>>> Need ',i3,' contour minimums (CONMINS),' + ' or none: got ',i3,' -- will let conpack choose ', + 'contour levels')") ntigcmf,nconmins do 51 ip=1,ntigcmf 51 conmins(ip) = 1. endif if (ncmindyn.le.0) then do 56 ip=1,ntiegcmf 56 cmindyn(ip) = 1. elseif (ncmindyn.ne.ntiegcmf) then write(6,"('>>> Need ',i3,' dyn contour minimums (CMINDYN),' + ' or none: got ',i3,' -- will let conpack choose ', + 'contour levels')") ntiegcmf,ncmindyn do 57 ip=1,ntiegcmf 57 cmindyn(ip) = 1. endif c c Contour maximums: if (nconmins.le.0) then do 65 ip=1,ntigcmf 65 conmaxs(ip) = 0. elseif (nconmaxs.ne.ntigcmf) then write(6,"('>>> Need ',i3,' contour maximums (CONMAXS),' + ' or none: got ',i3,' -- will let conpack choose ', + 'contour levels')") ntigcmf,nconmaxs do 61 ip=1,ntigcmf 61 conmaxs(ip) = 0. endif if (ncmaxdyn.le.0) then do 66 ip=1,ntiegcmf 66 cmaxdyn(ip) = 0. elseif (ncmaxdyn.ne.ntiegcmf) then write(6,"('>>> Need ',i3,' dyn contour maximums (CMAXDYN),' + ' or none: got ',i3,' -- will let conpack choose ', + 'contour levels')") ntiegcmf,ncmaxdyn do 62 ip=1,ntiegcmf 62 cmaxdyn(ip) = 0. endif c c Linear height scale: htub is upper boundary of height scale, and c must be a multiple of 100. c Bottom boundary is fixed at 100. and number of heights is fixed at 21 c Default is 100->500 by 20.(dht) This is htub=500. c A different htub will change dht (interval between each height): c When htub=200 -> dht=5, when htub=300, dht=10, ... c if (nhtub.gt.0) then if (mod(ifix(htub),100).ne.0) then write(6,"('getinp: upper boundary for linear height scale', + ' must be multiple of 100: htub=',f9.3,' will default to', + ' 500 km')") htub htub = 500. endif dht = (htub-ht1) / float(nhtscale-1) c write(6,"('getinp: htub=',e12.6,' dht=',e12.6)") htub,dht endif c return end