--------------- button.F ------------------------
#include "include/port.h"
C=======================================================================
C=======================================================================
	subroutine rabutton(itype)
c       rearrange the nature of the button menu
c       this can include changing the position where it is displayed
c       this can include changing the contents which are (not) displayed
	IMPLICIT_NONE
C       Parameters
#       include "echelle.par"
C       External Variable
c                       type of rearrangement of the menu
	integer         itype
C       Common Block
	include 'button.inc'
C       Executable Code
c       always put the menu down before rearranging
	if (bdataup) call dnbutton
c       reset the Y limits of the menu
	bminndc = 0.78
	bmaxndc = 0.99
c       this displays the entire menu all the time
c       bdatap(MINBDATA +  0) = i_bmenus
	bdatap(MINBDATA +  0) = i_optics
	bdatap(MINBDATA +  1) = i_allset
	bdatap(MINBDATA +  2) = i_dewar
	bdatap(MINBDATA +  3) = i_refresh
	bdatap(MINBDATA +  4) = i_zoom
	bdatap(MINBDATA +  5) = i_displam
	bdatap(MINBDATA +  6) = i_dispord
	bdatap(MINBDATA +  7) = i_markdet
	bdatap(MINBDATA +  8) = i_kicsset
	bdatap(MINBDATA +  9) = i_linepos
	bdatap(MINBDATA + 10) = i_quit2com
	botbdata = MINBDATA + 10
	return
	end
C=======================================================================
C=======================================================================
--------------- cdata.F ------------------------
#include "include/port.h"
C=======================================================================
C=======================================================================
	subroutine racdata(itype)
c       rearrange the nature of the cdata menu
c       this can include changing the position where it is displayed
c       this can include changing the contents which are (not) displayed
	IMPLICIT_NONE
C       Parameters
#       include "echelle.par"
C       External Variable
c                       type of rearrangement of the menu
	integer         itype
C       Common Block
	include 'cdata.inc'
C       Executable Code
c       always put the menu down before rearranging
	if (cdataup) call dncdata
c       reset the Y limits of the menu
	cminndc = 0.05
	cmaxndc = 0.40
c       this displays the entire menu all the time
	cdatap(MINCDATA +  0) = i_curspsn
	cdatap(MINCDATA +  1) = i_clambda
	cdatap(MINCDATA +  2) = i_corder
	cdatap(MINCDATA +  3) = i_clambdab
	cdatap(MINCDATA +  4) = i_dispapx
	cdatap(MINCDATA +  5) = i_dispamm
	cdatap(MINCDATA +  6) = i_cseps
	cdatap(MINCDATA +  7) = i_csepp
	cdatap(MINCDATA +  8) = i_cloc
	cdatap(MINCDATA +  9) = i_clen
	cdatap(MINCDATA + 10) = i_idet
	cdatap(MINCDATA + 11) = i_dpx
	cdatap(MINCDATA + 12) = i_dpy
	cdatap(MINCDATA + 13) = i_cdkpix
	botcdata = MINCDATA + 13
	return
	end
C=======================================================================
C=======================================================================
--------------- detector.F ------------------------
#include "include/port.h"
C==============================================================================
C==============================================================================
	subroutine pixpos(imos,idet,cx,ry,ex,ey)
c       determine the position of a pixel measured in the echelle format coords
	IMPLICIT_NONE
#       include "echelle.par"
#       include "include/units.par"
c       External Variables
c                       which of the stored mosaic positions is this?
	integer         imos
c                       which of the detectors in the mosaic is this?
	integer         idet
c                       row and column number of the pixel on the detector
	real            ry, cx
c                       position of this pixel on the echelle format [mm]
	real            ex, ey
c       Internal Variables
c                       position of this pixel on the detector mosaic [m]
	real            mx, my
C       Common Block
	include 'detmos.inc'
	include 'setup.inc'
C       Executable code
c       first convert from pixel coords to detector mosaic coords
c       write(STDERR,*) 'cx, ry', cx, ry
c       write(STDERR,*) 'pixpos,posmos',imos,posmos(xp,imos),posmos(yp,imos)
c       mx = tmc(Xp,Xo,C2M,idet) * cx + tmc(Xp,Yo,C2M,idet) * ry +
c    &  tmc(Xp,To,C2M,idet)
c       my = tmc(Yp,Xo,C2M,idet) * cx + tmc(Yp,Yo,C2M,idet) * ry +
c    &  tmc(Yp,To,C2M,idet)
	mx = cx
	my = ry
	call translate(mx, my, tmc(Xp,Xo,C2M,idet), 1)
c       write(STDERR,*) 'mx, my', mx, my
c       then convert from detector mosaic coords to display coords
	ex = (tmd(Xp,Xo,M2D) * mx + tmd(Xp,Yo,M2D) * my) * mmPERm +
     &  posmos(Xp,imos)
	ey = (tmd(Yp,Xo,M2D) * mx + tmd(Yp,Yo,M2D) * my) * mmPERm +
     &  posmos(Yp,imos)
c       write(STDERR,*) 'ex, ey', ex, ey
	return
	end
C==============================================================================
C==============================================================================
	subroutine mosize()
c       Calculate the size of a rectangle completely enclosing the mosaic
c       These coordinates are in the coordinate system of the echelle
c       focal plane.
c       This defines the contents of the cormos array
c       cormos(Xp,0) is the X location of the geographic center of the mosaic
c       cormos(Yp,0) is the Y location of the geographic center of the mosaic
c       cormos(Xp,1) is the X location of the leftmost    pixel in the mosaic
c       cormos(Yp,1) is the Y location of the bottommost  pixel in the mosaic
c       cormos(Xp,2) is the X location of the rightmost   pixel in the mosaic
c       cormos(Yp,2) is the Y location of the topmost     pixel in the mosaic
c       As the cormos positions are computed using subroutine pixpos,
c       all cormos entries have the dimension [mm].
	IMPLICIT_NONE
#       include "echelle.par"
#       include "include/units.par"
C       External Variables
C       Internal Variables
	real            px, py
	integer         i
C       Common Blocks
	include 'detmos.inc'
	include 'setup.inc'
C       Executable Code
	posmos(Xp,0) = 0.
	posmos(Yp,0) = 0.
	call distran
	call pixpos(0,1,0.,0.,px,py)
	cormos(Yp,1) = py
	cormos(Yp,2) = py
	cormos(Xp,1) = px
	cormos(Xp,2) = px
	do 10 i = 1,nchips
	  call pixpos(0,i,0.,0.,px,py)
	  cormos(Yp,1) = min(cormos(Yp,1),py)
	  cormos(Yp,2) = max(cormos(Yp,2),py)
	  cormos(Xp,1) = min(cormos(Xp,1),px)
	  cormos(Xp,2) = max(cormos(Xp,2),px)
	  call pixpos(0,i,npix(i,Xp)+1.,npix(i,Yp)+1.,px,py)
	  cormos(Yp,1) = min(cormos(Yp,1),py)
	  cormos(Yp,2) = max(cormos(Yp,2),py)
	  cormos(Xp,1) = min(cormos(Xp,1),px)
	  cormos(Xp,2) = max(cormos(Xp,2),px)
	  call pixpos(0,i,npix(i,Xp)+1.,0.,px,py)
	  cormos(Yp,1) = min(cormos(Yp,1),py)
	  cormos(Yp,2) = max(cormos(Yp,2),py)
	  cormos(Xp,1) = min(cormos(Xp,1),px)
	  cormos(Xp,2) = max(cormos(Xp,2),px)
	  call pixpos(0,i,0.,npix(i,Yp)+1.,px,py)
	  cormos(Yp,1) = min(cormos(Yp,1),py)
	  cormos(Yp,2) = max(cormos(Yp,2),py)
	  cormos(Xp,1) = min(cormos(Xp,1),px)
	  cormos(Xp,2) = max(cormos(Xp,2),px)
10      continue
c       find the central location of the mosaic
	cormos(Xp,0) = 0.5 * (cormos(Xp,1) + cormos(Xp,2))
	cormos(Yp,0) = 0.5 * (cormos(Yp,1) + cormos(Yp,2))
c       move this mosaic completely out of the picture
	posmos(Xp,0) = 1.e9
	posmos(Yp,0) = 1.e9
	return
	end
C==============================================================================
C==============================================================================
--------------- detmos.F ------------------------
#include "include/port.h"
C=======================================================================
C=======================================================================
	subroutine radetmos(itype)
c       rearrange the nature of the detmos menu
c       this can include changing the position where it is displayed
c       this can include changing the contents which are (not) displayed
	IMPLICIT_NONE
C       Parameters
#       include "echelle.par"
C       External Variable
c                       type of rearrangement of the menu
	integer         itype
C       Common Block
	include 'detmos.inc'
C       Executable Code
c       always put the menu down before rearranging
	if (ddataup) call dndetmos
c       reset the Y limits of the menu
	dminndc = 0.05
	dmaxndc = 0.40
c       this displays the entire menu all the time
	ddatap(MINDDATA +  0) = i_DETECTOR
	ddatap(MINDDATA +  1) = i_NCHIPS
	ddatap(MINDDATA +  2) = i_NBSPOT
	ddatap(MINDDATA +  3) = i_PIXXSIZ0
	ddatap(MINDDATA +  4) = i_PIXYSIZ0
	ddatap(MINDDATA +  5) = i_CHIPID1
	ddatap(MINDDATA +  6) = i_NPIXX0
	ddatap(MINDDATA +  7) = i_NPIXY0
	botddata = MINDDATA + 7
	return
	end
C=======================================================================
C=======================================================================
--------------- echelle.F ------------------------
#include "include/port.h"
C==============================================================================
C==============================================================================
	program echellemain
c       (from dan schroeder, april 85)
c       (revised for vms vax by c. pilachowski, april 85)
c       (prism cross dispersion added sept. 85)
c       (original Lick Mongo implementation by A.P. Hatzes)
c       (further work by S.L. Allen for Keck HIRES)
c
c       this program gives the format of an echellogram with a
c       grating or prism cross dispersion over a user-specified
c       range of wavelengths.  input required included telescope
c       and collimator diameters, camera focal length, echelle
c       grating parameters, wavelength range, cross-disperser
c       type, cross disperser grating order and number of
c       grooves/mm or prism glass type, angle, and number of prisms.
c
c       grating parameters can be iterated until a final solution,
c       which is written out to a file called format.out.
c
c       a subroutine of glass types and parameters for the index of
c       refraction as in the Schott glass catalog is required.
c       the subroutine is the file glass.for, which should be
c       linked with this program.
	IMPLICIT_NONE
C       Parameters      ------------------------------------------------
#       include "echelle.par"
#       include "include/stdio.par"
#       include "include/units.par"
c                       Lick Mongo LVISIBILITY mode
	integer         INVERT
	parameter       (INVERT = 2)
C       Local Variables ------------------------------------------------
c                       loop
	integer         i
c                       a file containing detector or spectrograph description
	character       setfilnm*(MXPATH)
c                       prompt information for the user
	character*72    prompts(7)
C       External Functions----------------------------------------------
	integer         keymouse
	integer         comloop
	integer         readmen
	integer         readspc, readdet, readset
	integer         writspc, writdet, writset, wkics
	integer         PMGO(lenc)
C       Common Blocks   ------------------------------------------------
	include 'wizard.cmn'
	include 'spgraf.inc'
	include 'setup.inc'
	include 'schott.cmn'
	include 'echord.cmn'
	include 'cdata.inc'
	include 'lims.cmn'
	include 'linpos.cmn'
	include 'lam.cmn'
	include 'detmos.inc'
C       Data initialization---------------------------------------------
	data    nlam    /0/
	data    wizard  /.false./
	data    (prompts(i),i=1,7) /
     1  ' some Lick Mongo term types are:',
     2  '     0:  Don''t do screen graphics',
     3  '     1:  DEI Retrographics VT-100',
     4  '     7:  Workstation',
     5  '    11:  X11 Window',
     6  '    13:  GraphOn-2xx',
     7  '    14:  GraphOn-140' /
C       Executable Code=================================================
c       Fortran sucks

c       Begin a long segment of interactive I/O

c       Get device for graphical output
	call getenv('DISPLAY',setfilnm)
	if (PMGO(lenc)(setfilnm) .gt. 0) then
c           assume user wants X11 display if DISPLAY is set
	    idev = 11
	else
	    write(STDOUT,ALINE) prompts
92          write(STDOUT,PROMPT) ' Enter Lick Mongo terminal type:  '
	    read(STDIN,*,err=92) idev
	endif
c       jump here for complete restart of program
1       continue
	defdir(1) = DWD
	defdir(2) = DSETUPDIR
	call canondir(ENVARDIR,defdir(2))
	fixspace = .false.
	detfilnm = ' '
	spcfilnm = ' '
	observer = ' '
c
	write(STDOUT,*)
	write(STDOUT,*) 'Which Setup?'
	i = readmen(NDEFDIR,defdir,'set',setfilnm)
	i = readset(setfilnm,NDEFDIR,defdir)
	i = writset(SETBAKF)
c
	if (detfilnm .eq. ' ') then
c           we did not get a file while in readset
	    write(STDOUT,*)
	    write(STDOUT,*) 'Which Detector?'
	    i = readmen(NDEFDIR,defdir,'det',detfilnm)
	    i = readdet(detfilnm)
	endif
	i = writdet(DETBAKF)
c
	if (spcfilnm .eq. ' ') then
c           we did not get a file while in readset
	    write(STDOUT,*)
	    write(STDOUT,*) 'Which Spectrograph?'
	    i = readmen(NDEFDIR,defdir,'spc',spcfilnm)
	    i = readspc(spcfilnm)
	endif
	i = writspc(SPCBAKF)
	fulform = .true.
	call mosize()
	colldiam = (mmPERm/asecPERrad) * (colfocln*primdiam*focscale)
	if (nxdprism .gt. 0) then
	    call glassname(prglas(0))
	endif
	if (nxdgrat .gt. 0) then
	    mci(1) = mc - 1
	    mci(2) = mc + 2
	else
	    mc = 0
	    mci(1) = 0
	    mci(2) = 0
	endif
	call getwave()
	boxfl = .true.
	fulform = .true.
c       jump here to replot existing configuration
100     continue
C       ----------------------------------------------------------------
	call calcform(fixspace)
	tilt = .true.
c       we write out the setup regularly
	i = writset(SETBAKF)
C       ----------------------------------------------------------------
C       Plot the Spectrograph format on the graphics device
	if (idev .ne. 0) then
	    if (fulform) call getclim
c           fulform = .true.
	    if (boxfl) then
		call initscrn
c               write the names of the numeric and text at edge of the picture
		call upbutton
		call upcdata
		call rasetup(0)
		call upsetup
		call udsetup
	    endif
c           plot all the orders
	    call plotmord(0,mci)
c           plot detector arrays at the permanently stored locations
	    do 585 i = 1,nmos
	      call mosaic(i,INVERT)
	      call badcol(i,INVERT)
585         continue
c           plot locations of spectral lines on the Echelle format
	    if (nlam .gt. 0) call marklines
c           plot moveable detector array at the initial location
	    call spc2det
	    call mosaic(0,INVERT)
	    call badcol(0,INVERT)
	    call drowins(INVERT)
	endif
	i = writset(SETBAKF)
	i = writdet(DETBAKF)
	i = writspc(SPCBAKF)
1000    continue
	if (idev .ne. 0) then
c           enter the event processing loop looking for keyboard & mouse input
	    if (keymouse() .eq. -1) goto 100
	endif
C       ----------------------------------------------------------------
	i = comloop()
	if (i .eq. 1) then
	    goto 1
	elseif (i .eq. 100) then
	    goto 100
	elseif (i .eq. 1000) then
	    goto 1000
	endif
C       ----------------------------------------------------------------
c       always write out the final setup before exit
	i = writset(SETBAKF)
	i = wkics(' ')
	end
C==============================================================================
C==============================================================================
--------------- echinter.F ------------------------
#include "include/port.h"
C==============================================================================
C==============================================================================
	integer function keymouse()
c       Catch keyboard and mouse events and process them
c       This is the main_loop in which the user spends the most time
c       interacting with the program.
	IMPLICIT_NONE
C       Parameters
#       include "include/stdio.par"
#       include "echelle.par"
#       include "include/units.par"
c                       Lick Mongo LVISIBILITY mode
	integer         INVERT
	parameter       (INVERT = 2)
c                       ISI Mouse button codes
	integer         ISIMB1
	parameter       (ISIMB1 = 40209)
	integer         ISIMB2
	parameter       (ISIMB2 = 40210)
	integer         ISIMB3
	parameter       (ISIMB3 = 40212)
c                       X11 Mouse button codes
	integer         X11MB1
	parameter       (X11MB1 = -1)
	integer         X11MB2
	parameter       (X11MB2 = -2)
	integer         X11MB3
	parameter       (X11MB3 = -3)
C       Local Variables
c                       loops
	integer         i, imos
c                       a temporary logical variable
	logical         okay
c                       current & saved positions of cursor (Echelle ) [mm]
	real            xeurs, yeurs
c                       current positions of cursor (Lick Mongo coords) [mm]
	real            xcurs, ycurs
c                       a dummy variable for temporary use
	real            tmpdum, reldist
c                       the character typed in cursor mode
	character*1     comm
c                       ASCII code of character typed in cursor mode
	integer         key, keylast
c                       label identifying the new changeable parameter
	character       newlab*(LLABEL)
c                       an input string typed by a user
	character*80    stringinp
c                       corners of a box being tracked [mm]
	real            tx0, ty0, tx1, ty1
c                       this might have been in the setup.inc common block
c                       but is is not.  It is the tilt of the Hamilton
c                       Echelle grating measured in encoder units.
	real            egtilt
	character*80    title1,title2
C       External Functions
c                       a function which gets unambiguous input
	logical         getyes
c                       Lick Mongo function which gets non-blank string length
	integer         PMGO(lenc)
c                       Lick Mongo X11 function which registers an event handler
c       integer         PTUV(regmot)
c                       subroutine which acts as an event handler
	external        xtrackcur
c                       find the spectral line nearest to the cursor
	integer         findline
c
	logical         acspgraf
	logical         acsetup
c       logical         acdetmos
	logical         acbutton
	logical         trspgraf
	logical         trsetup
c       logical         trdetmos
c       logical         wbcdata
	logical         wbspgraf
	logical         wbsetup
c       logical         wbdetmos
	logical         wbbutton
C       Common Blocks
	include 'echord.cmn'
	include 'lam.cmn'
	include 'spgraf.inc'
	include 'wizard.cmn'
	include 'cdata.inc'
	include 'lims.cmn'
	include 'linpos.cmn'
	include 'detmos.inc'
	include 'setup.inc'
	include 'button.inc'
C       Data
	data    newlab  /'       '/
c       initial values of Hamilton Spectrograph height and tilt parameters
c       egt(0)= echelle grating tilt reading when blaze in center of CCD
c       egt(1)= change in tilt reading with motion of 1 mm at chip
C       data    egt     /494000., -78./ before 1988 Dec 24
	data    egt     /493743., -76.4/
c       hgt(0)= CCD height reading when order # 120 in center of CCD
c       hgt(1)= change in height reading with motion of 1 mm at chip
C       data    hgt     /501302., 570./ before 1988 Dec 24
	data    hgt     /500605., 601./
C       Executable Code
	keymouse = 0
	tilt = .true.
c       top of interaction loop, we keep jumping back to here
100     continue
c       on a Sun, check to see if the last action caused IEEE exception
c	call sunieee()
c       wait for user action (key or mouse button press)
	call mongohairs(key,xcurs,ycurs)
c       convert Mongo coordinates to Echelle coordinates
	xeurs = xcurs
	yeurs = ycurs
	call translate(xeurs, yeurs, tde(Xp,Xo,D2E), 1)
c       redisplay position of crosshair info about format at that point
	call cursdata(yeurs,xeurs)
	call detcoord(xcurs,ycurs,idet,dpx,dpy)
	call udcdata
	call udsetup
c       convert the integer to equivalent ASCII character
	comm = char(key)
c       convert the ASCII character to uppercase
	if (comm .ge. 'a' .and. comm .le. 'z')
     &  comm = char(ichar(comm) - 32)
c       figure out what to do
c       ----------------------------------------------------------------
	if (acbutton(comm,i) .or.
     &  (key .eq. X11MB1 .and. wbbutton(xcurs,ycurs,i))) then
c           this key is one of the accelerators for changing the
c           list of menus being displayed
c           or the user clicked MB1 on its label
	    if (i .eq. i_quit2com .or. i .eq. i_escape) then
c               quit the interactive cursor and go to command mode
		call tidle
		goto 9900
	    elseif (i .eq. i_defset) then
c               display only the usual cursor/setup information
		call dnspgraf
		call dndetmos
		call upbutton
		call upcdata
		call rasetup(0)
		call upsetup
	    elseif (i .eq. i_optics) then
c               display all the telescope/spectrograph optical hardware information
		call dnsetup
		call dncdata
		call dndetmos
		call upspgraf
	    elseif (i .eq. i_allset) then
c               display all the setup information
		call dnspgraf
		call dncdata
		call dndetmos
		call rasetup(1)
		call upsetup
	    elseif (i .eq. i_dewar) then
c               display all the detector mosaic information
		call dnspgraf
		call dncdata
		call dnsetup
		call radetmos(0)
		call updetmos
	    elseif (i .eq. i_refresh) then
c               Pack in new values of everything and re-plot
c               It is essential to forget the saved positions, because
c               they are expressed in a coordinate system which no longer
c               means anything.
		nmos = 0
		call dndetmos
		call dncdata
		call dnsetup
		call dnspgraf
		call dnbutton
		goto 9000
	    elseif (i .eq. i_zoom) then
		if (.not. fulform) then
c                   we are already zoomed, unzoom
		    fulform = .true.
		    goto 9000
		endif
c               zoom in to show only the region inside the CCD
		fulform = .false.
c               this ignores any rotation between detector and format
C               define DEBUGZOOM
#               ifdef DEBUGZOOM
		write(STDERR,*) '-Xposmos,tx01',
     &          posmos(Xp,0),tx0,tx1
		write(STDERR,*) '-Yposmos,ty01',
     &          posmos(Yp,0),ty0,ty1
#               endif /* DEBUGZOOM */
c               tx0 and ty0 become the margin around the edge of the detector
		tx0 = (cormos(Xp,2) - cormos(Xp,1)) * (PMARGIN - 1) * .5
		ty0 = (cormos(Yp,2) - cormos(Yp,1)) * (PMARGIN - 1) * .5
		xmin = posmos(Xp,0) + cormos(Xp,1) - tx0
		xmax = posmos(Xp,0) + cormos(Xp,2) + tx0
		if (nxdgrat .gt. 0) then
c                   Note that when the format is redrawn, the current y position
c                   of the center of the mosaic will be at coordinate 0.
c                   Thus, we do not use posmos(Yp,0) in this calculation.
		    ymin = cormos(Yp,1) - ty0
		    ymax = cormos(Yp,2) + ty0
		else
c                   when there are only prisms, the coordinates do not shift
		    ymin = posmos(Yp,0) + cormos(Yp,1) - ty0
		    ymax = posmos(Yp,0) + cormos(Yp,2) + ty0
		endif
#               ifdef DEBUGZOOM
		write(STDERR,*) '+Xposmos,tx01',
     &          posmos(Xp,0),tx0,tx1
		write(STDERR,*) '+Yposmos,ty01',
     &          posmos(Yp,0),ty0,ty1
#               endif /* DEBUGZOOM */
c               If the observing site uses non-standard video orientation,
c               exchange the Lick Mongo coordinates to flip the entire picture.
		if (.not. stdvidv) then
		    tmpdum = ymin
		    ymin = ymax
		    ymax = tmpdum
		endif
		if (.not. stdvidh) then
		    tmpdum = xmin
		    xmin = xmax
		    xmax = tmpdum
		endif
		goto 9000
	    elseif (i .eq. i_displam) then
c               plot/unplot the wavelengths of the orders
		call plotmord(2,mci)
		lamnum = .not. lamnum
		call plotmord(2,mci)
	    elseif (i .eq. i_dispord) then
c               plot/unplot the order numbers of the orders
		call plotmord(2,mci)
		ordnum = .not. ordnum
		if (ordnum) lamnum = .false.
		call plotmord(2,mci)
	    elseif (i .eq. i_markdet) then
c               plot a semi-permanent box on top of the moveable box.
c               Box size is same as the detector mosaic.
		imos = 0
		reldist = RELDMIN
		do 500 i=1,nmos
c                 find out which of the already placed detectors is closest
		  tmpdum = ( (posmos(Xp,i) - posmos(Xp,0)) /
     &            (cormos(Xp,2) - cormos(Xp,1)) )**2
     &            +        ( (posmos(Yp,i) - posmos(Yp,0)) /
     &            (cormos(Yp,2) - cormos(Yp,1)) )**2
		  if (tmpdum .lt. reldist) then
		      imos = i
		      reldist = tmpdum
		  endif
500             continue
		if (imos .ne. 0) then
c                   there was a previous box close to the current location
c                   undraw this box and move last box into its position
		    call mosaic(imos,INVERT)
		    call badcol(imos,INVERT)
c                   call drowins(INVERT)
		    posmos(Xp,imos) = posmos(Xp,nmos)
		    posmos(Yp,imos) = posmos(Yp,nmos)
		    nmos = nmos - 1
		elseif (nmos .lt. MAXMOSPOS) then
c                   a new position is saved for posterity
		    nmos = nmos + 1
		    posmos(Xp,nmos) = posmos(Xp,0)
		    posmos(Yp,nmos) = posmos(Yp,0)
		    call mosaic(nmos,INVERT)
		    call badcol(nmos,INVERT)
c                   call drowins(INVERT)
		endif
c               write(STDERR,*) 'nmos ',nmos
c               call sunieee()
c               write(STDERR,*) 'posmos',posmos(Xp,nmos),posmos(Yp,nmos)
	    elseif(i .eq. i_linepos) then
635             continue
		title1 = 'Enter name for line position dump:  '
		i = PMGO(lenc)(title1) + 2
		call mgoprompt(title1(:i))
		call mx11gets(title2)
		if (title2 .eq. ' ') then
		    if (setup .eq. ' ') goto 635
		else
		    setup = title2
		endif
c               write out the setup in this directory
		call linepos(title2)
	    elseif(i .eq. i_kicsset) then
640             continue
		i = PMGO(lenc)(setup)
		title1 =
     &          'Enter a name for this setup ('//setup(:i)//'):  '
		i = PMGO(lenc)(title1) + 2
		call mgoprompt(title1(:i))
		call mx11gets(title2)
		if (title2 .eq. ' ') then
		    if (setup .eq. ' ') goto 640
		else
		    setup = title2
		endif
