#! /bin/sh
# This is a shell archive.  Remove anything before this line, then unpack
# it by saving it into a file and typing "sh file".  To overwrite existing
# files, type "sh file -c".  You can also feed this as standard input via
# unshar, or by typing "sh <file", e.g..  If this archive is complete, you
# will see the following message at the end:
#		"End of shell archive."
# Contents:  Makefile README.1ST cirsub.f ct1.dat ct1.res ct2.dat
#   ct2.res diged.f linsub.f lt.out lt1.dat lt1.res lt2.dat lt2.res
#   map.f mapsub.f
# Wrapped by wrp@cyclops.micr.Virginia.EDU on Sat May 16 13:03:59 1992
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
if test -f 'Makefile' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'Makefile'\"
else
echo shar: Extracting \"'Makefile'\" \(286 characters\)
sed "s/^X//" >'Makefile' <<'END_OF_FILE'
X
Xall : mapc mapl diged
X
Xmapc : map.o mapsub.o cirsub.o
X	f77 -o mapc map.o mapsub.o cirsub.o -lc
X
Xmapl : map.o mapsub.o linsub.o
X	f77 -o mapl map.o mapsub.o linsub.o -lc
X
Xdiged : diged.f
X	f77 -o diged diged.f
X
Xmap.o	: map.f
X
Xmapsub.o : mapsub.f
X
Xcirsub.o : cirsub.f
X
Xlinsub.o : linsub.f
END_OF_FILE
if test 286 -ne `wc -c <'Makefile'`; then
    echo shar: \"'Makefile'\" unpacked with wrong size!
fi
# end of 'Makefile'
fi
if test -f 'README.1ST' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'README.1ST'\"
else
echo shar: Extracting \"'README.1ST'\" \(6712 characters\)
sed "s/^X//" >'README.1ST' <<'END_OF_FILE'
X
X
XCopyright 1982, 1985, 1992 by William R. Pearson. All rights reserved.
XThe MAPC, MAPL, or DIGED programs and documentation may not be sold or
Xincorporated into a commercial product, in whole or in part, without
Xwritten consent of William R. Pearson.
X
X				Revised May, 1992
X
X	I have had several requests lately for my mapping for
Xinferring restriction maps from fragment length data, so I have
Xrecompiled them under unix.  The notes below refer to the MS-DOS
Xversion, which is essentially identical to the UNIX version.  The
Xsource code has been changed to move from Microsoft Fortran 3.3 to
XSunOS f77.  Workstations have become a lot faster in the past 10
Xyears, so that it may be quite reasonable to attempt mapping problems
Xthat arelarger than those outlined below.
X
X				August, 1985
X
X	This disk contains the programs and source code for the
Xrestriction mapping programs MAPC (circular molecules) and MAPL
X(linear molecules) described in Nucleic Acids Research (1982)
X10:217-227. In addition, an improved data entry program, DIGED, is
Xincluded.  These programs are the same as the original distribution
Xfor the Dec-10/20 and VAX computers.
X
X	The program files are:
X
X	mapc, mapl	map circular or linear molecules.  mapc will
X			work on linear molecules but mapl is faster.
X
X	diged		improved data entry program that allows
X			editing of digest data
X
X
X	In addition to the programs, I have included several test data
Xfiles: ct1.dat, ct2.dat, lt1.dat, lt2.dat.  CT1,2 are two tests for
Xcircular molecules, LT1,2 are tests for linears.  CT1 and LT1 are
Xartificial tests that should be solved very rapidly with errors <10-6, CT2
Xand LT2 are real data.  The results of these tests are shown in CT1.RES,
Xetc.
X
XRunning the programs.
X
X	To run the mapping programs, you must first create a data file
Xusing diged and then run mapc or mapl.  For example to map the test file
Xct2.dat, you would type:
X
X% mapc					; run the program
XType data filename ct2.dat		; test file name
XError, Efact = 0.02, 2.00		; be sure to use decimal points and
X					; separate the values with a comma.
XUsing  ERR=   .0200  EFACT=   2.00
X
X  pGT55 glutathione-s-transferase 16-Jan-81
X
X 
X 
X ERROR =   .0200  EFACT =  2.000
X      936  Digestions calculated in      0 sec
X
XRunning the mapping programs is simple, just remember to enter the Error
Xand Efact values as real numbers with decimal points, and separate them
Xwith a comma.  If you forget a decimal point, a very low value for the
Xerror or efact may be used.  If you forget to enter one of the numbers, the
Xprogram will wait until it is typed or a / is typed.
X
X	These mapping programs are fast and efficient but they have
Xtheir limits.  Enzymes which make one to five cuts can be mapped
Xquickly, but more than 5 fragments takes a lot more time.  It is
Ximpossible to accurately map more than 8 unknown fragments with this
Xprogram, and it would take forever. [This may no longer be true.] Once
Xyou get a feel for the program with simple digests (sub-cloned phage
Xfragments or lots of six-cutters) you can try more complicated
Xproblems.  When trying to solve complex problems (more than 5
Xfragments in 2 or more digests) start with very low error limits
X(<0.01) and raise the limits after successive failures.  If the error
Xvalue is too low, the search will fail quickly and you can try a
Xlarger value. If the error value is too high, it may take several
Xhours to get an answer.
X
XDIGED 
X
X	In the NAR paper, an example of data entry using the program DIGFIL
Xwas shown.  Because DIGFIL required retyping of all data to make the
Xsmallest change, I have written a new program, DIGED.  In addition to the
Xdata entry functions of DIGFIL, DIGED allows you to add enzymes, change
Xfragment sizes, and reorder data from already existing files.  The data
Xentry portions of DIGED are exactly like DIGFIL.  The new sections should
Xbe self-explanatory.
X
X	Before you can map restriction data, they must be entered into a
Xdata file.  Most people have much more difficulty with this process than
Xthe actual mapping, because the several kinds of data must be entered that
Xone does not usually consider explicitly when mapping by hand.  Again, when
Xentering values for the size of fragments, be sure to use decimal points.
XAnd when entering the integer IBEG and IEND parameters, do not use decimal
Xpoints.
X
X	In addition, f77 requires that lists with an arbitrary number
Xof values (such as restriction fragment sizes) end with a slash (/).
XFor example, to enter a restriction fragment sizes, you would type:
X
X	BAM1: 14.7, 8.4, 4.5, 3.2, /
X
XIf you forget the /, the program will wait for you to type it.
X
X	Most new users of the mapping programs are confused by some of the
Xparameters required to map circular molecules.  One of the most common
Xmistakes is to forget to enter -1. when asked for the restriction digest
XXOFF (-1. UNKNOWN).  XOFF is the coordinate of any known restriction site
Xfor the given enzyme in the molecule being mapped.  If no site is known,
X-1. MUST BE USED.  The entry cannot be left blank, or the program assumes
Xthat there is a known restriction site at 0.0.
X
X	Circular molecules also require the investigator to specify a NEW
XFRAGment in the double digest data which is not present in either single
Xdigest.  This information is also essential and cannot be left blank.  I
Xhave left the choice of the NEW FRAG to the user so that he may specify a
Xfragment clearly different from those in either single digest.  In
Xaddition, the fragment size of this fragment should be accurately known.
X
X	You should also note that the order of restriction digests is
Ximportant.  Since the program tries to fit the first two digests, and then
Xinclude the third and fourth, etc.  The program can go much faster if the
Xdigests with few restriction fragments are tested before digests with a
Xlarge number of fragments.  In addition, the best restriction fragment data
Xshould be tested before poorer data.  DIGED offers an option to reorder the
Xenzyme digest data for efficient fitting.
X
XRecompiling the programs:
X
X	I have included all of the source files required to recompile the
Xmapping and data entry programs, so that you can modify (and hopefully
Ximprove) them.  The programs would be much more useful if they took into
Xconsideration which fragments were not cut in a digestion, and knew that
Xcertain sites were not present in the vector.  To rebuid the programs,
Xtype: make all .
X
X	This program is a direct translation from earlier large machine
Xversions, but the unix version has not been extensively tested.  I would
Xappreciate hearing about any bugs you might find.
X
XWilliam R. Pearson
X
XDepartment of Biochemistry
XBox 440 Jordan Hall
XUniversity of Virginia
XCharlottesville, VA  22908
X
Xwrp@virginia.EDU
END_OF_FILE
if test 6712 -ne `wc -c <'README.1ST'`; then
    echo shar: \"'README.1ST'\" unpacked with wrong size!
fi
# end of 'README.1ST'
fi
if test -f 'cirsub.f' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'cirsub.f'\"
else
echo shar: Extracting \"'cirsub.f'\" \(2987 characters\)
sed "s/^X//" >'cirsub.f' <<'END_OF_FILE'
XC	NDGCIR.FOR	29-JAN-80
XC
XC	COPYRIGHT (C) 1981 WILLIAM R. PEARSON
XC
XC
XC	DIGESTS TWO RESTRICTION FRAGMENTS TO GIVE SYNDIG
XC
XC	FIRST FINDS START OF MOLECULE, THEN MERGES TWO MOLECULES
XC
X	SUBROUTINE DIGEST(ID,JD,XOFF,SYNDIG)
X	DIMENSION SYNDIG(1)
X      COMMON /DDATA/ND,N1F(10),N2F(45),D1DAT(10,20),D2DAT(45,40),XL1(10)
X     1, XL2(45)
XC
XC	ZERO THE SYNTHETIC ARRAY
XC
X	NI=N1F(ID)
X	NJ=N1F(JD)
X	DO 10 I=1,NI+NJ
X   10	SYNDIG(I)=0.0
XC
XC	THE FIRST DIGEST IS ASSUMED TO START AT 0.0, IST=1 BUT THE
XC	SECOND DIGEST MUST START AT XREL, THE DISTANCE FROM 0.0 TO THE
XC	LEFT MOST CUT USING CIRCULAR POSITIONS
XC
X	POS2=0.0
X	POS0=0.0
X	JS=1
X	DO 30 J=NJ,1,-1
X	IF (POS0.GT.XOFF) GOTO 40
X	POS2=POS0
X	JS=J
X   30	POS0=POS0+D1DAT(JD,J)
X   40	XREL=XOFF-POS2
X	JS=JS-1
XC
XC	JS=JS-1 FOR MOD COUNTING
XC
XC
XC	NOW MERGE USING MODULUS COUNTING
XC
X	I=1
X	J=0
X	K=0
X	POS0=0.0
X	POS1=D1DAT(ID,I)
X	POS2=XREL
X	IF (I.GE.NI) GOTO 75
X   60	K=K+1
X	IF (POS1.LE.POS2) GOTO 70
X	SYNDIG(K)=POS2-POS0
X	POS0=POS2
X	J=J+1
XC
XC	.GE. HERE BECAUSE STARTS AT 0
XC
X	IF (J.GE.NJ) GOTO 65
X	POS2=POS2+D1DAT(JD,MOD((JS+J),NJ)+1)
X	GOTO 60
XC
XC	DONE WITH DIG2, FILL WITH DIG1
XC
X   65	IF (I.GE.NI) GOTO 80
X	K=K+1
X	SYNDIG(K)=POS1-POS0
X	POS0=POS1
X	I=I+1
X	POS1=POS1+D1DAT(ID,I)
X	GOTO 65
X   70	SYNDIG(K)=POS1-POS0
X	POS0=POS1
X	I=I+1
X	IF (I.GE.NI) GOTO 75
X	POS1=POS1+D1DAT(ID,I)
X	GOTO 60
XC
XC	FILL IN WITH DIG2
XC
X   75	IF (J.GE.NJ) GOTO 80
X	K=K+1
X	SYNDIG(K)=POS2-POS0
X	POS0=POS2
X	J=J+1
X	POS2=POS2+D1DAT(JD,MOD((JS+J),NJ)+1)
X	GOTO 75
XC
XC	ALL DONE, GET FRAG FROM END CUTS
XC
X   80	K=K+1
X	SYNDIG(K)=PFRACT(1.0-POS0)
XC	WRITE(0,101) (SYNDIG(I),I=1,K)
XC  101	FORMAT(' SYN ',12F8.4)
X	RETURN
X	END
X
XC	CRFIND	7-APR-80
XC
XC	COPYRIGHT (C) 1981 WILLIAM R. PEARSON
XC
XC
XC	GIVEN TWO PERMUTATIONS OF FRAGMENTS, ROTATES THE
XC	FRAGMENTS TO FIND A SOLUTION
XC
XC	USES XDOFF FOR OFFSET OF TWO DIGESTIONS
XC
X	SUBROUTINE FIND(ID,JD,NOFF,XOFF,EOFF,ERR)
X	DIMENSION XOFF(1),EOFF(1)
X	DIMENSION SYNDIG(40)
X      COMMON /DDATA/ND,N1F(10),N2F(45),D1DAT(10,20),D2DAT(45,40),XL1(10)
X     1, XL2(45)
X	COMMON /IDATA/ IB(10),IT(10),XCOFF(10),XDOFF(45),XORG
XC
XC
X	NI=N1F(ID)
X	NJ=N1F(JD)
X	nij=ni+nj
X	KD=MMAP(ID,JD,ND)
XC
XC	CHECK FOR KNOWN OFFSETS
XC
X	IF ((XCOFF(ID).GE.0.0).AND.(XCOFF(JD).GE.0.0)) GOTO 100
XC
XC	START ROTATING
XC
X	XDDOFF=XDOFF(KD)
X	X1OFF=0.0
X	DO 50 IROT=1,NI
X	X2OFF=0.0
X	DO 40 JROT=1,NJ
XC
XC	CHECK WITH POSITIVE DOUBLE DIGEST OFFSET
XC
X	X3OFF=X2OFF-X1OFF+XDDOFF
X	X3OFF=PFRACT(X3OFF)
X	CALL DIGEST(ID,JD,X3OFF,SYNDIG)
X	EVOFF=ERROR(KD,SYNDIG,NIJ)
X	IF (EVOFF.LE.ERR) CALL SAVOFF(X3OFF,NOFF,XOFF,EVOFF,EOFF)
XC
XC	CHECK WITH NEGATIVE DOUBLE DIGEST OFFSET
XC
X	X3OFF=X2OFF-X1OFF-XDDOFF
X	X3OFF=PFRACT(X3OFF)
X	CALL DIGEST(ID,JD,X3OFF,SYNDIG)
X	EVOFF=ERROR(KD,SYNDIG,NIJ)
X	IF (EVOFF.LE.ERR) CALL SAVOFF(X3OFF,NOFF,XOFF,EVOFF,EOFF)
X	X2OFF=X2OFF+(1.0-D1DAT(JD,JROT))
X   40	CONTINUE
X	X1OFF=X1OFF+(1.0-D1DAT(ID,IROT))
X   50	CONTINUE
X	RETURN
XC
XC
X  100	X3OFF=PFRACT(XCOFF(JD)-XCOFF(ID))
X	CALL DIGEST(ID,JD,X3OFF,SYNDIG)
X	EVOFF=ERROR(KD,SYNDIG,NIJ)
X	IF (EVOFF.LE.ERR) CALL SAVOFF(X3OFF,NOFF,XOFF,EVOFF,EOFF)
X	RETURN
X	END
END_OF_FILE
if test 2987 -ne `wc -c <'cirsub.f'`; then
    echo shar: \"'cirsub.f'\" unpacked with wrong size!
