cdeck homer1
      subroutine homer1 (rtemp,ltemp)
      character*8 temp(1000)
c
c   homer1 processes the argument list, gets variable labels, and
c      gets value labels for age and sex variables.
c
      include 'maincomo.for'
      include 'homerc.for'
c   l o c a l   v a r i a b l e s
c
c   use chars common to get character definitions
c
      character*8 blank, comma, equal
      integer nkeys
      parameter (nkeys=26)
      character*8 keywrd(nkeys)
      integer iw, nw, i
      character*60 n
      logical   qerr, qnumbr
      double precision atof
      data equal /'='/, comma /','/, blank /' '/
c
c   check that the number of subfiles is not greater than
c   the dimensions in common block biochkc
c
      data keywrd /'xcoor','ycoor','time','age','sex','id',
     1 'map','mapscale',
     2 'remove','xorigin','yorigin','square','grids','vectime',
     3 'grid','vecdist','fill','maxanim','maxcases','dunntime',
     4 'residual','likeliho','diagnost','dunn','lotus','random'/
c
      if (nsmax.gt.200) go to 640
c
c   set default parameter values
c
      do 10 i=1,6
   10 varnum(i)=0
      do 20 i=1,nsmax
      xco(i)=-r1mach(2)
      yco(i)=-r1mach(2)
      siz(i)=0.
      nint(i)=0
      time(i)=0.
      ndon(i)=0
      tobig(i)=0.
      duntim(i)=0.
   20 continue
      qoptsr(2)=.false.
      do 30 i=6,13
   30 qoptsr(i)=.false.
      map=0
      irem=0
      nsum=0
      dunprt=-1
      maxaim=nsmax
      maxcase=500
c
c   print out simple menu on error output unit
c
      io=i1mach(4)
      write(io,*)
     1   'xcoor=x_UTM_field ycoor=y_UTM_field time=date_time_field'
      write(io,*)  '[map=[fill|both]] [mapscale] [remove]'
      write(io,*)  '[xorigin=lower_left_map_x_coor]'
      write(io,*)  '[yorigin=lower_left_map_y_coor]'
      write(io,*)  '[square=map_grid_size [mile|km|m|feet]]'
      write(io,*)  '[grids=#_map_squares_per_side]'
      write(io,*)
     1   '[vectime=fill_times [day|days|hour|hours|minute|minutes]]'
      write(io,*)  '[vecdist=fill_distance [mile|km|m|feet]]'
      write(io,*)  '[fill=#_squares_hole_fill]'
      write(io,*) '[dunntime=constant_time_interval',
     1   '[day|days|hour|hours|minute|minutes]]'
      write(io,*)  '[dunn] [residual] [likelihood] [diagnostic]'
      write(io,*)  '[maxanim=max_#_anim] [maxcases=max_#_cases]'
      write(io,*)  '[random (time series test)]'
      write(io,*)  '[lotus [ ( all jt jennrich polygon dunn grid grids '
     1           //'unique data ) ]]'
      write(io,*)  'The above generate files for input to LOTUS 1-2-3'
     1           //' for plotting.'
      write(io,*)  'WARNING -- This code needs further debugging!'
c
c   pick up argument list
c
c     nw1=ltemp-5
      nw1=1000
      call stack (temp,nw1,nw)
      iw=0
c
c   process options + statistics card
c
      call statop
c
      if (qoptsr(5)) then
         do 40 i=1,nsmax
   40       nint(i)=100
      endif
c   list argument list on iolp for debugging
c
c     write (unit=iolp,fmt=401) (i,temp(i),i=1,nw)
c 401 format (5(1x,i3,2h,',a8,1h'))
c
c   interpret procedure call card
c
c   first make sure a comma terminates the list
c
      if (temp(nw).eq.comma) go to 60
      nw=nw+1
      temp(nw)=comma
      go to 60
   50 if (temp(iw).ne.comma) iw=iw-1
   60 iw=iw+3
      if (iw-2.gt.nw) go to 550
      do 70 i=1,nkeys
      if (temp(iw-2).eq.keywrd(i)) go to (80,80,80,80,80,80,90,110,120,
     1 130,170,210,250,290,250,330,370,410,420,430,470,480,
     2 490,500,510,515), i
   70 continue
      write (unit=io,fmt=680) temp(iw-2)
      call linect (1)
      go to 600
   80 varnum(i)=atof(temp(iw))
c   set up formats to read data in observ
      if (i.le.3) then
         vfmt(varnum(i))=0
      else
         vfmt(varnum(i))=10
      endif
      varnam(varnum(i))=keywrd(i)
      iw=iw+1
      go to 50
c
c   map
c
   90 nsum=1
      qoptsr(2)=.true.
      if (temp(iw-1).ne.equal) then
         iw=iw-1
         go to 50
      else if (temp(iw).eq.'fill') then
         nsum=2
      else if (temp(iw).eq.'both') then
         nsum=3
      endif
      iw=iw+1
      go to 50
