subroutine getopt include 'screen.inc' integer*2 irowt,nlines,iopt real w logical yesno external yesno c c define option names c optstr(1)='HELP' optstr(2)='GRPD' optstr(3)='DEFT' optstr(4)='DESC' optstr(5)='PEST' optstr(6)='SEST' optstr(7)='CUTP' optstr(8)='NPOL' c 15 do 5 i=1,maxopt 5 option(i)=0 w=0. call cls c c get data analysis options c irow=1 icol=15 line='Select from the following data analysis and input options' call scrlin irow=irow+1 line='by moving the cursor with the up and down arrow keys, and' call scrlin irow=irow+1 line='hitting a carriage return to select a particular option,' call scrlin irow=irow+1 line='or to un-select an option already selected.' call scrlin irow=irow+2 irowt=irow icol=10 line='HELP - provide explanatory material in output.' call scrlin irow=irow+1 line=' Good to use on initial runs.' call scrlin irow=irow+1 line='GRPD - data have been grouped into intervals '// 1 'for entry to program.' call scrlin irow=irow+1 line=' Default is ungrouped data. '// 1 'Only used for perp. distances.' call scrlin irow=irow+1 line='DEFT - Use default data analysis options.' call scrlin irow=irow+1 line=' Program will use Fourier estimator and 3 '// 1 'sets of cut points.' call scrlin irow=irow+1 line='DESC - Provide descriptive output where available.' call scrlin irow=irow+1 line=' Only applies to perpendicular distance analyses.' call scrlin irow=irow+1 line='PEST - Perform perpendicular distance estimation' call scrlin irow=irow+2 line='SEST - Perform sighting distance and angles estimation' call scrlin irow=irow+1 line=' using the Hayne estimators.' call scrlin irow=irow+1 line='CUTP - Cut points for histograms of perpendicular distances' call scrlin irow=irow+1 line=' of ungrouped data will be entered by user.' call scrlin irow=irow+1 line='NPOL - Perform separate density estimate for each' call scrlin irow=irow+1 line=' replicate line, i.e., no pooling of lines.' call scrlin irow=irow+1 line='FINISHED selecting options, and ready to proceed.' call scrlin irow=irow+1 line='(Don''t hit Enter here until '// 1 'satisfied with above selections' call scrlin icol=9 call putcur(irowt,icol,ivpage,ierror) nlines=16 60 call inkey(line,keycde,nchar) if (keycde.eq.0) then continue c up arrow else if (keycde.eq.72) then call getcur(ivpage,irow,icol,ierror) irow=irow-2 if (irow.lt.irowt) irow=irowt+nlines call putcur(irow,icol,ivpage,ierror) c down arrow else if (keycde.eq.80) then call getcur(ivpage,irow,icol,ierror) irow=irow+2 if (irow.gt.irowt+nlines) irow=irowt call putcur(irow,icol,ivpage,ierror) c carriage return, meaning this area is selected. else if (keycde.eq.28) then call getcur(ivpage,irow,icol,ierror) iopt=(irow-irowt)/2+1 if (iopt.lt.9) then option(iopt)=1-option(iopt) if (option(iopt).eq.1) then line='Selected ' line(9:9)=char(26) else line=' ' endif call putcur(irow,1,ivpage,ierror) call wchars(ivpage,line,9,icolor,ibckgd,1,ierror) c check for errors in options ierrow=irowt+nlines+2 call scroll(1,0,ierrow,1,25,80,7,ierror) if (option(6)*option(2).eq.1) then call putcur(ierrow,1,ivpage,ierror) line=' ERROR - '// 1 'Cannot specify grouped data for sighting distance data.' call wchars(ivpage,line,70,icolor,ibckgd,1,ierror) ierrow=ierrow+1 endif if (option(4)*option(2).eq.1) then call putcur(ierrow,1,ivpage,ierror) line=' ERROR - '// 1 'Cannot have descriptive output for grouped data.' call wchars(ivpage,line,70,icolor,ibckgd,1,ierror) ierrow=ierrow+1 endif if ((option(7)*option(2)).eq.1 .and. ierrow.le.25) then call putcur(ierrow,1,ivpage,ierror) line=' ERRROR - '// 1 'Cannot have cutpoints specified for grouped data.' call wchars(ivpage,line,70,icolor,ibckgd,1,ierror) ierrow=ierrow+1 endif if ((option(3)*(option(4)+option(5) 1 +option(6)+option(7))).gt.0 .and. ierrow.le.25) then call putcur(ierrow,1,ivpage,ierror) line=' ERRROR - '// 1 'Cannot have DEFT with any of DESC, PEST, SEST, or CUTP.' call wchars(ivpage,line,70,icolor,ibckgd,1,ierror) ierrow=ierrow+1 endif call putcur(irow,icol,ivpage,ierror) else c come here when satisfied with options specified. go to 70 endif endif go to 60 70 nlines=0 do 75 iopt=1,maxopt 75 nlines=nlines+option(iopt) if (nlines.eq.0 .or. nlines.gt.8) then call putcur(25,1,ivpage,ierror) line='No options were specified. Re-do input.'// 1 ' Press any key to continue.' call wchars(ivpage,line,70,icolor,ibckgd,1,ierror) 76 call inkey(line,keycde,nchar) if (keycde.eq.0) go to 76 go to 15 endif irow=1 icol=15 call cls line='Options specified are:' call scrlin icol=20 do 80 i=1,maxopt if (option(i).eq.1) then irow=irow+1 call putcur(irow,icol,ivpage,ierror) call wchars(ivpage,optstr(i),4,icolor,ibckgd,0,ierror) endif 80 continue irow=irow+2 icol=5 line='Are these options OK and ready to proceed?' if (yesno(0)) then go to 30 else go to 15 endif 30 call scroll(1,0,irow,1,irow+3,80,7,ierror) line='Input data are assumed to be untruncated, i.e., the' call scrlin irow=irow+1 line='strip width W is assumed equal to infinity.' call scrlin irow=irow+1 line='Do you want to specify a truncation distance (strip width)?' if (yesno(1)) then 115 irow=irow+3 call scroll(1,0,irow,1,irow,80,7,ierror) 117 call putcur(irow,icol,ivpage,ierror) line='Enter strip width in '//disunt(1:ndisut)//': ' nchar=index(line,': ')+1 call scrlin call getbuf(line,nchar,15,iatt) w=0. read(line,'(f15.0)',err=116) w 116 if (w.le.0) then call putcur(irow+1,icol,ivpage,ierror) line='Incorrect strip width entered. Re-enter.' call wchars(ivpage,line,41,icolor,ibckgd,0,ierror) go to 117 endif if (pntran) then w=w*w*pi endif endif line=' ' line(1:1)='*' iopt=2 do 140 i=1,maxopt if (option(i).eq.1) then line(iopt:iopt+3)=optstr(i) iopt=iopt+4 line(iopt:iopt)=',' iopt=iopt+1 endif 140 continue iopt=iopt-1 line(iopt:iopt)='*' if (w.eq.0.) then write(unit=iout,fmt='(a)') line(1:iopt) else write(unit=iout,fmt='(a,g11.5)') line(1:iopt),w endif return end