fi
# end of 'cirsub.f'
fi
if test -f 'ct1.dat' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'ct1.dat'\"
else
echo shar: Extracting \"'ct1.dat'\" \(877 characters\)
sed "s/^X//" >'ct1.dat' <<'END_OF_FILE'
X BRUTAG TEST DATA C ABCD                                               
X  4  0
XA     3  2  3  0.0000E+00
X  0.3000E+01  0.1500E+02  0.3200E+02
XB     3  2  3 -0.1000E+01
X  0.1300E+02  0.1600E+02  0.2100E+02
XC     3  2  3 -0.1000E+01
X  0.3000E+01  0.1300E+02  0.3400E+02
XD     2  2  2 -0.1000E+01
X  0.2200E+02  0.2800E+02
XA    B      6  0.7000E+01
X  0.3000E+01  0.3000E+01  0.7000E+01  0.9000E+01  0.1200E+02  0.1600E+02
XA    C      6  0.1500E+02
X  0.1000E+01  0.3000E+01  0.3000E+01  0.1300E+02  0.1500E+02  0.1500E+02
XA    D      5  0.7000E+01
X  0.3000E+01  0.7000E+01  0.8000E+01  0.1400E+02  0.1800E+02
XB    C      6  0.8000E+01
X  0.3000E+01  0.5000E+01  0.8000E+01  0.8000E+01  0.1300E+02  0.1300E+02
XB    D      5  0.4000E+01
X  0.4000E+01  0.5000E+01  0.1100E+02  0.1300E+02  0.1700E+02
XC    D      5  0.9000E+01
X  0.3000E+01  0.3000E+01  0.9000E+01  0.1000E+02  0.2500E+02
END_OF_FILE
if test 877 -ne `wc -c <'ct1.dat'`; then
    echo shar: \"'ct1.dat'\" unpacked with wrong size!
fi
# end of 'ct1.dat'
fi
if test -f 'ct1.res' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'ct1.res'\"
else
echo shar: Extracting \"'ct1.res'\" \(818 characters\)
sed "s/^X//" >'ct1.res' <<'END_OF_FILE'
X  BRUTAG TEST DATA C ABCD                                    
X 
X 
X 
X ERROR =   .0050  EFACT =  2.000
X      104  Digestions calculated in       3.71 sec
X 
X 
X A   
X A   32.000     B   15.000     C   3.0000     
X 
X B   
X A   21.000     B   16.000     C   13.000     
X 
X C   
X A   34.000     B   13.000     C   3.0000     
X 
X D   
X A   28.000     B   22.000     
X 
X T ERROR= .654E-07  D ERROR= .421E-07
X A      .00000     B      6.0000     C      19.000     D      10.000    
X A        1C1-------B-------1---------------A---------------1C1-------B
X B        ------2---------A---------2-------B--------2-----C|-----2----
X C        --A----------------3C-3-----B------3--------------|-A--------
X D        ---------4----------B----------4-------------A----|--------4-
X A      C B A 
X B      A B C 
X C      C B A 
X D      B A 
END_OF_FILE
if test 818 -ne `wc -c <'ct1.res'`; then
    echo shar: \"'ct1.res'\" unpacked with wrong size!
fi
# end of 'ct1.res'
fi
if test -f 'ct2.dat' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'ct2.dat'\"
else
echo shar: Extracting \"'ct2.dat'\" \(477 characters\)
sed "s/^X//" >'ct2.dat' <<'END_OF_FILE'
X  pGT55 glutathione-s-transferase 16-Jan-81
X  3  0
XBam1  3  1  3  0.3750E+00
X  0.3760E+01  0.1380E+01  0.4200E+00
XBgl2  1  1  1 -0.1000E+01
X  0.5550E+01
XPst1  4  1  4  0.3612E+01
X  0.4320E+01  0.4300E+00  0.3900E+00  0.3400E+00
XBam1 Bgl2   4  0.1400E+00
X  0.3760E+01  0.1380E+01  0.3000E+00  0.1400E+00
XBam1 Pst1   5  0.3240E+01
X  0.3240E+01  0.1080E+01  0.4300E+00  0.3900E+00  0.2800E+00
XBgl2 Pst1   5  0.1400E+00
X  0.4320E+01  0.4300E+00  0.3400E+00  0.2500E+00  0.1400E+00
END_OF_FILE
if test 477 -ne `wc -c <'ct2.dat'`; then
    echo shar: \"'ct2.dat'\" unpacked with wrong size!
fi
# end of 'ct2.dat'
fi
if test -f 'ct2.res' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'ct2.res'\"
else
echo shar: Extracting \"'ct2.res'\" \(3144 characters\)
sed "s/^X//" >'ct2.res' <<'END_OF_FILE'
X   pGT55 glutathione-s-transferase 16-Jan-81                 
X 
X 
X 
X ERROR =   .0200  EFACT =  2.000
X      936  Digestions calculated in      13.74 sec
X 
X 
X Bam1
X A   3.7600     B   1.3800     C   .42000     
X 
X Bgl2
X A   5.5500     
X 
X Pst1
X A   4.3200     B   .43000     C   .39000     D   .34000     
X 
X T ERROR= .425E-02  D ERROR= .437E-02
X Bam1   .37500     Bgl2   4.2668     Pst1   3.6120     
X Bam1     ---1----------------A----------------1-C1------B--|--1-------
X Bgl2     -------------A------------------------2-----------|----------
X Pst1     -------------A------------------3-B-3-C-3D-3------|----------
X Bam1   A C B 
X Bgl2   A 
X Pst1   B C D A 
X 
X T ERROR= .550E-02  D ERROR= .437E-02
X Bam1   .37500     Bgl2   4.4076     Pst1   3.6120     
X Bam1     ---1----------------A----------------1-C1------B--|--1-------
X Bgl2     --------------A------------------------2----------|----------
X Pst1     -------------A------------------3-B-3-C-3D-3------|----------
X Bam1   A C B 
X Bgl2   A 
X Pst1   B C D A 
X 
X T ERROR= .634E-02  D ERROR= .553E-02
X Bam1   .37500     Bgl2   4.2668     Pst1   3.6120     
X Bam1     ---1----------------A----------------1-C1------B--|--1-------
X Bgl2     -------------A------------------------2-----------|----------
X Pst1     -------------A------------------3-C-3-B-3D-3------|----------
X Bam1   A C B 
X Bgl2   A 
X Pst1   C B D A 
X 
X T ERROR= .721E-02  D ERROR= .553E-02
X Bam1   .37500     Bgl2   4.4076     Pst1   3.6120     
X Bam1     ---1----------------A----------------1-C1------B--|--1-------
X Bgl2     --------------A------------------------2----------|----------
X Pst1     -------------A------------------3-C-3-B-3D-3------|----------
X Bam1   A C B 
X Bgl2   A 
X Pst1   C B D A 
X 
X T ERROR= .737E-02  D ERROR= .103E-01
X Bam1   .37500     Bgl2   4.2668     Pst1   3.6120     
X Bam1     ---1----------------A----------------1-C1------B--|--1-------
X Bgl2     -------------A------------------------2-----------|----------
X Pst1     -------------A------------------3-D-3C-3-B-3------|----------
X Bam1   A C B 
X Bgl2   A 
X Pst1   D C B A 
X 
X T ERROR= .745E-02  D ERROR= .670E-02
X Bam1   .37500     Bgl2   4.2668     Pst1   3.6120     
X Bam1     ---1----------------A----------------1-C1------B--|--1-------
X Bgl2     -------------A------------------------2-----------|----------
X Pst1     -------------A------------------3-B-3-D3-C-3------|----------
X Bam1   A C B 
X Bgl2   A 
X Pst1   B D C A 
X 
X T ERROR= .761E-02  D ERROR= .910E-02
X Bam1   .37500     Bgl2   4.2668     Pst1   3.6120     
X Bam1     ---1----------------A----------------1-C1------B--|--1-------
X Bgl2     -------------A------------------------2-----------|----------
X Pst1     -------------A------------------3-D-3-B3-C-3------|----------
X Bam1   A C B 
X Bgl2   A 
X Pst1   D B C A 
X 
X T ERROR= .793E-02  D ERROR= .896E-02
X Bam1   .37500     Bgl2   4.2668     Pst1   3.6120     
X Bam1     ---1----------------A----------------1-C1------B--|--1-------
X Bgl2     -------------A------------------------2-----------|----------
X Pst1     -------------A------------------3-C-3-D3-B-3------|----------
X Bam1   A C B 
X Bgl2   A 
X Pst1   C D B A 
END_OF_FILE
if test 3144 -ne `wc -c <'ct2.res'`; then
    echo shar: \"'ct2.res'\" unpacked with wrong size!