c
c   mapscale
  110 nomap=1
      qoptsr(2)=.true.
      iw=iw-1
      go to 50
c
c   remove
c
  120 irem=1
      qoptsr(2)=.true.
      iw=iw-1
      go to 50
c
c   xorigin
c
  130 qoptsr(2)=.true.
      do 140 i=1,nsmax
      xco(i)=atof(temp(iw))
      iw=iw+1
      if (temp(iw).eq.comma) iw=iw+1
      if (.not.qnumbr(temp(iw))) go to 150
  140 continue
      go to 50
  150 do 160 j=i,nsmax
  160 xco(j)=xco(i)
      go to 50
c
c   yorigin
c
  170 qoptsr(2)=.true.
      do 180 i=1,nsmax
      yco(i)=atof(temp(iw))
      iw=iw+1
      if (temp(iw).eq.comma) iw=iw+1
      if (.not.qnumbr(temp(iw))) go to 190
  180 continue
      go to 50
  190 do 200 j=i,nsmax
  200 yco(j)=yco(i)
      go to 50
c
c   square
c
  210 qoptsr(2)=.true.
      do 220 i=1,nsmax
      siz(i)=atof(temp(iw))
      iw=iw+1
      if (temp(iw).eq.comma) then
         go to 230
      elseif (temp(iw).eq.'mile'.or.temp(iw).eq.'miles') then
         siz(i)=siz(i)*1609.344
         iw=iw+1
      elseif (temp(iw).eq.'km') then
         siz(i)=siz(i)*1000.
         iw=iw+1
      elseif (temp(iw).eq.'m') then
         iw=iw+1
      elseif (temp(iw).eq.'feet') then
         siz(i)=siz(i)*0.3048
         iw=iw+1
      endif
      if (temp(iw).eq.comma .or. .not.qnumbr(temp(iw))) go to 230
  220 continue
      go to 50
  230 do 240 j=i,nsmax
  240 siz(j)=siz(i)
      go to 50
c
c   grids
c
  250 qoptsr(2)=.true.
      do 260 i=1,nsmax
      nint(i)=int(atof(temp(iw)))
      iw=iw+1
      if (temp(iw).eq.comma) iw=iw+1
      if (.not. qnumbr(temp(iw))) go to 270
  260 continue
      go to 50
  270 do 280 j=i,nsmax
  280 nint(j)=nint(i)
      go to 50
c
c   vectime
c
  290 qoptsr(2)=.true.
      do 300 i=1,nsmax
      time(i)=atof(temp(iw))
      iw=iw+1
      if (temp(iw).eq.comma) go to 310
      if (temp(iw).eq.'minute'.or.temp(iw).eq.'minutes') then
         time(i)=time(i)/(24.*60.)
         iw=iw+1
      elseif (temp(iw).eq.'hour'.or.temp(iw).eq.'hours') then
         time(i)=time(i)/24.
         iw=iw+1
      elseif (temp(iw).eq.'day'.or.temp(iw).eq.'days') then
         iw=iw+1
      endif
      if (temp(iw).eq.comma .or. .not.qnumbr(temp(iw))) go to 310
  300 continue
      go to 50
  310 do 320 j=i,nsmax
  320 time(j)=time(i)
      go to 50
c
c   vecdist
c
  330 qoptsr(2)=.true.
      do 340 i=1,nsmax
      tobig(i)=atof(temp(iw))
      iw=iw+1
      if (temp(iw).eq.comma) then
         go to 350
      elseif (temp(iw).eq.'mile'.or.temp(iw).eq.'miles') then
         tobig(i)=tobig(i)*1.609344
         iw=iw+1
      elseif (temp(iw).eq.'km') then
         tobig(i)=tobig(i)*1000.
         iw=iw+1
      elseif (temp(iw).eq.'feet') then
         tobig(i)=tobig(i)*0.3048
         iw=iw+1
      elseif (temp(iw).eq.'m') then
         iw=iw+1
      endif
      if (temp(iw).eq.comma .or. .not.qnumbr(temp(iw))) go to 350
  340 continue
      go to 50
  350 do 360 j=i,nsmax
  360 tobig(j)=tobig(i)
      go to 50
c
c   fill
c
  370 qoptsr(2)=.true.
      do 380 i=1,nsmax
      ndon(i)=int(atof(temp(iw)))
      iw=iw+1
      if (temp(iw).eq.comma .or. .not.qnumbr(temp(iw))) go to 390
  380 continue
      go to 50
  390 do 400 j=i,nsmax
  400 ndon(j)=ndon(i)
      go to 50
  410 maxaim=int(atof(temp(iw)))
      iw=iw+1
      go to 50
  420 maxcase=int(atof(temp(iw)))
      iw=iw+1
      go to 50