c               write out the setup in this directory
		call wkics(' ')
		i = PMGO(lenc)(setup)
		call writset(setup(:i)//'.set')
		call mgoprompt('Do you want to execute this setup?  ')
		if (getyes(i)) then
c                   make a copy of the setup in the real directory
		    call wkics(KSETUPDIR)
		    call mgoprompt('Are you sure?  ')
		    if (getyes(i)) then
c                       execute the setup
			call system('go -f '//setup)
		    endif
		endif
	    endif /* i .eq. i_something */
c       --------------------------------
	elseif (acspgraf(comm,i) .or.
     &  (key .eq. X11MB1 .and. wbspgraf(xcurs,ycurs,i))) then
c           this key is one of the accelerators for changing the
c           design of telescope or spectrograph.
c           or the user clicked MB1 on its label
	    if (.not. idataup) then
		call dndetmos
		call dncdata
		call dnsetup
		call upspgraf
	    endif
	    if (wizard) then
		call mgoprompt('New value for '//idatal(i))
		call mx11gets(stringinp)
		if (trspgraf(stringinp,i)) then
		    if ( (i .eq. i_PRAPEXD ) .or. (i .eq. i_PRGLAS  )
     &              .or. (i .eq. i_PRFACE  ) .or. (i .eq. i_NXDPRISM)
     &              ) then
c                       set new values for all of the prisms
			call newprism(i)
c                   elseif (i .eq. i_XDDELTA) then
c                       get the degree version also
c                       xddeltad = xddelta * degPERrad
		    elseif (i .eq. i_XDDELTAD) then
c                       get the radian version also
c                       xddelta = xddeltad * radPERdeg
		    elseif (i .eq. i_ECDELTA) then
c                       get the degree version also
			ecdeltad = ecdelta * degPERrad
		    elseif (i .eq. i_ECDELTAD) then
c                       get the radian version also
			ecdelta = ecdeltad * radPERdeg
		    elseif (i .eq. i_ECTHETA) then
c                       get the degree version also
			ecthetad = ectheta * degPERrad
		    elseif (i .eq. i_ECTHETAD) then
c                       get the radian version also
			ectheta = ecthetad * radPERdeg
		    elseif (i .eq. i_ECSIGMAI) then
c                       respect spacing constraints
			if (fixspace) then
			    ecsigmai = HeNeWAV * umPERAang *
     &                      nint((ecsigmai*AangPERum)/HeNeWAV)
			endif
			ecsigma = umPERmm / ecsigmai
		    elseif (i .eq. i_ECSIGMA) then
c                       respect spacing constraints
			ecsigmai = umPERmm / ecsigma
			if (fixspace) then
			    ecsigmai = HeNeWAV * umPERAang *
     &                      nint((ecsigmai*AangPERum)/HeNeWAV)
			    ecsigma = umPERmm / ecsigmai
			endif
		    elseif (i .eq. i_XDSIGMAI) then
			xdsigma = umPERmm / xdsigmai
		    elseif (i .eq. i_XDSIGMA) then
			xdsigmai = umPERmm / xdsigma
		    elseif ( i .eq. i_COLFOCLN) then
			collmeth = i_COLFOCLN
c                       recalculate the collimated beam diameter
			colldiam = (mmPERm / asecPERrad) *
     &                  (colfocln * primdiam * focscale)
		    elseif ( i .eq. i_COLLDIAM)  then
			collmeth = i_COLLDIAM
c                       recalculate the collimator focal length
			colfocln = (asecPERrad / mmPERm) *
     &                  (colldiam / (primdiam * focscale))
		    elseif ((i .eq. i_FOCSCALE) .or. (i .eq. i_PRIMDIAM)
     &              ) then
			if     (collmeth .eq. i_COLLDIAM) then
			    colfocln = (asecPERrad / mmPERm) *
     &                      (colldiam / (primdiam * focscale))
			elseif (collmeth .eq. i_COLFOCLN) then
			    colldiam = (mmPERm / asecPERrad) *
     &                      (colfocln * primdiam * focscale)
			endif
		    elseif (i .eq. i_NXDGRAT) then
c                       the code does not allow for a change here
			nxdgrat = 1
		    elseif ((i .eq. i_TELESCOP) .or. (i .eq. i_INSTRUME)
     &              .or.    (i .eq. i_CAMFOCLN) .or. (i .eq. i_XDALFBET)
     &              .or.    (i .eq. i_FPROTANG) .or. (i .eq. i_PRANGIND)
     &              ) then
c                       the trspgraf routine has changed the appropriate value
c                       and no further action is required
		    else
			write(STDERR,*)
     &                  'Cannot reset spgraf item ', idatal(i)
		    endif /* (i .eq. i_XXXXXX) */
		endif /* trspgraf(stringinp,i) */
c               most changes to the above variables require a replot ...
		call dnspgraf
		call dnbutton
c               ... for that reason, we erase the echelle format
		call PMGO(erase)()
		call upspgraf
		call upbutton
	    else  /* wizard */
		if (i .eq. i_wizard) then
c                   see if user is a wizard
		    call tidle
		    call mgoprompt(' Are you a wizard?  ')
		    call mx11gets(stringinp)
		    wizard = stringinp(1:1) .eq. 'y'
		    if (wizard) then
			call mgoprompt(' Prove it:  ')
			call mx11gets(stringinp)
			wizard = stringinp(1:4) .eq. 'Vogt'
			if (wizard) then
			    call mgoprompt(' Regards to the wizard!')
			else
			    call mgoprompt(' You are not a wizard.')
			endif
		    endif
		else
		    call mgoprompt('Only Wizards can change optics')
		endif
	    endif /* wizard */
c       --------------------------------
	elseif (acsetup(comm,i) .or.
     &  (key .eq. X11MB1 .and. wbsetup(xcurs,ycurs,i))) then
c           this key is one of the accelerators for changing the
c           setup of detector or spectrograph.
	    call dncdata
	    call dnspgraf
	    call upsetup
	    call mgoprompt('New value for '//sdatal(i))
	    call mx11gets(stringinp)
	    if (trsetup(stringinp,i)) then
		if     ((i .eq. i_SLITVEL ) .or. (i .eq. i_SLITPIX)
     &          .or.    (i .eq. i_SLITSIZE) .or. (i .eq. i_SLITRAW)
     &          .or.    (i .eq. i_SLITWID )) then
		    slitmeth = i
		    call calcslit
		elseif ((i .eq. i_DECKPIX ) .or. (i .eq. i_DECKSIZE)
     &          .or.    (i .eq. i_DECKHGT )) then
		    deckmeth = i
		    call calcdeck
		elseif ((i .eq. i_XDANGLE ) .or. (i .eq. i_ECANGLE )
     &          .or.    (i .eq. i_XDALPHAD) .or. (i .eq. i_HAMHGT  )
     &          ) then
		    if (i .eq. i_XDALPHAD) xdangle =
     &              xdalphad - (xddeltad + xdalfbet*0.5)
c                   the move is done, undraw the old location of the detector
		    call mosaic(0,INVERT)
		    call badcol(0,INVERT)
		    call drowins(INVERT)
c                   calculate new position of detector
		    call spc2det
c                   draw the new location of the detector
		    call mosaic(0,INVERT)
		    call badcol(0,INVERT)
		    call drowins(INVERT)
		elseif (i .eq. i_RADVEL  ) then
		    redshift =
     &              sqrt((1+radvel/cLIGHT)/(1-radvel/cLIGHT)) - 1
		    radvelz = redshift
		elseif (i .eq. i_RADVELZ ) then
		    redshift = radvelz
		    radvel = cLIGHT *
     &              (((1+redshift)**2 - 1) / ((1+redshift)**2 + 1))
		elseif ((i .eq. i_COLL    ) .or. (i .eq. i_CAMERA  )
     &          ) then
c                   COLL and CAMERA can only be 'RED' or 'BLUE'
		    if     ( sdatav(SVNEW,i)(1:1) .eq. 'R'
     &              .or.     sdatav(SVNEW,i)(1:1) .eq. 'r' ) then
			sdatav(SVNEW,i) = 'RED'
		    elseif ( sdatav(SVNEW,i)(1:1) .eq. 'B'
     &              .or.     sdatav(SVNEW,i)(1:1) .eq. 'b' ) then
			sdatav(SVNEW,i) = 'BLUE'
		    else
c                       reset back to the original value
			sdatav(SVNEW,i) = sdatav(SVOLD,i)
			call mgoprompt('Value must be RED or BLUE')
		    endif
		elseif ((i .eq. i_FILTER  ) .or. (i .eq. i_FILTER2 )
     &          ) then
		    if ( sdatai(i) .lt. 1 .or. sdatai(i) .gt. 12 ) then
			sdatai(i) = min(12,max(1,sdatai(i)))
			call mgoprompt('Filter must be from 1 to 12')
		    endif
		elseif ((i .eq. i_XBIN    ) .or. (i .eq. i_YBIN    )
     &          ) then
		    if ( sdatai(i) .lt. 1) then
			sdatai(i) = 1
			call mgoprompt('Binning must >= 1')
		    endif
		elseif ((i .eq. i_WAVFILNM)
     &          ) then
c                   read a new wavelength file
		    call getwave()
		elseif ((i .eq. i_COFOCUS ) .or. (i .eq. i_CAFOCUS )
     &          .or.    (i .eq. i_SETUPNM ) .or. (i .eq. i_OBSERVER)
     &          .or.    (i .eq. i_FILNAME ) .or. (i .eq. i_FIL2NAME)
     &          .or.    (i .eq. i_XDORDER ) .or. (i .eq. i_DECKNNAM)
     &          .or.    (i .eq. i_WAVLMAX ) .or. (i .eq. i_WAVLMIN )
     &          .or.    (i .eq. i_RADVEL  ) .or. (i .eq. i_RADVELZ )
     &          ) then
c                   the trsetup routine has changed the appropriate value
c                   and no further action is required
		else
		    write(STDERR,*)
     &              'Cannot reset setup item ', sdatal(i)
		endif /* (i .eq. i_XXXXXX) */
c               --------
		if ( (i .eq. i_XDORDER )
     &          .or. (i .eq. i_WAVLMAX ) .or. (i .eq. i_WAVLMIN )
     &          .or. (i .eq. i_RADVEL  ) .or. (i .eq. i_RADVELZ )
     &          ) then
c                   we really must redraw everything
		    call PMGO(erase)()
		endif
	    endif
	    call dnsetup
	    call upsetup
	    call upbutton
c       ----------------------------------------------------------------
	elseif (key .eq. X11MB1 .or. key .eq. 9) then
Cmkey       Button1:  try to identify the spectral line nearest to cursor
Cmkey       ^I:       try to identify the spectral line nearest to cursor
	    if (findline(xeurs,yeurs,i) .eq. SUCCESS) then
		if (earth(i)) then
		    write(stringinp,*) 'Wavelength ', lambda(i)
		else
		    write(stringinp,*) 'Wavelength ', lambda(i),
     &              ' at redshift ', redshift
		endif
	    else
		stringinp = 'Cannot find a spectral line'
	    endif
	    call mgoprompt(stringinp)
	elseif (key .eq. X11MB3 .or. comm .eq. 'W') then
Cmkey       W:  pretend there is a mouse, and define a readout window
Cmkey       Button3:  use mouse to move a readout window over the format
	    tx0 = xcurs
	    ty0 = ycurs
	    tx1 = xcurs
	    ty1 = ycurs
	    call trkrbox(key,tx0,ty0,tx1,ty1,okay)
	    if (okay) then
		call drowins(INVERT)
		call rowind(tx0,ty0,tx1,ty1)
		call drowins(INVERT)
	    endif
	elseif (key .eq. X11MB2 .or. comm .eq. 'M') then
Cmkey       M:  pretend there is a mouse, and move a CCD over the format
Cmkey       Button2:  use mouse to move a CCD over the format
c           add the offset coord of each corner to the position of mosaic
	    tx0 = cormos(Xp,1) + posmos(Xp,0)
	    ty0 = cormos(Yp,1) + posmos(Yp,0)
	    tx1 = cormos(Xp,2) + posmos(Xp,0)
	    ty1 = cormos(Yp,2) + posmos(Yp,0)
c           we might want to turn tracking off while moving box
c           i = PTUV(regmot)(0,0)
c           do the magical moving of a box using the mouse
	    call trkfbox(key, xcurs,ycurs, tx0,ty0, tx1,ty1)
c           if we turned tracking off, we want it back on now
c           i = PTUV(regmot)(1,xtrackcur)
c           the move is done, undraw the old location of the detector
	    call mosaic(0,INVERT)
	    call badcol(0,INVERT)
	    call drowins(INVERT)
c           (origin of mosaic) = (middle of rectangle) - (coord of middle)
	    posmos(Xp,0) = 0.5 * (tx0 + tx1) - cormos(Xp,0)
	    posmos(Yp,0) = 0.5 * (ty0 + ty1) - cormos(Yp,0)
#           ifdef DEBUGZOOM
	    write(STDERR,*) ' Xposmos,tx01',
     &      posmos(Xp,0),tx0,tx1
	    write(STDERR,*) ' Yposmos,ty01',
     &      posmos(Yp,0),ty0,ty1
#           endif /* DEBUGZOOM */
c           reset coordinate transformations for the new location
	    call distran
c           draw the new location of the detector
	    call mosaic(0,INVERT)
	    call badcol(0,INVERT)
	    call drowins(INVERT)
c           calculate the spectrograph configuration implied by this position
	    call det2spc(egtilt)
c           write out these changes
	    call udsetup
c       ----------------------------------------------------------------
	else
c           no defined action, do nothing
	endif
c       ----------------------------------------------------------------
	xclast = xeurs
	yclast = yeurs
	keylast = key
	goto 100
C       End of Keyboard and mouse event processing block
9000    continue
c       set return value so that entire picture gets redrawn
	keymouse = -1
9900    continue
	call tidle
	return
	end
C=======================================================================
C=======================================================================
	integer function comloop()
	IMPLICIT_NONE
C       Parameters      ------------------------------------------------
#       include "include/stdio.par"
#       include "echelle.par"
C       External Variables
C       Local Variables ------------------------------------------------
c                       string from user to use as title on hardcopy plots
	character*132   title
c                       string from user to use as name of PostScript file
	character*132   psfile
c                       a help menu for the user
	character*72    prompts(12)
c                       the character typed by the user
	character*1     comm
c                       loop
	integer         i
C       External Functions
	integer         dohardplot
c                       Lick Mongo function
	integer         PMGO(lenc)
c                       a function which gets unambiguous input
	logical         getyes
C       Common Blocks   ------------------------------------------------
	include 'spgraf.inc'
	include 'lims.cmn'
	include 'setup.inc'
	include 'lam.cmn'
C       Data            ------------------------------------------------
	data    (prompts(i),i=1,10) /
     1  ' Non-plot commands are as follows:',
     2  '   W: Write format.out file describing Echelle format',
     3  '   G: Go back to start and refresh all echelle parameters',
     4  '   L: Make a laser plot',
     5  '   P: Make a PostScript file',
     6  '   R: Refresh plot and return to Interaction with plot',
     7  '   M: Minimize deviations of lines from blaze wavelength',
     8  '   Q: Quit the program',
     9  '   I: return to Interaction with plot',
     A  '   K: Define a KICS setup'/
	data    (prompts(i),i=11,12) /
     1  ' ',
     2  'Hit return in this text window when done'/
C       Executable Code ------------------------------------------------
	comloop = -1
620     continue
	call mgoprompt('Command (? for help):  ')
	call mx11gets(comm)
	if (comm .ge. 'a' .and. comm .le. 'z')
     &  comm = char(ichar(comm) - 32)
	if (comm .eq. 'W') then
c           Write out a file containing a description of the echelle format
	    call writform
	elseif(comm .eq. 'G') then
c           complete restart of program
	    boxfl = .true.
	    comloop = 1
	elseif(comm .eq. 'L' .or. comm .eq. 'P') then
	    title = ' '
	    call mgoprompt('Enter a label for this plot:  ')
	    call mx11gets(title)
	    psfile = ' '
	    if (comm .eq. 'P') then
		call mgoprompt('Enter name of the output PS file:  ')
		call mx11gets(psfile)
	    endif
	    i = dohardplot(title,psfile)
	    call device(idev)
	elseif(comm .eq. 'K') then
c           define and execute a KICS setup
640         continue
	    i = PMGO(lenc)(setup)
	    title = 'Enter a name for this setup ('//setup(:i)//'):  '
	    i = PMGO(lenc)(title) + 2
	    call mgoprompt(title(:i))
	    call mx11gets(title)
	    if (title .eq. ' ') then
		if (setup .eq. ' ') goto 640
	    else
		setup = title
	    endif
c           write out the setup in this directory
	    call wkics(' ')
	    i = PMGO(lenc)(setup)
	    call writset(setup(:i)//'.set')
	    call mgoprompt('Do you want to execute this setup?  ')
	    if (getyes(i)) then
c               make a copy of the setup in the real directory
		call wkics(KSETUPDIR)
		call mgoprompt('Are you sure?  ')
		if (getyes(i)) then
c                   execute the setup
		    call system('go -f '//setup)
		endif
	    endif
	elseif(comm .eq. 'I') then
c           return to interaction with plot
	    comloop = 1000
	elseif(comm .eq. 'R') then
c           refresh plot and return to interaction
	    boxfl = .true.
	    fulform = .true.
	    comloop = 100
	elseif(comm .eq. 'M') then
	    call minimize(ecsigmai,ecthetad,ecdeltad)
	    boxfl = .true.
	    fulform = .true.
	    comloop = 100
	elseif(comm .eq. '?' .or. comm .eq. 'H') then
	    call mgoprompt('Look at the text screen')
	    write(STDOUT,ALINE) prompts
	    read(STDIN,*)
	elseif(comm .eq. 'Q') then
	    return
	else
	    call mgoprompt(' Unknown command. Use ? or H for help.')
	endif
	if (comloop .lt. 0) goto 620
	return
	end
C=======================================================================
C=======================================================================
	integer function dohardplot(title,psfile)
	IMPLICIT_NONE
C       Parameters      ------------------------------------------------
#       include "include/stdio.par"
#       include "echelle.par"
c                       Lick Mongo LVISIBILITY mode
	integer         INVERT
	parameter       (INVERT = 2)
C       External Variables
c                       string from user to use as title on hardcopy plots
	character*(*)   title
c                       string from user to use as name of PostScript file
	character*(*)   psfile
C       Local Variables ------------------------------------------------
c                       loop
	integer         i
C       External Functions
c                       two Lick Mongo functions
	integer         PMGO(fileplot)
	integer         PMGO(lenc)
C       Common Blocks   ------------------------------------------------
	include 'spgraf.inc'
	include 'lims.cmn'
	include 'setup.inc'
	include 'lam.cmn'
C       Executable Code ------------------------------------------------
c       dump a hardcopy plot to the laserprinter
#       ifdef IMAGEN
	call imsetup
	call fileinit
	call setlweight(1.)
#       else /* IMAGEN */
	call psplot(.true.,psfile,' ')
	call setlweight(0.3)
	call setpsfmode(2)
	call makecolor(2,.6,.6,.6)
c       call makecolor(3,0.,0.,0.)
c       call makecolor(4,0.,0.,0.)
c       call makecolor(5,0.,0.,0.)
#       endif /* IMAGEN */
c       set up the geometric transformation
	call getphysical(pxmin,pymin,pxmax,pymax)
	call setlim(xmin,ymin,xmax,ymax)
	call rect(-1,-1,-1,-1)
c       plot the echelle orders
	call setexpand(0.7)
	call plotmord(0,mci)
c       plot any ccd mosaics
	do 630 i = 1,nmos
	  call mosaic(i,INVERT)
	  call badcol(i,INVERT)
630     continue
	call rect(1,2,0,0)
	call setexpand(0.3)
	if (nlam .gt. 0) call marklines(.true.)
	call setexpand(1.)
	call xlabel(4,'[mm]')
	call ylabel(4,'[mm]')
	call tlabel(PMGO(lenc)(title),title)
	write(STDOUT,*) PMGO(fileplot)(0),' vectors plotted'
	return
	end
C=======================================================================
C=======================================================================
	subroutine xtrackcur(xd, yd, wx, wy)
c       as the cursor moves across the echelle format, update values
c       this serves as a Lick Mongo X11 event handler callback routine
	IMPLICIT_NONE
C       Parameters
#       include "echelle.par"
C       External Variables
c                       Lick Mongo device coordinates of event
	integer         xd, yd
c                       Lick Mongo world coordinates of event
	real            wx, wy
C       Internal Variables
c                       local copy of world coords
	real            lwx, lwy
C       Common Block
	include 'setup.inc'
	include 'cdata.inc'
C       Executable Code
	lwx = wx
	lwy = wy
	call translate(lwx,lwy,tde(Xp,Xo,D2E),1)
	call cursdata(lwy, lwx)
	call detcoord(wx, wy, idet, dpx, dpy)
	call udcdata()
	return
	end
C=======================================================================
C=======================================================================
	subroutine rowind(tx0,ty0,tx1,ty1)
c       Given Echelle Format coordinates of 2 points
c       find the corresponding readout windows on each detector.
c       These windows are loaded into the setup common block.
c       Limits are computed and stored as if binning were 1,
c       binning is only taken into account when drawing pictures.
C       Parameters
#       include "echelle.par"
#       include "include/units.par"
C       External Variables
c                       Echelle Format coordinates of one corner [mm]
	real            tx0, ty0
c                       Echelle Format coordinates of one corner [mm]
	real            tx1, ty1
C       Internal Variables
c                       Echelle Format coordinates [m]
	real            ex0, ey0, ex1, ey1
c                       chip coordinates [pixel]
	real            dpx, dpy, dpx0, dpy0, dpx1, dpy1
c                       loop
	integer         idet
C       Common Blocks
	include 'setup.inc'
	include 'detmos.inc'
	include 'spgraf.inc'
C       Executable Code
c       Convert to Detector Mosaic coordinates
	ex0 = (tx0 - posmos(Xp,0)) * mPERmm
	ey0 = (ty0 - posmos(Yp,0)) * mPERmm
	ex1 = (tx1 - posmos(Xp,0)) * mPERmm
	ey1 = (ty1 - posmos(Yp,0)) * mPERmm
c       search all chips for insidedness
	do 1000 idet=1,nchips
c         NOTE:  In the general case, proper determination of the
c         readout region of the chip would require full-blown polygon
c         clipping of the rubber-box to the detector limits.
c         The full general case is NOT treated here, but a simpler
c         method which works by finding the bounding box of the
c         rubberbox and using that as the readout limits.
c         This will result in readout windows which are slightly larger
c         than absolutely necessary, and this error is worse for cases
c         where the detectors are rotated wrt the Echelle Format.
	  dpx0 = tmc(Xp,Xo,M2C,idet)*ex0 + tmc(Xp,Yo,M2C,idet)*ey0
	  dpy0 = tmc(Yp,Xo,M2C,idet)*ex0 + tmc(Yp,Yo,M2C,idet)*ey0
	  dpx1 = dpx0
	  dpy1 = dpy0
	  dpx = tmc(Xp,Xo,M2C,idet)*ex1 + tmc(Xp,Yo,M2C,idet)*ey0
	  dpy = tmc(Yp,Xo,M2C,idet)*ex1 + tmc(Yp,Yo,M2C,idet)*ey0
	  dpx0 = min(dpx0,dpx)
	  dpy0 = min(dpy0,dpy)
	  dpx1 = max(dpx1,dpx)
	  dpy1 = max(dpy1,dpy)
	  dpx = tmc(Xp,Xo,M2C,idet)*ex1 + tmc(Xp,Yo,M2C,idet)*ey1
	  dpy = tmc(Yp,Xo,M2C,idet)*ex1 + tmc(Yp,Yo,M2C,idet)*ey1
	  dpx0 = min(dpx0,dpx)
	  dpy0 = min(dpy0,dpy)
	  dpx1 = max(dpx1,dpx)
	  dpy1 = max(dpy1,dpy)
	  dpx = tmc(Xp,Xo,M2C,idet)*ex0 + tmc(Xp,Yo,M2C,idet)*ey1
	  dpy = tmc(Yp,Xo,M2C,idet)*ex0 + tmc(Yp,Yo,M2C,idet)*ey1
	  dpx0 = min(dpx0,dpx) + tmc(Xp,To,M2C,idet)
	  dpy0 = min(dpy0,dpy) + tmc(Yp,To,M2C,idet)
	  dpx1 = max(dpx1,dpx) + tmc(Xp,To,M2C,idet)
	  dpy1 = max(dpy1,dpy) + tmc(Yp,To,M2C,idet)
c         clip all readout regions so they do not extend beyond detector edges
	  dpx0 = max(dpx0,0.)
	  dpy0 = max(dpy0,0.)
	  dpx1 = min(dpx1,npix(idet,Xp)+.9)
	  dpy1 = min(dpy1,npix(idet,Yp)+.9)
c         set the window limits
	  window(Xo,idet) = dpx0
	  window(Yo,idet) = dpy0
	  window(dX,idet) = dpx1 - window(Xo,idet)
	  window(dY,idet) = dpy1 - window(Yo,idet)
	  if (window(dX,idet) .le. 0 .or. window(dY,idet) .le. 0) then
c             not a valid window, set to nothing
	      window(Xo,idet) = 0
	      window(Yo,idet) = 0
	      window(dX,idet) = 0
	      window(dY,idet) = 0
c         else
c             write(*,*)'winlim',window(Xo,idet),window(Yo,idet),
c    &        window(dX,idet),window(dY,idet)
	  endif
1000    continue
	return
	end
C==============================================================================
C==============================================================================
	subroutine writform
c       Write out a file containing a description of the echelle format.
c       This is usually done after the program has been used for
c       designing a new spectrograph.
	IMPLICIT_NONE
C       Parameters
#       include "echelle.par"
C       Internal Variables
	integer         i
C       Common Blocks
	include 'echord.cmn'
	include 'spgraf.inc'
	include 'schott.cmn'
	include 'setup.inc'
C       Executable Code
c       Open the file into which the format is output.
	open(EFOLUN,file='format.out',form='formatted',
     &  status=StatNew CarriageControlList )
	write(EFOLUN,'(10x,a,/)')
     &  'ORDER SEPARATIONS, LOCATIONS, AND LENGTHS'
	write(EFOLUN,'(8x,a,f7.2,/)')
     &  'ECHELLE:    grooves/mm =', ecsigmai
	write(EFOLUN,'(20x,a,f5.1,6x,a,f4.1,/)')
     &  'Blaze Angle =', ecdeltad, 'Theta =', ecthetad
	write(EFOLUN,'(8x,a,f6.4,a)')
     &  'DIAMETERS:   Collimated Beam =', colldiam, ' m'
	write(EFOLUN,'(21x,a,f6.2,a,/)')
     &  'Telescope =', primdiam, '  m'
	write(EFOLUN,'(8x,a,f6.4,a)')
     &  'Collimator Focal Length =', colfocln, ' m'
	write(EFOLUN,'(8x,a,f7.4,a,/)')
     &  'Camera Focal Length =', camfocln, ' m'
	if (nxdprism .gt. 0) then
	    write(EFOLUN,'(8x,a)') 'PRISM CROSS DISPERSION'
	    write(EFOLUN,'(8X,A6,a,I2,a,f6.2,a)') typeg,' glass   ',
     &      nxdprism,' prisms at ',prapexd(0), ' degrees'
	endif
	if (nxdgrat .gt. 0) then
	    write(EFOLUN,'(8x,a)') 'GRATING CROSS DISPERSION'
	    write(EFOLUN,'(8x,a,f5.0,a,i2//)')
     &      'GRATING:     ', xdsigmai, ' G/mm      ORDER =', mc
	endif
	write(EFOLUN,*)
	write(EFOLUN,'(a)') ' Order Blaze(A)  FSR(A) DEL(mm) '//
     &  ' DEL(asec) HEIGHT(mm)  LENGTH(mm) DISP(A/mm)'
	write(EFOLUN,'(i5,f9.1,f8.1,f8.3,f10.3,f11.3,f10.2,f10.2)')
     &  (morder(i), wv(i), fsr(i), delx(i),
     &  phi(i), x(i,mc), f2db(i), fsr(i)/f2db(i), i=1,norders)
	close(EFOLUN)
	return
	end
C==============================================================================
C==============================================================================
	subroutine newprism(index)
c       fill in new values for prism parameters when one is changed
	IMPLICIT_NONE
C       Parameters
#       include "echelle.par"
C       External Variables
c                       index into array of changeable spgraf parameters
	integer         index
C       Internal Variables
c                       loop
	integer         i
C       Common Blocks
	include 'spgraf.inc'
C       Executable Code
	if (index .eq. i_PRAPEXD .or. index .eq. i_NXDPRISM) then
c           change all of the apex angles
	    do 121 i = 1,nxdprism
	      prapexd(i) = prapexd(0)
121         continue
	endif
	if (index .eq. i_PRGLAS  .or. index .eq. i_NXDPRISM) then
c           change all of the glass types
	    do 122 i = 1,nxdprism
	      prglas(i) = prglas(0)
122         continue
	endif
	if (index .eq. i_PRFACE  .or. index .eq. i_NXDPRISM) then
c           change all of the angles between faces
	    do 123 i = 2,nxdprism
	      prface(i) = prface(1)
123         continue
	endif
	return
	end
C==============================================================================
C==============================================================================
--------------- echplot.F ------------------------
#include "include/port.h"
C==============================================================================
C==============================================================================
	subroutine initscrn
c       initialize Lick Mongo for plotting on the currently selected device
	IMPLICIT_NONE
#       include "echelle.par"
C       Internal Variable
c                       dummy
	integer         i
c                       fractional sizes of Lick Mongo subwindows
	real            fracs(3)
C       External Function
	integer         PTUV(regmot)
	external        xtrackcur
C       Common Block
	include 'lims.cmn'
C       Static Variable
	save            fracs
C       Data
c       data    fracs   /1., 10., 2./
	data    fracs   /2., 10., 0./
C       Executable Code
	call device(idev)
	call tsetup
c       --------
	if (idev .eq. 7 .or. idev .eq. 11) then
c           make the biggest window allowed on the workstation
	    call setphysical(0.,0.,10000.,10000.)
c           wait a little for the window to be mapped
	    call sleep(2)
	    call erase
	    call getphysical(pxmin,pymin,pxmax,pymax)
	    pxmax = pxmax * .9
	    pymax = pymax * .9
	    call setphysical(pxmin,pymin,pxmax,pymax)
	endif
	call erase
	call getphysical(pxmin,pymin,pxmax,pymax)
c       --------
	call submargins(0.,0.)
	call winfrac(fracs,3,1)
	call window(3,1,1)
c       if (idev .eq. 11) call abox(5,5,5,5)
c       call window(3,1,3)
c       if (idev .eq. 11) call abox(5,5,5,5)
	call window(3,1,2)
c       --------
	call setlim(xmin,ymin,xmax,ymax)
	call rect(-1,-1,-1,-1)
c       --------
	if (idev .eq. 11) then
	    i = PTUV(regmot)(1,xtrackcur)
	endif
c       --------
	call makecolor(2,.6,.6,.6)
	call makecolor(3,1.,1.,0.)
	call makecolor(4,0.,1.,1.)
	call makecolor(5,1.,0.,0.)
	return
	end
C==============================================================================
C==============================================================================
	subroutine plotmord(ivis,cdord)
c       Plot all of the echelle orders for each order of cross dispersion
	IMPLICIT_NONE
C       Parameter
#       include "echelle.par"
C       External Variables
c                       which Lick Mongo SETLVIS mode should be used?
	integer         ivis
c                       the interesting range of cross disperser orders
	integer         cdord(2)
C       Internal Variables
c                       loop over all desired cross disperser orders
	integer         j
C       Common Blocks
	include 'lims.cmn'
	include 'echord.cmn'
	include 'setup.inc'
C       Executable Code
c       define Lick Mongo color 2 to be gray
	call setcolor(2)
c       Step through the entire range of cross-dispersion orders
	do 20 j=cdord(1),cdord(2)
c         we do not do the desired cross-dispersion order here
	  if (j .ne. mc) then
	      call plotord(ivis,j,.false.)
	  endif
20      continue
c       Finally, plot the echelle orders for the desired cross-disp. order
	if (idev .eq. 7 .or. idev .eq. 11) then
c           on a workstation device, plot the wings of the orders
	    call plotord(ivis,mc,.true.)
	endif
	call setcolor(1)
	call plotord(ivis,mc,.false.)
	return
	end
C==============================================================================
C==============================================================================
	subroutine plotord(ivis,mord,wing)
c       Plot all of the echelle orders from a single order of the
c       cross disperser.
c       Optionally decorate it with wavelength and/or order # information
	IMPLICIT_NONE
C       Parameter
#       include "echelle.par"
c                       length in characters of an order label
	integer         LOL
	parameter       (LOL = 7)
c                       symbolic names for bluer and redder ends of an order
	integer         BLU, RED
	parameter       (BLU = 1, RED = 2)
c                       how many?
	integer         NRB
	parameter       (NRB = RED - BLU + 1)
C       External Variables
c                       which Lick Mongo SETLVIS mode should be used?
	integer         ivis
c                       which order of cross dispersion to plot?
	integer         mord
c                       If wing is false, only the FSR of each Echelle order
c                       is plotted.
c                       If wing is true, the next FSR-worth of of each
c                       Echelle order outside the FSR is plotted.
	logical         wing
C       Internal Variables
	real            xord(BLU:RED)
	real            yord(BLU:RED)
c                       string used for labelling wavelengths and order numbers
	character       corder*(LOL)
	integer         iord, iop1, iom1, i
C       Common Blocks
	include 'setup.inc'
	include 'echord.cmn'
	include 'lims.cmn'
C       Executable Code
c       All of the real variables used in this routine have the dimensions of
c       millimeters [mm].
	call setlvis(ivis)
c       keep in mind here that x(1) is the bluest echelle order
c       and x(norders) is the reddest echelle order.  This ordering
c       thus runs backwards from the actual echelle order numbers.
	do 10 iord = 1,norders
c         calculate iop1 and iom1 which cannot exceed array bounds
	  iop1 = iord + 1
	  iom1 = iord - 1
c         Calculate position of left and right ends of this order (xord).
c         The xord calculations may be too much of an approximation,
c         but the cursor position finding algorithm uses this same approx.
c         Calculate height of the ends of the FSR of this order (yord).
	  if (wing) then
c             wing implies tilt, this is evident in the yord calculation
c             first, calculate the bluer wing
	      xord(BLU) = -f2db(iord)
	      xord(RED) = -f2db(iord) * 0.5
	      yord(BLU) = x(iom1,mord)
	      yord(RED) = 0.5 * (x(iord,mord) + x(iom1,mord))
c             draw the bluer wing
	      call translate(yord, xord, tde(Xp,Xo,E2D), NRB)
	      call connect(yord,xord,NRB)
c             now, calculate for the redder wing
	      xord(BLU) =  f2db(iord)*0.5
	      xord(RED) =  f2db(iord)
	      yord(BLU) = 0.5 * (x(iord,mord) + x(iop1,mord))
	      yord(RED) = x(iop1,mord)
	  else
	      xord(BLU) = -f2db(iord) * 0.5
	      xord(RED) =  f2db(iord) * 0.5
	      if (tilt) then
		  yord(BLU) = 0.5 * (x(iord,mord) + x(iom1,mord))
		  yord(RED) = 0.5 * (x(iord,mord) + x(iop1,mord))
	      else
		  yord(BLU) = x(iord,mord)
		  yord(RED) = x(iord,mord)
	      endif
	  endif
c         draw this order
	  call translate(yord, xord, tde(Xp,Xo,E2D), NRB)
	  call connect(yord,xord,NRB)
c         find order # 120
	  if (morder(iord) .eq. 120) i120 = iord
c         label the edges of the orders if desired
	  i = mod(morder(iord),5)
	  if (wing) then
c             do not label the wing
	  elseif (ordnum .and. i .eq. 0) then
c             order number on the left side of the order
	      write(corder(1:5),'(a1,i3,a1)') ' ',morder(iord),' '
	      call relocate(yord(BLU),xord(BLU))
	      call putlabel(5,corder,4)
	      if (.not. lamnum) then
c                 order number on the right side of the order
		  call relocate(yord(RED),xord(RED))
		  call putlabel(5,corder,6)
	      endif
	  elseif (lamnum .and. i .eq. 1) then
c             wavelength on the right side of the order
	      write(corder(:LOL),'(f7.1)') wv(iord) + fsr(iord) * 0.5
	      call relocate(yord(RED),xord(RED))
	      call putlabel(LOL,corder,6)
	  elseif (lamnum .and. i .eq. 0) then
c             wavelength on the left side of the order
	      write(corder(:LOL),'(f7.1)') wv(iord) - fsr(iord) * 0.5
	      call relocate(yord(BLU),xord(BLU))
	      call putlabel(LOL,corder,4)
	  endif
10      continue
	call setlvis(0)
	return
	end
C==============================================================================
C==============================================================================
	subroutine getclim
c       this subroutine computes reasonable values for world coordinate limits
	IMPLICIT_NONE
C       Parameter
#       include "echelle.par"
#       include "include/units.par"
C       Internal Variables
c                       height between reddest and bluest order [mm]
	real            xb
c                       position of a "corner", or size of Echelle format [mm]
	real            xcs, ycs
c                       position of middle of the Echelle format [mm]
	real            xmid, ymid
C       Common Blocks
	include 'echord.cmn'
	include 'lims.cmn'
	include 'spgraf.inc'
	include 'detmos.inc'
	include 'setup.inc'
C       Executable Code
c       figure the size of the graphics region leaving a little margin
c       --------    red end of reddest order    ----------------
	ycs = f2db(norders)
	xcs = x(norders,mc)
	call translate(xcs, ycs, tde(Xp,Xo,E2D), 1)
	ymax = ycs
	ymin = ycs
	xmax = xcs
	xmin = xcs
c       --------   blue end of reddest order    ----------------
	ycs = -f2db(norders)
	xcs = x(norders,mc)
	call translate(xcs, ycs, tde(Xp,Xo,E2D), 1)
	ymax = max(ymax, ycs)
	ymin = min(ymin, ycs)
	xmax = max(xmax, xcs)
	xmin = min(xmin, xcs)
c       --------    red end of bluest  order    ----------------
	ycs = f2db(1)
	xcs = x(1,mc)
	call translate(xcs, ycs, tde(Xp,Xo,E2D), 1)
	ymax = max(ymax, ycs)
	ymin = min(ymin, ycs)
	xmax = max(xmax, xcs)
	xmin = min(xmin, xcs)
c       --------   blue end of bluest  order    ----------------
	ycs = -f2db(1)
	xcs = x(1,mc)
	call translate(xcs, ycs, tde(Xp,Xo,E2D), 1)
	ymax = max(ymax, ycs)
	ymin = min(ymin, ycs)
	xmax = max(xmax, xcs)
	xmin = min(xmin, xcs)
c       --------   find middle of Echelle format   -------------
c       write(*,*) 'maxes1', xmin, xmax, ymin, ymax
	xmid = (xmax + xmin) * 0.5
	ymid = (ymax + ymin) * 0.5
c       --------   leave a little room around the edges --------
	xcs = max(xmax - xmin,cormos(Xp,2)-cormos(Xp,1)) * PMARGIN * 0.5
	ycs = max(ymax - ymin,cormos(Yp,2)-cormos(Yp,1)) * PMARGIN * 0.5
	xmax = xmid + xcs
	xmin = xmid - xcs
	ymax = ymid + ycs
	ymin = ymid - ycs
c       --------    swap things as a temporary hack  -----------
c       write(*,*) 'maxes2', xmin, xmax, ymin, ymax
c       xb = xmin
c       xmin = ymin
c       ymin = xb
c       xb = xmax
c       xmax = ymax
c       ymax = xb
c       --------------------------------------------------------
c       If the observing site uses non-standard video orientation,
c       exchange the Lick Mongo coordinates to flip the entire picture.
	if (.not. stdvidv) then
	    xb = ymin
	    ymin = ymax
	    ymax = xb
	endif
	if (.not. stdvidh) then
	    xb = xmin
	    xmin = xmax
	    xmax = xb
	endif
	return
	end
C==============================================================================
C==============================================================================
	subroutine drowins(ivis)
c       plot outlines of all of the readout windows in the mosaic
	IMPLICIT_NONE
#       include "echelle.par"
C       External Variables
c                       Lick Mongo line-visibility
	integer         ivis
C       Local Variables
c                       loop
	integer         i
C       Common Block
	include 'detmos.inc'
C       Executable Code
	call setcolor(3)
	do 10 i = 1,nchips
	  call drowin(i,ivis)
10      continue
	call setcolor(1)
	return
	end
C==============================================================================
C==============================================================================
	subroutine drowin(ndet,ivis)
c       draw the outline of a readout window on the display
	IMPLICIT_NONE
C       Parameters
c                       how many points?
	integer         HMPT
	parameter       (HMPT = 5)
#       include "echelle.par"
#       include "include/units.par"
C       External Variables
c                       which detector in the mosaic
	integer         ndet
c                       Lick Mongo line-visibility
	integer         ivis
C       Local Variables
c                       positions of corners of detectors on format [mm]
	real            xy(HMPT,Xp:Yp)
C       Common Block
c       include 'detmos.inc'
	include 'setup.inc'
C       Executable Code
	call pixpos(0,ndet,real(window(Xp,ndet)),
     &  real(window(Yp,ndet)),              xy(1,Xp),xy(1,Yp))
	call pixpos(0,ndet,window(Xp,ndet)+window(dX,ndet)+1.,
     &  real(window(Yp,ndet)),              xy(2,Xp),xy(2,Yp))
	call pixpos(0,ndet,window(Xp,ndet)+window(dX,ndet)+1.,
     &  window(Yp,ndet)+window(dY,ndet)+1., xy(3,Xp),xy(3,Yp))
	call pixpos(0,ndet,real(window(Xp,ndet)),
     &  window(Yp,ndet)+window(dY,ndet)+1., xy(4,Xp),xy(4,Yp))
	xy(5,Xp) = xy(1,Xp)
	xy(5,Yp) = xy(1,Yp)
c       write(*,*) xy(1,Xp), xy(1,Yp), xy(3,Xp), xy(3,Yp)
	call setlvis(ivis)
	call setltype(1)
c       call translate(xy(1,Xp), xy(1,Yp), tde(Xp,Xo,E2D), HMPT)
	call connect(xy(1,Xp), xy(1,Yp), HMPT)
	call setltype(0)
	call setlvis(0)
	return
	end
C==============================================================================
C==============================================================================
	subroutine mosaic(mos,ivis)
c       plot outlines of all of the detectors in the mosaic
	IMPLICIT_NONE
#       include "echelle.par"
C       External Variables
c                       which mosaic position
	integer         mos
c                       Lick Mongo line-visibility
	integer         ivis
C       Local Variables
c                       loop
	integer         i
C       Common Block
	include 'detmos.inc'
C       Executable Code
	call setcolor(4)
	do 10 i = 1,nchips
	  call ccdbox(mos,i,ivis)
10      continue
	call setcolor(1)
	return
	end
C==============================================================================
C==============================================================================
	subroutine ccdbox(mos,ndet,ivis)
c       draw the outline of a detector on the display
	IMPLICIT_NONE
C       Parameters
c                       how many points?
	integer         HMPT
	parameter       (HMPT = 5)
#       include "echelle.par"
#       include "include/units.par"
C       External Variables
c                       which mosaic position
	integer         mos
c                       which detector in the mosaic
	integer         ndet
c                       Lick Mongo line-visibility
	integer         ivis
C       Local Variables
c                       positions of corners of detectors on format [mm]
	real            xy(HMPT,Xp:Yp)
C       Common Block
	include 'detmos.inc'
	include 'setup.inc'
C       Executable Code
	call pixpos(mos,ndet,0.               ,0.     ,
     &  xy(1,Xp),xy(1,Yp))
	call pixpos(mos,ndet,npix(ndet,Xp)+1.,0.     ,
     &  xy(2,Xp),xy(2,Yp))
	call pixpos(mos,ndet,npix(ndet,Xp)+1.,npix(ndet,Yp)+1.,
     &  xy(3,Xp),xy(3,Yp))
	call pixpos(mos,ndet,0.               ,npix(ndet,Yp)+1.,
     &  xy(4,Xp),xy(4,Yp))
	xy(5,Xp) = xy(1,Xp)
	xy(5,Yp) = xy(1,Yp)
c       write(*,*) xy(1,Xp), xy(1,Yp), xy(3,Xp), xy(3,Yp)
	call setlvis(ivis)
c       call translate(xy(1,Xp), xy(1,Yp), tde(Xp,Xo,E2D), HMPT)
	call connect(xy(1,Xp), xy(1,Yp), HMPT)
	call setlvis(0)
	return
	end
C==============================================================================
C==============================================================================
	subroutine badcol(mos,ivis)
c       draw all the bad spots of a given detector mosaic
	IMPLICIT_NONE
#       include "echelle.par"
#       include "include/units.par"
#       include "include/stdio.par"
C       Parameter
c                       how many points?
	integer         HMPT
	parameter       (HMPT = 2)
c                       we draw using the default foreground color
	integer         FGCLR
	parameter       (FGCLR = 1)
C       External Variables
c                       which mosaic position
	integer         mos
c                       Lick Mongo line-visibility
	integer         ivis
C       Local Variables
	integer         i, j
c                       positions of ends of bad columns on format [mm]
	real            xy(HMPT,Xp:Yp)
C       Common Block
	include 'detmos.inc'
	include 'setup.inc'
C       Executable Code
	call setlvis(ivis)
c       note that the binning factor of the chip is considered when drawing
	do 10 i = 1,nbspot
c         which chip does this bad spot live on
	  j = bspot(cID,i)
c         position of badspot corner nearest to readout amp
	  call pixpos(mos, j,
     &    real( (bspot(Xp,i)/xbin(j))*xbin(j) ),
     &    real( (bspot(Yp,i)/ybin(j))*ybin(j) ),
     &    xy(1,Xp), xy(1,Yp))
c         position of badspot corner farthest from readout amp
	  call pixpos(mos, j,
     &    real(((bspot(Xp,i)+bspot(dX,i) + xbin(j)-1)/xbin(j))*xbin(j)),
     &    real(((bspot(Yp,i)+bspot(dY,i) + ybin(j)-1)/ybin(j))*ybin(j)),
     &    xy(2,Xp), xy(2,Yp))
c         draw the sucker
c         call translate(xy(1,Xp), xy(1,Yp), tde(Xp,Xo,E2D), HMPT)
	  call mrectang(xy(1,Xp), xy(1,Yp), xy(2,Xp), xy(2,Yp), 5)
10      continue
	call setlvis(0)
	return
	end
C==============================================================================
C==============================================================================
	subroutine marklines
c       For every wavelength in the array lambda, plot a dot on the
c       Echelle format which marks that spectral line.
	IMPLICIT_NONE
C       Parameters
#       include "echelle.par"
C       Local Variables
C       Common Blocks
	include 'linpos.cmn'
	include 'lam.cmn'
	include 'cdata.inc'
c       include 'setup.inc'
C       Executable Code
c       calculate the position of each line on the echelle format
	call calclines
c       plot the lines which are inside the FSR
	call points(83.,1,yline(MINLIN,1),xline(MINLIN,1),nlam)
c       plot the lines which are outside the FSR
	call points(80.,1,yline(MINLIN,2),xline(MINLIN,2),nlam)
c       plot the last point where the cursor was known to be
	call points(41.,1,xclast,yclast,1)
	return
	end
C==============================================================================
C==============================================================================
	subroutine calclines
c       Calculate the position on the echelle format for every line in array
c       lambda.
	IMPLICIT_NONE
C       Parameters
#       include "echelle.par"
C       Local Variables
c                       loop
	integer         i, j
c                       the redshifted wavelength
	real            redlam
c                       temporary location to store position
	real            xyl(2,Xp:Yp)
C       Common Blocks
	include 'linpos.cmn'
	include 'lam.cmn'
	include 'setup.inc'
C       Executable Code
	do 50 i = MINLIN,MINLIN-1+nlam
	  redlam = lambda(i)
c         if this is not a terrestrial line, redshift it
	  if (.not. earth(i)) redlam = redlam * (1 + redshift)
c         Take this wavelength and find out where on the Echelle format
c         it would fall.  Return with the position and index of order number.
	  call wav2pos(redlam, xyl, ilval(1,i))
	  do 40 j=1,2
	    xline(i,j) = xyl(j,Xp)
	    yline(i,j) = xyl(j,Yp)
40        continue
50      continue
c       Now must convert from Echelle format coords to Lick Mongo world coords
c       positions of lines which are inside the FSR
	call translate
     &  (yline(MINLIN,1), xline(MINLIN,1), tde(Xp,Xo,E2D), nlam)
c       positions of lines which are outside the FSR
	call translate
     &  (yline(MINLIN,2), xline(MINLIN,2), tde(Xp,Xo,E2D), nlam)
	return
	end
C==============================================================================
C==============================================================================
	subroutine linepos(outfile)
c       For every wavelength in the array lambda, find that position of
c       that line on the detector and write it to an output file.
	IMPLICIT_NONE
C       Parameters
#       include "echelle.par"
#       include "include/stdio.par"
C       External Variable
c                       name of the file to write output
	character*(*)   outfile
C       Local Variables
c                       loop
	integer         i, j
c                       I/O status
	integer         ios
c                       index of detector in which line falls
	integer         idet
c                       pixel coordinates of line
	real            xpix, ypix
C       Common Blocks
	include 'linpos.cmn'
	include 'lam.cmn'
	include 'echord.cmn'
	include 'setup.inc'
C       Executable Code
c       see if we can open the output file
	open(EFOLUN,file=outfile,status='unknown',iostat=ios)
	if (ios .ne. SUCCESS) then
	    write(STDERR,*)
     &      'linepos: could not open output line position file'
	    write(STDERR,*) 'name of file was ',outfile
	    return
	endif
c       paranoia of an experienced Fortran programmer
	rewind(EFOLUN)
c       write all the "header" info to the file
	write(EFOLUN,*)
     &  '# Echelle simulator: approximate positions of marked lines'
	write(EFOLUN,*) 'DetFilNm: ', detfilnm
	write(EFOLUN,*) 'SpcFilNm: ', spcfilnm
	write(EFOLUN,*) 'WaveFile: ', wavefile
	write(EFOLUN,*) 'ECHANGL: ' , ecangle
	write(EFOLUN,*) 'XDANGL: '  , xdangle
	write(EFOLUN,*)
     &  '# lambda[A] x[pixel] y[pixel] order detID telluric?'
	write(EFOLUN,*) 'DataBegin:'
c       calculate the position of each line on the echelle format
	call calclines
c       loop over every defined spectral line
	do 500 i = MINLIN,MINLIN-1+nlam
c         loop over the nearest to blaze and next nearest to blaze
	  do 100 j =1,2
c           convert from Lick Mongo world coords to detector coords
	    call detcoord(yline(i,j),xline(i,j),idet,xpix,ypix)
	    if (idet .ne. -1) then
		write(EFOLUN,'(f9.2,2f9.1,i5,i4,3x,l1)')
     &          lambda(i),xpix,ypix,morder(ilval(j,i)),idet,earth(i)
	    endif
100       continue
500     continue
	close(EFOLUN)
	return
	end
C==============================================================================
C==============================================================================
--------------- echsubs.F ------------------------
#include "include/port.h"
C==============================================================================
C==============================================================================
	subroutine cursdata(xcurs,ycurs)
c       Given a position on the Echelle format, calculate all the
c       interesting facts about that location.
	IMPLICIT_NONE
C       Parameter
#       include "echelle.par"
#       include "include/units.par"
C       External Variables
c                       Focal Plane coordinates of the cursor [mm]
	real            xcurs, ycurs
C       Local Variables
	integer         nord, n1, n2, npoint
	real            y1, y2, dy1, dy2
C       Common Blocks   -------------------------------------------------
	include 'echord.cmn'
	include 'cdata.inc'
	include 'lims.cmn'
	include 'spgraf.inc'
	include 'detmos.inc'
	include 'setup.inc'
C       Executable Code
	if (ycurs .le. (0.5*(x(0,mc) + x(1,mc))) ) then
c           cursor below all the orders
	    nord = 1
	elseif (ycurs .ge. (0.5*(x(norders,mc)+x(norders+1,mc))) ) then
c           cursor above all the orders
	    nord = norders
	else
c           start a binary search to find out what order cursor was on
	    n1 = 1
	    n2 = norders
50          continue
	    if (n2 .eq. n1) then
c               we have found the correct order
		nord = n1
	    elseif ( abs(n2-n1) .eq. 1) then
c               we are within 1 of the correct order
		y1 = x(n1,mc)
		if (tilt) y1 = y1 + delx(n1)*xcurs/f2db(n1)
		y2 = x(n2,mc)
		if (tilt) y2 = y2 + delx(n2)*xcurs/f2db(n2)
		dy1 = abs(ycurs - y1)
		dy2 = abs(ycurs - y2)
		if (dy2 .lt. dy1) then
		    nord = n2
		else
		    nord = n1
		endif
	    else
c               binary search
		npoint = (n2 + n1)/2
		y1 = x(npoint,mc)
		if (tilt)
     &          y1 = y1 + delx(npoint)*xcurs/f2db(npoint)
		if (ycurs .gt. y1) then
		    n1 = npoint
		elseif (ycurs .lt. y1) then
		    n2 = npoint
		elseif (.not. tilt .and. ycurs .eq. x(npoint,mc)) then
		    nord = npoint
		    goto 100
		endif
		goto 50
	    endif
	endif
c       The search is done, we know which order the cursor was near
100     continue
	corder = morder(nord)
	clambdab = wv(nord)
	dispamm = fsr(nord) / f2db(nord)
	dispapx = dispamm * pixsiz(ONLY1,Xp) * mmPERm
	clambda = clambdab + xcurs*dispamm
	csepm = delx(nord)
	csepp = delx(nord) * mPERmm / pixsiz(ONLY1,Xp)
	cseps = phi(nord)
	clen = f2db(nord)
	cloc = x(nord,mc)
	cdkpix = dckpix(nord)
c       new calculation for getting the cross disperser wavelength
	y1 = x(nord,mc)
	if (tilt) y1 = y1 + delx(nord)*xcurs/f2db(nord)
	dy1 = (ycurs - y1) / delx(nord)
	if (dy1 .gt. 0.) then
	    cxlambda = clambda + (wv(nord+1)-wv(nord))*dy1
	else
	    cxlambda = clambda + (wv(nord)-wv(nord-1))*dy1
	endif
c       write(STDERR,*) 'xcurs,ycurs,cxlambda',xcurs,ycurs,cxlambda
	return
	end
C==============================================================================
C==============================================================================
	subroutine detcoord(xc,yc,idet,dpx,dpy)
c       Find out which detector a point is inside, if any, and where
c       Most often the point of interest will be the cursor, but it
c       may be a particular spectral line.
	IMPLICIT_NONE
C       Parameters
#       include "echelle.par"
#       include "include/units.par"
C       External Variables
c                       input:  Focal Plane coordinates of a point [mm]
	real            xc, yc
c                       output: index of the detector containing the point
c                       If not inside any detector, returns -1
	integer         idet
c                       output: pixel coordinates of the point, if inside
	real            dpx, dpy
C       Internal Variables
	real            cx, cy
C       Common Blocks
	include 'setup.inc'
	include 'detmos.inc'
c       include 'cdata.inc'
C       Executable Code
c       Convert to Detector Mosaic coordinates
	cx = (xc - posmos(Xp,0)) * mPERmm
	cy = (yc - posmos(Yp,0)) * mPERmm
c       search all chips for insidedness
	do 1000 idet=1,nchips
	  dpx = tmc(Xp,Xo,M2C,idet)*cx + tmc(Xp,Yo,M2C,idet)*cy +
     &    tmc(Xp,To,M2C,idet)
	  dpy = tmc(Yp,Xo,M2C,idet)*cx + tmc(Yp,Yo,M2C,idet)*cy +
     &    tmc(Yp,To,M2C,idet)
c         if we are inside this chip, jump out with no further checking
	  if (  0 .le. dpx .and. dpx .le. (npix(idet,Xp)+1)
     &    .and. 0 .le. dpy .and. dpy .le. (npix(idet,Yp)+1) ) goto 1001
1000    continue
1001    continue
	if (idet .gt. nchips) idet = -1
	return
	end
C==============================================================================
C==============================================================================
	subroutine wav2pos(waveln,xyl,numord)
c       Given a wavelength waveln this routine finds the positions on the
c       plotted Echelle format at which that wavelength will be found.
c       Two positions are returned; these are in two adjacent Echelle orders.
c       The first position is for the Echelle order where waveln is
c       closest to the Echelle blaze wavelength; the second position is for
c       the next closest occurrance of waveln.
	IMPLICIT_NONE
C       Parameters
#       include "echelle.par"
C       External Variables
c                       wavelength of interest [Aangstrom]
	real            waveln
c                       positions of waveln on focal plane [mm]
	real            xyl(2,Xp:Yp)
c                       index of order number in which this line best appears
	integer         numord(2)
C       Local Variables
c                       current limits of binary search
	integer         n1, n2, npoint
c                       (waveln - (Echelle blaze wavelength)) [Aangstrom]
	real            dellam
C       Common Blocks
	include 'echord.cmn'
	include 'lims.cmn'
	include 'spgraf.inc'
	include 'setup.inc'
C       Executable Code
	if (waveln .ge. wv(1) .and. waveln .le. wv(norders))then
c           this line is inside the specified wavelength range
	    n1 = 1
	    n2 = norders
20          continue
	    npoint = (n2 + n1) / 2
	    if (n2 .eq. n1) then
		    npoint = n1
	    elseif ( abs(n2-n1) .eq. 1) then
c               we are within one of the correct order
		if ((waveln-wv(n1))/fsr(n1) .le. 0.5) then
		    npoint = n1
		else
		    npoint = n2
		endif
	    else
c               this is a binary search
		if (waveln .gt. wv(npoint)) then
		    n1 = npoint
		    goto 20
		elseif (waveln .lt. wv(npoint))then
		    n2 = npoint
		    goto 20
		else
c                   they are equal, fall thru the if blocks to the calc
		endif
	    endif
	    do 40 n1=1,2
	      numord(n1) = npoint
	      dellam = (waveln - wv(npoint)) / fsr(npoint)
	      xyl(n1,Xp) = dellam * f2db(npoint)
	      xyl(n1,Yp) = x(npoint,mc)
	      if (tilt) xyl(n1,Yp) = xyl(n1,Yp) + dellam * delx(npoint)
	      npoint = npoint + sign(1.,dellam)
40          continue
	else
c           this line is outside the specified wavelength range
	    do 140 n1=1,2
	      numord(n1) = 0
	      xyl(n1,Xp) = 1.e9
140         continue
	endif
	return
	end
C==============================================================================
C==============================================================================
	subroutine getwave()
c       Open and read a wavelength file (if any)
	IMPLICIT_NONE
C       Parameters
#       include "echelle.par"
#       include "include/stdio.par"
C       Internal Variables
c                       loop
	integer         k
c                       I/O status
	integer         ios
	character       fname*(MXPATH)
C       External function
c       integer         PMGO(lenc)
C       Common Block
	include 'lam.cmn'
	include 'lims.cmn'
	include 'setup.inc'
C       Executable Code
	if (wavefile .eq. ' ') return
	fname = wavefile
	call canonfile(NDEFDIR,defdir,fname)
c       if (PMGO(lenc)(fname) .gt. 0) then
	if (fname .ne. ' ') then
c           the filename is not null
	    open(unit=WAVLUN,file=fname,status='OLD',
     &      form='FORMATTED',iostat=ios)
	    if (ios .ne. 0) then
		write(STDERR,*) ' Error opening file ',fname
	    else
		k = MINLIN
		ios = SUCCESS
7               continue
		read(WAVLUN,*,iostat=ios) lambda(k), earth(k), wt(k)
		if (ios .eq. EOF) then
c                   normal termination, fall off ifblock
		elseif (ios .ne. SUCCESS) then
c                   some kind of error while reading file
		    write(STDERR,*) 'Error reading file ',fname
		    write(STDERR,*) 'Check format and protection.'
		elseif (ios .eq. SUCCESS) then
c                   successful read
		    k = k + 1
		    if (k .le. MAXLIN) then
c                       there is still room, go back for more
			goto 7
		    else
c                       full table of lines, report and fall through
			write(STDERR,*)
     &                  'Not enough room for all the lines in ',fname
			write(STDERR,*)
     &                  'Increase parameter NUMLIN for more.'
		    endif
		endif
		nlam = k - MINLIN
		close(WAVLUN)
	    endif
	else
c           the filename is null
	    write(STDERR,*) ' Cannot find a file called ',wavefile
	endif
	return
	end
C==============================================================================
C==============================================================================
	subroutine calcform(fixspace)
c       This is the subroutine which actually calculates the format of the
c       echelle spectrum on the detector.  The original author of this code
c       (Schroeder) did not include any references to published texts.
c       (Presumably because his own text was not yet published.)
c       References have been added, and they are to the text of the author, viz.
c       Astronomical Optics; Daniel J. Schroeder; Academic Press, Inc.; 1987
c       For prism dispersion, new references have been added to this text:
c       Optics; E. Hecht & A. Zajac; Addison-Wesley; 1974
	IMPLICIT_NONE
C       Parameters      ------------------------------------------------
#       include "echelle.par"
#       include "include/units.par"
#       include "include/stdio.par"
C       External Variables
c                       When a grating is being ruled, it is usually best if
c                       the spacing between the grooves is an integral multiple
c                       of the wavelength of a reference beam.
c                       A commonly used wavelength is that produced by
c                       a Helium-Neon laser.
c                       If this program is being used to design a spectrograph,
c                       the designer may wish to enforce such a spacing.
c                       fixspace determines whether such spacing is enforced.
	logical         fixspace
C       Internal Variables
c                       the blaze wavelength of an echelle order
c                       sometimes [um], sometimes [mm]
	real            bwav
c                       the echelle order number of the bluest (shortest) order
	integer         ms
c                       the echelle order number of the reddest (longest) order
	integer         ml
c                       loops
	integer         i, j, mi
c                       temporary variable
	real            temp
c               For Prism Cross Dispersion
c                       incident angle from surface normal for a prism [radian]
	real            thetain
c                       outbound angle from surface normal for a prism [radian]
	real            thetout
c                       {the index of refraction of the prism cross disperser}
c                       evaluated at blaze wavelength of one order
c                       [dimensionless]
	real            avn
c               For Grating Cross Dispersion
c                       sine of incident angle (alpha)
	real            sa
C       External Function
	real            glref
C       Common Blocks   ------------------------------------------------
	include 'schott.cmn'
	include 'echord.cmn'
	include 'spgraf.inc'
	include 'setup.inc'
C       Executable Code ------------------------------------------------
c       compute echelle blaze angle in radians
	ecdelta = ecdeltad * radPERdeg
c       compute theta (half angle) in radians
	ectheta = ecthetad * radPERdeg
	if (fixspace) then
C           Convert spacing to integral number of HeNeWAV wavelengths
	    ecsigma = AangPERmm / ecsigmai
	    ecsigma = (HeNeWAV * nint(ecsigma / HeNeWAV)) * mmPERAang
	    ecsigmai = umPERmm / ecsigma
	else
	    ecsigma = umPERmm / ecsigmai
	endif
	f2dbdl = camfocln*mmPERm / (ecsigma * cos(ecdelta - ectheta))
c       base is the echelle grating constant m*lambda [micrometers]
c       see Shroeder Table 15.3
	base = 2.*ecsigma*sin(ecdelta)*cos(ectheta)
c       this order is the next bluer order than the one containing ws
	ms = int((AangPERum * base / ws) + 0.5) + 1
c       this order is the next redder order than the one containing wl
	ml = int((AangPERum * base / wl) - 0.5)
	norders = (ms - ml) - 1
	if (norders .ge. MAXORD) then
	    write(STDERR,*)
     &      'There are too many echelle orders in the wavelength range.'
	    write(STDERR,*) norders,' >= ',MAXORD
	    write(STDERR,*) ' Increase parameter MAXORD and try again.'
	    stop
	endif
c       The collimator/echelle/cross disperser/camera combination reimages
c       the slit onto the detector and shrinks it in the process.
c       Temporarily, calculate magnification if there were no dispersers.
	demag = camfocln / colfocln
c       write(92,*) 'demag', demag
c       N.B.  This calculation assumes that theta is a constant.  Many
c       echelle gratings can be rotated to "tune" them to look at wavelengths
c       slightly off the blaze.  Such a rotation changes theta, and thus
c       changes the blaze wavelengths, FSRs, &c. of the echelle.
	i = -1
	do 222 mi = ms,ml,-1
	  i = i + 1
c         note that the order number (morder) counts DOWN as i counts UP
	  morder(i) = mi
c         blaze wavelength of echelle order morder(i) [micrometers]
	  bwav = base / morder(i)
c         blaze wavelength of echelle order morder(i) [Aangstroms]
	  wv(i) = AangPERum * bwav
c         the Free Spectral Range of order morder(i) [Aangstroms]
c         this is denoted "DELTA lambda" in Schroeder Table 15.3
	  fsr(i) = wv(i) / morder(i)
c         the length of the FSR of morder(i) on the detector [mm]
c         this is f2 * "DELTA beta" in Schroeder Table 15.3
	  f2db(i) = bwav * f2dbdl
c         initialize decker magnification for each order
	  deckmag(i) = demag
222     continue
C       ----------------------------------------------------------------
c       to get the format, compute the effects of the cross dispersers
c       compute the cross dispersion of any prisms
c       see H&Z eqs. 5.52 and 5.53
	if (nxdprism .gt. 0) then
	    do 511 i = 0,norders+1
	      bwav = wv(i) * umPERAang
	      avn = glref(iglass,bwav)
	      x(i,mc) = 0.
	      thetain = prangind * radPERdeg
	      do 500 j = 1,nxdprism
		temp = sin(thetain)
		thetout = asin(sin(prapexd(j)*radPERdeg) *
     &          sqrt(avn**2 - temp**2) -
     &          temp * cos(prapexd(j)*radPERdeg) )
		deckmag(i) = deckmag(i) * cos(thetain) / cos(thetout)
		thetain = prface(j+1)*radPERdeg - thetout
500           continue
	      x(i,mc) = -thetout
511         continue
	endif
C       ---------
c       compute the cross dispersion of any gratings
	if (nxdgrat .gt. 0) then
c           Compute the incident angle (alpha).
c           This uses the given value of xdangle as the tilt of the
c           cross-disperser off-blaze.
	    xdalphad = xdangle + xddeltad + xdalfbet*0.5
	    sa = sin(xdalphad * radPERdeg)
c           For blaze wavelength of each Echelle order, calculate the
c           outgoing angle (beta) from the cross dispersing grating.
c           See Schroeder Eq. 13.2.1, Fig. 13.2, and associated text.
	    do 275 j = mci(1), mci(2)
	      temp = j * xdsigmai * mmPERAang
	      do 225 i = 0,norders+1
c               this is the diffracted angle (beta) for this wavelength
		if (nxdprism .gt. 0) then
		    x(i,j) = x(i,mc) + asin(temp * wv(i) - sa)
		else
		    x(i,j) = asin(temp * wv(i) - sa)
		endif
		if (j .eq. mc) then
		    deckmag(i) = deckmag(i) *
     &              sqrt( (1. - sa*sa) / (1. - (temp * wv(i) - sa)**2))
		endif
225           continue
275         continue
c           for reference, save the outgoing angle of two orders
	    xdbetad(1) =asin(mc*xdsigmai*mmPERAang*wv(1) - sa)*degPERrad
	    xdbetad(2) =asin(mc*xdsigmai*mmPERAang*wv(norders) - sa) *
     &      degPERrad
c           and for display, save the outgoing central angle
	    xdbetad(3) = xdalphad - xdalfbet
	endif
C       ---------
c       The dispersers have an anamorphic effect which is different in
c       the two different directions of dispersion.
c       See Shroeder eqs. 12.2.1a, 13.1.1, 13.2.3 and the related text.
c       For purposes of variable naming in an Echelle spectrograph, the
c       two different magnifications are here called slitmag and deckmag.
c       These are in the Echelle and cross dispersing directions, respectively.
c       deckmag has already been calculated for each order.
c       Slitmag also varies slightly along each order, but here we simply
c       calculate the magnification when the Echelle is on-blaze.
c       magnification of slit on detector [dimensionless]
	slitmag = demag * cos(ecdelta + ectheta)/cos(ecdelta - ectheta)
C       ---------
c       Convert the angular deviations caused by the cross-disperser into
c       linear displacement at the camera focus.
c       up to this point, x has been the angular deviation [radians]
c       this loop converts each x into linear deviation [mm]
	if (nxdprism .gt. 0) then
c           there are prisms in use...
c           put x=0 in the middle of the format
	    temp = ( x(1,mc) + x(norders,mc) ) * 0.5
	else
c           no prisms in use
c           put x=0 at the point which is directly on the optical axis
c           of the beam as it leaves the cross disperser headed toward camera
	    temp = (xdangle + xddeltad - xdalfbet*0.5) * radPERdeg
	endif
	do 720 j = mci(1), mci(2)
	  do 700 i = 0,norders+1
	    x(i,j) = (x(i,j) - temp) * camfocln * mmPERm
700       continue
720     continue
c       using the previous calculations, take their "derivative"
	do 750 i = 1,norders
	  delx(i) = 0.5 * (x(i+1,mc) - x(i-1,mc))
	  phi(i) = focscale * delx(i) / deckmag(i)
750     continue
c       finally, calculate where the detector is, and how big slit is
	call spc2det
	call calcdeck
	call calcslit
	call echtran
	return
	end
C==============================================================================
C==============================================================================
	subroutine det2spc(egtilt)
c       Given information about the position of the detector on the Echelle
c       format, calculate the configuration of the spectrograph.
c       COMPARE THIS ROUTINE WITH spc2det, WHICH DOES THE OPPOSITE.
c       Inputs are the last position of the cursor clambda and
c       cxlambda or the position of the mosaic.
c       Results are new values of ecangle xdangle xdalphad hamhgd egtilt.
	IMPLICIT_NONE
C       Parameters
#       include "include/units.par"
#       include "echelle.par"
C       External Variables
c                       this might have been in the setup.inc common block
c                       but is is not.  It is the tilt of the Hamilton
c                       Echelle grating measured in encoder units.
	real            egtilt
C       Internal Variables
C       Common Block
	include 'spgraf.inc'
	include 'setup.inc'
	include 'echord.cmn'
	include 'lims.cmn'
	include 'cdata.inc'
C       Executable Code
c       use the position of the mosaic to determine which wavelengths at origin
c       Note that this corrupts the values of everything in the cdata common
c       such that it thinks the cursor was at the origin of the mosaic,
c       but that the cursor may, in fact, have been at an edge or corner
c       after a drag of the detector.
c       Note that we take care to find the position of the center of
c       the mosaic, not the position of the origin (which may not be at center).
	call cursdata(posmos(Xp,0)+cormos(Xp,0),
     &  posmos(Yp,0)+cormos(Yp,0))
c       calculate the Echelle rotation angle off blaze
	ecangle = asin( corder * clambda /
     &  (2 * AangPERum * ecsigma * cos(ectheta)))
     &  * degPERrad - ecdeltad
c       The following calc does not handle a spectrograph with both
c       prisms and gratings for cross dispersion.
	if (nxdgrat .gt. 0) then
	    xdangle = asin( mc * cxlambda /
     &      (2 * AangPERum * xdsigma * cos(xdalfbet*0.5*radPERdeg)))
     &      * degPERrad - xddeltad
	    xdalphad = xdangle + xddeltad + xdalfbet*0.5
	else
c           Hamilton Spectrograph with TI 800x800 CCD
c           Hamilton Dewar stepper motor height in device units
c           when order 120 is at center of chip, we are at hgt(0)
	    hamhgt = hgt(0) + hgt(1) *
     &      (posmos(Yp,0) + cormos(Yp,0) - x(i120,mc))
c           Hamilton Echelle grating tilt in device units
c           when center of chip is on blaze, we are at egt(0)
	    egtilt = egt(0) + egt(1) *
     &      (posmos(Xp,0) + cormos(Xp,0))
	endif
	return
	end
C==============================================================================
C==============================================================================
	subroutine spc2det
c       Given information about the state of the spectrograph,
c       calculate where on the Echelle format the detector will be.
c       COMPARE THIS ROUTINE WITH det2spc, WHICH DOES THE OPPOSITE.
c       This is intended to be called after calcform.
c       Its typical use is to calculate where the detector array will be
c       on the Echelle format given grating angles and/or stage positions.
c       Inputs are xdangle or hamhgt and ecangle.
c       Results are posmos(Xp,0), posmos(Yp,0), xdalphad, and
c       a new transform matrix.
	IMPLICIT_NONE
C       Parameters
#       include "include/units.par"
#       include "echelle.par"
c                       symbolic to avoid any confusion
	integer         ACPL
	parameter       (ACPL = 2)
C       Internal Variables
c                       cross disperser wavelength produced by xdangle [Aang.]
	real            xlam
c                       Echelle wavelength produced by ecangle [Aangstrom]
	real            elam
c                       position of wavelengths on Echelle format [mm]
	real            xyl(ACPL,Xp:Yp)
c                       indices of Echelle orders nearest to wavelength
	integer         numord(ACPL)
c                       loop
	integer         i
C       Common Block
	include 'spgraf.inc'
	include 'setup.inc'
	include 'echord.cmn'
	include 'lims.cmn'
C       Executable Code
c       This code does not handle the case where there are both prisms and
c       gratings for cross dispersion.
	if (nxdgrat .gt. 0) then
c           cross dispersing grating
	    xlam = (2 * AangPERum * xdsigma *
     &      cos(xdalfbet*0.5*radPERdeg) *
     &      sin((xddeltad + xdangle) * radPERdeg)) / mc
	    call wav2pos(xlam, xyl, numord)
c           (mosaic center) = (position of desired light) - (coord of ctr)
	    posmos(Yp,0) = xyl(1,Yp) - cormos(Yp,0)
	    xdalphad = xdangle + xddeltad + xdalfbet*0.5
	else
c           cross dispersing prism
C           THIS CODE ONLY WORKS FOR HAMILTON SPEC WITH TI 800x800 CCD
	    posmos(Yp,0) = ((hamhgt - hgt(0)) / hgt(1)) +
     &      (x(i120,mc) - cormos(Yp,0))
	endif
c       this is the blaze wavelength times Echelle order number
	elam = 2 * ecsigma * AangPERum * cos(ectheta) *
     &  sin((ecdeltad + ecangle) * radPERdeg)
	do 100 i=1,ACPL
	  icord = numord(i)
c         this is the number of Free Spectral Ranges off blaze
	  xyl(i,Yp) = (elam / morder(icord) - wv(icord)) / fsr(icord)
100     continue
	if (abs(xyl(1,Yp)) .le. abs(xyl(2,Yp))) then
c           choose the first position as closest
	    i = 1
	else
c           choose the second position as closest
	    i = 2
	endif
	icord = numord(i)
c       position of center = (# of mm off blaze) - (coord of center)
	posmos(Xp,0) = xyl(i,Yp) * f2db(icord) - cormos(Xp,0)
c       calculate the new transformation matrix from echelle to mosaic
	call distran
	return
	end
C==============================================================================
C==============================================================================
	subroutine calcdeck
c       Step through all the possible ways in which the decker may be set
c       Find the way with the highest priority and use it to reset all
c       the other values.
C       Parameters
#       include "echelle.par"
#       include "include/stdio.par"
#       include "include/units.par"
C       Internal Variables
c                       geometric mean pixel size
	real            pixmean
c                       loop
	integer         i
C       Common Blocks
	include 'detmos.inc'
	include 'echord.cmn'
	include 'setup.inc'
	include 'spgraf.inc'
C       Executable Code
c       This code does not work for non-square pixels,
c       but we take the geometric mean of the pixels in such a case.
	pixmean = sqrt(pixsiz(ONLY1,Xp) * pixsiz(ONLY1,Yp))
c       The order nearest the center of the detector is icord.
c       The decker size in pixels varies slightly across the Echelle
c       format.  DECKHGT and DECKSIZE are constant, but DECKSIZE depends
c       upon the telescope and not on the spectrograph proper.
c       DECKHGT is therefore regarded as the canonical specification.
c       If the observer specified something else, the order at the center of
c       the detector is used to set DECKHGT from the wishes of the observer.
	if     (deckmeth .eq. i_DECKHGT ) then
c           do nothing
	elseif (deckmeth .eq. i_DECKSIZE) then
	    deckhgt = decksize / (focscale * mmPERm)
	elseif (deckmeth .eq. i_DECKPIX ) then
	    deckhgt = deckpix * pixmean / deckmag(icord)
	else
	    write(STDERR,*) 'calcdeck: no method'
	endif
	decksize = deckhgt * focscale * mmPERm
	do 100 i = 0,MAXORD
	  dckpix(i) = deckhgt * deckmag(i) / pixmean
100     continue
	deckpix  = dckpix(icord)
	return
	end
C==============================================================================
C==============================================================================
	subroutine calcslit
c       Step through all the possible ways in which the slit may be set
c       Find the way with the highest priority and use it to reset all
c       the other values.
C       Parameters
#       include "echelle.par"
#       include "include/stdio.par"
#       include "include/units.par"
c                       number of machine encoder units per meter of slit width
	real            meuPERslitm
	parameter       (meuPERslitm = 1.e6)
C       Internal Variables
c                       geometric mean pixel size
	real            pixmean
C       Common Blocks
	include 'detmos.inc'
	include 'echord.cmn'
	include 'setup.inc'
	include 'spgraf.inc'
C       Executable Code
c       This code does not work for non-square pixels,
c       but we take the geometric mean of the pixels in such a case.
	pixmean = sqrt(pixsiz(ONLY1,Xp) * pixsiz(ONLY1,Yp))
c       The order nearest the center of the detector is icord.
c       The slit size in pixels and velocity varies slightly across the
c       Echelle format.  It actually varies along each Echelle order, but
c       that effect is NOT modelled here.
c       SLITWID and SLITSIZE are constant, but SLITSIZE depends
c       upon the telescope and not on the spectrograph proper.
c       SLITPIX does not change here, but slitmag is not really a
c       constant (this is the unmodelled effect).
c       SLITWID is therefore regarded as the canonical specification.
c       If the observer specified something else, the order at the center of
c       the detector is used to set SLITWID from the wishes of the observer.
	if     (slitmeth .eq. i_SLITWID ) then
c           do nothing
	elseif (slitmeth .eq. i_SLITSIZE) then
/*          slitwid  = slitsize / (focscale * mmPERm)                   */
	    slitwid  = slitsize /  focscale
	elseif (slitmeth .eq. i_SLITPIX ) then
/*          slitwid  = slitpix * pixmean / slitmag                      */
	    slitwid  = mmPERm * slitpix * pixmean / slitmag
	elseif (slitmeth .eq. i_SLITVEL ) then
/*          slitwid  = slitvel * base*f2dbdl / (slitmag*cLIGHT*mmPERm)  */
	    slitwid  = slitvel * base*f2dbdl / (slitmag*cLIGHT)
	elseif (slitmeth .eq. i_SLITRAW ) then
/*          slitwid  = slitraw / meuPERslitm                            */
	    slitwid  = mmPERm * slitraw / meuPERslitm
	else
	    write(STDERR,*) 'calcslit: no method'
	endif
#       ifdef METER
c       this was the old way, slitwid in [meter]
	slitsize = slitwid * focscale * mmPERm
	slitpix  = slitwid * slitmag / pixmean
	slitraw  = slitwid * meuPERslitm
	slitvel  = slitwid * slitmag * cLIGHT * mmPERm / (base * f2dbdl)
#       else /* METER */
c       new way, slitwid now in [mm]
	slitsize = slitwid * focscale
	slitpix  = slitwid * slitmag / pixmean * mPERmm
	slitraw  = slitwid * meuPERslitm * mPERmm
	slitvel  = slitwid * slitmag * cLIGHT / (base * f2dbdl)
#       endif /* METER */
	return
	end
C==============================================================================
C==============================================================================
	integer function findline(x,y,indx)
c       find the marked spectral line closest to point (x,y)
	IMPLICIT_NONE
C       Parameters
#       include "echelle.par"
#       include "include/stdio.par"
c                       default distance greater than which is ridiculous
	real            TOOFAR
	parameter       (TOOFAR = 1.e30)
C       External Variables
c                       x and y location of a point on the echelle format [mm]
	real            x, y
c                       if a line is found, this is the index pointing to it
	integer         indx
C       Internal Variables
c                       loop
	integer         i, j
c                       nearest distance so far
	real            dist, newdist
C       Common Blocks
	include 'lam.cmn'
	include 'linpos.cmn'
C       Executable Code
	if (nlam .le. 0) then
c           we return something other than SUCCESS
c           someday we might want to define other status codes
	    findline = EOF
	    return
	endif
	dist = TOOFAR
	do 20 j=1,2
	  do 10 i=MINLIN,MINLIN-1+nlam
	    newdist = ((x - xline(i,j))**2 + (y - yline(i,j))**2)
	    if (newdist .lt. dist) then
		dist = newdist
		indx = i
	    endif
10        continue
20      continue
	findline = SUCCESS
	return
	end
C==============================================================================
C==============================================================================
--------------- echvogt.F ------------------------
#include "include/port.h"
C==============================================================================
C==============================================================================
	subroutine minimize(sigi,thetad,deltad)
c       Minimize deviation of lines from blaze center by searching
c       through parameter space.  This routine is intended to be used
c       when designing a new spectrograph.
	IMPLICIT_NONE
#       include "include/stdio.par"
#       include "echelle.par"
#       include "include/units.par"
C       External Variables
c                       spacing of grooves on echelle grating [grooves/mm]
	real            sigi
c                       half angle (thetad) [degrees]
	real            thetad
c                       echelle blaze angle [degrees]
	real            deltad
C       Local Variables
	real            theta1, theta2, delta1, delta2
	real            stemp, sig1, sig2
	real            th1, th2, thb1, thb2, dth, dthb
	real            qmin, scheck, q
	integer         nth, nthb, nds, ith, ithb
	integer         isig, isig1, isig2, jsig
	real            sig0, theta0, delta0
	character*80    oneline
C       External Function
	real            func
C       Executable Code
700     write(STDOUT,PROMPT)
     &  ' Enter range of spacing [mm**-1] <min> <max>:  '
	call mx11gets(oneline)
	read(oneline,*,ERR=700) sig1,sig2
725     write(STDOUT,PROMPT)
     &  ' Enter range of theta [degrees] <min> <max>:  '
	call mx11gets(oneline)
	read(oneline,*,ERR=725) theta1,theta2
740     write(STDOUT,PROMPT)
     &  ' Enter range of blaze angle [degrees] <min> <max>:  '
	call mx11gets(oneline)
	read(oneline,*,ERR=740) delta1,delta2
	IF (SIG1 .GT. SIG2) THEN
c           reorder spacing values if they were backward
	    STEMP = SIG2
	    SIG2 = SIG1
	    SIG1 = STEMP
	ENDIF
	THB1 = delta1
	THB2 = delta2
	TH1 = THETA1
	TH2 = THETA2
	dth = min(abs(theta2-theta1)/20.,0.2)
	dthb = min(abs(delta2-delta1)/10.,0.25)
	QMIN = 1.E20
c       Check to see if one of the search parameters is fixed
	IF (THETA2-THETA1 .LE. 0) THEN
	    NTH = 1
	ELSE
	    NTH = IFIX((THETA2-THETA1)/DTH) + 1
	ENDIF
	IF (delta2-delta1 .LE. 0) THEN
	    NTHB = 1
	ELSE
	    NTHB  = IFIX((delta2-delta1)/DTHB) + 1
	ENDIF
	if(sig1 .eq. sig2) then
	    nds = 1
	else
c           Force spacing to be an integral number of HeNeWAV angstroms.
	    SIG1 = AangPERmm / SIG1 + HeNeWAV
	    SIG2 = AangPERmm / SIG2
	    ISIG2 = IFIX(SIG2/HeNeWAV)
	    SIG2 = HeNeWAV*FLOAT(ISIG2)
	    ISIG1 = NINT(SIG1/HeNeWAV)
	    NDS = ISIG1-ISIG2
	endif
	DO 759 ITH = 1,NTH
	  DO 757 ITHB = 1,NTHB
	    DO 755 ISIG = 1,NDS
	      SCHECK=SIG2+HeNeWAV*(ISIG-1)
	      IF(SCHECK .GT. SIG1) GO TO 755
	      SIGI = SCHECK
	      thetad = (ITH-1)*DTH + THETA1
	      deltad = delta1 + (ITHB-1)*DTHB
	      Q = FUNC(SIGI,thetad,deltad)
c             Mimimize Q,the weighted sum square of the line deviations
c             from blaze center
	      IF(Q .LT. QMIN) THEN
		  QMIN = Q
		  SIG0 = SIGI
		  THETA0 = thetad
		  delta0 = deltad
		  JSIG = ISIG
	      ENDIF
755         CONTINUE
757       CONTINUE
759     CONTINUE
	SIG0 = AangPERmm / SIG0
	thetad = THETA0
	deltad = delta0
	SIGI = SIG0
	return
	end
C==============================================================================
C==============================================================================
	real FUNCTION FUNC(SIG,thetad,deltad)
c       Find the weighted sum squared deviations of the line positions from
c       the blaze wavelength (Q-value). Weights range from 1-10.
	IMPLICIT_NONE
C       Parameters
#       include "echelle.par"
#       include "include/units.par"
C       External Variables
c                       spacing of grooves on echelle [grooves/mm]
	real            sig
c                       half angle (theta) [degrees]
	real            thetad
c                       echelle blaze angle [degrees]
	real            deltad
C       Internal Variables
	integer         i, m
	real            b, qtemp, wb, q
C       Common Block
	include 'lam.cmn'
C       Executable Code
c       Grating equation
	b = 2 * sig * sin(deltad*radPERdeg) * cos(thetad*radPERdeg)
	DO 10 I = 1,NLAM
c         Get order (m)
	  M = NINT(B / LAMBDA(I))
C         Get blaze wavelength
	  WB = B / M
	  QTEMP = WT(I)*2*(B/WB)*(LAMBDA(I)-WB)/WB
	  Q = QTEMP**2 + Q
10      continue
C       Normalize to the number of wavelengths
	FUNC = Q / NLAM
	RETURN
	END
C==============================================================================
C==============================================================================
--------------- fmanip.F ------------------------
#include "include/port.h"
C==============================================================================
C==============================================================================
	subroutine findfiles(tailend,numd,defdir,numf,files)
c       given tail end of a file name (the yyyy part of 'xxxx.yyyy')
c       find all files in a set of specified default directories
c       that end with that tail.
c       Return this list of files to the calling routine.
c       It is presumed that the user has the ability to write in the
c       current working directory.  Otherwise this fails.
c       This is, by its nature, very operating system dependent.
c       This should work on most Un*x systems.
	IMPLICIT_NONE
C       Parameters
#       include "include/stdio.par"
c                       logical unit for reading directory file
	integer         DLUN
	parameter       (DLUN = 97)
c                       max size of command line
	integer         COMLEN
	parameter       (COMLEN = 256)
c                       name of temporary file
	character*(*)   TMPFILE
	parameter       (TMPFILE = '.dir.')
c                       command to remove a file
	character*(*)   REMOVE
	parameter       (REMOVE = '/bin/rm -f')
c                       command to create an empty file
	character*(*)   CREATE
	parameter       (CREATE = '/bin/touch')
C       External Variables
c                       The tail end of the files to be matched
c                       This is taken literally on a Un*x system
c                       if value is 'foo.bar' we find *.foo.bar
c                       if value is '.foo.bar' we find *..foo.bar
c                       But we do not find "hidden" files starting with '.'
	character*(*)   tailend
c                       number of directories to search
	integer         numd
c                       default directory to search
	character*(*)   defdir(numd)
c                       On Input:  numf(0) is compiled size of array of strings
c                       On Output: numf(0) is total number of matches
c                       On Output: numf(i) is number of matched in dir i
	integer         numf(0:numd)
c                       list of matching files
	character*(*)   files(numf(0))
C       Internal Variables
c                       save value of numf(0)
	integer         maxf
c                       loops etc.
	integer         i, j
c                       length of the tail end
	integer         lentail
c                       length of default directory
	integer         lendef
c                       length of matching result
	integer         lenr
c                       command sent to OS to find contents of dir
	character       comstr*(COMLEN)
c                       Fortran I/O status
	integer         ios
C       External Functions
	integer         lenc
	integer         system
C       Executable Code
#       define STRIPSPACE
c       find correct length of the tail string
	lentail = lenc(tailend)
#       ifdef STRIPSPACE
	i = index(tailend,' ')
	if (i .ne. 0 .and. i .lt. lentail) lentail = i
#       endif /* STRIPSPACE */
	maxf = numf(0)
	numf(0) = 0
	do 1000 j=1,numd
	  numf(j) = 0
c         get rid of any previous result file
	  comstr = REMOVE//' '//TMPFILE//';'//CREATE//' '//TMPFILE
	  i = system(comstr)
c         find the correct length of the directory
	  lendef = lenc(defdir(j))
c         get all the matching names in this directory
	  if (lendef .gt. 0) then
#             ifdef STRIPSPACE
	      i = index(defdir(j),' ')
	      if (i .ne. 0 .and. i .lt. lendef) lendef = i
#             endif /* STRIPSPACE */
c             Note that this is specific to the Cshell, oops
	      comstr = 'csh -f -c "(/bin/ls '//defdir(j)(:lendef)//'/*.'
     &        //tailend(:lentail)//' >> '//TMPFILE//') >& /dev/null"'
	      i = system(comstr)
	  endif
c         read the matching names
	  open(unit=DLUN,file=TMPFILE,status='old')
	  rewind(DLUN)
	  i = numf(j-1)
	  ios = SUCCESS
100       continue
	  read(DLUN,ALINE,iostat=ios) comstr
	  if (ios .eq. SUCCESS) then
c             read another one successfully
	      lenr = lenc(comstr)
	      if (i .ge. maxf) then
		  write(STDERR,*)
     &            'findfiles: no room for '//comstr(:lenr)
	      elseif (comstr(1:1)       .eq. '#'
     &        .or.    comstr(lenr:lenr) .eq. '~' ) then
c                 ignore files with such names
c                 they are presumed to be editor backups
	      elseif (lenr-(lendef+1) .le. len(files(1))) then
c                 the name of the file will fit in the output string
		  if (comstr(lendef+2:lendef+2) .eq. '#') then
c                     kindly ignore this file
		  else
		      i = i + 1
		      numf(j) = numf(j) + 1
		      files(i) = comstr(lendef+2:)
		  endif
	      else
		  write(STDERR,*) 'findfiles: file name too long'
		  write(STDERR,*) comstr(:lenr)
	      endif
	      goto 100
	  elseif (ios .eq. EOF) then
c             normal completion, fall off if blocks
	  else
	      write(STDERR,*) 'findfiles: something weird'
	  endif
1000    continue
c       assign the proper count
	numf(0) = i
	return
	end
C==============================================================================
C==============================================================================
	subroutine canondir(envar,result)
c       Search the environment for a variable with the name in envar.
c       If one exists, put its value into result.
c       Otherwise, leave result unmodified.
	IMPLICIT_NONE
C       Parameters
#       include "include/stdio.par"
c                       maximum length of value of environment variable
	integer         MAXLEN
	parameter       (MAXLEN = 128)
C       External Variables
c                       If there exists an environment variable with the
c                       name in envar, its value is put into result.
c                       If there is no such environment variable
c                       result is not modified.
	character*(*)   envar
c                       presumably a hard-coded default directory which
c                       may be overridden by the environment.
	character*(*)   result
C       Internal Variables
c                       value of environment variable
	character       enval*(MAXLEN)
c                       length of result
	integer         lres
c                       length of environment variable
	integer         lenv
C       External Functions
	integer         lenc
C       Executable Code
	lenv = lenc(envar)
	if (lenv .eq. 0) return
	call getenv(envar,enval)
	lenv = lenc(enval)
	if (lenv .gt. 0) then
c           there is a translation
	    lres = len(result)
	    if (lenv .gt. lres) then
		write(STDERR,*) 'canondir: result does not fit'
	    else
		result = enval
	    endif
	endif
	return
	end
C=======================================================================
C=======================================================================
	subroutine canonfile(numd,defdir,result)
c       given a file name, find out if it exists and can be read
	IMPLICIT_NONE
C       Parameters
#       include "include/stdio.par"
c                       maximum size of full path name of a file
	integer         MXPATH
	parameter       (MXPATH = 128)
C       External Variables
c                       number of directories to search
	integer         numd
c                       default directory to search
	character*(*)   defdir(numd)
c                       the result file to inquire about
c                       if inquire fails, the result is blanked
	character*(*)   result
C       Internal Variables
c                       loop
	integer         i
c                       does the file exist?
	logical         ex
c                       length of default directory
	integer         lendef
c                       place to hold constructed file name
	character       filenm*(MXPATH)
C       External Functions
	integer         PMGO(lenc)
C       Executable Code
	if (result .eq. ' ') return
c       first try the filename exactly as given
	ex = .false.
	inquire(file=result,exist=ex)
	if (ex) return
c       otherwise, loop over all possible directories
	do 1000 i=1,numd
	  lendef = PMGO(lenc)(defdir(i))
	  filenm = defdir(i)(:lendef)//'/'//result
	  inquire(file=filenm,exist=ex)
	  if (ex) goto 9000
1000    continue
c       done looping
9000    continue
	if (ex) then
	    result = filenm
	else
c           we did not find such a file
	    result = ' '
	endif
	return
	end
C==============================================================================
C==============================================================================
--------------- getyes.F ------------------------
#include "include/port.h"
C=======================================================================
C=======================================================================
	logical function getyes(this)
c       Get a yes or no answer from the terminal
c       Can be called as func or subr and used as a logical value
	IMPLICIT_NONE
C       Parameter
#       include "include/stdio.par"
	integer         MAXTRY
	parameter       (MAXTRY = 10)
C       External variable
	integer         this
C       Internal variable
	character*10    that
	character*1     jot
	integer         retry
C       Executable Code
	retry = 0
10      continue
c       read (STDIN,ALINE,end=17) that
	call mx11gets(that)
	jot = that(1:1)
	if (jot.eq.'1' .or. jot.eq.'y' .or. jot.eq.'Y') then
	    this = -1
	    getyes = .true.
	    return
	endif
	if (jot.eq.'0' .or. jot.eq.'n' .or. jot.eq.'N') then
	    this = 0
	    getyes = .false.
	    return
	endif
c7      write(STDOUT,PROMPT) ' What?  Try Again.  Yes Or No?  '
17      call mgoprompt(' What?  Try Again.  Yes Or No?  ')
	retry = retry + 1
	if (retry .le. MAXTRY) goto 10
c       write(STDOUT,*) ' Giving up.'
	call mgoprompt(' Giving up.')
	stop
	end
C=======================================================================
C=======================================================================
--------------- glass.F ------------------------
#include "include/port.h"
	SUBROUTINE GLASS
c       This subroutine is never called, it serves as a huge block data.
c       Note that because it is never called, it may be necessary to
c       force some linkers/loaders/binders to explicitly include it as
c       part of the resulting binary program.
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c       Schott 1984 glass catalog (244 glasses with FuSi &   c
c       CaFl, and NACL at the end.)                          c
c       Data for CaFl, Qtz, and NACL by S. Vogt-11/25/85.    c
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
	IMPLICIT_NONE
#       include "echelle.par"
	include 'glass.cmn'
C       Data
	data    kg      /MAXGLASS/
	data kgnam(  1)/'FK1   '/
	data glc(1,  1)/ 0.21392463e+01/,glc(2,  1)/-0.92409374e-02/
	data glc(3,  1)/ 0.87449768e-02/,glc(4,  1)/ 0.21463624e-03/
	data glc(5,  1)/-0.12671989e-04/,glc(6,  1)/ 0.68154684e-06/
	data kgnam(  2)/'FK3   '/
	data glc(1,  2)/ 0.21202375e+01/,glc(2,  2)/-0.86868569e-02/
	data glc(3,  2)/ 0.91401191e-02/,glc(4,  2)/ 0.12613174e-03/
	data glc(5,  2)/-0.82960642e-06/,glc(6,  2)/ 0.13180567e-06/
	data kgnam(  3)/'FK5   '/
	data glc(1,  3)/ 0.21887621e+01/,glc(2,  3)/-0.95572007e-02/
	data glc(3,  3)/ 0.89915232e-02/,glc(4,  3)/ 0.14560516e-03/
	data glc(5,  3)/-0.52843067e-05/,glc(6,  3)/ 0.34588010e-06/
	data kgnam(  4)/'FK50  '/
	data glc(1,  4)/ 0.21857458e+01/,glc(2,  4)/-0.51833855e-02/
	data glc(3,  4)/ 0.81653709e-02/,glc(4,  4)/ 0.95279641e-04/
	data glc(5,  4)/-0.16560087e-05/,glc(6,  4)/ 0.18838484e-06/
	data kgnam(  5)/'FK51  '/
	data glc(1,  5)/ 0.21883307e+01/,glc(2,  5)/-0.53658786e-02/
	data glc(3,  5)/ 0.77436552e-02/,glc(4,  5)/ 0.13129343e-03/
	data glc(5,  5)/-0.74179516e-05/,glc(6,  5)/ 0.45815122e-06/
	data kgnam(  6)/'FK52  '/
	data glc(1,  6)/ 0.21858571e+01/,glc(2,  6)/-0.52014619e-02/
	data glc(3,  6)/ 0.81074888e-02/,glc(4,  6)/ 0.10085829e-03/
	data glc(5,  6)/-0.22241781e-05/,glc(6,  6)/ 0.19197508e-06/
	data kgnam(  7)/'FK54  '/
	data glc(1,  7)/ 0.20478023e+01/,glc(2,  7)/-0.48685134e-02/
	data glc(3,  7)/ 0.62781975e-02/,glc(4,  7)/ 0.88845082e-04/
	data glc(5,  7)/-0.41267464e-05/,glc(6,  7)/ 0.24392914e-06/
	data kgnam(  8)/'PK1   '/
	data glc(1,  8)/ 0.22347576e+01/,glc(2,  8)/-0.10003049e-01/
	data glc(3,  8)/ 0.10000850e-01/,glc(4,  8)/ 0.13066001e-03/
	data glc(5,  8)/-0.95958149e-06/,glc(6,  8)/ 0.15899017e-06/
	data kgnam(  9)/'PK2   '/
	data glc(1,  9)/ 0.22770533e+01/,glc(2,  9)/-0.10532010e-01/
	data glc(3,  9)/ 0.10188354e-01/,glc(4,  9)/ 0.29001564e-03/
	data glc(5,  9)/-0.19602856e-04/,glc(6,  9)/ 0.10967718e-05/
	data kgnam( 10)/'PK3   '/
	data glc(1, 10)/ 0.22977022e+01/,glc(2, 10)/-0.10331615e-01/
	data glc(3, 10)/ 0.10757237e-01/,glc(4, 10)/ 0.21255152e-03/
	data glc(5, 10)/-0.89190321e-05/,glc(6, 10)/ 0.57854334e-06/
	data kgnam( 11)/'PK50  '/
	data glc(1, 11)/ 0.22856264e+01/,glc(2, 11)/-0.98499203e-02/
	data glc(3, 11)/ 0.96984515e-02/,glc(4, 11)/ 0.24472149e-03/
	data glc(5, 11)/-0.16333863e-04/,glc(6, 11)/ 0.91344805e-06/
	data kgnam( 12)/'PK51  '/
	data glc(1, 12)/ 0.23095538e+01/,glc(2, 12)/-0.57099342e-02/
	data glc(3, 12)/ 0.95910979e-02/,glc(4, 12)/ 0.14455285e-03/
	data glc(5, 12)/-0.51413770e-05/,glc(6, 12)/ 0.35994942e-06/
	data kgnam( 13)/'PSK2  '/
	data glc(1, 13)/ 0.24266341e+01/,glc(2, 13)/-0.10593625e-01/
	data glc(3, 13)/ 0.12590958e-01/,glc(4, 13)/ 0.17407923e-03/
	data glc(5, 13)/-0.32622544e-06/,glc(6, 13)/ 0.19916158e-06/
	data kgnam( 14)/'PSK3  '/
	data glc(1, 14)/ 0.23768193e+01/,glc(2, 14)/-0.10146514e-01/
	data glc(3, 14)/ 0.12167148e-01/,glc(4, 14)/ 0.11916606e-03/
	data glc(5, 14)/ 0.64250627e-05/,glc(6, 14)/-0.17478706e-06/
	data kgnam( 15)/'PSK50 '/
	data glc(1, 15)/ 0.23946348e+01/,glc(2, 15)/-0.96851585e-02/
	data glc(3, 15)/ 0.11457938e-01/,glc(4, 15)/ 0.17638709e-03/
	data glc(5, 15)/-0.34507987e-05/,glc(6, 15)/ 0.29704663e-06/
	data kgnam( 16)/'PSK52 '/
	data glc(1, 16)/ 0.25342699e+01/,glc(2, 16)/-0.10342368e-01/
	data glc(3, 16)/ 0.12636367e-01/,glc(4, 16)/ 0.38218429e-03/
	data glc(5, 16)/-0.28742342e-04/,glc(6, 16)/ 0.16748094e-05/
	data kgnam( 17)/'PSK53 '/
	data glc(1, 17)/ 0.25852417e+01/,glc(2, 17)/-0.94290947e-02/
	data glc(3, 17)/ 0.14074470e-01/,glc(4, 17)/ 0.27924791e-03/
	data glc(5, 17)/-0.12779218e-04/,glc(6, 17)/ 0.94769182e-06/
	data kgnam( 18)/'BK1   '/
	data glc(1, 18)/ 0.22513742e+01/,glc(2, 18)/-0.93254015e-02/
	data glc(3, 18)/ 0.10539647e-01/,glc(4, 18)/ 0.22595365e-03/
	data glc(5, 18)/-0.10729053e-04/,glc(6, 18)/ 0.72832778e-06/
	data kgnam( 19)/'BK3   '/
	data glc(1, 19)/ 0.22184519e+01/,glc(2, 19)/-0.10539086e-01/
	data glc(3, 19)/ 0.99115699e-02/,glc(4, 19)/ 0.18512559e-03/
	data glc(5, 19)/-0.70180588e-05/,glc(6, 19)/ 0.42385691e-06/
	data kgnam( 20)/'BK6   '/
	data glc(1, 20)/ 0.23125058e+01/,glc(2, 20)/-0.95398792e-02/
	data glc(3, 20)/ 0.11668749e-01/,glc(4, 20)/ 0.15598074e-03/
	data glc(5, 20)/ 0.11623640e-05/,glc(6, 20)/ 0.12318050e-06/
	data kgnam( 21)/'BK7   '/
	data glc(1, 21)/ 0.22718929e+01/,glc(2, 21)/-0.10108077e-01/
	data glc(3, 21)/ 0.10592509e-01/,glc(4, 21)/ 0.20816965e-03/
	data glc(5, 21)/-0.76472538e-05/,glc(6, 21)/ 0.49240991e-06/
	data kgnam( 22)/'UBK7  '/
	data glc(1, 22)/ 0.22715621e+01/,glc(2, 22)/-0.98571566e-02/
	data glc(3, 22)/ 0.10808515e-01/,glc(4, 22)/ 0.14068151e-03/
	data glc(5, 22)/ 0.13041796e-05/,glc(6, 22)/ 0.48615933e-07/
	data kgnam( 23)/'BK8   '/
	data glc(1, 23)/ 0.22804948e+01/,glc(2, 23)/-0.94190530e-02/
	data glc(3, 23)/ 0.11349888e-01/,glc(4, 23)/ 0.56741756e-04/
	data glc(5, 23)/ 0.12149716e-04/,glc(6, 23)/-0.42771477e-06/
	data kgnam( 24)/'BK10  '/
	data glc(1, 24)/ 0.22177191e+01/,glc(2, 24)/-0.10248661e-01/
	data glc(3, 24)/ 0.96627662e-02/,glc(4, 24)/ 0.16782840e-03/
	data glc(5, 24)/-0.55328684e-05/,glc(6, 24)/ 0.34747416e-06/
	data kgnam( 25)/'BALK1 '/
	data glc(1, 25)/ 0.22966923e+01/,glc(2, 25)/-0.82975549e-02/
	data glc(3, 25)/ 0.11907234e-01/,glc(4, 25)/ 0.19908305e-03/
	data glc(5, 25)/-0.20306838e-05/,glc(6, 25)/ 0.31429703e-06/
	data kgnam( 26)/'BALKN3'/
	data glc(1, 26)/ 0.22738525e+01/,glc(2, 26)/-0.88519024e-02/
	data glc(3, 26)/ 0.11511571e-01/,glc(4, 26)/ 0.20622098e-03/
	data glc(5, 26)/-0.39599217e-05/,glc(6, 26)/ 0.44844819e-06/
	data kgnam( 27)/'K3    '/
	data glc(1, 27)/ 0.22727603e+01/,glc(2, 27)/-0.87840747e-02/
	data glc(3, 27)/ 0.11325842e-01/,glc(4, 27)/ 0.34828095e-03/
	data glc(5, 27)/-0.21976876e-04/,glc(6, 27)/ 0.13941592e-05/
	data kgnam( 28)/'K4    '/
	data glc(1, 28)/ 0.22734025e+01/,glc(2, 28)/-0.88768403e-02/
	data glc(3, 28)/ 0.12161748e-01/,glc(4, 28)/ 0.18966377e-03/
	data glc(5, 28)/ 0.14584031e-05/,glc(6, 28)/ 0.27687697e-06/
	data kgnam( 29)/'K5    '/
	data glc(1, 29)/ 0.22850299e+01/,glc(2, 29)/-0.86010725e-02/
	data glc(3, 29)/ 0.11806783e-01/,glc(4, 29)/ 0.20765657e-03/
	data glc(5, 29)/-0.21314913e-05/,glc(6, 29)/ 0.32131234e-06/
	data kgnam( 30)/'K7    '/
	data glc(1, 30)/ 0.22520059e+01/,glc(2, 30)/-0.84630818e-02/
	data glc(3, 30)/ 0.11351376e-01/,glc(4, 30)/ 0.18421156e-03/
	data glc(5, 30)/-0.20450534e-05/,glc(6, 30)/ 0.34814749e-06/
	data kgnam( 31)/'K10   '/
	data glc(1, 31)/ 0.22209762e+01/,glc(2, 31)/-0.83295635e-02/
	data glc(3, 31)/ 0.11963114e-01/,glc(4, 31)/ 0.13879745e-03/
	data glc(5, 31)/ 0.78358808e-05/,glc(6, 31)/ 0.84344620e-07/
	data kgnam( 32)/'K11   '/
	data glc(1, 32)/ 0.22211157e+01/,glc(2, 32)/-0.91442577e-02/
	data glc(3, 32)/ 0.10670316e-01/,glc(4, 32)/ 0.18263096e-03/
	data glc(5, 32)/-0.14105398e-05/,glc(6, 32)/ 0.33096328e-06/
	data kgnam( 33)/'K50   '/
	data glc(1, 33)/ 0.22861092e+01/,glc(2, 33)/-0.91773008e-02/
	data glc(3, 33)/ 0.11562643e-01/,glc(4, 33)/ 0.22550894e-03/
	data glc(5, 33)/-0.54163445e-05/,glc(6, 33)/ 0.43498997e-06/
	data kgnam( 34)/'UK50  '/
	data glc(1, 34)/ 0.22858030e+01/,glc(2, 34)/-0.89733347e-02/
	data glc(3, 34)/ 0.11798712e-01/,glc(4, 34)/ 0.14952379e-03/
	data glc(5, 34)/ 0.34334254e-05/,glc(6, 34)/ 0.59393094e-07/
	data kgnam( 35)/'K51   '/
	data glc(1, 35)/ 0.22351459e+01/,glc(2, 35)/-0.99823499e-02/
	data glc(3, 35)/ 0.11161681e-01/,glc(4, 35)/ 0.18637660e-03/
	data glc(5, 35)/-0.25979987e-05/,glc(6, 35)/ 0.49365998e-06/
	data kgnam( 36)/'ZK1   '/
	data glc(1, 36)/ 0.23157951e+01/,glc(2, 36)/-0.87493905e-02/
	data glc(3, 36)/ 0.12329645e-01/,glc(4, 36)/ 0.26311112e-03/
	data glc(5, 36)/-0.82854201e-05/,glc(6, 36)/ 0.73735801e-06/
	data kgnam( 37)/'ZK5   '/
	data glc(1, 37)/ 0.23151352e+01/,glc(2, 37)/-0.77924593e-02/
	data glc(3, 37)/ 0.13029385e-01/,glc(4, 37)/ 0.27439704e-03/
	data glc(5, 37)/-0.59213789e-05/,glc(6, 37)/ 0.63841709e-06/
	data kgnam( 38)/'ZKN7  '/
	data glc(1, 38)/ 0.22447173e+01/,glc(2, 38)/-0.94165837e-02/
	data glc(3, 38)/ 0.11533424e-01/,glc(4, 38)/ 0.27117600e-04/
	data glc(5, 38)/ 0.17553283e-04/,glc(6, 38)/-0.70564114e-06/
	data kgnam( 39)/'BAK1  '/
	data glc(1, 39)/ 0.24333007e+01/,glc(2, 39)/-0.84931353e-02/
	data glc(3, 39)/ 0.13893512e-01/,glc(4, 39)/ 0.26798268e-03/
	data glc(5, 39)/-0.61946101e-05/,glc(6, 39)/ 0.62209005e-06/
	data kgnam( 40)/'BAK2  '/
	data glc(1, 40)/ 0.23370143e+01/,glc(2, 40)/-0.86389345e-02/
	data glc(3, 40)/ 0.12265051e-01/,glc(4, 40)/ 0.24273540e-03/
	data glc(5, 40)/-0.63916988e-05/,glc(6, 40)/ 0.51229141e-06/
	data kgnam( 41)/'BAK4  '/
	data glc(1, 41)/ 0.24218304e+01/,glc(2, 41)/-0.92167103e-02/
	data glc(3, 41)/ 0.13821685e-01/,glc(4, 41)/ 0.32955714e-03/
	data glc(5, 41)/-0.12153641e-04/,glc(6, 41)/ 0.10333767e-05/
	data kgnam( 42)/'BAK5  '/
	data glc(1, 42)/ 0.23861698e+01/,glc(2, 42)/-0.84606642e-02/
	data glc(3, 42)/ 0.13233029e-01/,glc(4, 42)/ 0.20949226e-03/
	data glc(5, 42)/-0.55580737e-06/,glc(6, 42)/ 0.29765122e-06/
	data kgnam( 43)/'BAK6  '/
	data glc(1, 43)/ 0.24394521e+01/,glc(2, 43)/-0.95754011e-02/
	data glc(3, 43)/ 0.13786016e-01/,glc(4, 43)/ 0.37095536e-03/
	data glc(5, 43)/-0.17661400e-04/,glc(6, 43)/ 0.13821042e-05/
	data kgnam( 44)/'BAK50 '/
	data glc(1, 44)/ 0.24195494e+01/,glc(2, 44)/-0.95312125e-02/
	data glc(3, 44)/ 0.13775289e-01/,glc(4, 44)/ 0.18153631e-03/
	data glc(5, 44)/ 0.46618943e-05/,glc(6, 44)/ 0.20448919e-07/
	data kgnam( 45)/'SK1   '/
	data glc(1, 45)/ 0.25491516e+01/,glc(2, 45)/-0.92996196e-02/
	data glc(3, 45)/ 0.15424606e-01/,glc(4, 45)/ 0.27409985e-03/
	data glc(5, 45)/-0.17393911e-05/,glc(6, 45)/ 0.40037912e-06/
	data kgnam( 46)/'SK2   '/
	data glc(1, 46)/ 0.25395065e+01/,glc(2, 46)/-0.88026103e-02/
	data glc(3, 46)/ 0.15691213e-01/,glc(4, 46)/ 0.18518895e-03/
	data glc(5, 46)/ 0.84796564e-05/,glc(6, 46)/-0.70710768e-07/
	data kgnam( 47)/'SK3   '/
	data glc(1, 47)/ 0.25470242e+01/,glc(2, 47)/-0.10118918e-01/
	data glc(3, 47)/ 0.14639317e-01/,glc(4, 47)/ 0.29976361e-03/
	data glc(5, 47)/-0.98865231e-05/,glc(6, 47)/ 0.82251299e-06/
	data kgnam( 48)/'SK4   '/
	data glc(1, 48)/ 0.25585228e+01/,glc(2, 48)/-0.98824951e-02/
	data glc(3, 48)/ 0.15151820e-01/,glc(4, 48)/ 0.21134478e-03/
	data glc(5, 48)/ 0.34130130e-05/,glc(6, 48)/ 0.12673355e-06/
	data kgnam( 49)/'SK5   '/
	data glc(1, 49)/ 0.24876635e+01/,glc(2, 49)/-0.10442251e-01/
	data glc(3, 49)/ 0.13736058e-01/,glc(4, 49)/ 0.16392687e-03/
	data glc(5, 49)/ 0.47463374e-05/,glc(6, 49)/-0.49303610e-07/
	data kgnam( 50)/'SK6   '/
	data glc(1, 50)/ 0.25596842e+01/,glc(2, 50)/-0.91217460e-02/
	data glc(3, 50)/ 0.15610313e-01/,glc(4, 50)/ 0.30347388e-03/
	data glc(5, 50)/-0.65261354e-05/,glc(6, 50)/ 0.69039819e-06/
	data kgnam( 51)/'SK7   '/
	data glc(1, 51)/ 0.25420185e+01/,glc(2, 51)/-0.97351561e-02/
	data glc(3, 51)/ 0.14884507e-01/,glc(4, 51)/ 0.17370120e-03/
	data glc(5, 51)/ 0.63461730e-05/,glc(6, 51)/-0.53316579e-07/
	data kgnam( 52)/'SK8   '/
	data glc(1, 52)/ 0.25516208e+01/,glc(2, 52)/-0.93738374e-02/
	data glc(3, 52)/ 0.15451158e-01/,glc(4, 52)/ 0.35159357e-03/
	data glc(5, 52)/-0.11852989e-04/,glc(6, 52)/ 0.97956516e-06/
	data kgnam( 53)/'SK9   '/
	data glc(1, 53)/ 0.25592131e+01/,glc(2, 53)/-0.90020732e-02/
	data glc(3, 53)/ 0.16280492e-01/,glc(4, 53)/ 0.18861769e-03/
	data glc(5, 53)/ 0.13679471e-04/,glc(6, 53)/-0.30071065e-06/
	data kgnam( 54)/'SK10  '/
	data glc(1, 54)/ 0.25881711e+01/,glc(2, 54)/-0.93042169e-02/
	data glc(3, 54)/ 0.16075770e-01/,glc(4, 54)/ 0.22083748e-03/
	data glc(5, 54)/ 0.35467529e-05/,glc(6, 54)/ 0.26143582e-06/
	data kgnam( 55)/'SK11  '/
	data glc(1, 55)/ 0.24098938e+01/,glc(2, 55)/-0.95183518e-02/
	data glc(3, 55)/ 0.12805486e-01/,glc(4, 55)/ 0.24249380e-03/
	data glc(5, 55)/-0.75561129e-05/,glc(6, 55)/ 0.59784011e-06/
	data kgnam( 56)/'SK12  '/
	data glc(1, 56)/ 0.24674397e+01/,glc(2, 56)/-0.93595371e-02/
	data glc(3, 56)/ 0.13921727e-01/,glc(4, 56)/ 0.20838047e-03/
	data glc(5, 56)/ 0.15107581e-06/,glc(6, 56)/ 0.24301769e-06/
	data kgnam( 57)/'SK13  '/
	data glc(1, 57)/ 0.24934144e+01/,glc(2, 57)/-0.92031432e-02/
	data glc(3, 57)/ 0.14259619e-01/,glc(4, 57)/ 0.29676678e-03/
	data glc(5, 57)/-0.93746109e-05/,glc(6, 57)/ 0.74341245e-06/
	data kgnam( 58)/'SK14  '/
	data glc(1, 58)/ 0.25300639e+01/,glc(2, 58)/-0.10126279e-01/
	data glc(3, 58)/ 0.14483568e-01/,glc(4, 58)/ 0.15266041e-03/
	data glc(5, 58)/ 0.68001252e-05/,glc(6, 58)/-0.67666095e-07/
	data kgnam( 59)/'SK15  '/
	data glc(1, 59)/ 0.25901210e+01/,glc(2, 59)/-0.99415459e-02/
	data glc(3, 59)/ 0.15735505e-01/,glc(4, 59)/ 0.19944840e-03/
	data glc(5, 59)/ 0.63298328e-05/,glc(6, 59)/ 0.19631497e-08/
	data kgnam( 60)/'SK16  '/
	data glc(1, 60)/ 0.25846319e+01/,glc(2, 60)/-0.11059422e-01/
	data glc(3, 60)/ 0.14856282e-01/,glc(4, 60)/ 0.22377211e-03/
	data glc(5, 60)/-0.49029910e-06/,glc(6, 60)/ 0.28445925e-06/
	data kgnam( 61)/'SKN18 '/
	data glc(1, 61)/ 0.26376216e+01/,glc(2, 61)/-0.10518989e-01/
	data glc(3, 61)/ 0.16589824e-01/,glc(4, 61)/ 0.34939073e-03/
	data glc(5, 61)/-0.10028109e-04/,glc(6, 61)/ 0.11802616e-05/
	data kgnam( 62)/'SK19  '/
	data glc(1, 62)/ 0.25594250e+01/,glc(2, 62)/-0.93541373e-02/
	data glc(3, 62)/ 0.15497881e-01/,glc(4, 62)/ 0.23655893e-03/
	data glc(5, 62)/ 0.14330022e-05/,glc(6, 62)/ 0.29327826e-06/
	data kgnam( 63)/'SK20  '/
	data glc(1, 63)/ 0.23975952e+01/,glc(2, 63)/-0.96663991e-02/
	data glc(3, 63)/ 0.12508188e-01/,glc(4, 63)/ 0.25565265e-03/
	data glc(5, 63)/-0.96947284e-05/,glc(6, 63)/ 0.68512885e-06/
	data kgnam( 64)/'SK51  '/
	data glc(1, 64)/ 0.25855045e+01/,glc(2, 64)/-0.96112749e-02/
	data glc(3, 64)/ 0.14803167e-01/,glc(4, 64)/ 0.28628731e-03/
	data glc(5, 64)/-0.84638718e-05/,glc(6, 64)/ 0.79967143e-06/
	data kgnam( 65)/'SK52  '/
	data glc(1, 65)/ 0.26378898e+01/,glc(2, 65)/-0.11047170e-01/
	data glc(3, 65)/ 0.16634360e-01/,glc(4, 65)/ 0.30997141e-03/
	data glc(5, 65)/-0.35480823e-05/,glc(6, 65)/ 0.57899721e-06/
	data kgnam( 66)/'SK55  '/
	data glc(1, 66)/ 0.25852191e+01/,glc(2, 66)/-0.12089769e-01/
	data glc(3, 66)/ 0.14721771e-01/,glc(4, 66)/ 0.24958755e-03/
	data glc(5, 66)/-0.32759191e-05/,glc(6, 66)/ 0.36957062e-06/
	data kgnam( 67)/'KF1   '/
	data glc(1, 67)/ 0.23324325e+01/,glc(2, 67)/-0.85563978e-02/
	data glc(3, 67)/ 0.14012802e-01/,glc(4, 67)/ 0.34494190e-03/
	data glc(5, 67)/-0.76053118e-05/,glc(6, 67)/ 0.12660303e-05/
	data kgnam( 68)/'KF3   '/
	data glc(1, 68)/ 0.22591522e+01/,glc(2, 68)/-0.86810568e-02/
	data glc(3, 68)/ 0.12074479e-01/,glc(4, 68)/ 0.36515757e-03/
	data glc(5, 68)/-0.19089812e-04/,glc(6, 68)/ 0.14345201e-05/
	data kgnam( 69)/'KF6   '/
	data glc(1, 69)/ 0.22651845e+01/,glc(2, 69)/-0.84401006e-02/
	data glc(3, 69)/ 0.13185124e-01/,glc(4, 69)/ 0.23958981e-03/
	data glc(5, 69)/ 0.20310603e-05/,glc(6, 69)/ 0.60813527e-06/
	data kgnam( 70)/'KF9   '/
	data glc(1, 70)/ 0.22824396e+01/,glc(2, 70)/-0.85960144e-02/
	data glc(3, 70)/ 0.13442645e-01/,glc(4, 70)/ 0.27803535e-03/
	data glc(5, 70)/-0.49998960e-06/,glc(6, 70)/ 0.77105911e-06/
	data kgnam( 71)/'KF50  '/
	data glc(1, 71)/ 0.23045807e+01/,glc(2, 71)/-0.88382960e-02/
	data glc(3, 71)/ 0.13484730e-01/,glc(4, 71)/ 0.38601862e-03/
	data glc(5, 71)/-0.13379593e-04/,glc(6, 71)/ 0.13359542e-05/
	data kgnam( 72)/'BALF3 '/
	data glc(1, 72)/ 0.24251277e+01/,glc(2, 72)/-0.74347248e-02/
	data glc(3, 72)/ 0.15487534e-01/,glc(4, 72)/ 0.16375720e-03/
	data glc(5, 72)/ 0.15027176e-04/,glc(6, 72)/-0.17953510e-06/
	data kgnam( 73)/'BALF4 '/
	data glc(1, 73)/ 0.24528366e+01/,glc(2, 73)/-0.92047678e-02/
	data glc(3, 73)/ 0.14552794e-01/,glc(4, 73)/ 0.43046688e-03/
	data glc(5, 73)/-0.20489836e-04/,glc(6, 73)/ 0.15924415e-05/
	data kgnam( 74)/'BALF5 '/
	data glc(1, 74)/ 0.23544612e+01/,glc(2, 74)/-0.79053990e-02/
	data glc(3, 74)/ 0.13971868e-01/,glc(4, 74)/ 0.25936745e-03/
	data glc(5, 74)/-0.15064670e-06/,glc(6, 74)/ 0.60410634e-06/
	data kgnam( 75)/'BALF6 '/
	data glc(1, 75)/ 0.24802388e+01/,glc(2, 75)/-0.86000215e-02/
	data glc(3, 75)/ 0.15624147e-01/,glc(4, 75)/ 0.30040260e-03/
	data glc(5, 75)/-0.22119056e-05/,glc(6, 75)/ 0.80013234e-06/
	data kgnam( 76)/'BALF8 '/
	data glc(1, 76)/ 0.23718251e+01/,glc(2, 76)/-0.83840363e-02/
	data glc(3, 76)/ 0.14379250e-01/,glc(4, 76)/ 0.39742058e-03/
	data glc(5, 76)/-0.13041618e-04/,glc(6, 76)/ 0.14386564e-05/
	data kgnam( 77)/'BALF50'/
	data glc(1, 77)/ 0.24792852e+01/,glc(2, 77)/-0.92013619e-02/
	data glc(3, 77)/ 0.15615134e-01/,glc(4, 77)/ 0.43452084e-03/
	data glc(5, 77)/-0.16552131e-04/,glc(6, 77)/ 0.16658805e-05/
	data kgnam( 78)/'BALF51'/
	data glc(1, 78)/ 0.24334741e+01/,glc(2, 78)/-0.85343207e-02/
	data glc(3, 78)/ 0.15241024e-01/,glc(4, 78)/ 0.30677273e-03/
	data glc(5, 78)/-0.19515136e-05/,glc(6, 78)/ 0.85689514e-06/
	data kgnam( 79)/'SSK1  '/
	data glc(1, 79)/ 0.25680835e+01/,glc(2, 79)/-0.90625067e-02/
	data glc(3, 79)/ 0.16608680e-01/,glc(4, 79)/ 0.25292407e-03/
	data glc(5, 79)/ 0.52540756e-05/,glc(6, 79)/ 0.35912155e-06/
	data kgnam( 80)/'SSK2  '/
	data glc(1, 80)/ 0.25832910e+01/,glc(2, 80)/-0.90240848e-02/
	data glc(3, 80)/ 0.17028671e-01/,glc(4, 80)/ 0.25881635e-03/
	data glc(5, 80)/ 0.67648572e-05/,glc(6, 80)/ 0.34731723e-06/
	data kgnam( 81)/'SSK3  '/
	data glc(1, 81)/ 0.25587299e+01/,glc(2, 81)/-0.90062517e-02/
	data glc(3, 81)/ 0.16793145e-01/,glc(4, 81)/ 0.43401638e-03/
	data glc(5, 81)/-0.12949572e-04/,glc(6, 81)/ 0.15042044e-05/
	data kgnam( 82)/'SSK4  '/
	data glc(1, 82)/ 0.25707849e+01/,glc(2, 82)/-0.92577764e-02/
	data glc(3, 82)/ 0.16170751e-01/,glc(4, 82)/ 0.27742702e-03/
	data glc(5, 82)/ 0.12686469e-06/,glc(6, 82)/ 0.45044790e-06/
	data kgnam( 83)/'SSKN5 '/
	data glc(1, 83)/ 0.26971175e+01/,glc(2, 83)/-0.10516627e-01/
	data glc(3, 83)/ 0.18053262e-01/,glc(4, 83)/ 0.64060677e-03/
	data glc(5, 83)/-0.39493178e-04/,glc(6, 83)/ 0.32567627e-05/
	data kgnam( 84)/'SSKN8 '/
	data glc(1, 84)/ 0.25670599e+01/,glc(2, 84)/-0.98663081e-02/
	data glc(3, 84)/ 0.17078368e-01/,glc(4, 84)/ 0.50554082e-03/
	data glc(5, 84)/-0.21403288e-04/,glc(6, 84)/ 0.24582991e-05/
	data kgnam( 85)/'SSK50 '/
	data glc(1, 85)/ 0.25696487e+01/,glc(2, 85)/-0.90907229e-02/
	data glc(3, 85)/ 0.16655170e-01/,glc(4, 85)/ 0.37688285e-03/
	data glc(5, 85)/-0.95448507e-05/,glc(6, 85)/ 0.12959815e-05/
	data kgnam( 86)/'SSK51 '/
	data glc(1, 86)/ 0.25256456e+01/,glc(2, 86)/-0.88479177e-02/
	data glc(3, 86)/ 0.16074734e-01/,glc(4, 86)/ 0.28025567e-03/
	data glc(5, 86)/ 0.11591526e-06/,glc(6, 86)/ 0.73266529e-06/
	data kgnam( 87)/'SSK52 '/
	data glc(1, 87)/ 0.26963923e+01/,glc(2, 87)/-0.10347971e-01/
	data glc(3, 87)/ 0.18618508e-01/,glc(4, 87)/ 0.46286000e-03/
	data glc(5, 87)/-0.13476750e-04/,glc(6, 87)/ 0.16107565e-05/
	data kgnam( 88)/'LAKN6 '/
	data glc(1, 88)/ 0.26520918e+01/,glc(2, 88)/-0.10634343e-01/
	data glc(3, 88)/ 0.16314457e-01/,glc(4, 88)/ 0.24908012e-03/
	data glc(5, 88)/ 0.70505584e-06/,glc(6, 88)/ 0.27087570e-06/
	data kgnam( 89)/'LAKN7 '/
	data glc(1, 89)/ 0.26820255e+01/,glc(2, 89)/-0.11431524e-01/
	data glc(3, 89)/ 0.16434096e-01/,glc(4, 89)/ 0.24373786e-03/
	data glc(5, 89)/ 0.17117573e-05/,glc(6, 89)/ 0.21575860e-06/
	data kgnam( 90)/'LAK8  '/
	data glc(1, 90)/ 0.28791177e+01/,glc(2, 90)/-0.14887202e-01/
	data glc(3, 90)/ 0.19662614e-01/,glc(4, 90)/ 0.43841844e-03/
	data glc(5, 90)/-0.12951193e-04/,glc(6, 90)/ 0.11580631e-05/
	data kgnam( 91)/'LAK9  '/
	data glc(1, 91)/ 0.28081456e+01/,glc(2, 91)/-0.14266626e-01/
	data glc(3, 91)/ 0.18008161e-01/,glc(4, 91)/ 0.56748764e-03/
	data glc(5, 91)/-0.32899281e-04/,glc(6, 91)/ 0.20438076e-05/
	data kgnam( 92)/'LAK10 '/
	data glc(1, 92)/ 0.28984614e+01/,glc(2, 92)/-0.14857039e-01/
	data glc(3, 92)/ 0.20985037e-01/,glc(4, 92)/ 0.54506921e-03/
	data glc(5, 92)/-0.17297314e-04/,glc(6, 92)/ 0.17993601e-05/
	data kgnam( 93)/'LAK11 '/
	data glc(1, 93)/ 0.27031311e+01/,glc(2, 93)/-0.12225054e-01/
	data glc(3, 93)/ 0.16715221e-01/,glc(4, 93)/ 0.32476320e-03/
	data glc(5, 93)/-0.51327015e-05/,glc(6, 93)/ 0.50461740e-06/
	data kgnam( 94)/'LAKN12'/
	data glc(1, 94)/ 0.27627145e+01/,glc(2, 94)/-0.10444563e-01/
	data glc(3, 94)/ 0.18601838e-01/,glc(4, 94)/ 0.25893372e-03/
	data glc(5, 94)/ 0.76556580e-05/,glc(6, 94)/-0.37061383e-07/
	data kgnam( 95)/'LAKN13'/
	data glc(1, 95)/ 0.28115119e+01/,glc(2, 95)/-0.10386717e-01/
	data glc(3, 95)/ 0.19734379e-01/,glc(4, 95)/ 0.32856524e-03/
	data glc(5, 95)/ 0.32051557e-05/,glc(6, 95)/ 0.30925067e-06/
	data kgnam( 96)/'LAKN14'/
	data glc(1, 96)/ 0.28272796e+01/,glc(2, 96)/-0.14543591e-01/
	data glc(3, 96)/ 0.18607179e-01/,glc(4, 96)/ 0.36867908e-03/
	data glc(5, 96)/-0.69826459e-05/,glc(6, 96)/ 0.70273582e-06/
	data kgnam( 97)/'LAKN16'/
	data glc(1, 97)/ 0.29440159e+01/,glc(2, 97)/-0.14557146e-01/
	data glc(3, 97)/ 0.21617158e-01/,glc(4, 97)/ 0.40140812e-03/
	data glc(5, 97)/ 0.24517155e-06/,glc(6, 97)/ 0.58190649e-06/
	data kgnam( 98)/'LAK20 '/
	data glc(1, 98)/ 0.28088805e+01/,glc(2, 98)/-0.97299067e-02/
	data glc(3, 98)/ 0.20547293e-01/,glc(4, 98)/ 0.31872622e-03/
	data glc(5, 98)/ 0.66319967e-05/,glc(6, 98)/ 0.31014063e-06/
	data kgnam( 99)/'LAK21 '/
	data glc(1, 99)/ 0.26478736e+01/,glc(2, 99)/-0.11574789e-01/
	data glc(3, 99)/ 0.15782386e-01/,glc(4, 99)/ 0.17291765e-03/
	data glc(5, 99)/ 0.77882807e-05/,glc(6, 99)/-0.11063827e-06/
	data kgnam(100)/'LAKL21'/
	data glc(1,100)/ 0.26496868e+01/,glc(2,100)/-0.14180769e-01/
	data glc(3,100)/ 0.15173226e-01/,glc(4,100)/ 0.31464516e-03/
	data glc(5,100)/-0.10814561e-04/,glc(6,100)/ 0.79828892e-06/
	data kgnam(101)/'LAKN22'/
	data glc(1,101)/ 0.26775139e+01/,glc(2,101)/-0.10439699e-01/
	data glc(3,101)/ 0.17312971e-01/,glc(4,101)/ 0.23622943e-03/
	data glc(5,101)/ 0.81681533e-05/,glc(6,101)/-0.13539324e-06/
	data kgnam(102)/'LAK23 '/
	data glc(1,102)/ 0.27367941e+01/,glc(2,102)/-0.11905799e-01/
	data glc(3,102)/ 0.17099759e-01/,glc(4,102)/ 0.34286906e-03/
	data glc(5,102)/-0.81287792e-05/,glc(6,102)/ 0.71596070e-06/
	data kgnam(103)/'LAK28 '/
	data glc(1,103)/ 0.29790542e+01/,glc(2,103)/-0.14645416e-01/
	data glc(3,103)/ 0.22376581e-01/,glc(4,103)/ 0.44238875e-03/
	data glc(5,103)/-0.16906632e-05/,glc(6,103)/ 0.73784132e-06/
	data kgnam(104)/'LAK31 '/
	data glc(1,104)/ 0.28283850e+01/,glc(2,104)/-0.14963716e-01/
	data glc(3,104)/ 0.18210258e-01/,glc(4,104)/ 0.36816151e-03/
	data glc(5,104)/-0.86283328e-05/,glc(6,104)/ 0.75649349e-06/
	data kgnam(105)/'LLF1  '/
	data glc(1,105)/ 0.23505162e+01/,glc(2,105)/-0.85306451e-02/
	data glc(3,105)/ 0.15750853e-01/,glc(4,105)/ 0.42811388e-03/
	data glc(5,105)/-0.69875718e-05/,glc(6,105)/ 0.17175517e-05/
	data kgnam(106)/'LLF2  '/
	data glc(1,106)/ 0.23299214e+01/,glc(2,106)/-0.85444433e-02/
	data glc(3,106)/ 0.15031394e-01/,glc(4,106)/ 0.40265729e-03/
	data glc(5,106)/-0.76000030e-05/,glc(6,106)/ 0.15659130e-05/
	data kgnam(107)/'LLF3  '/
	data glc(1,107)/ 0.23880339e+01/,glc(2,107)/-0.91010943e-02/
	data glc(3,107)/ 0.15789160e-01/,glc(4,107)/ 0.40516750e-03/
	data glc(5,107)/-0.54507043e-05/,glc(6,107)/ 0.15992768e-05/
	data kgnam(108)/'LLF4  '/
	data glc(1,108)/ 0.23895058e+01/,glc(2,108)/-0.86358875e-02/
	data glc(3,108)/ 0.16448035e-01/,glc(4,108)/ 0.45166611e-03/
	data glc(5,108)/-0.74107160e-05/,glc(6,108)/ 0.18684107e-05/
	data kgnam(109)/'LLF6  '/
	data glc(1,109)/ 0.23047007e+01/,glc(2,109)/-0.85161517e-02/
	data glc(3,109)/ 0.14319368e-01/,glc(4,109)/ 0.35400942e-03/
	data glc(5,109)/-0.56239322e-05/,glc(6,109)/ 0.13019147e-05/
	data kgnam(110)/'LLF7  '/
	data glc(1,110)/ 0.23525384e+01/,glc(2,110)/-0.88030406e-02/
	data glc(3,110)/ 0.15703390e-01/,glc(4,110)/ 0.48840166e-03/
	data glc(5,110)/-0.14611711e-04/,glc(6,110)/ 0.21125553e-05/
	data kgnam(111)/'BAF3  '/
	data glc(1,111)/ 0.24549347e+01/,glc(2,111)/-0.83372035e-02/
	data glc(3,111)/ 0.16841270e-01/,glc(4,111)/ 0.50168527e-03/
	data glc(5,111)/-0.14413749e-04/,glc(6,111)/ 0.20771351e-05/
	data kgnam(112)/'BAF4  '/
	data glc(1,112)/ 0.25221558e+01/,glc(2,112)/-0.83373294e-02/
	data glc(3,112)/ 0.18614464e-01/,glc(4,112)/ 0.60603872e-03/
	data glc(5,112)/-0.18920312e-04/,glc(6,112)/ 0.27375194e-05/
	data kgnam(113)/'BAF5  '/
	data glc(1,113)/ 0.25332036e+01/,glc(2,113)/-0.85264801e-02/
	data glc(3,113)/ 0.17164398e-01/,glc(4,113)/ 0.41464804e-03/
	data glc(5,113)/-0.72876766e-05/,glc(6,113)/ 0.14129143e-05/
	data kgnam(114)/'BAFN6 '/
	data glc(1,114)/ 0.24763453e+01/,glc(2,114)/-0.91229217e-02/
	data glc(3,114)/ 0.16804733e-01/,glc(4,114)/ 0.34558633e-03/
	data glc(5,114)/ 0.25330454e-05/,glc(6,114)/ 0.11900884e-05/
	data kgnam(115)/'BAF8  '/
	data glc(1,115)/ 0.25817259e+01/,glc(2,115)/-0.86743047e-02/
	data glc(3,115)/ 0.18611342e-01/,glc(4,115)/ 0.46995284e-03/
	data glc(5,115)/-0.73102793e-05/,glc(6,115)/ 0.17799691e-05/
	data kgnam(116)/'BAF9  '/
	data glc(1,116)/ 0.26453542e+01/,glc(2,116)/-0.96193048e-02/
	data glc(3,116)/ 0.18369094e-01/,glc(4,116)/ 0.69291183e-03/
	data glc(5,116)/-0.37950550e-04/,glc(6,116)/ 0.32253161e-05/
	data kgnam(117)/'BAFN10'/
	data glc(1,117)/ 0.27293062e+01/,glc(2,117)/-0.10356456e-01/
	data glc(3,117)/ 0.20236563e-01/,glc(4,117)/ 0.58969718e-03/
	data glc(5,117)/-0.20288303e-04/,glc(6,117)/ 0.28521978e-05/
	data kgnam(118)/'BAFN11'/
	data glc(1,118)/ 0.27200652e+01/,glc(2,118)/-0.10192712e-01/
	data glc(3,118)/ 0.19760925e-01/,glc(4,118)/ 0.51935441e-03/
	data glc(5,118)/-0.14074936e-04/,glc(6,118)/ 0.22229689e-05/
	data kgnam(119)/'BAF12 '/
	data glc(1,119)/ 0.26288183e+01/,glc(2,119)/-0.93686092e-02/
	data glc(3,119)/ 0.19694576e-01/,glc(4,119)/ 0.58312064e-03/
	data glc(5,119)/-0.17556026e-04/,glc(6,119)/ 0.29471099e-05/
	data kgnam(120)/'BAF13 '/
	data glc(1,120)/ 0.27225849e+01/,glc(2,120)/-0.97951672e-02/
	data glc(3,120)/ 0.21079012e-01/,glc(4,120)/ 0.62762461e-03/
	data glc(5,120)/-0.18947499e-04/,glc(6,120)/ 0.32030090e-05/
	data kgnam(121)/'BAF50 '/
	data glc(1,121)/ 0.27649287e+01/,glc(2,121)/-0.93828870e-02/
	data glc(3,121)/ 0.22737486e-01/,glc(4,121)/ 0.44606478e-03/
	data glc(5,121)/ 0.61200859e-05/,glc(6,121)/ 0.17483664e-05/
	data kgnam(122)/'BAF51 '/
	data glc(1,122)/ 0.26688306e+01/,glc(2,122)/-0.92476959e-02/
	data glc(3,122)/ 0.20660252e-01/,glc(4,122)/ 0.52893109e-03/
	data glc(5,122)/-0.70867424e-05/,glc(6,122)/ 0.21797509e-05/
	data kgnam(123)/'BAF52 '/
	data glc(1,123)/ 0.25352388e+01/,glc(2,123)/-0.90581553e-02/
	data glc(3,123)/ 0.17360353e-01/,glc(4,123)/ 0.69764119e-03/
	data glc(5,123)/-0.38819033e-04/,glc(6,123)/ 0.35656310e-05/
	data kgnam(124)/'BAF53 '/
	data glc(1,124)/ 0.27294386e+01/,glc(2,124)/-0.10668350e-01/
	data glc(3,124)/ 0.20239807e-01/,glc(4,124)/ 0.58138876e-03/
	data glc(5,124)/-0.18249855e-04/,glc(6,124)/ 0.25746426e-05/
	data kgnam(125)/'BAF54 '/
	data glc(1,125)/ 0.27195755e+01/,glc(2,125)/-0.10322464e-01/
	data glc(3,125)/ 0.20098244e-01/,glc(4,125)/ 0.43867795e-03/
	data glc(5,125)/-0.23936865e-05/,glc(6,125)/ 0.15014011e-05/
	data kgnam(126)/'LF1   '/
	data glc(1,126)/ 0.24217647e+01/,glc(2,126)/-0.85906079e-02/
	data glc(3,126)/ 0.17651245e-01/,glc(4,126)/ 0.58415074e-03/
	data glc(5,126)/-0.16884537e-04/,glc(6,126)/ 0.27259662e-05/
	data kgnam(127)/'LF2   '/
	data glc(1,127)/ 0.24682847e+01/,glc(2,127)/-0.86227186e-02/
	data glc(3,127)/ 0.19045004e-01/,glc(4,127)/ 0.62971872e-03/
	data glc(5,127)/-0.15592113e-04/,glc(6,127)/ 0.30502534e-05/
	data kgnam(128)/'LF3   '/
	data glc(1,128)/ 0.24479180e+01/,glc(2,128)/-0.85152303e-02/
	data glc(3,128)/ 0.18685135e-01/,glc(4,128)/ 0.46787852e-03/
	data glc(5,128)/ 0.13422259e-05/,glc(6,128)/ 0.20021368e-05/
	data kgnam(129)/'LF4   '/
	data glc(1,129)/ 0.24364980e+01/,glc(2,129)/-0.86900852e-02/
	data glc(3,129)/ 0.18427867e-01/,glc(4,129)/ 0.56173085e-03/
	data glc(5,129)/-0.11219778e-04/,glc(6,129)/ 0.27012778e-05/
	data kgnam(130)/'LF5   '/
	data glc(1,130)/ 0.24441760e+01/,glc(2,130)/-0.83059695e-02/
	data glc(3,130)/ 0.19000697e-01/,glc(4,130)/ 0.54129697e-03/
	data glc(5,130)/-0.41973115e-05/,glc(6,130)/ 0.23742897e-05/
	data kgnam(131)/'LF6   '/
	data glc(1,131)/ 0.24043241e+01/,glc(2,131)/-0.84381264e-02/
	data glc(3,131)/ 0.17623826e-01/,glc(4,131)/ 0.47507875e-03/
	data glc(5,131)/-0.40602970e-05/,glc(6,131)/ 0.20556661e-05/
	data kgnam(132)/'LF7   '/
	data glc(1,132)/ 0.24259431e+01/,glc(2,132)/-0.86137761e-02/
	data glc(3,132)/ 0.18353273e-01/,glc(4,132)/ 0.53951938e-03/
	data glc(5,132)/-0.69790993e-05/,glc(6,132)/ 0.24087417e-05/
	data kgnam(133)/'LF8   '/
	data glc(1,133)/ 0.23966602e+01/,glc(2,133)/-0.82907298e-02/
	data glc(3,133)/ 0.17199116e-01/,glc(4,133)/ 0.45298946e-03/
	data glc(5,133)/-0.38995694e-05/,glc(6,133)/ 0.19005178e-05/
	data kgnam(134)/'F1    '/
	data glc(1,134)/ 0.25713922e+01/,glc(2,134)/-0.84543797e-02/
	data glc(3,134)/ 0.23611565e-01/,glc(4,134)/ 0.78346482e-03/
	data glc(5,134)/-0.10331153e-04/,glc(6,134)/ 0.42751979e-05/
	data kgnam(135)/'F2    '/
	data glc(1,135)/ 0.25554063e+01/,glc(2,135)/-0.88746150e-02/
	data glc(3,135)/ 0.22494787e-01/,glc(4,135)/ 0.86924972e-03/
	data glc(5,135)/-0.24011704e-04/,glc(6,135)/ 0.45365169e-05/
	data kgnam(136)/'F3    '/
	data glc(1,136)/ 0.25342719e+01/,glc(2,136)/-0.86565414e-02/
	data glc(3,136)/ 0.22160522e-01/,glc(4,136)/ 0.71828923e-03/
	data glc(5,136)/-0.83757309e-05/,glc(6,136)/ 0.35549137e-05/
	data kgnam(137)/'F4    '/
	data glc(1,137)/ 0.25446900e+01/,glc(2,137)/-0.85925662e-02/
	data glc(3,137)/ 0.22583116e-01/,glc(4,137)/ 0.73789911e-03/
	data glc(5,137)/-0.95060664e-05/,glc(6,137)/ 0.38257675e-05/
	data kgnam(138)/'F5    '/
	data glc(1,138)/ 0.25069744e+01/,glc(2,138)/-0.86678569e-02/
	data glc(3,138)/ 0.21105291e-01/,glc(4,138)/ 0.70608713e-03/
	data glc(5,138)/-0.13731195e-04/,glc(6,138)/ 0.35479149e-05/
	data kgnam(139)/'F6    '/
	data glc(1,139)/ 0.26038221e+01/,glc(2,139)/-0.88224838e-02/
	data glc(3,139)/ 0.23872164e-01/,glc(4,139)/ 0.96357866e-03/
	data glc(5,139)/-0.29653611e-04/,glc(6,139)/ 0.54103450e-05/
	data kgnam(140)/'F7    '/
	data glc(1,140)/ 0.25700098e+01/,glc(2,140)/-0.84594488e-02/
	data glc(3,140)/ 0.23243109e-01/,glc(4,140)/ 0.91209596e-03/
	data glc(5,140)/-0.25955976e-04/,glc(6,140)/ 0.51185012e-05/
	data kgnam(141)/'F8    '/
	data glc(1,141)/ 0.24847853e+01/,glc(2,141)/-0.87690408e-02/
	data glc(3,141)/ 0.20213087e-01/,glc(4,141)/ 0.63621526e-03/
	data glc(5,141)/-0.83230722e-05/,glc(6,141)/ 0.29472755e-05/
	data kgnam(142)/'F9    '/
	data glc(1,142)/ 0.25599175e+01/,glc(2,142)/-0.93903357e-02/
	data glc(3,142)/ 0.21745487e-01/,glc(4,142)/ 0.75168710e-03/
	data glc(5,142)/-0.16255461e-04/,glc(6,142)/ 0.40551837e-05/
	data kgnam(143)/'FN11  '/
	data glc(1,143)/ 0.25610417e+01/,glc(2,143)/-0.11488430e-01/
	data glc(3,143)/ 0.21189476e-01/,glc(4,143)/ 0.12504217e-02/
	data glc(5,143)/-0.89130731e-04/,glc(6,143)/ 0.10480983e-04/
	data kgnam(144)/'F13   '/
	data glc(1,144)/ 0.25614812e+01/,glc(2,144)/-0.85680987e-02/
	data glc(3,144)/ 0.23074904e-01/,glc(4,144)/ 0.81271690e-03/
	data glc(5,144)/-0.16852152e-04/,glc(6,144)/ 0.45166052e-05/
	data kgnam(145)/'F14   '/
	data glc(1,145)/ 0.25012990e+01/,glc(2,145)/-0.87770607e-02/
	data glc(3,145)/ 0.20833999e-01/,glc(4,145)/ 0.71365720e-03/
	data glc(5,145)/-0.15356429e-04/,glc(6,145)/ 0.35458118e-05/
	data kgnam(146)/'F15   '/
	data glc(1,146)/ 0.25138970e+01/,glc(2,146)/-0.88848319e-02/
	data glc(3,146)/ 0.21048670e-01/,glc(4,146)/ 0.77800910e-03/
	data glc(5,146)/-0.19727183e-04/,glc(6,146)/ 0.38039205e-05/
	data kgnam(147)/'BASF1 '/
	data glc(1,147)/ 0.25778903e+01/,glc(2,147)/-0.83279108e-02/
	data glc(3,147)/ 0.21841868e-01/,glc(4,147)/ 0.68618153e-03/
	data glc(5,147)/-0.81530554e-05/,glc(6,147)/ 0.33013474e-05/
	data kgnam(148)/'BASF2 '/
	data glc(1,148)/ 0.26926115e+01/,glc(2,148)/-0.87432478e-02/
	data glc(3,148)/ 0.25176098e-01/,glc(4,148)/ 0.97702423e-03/
	data glc(5,148)/-0.28680692e-04/,glc(6,148)/ 0.57931396e-05/
	data kgnam(149)/'BASF5 '/
	data glc(1,149)/ 0.25131519e+01/,glc(2,149)/-0.85791364e-02/
	data glc(3,149)/ 0.19014140e-01/,glc(4,149)/ 0.63221574e-03/
	data glc(5,149)/-0.17533060e-04/,glc(6,149)/ 0.28739893e-05/
	data kgnam(150)/'BASF6 '/
	data glc(1,150)/ 0.27138041e+01/,glc(2,150)/-0.94656841e-02/
	data glc(3,150)/ 0.22128109e-01/,glc(4,150)/ 0.77376428e-03/
	data glc(5,150)/-0.28857539e-04/,glc(6,150)/ 0.42797530e-05/
	data kgnam(151)/'BASF10'/
	data glc(1,151)/ 0.26531250e+01/,glc(2,151)/-0.81388553e-02/
	data glc(3,151)/ 0.22995643e-01/,glc(4,151)/ 0.73535957e-03/
	data glc(5,151)/-0.13407390e-04/,glc(6,151)/ 0.36962325e-05/
	data kgnam(152)/'BASF12'/
	data glc(1,152)/ 0.27172821e+01/,glc(2,152)/-0.95055782e-02/
	data glc(3,152)/ 0.23326873e-01/,glc(4,152)/ 0.93379945e-03/
	data glc(5,152)/-0.39996373e-04/,glc(6,152)/ 0.56638955e-05/
	data kgnam(153)/'BASF13'/
	data glc(1,153)/ 0.28055334e+01/,glc(2,153)/-0.10583600e-01/
	data glc(3,153)/ 0.24780423e-01/,glc(4,153)/ 0.10753528e-02/
	data glc(5,153)/-0.54046905e-04/,glc(6,153)/ 0.72739552e-05/
	data kgnam(154)/'BASF14'/
	data glc(1,154)/ 0.28040560e+01/,glc(2,154)/-0.10121606e-01/
	data glc(3,154)/ 0.27277876e-01/,glc(4,154)/ 0.11920911e-02/
	data glc(5,154)/-0.52304151e-04/,glc(6,154)/ 0.86551492e-05/
	data kgnam(155)/'BASF50'/
	data glc(1,155)/ 0.28430385e+01/,glc(2,155)/-0.12392675e-01/
	data glc(3,155)/ 0.26677418e-01/,glc(4,155)/ 0.11036516e-02/
	data glc(5,155)/-0.38659027e-04/,glc(6,155)/ 0.60798447e-05/
	data kgnam(156)/'BASF51'/
	data glc(1,156)/ 0.28907600e+01/,glc(2,156)/-0.11983429e-01/
	data glc(3,156)/ 0.25796356e-01/,glc(4,156)/ 0.13500460e-02/
	data glc(5,156)/-0.82129746e-04/,glc(6,156)/ 0.79925811e-05/
	data kgnam(157)/'BASF52'/
	data glc(1,157)/ 0.28247094e+01/,glc(2,157)/-0.13066162e-01/
	data glc(3,157)/ 0.23808337e-01/,glc(4,157)/ 0.89302284e-03/
	data glc(5,157)/-0.33448747e-04/,glc(6,157)/ 0.44506802e-05/
	data kgnam(158)/'BASF54'/
	data glc(1,158)/ 0.29179112e+01/,glc(2,158)/-0.11371629e-01/
	data glc(3,158)/ 0.29697508e-01/,glc(4,158)/ 0.20284464e-02/
	data glc(5,158)/-0.14304533e-03/,glc(6,158)/ 0.15393060e-04/
	data kgnam(159)/'BASF55'/
	data glc(1,159)/ 0.28080853e+01/,glc(2,159)/-0.13076515e-01/
	data glc(3,159)/ 0.24961324e-01/,glc(4,159)/ 0.19412734e-02/
	data glc(5,159)/-0.15776742e-03/,glc(6,159)/ 0.14562956e-04/
	data kgnam(160)/'BASF56'/
	data glc(1,160)/ 0.26716908e+01/,glc(2,160)/-0.88722613e-02/
	data glc(3,160)/ 0.24052884e-01/,glc(4,160)/ 0.99655176e-03/
	data glc(5,160)/-0.38518520e-04/,glc(6,160)/ 0.59357564e-05/
	data kgnam(161)/'BASF57'/
	data glc(1,161)/ 0.26629169e+01/,glc(2,161)/-0.98650297e-02/
	data glc(3,161)/ 0.21537161e-01/,glc(4,161)/ 0.66532162e-03/
	data glc(5,161)/-0.14148425e-04/,glc(6,161)/ 0.33387062e-05/
	data kgnam(162)/'BASF64'/
	data glc(1,162)/ 0.28178914e+01/,glc(2,162)/-0.11398749e-01/
	data glc(3,162)/ 0.25203102e-01/,glc(4,162)/ 0.77721356e-03/
	data glc(5,162)/-0.16483738e-04/,glc(6,162)/ 0.45370859e-05/
	data kgnam(163)/'LAF2  '/
	data glc(1,163)/ 0.29673787e+01/,glc(2,163)/-0.10978767e-01/
	data glc(3,163)/ 0.25088607e-01/,glc(4,163)/ 0.63171596e-03/
	data glc(5,163)/-0.75645417e-05/,glc(6,163)/ 0.23202213e-05/
	data kgnam(164)/'LAF3  '/
	data glc(1,164)/ 0.28832223e+01/,glc(2,164)/-0.11371082e-01/
	data glc(3,164)/ 0.22149870e-01/,glc(4,164)/ 0.57232017e-03/
	data glc(5,164)/-0.13181988e-04/,glc(6,164)/ 0.20252639e-05/
	data kgnam(165)/'LAFN7 '/
	data glc(1,165)/ 0.29676706e+01/,glc(2,165)/-0.13465547e-01/
	data glc(3,165)/ 0.30562239e-01/,glc(4,165)/ 0.11147255e-02/
	data glc(5,165)/-0.23979989e-04/,glc(6,165)/ 0.62175926e-05/
	data kgnam(166)/'LAFN8 '/
	data glc(1,166)/ 0.29343747e+01/,glc(2,166)/-0.12591530e-01/
	data glc(3,166)/ 0.25612524e-01/,glc(4,166)/ 0.82846469e-03/
	data glc(5,166)/-0.22108582e-04/,glc(6,166)/ 0.39458540e-05/
	data kgnam(167)/'LAF9  '/
	data glc(1,167)/ 0.30998216e+01/,glc(2,167)/-0.12191689e-01/
	data glc(3,167)/ 0.37147724e-01/,glc(4,167)/ 0.25559645e-02/
	data glc(5,167)/-0.15721379e-03/,glc(6,167)/ 0.18886019e-04/
	data kgnam(168)/'LAFN10'/
	data glc(1,168)/ 0.31052418e+01/,glc(2,168)/-0.15458266e-01/
	data glc(3,168)/ 0.26987363e-01/,glc(4,168)/ 0.74367535e-03/
	data glc(5,168)/-0.12921245e-04/,glc(6,168)/ 0.27404039e-05/
	data kgnam(169)/'LAFN11'/
	data glc(1,169)/ 0.29824657e+01/,glc(2,169)/-0.11740938e-01/
	data glc(3,169)/ 0.33413662e-01/,glc(4,169)/ 0.14342882e-02/
	data glc(5,169)/-0.44936078e-04/,glc(6,169)/ 0.91479497e-05/
	data kgnam(170)/'LAF13 '/
	data glc(1,170)/ 0.30604516e+01/,glc(2,170)/-0.12242361e-01/
	data glc(3,170)/ 0.30441692e-01/,glc(4,170)/ 0.96185256e-03/
	data glc(5,170)/-0.16231095e-04/,glc(6,170)/ 0.49181335e-05/
	data kgnam(171)/'LAF20 '/
	data glc(1,171)/ 0.27698488e+01/,glc(2,171)/-0.10003512e-01/
	data glc(3,171)/ 0.20882171e-01/,glc(4,171)/ 0.45883886e-03/
	data glc(5,171)/-0.50275096e-05/,glc(6,171)/ 0.16410791e-05/
	data kgnam(172)/'LAF21 '/
	data glc(1,172)/ 0.31235620e+01/,glc(2,172)/-0.15060495e-01/
	data glc(3,172)/ 0.25833167e-01/,glc(4,172)/ 0.58672351e-03/
	data glc(5,172)/-0.70659294e-05/,glc(6,172)/ 0.15283898e-05/
	data kgnam(173)/'LAF22 '/
	data glc(1,173)/ 0.30810534e+01/,glc(2,173)/-0.12471635e-01/
	data glc(3,173)/ 0.30440583e-01/,glc(4,173)/ 0.12728060e-02/
	data glc(5,173)/-0.59411203e-04/,glc(6,173)/ 0.88134517e-05/
	data kgnam(174)/'LAFN23'/
	data glc(1,174)/ 0.27925282e+01/,glc(2,174)/-0.97181630e-02/
	data glc(3,174)/ 0.20756437e-01/,glc(4,174)/ 0.39610891e-03/
	data glc(5,174)/ 0.19565557e-05/,glc(6,174)/ 0.10029477e-05/
	data kgnam(175)/'LAFN24'/
	data glc(1,175)/ 0.30188196e+01/,glc(2,175)/-0.15176009e-01/
	data glc(3,175)/ 0.24040260e-01/,glc(4,175)/ 0.53038456e-03/
	data glc(5,175)/-0.13346974e-05/,glc(6,175)/ 0.12064345e-05/
	data kgnam(176)/'LAF25 '/
	data glc(1,176)/ 0.30997712e+01/,glc(2,176)/-0.14428294e-01/
	data glc(3,176)/ 0.27899374e-01/,glc(4,176)/ 0.10345598e-02/
	data glc(5,176)/-0.43008448e-04/,glc(6,176)/ 0.54917491e-05/
	data kgnam(177)/'LAF26 '/
	data glc(1,177)/ 0.29676367e+01/,glc(2,177)/-0.13599942e-01/
	data glc(3,177)/ 0.27026861e-01/,glc(4,177)/ 0.88284489e-03/
	data glc(5,177)/-0.22042475e-04/,glc(6,177)/ 0.45665081e-05/
	data kgnam(178)/'LAFN28'/
	data glc(1,178)/ 0.30750514e+01/,glc(2,178)/-0.14743725e-01/
	data glc(3,178)/ 0.24004375e-01/,glc(4,178)/ 0.55949356e-03/
	data glc(5,178)/-0.10007074e-04/,glc(6,178)/ 0.11559175e-05/
	data kgnam(179)/'LASF3 '/
	data glc(1,179)/ 0.31784063e+01/,glc(2,179)/-0.13412073e-01/
	data glc(3,179)/ 0.30181383e-01/,glc(4,179)/ 0.95182871e-03/
	data glc(5,179)/-0.20895475e-04/,glc(6,179)/ 0.36834162e-05/
	data kgnam(180)/'LASF8 '/
	data glc(1,180)/ 0.31513867e+01/,glc(2,180)/-0.12595765e-01/
	data glc(3,180)/ 0.36908088e-01/,glc(4,180)/ 0.15820869e-02/
	data glc(5,180)/-0.51101128e-04/,glc(6,180)/ 0.10662006e-04/
	data kgnam(181)/'LASFN9'/
	data glc(1,181)/ 0.32994326e+01/,glc(2,181)/-0.11680436e-01/
	data glc(3,181)/ 0.40133103e-01/,glc(4,181)/ 0.13263988e-02/
	data glc(5,181)/ 0.47438783e-05/,glc(6,181)/ 0.78507188e-05/
	data kgnam(182)/'LASF11'/
	data glc(1,182)/ 0.31634123e+01/,glc(2,182)/-0.14427452e-01/
	data glc(3,182)/ 0.28384126e-01/,glc(4,182)/ 0.60299606e-03/
	data glc(5,182)/ 0.66029672e-05/,glc(6,182)/ 0.14484996e-05/
	data kgnam(183)/'LASF13'/
	data glc(1,183)/ 0.33331229e+01/,glc(2,183)/-0.13161988e-01/
	data glc(3,183)/ 0.35541296e-01/,glc(4,183)/ 0.14177373e-02/
	data glc(5,183)/-0.52019105e-04/,glc(6,183)/ 0.72348123e-05/
	data kgnam(184)/'LASFN1'/
	data glc(1,184)/ 0.34174343e+01/,glc(2,184)/-0.15504887e-01/
	data glc(3,184)/ 0.36536079e-01/,glc(4,184)/ 0.10424971e-02/
	data glc(5,184)/-0.18067825e-05/,glc(6,184)/ 0.38393637e-05/
	data kgnam(185)/'LASFN1'/
	data glc(1,185)/ 0.35278149e+01/,glc(2,185)/-0.17049614e-01/
	data glc(3,185)/ 0.42895039e-01/,glc(4,185)/ 0.19248178e-02/
	data glc(5,185)/-0.75388918e-04/,glc(6,185)/ 0.13032008e-04/
	data kgnam(186)/'LASFN3'/
	data glc(1,186)/ 0.31731314e+01/,glc(2,186)/-0.14823958e-01/
	data glc(3,186)/ 0.26862762e-01/,glc(4,186)/ 0.69283981e-03/
	data glc(5,186)/-0.12265479e-04/,glc(6,186)/ 0.17263354e-05/
	data kgnam(187)/'LASFN3'/
	data glc(1,187)/ 0.34322240e+01/,glc(2,187)/-0.12790848e-01/
	data glc(3,187)/ 0.35133497e-01/,glc(4,187)/ 0.84763112e-03/
	data glc(5,187)/ 0.45551843e-05/,glc(6,187)/ 0.16550517e-05/
	data kgnam(188)/'LASF32'/
	data glc(1,188)/ 0.31385520e+01/,glc(2,188)/-0.15378166e-01/
	data glc(3,188)/ 0.34981894e-01/,glc(4,188)/ 0.24848158e-02/
	data glc(5,188)/-0.17333919e-03/,glc(6,188)/ 0.19596905e-04/
	data kgnam(189)/'LASF33'/
	data glc(1,189)/ 0.31542132e+01/,glc(2,189)/-0.11481374e-01/
	data glc(3,189)/ 0.34684427e-01/,glc(4,189)/ 0.12974344e-02/
	data glc(5,189)/-0.27569572e-04/,glc(6,189)/ 0.78461878e-05/
	data kgnam(190)/'SF1   '/
	data glc(1,190)/ 0.28458754e+01/,glc(2,190)/-0.98260548e-02/
	data glc(3,190)/ 0.32192965e-01/,glc(4,190)/ 0.17491597e-02/
	data glc(5,190)/-0.78964252e-04/,glc(6,190)/ 0.11858651e-04/
	data kgnam(191)/'SF2   '/
	data glc(1,191)/ 0.26361862e+01/,glc(2,191)/-0.90087536e-02/
	data glc(3,191)/ 0.25179779e-01/,glc(4,191)/ 0.11171914e-02/
	data glc(5,191)/-0.40112089e-04/,glc(6,191)/ 0.66254840e-05/
	data kgnam(192)/'SF3   '/
	data glc(1,192)/ 0.29144630e+01/,glc(2,192)/-0.97237692e-02/
	data glc(3,192)/ 0.34855288e-01/,glc(4,192)/ 0.20259158e-02/
	data glc(5,192)/-0.10348282e-03/,glc(6,192)/ 0.14959114e-04/
	data kgnam(193)/'SF4   '/
	data glc(1,193)/ 0.29605971e+01/,glc(2,193)/-0.93495013e-02/
	data glc(3,193)/ 0.37404384e-01/,glc(4,193)/ 0.18634691e-02/
	data glc(5,193)/-0.65403181e-04/,glc(6,193)/ 0.13765657e-04/
	data kgnam(194)/'SF5   '/
	data glc(1,194)/ 0.27105646e+01/,glc(2,194)/-0.91211994e-02/
	data glc(3,194)/ 0.27760538e-01/,glc(4,194)/ 0.12739656e-02/
	data glc(5,194)/-0.47889342e-04/,glc(6,194)/ 0.80562028e-05/
	data kgnam(195)/'SF6   '/
	data glc(1,195)/ 0.31195007e+01/,glc(2,195)/-0.10902580e-01/
	data glc(3,195)/ 0.41330651e-01/,glc(4,195)/ 0.31800214e-02/
	data glc(5,195)/-0.21953184e-03/,glc(6,195)/ 0.26671014e-04/
	data kgnam(196)/'SFL6  '/
	data glc(1,196)/ 0.31206868e+01/,glc(2,196)/-0.13279387e-01/
	data glc(3,196)/ 0.41905574e-01/,glc(4,196)/ 0.27505904e-02/
	data glc(5,196)/-0.15173832e-03/,glc(6,196)/ 0.25644487e-04/
	data kgnam(197)/'SF7   '/
	data glc(1,197)/ 0.26129703e+01/,glc(2,197)/-0.89265027e-02/
	data glc(3,197)/ 0.24553061e-01/,glc(4,197)/ 0.97700411e-03/
	data glc(5,197)/-0.26551022e-04/,glc(6,197)/ 0.54909672e-05/
	data kgnam(198)/'SF8   '/
	data glc(1,198)/ 0.27594675e+01/,glc(2,198)/-0.93696887e-02/
	data glc(3,198)/ 0.29328240e-01/,glc(4,198)/ 0.14385871e-02/
	data glc(5,198)/-0.58543435e-04/,glc(6,198)/ 0.93241989e-05/
	data kgnam(199)/'SF9   '/
	data glc(1,199)/ 0.26563905e+01/,glc(2,199)/-0.89916333e-02/
	data glc(3,199)/ 0.26099377e-01/,glc(4,199)/ 0.10141982e-02/
	data glc(5,199)/-0.23235110e-04/,glc(6,199)/ 0.58174500e-05/
	data kgnam(200)/'SF10  '/
	data glc(1,200)/ 0.28784725e+01/,glc(2,200)/-0.10565453e-01/
	data glc(3,200)/ 0.33279420e-01/,glc(4,200)/ 0.20551378e-02/
	data glc(5,200)/-0.11396226e-03/,glc(6,200)/ 0.16340021e-04/
	data kgnam(201)/'SF11  '/
	data glc(1,201)/ 0.30539614e+01/,glc(2,201)/-0.11580432e-01/
	data glc(3,201)/ 0.39199816e-01/,glc(4,201)/ 0.29462812e-02/
	data glc(5,201)/-0.20371019e-03/,glc(6,201)/ 0.27633569e-04/
	data kgnam(202)/'SF12  '/
	data glc(1,202)/ 0.26385867e+01/,glc(2,202)/-0.94879851e-02/
	data glc(3,202)/ 0.24984154e-01/,glc(4,202)/ 0.11970650e-02/
	data glc(5,202)/-0.55728265e-04/,glc(6,202)/ 0.78814553e-05/
	data kgnam(203)/'SF13  '/
	data glc(1,203)/ 0.29177579e+01/,glc(2,203)/-0.11483287e-01/
	data glc(3,203)/ 0.33825845e-01/,glc(4,203)/ 0.25277439e-02/
	data glc(5,203)/-0.17332899e-03/,glc(6,203)/ 0.21465274e-04/
	data kgnam(204)/'SF14  '/
	data glc(1,204)/ 0.29826955e+01/,glc(2,204)/-0.11720091e-01/
	data glc(3,204)/ 0.35994978e-01/,glc(4,204)/ 0.29250972e-02/
	data glc(5,204)/-0.21913665e-03/,glc(6,204)/ 0.26700784e-04/
	data kgnam(205)/'SF15  '/
	data glc(1,205)/ 0.27898291e+01/,glc(2,205)/-0.10260526e-01/
	data glc(3,205)/ 0.29707118e-01/,glc(4,205)/ 0.19137570e-02/
	data glc(5,205)/-0.12468626e-03/,glc(6,205)/ 0.15187223e-04/
	data kgnam(206)/'SF16  '/
	data glc(1,206)/ 0.26312546e+01/,glc(2,206)/-0.88042107e-02/
	data glc(3,206)/ 0.25282256e-01/,glc(4,206)/ 0.10126871e-02/
	data glc(5,206)/-0.27861159e-04/,glc(6,206)/ 0.58927698e-05/
	data kgnam(207)/'SF17  '/
	data glc(1,207)/ 0.26432169e+01/,glc(2,207)/-0.88860441e-02/
	data glc(3,207)/ 0.25631865e-01/,glc(4,207)/ 0.10760709e-02/
	data glc(5,207)/-0.33523570e-04/,glc(6,207)/ 0.64052431e-05/
	data kgnam(208)/'SF18  '/
	data glc(1,208)/ 0.28577802e+01/,glc(2,208)/-0.94889259e-02/
	data glc(3,208)/ 0.33023767e-01/,glc(4,208)/ 0.17143328e-02/
	data glc(5,208)/-0.74064352e-04/,glc(6,208)/ 0.12078466e-04/
	data kgnam(209)/'SF19  '/
	data glc(1,209)/ 0.26942327e+01/,glc(2,209)/-0.94285222e-02/
	data glc(3,209)/ 0.26806270e-01/,glc(4,209)/ 0.12120420e-02/
	data glc(5,209)/-0.45516530e-04/,glc(6,209)/ 0.75592211e-05/
	data kgnam(210)/'SF50  '/
	data glc(1,210)/ 0.26574144e+01/,glc(2,210)/-0.95545655e-02/
	data glc(3,210)/ 0.25081498e-01/,glc(4,210)/ 0.15350870e-02/
	data glc(5,210)/-0.91737353e-04/,glc(6,210)/ 0.99741416e-05/
	data kgnam(211)/'SF51  '/
	data glc(1,211)/ 0.26785087e+01/,glc(2,211)/-0.11867542e-01/
	data glc(3,211)/ 0.23037272e-01/,glc(4,211)/ 0.22651418e-02/
	data glc(5,211)/-0.20072278e-03/,glc(6,211)/ 0.16380215e-04/
	data kgnam(212)/'SF52  '/
	data glc(1,212)/ 0.27576175e+01/,glc(2,212)/-0.97069196e-02/
	data glc(3,212)/ 0.29008907e-01/,glc(4,212)/ 0.16834427e-02/
	data glc(5,212)/-0.86832245e-04/,glc(6,212)/ 0.11266792e-04/
	data kgnam(213)/'SF53  '/
	data glc(1,213)/ 0.28788944e+01/,glc(2,213)/-0.10038296e-01/
	data glc(3,213)/ 0.33232802e-01/,glc(4,213)/ 0.20364401e-02/
	data glc(5,213)/-0.11763293e-03/,glc(6,213)/ 0.15672506e-04/
	data kgnam(214)/'SF54  '/
	data glc(1,214)/ 0.29157333e+01/,glc(2,214)/-0.94607589e-02/
	data glc(3,214)/ 0.35929046e-01/,glc(4,214)/ 0.16830114e-02/
	data glc(5,214)/-0.46451087e-04/,glc(6,214)/ 0.12104532e-04/
	data kgnam(215)/'SF55  '/
	data glc(1,215)/ 0.29810972e+01/,glc(2,215)/-0.10106105e-01/
	data glc(3,215)/ 0.37725376e-01/,glc(4,215)/ 0.21692831e-02/
	data glc(5,215)/-0.94743970e-04/,glc(6,215)/ 0.16404455e-04/
	data kgnam(216)/'SF56  '/
	data glc(1,216)/ 0.30510040e+01/,glc(2,216)/-0.94149325e-02/
	data glc(3,216)/ 0.41729775e-01/,glc(4,216)/ 0.19779903e-02/
	data glc(5,216)/-0.48421498e-04/,glc(6,216)/ 0.15734251e-04/
	data kgnam(217)/'SFL56 '/
	data glc(1,217)/ 0.30549693e+01/,glc(2,217)/-0.12858387e-01/
	data glc(3,217)/ 0.40081007e-01/,glc(4,217)/ 0.23376489e-02/
	data glc(5,217)/-0.10682651e-03/,glc(6,217)/ 0.21446850e-04/
	data kgnam(218)/'SF57  '/
	data glc(1,218)/ 0.32578469e+01/,glc(2,218)/-0.14544868e-01/
	data glc(3,218)/ 0.42028938e-01/,glc(4,218)/ 0.52295853e-02/
	data glc(5,218)/-0.46931979e-03/,glc(6,218)/ 0.44359036e-04/
	data kgnam(219)/'SF58  '/
	data glc(1,219)/ 0.34782654e+01/,glc(2,219)/-0.10766912e-01/
	data glc(3,219)/ 0.58676907e-01/,glc(4,219)/ 0.42207315e-02/
	data glc(5,219)/-0.22895268e-03/,glc(6,219)/ 0.40847905e-04/
	data kgnam(220)/'SF59  '/
	data glc(1,220)/ 0.36049456e+01/,glc(2,220)/-0.17579501e-01/
	data glc(3,220)/ 0.54777275e-01/,glc(4,220)/ 0.80837909e-02/
	data glc(5,220)/-0.76975589e-03/,glc(6,220)/ 0.79262505e-04/
	data kgnam(221)/'SF61  '/
	data glc(1,221)/ 0.29458531e+01/,glc(2,221)/-0.92723542e-02/
	data glc(3,221)/ 0.37513268e-01/,glc(4,221)/ 0.16807292e-02/
	data glc(5,221)/-0.33978727e-04/,glc(6,221)/ 0.12154392e-04/
	data kgnam(222)/'SF62  '/
	data glc(1,222)/ 0.27369014e+01/,glc(2,222)/-0.91210145e-02/
	data glc(3,222)/ 0.28718145e-01/,glc(4,222)/ 0.12307943e-02/
	data glc(5,222)/-0.37780898e-04/,glc(6,222)/ 0.78617786e-05/
	data kgnam(223)/'SF63  '/
	data glc(1,223)/ 0.29393620e+01/,glc(2,223)/-0.96548019e-02/
	data glc(3,223)/ 0.36674842e-01/,glc(4,223)/ 0.17881803e-02/
	data glc(5,223)/-0.52282393e-04/,glc(6,223)/ 0.12867869e-04/
	data kgnam(224)/'SFN64 '/
	data glc(1,224)/ 0.28125953e+01/,glc(2,224)/-0.11916007e-01/
	data glc(3,224)/ 0.31041260e-01/,glc(4,224)/ 0.14083879e-02/
	data glc(5,224)/-0.44978076e-04/,glc(6,224)/ 0.11419083e-04/
	data kgnam(225)/'TIK1  '/
	data glc(1,225)/ 0.21573978e+01/,glc(2,225)/-0.84004189e-02/
	data glc(3,225)/ 0.10457582e-01/,glc(4,225)/ 0.21822593e-03/
	data glc(5,225)/-0.55063640e-05/,glc(6,225)/ 0.54469060e-06/
	data kgnam(226)/'TIF1  '/
	data glc(1,226)/ 0.22473124e+01/,glc(2,226)/-0.89044058e-02/
	data glc(3,226)/ 0.12493525e-01/,glc(4,226)/ 0.42650638e-03/
	data glc(5,226)/-0.21564809e-04/,glc(6,226)/ 0.26364065e-05/
	data kgnam(227)/'TIF2  '/
	data glc(1,227)/ 0.23062438e+01/,glc(2,227)/-0.93513887e-02/
	data glc(3,227)/ 0.14218213e-01/,glc(4,227)/ 0.61537921e-03/
	data glc(5,227)/-0.39493915e-04/,glc(6,227)/ 0.47363335e-05/
	data kgnam(228)/'TIF3  '/
	data glc(1,228)/ 0.23488389e+01/,glc(2,228)/-0.10357251e-01/
	data glc(3,228)/ 0.14639213e-01/,glc(4,228)/ 0.11021697e-02/
	data glc(5,228)/-0.93622430e-04/,glc(6,228)/ 0.82094068e-05/
	data kgnam(229)/'TIF4  '/
	data glc(1,229)/ 0.24498259e+01/,glc(2,229)/-0.10128610e-01/
	data glc(3,229)/ 0.18753684e-01/,glc(4,229)/ 0.11999618e-02/
	data glc(5,229)/-0.88610291e-04/,glc(6,229)/ 0.98139193e-05/
	data kgnam(230)/'TIFN5 '/
	data glc(1,230)/ 0.24757539e+01/,glc(2,230)/-0.10282285e-01/
	data glc(3,230)/ 0.20102692e-01/,glc(4,230)/ 0.12335546e-02/
	data glc(5,230)/-0.85902987e-04/,glc(6,230)/ 0.10257463e-04/
	data kgnam(231)/'TIF6  '/
	data glc(1,231)/ 0.25388379e+01/,glc(2,231)/-0.10552711e-01/
	data glc(3,231)/ 0.22004734e-01/,glc(4,231)/ 0.20230960e-02/
	data glc(5,231)/-0.18345806e-03/,glc(6,231)/ 0.23097036e-04/
	data kgnam(232)/'TISF1 '/
	data glc(1,232)/ 0.27091574e+01/,glc(2,232)/-0.12750242e-01/
	data glc(3,232)/ 0.27097845e-01/,glc(4,232)/ 0.24436836e-02/
	data glc(5,232)/-0.21244237e-03/,glc(6,232)/ 0.23518712e-04/
	data kgnam(233)/'KZFN1 '/
	data glc(1,233)/ 0.23635655e+01/,glc(2,233)/-0.96497023e-02/
	data glc(3,233)/ 0.14907410e-01/,glc(4,233)/ 0.30149478e-03/
	data glc(5,233)/ 0.28868678e-05/,glc(6,233)/ 0.67799805e-06/
	data kgnam(234)/'KZFN2 '/
	data glc(1,234)/ 0.23016068e+01/,glc(2,234)/-0.10463801e-01/
	data glc(3,234)/ 0.13289732e-01/,glc(4,234)/ 0.33438756e-03/
	data glc(5,234)/-0.71799896e-05/,glc(6,234)/ 0.91964556e-06/
	data kgnam(235)/'KZF6  '/
	data glc(1,235)/ 0.22934044e+01/,glc(2,235)/-0.10346122e-01/
	data glc(3,235)/ 0.13319863e-01/,glc(4,235)/ 0.34833226e-03/
	data glc(5,235)/-0.99354090e-05/,glc(6,235)/ 0.11227905e-05/
	data kgnam(236)/'KZFS1 '/
	data glc(1,236)/ 0.25495109e+01/,glc(2,236)/-0.14614529e-01/
	data glc(3,236)/ 0.18246082e-01/,glc(4,236)/ 0.60860367e-03/
	data glc(5,236)/-0.20613741e-04/,glc(6,236)/ 0.23500631e-05/
	data kgnam(237)/'KZFSN2'/
	data glc(1,237)/ 0.23912843e+01/,glc(2,237)/-0.13244644e-01/
	data glc(3,237)/ 0.13524263e-01/,glc(4,237)/ 0.33475551e-03/
	data glc(5,237)/-0.11613973e-04/,glc(6,237)/ 0.10939788e-05/
	data kgnam(238)/'KZFSN4'/
	data glc(1,238)/ 0.25493446e+01/,glc(2,238)/-0.13234586e-01/
	data glc(3,238)/ 0.18586165e-01/,glc(4,238)/ 0.54759655e-03/
	data glc(5,238)/-0.11717987e-04/,glc(6,238)/ 0.20042905e-05/
	data kgnam(239)/'KZFSN5'/
	data glc(1,239)/ 0.26699840e+01/,glc(2,239)/-0.13941585e-01/
	data glc(3,239)/ 0.22384056e-01/,glc(4,239)/ 0.74780873e-03/
	data glc(5,239)/-0.17341165e-04/,glc(6,239)/ 0.34427318e-05/
	data kgnam(240)/'KZFS6 '/
	data glc(1,240)/ 0.24877262e+01/,glc(2,240)/-0.12894400e-01/
	data glc(3,240)/ 0.16567331e-01/,glc(4,240)/ 0.36347288e-03/
	data glc(5,240)/-0.15994850e-05/,glc(6,240)/ 0.11023685e-05/
	data kgnam(241)/'KZFSN7'/
	data glc(1,241)/ 0.27497306e+01/,glc(2,241)/-0.13708753e-01/
	data glc(3,241)/ 0.24819910e-01/,glc(4,241)/ 0.96006315e-03/
	data glc(5,241)/-0.33307832e-04/,glc(6,241)/ 0.58217650e-05/
	data kgnam(242)/'KZFS8 '/
	data glc(1,242)/ 0.28717595e+01/,glc(2,242)/-0.13501333e-01/
	data glc(3,242)/ 0.28964424e-01/,glc(4,242)/ 0.10970513e-02/
	data glc(5,242)/-0.24165632e-04/,glc(6,242)/ 0.56994640e-05/
	data kgnam(243)/'KZFSN9'/
	data glc(1,243)/ 0.25066403e+01/,glc(2,243)/-0.13178716e-01/
	data glc(3,243)/ 0.17087006e-01/,glc(4,243)/ 0.47129902e-03/
	data glc(5,243)/-0.11358998e-04/,glc(6,243)/ 0.16946777e-05/
	data kgnam(244)/'LGSK2 '/
	data glc(1,244)/ 0.24750760e+01/,glc(2,244)/-0.54304528e-02/
	data glc(3,244)/ 0.13893210e-01/,glc(4,244)/ 0.22990560e-03/
	data glc(5,244)/-0.16868474e-05/,glc(6,244)/ 0.43959703e-06/
C-----------------------------------------------------------------------
c       Note that these last were not originally part of the catalog
	data kgnam(245)/'CAFL  '/
	data glc(1,245)/ 0.20389378E+01/,glc(2,245)/-0.31666246E-02/
	data glc(3,245)/ 0.61695164E-02/,glc(4,245)/ 0.53092853E-04/
	data glc(5,245)/ 0.57625444E-06/,glc(6,245)/-0.41474028E-08/
	data kgnam(246)/'QUARTZ'/
	data glc(1,246)/ 0.21041717E+01/,glc(2,246)/-0.93310703E-02/
	data glc(3,246)/ 0.88008631E-02/,glc(4,246)/ 0.73331372E-04/
	data glc(5,246)/ 0.31904689E-05/,glc(6,246)/-0.67043545E-07/
	data kgnam(247)/'NACL '/
	data glc(1,247)/ 0.23300477e+01/,glc(2,247)/-0.94085558e-03/
	data glc(3,247)/ 0.18063105e-01/,glc(4,247)/ 0.35052613e-03/
	data glc(5,247)/ 0.26039432e-05/,glc(6,247)/ 0.35339426e-06/
C-----------------------------------------------------------------------
	return
	end
--------------- glasubs.F ------------------------
#include "include/port.h"
C==============================================================================
C==============================================================================
	real function glref(gtype,lambda)
c       A function which accepts as input the glass type and the wavelength,
c       and returns the index of refraction of that glass at that wavelength.
	IMPLICIT_NONE
#       include "include/stdio.par"
#       include "echelle.par"
C       External Variables
c                       index into the glass type table
	integer         gtype
c                       wavelength of interest [micrometers]
	real            lambda
C       Internal Variables
C       Common Blocks
	include 'glass.cmn'
C       Executable Code
c       consistency check
	if (gtype .gt. MAXGLASS .or. gtype .lt. MINGLASS) then
	    write(STDERR,*)
     &      ' glref:  Glass type is outside of allowed range', gtype
	    write(STDERR,*)
     &      ' glref:  Range is ', MINGLASS, '<= gtype <=', MAXGLASS
	    glref = -1.
	    return
	endif
c       this is the square of the index of refraction at wavelength lambda
	glref = glc(1,gtype) + glc(2,gtype) * lambda**2 +
     &  (glc(3,gtype) + (glc(4,gtype) + (glc(5,gtype) + glc(6,gtype)/
     &  lambda**2)/lambda**2)/lambda**2)/lambda**2
	glref = sqrt(glref)
	return
	end
C==============================================================================
C==============================================================================
	integer function gldref(gtype,lambda,refn,drefdl)
c       A function which accepts as input the glass type and the wavelength.
c       It returns the index of refraction of that glass at that wavelength,
c       and the derivative of index of refraction of that glass
c       with respect to wavelength evaluated at that wavelength.
c       The function returns 0 if no errors occurs.
	IMPLICIT_NONE
#       include "include/stdio.par"
#       include "echelle.par"
C       External Variables
c                       index into the glass type table
	integer         gtype
c                       wavelength of interest [micrometers]
	real            lambda
c                       index of refraction of the glass at the wavelength
	real            refn
c                       derivative of refn wrt lambda at the wavelength
c                       [micrometers**-1]
	real            drefdl
C       Internal Variables
c                       temporary variable for computing derivative [um**-1]
	real            top
C       Common Blocks
	include 'glass.cmn'
C       External Function
C       Executable Code
c       check for consistency
	if (gtype .gt. MAXGLASS .or. gtype .lt. MINGLASS) then
	    write(STDERR,*)
     &      ' gldref:  Glass type is outside of allowed range', gtype
	    write(STDERR,*)
     &      ' gldref:  Range is ', MINGLASS, '<= gtype <=', MAXGLASS
	    gldref = -1
	    return
	endif
	gldref = 0
c       this is the square of the index of refraction at wavelength lambda
	refn = glc(1,gtype) + glc(2,gtype) * lambda**2 +
     &  (glc(3,gtype) + (glc(4,gtype) + (glc(5,gtype) + glc(6,gtype)/
     &  lambda**2)/lambda**2)/lambda**2)/lambda**2
	refn = sqrt(refn)
c       units of top are [micrometers**-1]
	top = glc(2,gtype) * lambda - (glc(3,gtype) + (2.*glc(4,gtype) +
     &  (3.*glc(5,gtype) + 4.*glc(6,gtype)/lambda**2)
     &  /lambda**2)/lambda**2)/lambda**3
c       drefdl is the {derivative of {the index of refraction} w.r.t.
c       wavelength} evaluated at wavelength lambda [micrometers**-1]
	drefdl = top / refn
	return
	end
C==============================================================================
C==============================================================================
	subroutine getglas
c       load the index of refraction coefficients from the Schott data
c       Alas, all communication is done via the common blocks.
	IMPLICIT_NONE
C       Parameters
#       include "include/stdio.par"
#       include "echelle.par"
C       Internal Variables
	integer         i
C       Common Blocks
	include 'schott.cmn'
	include 'glass.cmn'
C       Executable Code
	if (iglass .gt. MAXGLASS .or. iglass .lt. MINGLASS)
     &  write(STDERR,*) ' WARNING: glass type outside range'
	typeg = kgnam(iglass)
	do 10 i = 0,5
	  a(i) = glc(i+1,iglass)
10      continue
	return
	end
C==============================================================================
C==============================================================================
	subroutine glassname(schott)
c       search thru the Schott data for a glass with a name matching schott.
c       Then, load up the refraction coefficients for that glass.
	IMPLICIT_NONE
C       Parameters
#       include "include/stdio.par"
#       include "echelle.par"
C       External Variable
	character*(*)   schott
C       Internal Variables
c                       loop
	integer         i
C       Common Blocks
	include 'glass.cmn'
	include 'schott.cmn'
C       Executable Code
c       default to UBK7
	iglass = 22
c       go hunt
	do 100 i=MINGLASS,MAXGLASS
	  if (schott .eq. kgnam(i)) then
	      iglass = i
	      goto 200
	  endif
100     continue
	write(STDERR,*) 'glassname:  could not match glass ', schott
	write(STDERR,*) 'used UBK7 instead.'
200     continue
	call getglas
	return
	end
C==============================================================================
C==============================================================================
--------------- menu.F ------------------------
/*
 *      If not for the history of this program (being that it was
 *      originally written in Fortran, and that a goal
 *      in its design was to use Lick Mongo to insure that it could
 *      operate on a wide variety of graphics devices) this would
 *      consist of macro-replicated C code.
 *
 *      As it is, it consists of macro-replicated Fortran code.
 *      It works, but it would be more transparent in C.
 */

#include "include/port.h"
#ifdef CURSOR
#   define INCFILE 'cdata.inc'
#   define DATFILE "cdata.dta"
#   define TITLE   cdata
#   define PF c
#   define MIN MINCDATA
#   define BOT botcdata
#   define MAX MAXCDATA
#   define NUL NULCDATA
#endif /* CURSOR */
#ifdef SPGRAF
#   define INCFILE 'spgraf.inc'
#   define DATFILE "spgraf.dta"
#   define TITLE   spgraf
#   define PF i       /* "i" is for "instrument", telescope/spect. combo */
#   define MIN MINIDATA
#   define BOT botidata
#   define MAX MAXIDATA
#   define NUL NULIDATA
#endif /* SPGRAF */
#ifdef SETUP
#   define INCFILE 'setup.inc'
#   define DATFILE "setup.dta"
#   define TITLE   setup
#   define PF s
#   define MIN MINSDATA
#   define BOT botsdata
#   define MAX MAXSDATA
#   define NUL NULSDATA
#endif /* SETUP */
#ifdef DETMOS
#   define INCFILE 'detmos.inc'
#   define DATFILE "detmos.dta"
#   define TITLE   detmos
#   define PF d
#   define MIN MINDDATA
#   define BOT botddata
#   define MAX MAXDDATA
#   define NUL NULDDATA
#endif /* DETMOS */
#ifdef BUTTON
#   define INCFILE 'button.inc'
#   define DATFILE "button.dta"
#   define TITLE   button
#   define PF b
#   define MIN MINBDATA
#   define BOT botbdata
#   define MAX MAXBDATA
#   define NUL NULBDATA
#endif /* DETMOS */
C==============================================================================
C==============================================================================
	subroutine ud TITLE
c       The screen displays some data regarding the portion of the
c       echelle format underneath the cursor.  This routine updates
c       all of the information that is expected to change as the cursor moves.
c       This code underwent a severe rewrite as a part of the final
c       polishing.  The final product for Keck does not want to see all the
c       labels on the screen which allow the user to modify the spectrograph.
c       In the original version, this was all done in the nightmare of code
c       in the file echpltxt.F.  It is debatable whether this new code is
c       any less of a nightmare, but at least it breaks up that horrid
c       label code into smaller chunks so that not all of it need be
c       displayed.
	IMPLICIT_NONE
C       Parameters
#       include "echelle.par"
#       include "include/stdio.par"
C       Internal Variables
c                       loop
	integer         i
c                       terseness
	integer         j
c                       I/O status
	integer         ios
C       External Function
	integer         PMGO(lenc)
C       Common Block
	include INCFILE
C       Data
#       include DATFILE
C       Executable Code
	if (.not. PF dataup) return
	do 200 i = MIN,BOT
	  j = PF datap(i)
c         write out the new label into the string for storage
	  if (j .eq. NUL) then
	      goto 199
	  elseif (PF dataf(j) .eq. NoValFmt) then
	      goto 199
	  elseif (index(PF dataf(j),'f') .ne. 0) then
c             presume real data
	      write(PF datav(SVNEW,j),PF dataf(j),iostat=ios)
     &        PF datar(j)
	  elseif (index(PF dataf(j),'i') .ne. 0) then
c             presume integer data
	      write(PF datav(SVNEW,j),PF dataf(j),iostat=ios)
     &        PF datai(j)
	  elseif (index(PF dataf(j),'a') .ne. 0) then
c             presume character data--already written into NEW string
	  else
	      write(STDERR,*) 'ud*:  unknown data format'
	      write(STDERR,*) 'ud*:  ', PF dataf(j),i,j
	  endif
c         erase the label string from last time
	  call PMGO(grelocate)(PF datax(Xp,j,2),PF datax(Yp,j,2))
	  call PMGO(setlvis)(1)
	  call PMGO(label)
     &    (PMGO(lenc)(PF datav(SVOLD,j)),PF datav(SVOLD,j))
c         draw the new label string on the screen
	  call PMGO(grelocate)(PF datax(Xp,j,2),PF datax(Yp,j,2))
	  call PMGO(setlvis)(0)
	  call PMGO(label)
     &    (PMGO(lenc)(PF datav(SVNEW,j)),PF datav(SVNEW,j))
c         copy new into old
	  PF datav(SVOLD,j) = PF datav(SVNEW,j)
199       continue
200     continue
	return
	end
C==============================================================================
C==============================================================================
	subroutine dn TITLE
c       This routine undisplays the cursor data menu.
	IMPLICIT_NONE
C       Parameters
#       include "echelle.par"
C       Internal Variables
c                       loop
	integer         i
c                       terseness
	integer         j
C       External Function
	integer         PMGO(lenc)
C       Common Block
	include INCFILE
C       Executable Code
	if (.not. PF dataup) return
	call PMGO(setlvis)(1)
	do 200 i = MIN,BOT
	  j = PF datap(i)
	  if (j .eq. NUL) goto 199
c         erase the label strings
	  call PMGO(grelocate)(PF datax(Xp,j,1),PF datax(Yp,j,1))
	  call PMGO(label)(PMGO(lenc)(PF datal(j)),PF datal(j))
c         erase the value strings
	  call PMGO(grelocate)(PF datax(Xp,j,2),PF datax(Yp,j,2))
	  call PMGO(label)
     &    (PMGO(lenc)(PF datav(SVOLD,j)),PF datav(SVOLD,j))
c         blank the old strings for next time
	  PF datav(SVOLD,j) = ' '
199       continue
200     continue
	call PMGO(setlvis)(0)
	PF dataup = .false.
	return
	end
C==============================================================================
C==============================================================================
	subroutine up TITLE
c       This routine redisplays the cursor data menu.
c       The positions of each label are always recalculated.
	IMPLICIT_NONE
C       Parameters
#       include "echelle.par"
C       Internal Variables
c                       loop
	integer         i
c                       terseness
	integer         j
c                       is there a Lick Mongo escape character in string?
	logical         mgoesc
C       External Function
	integer         PMGO(lenc)
C       Common Block
	include INCFILE
	include 'lims.cmn'
C       Executable Code
	if (.not. PF meninit) call ra TITLE(0)
	call PMGO(setlvis)(0)
	do 200 i = MIN,BOT
	  j = PF datap(i)
	  if (j .eq. NUL) goto 199
c         calculate where the label should be
	  PF datax(Xp,j,1) = pxmin + (pxmax - pxmin) * 0.03
	  PF datax(Yp,j,1) = pymin + (pymax - pymin) *
     &    ((((PF minndc - PF maxndc) /
     &    (BOT-MIN+1)) *
     &    (i-MIN+0.5)) + PF maxndc)
c         plot the label
	  call PMGO(grelocate)(PF datax(Xp,j,1),PF datax(Yp,j,1))
	  mgoesc = index(PF datal(j),char(92)//'gV') .ne. 0
	  if (mgoesc) call PMGO(setpsfmode)(1)
	  call PMGO(label)(PMGO(lenc)(PF datal(j)),PF datal(j))
	  if (mgoesc) call PMGO(setpsfmode)(2)
c         store the current location for plotting RHS of equations
	  call PMGO(getgxy)(PF datax(Xp,j,2),PF datax(Yp,j,2))
c         call PMGO(label)(PMGO(lenc)(PF datav(j)),PF datav(j))
199       continue
200     continue
	PF dataup = .true.
c       updating the data is always a part of putting up the menu
	call ud TITLE
	return
	end
C==============================================================================
C==============================================================================
	logical function wb TITLE(xw,yw,index)
c       This function determines whether the given position in world
c       coordinates is within the boundaries of one of the labels
c       being displayed in the menu.
c       If it is within a boundary, the index of that label is returned.
	IMPLICIT_NONE
C       Parameters
#       include "echelle.par"
C       External Variables
c                       x and y world coordinates
	real            xw, yw
c                       return value of closest index
c                       if the return value of the function is false,
c                       this is undefined
	integer         index
C       Internal Variables
c                       x and y normalized device coordinates
	real            xnd, ynd
C       Common Block
	include INCFILE
C       Executable Code
c       see if this menu is currently displayed
	wb TITLE = PF dataup
	if (.not. wb TITLE) then
	    return
	endif
c       convert to NDC
	call nc TITLE(xw, yw, xnd, ynd)
	wb TITLE = (ynd .ge. MIN) .and. (ynd .le. BOT+1)
c       if we are outside the Y menu limits, return
	if (.not. wb TITLE) then
	    return
	endif
c       compute which label is closest, and lookup its true id via pointer
	index = PF datap(nint(ynd - 0.5))
c       see if the X menu limits are resonable
	wb TITLE = (xnd .ge. PF datax(Xp,index,1)) .and.
     &             (xnd .le. PF datax(Xp,index,2))
c       and that is all, one way or the other
	return
	end
C==============================================================================
C=======================================================================
	subroutine nc TITLE(wx,wy, gx, gy)
c       given a Lick Mongo world coordinate, find the menu coordinate
	IMPLICIT_NONE
C       Parameters
#       include "echelle.par"
C       External Variables
c                       input world coordinates
	real            wx, wy
c                       output y menu coordinates
c                       output device x coordinate
	real            gx, gy
C       Internal Variables
c                       device coordinate limits in effect when invoked
	real            gx1, gx2, gy1, gy2
c                       world coordinate limits in effect when invoked
	real            wx1, wx2, wy1, wy2
C       Common Block
	include 'lims.cmn'
	include INCFILE
C       Executable Code
c       get the transformation
	call getloc(gx1,gy1,gx2,gy2)
	call getlim(wx1,wy1,wx2,wy2)
c       convert to device coordinates
	gx = gx1 + (gx2-gx1)*(wx-wx1)/(wx2-wx1)
	gy = gy1 + (gy2-gy1)*(wy-wy1)/(wy2-wy1)
c       convert to Normalized device coordinates
	gy = (gy - pymin) / (pymax - pymin)
c       convert to Y menu coordinates
	gy = ((gy - PF maxndc) * (BOT - MIN + 1) /
     &  ( PF minndc - PF maxndc)) + MIN
	return
	end
C=======================================================================
C==============================================================================
	logical function ac TITLE (ascii,index)
c       This routine determines whether the ASCII character in
c       iascii is one of the accelerator keys.
c       The function returns .true. if there is a match,
c       otherwise it returns .false.
	IMPLICIT_NONE
C       Parameters
#       include "echelle.par"
C       External Variables
c                       the ASCII value of some character
	character*(*)   ascii
c                       the index of the matching table entry, if any
c                       if no match, value is undefined
	integer         index
C       Internal Variables
c                       loop
	integer         i
C       Common Block
	include INCFILE
C       Executable Code
	ac TITLE = .false.
	if (ascii .eq. NoAc) return
	do 100 i = MIN,MAX
	  if (ascii .eq. PF dataa(i)) then
	      ac TITLE = .true.
	      index = i
	      return
	  endif
100     continue
	return
	end
C==============================================================================
C==============================================================================
	logical function tr TITLE (string,j)
c       This routine takes the character string in string and
c       reads a value out of it, stuffing it into the
c       real (datar), integer (datai), or character value (datav) arrays.
c       The format is obtained from the dataf array.
c       The function returns .true. if it is successful,
c       otherwise it returns .false.
c       Much of this code is effectively the inverse operation of ud TITLE
	IMPLICIT_NONE
C       Parameters
#       include "echelle.par"
#       include "include/stdio.par"
C       External Variables
c                       the string from which we will read a value
	character*(*)   string
c                       the index of the table entry which will have
c                       its value replaced
	integer         j
C       Internal Variables
c                       Fortran I/O status
	integer         ios
C       Common Block
	include INCFILE
C       Executable Code
c       read in the new label into the string for storage
	if (PF dataf(j) .eq. NoValFmt) then
c           do nothing
	elseif (index(PF dataf(j),'f') .ne. 0) then
c           presume real data
	    read(string,*,iostat=ios) PF datar(j)
	elseif (index(PF dataf(j),'i') .ne. 0) then
c           presume integer data
	    read(string,*,iostat=ios) PF datai(j)
	elseif (index(PF dataf(j),'a') .ne. 0) then
c           presume character data
	    PF datav(SVNEW,j) = string
	else
	    write(STDERR,*) 'tr*:  unknown data format'
	    write(STDERR,*) 'tr*:  ', PF dataf(j),j
	endif
	tr TITLE = (ios .eq. SUCCESS)
	return
	end
C==============================================================================
C==============================================================================
--------------- pdisp.F ------------------------
#include "include/port.h"
	program pdisp
c       calculate the dispersion of a prism as a function of the input angle
	IMPLICIT_NONE
#       include "echelle.par"
#       include "include/units.par"
C       Parameters
C       Internal Variables
c                       wavelength near which we want to look [micrometers]
	real            lambda
c                       vertex angle of the prism
	real            vertex
c                       trig. funcs. of vertex angle
	real            sa, ca
c                       incident angle theta
	real            thetin
c                       trig. func. of incident angle
	real            st
c                       index of refraction and its derivative
	real            refn, drefdl
c                       total angular deviation
	real            delta
c                       derivative of deviation wrt wavelength [radian/um]
	real            dddl
c                       index into glass type table
	integer         igt
c                       outgoing angle
	real            thetout
c                       temporary variables for calcs
	real            zeta
	real            xi
	integer         i
C       External Function
	integer         gldref
C       Executable Code
	write(STDERR,PROMPT)
     &  ' Give the vertex angle of the prism [degrees]:  '
	read(STDIN,*) vertex
	vertex = vertex * radPERdeg
	sa = sin(vertex)
	ca = cos(vertex)
	write(STDERR,PROMPT)
     &  ' Give the index number of the glass type:  '
	read(STDIN,*) igt
	write(STDERR,PROMPT)
     &  ' Give the wavelength of interest [um]:  '
	read(STDIN,*) lambda
	i = gldref(igt,lambda,refn,drefdl)
c       References given in the following code are to the book
c       Optics, E. Hecht & A. Zajac, Addison-Wesley, 1974
	do 10 i = 1,89
	  thetin = i * radPERdeg
	  st = sin(thetin)
c         see H&Z eqs. 5.52 and 5.53
	  zeta = sqrt(refn**2 - st**2)
	  xi = sa * zeta - st * ca
	  thetout = asin(xi)
	  delta = thetin - vertex + thetout
c         this results from differentiation of H&Z eq. 5.53
	  dddl = refn * sa * drefdl
	  dddl = dddl / (zeta * (1. - xi**2) )
c         convert back to degrees
	  delta = delta * degPERrad
	  thetout = thetout * degPERrad
	  write(STDOUT,*) i, thetout, delta, dddl
10      continue
	end
--------------- ratwindow.F ------------------------
#include "include/port.h"
C==============================================================================
C==============================================================================
	subroutine ratwindow()
c       Given the physical/electrical properties of the CCD and readout
c       electronics along with the physical readout window and binning
c       desired by the user calculate the value of the WINDOW cards as
c       needed by the Keck instrument control system.
c       This is a rather lengthy process which involves the many
c       definitions of quantities found in the ratwin common block.
	IMPLICIT_NONE
C       Parameters
#       include "include/stdio.par"
#       include "echelle.par"
C       Common Blocks
	include 'setup.inc'
	include 'detmos.inc'
	include 'ratwin.cmn'
C       Internal Variables
c                       we loop over the 2 dimensions of the CCD
	integer         i
c                       how many imaging pixels are there to be
c                       read thru each amplifier in this readout mode
	integer         npread
C       Data
	data    nfcando         /.true./
	data    nfrecord        /.true./
	data    okmixed         /.true./
	data    dpost           / 30, 30 /
	data    dpre            / 10, 10 /
	data    namp            /  2,  2 /
C       Executable Code
c       check to see if the serial readout characteristics prevent us
c       from being able to do what was requested
	do 9000 i=Xp,Yp
c         how many pixels to be read thru each amp?
	  if (namp(i) .eq. 1) then
	      npread = npix(0,i)
	  elseif (namp(i) .eq. 2) then
c             note that we assume here that the CCD design is
c             symmetrical and the number of pixels is even.
	      npread = npix(0,i) / 2
	  endif
c         find the fiducial pixel
	  if ((i .eq. Xp) .and. (.not. nfcando)) then
	      if (namp(i) .eq. 1) then
c                 we can satisfy binning requirements by choice of fidpix
		  fidpix(i) = mod(phprepix(0) , binning(0,i))
		  if (fidpix(i) .ne. 0)
     &            fidpix(i) = binning(0,i) - fidpix(i)
	      elseif (namp(i) .eq. 2) then
c                 see if we can satisfy the binning requirements
		  if ( mod( npread + phprepix(0), binning(0,i))
     &            .ne. 0 ) then
c                     we cannot satisfy binning requirements
c                     so we punt by resetting this binning to 1
		      binning(0,i) = 1
		      fidpix(i) = 0
		  else
c                     we got lucky and we can do this
		      fidpix(i) = mod(phprepix(0) , binning(0,i))
		      if (fidpix(i) .ne. 0)
     &                fidpix(i) = binning(0,i) - fidpix(i)
		  endif
	      endif
	  else /*  ( i .eq. Yp .or. nfcando ) */
c             we really do not care much where the fiducial pixel is
c             Note that here we simply proceed under the assumption that
c             we are doing a multiple amplifier readout, and also that the
c             CCD in question has an even number of imaging pixels in the
c             serial direction.  This code could be generalized to allow
c             for a different fiducial pixel in cases where we know that
c             we will be using only one amplifier.
c             Thus, npostmix = 0 and ipostmix = 0
c             by the above reasoning, the fiducial pixel is
	      fidpix(i) = npix(0,i) / 2
	  endif
c         find the fiducial offset
	  fidoff(i) = mod(fidpix(i),binning(0,i))
c         find the number of postscan mixed pixels
	  if ( mod(npread,binning(0,i)) .eq. fidoff(i) ) then
	      npostmix(i) = 0
	      ipostmix(i) = 0
	  else
	      npostmix(i) = 1
	      ipostmix(i) = mod(binning(0,i) + mod(npread,binning(0,i))
     &        - fidoff(i), binning(0,i))
	  endif
c         the number of pure postscan logical pixels is easy
	  npostlog(i) = (dpost(i) + binning(0,i) - 1)/binning(0,i)
	  if (i .eq. Xp) then
	      ndrop(i) = mod(fidoff(i) + phprepix(0), binning(0,i))
	      if (fidoff(i) .eq. 0) then
		  nprelog(i) = phprepix(0) / binning(0,i)
	      else
		  nprelog(i) =
     &            (fidoff(i) + phprepix(0) - binning(0,i))/binning(0,i)
		  nprelog(i) = max(nprelog(i),0)
	      endif
	  else /* (i .eq. Yp) */
	      ndrop(i) = 0
	      nprelog(i) = (dpre(i) + binning(0,i) - 1)/binning(0,i)
	  endif
c         prescan mixed pixels are also easy
	  if (fidoff(i) .eq. 0) then
	      npremix(i) = 0
	      ipremix(i) = 0
	  else
	      npremix(i) = 1
	      ipremix(i) = fidoff(i)
	  endif
c         find the total number of logical pure image pixels that will be read
c         This assumes we bother to read out the entire image area.
	  nimage(i) = npread - (ipremix(i) + ipostmix(i))
	  if (mod(nimage(i),binning(0,i)) .ne. 0)
     &    write(STDERR,*) 'impossible nimage value', i
	  nimage(i) = nimage(i) / binning(0,i)
c         find the boundaries of the beginning of the desired readout
c         region in physical pixels
	  if (fidoff(i) .le. window(i,1)) then
c             easy case where the readout window is entirely real pixels
	      pindow(i) = ((window(i,1)-fidoff(i))/binning(0,i)) *
     &        binning(0,i) + fidoff(i)
	  else
c             harder case where we have to worry about mixed pixels
	      if (okmixed) then
		  pindow(i) = fidoff(i) - binning(0,i)
c                 physical window cannot extend off the shift register
c                 in the serial direction if we cannot do non-full
		  if ((i .eq. Xp) .and. (.not. nfcando) .and.
     &            ((pindow(i)+phprepix(0)) .lt. 0) )
     &            pindow(i) = pindow(i) + binning(0,i)
	      else
		  pindow(i) = fidoff(i)
	      endif
	  endif
c         find the boundaries of the end of the desired readout
c         region in physical pixels
	  pindow(i+4) = ((window(i,1)+window(i+2,1)-1 -fidoff(i)) /
     &    binning(0,i)) * binning(0,i) + binning(0,i) - 1 +
     &    fidoff(i)
	  if (pindow(i+4) .ge. npix(0,i)) then
c             end of region extends past the imaging pixels
	      if (.not. okmixed) then
		  pindow(i+4) = pindow(i+4) - binning(0,i)
	      endif
	  endif
c         having the beginning and the end of the desired readout region
c         in physical pixels, calculate the size of the region
	  pindow(i+2) = pindow(i+4) - pindow(i) + 1
c         finally, now, calculate the values needed for KICS in the
c         WINDOW card.
c         The size of the logical window is easy
	  if (mod(pindow(i+2),binning(0,i)) .ne. 0)
     &    write(STDERR,*) 'impossible pindow size', i
	  kindow(i+2) = pindow(i+2) / binning(0,i)
c         **************************************************************
c         NOTE:  the current definition of the KICS WINDOW card is not
c         well equipped to handle the kinds of complexities envisioned
c         in the preceding code.  For that reason, it is not clear
c         just what exactly the WINDOW card should be for arbitrary
c         values of the desired readout window and BINNING.  Thus,
c         the following code may not generate correct results for
c         some cases where the current readout code is incapable of
c         doing the desired task.
c
c         The location of the start of the logical window requires
c         carefully adding up preceding pixels
	  if (i .eq. Yp) then
c             start with those pre imaging rows
	      kindow(i) = nprelog(i)
	      if (pindow(i) .ge. 0) then
c                 add in any mixed prescan/image rows and pure image rows
c                 which come before the desired readout region
		  kindow(i) = kindow(i) + npremix(i) +
     &            ( pindow(i) / binning(0,i) )
	      endif
	  else /* (i .eq. Xp) */
	      if ((pindow(i) + phprepix(0)) .ge. 0) then
		  kindow(i) =
     &            ( pindow(i) + phprepix(0) ) / binning(0,i)
		  if (nfcando .and. nfrecord .and.
     &            (ndrop(i) .gt. 0)) kindow(i) = kindow(i) + 1
	      else
		  kindow(i) = 0
	      endif
	  endif
c         **************************************************************
	  write(STDERR,*) dpre(i),dpost(i),namp(i)
	  write(STDERR,*) fidpix(i), fidoff(i)
	  write(STDERR,*) ndrop(i),nprelog(i),npremix(i),ipremix(i)
	  write(STDERR,*) nimage(i),npostmix(i),ipostmix(i),npostlog(i)
9000    continue
	write(STDERR,*) pindow
	write(STDERR,*) kindow
	return
	end
C==============================================================================
C==============================================================================
--------------- readdet.F ------------------------
#include "include/port.h"
C==============================================================================
C==============================================================================
	integer function readdet(detfile)
C       ---------------------
c       Open a file which presumably contains FITS-card-like lines
c       and read the configuration of a detector from that file.
C       ---------------------
	IMPLICIT_NONE
C       ---------------------
C       Parameters
#       include "include/stdio.par"
#       include "token/keyval.par"
#       include "echelle.par"
C       ---------------------
C       External Variables
c                       the almost-FITS file containing the detector info
c                       which we will try to open and try to read
	character*(*)   detfile
C       ---------------------
C       Internal Variables
c                       return status of keyval function
	integer         ts
c                       loop
	integer         i, j
c                       a place to read Conrad FITS string arrays
	character*132   string
c                       iostatus of an internal read
	integer         ios
c                       a place to keep a dynamically created FITS keyword
	character*9     fitskey
c                       a place to keep a dynamically created format string
	character*4     ifmt
#       ifdef RECENTER
c                       temporary position variable
	real            cp(Xo:Yo)
#       endif /* RECENTER */
c                       temporary badspot limits
	integer         badspt(Xo:dY)
C       ---------------------
C       External Function
	integer         figINT
	integer         figREAL
	integer         figQSTR
	integer         kvfile
	integer         kvgQSTR
	integer         kvgINT
	integer         kvgLOG
	integer         lenc
C       ---------------------
C       Common Block
	include 'detmos.inc'
C       ---------------------
C       Executable Code
	ifmt = '(i1)'
c       get the canonical file name
	string = detfile
c       open the file
	call kvverb(.true.)
	ts = kvfile(string)
	if (ts .ne. SUCCESS) return
	write(STDOUT,*) 'Reading detector file ',detfile(:lenc(detfile))
c       ----------------------------------------------------------------
c       there need not be any occurence of these cards
	call kvverb(.false.)
	ts =   kvgLOG( 'STDVIDV ='  ,1,0,stdvidv)
	if (ts .ne. SUCCESS) stdvidv = .true.
	ts =   kvgLOG( 'STDVIDH ='  ,1,0,stdvidh)
	if (ts .ne. SUCCESS) stdvidh = .true.
	ts =   kvgLOG( 'STDVIDR ='  ,1,0,stdvidr)
	if (ts .ne. SUCCESS) stdvidr = .true.
c       grab the results of this for each and every chip
	ts = figINT ('PHPRPX',nchips,phprepix(0))
c       ----------------------------------------------------------------
c       there should be only one occurrence of each of these cards
	call kvverb(.true.)
	call kvrew(.true.)
	ts =   kvgQSTR('DETECTOR='  ,1,0,detector)
	ts =   kvgINT( 'NCHIPS  ='  ,1,0,nchips)
c       ----------------------------------------------------------------
c       grab the results of these for each and every chip
	ts = figQSTR('CHIPID',nchips,chipid(0))
	ts = figINT ('XPIX'  ,nchips,npix(0,Xp))
	ts = figINT ('YPIX'  ,nchips,npix(0,Yp))
	ts = figREAL('PIXXSZ',nchips,pixsiz(0,Xp))
	ts = figREAL('PIXYSZ',nchips,pixsiz(0,Yp))
c       ----------------------------------------------------------------
c       we expect exactly one DETPOSn card for each of NCHIPS
	fitskey = 'DETPOS  ='
	do 2000 i=1,nchips
	  write(ifmt(3:3),'(i1)') int(log10(real(i))+1)
	  write(fitskey(7:8),ifmt) i
	  ts = kvgQSTR(fitskey      ,1,0,string)
	  if (ts .ne. KEYNOT) then
c             a DETPOS card may have 4 or 6 entries
c             first, try reading all 6 possible entries
	      read(string,*,iostat=ios) (detpos(j,i),j=Xp,RpY)
	      if (ios .ne. SUCCESS) then
c                 try reading only 4 entries
		  read(string,*,iostat=ios) (detpos(j,i),j=Xp,Orient)
c                 by default, the reference pixel location is (0.,0.)
		  detpos(RpX,i) = 0.
		  detpos(RpY,i) = 0.
	      endif
	      if (ios .ne. SUCCESS) then
		  write(STDERR,*) 'readdet:  bad format in a DETPOS card'
		  write(STDERR,*) 'string value was ', string
	      else
c                 check orientation value for conformity
		  if (abs(detpos(Orient,i)) .ne. 1.) then
		      write(STDERR,*) 'readdet:  Orient was not +/- 1'
		      write(STDERR,*) 'string value was ', string
		      write(STDERR,*) 'a standard video chip is assumed'
		      detpos(Orient,i) = 1.
		  endif
	      endif
	  endif
2000    continue
c       ----------------------------------------------------------------
c       There may be no BSPOTs on any of the chips in this mosaic
	call kvverb(.false.)
	ts =   kvgINT( 'NBSPOT  ='  ,1,0,nbspot)
	if (ts .ne. SUCCESS) nbspot = 0
	if (nbspot .gt. MAXBADSPOT) then
c           there are too many bad spots for us to remember
	    write(STDERR,*) 'readdet:  too many BSPOT cards'
	    write(STDERR,*) 'used only the first ', MAXBADSPOT
	    nbspot = MAXBADSPOT
	endif
	call kvverb(.true.)
	fitskey = 'BSPOT   ='
	do 3000 i=1,nbspot
	  write(ifmt(3:3),'(i1)') int(log10(real(i))+1)
	  write(fitskey(6:8),ifmt) i
	  ts = kvgQSTR(fitskey      ,1,0,string)
	  if (ts .eq. SUCCESS) then
c             we have another badspot card
	      read(string,*,iostat=ios) (bspot(j,i),j=cID,dY)
	      if (ios .ne. SUCCESS) then
		  write(STDERR,*) 'readdet:  bad format BSPOT card'
		  write(STDERR,*) 'string value was ', string
	      elseif (bspot(cID,i) .lt. 1
     &        .or.    bspot(cID,i) .gt. nchips) then
c                 warn about BSPOTs on chips that do not exist
		  write(STDERR,*)
     &            'readdet:  got BSPOT card for nonexistant chip ',
     &            bspot(cID,i)
	      endif
	  endif
3000    continue
c       ----------------------------------------------------------------
c       clip all badspots so that they do not extend beyond detector edges
	j = 1
	do 3500 i = 1,nbspot
c         clip all corners to limits of chip
	  badspt(Xp) = max(min(bspot(Xp,i), bspot(Xp,i)+bspot(dX,i)), 0)
	  badspt(dX) = min(max(bspot(Xp,i), bspot(Xp,i)+bspot(dX,i)),
     &    npix(bspot(cID, i),Xp))
	  badspt(Yp) = max(min(bspot(Yp,i), bspot(Yp,i)+bspot(dY,i)), 0)
	  badspt(dY) = min(max(bspot(Yp,i), bspot(Yp,i)+bspot(dY,i)),
     &    npix(bspot(cID, i),Yp))
c         find out new extent of the badspot
	  bspot(dX,j) = badspt(dX) - badspt(Xp)
	  bspot(dY,j) = badspt(dY) - badspt(Yp)
	  if (bspot(dX,j) .gt. 0 .and. bspot(dY,j) .gt. 0) then
	      bspot(Xp,j) = badspt(Xp)
	      bspot(Yp,j) = badspt(Yp)
	      j = j + 1
	  else
	      write(STDERR,*) 'readdet:  silly limits in BSPOT card'
	  endif
3500    continue
c       set nbspot to a possibly lower value
	nbspot = j - 1
c       ----------------------------------------------------------------
c       create the transformation matrices
	call mostran
#       ifdef RECENTER
c       if there was only one chip, translate its center to
c       the center of the detector mosaic.
	if (nchips .eq. 1) then
c           compute the middle pixel on the chip
	    cp(Xo) = npix(1,Xo) * 0.5
	    cp(Yo) = npix(1,Yo) * 0.5
c           translate middle of chip to mosaic coords (0,0)
	    detpos(Xp,1) = detpos(Xp,1) - (tmc(Xp,To,C2M,1) +
     &      tmc(Xp,Xo,C2M,1)*cp(Xo) + tmc(Xp,Yo,C2M,1)*cp(Yo))
	    detpos(Yp,1) = detpos(Yp,1) - (tmc(Yp,To,C2M,1) +
     &      tmc(Yp,Xo,C2M,1)*cp(Xo) + tmc(Yp,Yo,C2M,1)*cp(Yo))
c           recompute the transformation matrices
	    call mostran
	endif
#       endif /* RECENTER */
c       ----------------------------------------------------------------
c       close the file
	call kvverb(.false.)
	ts = kvfile(' ')
C       ---------------------
	return
	end
C==============================================================================
C==============================================================================
	subroutine mostran
C       ---------------------
c       Calculate the transformation matrix from chip coords to mosaic coords
c       and vice versa.  All chips are calculated together.
c       Alas, all communication is done thru the mosaic common block.
C       ---------------------
	IMPLICIT_NONE
C       ---------------------
C       Parameters
#       include "echelle.par"
#       include "include/units.par"
C       Internal Variables
c                       loop
	integer         i
c                       trig functions
	real            sinrot, cosrot
C       ---------------------
C       Common Block
	include 'detmos.inc'
C       ---------------------
C       Executable Code
c       All coordinates here are taken to be real-valued coordinates.
c       This routine therefore uses the convention that the edges of
c       pixels have integral values and the centers of pixels have
c       half-integral values.
c       To convert from one system to the other use these rules:
c       real_value    = integer_value + 0.5
c       integer_value = floor( real_value )
	do 1000 i=1,nchips
	  sinrot = detpos(Rot,i) * radPERdeg
	  cosrot = cos( sinrot )
	  sinrot = sin( sinrot )
c         --------------------------------------------------------------
c         calculate the transformation from Chip coords to Mosaic coords
	  tmc(Xp, Xo, C2M, i) =  cosrot * pixsiz(i, Xo)
	  tmc(Yp, Xo, C2M, i) =  sinrot * pixsiz(i, Xo)
	  tmc(Xp, Yo, C2M, i) =  sinrot * pixsiz(i, Yo) *
     &    detpos(Orient, i)
	  tmc(Yp, Yo, C2M, i) = -cosrot * pixsiz(i, Yo) *
     &    detpos(Orient, i)
	  tmc(Xp, To, C2M, i) = detpos(Xp, i) -
     &    (detpos(RpX, i) * tmc(Xp, Xo, C2M, i)) -
     &    (detpos(RpY, i) * tmc(Xp, Yo, C2M, i))
	  tmc(Yp, To, C2M, i) = detpos(Yp, i) -
     &    (detpos(RpX, i) * tmc(Yp, Xo, C2M, i)) -
     &    (detpos(RpY, i) * tmc(Yp, Yo, C2M, i))
c         --------------------------------------------------------------
c         calculate the transformation from Mosaic coords to Chip coords
	  tmc(Xp, To, M2C, i) = detpos(RpX,i)
     &    -(detpos(Xp,i)*cosrot+detpos(Yp,i)*sinrot)/pixsiz(i,Xp)
	  tmc(Yp, To, M2C, i) = detpos(RpY,i) + detpos(Orient, i) *
     &     (detpos(Yp,i)*cosrot-detpos(Xp,i)*sinrot)/pixsiz(i,Yp)
	  tmc(Xp, Xo, M2C, i) =  cosrot / pixsiz(i, Xp)
	  tmc(Yp, Xo, M2C, i) =  sinrot / pixsiz(i, Yp) *
     &    detpos(Orient, i)
	  tmc(Xp, Yo, M2C, i) =  sinrot / pixsiz(i, Xp)
	  tmc(Yp, Yo, M2C, i) = -cosrot / pixsiz(i, Yp) *
     &    detpos(Orient, i)
c         --------------------------------------------------------------
1000    continue
C       ---------------------
	return
	end
C==============================================================================
C==============================================================================
--------------- readmen.F ------------------------
#include "include/port.h"
C==============================================================================
C==============================================================================
	integer function readmen(ndir,dirs,fileroot,retstring)
C       ---------------------
c       A function which attempts to find a files called "*.tailend"
c       It searches for such files in the ndir directories dirs.
c       If it does find files, it writes the contents of the file to
c       the standard output along with index numbers.
c       It prompts the user to choose one of the options in the menu,
c       and returns the string which the user chose in retstring.
c       The function presumes that the files being viewed as a menu will
c       fit upon a single screen.
C       ---------------------
	IMPLICIT_NONE
C       ---------------------
C       Parameters
#       include "echelle.par"
#       include "include/stdio.par"
c                       max number of files we may match
	integer         MXMFIL
	parameter       (MXMFIL = 32)
C       ---------------------
C       External Variables
c                       number of different directories to search
	integer         ndir
c                       names of the directories
	character*(*)   dirs(ndir)
c                       the root name of the file to open and read
	character*(*)   fileroot
c                       the return value read from the chosen line of the file
	character*(*)   retstring
C       ---------------------
C       Internal Variables
c                       loop
	integer         i, k, l
c                       fortran I/O status
	integer         ios
c                       list of files which match fileroot
	character       files(MXMFIL)*(MXPATH)
c                       number of matches in each directory
	integer         nfil(0:MXMFIL)
c                       a character string entered by the user
	character*64    retstr
C       ---------------------
C       External Function
	integer         PMGO(lenc)
C       ---------------------
C       Executable Code
c       search the directories for matches
	nfil(0) = MXMFIL
	call findfiles(fileroot,ndir,dirs,nfil,files)
c       start the prompt
	write(STDERR,*) 'Choose one of the following by its number'
c       regurgitate the list of matches for the user
	l = 1
c       loop over all directories
	do 1000 i = 1,ndir
	  if (nfil(i) .gt. 0) write(STDERR,*) 'In dir ',dirs(i)(:65)
c         loop over all files in each directory
	  do 500 k = l,l+nfil(i)-1
	    write(STDERR,'(i3,1x,a)') k,files(k)(:60)
500       continue
	  l = l + nfil(i)
1000    continue
c       ask which one to use
2000    continue
	write(STDERR,PROMPT) 'Which one?  '
	call mx11gets(retstr)
	read(retstr,*,iostat=ios) readmen
	if (ios .ne. SUCCESS .or.
     &  readmen .lt. 1 .or. readmen .gt. nfil(0)) goto 2000
c       figure out which directory was associated with that file
	i = 1
	l = nfil(i)
3000    continue
	if (readmen .gt. l) then
	    i = i + 1
	    l = l + nfil(i)
	    goto 3000
	endif
	l = PMGO(lenc)(dirs(i))
c       stuff that line into the return string
	retstring = dirs(i)(:l)//'/'//files(readmen)
C       ---------------------
	return
	end
C==============================================================================
C==============================================================================
--------------- readset.F ------------------------
#include "include/port.h"
C==============================================================================
C==============================================================================
	integer function readset(setfile,numd,defdir)
C       ---------------------
c       Open a file which presumably contains FITS-card-like lines
c       and read the configuration of a spectrograph from that file.
C       ---------------------
	IMPLICIT_NONE
C       ---------------------
C       Parameters
#       include "include/stdio.par"
#       include "token/keyval.par"
#       include "echelle.par"
C       ---------------------
C       External Variables
c                       the almost-FITS file containing the detector info
c                       which we will try to open and try to read
	character*(*)   setfile
c                       number of directories to search
	integer         numd
c                       default directory to search
	character*(*)   defdir(numd)
C       ---------------------
C       Internal Variables
c                       return value
	integer         ts, ts1, ts2
c                       loop
	integer         i, j
c                       a place to keep a dynamically created FITS keyword
	character*9     fitskey(3)
c                       a place to keep a dynamically created format string
	character*4     ifmt
c                       a place to read Conrad FITS string arrays
	character*132   string
c                       iostatus of an internal read
	integer         ios
c                       temporary window limits
	integer         winlim(Xo:dY)
c                       take default action
	logical         default
C       ---------------------
C       External Function
	integer         kvfile
	integer         kvgQSTR
	integer         kvgINT
	integer         kvgREAL
	integer         kvgDBLE
	integer         readdet, readspc
	integer         lenc
C       ---------------------
C       Common Block
	include 'lam.cmn'
	include 'setup.inc'
	include 'detmos.inc'
C       ---------------------
C       Executable Code
c       get the canonical file name
	string = setfile
c       open the file
	call kvverb(.true.)
	ts = kvfile(string)
	if (ts .ne. SUCCESS) return
	call kvrew(.true.)
	call kvverb(.false.)
	write(STDOUT,*) 'Reading setup file ',setfile(:lenc(setfile))
c       ----------------------------------------------------------------
c       variables associated with the spectrograph hardware
c       there need not be any occurrance of these cards
c       if they do not exist, reasonable defaults will be used
c       ----------------------------------------------------------------
	ts1 =    kvgQSTR('DETFILNM=',1,0,detfilnm)
	ts2 =    kvgQSTR('SPCFILNM=',1,0,spcfilnm)
	if (ts1 .eq. SUCCESS) then
	    call canonfile(numd,defdir,detfilnm)
	    if (detfilnm .ne. ' ') i = readdet(detfilnm)
	endif
	if (ts2 .eq. SUCCESS) then
	    call canonfile(numd,defdir,spcfilnm)
	    if (spcfilnm .ne. ' ') i = readspc(spcfilnm)
	endif
c       if either of the above was read, we have to reopen the setup file
	if ((ts1 .eq. SUCCESS) .or. (ts2 .eq. SUCCESS))
     &  ts = kvfile(string)
c       ----------------------------------------------------------------
	ts =     kvgQSTR('SETUP   =',1,0,setup)
	ts =     kvgQSTR('OBSERVER=',1,0,observer)
	ts =     kvgREAL('ECHANGL =',1,0,ecangle)
	ts =     kvgREAL('XDANGL  =',1,0,xdangle)
c       the next one is for the Hamilton Echelle spectrograph
	ts =     kvgREAL('HAMHGT  =',1,0,hamhgt)
c       ----------------------------------------------------------------
	ts =     kvgINT('DECKRAW =' ,1,0,deckraw)
	ts =     kvgREAL('DECKPOS =',1,0,deckpos)
	ts =     kvgQSTR('DECKNAME=',1,0,decknnam)
c       ----------------
c       look for the decker height in meters, then arcsec, then pixels
c       these are ordered from least relevant to most relevant, i.e. the
c       last one is most canonical
	if (     kvgREAL('DECKPIX =',1,0,deckpix)  .eq. SUCCESS)
     &  deckmeth = i_DECKPIX
	if (     kvgREAL('DECKSIZE=',1,0,decksize) .eq. SUCCESS)
     &  deckmeth = i_DECKSIZE
	if (     kvgREAL('DECKHGT =',1,0,deckhgt)  .eq. SUCCESS)
     &  deckmeth = i_DECKHGT
c       ----------------
c       look for the precise description of all the holes in the decker
	ts =     kvgQSTR('DECKSPEC=',1,0,string)
	if (ts .eq. SUCCESS) then
c           add code do interpret the string
c           need to read ndeckap and deckspec(1:2*ndeckap)
	    read(string,*,iostat=ios) ndeckap
	    if (ios .eq. SUCCESS) then
		read(string,*,iostat=ios) ndeckap,
     &          (deckspec(i),i=1,2*ndeckap)
	    endif
	    if (ios .ne. SUCCESS) then
		write(STDERR,*) 'readset:  bad format in DECKSPEC card'
		write(STDERR,*) 'string value was ', string
	    endif
	endif
c       ----------------------------------------------------------------
c       look for the slit width in meters, arcsec, pixels, velocity, MEU
c       these are ordered from least relevant to most relevant, i.e. the
c       last one is most canonical
	if (     kvgREAL('SLITVEL =',1,0,slitvel)  .eq. SUCCESS)
     &  slitmeth = i_SLITVEL
	if (     kvgREAL('SLITPIX =',1,0,slitpix)  .eq. SUCCESS)
     &  slitmeth = i_SLITPIX
	if (     kvgREAL('SLITSIZE=',1,0,slitsize) .eq. SUCCESS)
     &  slitmeth = i_SLITSIZE
	if (     kvgINT ('SLITRAW =',1,0,slitraw)  .eq. SUCCESS)
     &  slitmeth = i_SLITRAW
	if (     kvgREAL('SLITWID =',1,0,slitwid)  .eq. SUCCESS)
     &  slitmeth = i_SLITWID
c       ----------------------------------------------------------------
	ts =     kvgINT('FIL1POS =' ,1,0,filter)
	ts =     kvgINT('FIL2POS =' ,1,0,filter2)
	ts =     kvgQSTR('FIL1NAME=',1,0,filname)
	ts =     kvgQSTR('FIL2NAME=',1,0,fil2name)
c       ----------------------------------------------------------------
	ts =     kvgQSTR('COLL    =',1,0,coll)
	ts =     kvgREAL('COFOCUS =',1,0,cofocus)
	ts =     kvgQSTR('CAMERA  =',1,0,camera)
	ts =     kvgREAL('CAFOCUS =',1,0,cafocus)
c       ----------------------------------------------------------------
c       variables associated with the detector mosaic
c       ----------------------------------------------------------------
	ifmt = '(i1)'
c       there need not be any occurrence of these cards
	ts =     kvgQSTR('BINNING =',1,0,string)
	if (ts .eq. SUCCESS) read(string,*,iostat=ts) xbin(0),ybin(0)
	if (ts .ne. SUCCESS) then
	    xbin(0) = 1
	    ybin(0) = 1
	endif
	ts =     kvgQSTR('DWINDOW =',1,0,string)
	if (ts .eq. SUCCESS) read(string,*,iostat=ios)
     &  (window(j,0),j=Xo,dY)
	if (ts .ne. SUCCESS) then
	    window(Xo,0) = 0
	    window(Yo,0) = 0
	    window(dX,0) = npix(0,Xo)
	    window(dY,0) = npix(0,Yo)
	endif
	do 1000 i=1,MAXDETMOS
c         set defaults
	  xbin(i) = xbin(0)
	  ybin(i) = ybin(0)
	  window(Xo,i) = 0
	  window(Yo,i) = 0
	  window(dX,i) = npix(i,Xo)
	  window(dY,i) = npix(i,Yo)
1000    continue
	fitskey(1) = 'BINNING ='
	fitskey(2) = 'DWINDOW ='
	do 2000 i=1,MAXDETMOS
c         create the format which will be used for writing keyword to read
	  write(ifmt(3:3),'(i1)') int(log10(real(i))+1)
c         get BINNINGn for this chip
	  write(fitskey(1)(8:8),ifmt) i
	  ts =   kvgQSTR(fitskey(1) ,1,0,string)
	  if (ts .eq. SUCCESS) read(string,*,iostat=ts) xbin(i),ybin(i)
	  if (ts .ne. SUCCESS) then
	      xbin(i) = xbin(0)
	      ybin(i) = ybin(0)
	  endif
c         get WINDOWn for this chip
	  write(fitskey(2)(7:8),ifmt) i
	  ts2 =  kvgQSTR(fitskey(3) ,1,0,string)
	  default = ts2 .ne. SUCCESS
	  if (.not. default) then
	      read(string,*,iostat=ios) (window(j,i),j=Xo,dY)
	      default = ios .ne. SUCCESS
	      if (default) then
		  write(STDERR,*) 'readset:  bad format DWINDOW card'
		  write(STDERR,*) 'string value was ', string
	      endif
	  endif
	  if (default) then
	      window(Xo,i) = 0
	      window(Yo,i) = 0
	      window(dX,i) = npix(i,Xo)
	      window(dY,i) = npix(i,Yo)
	  else
c             clip all corners to limits of chip
	      winlim(Xo) = max(min(window(Xp,i),
     &        window(Xp,i)+window(dX,i)), 0)
	      winlim(dX) = min(max(window(Xp,i),
     &        window(Xp,i)+window(dX,i)), npix(i,Xp))
	      winlim(Yp) = max(min(window(Yp,i),
     &        window(Yp,i)+window(dY,i)), 0)
	      winlim(dY) = min(max(window(Yp,i),
     &        window(Yp,i)+window(dY,i)), npix(i,Yp))
c             find out new extent of the window limits
	      window(dX,i) = (winlim(dX)-winlim(Xp))
	      window(dY,i) = (winlim(dY)-winlim(Yp))
	      window(Xp,i) = (winlim(Xp)           )
	      window(Yp,i) = (winlim(Yp)           )
c             if (window(dX,i) .le. 0 .or. window(dY,i) .le. 0)
c    &        write(STDERR,*) 'readset:  silly limits in DWINDOW card'
	  endif
c         if we miss a chip entirely, assume there are no more
	  if (.not. ((ts  .eq. SUCCESS)
     &    .or.       (ts2 .eq. SUCCESS))) goto 2001
2000    continue
2001    continue
c       ----------------------------------------------------------------
c       variables used only in the instrument simulator
c       ----------------------------------------------------------------
c       there need not be any occurrance of these cards
	ts =     kvgQSTR('WAVEFILE=',1,0,wavefile)
	ts =     kvgDBLE('RADVEL  =',1,0,redshift)
	if (ts .ne. SUCCESS) then
c           try looking for RADVELZ
	    ts = kvgDBLE('RADVELZ =',1,0,redshift)
	    if (ts .ne. SUCCESS) redshift = 0.
	    radvel = cLIGHT *
     &      (((1+redshift)**2 - 1) / ((1+redshift)**2 + 1))
	else
c           we did get the velocity
	    radvel = redshift
c           convert velocity to redshift
c           this ignores the transverse redshift of special relativity
	    redshift = redshift / cLIGHT
	    redshift = sqrt((1 + redshift) / (1 - redshift)) - 1
	endif
	radvelz = redshift
c       ----------------------------------------------------------------
c       there should be one occurrance of each of these cards
	call kvverb(.true.)
	ts =     kvgREAL('WAVLMAX =',1,0,wl)
	ts =     kvgREAL('WAVLMIN =',1,0,ws)
	ts =     kvgINT ('XDORDER =',1,0,mc)
c       ----------------------------------------------------------------
c       close the file
	call kvverb(.false.)
	ts = kvfile(' ')
C       ---------------------
	return
	end
C==============================================================================
C==============================================================================
--------------- readspc.F ------------------------
#include "include/port.h"
C==============================================================================
C==============================================================================
	integer function readspc(spcfile)
C       ---------------------
c       Open a file which presumably contains FITS-card-like lines
c       and read the configuration of a spectrograph from that file.
C       ---------------------
	IMPLICIT_NONE
C       ---------------------
C       Parameters
#       include "include/stdio.par"
#       include "token/keyval.par"
#       include "echelle.par"
#       include "include/units.par"
C       ---------------------
C       External Variables
c                       the almost-FITS file containing the detector info
c                       which we will try to open and try to read
	character*(*)   spcfile
C       ---------------------
C       Internal Variables
c                       return status of token function
	integer         tks(0:MAXPRISM)
c                       other names for the above array for convenience
	integer         ts, ts1
	equivalence     (tks(0), ts)
	equivalence     (tks(1), ts1)
c                       loop
	integer         i
c                       a place to keep the mean of the prism info
	real            dum
c                       a place to keep a dynamically created FITS keyword
c       character*9     fitskey
c                       a place to read Conrad FITS string arrays
	character*132   string
C       ---------------------
C       External Function
	integer         figREAL
	integer         figQSTR
	integer         kvfile
	integer         kvgQSTR
	integer         kvgREAL
	integer         kvgINT
	integer         kvgLOG
	integer         lenc
C       ---------------------
C       Common Block
	include 'spgraf.inc'
C       ---------------------
C       Executable Code
c       get the canonical file name
	string = spcfile
c       open the file
	call kvverb(.true.)
	ts = kvfile(string)
	if (ts .ne. SUCCESS) return
	write(STDOUT,*) 'Reading spectrograph file ',
     &  spcfile(:lenc(spcfile))
c       ----------------------------------------------------------------
c       there should be only one occurrance of each of these cards
	call kvrew(.true.)
	ts =     kvgQSTR('TELESCOP=',1,0,telescop)
	ts =     kvgQSTR('INSTRUME=',1,0,instrume)
	ts =     kvgREAL('PRIMDIAM=',1,0,primdiam)
	ts =     kvgREAL('FOCSCALE=',1,0,focscale)
	ts =     kvgREAL('COLFOCLN=',1,0,colfocln)
	collmeth = i_COLFOCLN
	ts =     kvgREAL('CAMFOCLN=',1,0,camfocln)
	ts =     kvgREAL('ECTHETAD=',1,0,ecthetad)
	ectheta = ecthetad * radPERdeg
	ts =     kvgREAL('ECDELTAD=',1,0,ecdeltad)
	ecdelta = ecdeltad * radPERdeg
	ts =     kvgINT ('NXDGRAT =',1,0,nxdgrat)
	ts =     kvgINT ('NXDPRISM=',1,0,nxdprism)
c       ----------------------------------------------------------------
c       these cards are paired, either one may be set
	call kvverb(.false.)
	ts =     kvgREAL('ECSIGMA =',1,0,ecsigma)
	ts1=     kvgREAL('ECSIGMAI=',1,0,ecsigmai)
	call kvverb(.true.)
	if (ts1 .eq. SUCCESS) then
c           we give priority to the existence of ecsigmai
	    ecsigma = umPERmm / ecsigmai
	elseif (ts .eq. SUCCESS) then
	    ecsigmai = umPERmm / ecsigma
	else
	    write(STDERR,*)
     &      'readspc:  Echelle groove spacing was not given.'
	endif
c       ----------------------------------------------------------------
	ts =     kvgQSTR('XDISPERS=',1,0,xdispers)
c       ----------------------------------------------------------------
	if (nxdgrat .gt. MAXGRATX) then
	    write(STDERR,*)
     &      'readspc:  Too many cross gratings, MAXGRATX is ', MAXGRATX
	elseif (nxdgrat .gt. 0) then
	    ts = kvgREAL('XDDELTAD=',1,0,xddeltad)
	    ts = kvgREAL('XDALFBET=',1,0,xdalfbet)
c           these cards are paired, either one may be set
	    call kvverb(.false.)
	    ts = kvgREAL('XDSIGMA =',1,0,xdsigma)
	    ts1= kvgREAL('XDSIGMAI=',1,0,xdsigmai)
	    call kvverb(.true.)
	    if (ts1 .eq. SUCCESS) then
c               we give priority to the existence of xdsigmai
		xdsigma = umPERmm / xdsigmai
	    elseif (ts .eq. SUCCESS) then
		xdsigmai = umPERmm / xdsigma
	    else
		write(STDERR,*)
     &          'readspc:  Cross disperser spacing was not given.'
	    endif
	endif
c       ----------------------------------------------------------------
	if (nxdprism .gt. MAXPRISM) then
	    write(STDERR,*)
     &      'readspc:  Too many prisms, MAXPRISM is ', MAXPRISM
	elseif (nxdprism .gt. 0) then
	    ts = kvgREAL('PRANGIND=',1,0,prangind)
c           --------
c           get the apex angles of the prisms
	    ts = figREAL('PRAPEX',nxdprism,prapexd(0))
	    dum = 0.
	    do 1000 i=1,nxdprism
	      dum = dum + prapexd(i)
1000        continue
	    if (nxdprism .gt. 1) prapexd(0) = dum/nxdprism
c           --------
c           get the angle between adjacent faces of adjacent prisms
	    ts = figREAL('PRFACE',nxdprism-1,prface(1))
	    dum = 0.
	    do 2000 i=2,nxdprism
	      dum = dum + prface(i)
2000        continue
	    if (nxdprism .gt. 2) prface(1) = dum/(nxdprism-1)
c           --------
c           get the type of glass used in each prism
	    ts = figQSTR('PRGLAS',nxdprism,prglas(0))
	endif
c       ----------------------------------------------------------------
	ts =     kvgLOG ('STDECHFH=',1,0,stdechfh)
	ts =     kvgREAL('FPROTANG=',1,0,fprotang)
c       ----------------------------------------------------------------
c       close the file
	call kvverb(.false.)
	ts = kvfile(' ')
C       ---------------------
	return
	end
C==============================================================================
C==============================================================================
	subroutine echtran
C       ---------------------
c       Calculate the transform matrix from echelle coords to display coords
c       and vice versa.
c       Alas, all communication is done thru the spgraf common block.
c       --------
c       NOTE CAREFULLY:
c       Display coords and echelle coords are defined
c       by viewers on the same sides of the focal plane.  Their
c       +x and +y coordinate directions may be coincident, depending on the
c       value of the angle FPROTANG.  Thus, their handednesses will be the
c       same.
c       --------
c       In the case where STDVIDV=F, the +y coordinate directions of the
c       2 systems will be opposite, and the handedness of the two systems
c       will be the same.
c       --------
c       In the case where STDVIDH=F, the +x coordinate directions of the
c       2 systems will be opposite, and the handedness of the two systems
c       will be the same.
c       --------
c       In the case where STDVIDR=F, there will be a 90degree rotation
c       between the two coordinate systems, and their handednesses
c       will be opposite because they are still defined from opposite
c       sides of the focal plane.
c       --------
c       In the case where more than one of the standard video flags is
c       false, further flips and rotations will be in effect.
C       ---------------------
	IMPLICIT_NONE
C       ---------------------
C       Parameters
#       include "echelle.par"
#       include "include/units.par"
C       Internal Variables
c                       trig functions
	real            sinrot, cosrot
C       ---------------------
C       Common Block
	include 'setup.inc'
	include 'spgraf.inc'
C       ---------------------
C       Executable Code
	sinrot = fprotang * radPERdeg
	cosrot = cos( sinrot )
	sinrot = sin( sinrot )
c       --------------------------------------------------------------
c       Note that both the Echelle coords and the Display coords are
c       measured in millimeters.  Also note that their origins are
c       defined such that they coincide.
c       --------------------------------------------------------------
c       calculate the transformation from Echelle coords to Display coords
	tde(Xp, To, E2D) = 0.
	tde(Yp, To, E2D) = 0.
	tde(Xp, Xo, E2D) =  cosrot
	tde(Yp, Xo, E2D) =  sinrot
	tde(Xp, Yo, E2D) = -sinrot
	tde(Yp, Yo, E2D) =  cosrot
c       --------------------------------------------------------------
c       calculate the transformation from Display coords to Echelle coords
c       This is used in the following fashion
c       ex = tde(Xp,Xo,D2E) * dx + tde(Xp,Yo,D2E) * dy + tde(Xp,To,D2E)
c       ey = tde(Yp,Xo,M2E) * dx + tde(Yp,Yo,D2E) * dy + tde(Yp,To,D2E)
	tde(Xp, To, D2E) = 0.
	tde(Yp, To, D2E) = 0.
	tde(Xp, Xo, D2E) =  cosrot
	tde(Yp, Xo, D2E) = -sinrot
	tde(Xp, Yo, D2E) =  sinrot
	tde(Yp, Yo, D2E) =  cosrot
c       --------------------------------------------------------------
	if (.not. stdechfh) then
c           flip y coordinates of Echelle coords
	    tde(Xp, Yo, E2D) = -tde(Xp, Yo, E2D)
	    tde(Yp, Yo, E2D) = -tde(Yp, Yo, E2D)
	    tde(Yp, Xo, D2E) = -tde(Yp, Xo, D2E)
	    tde(Yp, Yo, D2E) = -tde(Yp, Yo, D2E)
	endif
C       ---------------------
	return
	end
C==============================================================================
C==============================================================================
	subroutine translate(xba, yba, tmat, num)
C       ---------------------
c       apply a general 2-d linear transformation matrix to some coordinates
C       ---------------------
	IMPLICIT_NONE
C       ---------------------
C       Parameters
#       include "echelle.par"
C       ---------------------
C       External Variables
c                       how many are there?
	integer         num
c                       input and output value of x coordinate
	real            xba(1:num)
c                       input and output value of y coordinate
	real            yba(1:num)
c                       transformation matrix
	real            tmat(Xp:Yp, Xo:To)
C       ---------------------
C       Internal Variables
c                       values after the transformation
	real            xaft, yaft
c                       loop
	integer         i
C       ---------------------
C       Executable Code
	do 100 i=1,num
	  xaft = tmat(Xp,Xo)*xba(i) + tmat(Xp,Yo)*yba(i) + tmat(Xp,To)
	  yaft = tmat(Yp,Xo)*xba(i) + tmat(Yp,Yo)*yba(i) + tmat(Yp,To)
	  xba(i) = xaft
	  yba(i) = yaft
100     continue
C       ---------------------
	return
	end
C==============================================================================
C==============================================================================
	subroutine distran
C       ---------------------
c       Calculate the transform matrix from mosaic coords to display coords
c       and vice versa.
c       This calculation is made repeatedly every time the user "drags" the
c       detector around the picture of the echelle format.
c       Alas, all communication is done thru the spgraf common block.
c       --------
c       NOTE CAREFULLY:  In the case where STDVIDV=T, STDVIDH=T, and
c       STDVIDR=T, Display coords and mosaic coords are defined
c       by viewers on opposite sides of the focal plane.  Their
c       +x and +y coordinate directions will be coincident, but because they
c       are viewed from opposite sides, that will make their handednesses
c       opposite.
c       --------
c       In the case where STDVIDV=F, the +y coordinate directions of the
c       2 systems will be opposite, and the handedness of the two systems
c       will be the same.
c       --------
c       In the case where STDVIDH=F, the +x coordinate directions of the
c       2 systems will be opposite, and the handedness of the two systems
c       will be the same.
c       --------
c       In the case where STDVIDR=F, there will be a 90degree rotation
c       between the two coordinate systems, and their handednesses
c       will be opposite because they are still defined from opposite
c       sides of the focal plane.
c       --------
c       In the case where more than one of the standard video flags is
c       false, further flips and rotations will be in effect.
C       ---------------------
	IMPLICIT_NONE
C       ---------------------
C       Parameters
#       include "echelle.par"
#       include "include/units.par"
C       ---------------------
C       Internal Variables
c                       trig functions
	real            sinrot, cosrot
C       ---------------------
C       Common Block
	include 'setup.inc'
	include 'spgraf.inc'
C       ---------------------
C       Executable Code
	sinrot = 0
	cosrot = cos( sinrot )
	sinrot = sin( sinrot )
c       --------------------------------------------------------------
c       Note that posmos is expressed in Display coordinates
c       Note also that we only ever use the position numbered "0".
c       --------------------------------------------------------------
c       calculate the transformation from Display coords to Mosaic coords
	tmd(Xp, To, D2M) = -(posmos(Xp,0)*cosrot + posmos(Yp,0)*sinrot)
	tmd(Yp, To, D2M) =   posmos(Xp,0)*sinrot - posmos(Yp,0)*cosrot
	tmd(Xp, Xo, D2M) =  cosrot
	tmd(Yp, Xo, D2M) = -sinrot
	tmd(Xp, Yo, D2M) =  sinrot
	tmd(Yp, Yo, D2M) =  cosrot
c       --------------------------------------------------------------
c       calculate the transformation from Mosaic coords to Display coords
c       This is used in the following fashion
c       dx = (tmd(Xp,Xo,M2D) * mx + tmd(Xp,Yo,M2D) * my) * mmPERm +
c    &  posmos(Xp,imos)
c       dy = (tmd(Yp,Xo,M2D) * mx + tmd(Yp,Yo,M2D) * my) * mmPERm +
c    &  posmos(Yp,imos)
	tmd(Xp, To, M2D) = posmos(Xp,0)
	tmd(Yp, To, M2D) = posmos(Yp,0)
	tmd(Xp, Xo, M2D) =  cosrot
	tmd(Yp, Xo, M2D) =  sinrot
	tmd(Xp, Yo, M2D) = -sinrot
	tmd(Yp, Yo, M2D) =  cosrot
C       ---------------------
	return
	end
C==============================================================================
C==============================================================================
--------------- setup.F ------------------------
#include "include/port.h"
C=======================================================================
C=======================================================================
	subroutine rasetup(itype)
c       rearrange the nature of the cdata menu
c       this can include changing the position where it is displayed
c       this can include changing the contents which are (not) displayed
	IMPLICIT_NONE
C       Parameters
#       include "echelle.par"
C       External Variable
c                       type of rearrangement of the menu
	integer         itype
C       Internal Variable
	integer         i
C       Common Block
	include 'setup.inc'
	include 'spgraf.inc'
C       Executable Code
c       always put the menu down before rearranging
	if (sdataup) call dnsetup
c       determine which rearrangement of the menu to use
	smaxndc = 0.75
	if (itype .eq. 1) then
c           reset the Y limits of the menu
	    sminndc = 0.05
	    i = MINSDATA
c           display almost the entire array
	    sdatap(i) = i_SETUPNM
	    i = i + 1
	    sdatap(i) = i_OBSERVER
	    i = i + 1
	    sdatap(i) = i_ECANGLE
	    i = i + 1
	    sdatap(i) = i_XDANGLE
	    if (instrume(1:8) .eq. 'Hamilton') then
		i = i + 1
		sdatap(i) = i_HAMHGT
	    endif
c           i = i + 1
c           sdatap(i) = i_ECANGRAW
c           i = i + 1
c           sdatap(i) = i_DECKER
c           i = i + 1
c           sdatap(i) = i_DECKRAW
c           i = i + 1
c           sdatap(i) = i_DECKPOS
	    i = i + 1
	    sdatap(i) = i_DECKNNAM
	    i = i + 1
	    sdatap(i) = i_DECKHGT
	    i = i + 1
	    sdatap(i) = i_DECKSIZE
	    i = i + 1
	    sdatap(i) = i_DECKPIX
c           i = i + 1
c           sdatap(i) = i_DECKSPEC
	    i = i + 1
	    sdatap(i) = i_SLITWID
	    i = i + 1
	    sdatap(i) = i_SLITSIZE
	    i = i + 1
	    sdatap(i) = i_SLITPIX
	    i = i + 1
	    sdatap(i) = i_SLITVEL
c           i = i + 1
c           sdatap(i) = i_SLITRAW
c           i = i + 1
c           sdatap(i) = i_FILTER
c           i = i + 1
c           sdatap(i) = i_FILTER2
	    i = i + 1
	    sdatap(i) = i_FILNAME
	    i = i + 1
	    sdatap(i) = i_FIL2NAME
	    i = i + 1
	    sdatap(i) = i_COLL
	    i = i + 1
	    sdatap(i) = i_COFOCUS
	    i = i + 1
	    sdatap(i) = i_CAMERA
	    i = i + 1
	    sdatap(i) = i_CAFOCUS
	    i = i + 1
	    sdatap(i) = i_XDORDER
	    i = i + 1
	    sdatap(i) = i_XDALPHAD
	    i = i + 1
	    sdatap(i) = i_XDBETAD
	    i = i + 1
	    sdatap(i) = i_XBIN
	    i = i + 1
	    sdatap(i) = i_YBIN
	    i = i + 1
	    sdatap(i) = i_RADVEL
	    i = i + 1
	    sdatap(i) = i_RADVELZ
	    i = i + 1
	    sdatap(i) = i_WAVLMAX
	    i = i + 1
	    sdatap(i) = i_WAVLMIN
	    i = i + 1
	    sdatap(i) = i_DETFILNM
	    i = i + 1
	    sdatap(i) = i_SPCFILNM
	    i = i + 1
	    sdatap(i) = i_WAVFILNM
	    botsdata = i
	else
c           reset the Y limits of the menu
	    sminndc = 0.43
	    i = MINSDATA
c           display only the interesting changing stuff
	    sdatap(i) = i_SETUPNM
	    i = i + 1
	    sdatap(i) = i_OBSERVER
	    i = i + 1
	    sdatap(i) = i_ECANGLE
	    i = i + 1
	    sdatap(i) = i_XDANGLE
	    if (instrume(1:8) .eq. 'Hamilton') then
		i = i + 1
		sdatap(i) = i_HAMHGT
	    endif
	    i = i + 1
	    sdatap(i) = i_DECKHGT
	    i = i + 1
	    sdatap(i) = i_DECKSIZE
	    i = i + 1
	    sdatap(i) = i_DECKPIX
	    i = i + 1
	    sdatap(i) = i_SLITWID
	    i = i + 1
	    sdatap(i) = i_SLITSIZE
	    i = i + 1
	    sdatap(i) = i_SLITPIX
	    i = i + 1
	    sdatap(i) = i_SLITVEL
	    i = i + 1
	    sdatap(i) = i_XDORDER
	    i = i + 1
	    sdatap(i) = i_XDALPHAD
	    i = i + 1
	    sdatap(i) = i_XBIN
	    i = i + 1
	    sdatap(i) = i_YBIN
	    botsdata = i
	endif
	smeninit = .true.
	return
	end
C=======================================================================
C=======================================================================
--------------- spgraf.F ------------------------
#include "include/port.h"
C=======================================================================
C=======================================================================
	subroutine raspgraf(itype)
c       rearrange the nature of the cdata menu
c       this can include changing the position where it is displayed
c       this can include changing the contents which are (not) displayed
	IMPLICIT_NONE
C       Parameters
#       include "echelle.par"
C       External Variable
c                       type of rearrangement of the menu
	integer         itype
C       Common Block
	include 'spgraf.inc'
C       Executable Code
c       always put the menu down before rearranging
	if (idataup) call dnspgraf
c       determine which rearrangement of the menu to use
	if (nxdgrat .gt. 0 .and. nxdprism .gt. 0) then
c           reset the Y limits of the menu
	    iminndc = 0.05
	    imaxndc = 0.80
c           display all of everything
	    idatap(MINIDATA +  0) = i_TELESCOP
	    idatap(MINIDATA +  1) = i_INSTRUME
	    idatap(MINIDATA +  2) = i_PRIMDIAM
	    idatap(MINIDATA +  3) = i_COLLDIAM
	    idatap(MINIDATA +  4) = i_CAMFOCLN
	    idatap(MINIDATA +  5) = i_ECSIGMAI
	    idatap(MINIDATA +  6) = i_ECTHETAD
	    idatap(MINIDATA +  7) = i_ECDELTAD
	    idatap(MINIDATA +  8) = i_FOCSCALE
	    idatap(MINIDATA +  9) = i_COLFOCLN
	    idatap(MINIDATA + 10) = i_XDISPERS
	    idatap(MINIDATA + 11) = i_NXDGRAT
	    idatap(MINIDATA + 12) = i_XDSIGMAI
	    idatap(MINIDATA + 13) = i_XDDELTAD
	    idatap(MINIDATA + 14) = i_XDALFBET
	    idatap(MINIDATA + 15) = i_FPROTANG
	    idatap(MINIDATA + 16) = i_NXDPRISM
	    idatap(MINIDATA + 17) = i_PRANGIND
	    idatap(MINIDATA + 18) = i_PRAPEXD
	    idatap(MINIDATA + 19) = i_PRAPEX1
	    idatap(MINIDATA + 20) = i_PRAPEX2
	    idatap(MINIDATA + 21) = i_PRAPEX3
	    idatap(MINIDATA + 22) = i_PRFACE
	    idatap(MINIDATA + 23) = i_PRFACE2
	    idatap(MINIDATA + 24) = i_PRFACE3
	    idatap(MINIDATA + 25) = i_PRGLAS
	    idatap(MINIDATA + 26) = i_PRGLAS1
	    idatap(MINIDATA + 27) = i_PRGLAS2
	    idatap(MINIDATA + 28) = i_PRGLAS3
	    idatap(MINIDATA + 29) = i_wizard
	    botidata = MINIDATA + 29
	else if (nxdgrat .gt. 0) then
c           reset the Y limits of the menu
	    iminndc = 0.05
	    imaxndc = 0.80
c           display all of everything
	    idatap(MINIDATA +  0) = i_TELESCOP
	    idatap(MINIDATA +  1) = i_INSTRUME
	    idatap(MINIDATA +  2) = i_PRIMDIAM
	    idatap(MINIDATA +  3) = i_COLLDIAM
	    idatap(MINIDATA +  4) = i_CAMFOCLN
	    idatap(MINIDATA +  5) = i_ECSIGMAI
	    idatap(MINIDATA +  6) = i_ECTHETAD
	    idatap(MINIDATA +  7) = i_ECDELTAD
	    idatap(MINIDATA +  8) = i_FOCSCALE
	    idatap(MINIDATA +  9) = i_COLFOCLN
	    idatap(MINIDATA + 10) = i_XDISPERS
	    idatap(MINIDATA + 11) = i_NXDGRAT
	    idatap(MINIDATA + 12) = i_XDSIGMAI
	    idatap(MINIDATA + 13) = i_XDDELTAD
	    idatap(MINIDATA + 14) = i_XDALFBET
	    idatap(MINIDATA + 15) = i_FPROTANG
	    idatap(MINIDATA + 16) = i_NXDPRISM
	    idatap(MINIDATA + 17) = i_wizard
	    botidata = MINIDATA + 17
	else if (nxdprism .gt. 0) then
c           reset the Y limits of the menu
	    iminndc = 0.05
	    imaxndc = 0.80
c           display all of everything
	    idatap(MINIDATA +  0) = i_TELESCOP
	    idatap(MINIDATA +  1) = i_INSTRUME
	    idatap(MINIDATA +  2) = i_PRIMDIAM
	    idatap(MINIDATA +  3) = i_COLLDIAM
	    idatap(MINIDATA +  4) = i_CAMFOCLN
	    idatap(MINIDATA +  5) = i_ECSIGMAI
	    idatap(MINIDATA +  6) = i_ECTHETAD
	    idatap(MINIDATA +  7) = i_ECDELTAD
	    idatap(MINIDATA +  8) = i_FOCSCALE
	    idatap(MINIDATA +  9) = i_COLFOCLN
	    idatap(MINIDATA + 10) = i_XDISPERS
	    idatap(MINIDATA + 11) = i_NXDGRAT
	    idatap(MINIDATA + 12) = i_FPROTANG
	    idatap(MINIDATA + 13) = i_NXDPRISM
	    idatap(MINIDATA + 14) = i_PRANGIND
	    idatap(MINIDATA + 15) = i_PRAPEXD
	    idatap(MINIDATA + 16) = i_PRAPEX1
	    idatap(MINIDATA + 17) = i_PRAPEX2
	    idatap(MINIDATA + 18) = i_PRAPEX3
	    idatap(MINIDATA + 19) = i_PRFACE
	    idatap(MINIDATA + 20) = i_PRFACE2
	    idatap(MINIDATA + 21) = i_PRFACE3
	    idatap(MINIDATA + 22) = i_PRGLAS
	    idatap(MINIDATA + 23) = i_PRGLAS1
	    idatap(MINIDATA + 24) = i_PRGLAS2
	    idatap(MINIDATA + 25) = i_PRGLAS3
	    idatap(MINIDATA + 26) = i_wizard
	    botidata = MINIDATA + 26
	endif
	imeninit = .true.
	return
	end
C=======================================================================
C=======================================================================
--------------- wkics.F ------------------------
#include "include/port.h"
C==============================================================================
#ifdef OLD_WAY
C==============================================================================
	integer function wkics(directory)
c       Open a file and write the configuration of a detector to that file.
c       using the KICS syntax.
	IMPLICIT_NONE
C       Parameters
#       include "include/stdio.par"
#       include "echelle.par"
C       External Variables
c                       the directory into which this setup should go
	character*(*)   directory
C       Internal Variables
c                       loop
	integer         i
c                       a place to read Conrad FITS string arrays
	character*132   string
c                       iostatus of an internal write
	integer         ios
c                       length of setup name
	integer         lsn
C       External Function
	integer         lenc
C       Common Block
	include 'setup.inc'
	include 'spgraf.inc'
	include 'detmos.inc'
	include 'lam.cmn'
C       Executable Code
c       BINNING   binning                                 array of integers[2]
c       CAFOCUS   camera-focus                            real number
c       COFOCUS   collimator-focus                        real number
c       COLL      collimator-select                       logical
c       DECKPOS   decker-position                         real number
c       DECKRAW   decker-raw-position                     integer
c       ECANGLE   echelle-angle                           real number
c       FILTER    filter-position                         integer
c       FILTER2   filter2-position                        integer
c       OBSERVER  observer                                ascii string
c       SLITWID   slit-width                              real number
c       SLITRAW   slit-raw-position                       integer
c       WINDOW    window                                  array of integers[5]
c       XDANGLE   cross-disperser-angle                   real number
c       open the file
	open(unit=EFOLUN,file=setup,status=StatNew,iostat=ios,
     &  form='formatted' CarriageControlList )
	if (ios .ne. SUCCESS) then
	    write(STDERR,*)
     &      'Could not open KICS file named'//setup
	endif
c       ----------------------------------------------------------------
	lsn = lenc(setup)
	string = 'define '//setup(:lsn)//' '
	lsn = lenc(string)+1
	i = lenc(observer)
	write(EFOLUN,*) string(:lsn)//'observer="'//observer(:i)//'"'
	write(EFOLUN,*) string(:lsn)//'ecangle=',ecangle
	if (nxdgrat .gt. 0)
     &  write(EFOLUN,*) string(:lsn)//'xdangle=',xdangle
c       special for the Hamilton Echelle spectrograph
c       if (nxdgrat .eq. 0 .and. nxdprism .eq. 2)
c    &  write(EFOLUN,*) string(:lsn)//'hamhgt=',nint(hamhgt)
c       ----------------------------------------------------------------
	write(EFOLUN,*) string(:lsn)//'deckpos=',deckpos
c       ----------------------------------------------------------------
	write(EFOLUN,*) string(:lsn)//'slitwid=',slitwid
c       ----------------------------------------------------------------
	write(EFOLUN,*) string(:lsn)//'filter=',filter
	write(EFOLUN,*) string(:lsn)//'filter2=',filter2
c       ----------------------------------------------------------------
	i = lenc(coll)
	write(EFOLUN,*) string(:lsn)//'coll= ',coll(:i)
	write(EFOLUN,*) string(:lsn)//'cofocus=',cofocus
	i = lenc(camera)
c       write(EFOLUN,*) string(:lsn)//'camera=',camera(:i)
	write(EFOLUN,*) string(:lsn)//'cafocus=',cafocus
c       ----------------------------------------------------------------
	write(EFOLUN,*) string(:lsn)//'binning="',
     &  xbin(0),',',ybin(0),'"'
	do 2500 i=1,nchips
	  write(EFOLUN,*) string(:lsn)//'window="',i,',',
     &    window(Xo,i),',',window(Yo,i),',',
     &    window(dX,i),',',window(dY,i),'"'
2500    continue
c       ----------------------------------------------------------------
c       close the file
	close(EFOLUN)
	return
	end
C==============================================================================
#else /* OLD_WAY */
C==============================================================================
	integer function wkics(directory)
c       Open a file and write the configuration of a detector to that file.
c       using the KICS syntax.
	IMPLICIT_NONE
C       Parameters
#       include "include/units.par"
#       include "include/stdio.par"
#       include "echelle.par"
C       External Variables
c                       the directory into which this setup should go
	character*(*)   directory
C       Internal Variables
c                       loop
	integer         i
c                       a place to read Conrad FITS string arrays
	character*256   string
c                       iostatus of an internal write
	integer         ios
C       External Function
	integer         lenc
C       Common Block
	include 'setup.inc'
	include 'spgraf.inc'
	include 'detmos.inc'
	include 'lam.cmn'
#       ifdef RATWIN
	include 'ratwin.cmn'
#       endif /* RATWIN */
C       Executable Code
c       open the file
	i = lenc(directory)
	if (i .gt. 0) then
	    string = directory
	endif
	string(i+1:) = setup
	open(unit=EFOLUN,file=string,status=StatNew,iostat=ios,
     &  form='formatted' CarriageControlList )
	if (ios .ne. SUCCESS) then
	    write(STDERR,*)
     &      'Could not open KICS file named '//setup
	endif
c       ----------------------------------------------------------------
	i = lenc(observer)
#       ifdef SOMEDAY
	write(EFOLUN,*) 'OBSERVER = "'//observer(:i)//'"'
#       endif /* SOMEDAY */
	write(EFOLUN,*) 'ECHANGL = ',ecangle
	if (nxdgrat .gt. 0)
     &  write(EFOLUN,*) 'XDANGL = ',xdangle
#       ifdef HAM_KICS
	/*
	 *  not useful until the Hamilton Echelle is driven by a variant
	 *  of the Keck Instrument Control System
	 */
	if (nxdgrat .eq. 0 .and. nxdprism .eq. 2)
     &  write(EFOLUN,*) 'HAMHGT = ',nint(hamhgt)
#       endif /* HAM_KICS */
c       ----------------------------------------------------------------
	write(EFOLUN,*) 'DECKNAME = ',decknnam
c       ----------------------------------------------------------------
	write(EFOLUN,*) 'SLITWID = ',slitwid
c       ----------------------------------------------------------------
c       write(EFOLUN,*) 'FIL1POS = ',filter
c       write(EFOLUN,*) 'FIL2POS = ',filter2
	write(EFOLUN,*) 'FIL1NAME= ',filname
	write(EFOLUN,*) 'FIL2NAME= ',fil2name
c       ----------------------------------------------------------------
	i = lenc(coll)
	write(EFOLUN,*) 'COLL = ',coll(:i)
	write(EFOLUN,'(a,f14.6)') 'COFOCUS = ',dble(cofocus)
	i = lenc(camera)
c       write(EFOLUN,*) 'CAMERA = ',camera(:i)
	write(EFOLUN,'(a,f14.6)') 'CAFOCUS = ',dble(cafocus)
c       ----------------------------------------------------------------
#       ifdef RATWIN
	call ratwindow
#       endif /* RATWIN */
	write(EFOLUN,*) 'BINNING = "',xbin(0),',',ybin(0),'"'
	write(EFOLUN,*) 'DWINDOW = "',1,',',
     &  window(Xo,0),',',window(Yo,0),',',
     &  window(dX,0),',',window(dY,0),'"'
#       ifdef RATWIN
	write(EFOLUN,*) 'WINDOW = "',1,',',
     &  kindow(Xo),',',kindow(Yo),',',
     &  kindow(dX),',',kindow(dY),'"'
#       endif /* RATWIN */
c       ----------------------------------------------------------------
c       close the file
	close(EFOLUN)
	return
	end
C==============================================================================
#endif  /* OLD_WAY */
C==============================================================================
--------------- writdet.F ------------------------
#include "include/port.h"
C==============================================================================
C==============================================================================
	integer function writdet(detfile)
c       Open a file and write the configuration of a detector to that file.
c       using FITS-card-like lines
	IMPLICIT_NONE
C       Parameters
#       include "include/stdio.par"
#       include "echelle.par"
	character*(*)   FMTLOG
	parameter       (FMTLOG = '(a,l20,a)')
	character*(*)   FMTINT
	parameter       (FMTINT = '(a,i20,a)')
	character*(*)   FMTSTR
	parameter       (FMTSTR = '(a,a,a)')
	character*(*)   FMTFP9
	parameter       (FMTFP9 = '(a,f20.9,a)')
	character*(*)   FMTBSPOT
	parameter       (FMTBSPOT = '(i6,4('','',i6))')
	character*(*)   FMTDETPOS
	parameter       (FMTDETPOS =
     &  '(2(f10.6,'',''),(f10.4,'',''),(i3,'',''),2(f10.3,'',''))')
C       External Variables
c                       the almost-FITS file containing the detector info
c                       which we will try to open and try to write
	character*(*)   detfile
C       Internal Variables
c                       loop
	integer         i, j
c                       a place to read Conrad FITS string arrays
	character*80    string
c                       iostatus of an internal write
	integer         ios
c                       a place to keep a dynamically created FITS keyword
	character*11    fitskey
c                       a place to keep a dynamically created format string
	character*4     ifmt
C       External Function
	integer         lenc
C       Common Block
	include 'detmos.inc'
C       Executable Code
	ifmt = '(i1)'
c       open the file
	open(unit=EFOLUN,file=detfile,status=StatNew,
     &  form='formatted',iostat=ios CarriageControlList )
	if (ios .ne. SUCCESS) return
	i = max(1,min(lenc(detector),MAXFITSTR))
	write(EFOLUN,FMTLOG) 'STDVIDV = '  ,stdvidv      ,'  /'
	write(EFOLUN,FMTLOG) 'STDVIDH = '  ,stdvidh      ,'  /'
	write(EFOLUN,FMTLOG) 'STDVIDR = '  ,stdvidr      ,'  /'
	write(EFOLUN,FMTSTR) 'DETECTOR= ''',detector(:i) ,''''
	write(EFOLUN,FMTINT) 'NCHIPS  = '  ,nchips       ,'  /'
	write(EFOLUN,FMTINT) 'XPIX    = '  ,npix(0,Xp)   ,'  /'
	write(EFOLUN,FMTINT) 'YPIX    = '  ,npix(0,Yp)   ,'  /'
	write(EFOLUN,FMTFP9) 'PIXXSZ  = '  ,pixsiz(0,Xp) ,'  /'
	write(EFOLUN,FMTFP9) 'PIXYSZ  = '  ,pixsiz(0,Yp) ,'  /'
c       ----------------------------------------------------------------
	do 1500 i=1,nchips
	  write(ifmt(3:3),'(i1)') int(log10(real(i))+1)
c
	  fitskey = 'CHIPID  = '''
	  write(fitskey(7:8),ifmt) i
	  j = max(1,min(lenc(chipid(i)),MAXFITSTR))
	  write(EFOLUN,FMTSTR)   fitskey, chipid(i)(:j) ,''''
c
	  fitskey = 'XPIX    = '
	  write(fitskey(5:8),ifmt) i
	  write(EFOLUN,FMTINT) fitskey(1:10), npix(i,Xp),'  /'
c
	  fitskey = 'YPIX    = '
	  write(fitskey(5:8),ifmt) i
	  write(EFOLUN,FMTINT) fitskey(1:10), npix(i,Yp),'  /'
c
	  fitskey = 'PIXXSZ  = '
	  write(fitskey(7:8),ifmt) i
	  write(EFOLUN,FMTFP9) fitskey(1:10),pixsiz(i,Xp),'  /'
c
	  fitskey = 'PIXYSZ  = '
	  write(fitskey(7:8),ifmt) i
	  write(EFOLUN,FMTFP9) fitskey(1:10),pixsiz(i,Yp),'  /'
c
	  fitskey = 'PHPRPX  = '
	  write(fitskey(7:8),ifmt) i
	  write(EFOLUN,FMTINT) fitskey(1:10),phprepix(i),'  /'
1500    continue
c       ----------------------------------------------------------------
	write(EFOLUN,FMTINT)   'NBSPOT  = ',nbspot,'  /'
c       ----------------------------------------------------------------
	fitskey = 'BSPOT   = '''
	do 2500 i=1,nbspot
	  write(ifmt(3:3),'(i1)') int(log10(real(i))+1)
	  write(fitskey(6:8),ifmt) i
	  string = ' '
	  write(string,FMTBSPOT) (bspot(j,i),j=cID,dY)
	  j = max(1,min(lenc(string),MAXFITSTR))
	  write(EFOLUN,FMTSTR)   fitskey, string(:j) ,''''
2500    continue
c       ----------------------------------------------------------------
	fitskey = 'DETPOS  = '''
	do 3500 i=1,nchips
	  write(ifmt(3:3),'(i1)') int(log10(real(i))+1)
	  write(fitskey(7:8),ifmt) i
	  string = ' '
	  write(string,FMTDETPOS)
     &    (detpos(j,i),j=Xp,Rot), int(detpos(Orient,i)),
     &    (detpos(j,i),j=RpX,RpY)
	  j = max(1,min(lenc(string),MAXFITSTR))
	  write(EFOLUN,FMTSTR)   fitskey, string(:j) ,''''
3500    continue
c       ----------------------------------------------------------------
c       close the file
	close(EFOLUN)
	return
	end
C==============================================================================
C==============================================================================
--------------- writset.F ------------------------
#include "include/port.h"
C==============================================================================
C==============================================================================
	integer function writset(setfile)
c       Open a file and write the configuration of a detector to that file.
c       using FITS-card-like lines
	IMPLICIT_NONE
C       Parameters
#       include "include/stdio.par"
#       include "echelle.par"
C       External Variables
c                       the almost-FITS file containing the setup info
c                       which we will try to open and try to write
	character*(*)   setfile
C       Internal Variables
c                       loop
	integer         i, j
c                       a place to read Conrad FITS string arrays
	character*80    string
c                       iostatus of an internal write
	integer         ios
c                       a place to keep a dynamically created FITS keyword
	character*11    fitskey(3)
c                       a place to keep a dynamically created format string
	character*4     ifmt
c                       a dummy
	doubleprecision dummy
C       External Function
	integer         lenc
C       Common Block
	include 'setup.inc'
	include 'spgraf.inc'
	include 'detmos.inc'
	include 'lam.cmn'
#       ifdef RATWIN
	include 'ratwin.cmn'
#       endif /* RATWIN */
C       Executable Code
c       open the file
	open(unit=EFOLUN,file=setfile,form='formatted',iostat=ios,
     &  status=StatNew CarriageControlList )
	if (ios .ne. SUCCESS) return
c       ----------------------------------------------------------------
	i = max(1,min(lenc(detfilnm),MAXFITSTR))
	write(EFOLUN,'(a,a,a)')     'DETFILNM= ''',detfilnm(:i) ,''''
	i = max(1,min(lenc(spcfilnm),MAXFITSTR))
	write(EFOLUN,'(a,a,a)')     'SPCFILNM= ''',spcfilnm(:i) ,''''
c       ----------------------------------------------------------------
	i = max(1,min(lenc(setup),MAXFITSTR))
	write(EFOLUN,'(a,a,a)')     'SETUP   = ''',setup(:i)    ,''''
	i = max(1,min(lenc(observer),MAXFITSTR))
	write(EFOLUN,'(a,a,a)')     'OBSERVER= ''',observer(:i) ,''''
	write(EFOLUN,'(a,f20.6,a)') 'ECHANGL = '  ,ecangle      ,'  /'
	if (nxdgrat .gt. 0)
     &  write(EFOLUN,'(a,f20.6,a)') 'XDANGL  = '  ,xdangle      ,'  /'
c       special for the Hamilton Echelle spectrograph
	if (nxdgrat .eq. 0 .and. nxdprism .eq. 2)
     &  write(EFOLUN,'(a,f20.0,a)') 'HAMHGT  = '  ,hamhgt       ,'  /'
c       ----------------------------------------------------------------
	i = min(lenc(decker),MAXFITSTR)
	write(EFOLUN,'(a,i20,a)')   'DECKRAW = '  ,deckraw      ,'  /'
	write(EFOLUN,'(a,f20.6,a)') 'DECKPOS = '  ,deckpos      ,'  /'
	i = max(1,min(lenc(decknnam),MAXFITSTR))
	write(EFOLUN,'(a,a,a)')     'DECKNAME= ''',decknnam(:i) ,''''
c       next three are written in order of increasing importance
	write(EFOLUN,'(a,f20.3,a)') 'DECKPIX = '  ,deckpix      ,'  /'
	write(EFOLUN,'(a,f20.3,a)') 'DECKSIZE= '  ,decksize     ,'  /'
	write(EFOLUN,'(a,f20.6,a)') 'DECKHGT = '  ,deckhgt      ,'  /'
	if (ndeckap .gt. 0) then
	    string = ' '
	    write(string,'(i4,4('','',f9.6))') ndeckap,
     &      (deckspec(i),i=1,2*ndeckap)
	    i = max(1,min(lenc(string),MAXFITSTR))
	    write(EFOLUN,'(a,a,a)') 'DECKSPEC= ''',string(:i)   ,''''
	endif
c       ----------------------------------------------------------------
c       these are written in order of increasing importance
	write(EFOLUN,'(a,f20.3,a)') 'SLITVEL = '  ,slitvel      ,'  /'
	write(EFOLUN,'(a,f20.3,a)') 'SLITPIX = '  ,slitpix      ,'  /'
	write(EFOLUN,'(a,f20.3,a)') 'SLITSIZE= '  ,slitsize     ,'  /'
	write(EFOLUN,'(a,i20,a)')   'SLITRAW = '  ,slitraw      ,'  /'
	write(EFOLUN,'(a,f20.6,a)') 'SLITWID = '  ,slitwid      ,'  /'
c       ----------------------------------------------------------------
	write(EFOLUN,'(a,i20,a)')   'FIL1POS = ',filter         ,'  /'
	write(EFOLUN,'(a,i20,a)')   'FIL2POS = ',filter2        ,'  /'
	i = max(1,min(lenc(filname),MAXFITSTR))
	write(EFOLUN,'(a,a,a)')     'FIL1NAME= ''',filname(:i)  ,''''
	i = max(1,min(lenc(fil2name),MAXFITSTR))
	write(EFOLUN,'(a,a,a)')     'FIL2NAME= ''',fil2name(:i) ,''''
c       ----------------------------------------------------------------
	i = max(1,min(lenc(coll),MAXFITSTR))
	write(EFOLUN,'(a,a,a)')     'COLL    = ''',coll(:i)     ,''''
	write(EFOLUN,'(a,f20.6,a)') 'COFOCUS = '  ,cofocus      ,'  /'
	i = max(1,min(lenc(camera),MAXFITSTR))
	write(EFOLUN,'(a,a,a)')     'CAMERA  = ''',camera(:i)   ,''''
	write(EFOLUN,'(a,f20.6,a)') 'CAFOCUS = '  ,cafocus      ,'  /'
c       ----------------------------------------------------------------
c       ----------------------------------------------------------------
#       ifdef RATWIN
	call ratwindow
#       endif /* RATWIN */
	write(EFOLUN,'(a,i9,a,i9,a)')
     &  'BINNING = ''', xbin(0), ',', ybin(0), ''' /'
	string = ' '
	write(string,'(i6,4('','',i6))') (window(j,0),j=Xo,dY)
	j = max(1,min(lenc(string),MAXFITSTR))
	write(EFOLUN,'(a,a,a)')
     &  'DWINDOW = ''', string(:j)   ,''''
#       ifdef RATWIN
	string = ' '
	write(string,'(i6,4('','',i6))') (kindow(j),j=Xo,dY)
	j = max(1,min(lenc(string),MAXFITSTR))
	write(EFOLUN,'(a,a,a)')
     &  'WINDOW  = ''', string(:j)   ,''''
#       endif /* RATWIN */
	ifmt = '(i1)'
	fitskey(1) = 'BINNING = '''
	fitskey(2) = 'DWINDOW = '''
	do 2500 i=1,nchips
c         create the format used to create the numbered keyword
	  write(ifmt(3:3),'(i1)') int(log10(real(i))+1)
c         write the BINNINGn
	  write(fitskey(1)(8:8),ifmt) i
	  string = ' '
	  write(string,'(i6,1('','',i6))') xbin(i), ybin(i)
	  j = max(1,min(lenc(string),MAXFITSTR))
	  write(EFOLUN,'(a,a,a)')   fitskey(1)    ,string(:j)  ,''''
c         write the DWINDOWn
	  write(fitskey(2)(7:8),ifmt) i
	  string = ' '
	  write(string,'(i6,4('','',i6))') (window(j,i),j=Xo,dY)
	  j = max(1,min(lenc(string),MAXFITSTR))
	  write(EFOLUN,'(a,a,a)')   fitskey(2)    ,string(:j)   ,''' /'
2500    continue
c       ----------------------------------------------------------------
c       ----------------------------------------------------------------
	i = max(1,min(lenc(wavefile),MAXFITSTR))
	write(EFOLUN,'(a,a,a)')     'WAVEFILE= ''',wavefile(:i) ,''''
	write(EFOLUN,'(a,f20.6,a)') 'RADVELZ = '  ,redshift     ,'  /'
	dummy = (redshift + 1)**2
	dummy = cLIGHT * (dummy - 1) / (dummy + 1)
	write(EFOLUN,'(a,f20.3,a)') 'RADVEL  = '  ,dummy        ,'  /'
	write(EFOLUN,'(a,f20.4,a)') 'WAVLMAX = '  ,wl           ,'  /'
	write(EFOLUN,'(a,f20.4,a)') 'WAVLMIN = '  ,ws           ,'  /'
	write(EFOLUN,'(a,i20,a)')   'XDORDER = '  ,mc           ,'  /'
c       ----------------------------------------------------------------
c       close the file
	close(EFOLUN)
	return
	end
C==============================================================================
C==============================================================================
--------------- writspc.F ------------------------
#include "include/port.h"
C==============================================================================
C==============================================================================
	integer function writspc(spcfile)
c       Open a file and write the configuration of a spectrograph to that file.
c       using FITS-card-like lines
	IMPLICIT_NONE
C       Parameters
#       include "include/stdio.par"
#       include "echelle.par"
c                       a quote
	character*(1)   q
	parameter       (q = '''')
C       External Variables
c                       the almost-FITS file containing the spectrograph info
c                       which we will try to open and try to write
	character*(*)   spcfile
C       Internal Variables
c                       loop
	integer         i, j
c                       a place to store a fits key word
	character*10    fitskey(3)
c                       iostatus of an internal write
	integer         ios
C       External Function
	integer         lenc
C       Common Block
	include 'spgraf.inc'
C       Executable Code
c       open the file
	open(unit=EFOLUN,file=spcfile,form='formatted',iostat=ios,
     &  status=StatNew CarriageControlList )
	if (ios .ne. SUCCESS) return
	i = max(1,min(lenc(telescop),MAXFITSTR))
	write(EFOLUN,'(a,a)')       'TELESCOP= ',q//telescop(:i)//q
	i = max(1,min(lenc(instrume),MAXFITSTR))
	write(EFOLUN,'(a,a)')       'INSTRUME= ',q//instrume(:i)//q
	write(EFOLUN,'(a,f20.4,a)') 'PRIMDIAM= ',primdiam,'  /'
	write(EFOLUN,'(a,f20.6,a)') 'FOCSCALE= ',focscale,'  /'
	write(EFOLUN,'(a,f20.3,a)') 'COLFOCLN= ',colfocln,'  /'
	write(EFOLUN,'(a,f20.3,a)') 'CAMFOCLN= ',camfocln,'  /'
	write(EFOLUN,'(a,f20.3,a)') 'ECTHETAD= ',ecthetad,'  /'
	write(EFOLUN,'(a,f20.5,a)') 'ECDELTAD= ',ecdeltad,'  /'
	write(EFOLUN,'(a,f20.3,a)') 'ECSIGMA = ',ecsigma ,'  /'
	write(EFOLUN,'(a,f20.3,a)') 'ECSIGMAI= ',ecsigmai,'  /'
	i = max(1,min(lenc(xdispers),MAXFITSTR))
	write(EFOLUN,'(a,a)')       'XDISPERS= ',q//xdispers(:i)//q
	write(EFOLUN,'(a,i20,a)')   'NXDGRAT = ',nxdgrat ,'  /'
	if (nxdgrat .gt. 0) then
	    write(EFOLUN,'(a,f20.5,a)') 'XDDELTAD= ',xddeltad,'  /'
	    write(EFOLUN,'(a,f20.5,a)') 'XDALFBET= ',xdalfbet,'  /'
	    write(EFOLUN,'(a,f20.3,a)') 'XDSIGMA = ',xdsigma ,'  /'
	    write(EFOLUN,'(a,f20.3,a)') 'XDSIGMAI= ',xdsigmai,'  /'
	endif
	write(EFOLUN,'(a,i20,a)')   'NXDPRISM= ',nxdprism,'  /'
	if (nxdprism .gt. 0) then
	    write(EFOLUN,'(a,f20.5,a)') 'PRANGIND= ',prangind
	    write(EFOLUN,'(a,f20.5,a)') 'PRAPEX  = ',prapexd(0)
	    write(EFOLUN,'(a,a)')       'PRGLAS  = ',q//prglas(0)(:6)//q
	    fitskey(1) = 'PRAPEX  = '
	    fitskey(2) = 'PRGLAS  = '
	    fitskey(3) = 'PRFACE  = '
	    do 1000 i=1,nxdprism
	      do 500 j=1,3
		write(fitskey(j)(7:7),'(i1)') i
500           continue
	      write(EFOLUN,'(a,f20.5,a)')fitskey(1)    ,prapexd(i)
	      write(EFOLUN,'(a,a)')      fitskey(2), q//prglas(i)(:6)//q
	      write(EFOLUN,'(a,f20.5,a)')fitskey(3)    ,prface(i)
1000        continue
	endif
	write(EFOLUN,'(a,l20,a)')   'STDECHFH= ',stdechfh,'  /'
	write(EFOLUN,'(a,f20.3,a)') 'FPROTANG= ',fprotang,'  /'
c       ----------------------------------------------------------------
c       close the file
	close(EFOLUN)
	return
	end
C==============================================================================
C==============================================================================