fi
# end of 'ct2.res'
fi
if test -f 'diged.f' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'diged.f'\"
else
echo shar: Extracting \"'diged.f'\" \(13871 characters\)
sed "s/^X//" >'diged.f' <<'END_OF_FILE'
XC	DIGED.FOR	9-June-82
XC
XC	modified 23-May-82 for file editing, additions
XC
XC	INTERACTIVE GENERATION OF RESTRICTION DATA FILES
XC
XC	VARIBLES USED:
XC		NAME(NDIG)		ENZYME NAMES
XC		D1DAT (NDIG,NFRAG)	SINGLE DIGEST DATA
XC		N1F(NDIG)	NUMBER OF SINGLE DIGEST FRAGMENTS
XC		D2DAT (NDIG*(NDIG-1)/2,2*NFRAG) DOUBLE DIGEST DATA
XC		N2F(NDIG*(NDIG-1)/2)	# OF DOUBLE DIGEST FRAGMENTS
XC		XOFF(NDIG)	OFFSETS FOR CIRCULAR MOLECULES
XC		IBEG(NDIG)	BEGINNING OF UNKNOWN DATA
XC		IEND(NDIG)	END OF UNKNOWN DATA
XC		X2OFF(NDIG*(NDIG-1)/2)	DOUBLE DIG OFFSET FOR CIRCULAR MOL
XC
X 
X	CHARACTER*1 IQUIT
X	COMMON /IO/LRD,LWD,LSD0,LSD1
X	COMMON /EDSTAT/DATSAV
XC
X	CALL IOINIT
X	WRITE(LWD,5)
X    5	FORMAT(' Data files for restriction mapping 3-Jun-82,84')
X   10	WRITE(LWD,15)
X   15	FORMAT(' 1-New data; 2-Load old data; 3-Add; 4-Edit'/
X     1	' 5-Reorder enzymes; 6-Save data; 7-Done  ? '$)
X	READ(LRD,25) ICHOICE
X   25	FORMAT(I1)
X	GOTO (100,200,300,400,500,600,700),ICHOICE
X	GOTO 10
X  100	CALL INIDAT
X	CALL TYPDAT
X	GOTO 10
X  200	CALL INIDAT
X	CALL GETDAT
X	GOTO 10
X  300	CALL TYPDAT
X	GOTO 10
X  400	CALL EDTDAT
X	GOTO 10
X  500	CALL ORDDAT
X	GOTO 10
X  600	CALL SAVDAT
X	GOTO 10
X  700	IF (DATSAV.EQ.0) STOP
X	WRITE(LWD,710)
X  710	FORMAT(' Abandon modified data? '$)
X	READ(LRD,715) IQUIT
X  715	FORMAT(A1)
X	IF (IQUIT.EQ.'Y'.OR.IQUIT.EQ.'y') STOP
X	GOTO 10
X
X	END
X
XC
XC
X	INTEGER FUNCTION MMAP(I,J,N)
X	IS=I
X	JS=J
X	IF (IS.LE.JS) GOTO 10
X	K=IS
X	IS=JS
X	JS=K
X   10	MMAP=((js-1)*(Js-2))/2 + Is
X	RETURN
X	END
X
X	SUBROUTINE IOINIT
X	COMMON /MAXCOM/MAXDIG,MAXFRG
X	COMMON /IO/LRD,LWD,LSD0,LSD1
XC	DATA MAXDIG,MAXFRG/10,20/
XC	DATA LRD,LWD,LSD0,LSD1/5,6,20,21/
X	
X	MAXDIG = 10
X	MAXFRG = 20
X	LRD = 5
X	LWD = 6
X	LSD0 = 11
X	LSD1 = 12
X
X	END
XC
XC
XC	TYPDAT.FOR	23-May-82
XC	subroutine for entering restriction digest data from keyboard
XC
X	SUBROUTINE TYPDAT
X	CHARACTER*4 NAME
X	CHARACTER*60 TITLE
X      COMMON /DDATA/NDIG,ITOPOL,N1F(10),N2F(45),D1DAT(10,20)
X     1 ,D2DAT(45,40),XL1(10),XL2(45)
X	COMMON /IDATA/IBEG(10),IEND(10),XOFF(10),X2OFF(45),XORG
X	COMMON /DNAME/NAME(10),TITLE
X	COMMON /MAXCOM/MAXDIG,MAXFRG
X	COMMON /EDSTAT/DATSAV
X	COMMON /IO/LRD,LWD,LSD0,LSD1
X	LOGICAL LFIX
XC
X	IF (ITOPOL.GE.0) GOTO 18
X	WRITE(LWD,10)
X   10	FORMAT(' 0-circle, 1-linear: '$)
X	READ(LRD,15) ITOPOL
X   15	FORMAT(I1)
X	IF (ITOPOL.NE.1) ITOPOL=0
X   18	NDD=MAXDIG-NDIG
X	WRITE(LWD,20) NDD
X   20	FORMAT(' Type up to ',I3,' enzyme names, 4 chars/name 1/line'/
X     1' end with blank line.')
XC
XC
X	NDIG0=NDIG
X	I=NDIG+1
X   30	WRITE(LWD,32) I
X   32	FORMAT(1X,I2,': '$)
X	READ(LRD,35) NAME(I)
X   35	FORMAT(A4)
X	IF (NAME(I).EQ.' ') GOTO 50
X	I=I+1
X	IF (I.LE.MAXDIG) GOTO 30
X	I=MAXDIG+1
X   50	NDIG=I-1
XC
XC
X	WRITE(LWD,55)
X   55	FORMAT(' single digest fragment lengths for each enzyme')
X	DO 80 I=NDIG0+1,NDIG
X	WRITE(LWD,60) NAME(I)
X   60	FORMAT(1X,A4,': '$)
X	READ(LRD,*) (D1DAT(I,J),J=1,MAXFRG)
XC   65	FORMAT(20F)
X	DO 70 J=1,MAXFRG
X   70	IF (D1DAT(I,J).EQ.0.0) GOTO 75
X	J=J+1
X   75	N1F(I)=J-1
X   80	CONTINUE
XC
XC
X	IF (ITOPOL.EQ.1) GOTO 150
XC
XC	GET THE XOFF, IBEG, IEND FOR CIRCULAR MOLECULES
XC
X   85	WRITE(LWD,90)
X   90	FORMAT(' XOFF (-1. = UNKNOWN), IBEG, IEND of unknown region')
X	DO 130 I=NDIG0+1,NDIG
X	WRITE(LWD,60) NAME(I)
X	READ(LRD,*) XOFF(I),IBEG(I),IEND(I)
XC 100	FORMAT(G,2I)
X  130	CONTINUE
XC	IF (I.EQ.1 .AND. XOFF(I).LT.0.0) XOFF(1)=0.0
XC	IF (XOFF(I).EQ.0.0 .AND. I.EQ.1 .AND.IBEG(I).EQ.0) IBEG(I)=2
X	LFIX=(.FALSE.)
X	DO 140 I=2,NDIG
X	IF (XOFF(I).LT.0.0 .AND. IBEG(I).EQ.0) IBEG(I)=2
X	LFIX= (XOFF(I).GE.0.0 .AND. IBEG(I).EQ.0)
X	IF (LFIX) IBEG(I)=1
X	IF (IEND(I).EQ.0) IEND(I)=N1F(I)
X	IF (IBEG(I).GT.IEND(I)) IBEG(I)=IEND(I)
X140	CONTINUE
X	IF (.NOT.LFIX.OR.(LFIX.AND.XOFF(1).GE.0.0)) GOTO 145
X	WRITE(LWD,142)
X142	FORMAT(' The first digest offset must be known to set'/
X     1  ' later digest offsets')
X	GOTO 85
X  145	IF (XOFF(1).LT.0.0) XOFF(1)=0.0
X	IF (IBEG(1).GT.0) GOTO 147
X	IBEG(1)=2
X	IF (LFIX) IBEG(1)=1
X  147	IF (IEND(1).LE.0) IEND(1)=N1F(1)
X	GOTO 200
X  150	WRITE(LWD,155)
X  155	FORMAT(' IBEG, IEND of unknown region')
X	DO 180 I=NDIG0+1,NDIG
X	WRITE(LWD,60) NAME(I)
X	READ(LRD,*) IBEG(I),IEND(I)
X  160	FORMAT(2I3)
X	IF (IBEG(I).EQ.0) IBEG(I)=1
X	IF (IEND(I).EQ.0) IEND(I)=N1F(I)
X  180	CONTINUE
X	DO 190 I=NDIG0+1,NDIG
X  190	XOFF(I)=0.0
XC
XC	GET DOUBLE DIGEST DATA
XC
X  200	WRITE(LWD,210)
X  210	FORMAT(' Enter double digest fragment lengths')
X	IF (ITOPOL.EQ.0) WRITE(LWD,212)
X  212	FORMAT(' then double digest created fragment on new line')
X	DO 300 I1=1,NDIG-1
X	DO 300 I2=I1+1,NDIG
X	IMM=MMAP(I1,I2,NDIG)
X	IF (N2F(IMM).GE.0) GOTO 300
X	WRITE(LWD,215) NAME(I1),NAME(I2)
X  215	FORMAT(1X,A4,1X,A4,': '$)
X	READ(LRD,*) (D2DAT(IMM,J),J=1,2*MAXFRG)
XC 220	FORMAT(40F)
X	X2OFF(IMM)=0.0
X	IF (ITOPOL.NE.0) GOTO 250
X	WRITE(LWD,225) NAME(I1),NAME(I2)
X  225	FORMAT(1X,A4,1X,A4,': new frag	'$)
X	READ(LRD,*) X2OFF(IMM)
XC 230	FORMAT(1F)
X  250	DO 260 J=1,2*MAXFRG
X  260	IF (D2DAT(IMM,J).LE.0.0) GOTO 270
X	J=J+1
X  270	N2F(IMM)=J-1
X  300	CONTINUE
X	DATSAV=1
X	RETURN
X	END
XC
XC
XC
X	SUBROUTINE SAVDAT
X	CHARACTER*20 FILNAM
X	CHARACTER*4 NAME
X	CHARACTER*60 TITLE
X      COMMON /DDATA/NDIG,ITOPOL,N1F(10),N2F(45),D1DAT(10,20)
X     1 ,D2DAT(45,40),XL1(10),XL2(45)
X	COMMON /IDATA/IBEG(10),IEND(10),XOFF(10),X2OFF(45),XORG
X	COMMON /DNAME/NAME(10),TITLE
X	COMMON /MAXCOM/MAXDIG,MAXFRG
X	COMMON /ORDCOM/IDORD(10)
X	COMMON /EDSTAT/DATSAV
X	COMMON /IO/LRD,LWD,LSD0,LSD1
XC
XC	ALL THE DATA IN, WRITE IT OUT
XC
X	WRITE(LWD,310)
X  310	FORMAT(/' File name for saving data: '$)
X	READ(LRD,315) FILNAM
X  315	FORMAT(A20)
X	OPEN(LSD1,FILE=FILNAM,STATUS='NEW')
X	WRITE(LWD,320)
X  320	FORMAT(' Descriptive title line: ')
X	READ(LRD,325) TITLE
X  325	FORMAT(A)
X	WRITE(LSD1,327) TITLE
X  327	FORMAT(1X,A)
X	WRITE(LSD1,330) NDIG, ITOPOL
X  330	FORMAT(2I3)
X	DO 400 I=1,NDIG
X	II=IDORD(I)
X	WRITE(LSD1,340) NAME(II),N1F(II),IBEG(II),IEND(II),XOFF(II)
X  340	FORMAT(A4,I3,2I3,E12.4)
X	WRITE(LSD1,350) (D1DAT(II,J),J=1,N1F(II))
X  350	FORMAT(10E12.4)
X  400	CONTINUE
X	DO 450 I1=1,NDIG-1
X	DO 450 I2=I1+1,NDIG
X	II1=IDORD(I1)
X	II2=IDORD(I2)
X	IMM=MMAP(II1,II2,NDIG)
X	WRITE(LSD1,410) NAME(II1),NAME(II2),N2F(IMM),X2OFF(IMM)
X  410	FORMAT(2(A4,1X),I3,E12.4)
X	IF (N2F(IMM).GT.0) WRITE(LSD1,420) (D2DAT(IMM,J),J=1,N2F(IMM))
X  420	FORMAT(10E12.4)
X  450	CONTINUE
XC
XC	ALL DONE
XC
X	CLOSE (LSD1)
X	DATSAV=0
X	RETURN
X	END
XC
XC
X	SUBROUTINE INIDAT
X	CHARACTER*4 NAME
X	CHARACTER*60 TITLE
X      COMMON /DDATA/NDIG,ITOPOL,N1F(10),N2F(45),D1DAT(10,20)
X     1 ,D2DAT(45,40),XL1(10),XL2(45)
X	COMMON /IDATA/IB(10),IT(10),XCOFF(10),XDOFF(45),XORG
X	COMMON /DNAME/NAME(10),TITLE
X	COMMON /EDSTAT/DATSAV
X	COMMON /MAXCOM/MAXDIG,MAXFRG
X	COMMON /ORDCOM/IDORD(10)
XC
XC	initialize data arrays
XC
X	DO 20 I=1,MAXDIG
X	N1F(I)=-1
X	DO 20 J=1,MAXFRG
X   20	D1DAT(I,J)=0.0
XC
XC
X	MDD=(MAXDIG*(MAXDIG-1))/2
X	DO 40 I=1,MDD
X	N2F(I)=-1
X	XDOFF(I)=-1.0
X	DO 40 J=1,2*MAXFRG
X   40	D2DAT(I,J)=0.0
XC
XC
X	DO 60 I=1,MAXDIG
X   60	IDORD(I)=I
XC
XC
X	NDIG=0
X	ITOPOL=-1
X	DATSAV=0
XC
X	RETURN
X	END
XC
XC
XC
XC
X	SUBROUTINE ORDDAT
X	CHARACTER*1 ICH
X	CHARACTER*4 NAME
X	CHARACTER*60 TITLE
X      COMMON /DDATA/NDIG,ITOPOL,N1F(10),N2F(45),D1DAT(10,20)
X     1 ,D2DAT(45,40),XL1(10),XL2(45)
X	COMMON /IDATA/IB(10),IT(10),XCOFF(10),XDOFF(45),XORG
X	COMMON /DNAME/NAME(10),TITLE
X	COMMON /EDSTAT/DATSAV
X	COMMON /MAXCOM/MAXDIG,MAXFRG
X	COMMON /ORDCOM/IDORD(10)
X	COMMON /IO/LRD,LWD,LSD0,LSD1
XC
XC
X	WRITE(LWD,10)
X   10	FORMAT(' The order of digests is:'/)
X	WRITE(LWD,20) (I,NAME(I),I=1,NDIG)
X   20	FORMAT(5(1X,I3,': ',A4,1X))
X	WRITE(LWD,30)
X   30	FORMAT('0Enter the enzyme numbers in the desired new order')
X	READ(LRD,*) (IDORD(I),I=1,NDIG)
XC  40	FORMAT(10I)
X	DO 45 I=1,NDIG
X	IF (IDORD(I).EQ.0) IDORD(I)=I
X   45	CONTINUE
X	IF (IDORD(1).EQ.1.OR.XCOFF(IDORD(1)).GE.0.0) GOTO 55
X	LFIX=0
X	DO 48 I=2,NDIG
X   48	IF (XCOFF(I).GE.0.0) LFIX=I
X	IF (LFIX.EQ.0.AND.XCOFF(1).LE.0.0) GOTO 55
X	WRITE(LWD,49) NAME(IDORD(1))
X   49	FORMAT(1X,A4,' cannot be first digest - unknown offset'/)
X	GOTO 100
X   55	WRITE(LWD,50)
X   50	FORMAT('0 The new order is :'/)
X	WRITE(LWD,20) (I,NAME(IDORD(I)),I=1,NDIG)
X	WRITE(LWD,60)
X   60	FORMAT(' Is that correct? (Y/N) ')
X	READ(LRD,65) ICH
X   65	FORMAT(A1)
X	IF (ICH.NE.'Y'.AND.ICH.NE.'y') GOTO 100
X	IF (.NOT.(XCOFF(1).EQ.0.0 .AND. XCOFF(IDORD(1)).LT.0.0)) GOTO 90
X	XCOFF(1)=-1.0
X	XCOFF(IDORD(1))=0.0
X   90	CALL SAVDAT
X	RETURN
X  100	DO 110 I=1,NDIG
X  110	IDORD(I)=I
X	RETURN
X	END
XC
XC
XC
X	SUBROUTINE GETDAT
X	CHARACTER*1 ICH
X	CHARACTER*20 FILNAM
X	CHARACTER*4 NAME,NAM1,NAM2
X	CHARACTER*60 TITLE
X      COMMON /DDATA/ND,MOLTYP,N1F(10),N2F(45),D1DAT(10,20),D2DAT(45,40)
X     1,XL1(10),XL2(45)
X	COMMON /IDATA/IB(10),IT(10),XCOFF(10),XDOFF(45),XORG
X	COMMON /DNAME/NAME(10),TITLE
X	COMMON /MAXCOM/MXD,MXF
X	COMMON /EDSTAT/DATSAV
X	COMMON /IO/LRD,LWD,LSD0,LSD1
XC
XC	MXD	MAXIMUM ENZYMES
XC	MXF	MAXIMUM FRAGMENTS
XC
XC	ND	NUMBER OF ENZYMES
XC	N1F	NUMBER OF FRAG/END
XC	N2F	NUMBER OF FRAG/DOUBLE DIG
XC	D1DAT	SINGLE DIGEST LENGTHS
XC	D2DAT	DOUBLE DIGEST LENGTHS
XC
XC
XC	GET THE DATA
XC
X	IF (DATSAV.EQ.0) GOTO 4
X	WRITE(LWD,2)
X    2	FORMAT(' Abandon unsaved data? ')
X	READ(LRD,3) ICH
X    3	FORMAT(A1)
X	IF (ICH.EQ.'Y'.OR.ICH.EQ.'y') GOTO 4
X	RETURN
X    4	WRITE(LWD,5)
X    5	FORMAT(' Old digest data file name: ')
X	READ(LRD,7) FILNAM
X    7	FORMAT(A)
X	OPEN(LSD0,FILE=FILNAM)
XC
XC
X	READ(LSD0,10) TITLE
X   10	FORMAT(A)
X	WRITE(LWD,10) TITLE
X	READ(LSD0,15) ND, MOLTYP
X   15	FORMAT(2I3)
X	write(lwd,*) nd,moltyp
X	IDEFST=2-MOLTYP
X	IF (ND.GT.MXD) GOTO 200
X	DO 50 ID=1,ND
X	READ(LSD0,20) NAME(ID),N1F(ID),IB(ID),IT(ID),XCOFF(ID)
X   20	FORMAT(A4,3I3,E12.4)
X	write(lwd,*) NAME(ID),N1F(ID),IB(ID),IT(ID),XCOFF(ID)
X	IF (ID.GT.1 .AND. XCOFF(ID).GE. 0.0 .AND. IB(ID).LE.0)
X     1	IB(ID)=1
X	IF (IB(ID).GT.0) GOTO 22
X	IB(ID)=IDEFST
X   22	IF (IT(ID).GT.0) GOTO 25
X	IT(ID)=N1F(ID)
X   25	IF(IB(ID).GT.IT(ID)) IB(ID)=IT(ID)
X	IF (N1F(ID).GT.MXF) GOTO 210
X	READ(LSD0,30) (D1DAT(ID,J),J=1,N1F(ID))
X   30	FORMAT(10E12.4)
X	write(lwd,*) (D1DAT(ID,J),J=1,N1F(ID))
X   50	CONTINUE
XC
XC	GET THE DOUBLE DIGESTS
XC
X	IC=0
X	DO 80 ID=1,ND-1
X	DO 80 JD=ID+1,ND
X	IC=MMAP(id,jd,nd)
X	READ(LSD0,60) NAM1,NAM2,N2F(IC),XDOFF(IC)
X   60	FORMAT(2(A4,1X),I3,E12.4)
X	write(lwd,*) NAM1,NAM2,N2F(IC),XDOFF(IC)
X	IF ((NAM1.EQ.NAME(ID)).AND.(NAM2.EQ.NAME(JD))) GOTO 70
X	IF ((NAM1.EQ.NAME(JD)).AND.(NAM2.EQ.NAME(ID))) GOTO 70
X	GOTO 220
X   70	IF ((XDOFF(IC).EQ.0.0).AND.(N2F(IC).EQ.(N1F(ID)+N1F(JD))))
X     1 GOTO 230
X	IF (N2F(IC).EQ.0) GOTO 80
X	READ(LSD0,30) (D2DAT(IC,K),K=1,N2F(IC))
X   80	CONTINUE
X	RETURN
XC
XC
X  200	WRITE(LWD,205) ND,MXD
X  205	FORMAT(' number of enzymes ',I2,' greater than ',I2//)
X	GOTO 250
X  210	WRITE(LWD,215) N1F(ID),MXF
X  215	FORMAT(' number of fragments ',I2,' greater than ',I2//)
X	GOTO 250
X  220	WRITE(LWD,225) NAM1,NAM2,NAME(ID),NAME(JD)
X  225	FORMAT(' found enzymes ',2(1X,A4),', expecting ',2(1X,A4)//)
X  230	WRITE(LWD,235) NAME(ID),NAME(JD)
X  235	FORMAT(' found digest offset of zero with on offset'
X     1 ' circular molecule',2(1X,A4)//)
X	GOTO 250
X  240	WRITE(LWD,245) FILNAM
X  245	FORMAT(' File : ',A20,' not found.')
X	RETURN
X  250	CONTINUE
X	CALL INIDAT
X	RETURN
X	END
XC
XC
X	SUBROUTINE EDTDAT
X	CHARACTER*4 NAME
X	CHARACTER*60 TITLE
X      COMMON /DDATA/NDIG,ITOPOL,N1F(10),N2F(45),D1DAT(10,20)
X     1 ,D2DAT(45,40),XL1(10),XL2(45)
X	COMMON /IDATA/IB(10),IT(10),XCOFF(10),XDOFF(45),XORG
X	COMMON /DNAME/NAME(10),TITLE
X	COMMON /EDSTAT/DATSAV
X	COMMON /MAXCOM/MAXDIG,MAXFRG
X	COMMON /IO/LRD,LWD,LSD0,LSD1
XC
XC
X   10	WRITE(LWD,15)
X   15	FORMAT(' Data editing: 1-Single 2-Double digest data? '$)
X	READ(LRD,20) ICH
X   20	FORMAT(I1)
X	GOTO (200,400),ICH
X	RETURN
X  200	WRITE(LWD,210)
X  210	FORMAT(' Enzymes are:')
X	WRITE(LWD,220) (I,NAME(I),I=1,NDIG)
X  220	FORMAT(5(1X,I3,':',A4)/)
X	WRITE(LWD,230)
X  230	FORMAT(' digest number to be edited (0 to quit)?  '$)
X	READ(LRD,20) IDIG
X	IF (IDIG.EQ.0) GOTO 10
X	WRITE(LWD,240) NAME(IDIG),N1F(IDIG)
X  240 FORMAT(1X,A4,' has ',I2,' fragments.  Edit 1-DATA, 2-PARAMS? '$)
X	READ(LRD,20) ICH
X	IF (ICH.EQ.2) GOTO 350
X  250	WRITE(LWD,255)
X  255	FORMAT(' To change fragment length, enter new value.'/
X     1' Blank entry keeps value the same.  New fragments may be added'/
X     2	' at the end of the list')
X	IF=0.0
X  260	IF=IF+1
X	IF (IF.GT.N1F(IDIG)) GOTO 300
X	XDAT=0.0
X	WRITE(LWD,265) IF,D1DAT(IDIG,IF)
X  265	FORMAT(1X,I3,':',G12.4,' ? '$)
X	READ(LRD,270) XDAT
X  270	FORMAT(F10.4)
X	IF (XDAT.EQ.0.0) GOTO 260
X	D1DAT(IDIG,IF)=XDAT
X	DATSAV=1
X	GOTO 260
X  300	XDAT=0.0
X	WRITE(LWD,305) IF
X  305	FORMAT(1X,I3,':             ?'$)
X	READ(LRD,270) XDAT
X	IF (XDAT.EQ.0.0) GOTO 200
X	D1DAT(IDIG,IF)=XDAT
X	DATSAV=1
X	IF (IF.GT.N1F(IDIG)) N1F(IDIG)=IF
X	IF=IF+1
X	GOTO 300
X  350	DATSAV=1
X	IF (ITOPOL.EQ.1) GOTO 370
X	WRITE(LWD,355) NAME(IDIG),XCOFF(IDIG),IB(IDIG),IT(IDIG)
X  355 FORMAT(1X,A4,' known coordinate:',G12.4,' first unknown fragment:'
X     1,I3,' last:',I3,/' new values: '$)
X	READ(LRD,*) XXC,IBN,ITN
XC 360	FORMAT(F,2I)
X	XCOFF(IDIG)=XXC
X	IF (IBN.GT.0) IB(IDIG)=IBN
X	IF (ITN.GT.0) IT(IDIG)=ITN
X	GOTO 200
X  370	WRITE(LWD,375) NAME(IDIG),IB(IDIG),IT(IDIG)
X  375	FORMAT(1X,A4,' first unknown fragment:',I3,' last:',I3,
X     1/' new values '$)
X	READ(LRD,*) IBN,ITN
X  380	FORMAT(2I3)
X	IF (IBN.GT.0) IB(IDIG)=IBN
X	IF (ITN.GT.0) IT(IDIG)=ITN
X	GOTO 200
XC
XC	here for double digest data
XC
X  400	WRITE(LWD,410)
X  410	FORMAT(' Enzymes are:')
X  	WRITE(LWD,420) (I,NAME(I),I=1,NDIG)
X  420	FORMAT(5(1X,I3,':',A4)/)
X	WRITE(LWD,425)
X  425	FORMAT(' Enter a pair of digest numbers (0 to quit) : '$)
X	READ(LRD,*) I1,I2
X  430	FORMAT(2I3)
X	IF (I1.EQ.0 .OR. I2.EQ.0) GOTO 10
X	I2DIG=MMAP(I1,I2,NDIG)
X	NN=N1F(I1)+N1F(I2)-ITOPOL
X	WRITE(LWD,435) NAME(I1),NAME(I2),N2F(I2DIG),NN
X  435	FORMAT(1X,A4,' vs ',A4,2X,I3,' fragments found',I3,' expected')
X	WRITE(LWD,255)
X	IF=0
X  440	IF=IF+1
X	IF (IF.GT.N2F(I2DIG)) GOTO 450
X	XDAT=0.0
X	WRITE(LWD,265) IF,D2DAT(I2DIG,IF)
X	READ(LRD,270) XDAT
X	IF (XDAT.EQ.0.0) GOTO 440
X	D2DAT(I2DIG,IF)=XDAT
X	DATSAV=1
X	GOTO 440
X  450	IF (IF.GT.NN) GOTO 500
X	XDAT=0.0
X	WRITE(LWD,305) IF
X	READ(LRD,270) XDAT
X	IF (XDAT.EQ.0.0) GOTO 400
X	D2DAT(I2DIG,IF)=XDAT
X	DATSAV=1
X	IF (IF.GT.N2F(I2DIG)) N2F(I2DIG)=IF
X	IF=IF+1
X	GOTO 450
X  500	IF (ITOPOL.EQ.1) GOTO 400
X	WRITE(LWD,505) XDOFF(I2DIG)
X  505	FORMAT(' New fragment is: ',G12.4,'  new value? '$)
X	READ(LRD,270) XDAT
X	IF (XDAT.GT.0.0) XDOFF(I2DIG)=XDAT
X	GOTO 400
X	END
END_OF_FILE
if test 13871 -ne `wc -c <'diged.f'`; then
    echo shar: \"'diged.f'\" unpacked with wrong size!
fi
# end of 'diged.f'
fi
if test -f 'linsub.f' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'linsub.f'\"
else
echo shar: Extracting \"'linsub.f'\" \(1670 characters\)
sed "s/^X//" >'linsub.f' <<'END_OF_FILE'
XC	NDGLIN.FOR	29-JAN-80
XC
XC	COPYRIGHT (C) 1981 WILLIAM R. PEARSON
XC
XC
XC	DIGESTS TWO RESTRICTION FRAGMENTS TO GIVE SYNDIG
XC
XC	FIRST FINDS START OF MOLECULE, THEN MERGES TWO MOLECULES
XC
X	SUBROUTINE DIGEST(ID,JD,XOFF,SYNDIG)
X	DIMENSION SYNDIG(1)
X      COMMON /DDATA/ND,N1F(10),N2F(45),D1DAT(10,20),D2DAT(45,40),XL1(10)
X     1, XL2(45)
XC
XC	ZERO THE SYNTHETIC ARRAY
XC
X	NI=N1F(ID)
X	NJ=N1F(JD)
X	DO 10 I=1,NI+NJ
X   10	SYNDIG(I)=0.0
XC
XC	NOW MERGE
XC
X	I=1
X	J=0
X	K=0
X	POS0=0.0
X	POS1=D1DAT(ID,I)
X	POS2=XOFF
X	IF (I.GE.NI) GOTO 75
X   60	K=K+1
X	IF (POS1.LE.POS2) GOTO 70
X	SYNDIG(K)=POS2-POS0
X	POS0=POS2
X	J=J+1
XC
XC	.GE. HERE BECAUSE STARTS AT 0
XC
X	IF (J.GE.NJ) GOTO 65
X	POS2=POS2+D1DAT(JD,J)
X	GOTO 60
XC
XC	DONE WITH DIG2, FILL WITH DIG1
XC
X   65	IF (I.GE.NI) GOTO 80
X	K=K+1
X	SYNDIG(K)=POS1-POS0
X	POS0=POS1
X	I=I+1
X	POS1=POS1+D1DAT(ID,I)
X	GOTO 65
X   70	SYNDIG(K)=POS1-POS0
X	POS0=POS1
X	I=I+1
X	IF (I.GE.NI) GOTO 75
X	POS1=POS1+D1DAT(ID,I)
X	GOTO 60
XC
XC	FILL IN WITH DIG2
XC
X   75	IF (J.GE.NJ) GOTO 80
X	K=K+1
X	SYNDIG(K)=POS2-POS0
X	POS0=POS2
X	J=J+1
X	POS2=POS2+D1DAT(JD,J)
X	GOTO 75
XC
XC	ALL DONE, GET FRAG FROM END CUTS
XC
X   80	K=K+1
X	SYNDIG(K)=PFRACT(1.0-POS0)
X	RETURN
X	END
X
XC	LNFIND	29-JAN-80
XC
XC	COPYRIGHT (C) 1981 WILLIAM R. PEARSON
XC
XC
XC	GIVEN TWO PERMUTATIONS OF FRAGMENTS, ROTATES THE
XC	FRAGMENTS TO FIND A SOLUTION
XC
X	SUBROUTINE FIND(ID,JD,NOFF,XOFF,EOFF,ERR)
X	DIMENSION XOFF(1),EOFF(1)
X	DIMENSION SYNDIG(40)
X      COMMON /DDATA/ND,N1F(10),N2F(45),D1DAT(10,20),D2DAT(45,40),XL1(10)
X     1, XL2(45)
XC
XC
X	NI=N1F(ID)
X	NJ=N1F(JD)
X	KD=MMAP(ID,JD,ND)
XC
X	X3OFF=0.0
X	CALL DIGEST(ID,JD,X3OFF,SYNDIG)
X	EVOFF=ERROR(KD,SYNDIG,NI+NJ)
X	IF (EVOFF.LE.ERR) CALL SAVOFF(X3OFF,NOFF,XOFF,EVOFF,EOFF)
X	RETURN
X	END
END_OF_FILE
if test 1670 -ne `wc -c <'linsub.f'`; then
    echo shar: \"'linsub.f'\" unpacked with wrong size!
fi
# end of 'linsub.f'
fi
if test -f 'lt.out' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'lt.out'\"
else
echo shar: Extracting \"'lt.out'\" \(3195 characters\)
sed "s/^X//" >'lt.out' <<'END_OF_FILE'
X  Brutlag test linear ABCD                                   
X
X
X
X ERROR =  0.0500  EFACT =  2.000
X    87288  Digestions calculated in      0 sec
X
X
X A   
X A   16.000     B   16.000     C   15.000     D   3.0000    
X
X B   
X A   21.000     B   13.000     C   9.0000     D   7.0000    
X
X C   
X A   34.000     B   12.000     C   3.0000     D   1.0000    
X
X D   
X A   26.000     B   22.000     C   2.0000    
X
X T ERROR=0.113E-07  D ERROR=0.852E-08
X A        1-------A-------1------C-------1D-1-------B-------1
X B        2--D---2---------A----------2-----B------2---C----2
X C        3-----B-----3C3-----------------A----------------D3
X D        4C4----------B----------4------------A------------4
X A      A C D B
X B      D A B C
X C      B C A D
X D      C B A
X
X T ERROR=0.159E-07  D ERROR=0.150E-07
X A        1-------A-------1D-1------C-------1-------B-------1
X B        2---C----2-----B------2---------A----------2--D---2
X C        D3----------------A----------------3C-3-----B-----D
X D        4------------A------------4----------B----------C-4
X A      A D C B
X B      C B A D
X C      D A C B
X D      A B C
X
X T ERROR=0.356E-02  D ERROR=0.713E-02
X A        1D-1-------A-------1------C-------1-------B-------1
X B        2---C----2-----B------2---------A----------2--D---2
X C        D3----------------A----------------3C-3-----B-----D
X D        4------------A------------4----------B----------C-4
X A      D A C B
X B      C B A D
X C      D A C B
X D      A B C
X
X T ERROR=0.356E-02  D ERROR=0.713E-02
X A        1D-1-------A-------1------C-------1-------B-------1
X B        2---C----2-----B------2---------A----------2--D---2
X C        D3----------------A----------------3C-3-----B-----D
X D        4------------A------------4----------B----------C-4
X A      D A C B
X B      C B A D
X C      D A C B
X D      A B C
X
X T ERROR=0.512E-02  D ERROR=0.876E-08
X A        1-------A-------1------C-------1D-1-------B-------1
X B        2--D---2---------A----------2-----B------2---C----2
X C        3C-3-----B----3-----------------A----------------D3
X D        4C4----------B----------4------------A------------4
X A      A C D B
X B      D A B C
X C      C B A D
X D      C B A
X
X T ERROR=0.512E-02  D ERROR=0.150E-07
X A        1-------A-------1D-1------C-------1-------B-------1
X B        2---C----2-----B------2---------A----------2--D---2
X C        D3----------------A----------------3-----B-----3C-D
X D        4------------A------------4----------B----------C-4
X A      A D C B
X B      C B A D
X C      D A B C
X D      A B C
X
X T ERROR=0.535E-02  D ERROR=0.713E-02
X A        1D-1-------A-------1------C-------1-------B-------1
X B        2-----B------2---C----2---------A----------2--D---2
X C        D3----------------A----------------3C-3-----B-----D
X D        4------------A------------4----------B----------C-4
X A      D A C B
X B      B C A D
X C      D A C B
X D      A B C
X
X T ERROR=0.535E-02  D ERROR=0.713E-02
X A        1D-1-------A-------1------C-------1-------B-------1
X B        2-----B------2---C----2---------A----------2--D---2
X C        D3----------------A----------------3C-3-----B-----D
X D        4------------A------------4----------B----------C-4
X A      D A C B
X B      B C A D
X C      D A C B
X D      A B C
END_OF_FILE
if test 3195 -ne `wc -c <'lt.out'`; then
    echo shar: \"'lt.out'\" unpacked with wrong size!
fi
# end of 'lt.out'
fi
if test -f 'lt1.dat' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'lt1.dat'\"
else
echo shar: Extracting \"'lt1.dat'\" \(951 characters\)
sed "s/^X//" >'lt1.dat' <<'END_OF_FILE'
X Brutlag test linear ABCD
X  4  1
XA     4  1  4  0.0000E+00
X  0.3000E+01  0.1500E+02  0.1600E+02  0.1600E+02
XB     4  1  4  0.0000E+00
X  0.7000E+01  0.9000E+01  0.1300E+02  0.2100E+02
XC     4  1  4  0.0000E+00
X  0.1000E+01  0.3000E+01  0.1200E+02  0.3400E+02
XD     3  1  3  0.0000E+00
X  0.2000E+01  0.2200E+02  0.2600E+02
XA    B      7  0.0000E+00
X  0.3000E+01  0.3000E+01  0.7000E+01  0.7000E+01  0.9000E+01  0.9000E+01  0.1200E+02
XA    C      7  0.0000E+00
X  0.1000E+01  0.1000E+01  0.3000E+01  0.3000E+01  0.1200E+02  0.1500E+02  0.1500E+02
XA    D      6  0.0000E+00
X  0.2000E+01  0.3000E+01  0.7000E+01  0.8000E+01  0.1400E+02  0.1600E+02
XB    C      7  0.0000E+00
X  0.1000E+01  0.3000E+01  0.5000E+01  0.7000E+01  0.8000E+01  0.1300E+02  0.1300E+02
XB    D      6  0.0000E+00
X  0.2000E+01  0.4000E+01  0.5000E+01  0.9000E+01  0.1300E+02  0.1700E+02
XC    D      6  0.0000E+00
X  0.1000E+01  0.2000E+01  0.3000E+01  0.9000E+01  0.1000E+02  0.2500E+02
END_OF_FILE
if test 951 -ne `wc -c <'lt1.dat'`; then
    echo shar: \"'lt1.dat'\" unpacked with wrong size!
fi
# end of 'lt1.dat'
fi
if test -f 'lt1.res' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'lt1.res'\"
else
echo shar: Extracting \"'lt1.res'\" \(1835 characters\)
sed "s/^X//" >'lt1.res' <<'END_OF_FILE'
X  Brutlag test linear ABCD                                   
X 
X 
X 
X ERROR =   .0100  EFACT =  2.000
X      376  Digestions calculated in       5.66 sec
X 
X 
X A   
X A   16.000     B   16.000     C   15.000     D   3.0000     
X 
X B   
X A   21.000     B   13.000     C   9.0000     D   7.0000     
X 
X C   
X A   34.000     B   12.000     C   3.0000     D   1.0000     
X 
X D   
X A   26.000     B   22.000     C   2.0000     
X 
X T ERROR= .113E-07  D ERROR= .852E-08
X A        1------A-------1-------C-------1D-1-------B-------1
X B        2--D---2---------A----------2-----B-----2----C----2
X C        3----B-----3-C3----------------A-----------------D3
X D        C4----------B----------4-------------A------------C
X A      A C D B 
X B      D A B C 
X C      B C A D 
X D      C B A 
X 
X T ERROR= .159E-07  D ERROR= .150E-07
X A        1------A-------1-D1-------C-------1-------B-------1
X B        2---C----2-----B-----2----------A----------2--D---2
X C        3-----------------A---------------3-C3-----B------3
X D        4-----------A------------4-----------B---------4C-4
X A      A D C B 
X B      C B A D 
X C      D A C B 
X D      A B C 
X 
X T ERROR= .512E-02  D ERROR= .876E-08
X A        1------A-------1-------C-------1D-1-------B-------1
X B        2--D---2---------A----------2-----B-----2----C----2
X C        3C3-----B-----3----------------A-----------------D3
X D        C4----------B----------4-------------A------------C
X A      A C D B 
X B      D A B C 
X C      C B A D 
X D      C B A 
X 
X T ERROR= .512E-02  D ERROR= .150E-07
X A        1------A-------1-D1-------C-------1-------B-------1
X B        2---C----2-----B-----2----------A----------2--D---2
X C        3-----------------A---------------3-----B-----3-C-3
X D        4-----------A------------4-----------B---------4C-4
X A      A D C B 
X B      C B A D 
X C      D A B C 
X D      A B C 
END_OF_FILE
if test 1835 -ne `wc -c <'lt1.res'`; then
    echo shar: \"'lt1.res'\" unpacked with wrong size!
fi
# end of 'lt1.res'
fi
if test -f 'lt2.dat' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'lt2.dat'\"
else
echo shar: Extracting \"'lt2.dat'\" \(1762 characters\)
sed "s/^X//" >'lt2.dat' <<'END_OF_FILE'
X s. drob lambda 4a2 map data
X  5  1
Xxho   2  1  2  0.0000E+00
X  0.2700E+02  0.1400E+02
Xkpn   5  3  4  0.0000E+00
X  0.1730E+02  0.1500E+01  0.3400E+01  0.1600E+02  0.3500E+01
Xxba   5  1  5  0.0000E+00
X  0.2150E+02  0.5800E+01  0.1500E+01  0.5000E+00  0.1200E+02
Xr1    6  2  5  0.0000E+00
X  0.1980E+02  0.6800E+01  0.1600E+01  0.1500E+01  0.8000E+00  0.1090E+02
Xhd3   6  1  5  0.0000E+00
X  0.2100E+02  0.5900E+01  0.3800E+01  0.2900E+01  0.1900E+01  0.5700E+01
Xxho  kpn    6  0.0000E+00
X  0.1730E+02  0.1100E+02  0.5000E+01  0.3500E+01  0.3400E+01  0.1500E+01
Xxho  xba    6  0.0000E+00
X  0.2150E+02  0.1200E+02  0.5600E+01  0.1500E+01  0.5000E+00  0.3000E+00
Xxho  r1     7  0.0000E+00
X  0.1980E+02  0.1090E+02  0.5000E+01  0.1700E+01  0.1600E+01  0.1500E+01  0.8000E+00
Xxho  hd3    7  0.0000E+00
X  0.2100E+02  0.6000E+01  0.5700E+01  0.2800E+01  0.2400E+01  0.1800E+01  0.1400E+01
Xkpn  xba    9  0.0000E+00
X  0.1730E+02  0.8500E+01  0.5100E+01  0.3400E+01  0.2500E+01  0.1600E+01  0.1500E+01  0.6000E+00  0.5000E+00
Xkpn  r1    10  0.0000E+00
X  0.1730E+02  0.7200E+01  0.6800E+01  0.3500E+01  0.1600E+01  0.1500E+01  0.1500E+01  0.1000E+01  0.8000E+00  0.2000E+00
Xkpn  hd3   10  0.0000E+00
X  0.1730E+02  0.6000E+01  0.3900E+01  0.3500E+01  0.2800E+01  0.2300E+01  0.2000E+01  0.1400E+01  0.1000E+01  0.7000E+00
Xxba  r1    10  0.0000E+00
X  0.1980E+02  0.1090E+02  0.5100E+01  0.1600E+01  0.1000E+01  0.9000E+00  0.7000E+00  0.5000E+00  0.5000E+00  0.2000E+00
Xxba  hd3   10  0.0000E+00
X  0.2100E+02  0.6000E+01  0.5700E+01  0.2800E+01  0.1600E+01  0.1500E+01  0.1300E+01  0.5000E+00  0.5000E+00  0.2000E+00
Xr1   hd3   11  0.0000E+00
X  0.1980E+02  0.5700E+01  0.5200E+01  0.3200E+01  0.2900E+01  0.1200E+01  0.9000E+00  0.8000E+00  0.8000E+00  0.7000E+00
X  0.5000E+00
END_OF_FILE
if test 1762 -ne `wc -c <'lt2.dat'`; then
    echo shar: \"'lt2.dat'\" unpacked with wrong size!
fi
# end of 'lt2.dat'
fi
if test -f 'lt2.res' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'lt2.res'\"
else
echo shar: Extracting \"'lt2.res'\" \(4116 characters\)
sed "s/^X//" >'lt2.res' <<'END_OF_FILE'
X  s. drob lambda 4a2 map data                                
X 
X 
X 
X ERROR =   .0100  EFACT =  2.000
X    11728  Digestions calculated in     211.90 sec
X 
X 
X xho 
X A   27.000     B   14.000     
X 
X kpn 
X A   17.300     B   16.000     C   3.5000     D   3.4000     E   1.5000    
X 
X 
X xba 
X A   21.500     B   12.000     C   5.8000     D   1.5000     E   .50000    
X 
X 
X r1  
X A   19.800     B   10.900     C   6.8000     D   1.6000     E   1.5000    
X 
X F   .80000     
X 
X hd3 
X A   21.000     B   5.9000     C   5.7000     D   3.8000     E   2.9000    
X 
X F   1.9000     
X 
X T ERROR= .257E-02  D ERROR= .214E-02
X xho      1---------------A---------------1--------B--------1
X kpn      2---------A---------2E2-D-2---------B--------2-C--2
X xba      3------------A------------3--C---D33------B-------3
X r1       4----------A-----------44D4---C----E4------B------4
X hd3      5-----------A------------5F5-E-5-D-5---B---5--C---5
X xho    A B 
X kpn    A E D B C 
X xba    A C D E B 
X r1     A F D C E B 
X hd3    A F E D B C 
X 
X T ERROR= .265E-02  D ERROR= .214E-02
X xho      1---------------A---------------1--------B--------1
X kpn      2---------A---------2E2-D-2---------B--------2-C--2
X xba      3------------A------------3--C---3D3------B-------3
X r1       4----------A-----------4D44---C----E4------B------4
X hd3      5-----------A------------5F5-E-5-D-5---B---5--C---5
X xho    A B 
X kpn    A E D B C 
X xba    A C E D B 
X r1     A D F C E B 
X hd3    A F E D B C 
X 
X T ERROR= .274E-02  D ERROR= .235E-02
X xho      1---------------A---------------1--------B--------1
X kpn      2---------A---------2E2-D-2---------B--------2-C--2
X xba      3------------A------------3--C---D33------B-------3
X r1       4----------A-----------44E4---C---4D4------B------4
X hd3      5-----------A------------5F5-E-5-D-5---B---5--C---5
X xho    A B 
X kpn    A E D B C 
X xba    A C D E B 
X r1     A F E C D B 
X hd3    A F E D B C 
X 
X T ERROR= .276E-02  D ERROR= .214E-02
X xho      1---------------A---------------1--------B--------1
X kpn      2---------A---------2E2-D-2---------B--------2-C--2
X xba      3------------A------------3--C---3D3------B-------3
X r1       4----------A-----------44D4---C----E4------B------4
X hd3      5-----------A------------5F5-E-5-D-5---B---5--C---5
X xho    A B 
X kpn    A E D B C 
X xba    A C E D B 
X r1     A F D C E B 
X hd3    A F E D B C 
X 
X T ERROR= .280E-02  D ERROR= .235E-02
X xho      1---------------A---------------1--------B--------1
X kpn      2---------A---------2E2-D-2---------B--------2-C--2
X xba      3------------A------------3--C---3D3------B-------3
X r1       4----------A-----------4E44---C---4D4------B------4
X hd3      5-----------A------------5F5-E-5-D-5---B---5--C---5
X xho    A B 
X kpn    A E D B C 
X xba    A C E D B 
X r1     A E F C D B 
X hd3    A F E D B C 
X 
X T ERROR= .292E-02  D ERROR= .214E-02
X xho      1---------------A---------------1--------B--------1
X kpn      2---------A---------2E2-D-2---------B--------2-C--2
X xba      3------------A------------3--C---D33------B-------3
X r1       4----------A-----------4D44---C----E4------B------4
X hd3      5-----------A------------5F5-E-5-D-5---B---5--C---5
X xho    A B 
X kpn    A E D B C 
X xba    A C D E B 
X r1     A D F C E B 
X hd3    A F E D B C 
X 
X T ERROR= .295E-02  D ERROR= .235E-02
X xho      1---------------A---------------1--------B--------1
X kpn      2---------A---------2E2-D-2---------B--------2-C--2
X xba      3------------A------------3--C---3D3------B-------3
X r1       4----------A-----------44E4---C---4D4------B------4
X hd3      5-----------A------------5F5-E-5-D-5---B---5--C---5
X xho    A B 
X kpn    A E D B C 
X xba    A C E D B 
X r1     A F E C D B 
X hd3    A F E D B C 
X 
X T ERROR= .307E-02  D ERROR= .235E-02
X xho      1---------------A---------------1--------B--------1
X kpn      2---------A---------2E2-D-2---------B--------2-C--2
X xba      3------------A------------3--C---D33------B-------3
X r1       4----------A-----------4E44---C---4D4------B------4
X hd3      5-----------A------------5F5-E-5-D-5---B---5--C---5
X xho    A B 
X kpn    A E D B C 
X xba    A C D E B 
X r1     A E F C D B 
X hd3    A F E D B C 
END_OF_FILE
if test 4116 -ne `wc -c <'lt2.res'`; then
    echo shar: \"'lt2.res'\" unpacked with wrong size!
fi
# end of 'lt2.res'
fi
if test -f 'map.f' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'map.f'\"
else
echo shar: Extracting \"'map.f'\" \(9289 characters\)
sed "s/^X//" >'map.f' <<'END_OF_FILE'
XC	MAP.FOR	22-July-1982
XC
XC	Copyright (c) 1982 William R. Pearson
XC
XC
X	CHARACTER*10 FILNAM, RFILE
X	character*1 ich
XC
X	LOGICAL FNDSOL
X	character*4 name
X	character*60 title
X	INTEGER TIME0, TIME1, TIME
X	COMMON /DNAME/NAME(10),title
X	COMMON /CNTCOM/IDCNT
X	COMMON /IO/LRD,LWD,LSD0,LSD1
X	DATA NBS/8/
X	DATA MXD,MXF/10,20/
X	call blkio
XC
XC	GET DATA FILE NAME AND 
XC	ERROR LIMITS
XC
X   10	WRITE(LWD,15)
X   15	FORMAT(' Type data filename '$)
X	READ(LRD,20) FILNAM
X   20	FORMAT(A10)
X	CALL GETDAT(FILNAM,MXD,MXF,MOLTYP)
X   35	WRITE(LWD,40)
X   40	FORMAT(' Error, Efact = '$)
X	READ(LRD,*) ERR,EFACT
X   42	FORMAT(2F6.2)
X	IF (ERR.GT.0.0 .AND. EFACT.GT.0.0) GOTO 49
X	IF (ERR.LE.0.0) ERR=0.025
X	IF (EFACT.LE.0.0) EFACT=2.0
X   49	WRITE(LWD,45) ERR,EFACT
X   45	FORMAT(' Using  ERR= ',F7.4,'  EFACT=',F7.2)
X	CALL SKPLIN(LWD)
X	WRITE(LWD,30) TITLE
X   30	FORMAT(1x,(a)//)
XC
XC
X	TIME0 = TIME()
X	CALL MAPSOL(MOLTYP,ERR,EFACT,FNDSOL)
X	TIME1 = TIME()
XC
XC
XC        WRITE(LWD,1502) TIME0, TIME1
XC 1502   FORMAT(' Start time:',I12,' Stop time: ',I12)
X	WRITE(LWD,501) IDCNT, TIME1-TIME0
X  501	FORMAT(1X,I8,'  Digestions calculated in ',I6,' sec')
X	IF (FNDSOL) CALL FINPLT(MOLTYP)
X	IF (FNDSOL) GOTO 508
X	WRITE(LWD,502)
X  502	FORMAT(' SEARCH FAILED - TYPE Y TO TRY AGAIN ')
X	READ(LRD,505) ICH
X  505	FORMAT(A1)
X	IF (ICH.EQ.'Y' .OR. ICH.EQ.'y') GOTO 35
X	STOP
XC
XC	CHECK FOR SAVING  RESULTS ON A FILE
XC
X  508	CALL SKPLIN(LWD)
X	WRITE(LWD,510)
X  510	FORMAT(' Type filename for results:  '$)
X	READ(LRD,520) RFILE
X  520	FORMAT(A10)
X	IF (RFILE.EQ. '          ') STOP
X	LPTDEV=LSD1
X	OPEN(LPTDEV,FILE=RFILE,STATUS='NEW')
X	LWDSAV=LWD
X	LWD=LPTDEV
X	WRITE(LPTDEV,30) TITLE
X	CALL SKPLIN(LPTDEV)
X	WRITE(LPTDEV,525) ERR, EFACT
X525	FORMAT(' ERROR = ',F7.4,'  EFACT = ',F6.3)
X	WRITE(LPTDEV,501) IDCNT, TIME1-TIME0
X	CALL SKPLIN(LPTDEV)
X	CALL FINPLT(MOLTYP)
X	CLOSE(LPTDEV)
X	LWD=LWDSAV
X	STOP
X	END
XC
XC	GETDAT.FOR	29-JAN-80
XC
XC	COPYRIGHT (C) 1981 WILLIAM R. PEARSON
XC
XC
XC	MODIFIED 25-SEP-80 FOR AUTOMATIC SORTING OF DOUBLE DIGEST DATA
XC
XC	DATA INPUT PROGRAM FOR RESTRICTION MAPPER
XC
X	SUBROUTINE GETDAT(FILNAM,MXD,MXF,MOLTYP)
X	DIMENSION D2TEMP(40),IORD(40)
X	character*10 FILNAM
X	character*4 name,nam1,nam2
X	character*60 title
X      COMMON /DDATA/ND,N1F(10),N2F(45),D1DAT(10,20),D2DAT(45,40),XL1(10)
X     1, XL2(45)
X	COMMON /IDATA/IB(10),IT(10),XCOFF(10),XDOFF(45),XORG
X	COMMON /DNAME/NAME(10),title
X	COMMON /IO/LRD,LWD,LSD0,LSD1
XC
XC	MXD	MAXIMUM ENZYMES
XC	MXF	MAXIMUM FRAGMENTS
XC
XC	ND	NUMBER OF ENZYMES
XC	N1F	NUMBER OF FRAG/END
XC	N2F	NUMBER OF FRAG/DOUBLE DIG
XC	D1DAT	SINGLE DIGEST LENGTHS
XC	D2DAT	DOUDLE DIGEST LENGTHS
XC
XC	ZERO OUT DATA ARRAYS
XC
X	DO 3 ID=1,MXD
X	DO 3 IF=1,MXF
X    3	D1DAT(ID,IF)=0.0
X	MXC=(MXD*(MXD-1))/2
X	DO 5 IC=1,MXC
X	DO 5 IF=1,2*MXF
X    5	D2DAT(IC,IF)=0.0
XC
XC	GET THE DATA
XC
X	OPEN(LSD0,FILE=FILNAM)
X	READ(LSD0,10) TITLE
X   10	FORMAT(A)
X	READ(LSD0,15) ND, MOLTYP
X   15	FORMAT(2I3)
X	IDEFST=2-MOLTYP
X	IF (ND.GT.MXD) GOTO 200
X	DO 50 ID=1,ND
X	READ(LSD0,20) NAME(ID),N1F(ID),IB(ID),IT(ID),XCOFF(ID)
X   20	FORMAT(A4,3I3,E12.4)
X	IF (ID.GT.1 .AND. XCOFF(ID).GE. 0.0 .AND. IB(ID).LE.0)
X     1	IB(ID)=1
X	IF (IB(ID).GT.0) GOTO 22
X	IB(ID)=IDEFST
X   22	IF (IT(ID).GT.0) GOTO 25
X	IT(ID)=N1F(ID)
X   25	IF(IB(ID).GT.IT(ID)) IB(ID)=IT(ID)
X	IF (N1F(ID).GT.MXF) GOTO 210
X	READ(LSD0,30) (D1DAT(ID,J),J=1,N1F(ID))
X   30	FORMAT(10E12.4)
X   50	CONTINUE
XC
XC	GET THE DOUBLE DIGESTS
XC
X	IC=0
X	DO 80 ID=1,ND-1
X	DO 80 JD=ID+1,ND
X	IC=IC+1
X	READ(LSD0,60) NAM1,NAM2,N2F(IC),XDOFF(IC)
X   60	FORMAT(2(A4,1X),I3,E12.4)
X	IF ((NAM1.EQ.NAME(ID)).AND.(NAM2.EQ.NAME(JD))) GOTO 70
X	IF ((NAM1.EQ.NAME(JD)).AND.(NAM2.EQ.NAME(ID))) GOTO 70
X	GOTO 220
X   70	IF ((XDOFF(IC).EQ.0.0).AND.(N2F(IC).EQ.(N1F(ID)+N1F(JD))))
X     1 GOTO 230
X	IF (N2F(IC).EQ.0) GOTO 80
X	READ(LSD0,30) (D2DAT(IC,K),K=1,N2F(IC))
X   80	CONTINUE
XC
XC
XC	ALL DATA IN, NORMALIZE
XC
X	DO 110 ID=1,ND
X	SUM=0
X	DO 90 IF=1,N1F(ID)
X   90	SUM=SUM+D1DAT(ID,IF)
X	XL1(ID)=SUM
X	IF (XCOFF(ID).GE.0.0) XCOFF(ID)=XCOFF(ID)/SUM
X	DO 100 IF=1,N1F(ID)
X  100	D1DAT(ID,IF)=D1DAT(ID,IF)/SUM
X  110	CONTINUE
XC
XC	SUBTRACT XCOFF(1) SO THAT IT HAS AN OFFSET OF 0.0
XC
X	XORG=XCOFF(1)
X	DO 115 ID=1,ND
X115	IF (XCOFF(ID).GE.0.0) XCOFF(ID)=PFRACT(1.0+XCOFF(ID)-XORG)
XC
XC	NORMALIZE DOUBLE DIGESTS
XC
X	NC=(ND*(ND-1))/2
X	DO 150 IC=1,NC
X	SUM=0
X	IF (N2F(IC).EQ.0) GOTO 125
X	DO 120 IF=1,N2F(IC)
X  120	SUM=SUM+D2DAT(IC,IF)
X  125	XL2(IC)=SUM
X	IF (N2F(IC).GT.0) XDOFF(IC)=XDOFF(IC)/SUM
X	DO 130 IF=1,N2F(IC)
X	IF (N2F(IC).EQ.0) GOTO 130
X	D2DAT(IC,IF)=D2DAT(IC,IF)/SUM
X  130	CONTINUE
X  150	CONTINUE
XC
XC	SORT THE DOUBLE DIGEST DATA
XC
X	DO 170 IC=1,NC
X	DO 180 IF=1,N2F(IC)
X  180	D2TEMP(IF)=D2DAT(IC,IF)
X	CALL CSORT(D2TEMP,IORD,N2F(IC))
X	DO 190 IF=1,N2F(IC)
X  190	D2DAT(IC,IORD(IF))=D2TEMP(IF)
X  170	CONTINUE
X	RETURN
X  200	WRITE(LWD,205) ND,MXD
X  205	FORMAT(' NUMBER OF ENZYMES ',I2,' GREATER THAN ',I2//)
X	GOTO 250
X  210	WRITE(LWD,215) N1F(ID),MXF
X  215	FORMAT(' NUMBER OF FRAGMENTS ',I2,' GREATER THAN ',I2//)
X	GOTO 250
X  220	WRITE(LWD,225) NAM1,NAM2,NAME(ID),NAME(JD)
X  225	FORMAT(' FOUND ENZYMES ',2(1X,A4),', EXPECTING ',2(1X,A4)//)
X  230	WRITE(LWD,235) NAME(ID),NAME(JD)
X  235	FORMAT(' FOUND DIGEST OFFSET OF ZERO WITH N1F+N1F=N2F ',
X     1	2(1X,A4)//)
X  250	STOP
X	END
XC
XC
X	subroutine BLKIO
X	COMMON /IO/LRD,LWD,LSD0,LSD1
X	lrd = 5
X	lwd = 6
XC	open(lrd,file='con')
XC	open(lwd,file='con')
X	lsd0=10
X	lsd1=11
X	return
X	END
XC
XC
XC	FINPLT  PLOTS OUT THE HAPPY RESULTS
XC
X	SUBROUTINE FINPLT(MOLTYP)
X	LOGICAL LEXT
X	character*4 name
X	character*60 title
X      COMMON /SAVCOM/IPSAV(10),NOSAV(10),XOSAV(10,40),EOSAV(10,40),
X     1 IOSAV(10)
X      COMMON /DDATA/ND,N1F(10),N2F(45),D1DAT(10,20),D2DAT(45,40),XL1(10)
X     1, XL2(45)
X	COMMON /DNAME/NAME(10),title
X	COMMON /IDATA/IB(10),IT(10),XCOFF(10),XDOFF(45),XORG
X	COMMON/CERVAL/ERVAL(45)
X      COMMON /BESCOM/IBW,ERRDIA(8),ERRTOT(8),XOBES(8,10),D1BES(8,10,20)
X	COMMON /IO/LRD,LWD,LSD0,LSD1
X	DIMENSION IORD(8),JORD(8)
X	character*1 ISYM(10),ASYM(20)
X	DIMENSION XOPLT(10),IOPLT(10)
X	DIMENSION PLTDAT(20)
X	DATA NBS/8/
X	DATA ISYM/'1','2','3','4','5','6','7','8','9','0'/
X	DATA ASYM/'A','B','C','D','E','F','G','H','I','J',
X     1	'K','L','M','N','O','P','Q','R','S','T'/
XC
XC
X	LEXT=(MOLTYP.EQ.0)
XC
XC	DISPLAY THE RESTRICTION FRAGMENT SIZES
XC
X	DO 100 ID=1,ND
X	DO 110 I=1,N1F(ID)
X  110	PLTDAT(I)=D1DAT(ID,I)*XL1(ID)
XC
XC	DATA IS BACK IN UNNORMALIZED FORM
XC	SORT EACH DIGEST
XC
X	CALL CSORT(PLTDAT,IORD,N1F(ID))
XC
XC	NOW DISPLAY THE FRAGMENTS
XC
X	DO 120 I=1,N1F(ID)
X  120	JORD(IORD(I))=I
XC
X	CALL SKPLIN(LWD)
X	WRITE(LWD,130) NAME(ID)
X  130	FORMAT(' ',A4)
X	WRITE(LWD,140) (ASYM(I),PLTDAT(JORD(I)),I=1,N1F(ID))
X  140	FORMAT(5(1X,A1,G13.5)/)
XC
X  100	CONTINUE
XC
XC	SORT THE BEST SOLUTIONS BY ERROR
XC
X	CALL CSORT(ERRTOT,IORD,NBS)
XC
XC	IORD IS THE INVERSE PERMUTATION SO GET
XC	THE INVERSE OF IT
XC
X	DO 5 IO=1,NBS
X    5	JORD(IORD(IO))=IO
XC
XC	CSORT SORTS IN DECREASING ORDER SO GO BACKWARDS
XC
XC	INITIALIZE IOPLT(ID) FOR LINEAR MOLECULES
XC
X	DO 7 ID=1,ND
X7	IOPLT(ID)=0
XC
XC
X	DO 20 IO=NBS,1,-1
X	IS=JORD(IO)
X	IF (ERRTOT(IS).GE.100.) GOTO 25
X	CALL SKPLIN(LWD)
X	WRITE(LWD,10) ERRTOT(IS),ERRDIA(IS)
X   10	FORMAT(' T ERROR=',1E9.3,'  D ERROR=',E9.3)
X	IF (.NOT.LEXT) GOTO 250
XC
XC	HAVE A CIRCULAR MOLECULE, MUST DISPLAY OFFSETS
XC	DISPLAY XOFF WITH RESPECT TO ORIGIN, 
XC	USE RESTRICTION SITE CLOSEST TO THE ORIGIN
XC
XC	XOPLT(1)=XCOFF(1)*XL1(1)
X	DO 230 ID=1,ND
X	XTOFF=XOBES(IS,ID)+XORG
X	XTOFF=PFRACT(XTOFF)
X	XPOS=XTOFF
X	IOFF=0
X	DO 220 I=1,N1F(ID)
X	XPOS=XPOS+D1BES(IS,ID,I)
X	XPOS=PFRACT(XPOS)
X	IF (XPOS.GE.XTOFF) GOTO 220
X	IOFF=I
X	XTOFF=XPOS
X  220	CONTINUE
X	IOPLT(ID)=IOFF
X  230	XOPLT(ID)=XTOFF*XL1(ID)
X	WRITE(LWD,240) (NAME(ID),XOPLT(ID),ID=1,ND)
X  240	FORMAT(4(1X,A4,G13.5))
X  250	DO 300 ID=1,ND
XC
XC
XC	SET + XCOFF(1) TO GIVE ABSOLUTE POSITIONING, ALL XOFF'S
XC	ARE CALCULATED WITH RESPECT TO DIG1
XC
X	XOFF=XOBES(IS,ID)+XORG
X	DO 15 IF=1,N1F(ID)
X	PLTDAT(IF)=D1BES(IS,ID,IF)
X   15	CONTINUE
X	CALL PLOT(ID,PLTDAT,XOFF,ISYM(ID),LEXT)
X  300	CONTINUE
X	DO 320 ID=1,ND
X	JF=IOPLT(ID)
X	DO 310 IF=1,N1F(ID)
X	JM=MOD(JF,N1F(ID))+1
X	PLTDAT(IF)=D1BES(IS,ID,JM)
X310	JF=JF+1
X	CALL CSORT(PLTDAT,IORD,N1F(ID))
X	WRITE(LWD,330) NAME(ID),(ASYM(IORD(J)),J=1,N1F(ID))
X  330	FORMAT(1X,A4,2X,20(1X,A1))
X  320	CONTINUE
X   20	CONTINUE
X   25	CONTINUE
X	RETURN
X	END
XC
XC
X	SUBROUTINE SKPLIN(LSD)
X	WRITE(LSD,5)
X    5	FORMAT(1X)
X	RETURN
X	END
XC
XC	NDSPL1.FOR	29-JAN-80
XC
XC	COPYRIGHT (C) 1981 WILLIAM R. PEARSON
XC
XC
XC	FOR PLOTTING RESTRICTION DIGESTS
XC
X	SUBROUTINE PLOT(ID,PLTDAT,XOFF,ISYM,LEXT)
X        character*1 ISYM
X	LOGICAL LEXT
X	character*4 name
X	character*60 title
X	DIMENSION PLTDAT(1)
X      COMMON /DDATA/ND,N1F(10),N2F(45),D1DAT(10,20),D2DAT(45,40),XL1(10)
X     1, XL2(45)
X	COMMON /DNAME/NAME(10),title
X	COMMON /IO/LRD,LWD,LSD0,LSD1
X	character*1 LINE(121)
X	DIMENSION IORD(20)
X	character*1 ALPHSM(20)
X	character*1 BLNK,DASH,BAR
X	DATA BLNK,DASH,BAR/' ','-','|'/
X	DATA ALPHSM/'A','B','C','D','E','F','G','H','I','J',
X     1	'K','L','M','N','O','P','Q','R','S','T'/
X	DATA LLEN,XFACT,LBAS/60,50.,50/
X	LEN=LBAS
X	IF (LEXT) LEN=LLEN
X	DO 10 I=1,LEN+1
X   10	LINE(I)=DASH
XC
XC	SORT IORD FOR LABELING FRAGMENTS
XC
X	CALL CSORT(PLTDAT,IORD,N1F(ID))
XC
XC
X	POS=XOFF
X	DO 20 I=1,N1F(ID)
X	IND=PFRACT(POS)*XFACT+1
X	LINE(IND)=ISYM
X	IND=PFRACT(POS+PLTDAT(I)/2.0)*XFACT+1
X	LINE(IND)=ALPHSM(IORD(I))
X   20	POS=POS+PLTDAT(I)
XC
XC	EXTEND 20%
XC
X	DO 30 I=1,20
X   30	LINE(LBAS+I)=LINE(I)
X	IF (LINE(LBAS+1).EQ.DASH) LINE(LBAS+1)=BAR
XC
XC	PRINT IT
XC
X	WRITE(LWD,40) NAME(ID),(LINE(I),I=1,LEN+1)
X   40	FORMAT(1X,A4,5X,121A1)
X	RETURN
X	END
END_OF_FILE
if test 9289 -ne `wc -c <'map.f'`; then
    echo shar: \"'map.f'\" unpacked with wrong size!
fi
# end of 'map.f'
fi
if test -f 'mapsub.f' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'mapsub.f'\"
else
echo shar: Extracting \"'mapsub.f'\" \(8645 characters\)
sed "s/^X//" >'mapsub.f' <<'END_OF_FILE'
XC	MAPSOL.FOR	8-MAR-81
XC
XC	COPYRIGHT (C) 1981 WILLIAM R. PEARSON
XC
XC	MODIFIED FOR LARGER ARRAYS, 10 ENZYMES, 20 FRAGMENTS
XC
XC	A RECURSIVE RESTRICTION MAPPER THAT DEDUCES CORRECT 
XC	SOLUTIONS
XC
X	SUBROUTINE MAPSOL(MOLTYP,ERR,EFACT,FNDSOL)
X	DIMENSION XOFF(40),EOFF(40),SYNDIG(40),IORD(40),ISYM(10),NP1(10)
X	LOGICAL SUCCES,FNDSOL
X	character*4 name
X	character*60 title
X      COMMON /DDATA/ND,N1F(10),N2F(45),D1DAT(10,20),D2DAT(45,40),XL1(10)
X     1,XL2(45)
X	COMMON /IDATA/IB(10),IT(10),XCOFF(10),XDOFF(45),XORG
X      COMMON /SAVCOM/IPSAV(10),NOSAV(10),XOSAV(10,40),EOSAV(10,40),
X     1 IOSAV(10)
X	COMMON /EPSCOM/EPS
X      COMMON /BESCOM/IBW,ERRCUM(8),ERRTOT(8),XOBES(8,10),
X     1 D1BES(8,10,20)
X	COMMON /CNTCOM/IDCNT
X	COMMON /DNAME/NAME(10),title
X	COMMON /IO/LRD,LWD,LSD0,LSD1
XC
XC
X	DATA NBS/8/
X	DATA MXD,MXF/10,20/
XC
XC	INITIALIZE FNDSOL AND THE LARGEST ERRCUM'S
XC	AND IBW
XC
X	FNDSOL=.FALSE.
X	DO 5 I=1,NBS
X	ERRTOT(I)=100.
X    5	ERRCUM(I)=100.
X	IBW=1
XC
XC	CALCULATE EPS FOR SAVOFF
XC
XC	USE 0.5% TEMPORARILY, SHOULD BE BASED ON D2DAT
XC
X	EPS = 0.005
X	EFERR = EFACT*ERR
XC
XC	INITIALIZE SOLUTION COUNTER
XC
X	IDCNT=0
XC
XC	FIND LARGEST NUMBER OF FRAGMENTS
XC
X	NFMX=0
X	DO 50 ID=1,ND
X	IF (NFMX.LT.N1F(ID)) NFMX=N1F(ID)
X	CALL FIRSTP(ID,IB(ID),IT(ID))
X	NP1(ID)=NFACT(IT(ID)-IB(ID)+1)
X   50	CONTINUE
XC
XC	IGNORE SYMMETRIC SOLUTIONS IN THE OPPOSITE DIRECTION
XC
X	DO 60 ID=1,ND
X	IF (XORG.GT.0.0 .AND. XCOFF(ID).GT.0.0) GOTO 80
X	IF (IB(ID).GT.(2-MOLTYP).OR.IT(ID).LT.N1F(ID)) GOTO 80
XC	IF (IB(ID).LE.(2-MOLTYP).AND.IT(ID).EQ.N1F(ID)) GOTO 60
XC	GOTO 80
X60	CONTINUE
X	DO 70 ID=1,ND
X      IF (NP1(ID).LT.2.AND.IB(ID).LE.(2-MOLTYP).AND.IT(ID).EQ.N1F(ID))
X     1	GOTO 70
XC	IF(IB(ID).GT.(2-MOLTYP).OR.IT(ID).LT.N1F(ID)) GOTO 80
XC	IF (XCOFF(ID).GT.0.0) GOTO 80
X	NP1(ID)=NP1(ID)/2
X	GOTO 80
X   70	CONTINUE
X   80	CONTINUE
XC
XC	DO IT
XC
X	NOSAV(1)=1
X	XOSAV(1,1)=0.0
X	IOSAV(1)=1
X	JSTART=1
X	DO 500 IP=1,NP1(JSTART)
X	IPSAV(JSTART)=IP
X	JD=JSTART+1
XC
XC	THIS IS THE ENTRY TO A NEW LEVEL OF FINDSOL
XC
X  100	IF (JD.LE.ND) GOTO 200
X	CALL FOUND
X	FNDSOL=.TRUE.
X	GOTO 250
XC
XC	FOR JP=1,NP1(JD)
XC
X  200	DO 202 JST=JSTART,JD-1
X  202	IF (N2F(MMAP(JST,JD,ND)).GT.0) GOTO 205
X	WRITE(LWD,204) NAME(JD)
X  204	FORMAT(' DOUBLE DIGEST OUT OF ORDER??  ',A4)
X	GOTO 235
X  205	IPSAV(JD)=0
X  210	IPSAV(JD)=IPSAV(JD)+1
X	IF (IPSAV(JD).GT.NP1(JD)) GOTO 250
X	JSP=IPSAV(JST)
X	JP=IPSAV(JD)
X	NOFF=0
X	CALL FIND(JST,JD,NOFF,XOFF,EOFF,ERR)
X	IF (NOFF.LT.1) GOTO 240
XC
XC	HAVE A SOLUTION, SAVE
XC
X	NOSAV(JD)=NOFF
X	DO 220 I=1,NOFF
X	EOSAV(JD,I)=EOFF(I)
X  220	XOSAV(JD,I)=XOFF(I)
XC
XC	CHECK FOR CONSISTENCY
XC
XC	FOR IOFF=1,NOFF
XC
X	IOSAV(JD)=0
X  230	IOSAV(JD)=IOSAV(JD)+1
XC	WRITE(lwd,233) JD,NOSAV(JD),IOSAV(JD),(XOSAV(JD,I),I=1,NOSAV(JD))
XC  233	FORMAT(1X,3I3,12F8.4)
X	IF (IOSAV(JD).GT.NOSAV(JD)) GOTO 240
X	CALL TEST(JD,EFERR,SUCCES,JST)
X	IF (.NOT.(SUCCES)) GOTO 230
XC
XC	ALL IS WELL, GOTO NEXT LEVEL
XC		(CALL FINDSOL(JD+1)  )
XC
X  235	JD=JD+1
X	GOTO 100
XC
XC	ALL OFFSETS CHECKED, GET NEXT PERM
XC
X  240	CALL NEXTP(JD,IB(JD),IT(JD))
X	GOTO 210
XC
XC
XC	RETURNING FROM PREVIOUS LEVEL
XC
X  250	JD=JD-1
X	IF (JD.LE.JSTART) GOTO 500
X	GOTO 230
XC
XC	FINISH OUTSIDE LOOP
XC
X  500	CALL NEXTP(JSTART,IB(JSTART),IT(JSTART))
XC
XC
X	RETURN
X	END
XC
XC	NFOUND		29-JAN-80
XC
XC	COPYRIGHT (C) 1981 WILLIAM R. PEARSON
XC
XC
XC	FOUND CHECKS FOR BEST NBS SOLUTIONS
XC
XC
X	SUBROUTINE FOUND
X      COMMON /SAVCOM/IPSAV(10),NOSAV(10),XOSAV(10,40),EOSAV(10,40),
X     1 IOSAV(10)
X      COMMON /DDATA/ND,N1F(10),N2F(45),D1DAT(10,20),D2DAT(45,40),XL1(10)
X     1, XL2(45)
X	COMMON /IDATA/ IB(10),IT(10),XCOFF(10),XDOFF(45),XORG
X	COMMON/CERVAL/ERVAL(45)
X      COMMON /BESCOM/IBW,ERRDIA(8),ERRTOT(8),XOBES(8,10),D1BES(8,10,20)
X 	DATA NBS/8/
XC
XC	ONCE A SOLUTION HAS BEEN FOUND, CHECK IF BETTER
XC
XC	CALCULATE TOTAL ERROR
XC
X	ETOT=0.0
X	NDE=0
X	DO 15 ID=1,ND-1
X	DO 15 JD=ID+1,ND
X	IMM=MMAP(ID,JD,ND)
X	IF (N2F(IMM).LE.0)GOTO 15
X	NDE=NDE+1
X	ETOT=ETOT+ERVAL(IMM)
X   15	CONTINUE
X	ETOT=ETOT/NDE
X	IF (ETOT.GE.ERRTOT(IBW)) RETURN
X	ERRTOT(IBW)=ETOT
XC
XC	CALCULATE DIA ERROR
XC
X	ECUM=0.0
X	NDE=0
X	DO 10 K=2,ND
X	IMM=MMAP(1,K,ND)
X	IF (N2F(IMM).LE.0) GOTO 10
X	NDE=NDE+1
X	ECUM=ECUM+ERVAL(IMM)
X   10	CONTINUE
X	ECUM=ECUM/NDE
X	ERRDIA(IBW)=ECUM
XC
XC	CHECK TO SEE IF PERMUTING INTERNALLY, IF SO, 
XC	DON'T REVERSE PLOT
XC
X	IF ((IB(1).EQ.1).AND.(IT(1).EQ.1)) GOTO 19
X	IF ((IB(1).NE.1).OR.(IT(1).NE.N1F(1))) GOTO 19
XC
XC
XC	CHECK TO SEE IF LONGEST FRAGMENT IS IN THE LAST POSITION
XC	IF SO, SAVE THE DIGEST BACKWARDS SO IT WILL BE IN THE FIRST POSITION
XC
X	IF (MOD(IPSAV(1),N1F(1)).EQ.0) GOTO 22
XC
XC	DONT REVERSE
XC
X   19	DO 20 KD=1,ND
X	XOBES(IBW,KD)=XOSAV(KD,IOSAV(KD))
X	DO 20 KF=1,N1F(KD)
X   20	D1BES(IBW,KD,KF)=D1DAT(KD,KF)
X	GOTO 27
XC
XC	DO REVERSE
XC
X   22	DO 25 KD=1,ND
X	KN=N1F(KD)
X	XOBES(IBW,KD)=PFRACT(1.0-XOSAV(KD,IOSAV(KD)))
X	DO 25 KF=1,N1F(KD)
X	D1BES(IBW,KD,KF)=D1DAT(KD,KN)
X   25	KN=KN-1
XC
XC
XC	FIND WORST ERRTOT
XC
X   27	DO 30 K=1,NBS
X   30	IF (ERRTOT(K).GT.ERRTOT(IBW)) IBW=K
XC
XC
X  100	RETURN
X	END
X
XC	NNNPRM.FOR	20-JUN-78
XC
XC	COPYRIGHT (C) 1981 WILLIAM R. PEARSON
XC
XC
XC	SET UP FOR IB,IT FOR PERMUTATION
XC	OF A SUBSET OF FRAGMENTS
XC
XC
XC	NEW PERMUTATION ROUTINE FOR LINEAR MAPPER
XC
XC	CONTAINS FIRSTP,NEXTP
XC
XC	USES IVES ALGORITHM
XC
X	SUBROUTINE FIRSTP(ID,IB,IT)
X	COMMON /PCOUNT/II(10),IC0(10,10),IC1(10,10)
XC
XC	INITIALIZE THE COUNTERS
XC
X	DO 10 I=1,(IT-IB+2)/2
X	IC0(ID,I)=IB-1+I
X	IC1(ID,I)=IB-1+I
X   10	CONTINUE
X	II(ID)=1
X	RETURN
X	END
XC
XC
XC
X	SUBROUTINE NEXTP(ID,IB,IT)
X	COMMON /PCOUNT/II(10),IC0(10,10),IC1(10,10)
X      COMMON /DDATA/ND,N1F(10),N2F(45),D1DAT(10,20),D2DAT(45,40),XL1(10)
X     1, XL2(45)
XC
XC
X	IF (IB.GE.IT) RETURN
XC
XC
X   10	IF (IC0(ID,II(ID)).LT. IT+1-II(ID)) GOTO 200
X	TMP=D1DAT(ID,IB-1+II(ID))
X	D1DAT(ID,IB-1+II(ID))=D1DAT(ID,(IT+1-II(ID)))
X	D1DAT(ID,(IT+1-II(ID)))=TMP
X	IC0(ID,II(ID))=IB-1+II(ID)
X	IF (IC1(ID,II(ID)) .LT. IT-II(ID)) GOTO 100
X	IC1(ID,II(ID))=IB-1+II(ID)
X	II(ID)=II(ID)+1
X	IF (II(ID) .LT. IT-IB+2-II(ID)) GOTO 10
X  100	IC1(ID,II(ID)) = IC1(ID,II(ID))+1
X	II(ID)=1
X	RETURN
X  200	TMP=D1DAT(ID,IC0(ID,II(ID)))
X	D1DAT(ID,IC0(ID,II(ID)))=D1DAT(ID,IC0(ID,II(ID))+1)
X	D1DAT(ID,IC0(ID,II(ID))+1)=TMP
X	IC0(ID,II(ID))=IC0(ID,II(ID))+1
X	II(ID)=1
X	RETURN
X	END
XC
XC
XC
X	FUNCTION NFACT(N)
X	NFACT=1
X	IF (N.LT.1) RETURN
X	DO 10 I=1,N
X	NFACT=NFACT*I
X   10	CONTINUE
X	RETURN
X	END
X
XC	MISMAP.FOR		12-JUN-79
XC
XC	COPYRIGHT (C) 1981 WILLIAM R. PEARSON
XC
XC
XC	MISCELLANEOUS SUBROUTINES FOR MAPPING
XC
XC
XC	ERROR CALCULATES THE ERROR OF THE SYNTHETIC DIGEST
XC
X	FUNCTION ERROR(KD,SYNDIG,N3)
X	DIMENSION SYNDIG(1)
X      COMMON /DDATA/ND,N1F(10),N2F(45),D1DAT(10,20),D2DAT(45,40),XL1(10)
X     1, XL2(45)
X	COMMON /CNTCOM/IDCNT
X	DIMENSION IORD(40)
XC
XC	UPDATE SOLUTION COUNTER
XC
X	IDCNT=IDCNT+1
XC
XC	SORT THE SYNDIG AND COMPARE
XC
X	CALL CSORT(SYNDIG,IORD,N3)
X    2	FORMAT(' KD = ',I3)
X    3	FORMAT(1X,12F8.4)
X	SUMSQ=0.0
X	DO 10 K=1,N3
X	DIFF=D2DAT(KD,IORD(K))-SYNDIG(K)
X   10	SUMSQ=SUMSQ+DIFF*DIFF
X	ERROR = SQRT(SUMSQ/FLOAT(N3-1))
X	RETURN
X	END
XC
XC	TEST TESTS TO SEE IF DIGESTS ARE CONSISTENT
XC
X	SUBROUTINE TEST(JD,ERR,SUCCES,JBAS)
X	LOGICAL SUCCES
X	DIMENSION SYNDIG(40)
X      COMMON /DDATA/ND,N1F(10),N2F(45),D1DAT(10,20),D2DAT(45,40),XL1(10)
X     1, XL2(45)
X      COMMON /SAVCOM/IPSAV(10),NOSAV(10),XOSAV(10,40),EOSAV(10,40),
X     1 IOSAV(10)
X	COMMON /CERVAL/ERVAL(45)
XC
XC
X	SUCCES=(.TRUE.)
X	ERVAL(MMAP(JBAS,JD,ND))=EOSAV(JD,IOSAV(JD))
X	IF (JD.LE.JBAS+1) RETURN
X	NJ=N1F(JD)
X	DO 100 KD=JBAS+1,JD-1
X	KKD=MMAP(KD,JD,ND)
X	ERVAL(KKD)=0.0
X	IF (N2F(KKD).EQ.0) GOTO 100
X	NK=N1F(KD)
X	XOFF=XOSAV(JD,IOSAV(JD))-XOSAV(KD,IOSAV(KD))
X	IF (XOFF.LT.0.0) XOFF=PFRACT(1.0+XOFF)
X	CALL DIGEST (KD,JD,XOFF,SYNDIG)
X	NKJ=NK+NJ
X	EVAL=ERROR(KKD,SYNDIG,NKJ)
X	IF (EVAL.GT.ERR) GOTO 200
X	ERVAL(KKD)=EVAL
X  100	CONTINUE
X	RETURN
X  200	SUCCES=(.FALSE.)
X	RETURN
X	END
XC
XC	PFRACT CALCULATES SMALLEST POSITIVE FRACTION
XC
X	FUNCTION PFRACT(X)
X   10	IF (X.GE.0.0) GOTO 20
X	X=X+1.0
X	GOTO 10
X   20	PFRACT=X-AINT(X)
X	RETURN
X	END
XC
XC	MMAP	MAPS INTO TRIANGULAR D2DAT MATRIX
XC
X	FUNCTION MMAP(I,J,N)
X	IF (I.LE.J) GOTO 10
X	K=I
X	I=J
X	J=K
X   10	MMAP=((2*N-I)*(I-1))/2+J-I
X	RETURN
X	END
XC
XC	SAVOFF	SAVES GOOD OFFSET AFTER
XC		CHECKING FOR DUPLICATES
XC
X	SUBROUTINE SAVOFF(XVOFF,NOFF,XOFF,EVOFF,EOFF)
X	DIMENSION XOFF(1),EOFF(1)
X	COMMON /EPSCOM/EPS
X	DATA MXOFF/40/
XC
XC	CHECK TO SEE IF UNIQUE
XC
X	IF (NOFF.EQ.0) GOTO 100
X	DO 20 I=1,NOFF
X	IF (ABS(XOFF(I)-XVOFF).LT.EPS) GOTO 120
X   20	CONTINUE
X  100	CONTINUE
X	IF (NOFF.LT.MXOFF) NOFF=NOFF+1
X	XOFF(NOFF)=XVOFF
X	EOFF(NOFF)=EVOFF
X	RETURN
XC
X  120	CONTINUE
X	IF (EOFF(I).LT.EVOFF) RETURN
X	XOFF(I)=XVOFF
X	EOFF(I)=EVOFF
X  	RETURN
X	END
XC
XC	CSORT
XC
XC	SORT BY COUNTING FROM KNUTH
XC
X	SUBROUTINE CSORT(DIG,IORD,N)
X	DIMENSION DIG(1),IORD(1)
X	IF (N.GT.1) GOTO 5
X	IORD(1)=1
X	RETURN
X    5	DO 10 I=1,N
X   10	IORD(I)=1
X	DO 20 I=N,2,-1
X	DO 20 J=I-1,1,-1
X	IF (DIG(I).GT.DIG(J)) GOTO 15
X	IORD(I)=IORD(I)+1
X	GOTO 20
X   15	IORD(J)=IORD(J)+1
X   20	CONTINUE
X	RETURN
X	END
END_OF_FILE
if test 8645 -ne `wc -c <'mapsub.f'`; then
    echo shar: \"'mapsub.f'\" unpacked with wrong size!
fi
# end of 'mapsub.f'
fi
echo shar: End of shell archive.
exit 0