c
c   dunntime
c
  430 qoptsr(6)=.true.
      do 440 i=1,nsmax
      duntim(i)=atof(temp(iw))
      if (duntim(i).le.0.) go to 650
      iw=iw+1
      if (temp(iw).eq.comma) go to 450
      if (temp(iw).eq.'minute'.or.temp(iw).eq.'minutes') then
         duntim(i)=duntim(i)/(24.*60.)
         iw=iw+1
      elseif (temp(iw).eq.'hour'.or.temp(iw).eq.'hours') then
         duntim(i)=duntim(i)/24.
         iw=iw+1
      elseif (temp(iw).eq.'day'.or.temp(iw).eq.'days') then
         iw=iw+1
      endif
      if (temp(iw).eq.comma .or. .not.qnumbr(temp(iw))) go to 450
  440 continue
      go to 50
  450 do 460 j=i,nsmax
  460 duntim(j)=duntim(i)
      go to 50
c
c   residual
c
  470 if (dunprt.eq.2) then
         dunprt=3
      else
         dunprt=1
      endif
      iw=iw-1
      qoptsr(6)=.true.
      go to 50
c
c   likelihood
c
  480 if (dunprt.eq.1) then
         dunprt=3
      else
         dunprt=2
      endif
      iw=iw-1
      if (temp(iw).eq.'od') iw=iw+1
      qoptsr(6)=.true.
      go to 50
c
c   diagnostic
c
  490 dunprt=4
      iw=iw-1
      if (temp(iw).eq.'ic') iw=iw+1
      qoptsr(6)=.true.
      go to 50
c
c   dunn
c
  500 dunprt=0
      iw=iw-1
      qoptsr(6)=.true.
      go to 50
c
c   lotus
c
  510 if (temp(iw-1).eq.comma) then
         do 520 i=7,11
  520    qoptsr(i)=.true.
         qoptsr(13)=.true.
         iw=iw-1
         go to 50
      elseif (temp(iw-1).eq.equal.or.temp(iw-1).eq.'(') then
         go to 530
      endif
      go to 660
  530 if (temp(iw).eq.comma) then
         go to 50
      elseif (temp(iw).eq.'all') then
         do 540 i=7,11
  540    qoptsr(i)=.true.
         qoptsr(13)=.true.
      elseif (temp(iw).eq.'grid'.or.temp(iw).eq.'grids') then
         qoptsr(7)=.true.
      elseif (temp(iw).eq.'polygon') then
         qoptsr(8)=.true.
      elseif (temp(iw).eq.'jt'.or.temp(iw).eq.'jennrich') then
         qoptsr(9)=.true.
      elseif (temp(iw).eq.'unique') then
         qoptsr(10)=.true.
      elseif (temp(iw).eq.'dunn') then
         qoptsr(11)=.true.
      elseif (temp(iw).eq.'data') then
         qoptsr(13)=.true.
      elseif (temp(iw).eq.')') then
      else
         go to 660
      endif
      iw=iw+1
      go to 530
c
c   randomization test for time series effects
c
 515  qoptsr(12)=.true.
      iw=iw-1
      go to 50
c
c   take care of some clean-up
c
c   get variable labels
c
  550 do 570 i=1,3
      do 560 j=1,5
  560 varlab(j,i)=blank
      if (varnum(i).eq.0) go to 570
c     if (lblpnt(3,varnum(i)).eq.0) go to 570
c     call point2 (lblpnt(3,varnum(i)))
c     call read2 (varlab(1,i))
  570 continue
c
c   options fixes
c
      if (qoptsr(2).and.(xco(1).eq.-9.99999e29.or.yco(1).eq.-9.99999e29)
     1 ) qoptsr(5)=.true.
c
c   error checking section
c
      do 580 i=1,3
      if (varnum(i).eq.0) go to 630
      do 580 j=i+1,3
      if (varnum(i).eq.varnum(j)) go to 635
  580 continue
      return
c
c   error return section
c
c   comma expected but not found
c
  590 n='comma expected but not found'
      go to 670
c
c   unrecognized parameter specified
c
  600 n='unrecognized parameter specified'
      go to 670
c
c   unrecognized variable specified
c
  610 n='unrecognized field specified'
      go to 670
c
c   more than one variable specified in parameter specification
c
  620 n='more than one field in parameter specification'
      go to 670
c
c   xcoor, ycoor, or time specification missing
c
  630 n='xcoor, ycoor, or time field missing'
      go to 670
c
c   xcoor, ycoor, or time fields the same
c
 635  n='xcoor, ycoor, or time fields specified the same'
      go to 670
c
c   number of subfiles exceeds dimensions
c
  640 n='number of subfiles exceeds dimensions'
      go to 670
c
c   dunntime parameter incorrect (< 0.)
c
  650 n='dunntime parameter incorrect (<0.)'
      go to 670
c
c   error in processing lotus specification
c
  660 n='error in processing lotus specification'
      go to 670
  670 call error (n)
      return
c
  680 format ('0','incorrect keyword ',a8)
      end