      PROGRAM CON3DP
C
      IMPLICIT INTEGER (I,J,K,L,M,N)
      DIMENSION NPOS(150)
      INTEGER*4 NTOT,NSEED
      INTEGER MATRIX(50,50,50),NXBEST(150,150),NXCOR(150),NYCOR(150)
      INTEGER BSCORE(150),MSCORE
      INTEGER NYBEST(150,150),NZBEST(150,150),NZCOR(150)
      REAL MFP
      REAL PROB(6), PROB1(6),RSCSUM
      DIMENSION NLIST(150)
      CHARACTER*1 ORIG(150)
      COMMON /A1/ MATRIX,NXBEST,NYBEST,BSCORE,NXCOR,NYCOR,
     + NZBEST,NZCOR
      COMMON /AA/ PROB,PROB1,RSCSUM,mscore
      COMMON /A2/ NLIST
      COMMON /A3/ ORIG
      COMMON /A4/ NUM, TEST, T1, NTOT, NMAR
      COMMON /AB/ MFP
      COMMON /AD/ XBAR,YBAR,ZBAR
      COMMON /C1/ NPOS
      COMMON /C3/ NS(20,20)
      COMMON /D1/ NSIZE,NSTART,NSTOP,nfl1
      COMMON /E1/ NBRCHN
      DATA (NS( 1,J),J=1,20) / -544, -505, -563, -503,
     +  -503, -446, -476, -389, -338, -316, -288, -286,
     +  -259, -273, -266, -208, -363, -270, -154, -292/
      DATA (NS( 2,J),J=1,20) / -505, -606, -668, -633,
     +  -601, -552, -637, -492, -399, -375, -373, -355,
     +  -350, -317, -290, -319, -331, -349, -311, -411/
      DATA (NS( 3,J),J=1,20) / -563, -668, -685, -639,
     +  -626, -575, -602, -494, -436, -372, -376, -356,
     +  -355, -330, -331, -351, -461, -354, -283, -373/
      DATA (NS( 4,J),J=1,20) / -503, -633, -639, -622,
     +  -617, -558, -564, -463, -441, -365, -374, -343,
     +  -299, -322, -291, -323, -376, -333, -270, -347/
      DATA (NS( 5,J),J=1,20) / -503, -601, -626, -617,
     +  -579, -538, -550, -426, -396, -343, -343, -316,
     +  -299, -309, -259, -291, -384, -315, -263, -306/
      DATA (NS( 6,J),J=1,20) / -446, -552, -575, -558,
     +  -538, -494, -505, -405, -362, -306, -295, -279,
     +  -235, -267, -225, -256, -338, -278, -195, -296/
      DATA (NS( 7,J),J=1,20) / -476, -637, -602, -564,
     +  -550, -505, -542, -444, -393, -337, -331, -295,
     +  -311, -316, -291, -294, -402, -356, -249, -366/
      DATA (NS( 8,J),J=1,20) / -389, -492, -494, -463,
     +  -426, -405, -444, -355, -285, -250, -248, -230,
     +  -247, -253, -225, -242, -333, -275, -201, -280/
      DATA (NS( 9,J),J=1,20) / -338, -399, -436, -441,
     +  -396, -362, -393, -285, -251, -215, -215, -189,
     +  -144, -170, -157, -151, -208, -150, -110, -181/
      DATA (NS(10,J),J=1,20) / -316, -375, -372, -365,
     +  -343, -306, -337, -250, -215, -217, -203, -170,
     +  -156, -154, -162, -122, -194, -168,  -84, -172/
      DATA (NS(11,J),J=1,20) / -288, -373, -376, -374,
     +  -343, -295, -331, -248, -215, -203, -172, -159,
     +  -151, -159, -166, -145, -231, -197, -102, -166/
      DATA (NS(12,J),J=1,20) / -286, -355, -356, -343,
     +  -316, -279, -295, -230, -189, -170, -159, -148,
     +  -131, -137, -146, -148, -194, -122,  -83, -135/
      DATA (NS(13,J),J=1,20) / -259, -350, -355, -299,
     +  -299, -235, -311, -247, -144, -156, -151, -131,
     +  -159, -136, -133, -143, -201, -141,  -91, -143/
      DATA (NS(14,J),J=1,20) / -273, -317, -330, -322,
     +  -309, -267, -316, -253, -170, -154, -159, -137,
     +  -136,  -89, -126, -133, -185, -185, -102, -173/
      DATA (NS(15,J),J=1,20) / -266, -290, -331, -291,
     +  -259, -225, -291, -225, -157, -162, -166, -146,
     +  -133, -126,  -96, -123, -214, -198, -132, -119/
      DATA (NS(16,J),J=1,20) / -208, -319, -351, -323,
     +  -291, -256, -294, -242, -151, -122, -145, -148,
     +  -143, -133, -123, -117, -227, -207, -160, -140/
      DATA (NS(17,J),J=1,20) / -363, -331, -461, -376,
     +  -384, -338, -402, -333, -208, -194, -231, -194,
     +  -201, -185, -214, -227, -278, -211, -109, -217/
      DATA (NS(18,J),J=1,20) / -270, -349, -354, -333,
     +  -315, -278, -356, -275, -150, -168, -197, -122,
     +  -141, -185, -198, -207, -211, -139,   -6, -185/
      DATA (NS(19,J),J=1,20) / -154, -311, -283, -270,
     +  -263, -195, -249, -201, -110,  -84, -102,  -83,
     +   -91, -102, -132, -160, -109,   -6,   13,  -67/
      DATA (NS(20,J),J=1,20) / -292, -411, -373, -347,
     +  -306, -296, -366, -280, -181, -172, -166, -135,
     +  -143, -173, -119, -140, -217, -185,  -67, -117/
C
      OPEN (UNIT=5)
      OPEN (UNIT=6)
      OPEN (UNIT=7)
      OPEN (UNIT=8)
      OPEN (UNIT=9)
      CALL GETINFO
      READ (7,30) NUM
   30 FORMAT (I5)
      I1=0
      I2=NUM
   32 CONTINUE
      READ (7,35) (ORIG(I+I1), I=1,50)
   35 FORMAT (50(A2))
      I2=I2-50
      IF (I2.GT.0) THEN
        I1=I1+50
        GOTO 32
      END IF
   40 CONTINUE
      CALL CONVERT
      DO 301 I=1,150
        BSCORE(I)=9999
  301 CONTINUE
      NBASE=0
      NBSUM=0
      NC1=0
      call clock(nd1)
      call ranset(2*nd1+1)
      nseed=int(1000000*ranf())
      call ranset(2*nseed+1)
      DO 499 II=1,NBRCHN
      NXCOR(1) = 25
      NYCOR(1) = 25
      NZCOR(1) = 25
      NXCOR(2) = 26
      NYCOR(2) = 25
      NZCOR(2) = 25
      MATRIX(25,25,25) = NLIST(1)
      MATRIX(26,25,25) = NLIST(2)
      XBAR = 25.5
      YBAR = 25
      ZBAR = 25
      do 302 i=1,num
      npos(i)=0
  302 continue
      do 500 i=3,num
        DO 498 J=0,5
          PROB(J) = 0
          PROB1(J) = 0
  498   CONTINUE
        rscsum=0
        NSTART=I
        CALL PLACE
        RNDNUM = RANF()
        IF (RSCSUM.EQ.0) GOTO 499
        DO 501 J=0,5
          PROB(J)=(PROB1(J)/RSCSUM)+prob(j-1)
  501   CONTINUE
        rpsum=0  
        do 703 i5=0,5
          rpsum=rpsum+prob(i5)
  703   continue
        WRITE (9,711) I,RNDNUM
  711   FORMAT(' FOR ATOM # ',I3,' RNDNUM = ',F10.9)
        DO 502 J=0,5
          IF (RNDNUM.LE.PROB(J)) THEN
            NPOS(I)=J
            CALL COORD(I,J)
            CALL COMPCM(NXCOR(I),NYCOR(I),NZCOR(I))
        WRITE(9,607) NXCOR(I),NYCOR(I),NZCOR(I)
  607   FORMAT(' X = ',I5,' Y = ',I5,' Z = ',I5)
            GOTO 503
          END IF
  502   CONTINUE
  503   CONTINUE
  500 CONTINUE
      NFL1 = 1
      NSTOP = NUM
      CALL SCORE
      NFL1 = 0
        NBSUM=NBSUM+MSCORE
        NC1=NC1+1
      WRITE (9,608) II,MSCORE
  608 FORMAT(' COORDS FOR CHAIN # ',I5,' SCORE = ',I7)
      do 605 i=1,num
        matrix(nxcor(i),nycor(i),nzcor(i))=0
        nxcor(i)=0
        nycor(i)=0
        nzcor(i)=0
  605 continue
      REWIND (UNIT=10)
  499 CONTINUE 
      NCOUNT=0
      AVGSC=FLOAT(NBSUM)/FLOAT(NC1)
      WRITE (8,910) NUM
  910 FORMAT (I5)
      I1=0
      I2=NUM
  915 CONTINUE
      READ (8,920) (NLIST(I+I1), I=1,25)
  920 FORMAT (25(A4))
      I2=I2-50
      IF (I2.GT.0) THEN
        I1=I1+25
        GOTO 915
      END IF
      DO 940 I=0,2
      WRITE (8,930) (NS(I,K),K=0,2)
  930 FORMAT(3I5)
  940 CONTINUE
      WRITE (8,950) NSIZE, NBRCHN, MFP, AVGSC
  950 FORMAT (I5,I10,F10.3,F12.5)
      DO 990 K=1,150
      WRITE (8,960) BSCORE(K)
      IF (BSCORE(K).EQ.9999) GOTO 995
      DO 980 I=1,NUM
      WRITE (8,970) I,NXBEST(I,K),NYBEST(I,K),NZBEST(I,K),K
  960 FORMAT(I10)
  970 FORMAT(I3,4I5)
  980 CONTINUE
  990 CONTINUE
  995 CONTINUE
      END
C
C
C
      SUBROUTINE CONVERT
C      
      IMPLICIT INTEGER (I,J,K,L,M,N)
      INTEGER*4 NTOT
      DIMENSION NLIST(150)
      CHARACTER*1 ORIG(150)
      COMMON /A2/NLIST
      COMMON /A3/ ORIG
      COMMON /A4/ NUM, TEST, T1, NTOT, NMAR

      DO 10 I=1,NUM
      IF (ORIG(I).EQ.'C') THEN
         NLIST(I)=1    
         GOTO 10
      END IF
      IF (ORIG(I).EQ.'M') THEN
         NLIST(I)=2    
         GOTO 10
      END IF
      IF (ORIG(I).EQ.'F') THEN
         NLIST(I)=3    
         GOTO 10
      END IF
      IF (ORIG(I).EQ.'I') THEN
         NLIST(I)=4    
         GOTO 10
      END IF
      IF (ORIG(I).EQ.'L') THEN
         NLIST(I)=5    
         GOTO 10
      END IF
      IF (ORIG(I).EQ.'V') THEN
         NLIST(I)=6    
         GOTO 10
      END IF
      IF (ORIG(I).EQ.'W') THEN
         NLIST(I)=7    
         GOTO 10
      END IF
      IF (ORIG(I).EQ.'Y') THEN
         NLIST(I)=8    
         GOTO 10
      END IF
      IF (ORIG(I).EQ.'A') THEN
         NLIST(I)=9   
         GOTO 10
      END IF
      IF (ORIG(I).EQ.'G') THEN
         NLIST(I)=10    
         GOTO 10
      END IF
      IF (ORIG(I).EQ.'T') THEN
         NLIST(I)=11    
         GOTO 10
      END IF
      IF (ORIG(I).EQ.'S') THEN
         NLIST(I)=12    
         GOTO 10
      END IF
      IF (ORIG(I).EQ.'Q') THEN
         NLIST(I)=13    
         GOTO 10
      END IF
      IF (ORIG(I).EQ.'N') THEN
         NLIST(I)=14    
         GOTO 10
      END IF
      IF (ORIG(I).EQ.'E') THEN
         NLIST(I)=15    
         GOTO 10
      END IF
      IF (ORIG(I).EQ.'D') THEN
         NLIST(I)=16    
         GOTO 10
      END IF
      IF (ORIG(I).EQ.'H') THEN
         NLIST(I)=17    
         GOTO 10
      END IF
      IF (ORIG(I).EQ.'R') THEN
         NLIST(I)=18    
         GOTO 10
      END IF
      IF (ORIG(I).EQ.'K') THEN
         NLIST(I)=19    
         GOTO 10
      END IF
      IF (ORIG(I).EQ.'P') THEN
         NLIST(I)=20
      END IF
   10 CONTINUE

      END
C
C
C
      SUBROUTINE PLACE
C
      IMPLICIT INTEGER (I,J,K,L,M,N)
      DIMENSION NPOS(150)
      INTEGER*4 NTOT
      INTEGER MATRIX(50,50,50),NXBEST(150,150),NXCOR(150),NYCOR(150)
      INTEGER BSCORE(150),MSCORE
      INTEGER NYBEST(150,150),NZBEST(150,150),NZCOR(150)
      REAL PROB(6), PROB1(6),RSCSUM
      DIMENSION NLIST(150)
      COMMON /A1/ MATRIX,NXBEST,NYBEST,BSCORE,NXCOR,NYCOR,
     + NZBEST,NZCOR
      COMMON /AA/ PROB,PROB1,RSCSUM,mscore
      COMMON /A2/NLIST
      COMMON /A4/ NUM, TEST, T1, NTOT, NMAR
      COMMON /C1/ NPOS
      COMMON /D1/ NSIZE,NSTART,NSTOP,nfl1
      N = NSTART
      NSTOP = NSTART+NSIZE
      IF (NSTOP.GT.NUM) THEN
        NSTOP=NUM
      END IF
C
CCC   START OF RECURSIVE ALGORITHM
C
   10 CONTINUE
      IF ((NPOS(N).GT.5).AND.(N.GT.NSTART)) THEN
        NPOS(N)=0
        NPOS(N-1)=NPOS(N-1)+1
        MATRIX(NXCOR(N-1),NYCOR(N-1),NZCOR(N-1))=0
        N=N-1
        GOTO 10
      END IF
      IF (NPOS(NSTART).GT.5) GOTO 900
      GOTO (100,200,300,400,500,600) NPOS(N)+1
C
CCC   NORTH
C
  100 CONTINUE
      NX=NXCOR(N-1)
      NY=NYCOR(N-1)-1
      NZ=NZCOR(N-1)
      GOTO 700
C
CCC   EAST
C
  200 CONTINUE
      NX=NXCOR(N-1)+1
      NY=NYCOR(N-1)
      NZ=NZCOR(N-1)
      GOTO 700
C
CCC   SOUTH
C
  300 CONTINUE
      NX=NXCOR(N-1)
      NY=NYCOR(N-1)+1
      NZ=NZCOR(N-1)
      GOTO 700
C
CCC   WEST
C
  400 CONTINUE
      NX=NXCOR(N-1)-1
      NY=NYCOR(N-1)
      NZ=NZCOR(N-1)
      GOTO 700
C
CCC   UP
C
  500 CONTINUE
      NX=NXCOR(N-1)
      NY=NYCOR(N-1)
      NZ=NZCOR(N-1)-1
      GOTO 700
C
CCC   DOWN
C
  600 CONTINUE
      NX=NXCOR(N-1)
      NY=NYCOR(N-1)
      NZ=NZCOR(N-1)+1
  700 CALL CHECK(NX,NY,NZ)
      IF (TEST .EQ. 1) THEN
      MATRIX(NX,NY,NZ)=NLIST(N)
      IF ((N.EQ.NUM).OR.(N.EQ.NSTOP)) THEN
          NXCOR(N)=NX
          NYCOR(N)=NY
          NZCOR(N)=NZ
          CALL SCORE
          NPOS(N)=NPOS(N)+1
          MATRIX(NX,NY,NZ)=0
          GOTO 10
      ELSE
          NXCOR(N)=NX
          NYCOR(N)=NY
          NZCOR(N)=NZ
          N=N+1
          GOTO 10
      END IF
      ELSE
          NPOS(N)=NPOS(N)+1
          GOTO 10
      END IF
  900 CONTINUE
      RETURN 
      END
C
C
C
      SUBROUTINE COORD(N1,NDIR)
      IMPLICIT INTEGER(I,J,K,L,M,N)
      INTEGER*4 NTOT
      INTEGER MATRIX(50,50,50),NXBEST(150,150),NXCOR(150),NYCOR(150)
      INTEGER BSCORE(150),MSCORE
      INTEGER NYBEST(150,150),NZBEST(150,150),NZCOR(150)
      REAL PROB(6), PROB1(6),RSCSUM
      DIMENSION NLIST(150)
      CHARACTER*1 ORIG(150)
      COMMON /A1/ MATRIX,NXBEST,NYBEST,BSCORE,NXCOR,NYCOR,
     + NZBEST,NZCOR
      COMMON /AA/ PROB,PROB1,RSCSUM,mscore
      COMMON /A2/ NLIST
      COMMON /A3/ ORIG
      COMMON /A4/ NUM, TEST, T1, NTOT, NMAR
      COMMON /D1/ NSIZE,NSTART,NSTOP,NFL1
C
      NXCOR(N1)=NXCOR(N1-1)
      NYCOR(N1)=NYCOR(N1-1)
      NZCOR(N1)=NZCOR(N1-1)
      GOTO (100,200,300,400,500,600) NDIR+1
C
  100 CONTINUE
      NYCOR(N1)=NYCOR(N1-1)-1
      GOTO 900
C
  200 CONTINUE
      NXCOR(N1)=NXCOR(N1-1)+1
      GOTO 900
C
  300 CONTINUE
      NYCOR(N1)=NYCOR(N1-1)+1
      GOTO 900
C
  400 CONTINUE
      NXCOR(N1)=NXCOR(N1-1)-1
      GOTO 900
C
  500 CONTINUE
      NZCOR(N1)=NZCOR(N1-1)-1
      GOTO 900
C
  600 CONTINUE
      NZCOR(N1)=NZCOR(N1-1)+1
      GOTO 900
C
  900 CONTINUE
      MATRIX(NXCOR(N1),NYCOR(N1),NZCOR(N1))=NLIST(N1)
      RETURN
      END
C
C
C
      SUBROUTINE COMPCM(NX,NY,NZ)
C
      COMMON /A4/ NUM, TEST, T1, NTOT, NMAR
      COMMON /AD/ XBAR, YBAR,ZBAR
C
      N1 = NUM - 1
      FNUM = FLOAT(NUM)
      XBAR = (XBAR*N1 + NX)/FNUM
      YBAR = (YBAR*N1 + NY)/FNUM
      ZBAR = (ZBAR*N1 + NZ)/FNUM
      RETURN
      END
C
C
C
      SUBROUTINE CHECK(N1,N2,N3)
      IMPLICIT INTEGER (I,J,K,L,M,N)
      INTEGER*4 NTOT
      INTEGER MATRIX(50,50,50),NXBEST(150,150),NXCOR(150),NYCOR(150)
      INTEGER BSCORE(150),MSCORE
      INTEGER NYBEST(150,150),NZBEST(150,150),NZCOR(150)
      REAL PROB(6), PROB1(6),RSCSUM
      COMMON /A1/ MATRIX,NXBEST,NYBEST,BSCORE,NXCOR,NYCOR,
     + NZBEST,NZCOR
      COMMON /AA/ PROB,PROB1,RSCSUM,mscore
      COMMON /A4/ NUM, TEST, T1, NTOT, NMAR
      TEST = 1
      IF (MATRIX(N1,N2,N3).NE.0) THEN
        TEST = 0
        GOTO 999
      END IF
      IF((N1.GT.50).OR.(N2.GT.50).OR.(N3.GT.50).OR.(N1.LE.0).OR.
     +  (N2.LE.0).OR.(N3.LE.0)) THEN
      TEST = 0
        GOTO 999
      END IF
  999 CONTINUE
      RETURN
      END
C
C
C
      SUBROUTINE SCORE
      IMPLICIT INTEGER (I,J,K,L,M,N)
      DIMENSION NPOS(150)
      INTEGER*4 NTOT
      INTEGER MATRIX(50,50,50),NXBEST(150,150),NXCOR(150),NYCOR(150)
      INTEGER BSCORE(150),MSCORE
      INTEGER NYBEST(150,150),NZBEST(150,150),NZCOR(150)
      REAL PROB(6), PROB1(6),RSCSUM
      REAL MFP,VDP
      COMMON /A1/ MATRIX,NXBEST,NYBEST,BSCORE,NXCOR,NYCOR,
     + NZBEST,NZCOR
      COMMON /AA/ PROB,PROB1,RSCSUM,mscore
      COMMON /AB/ MFP
      COMMON /AC/ VDP
      COMMON /AD/ XBAR,YBAR,ZBAR
      COMMON /A4/ NUM, TEST, T1, NTOT, NMAR
      COMMON /C1/ NPOS
      COMMON /C2/ NCTN,NCTD
      COMMON /C3/ NS(20,20)
      COMMON /D1/ NSIZE,NSTART,NSTOP,nfl1
      MSCORE=0
      IF (NSTOP.GT.NUM) THEN 
        NSTOP=NUM
      end if
      NTOT = NTOT + 1
      DO 910 I=1,NSTOP
        NX1=NXCOR(I)
        NY1=NYCOR(I)
        NZ1=NZCOR(I)
        N1=MATRIX(NXCOR(I),NYCOR(I),NZCOR(I))
      NX=NX1
      NY=NY1-1
      NZ=NZ1
      N2=MATRIX(NX,NY,NZ)
      MSCORE=MSCORE+4*NS(N1,N2)
      NX=NX1+1
      NY=NY1
      NZ=NZ1
      N2=MATRIX(NX,NY,NZ)
      MSCORE=MSCORE+4*NS(N1,N2)
      NX=NX1
      NY=NY1+1
      NZ=NZ1
      N2=MATRIX(NX,NY,NZ)
      MSCORE=MSCORE+4*NS(N1,N2)
      NX=NX1-1
      NY=NY1
      NZ=NZ1
      N2=MATRIX(NX,NY,NZ)
      MSCORE=MSCORE+4*NS(N1,N2)
      NX=NX1
      NY=NY1
      NZ=NZ1-1
      N2=MATRIX(NX,NY,NZ)
      MSCORE=MSCORE+4*NS(N1,N2)
      NX=NX1
      NY=NY1
      NZ=NZ1+1
      N2=MATRIX(NX,NY,NZ)
      MSCORE=MSCORE+4*NS(N1,N2)
      NX=NX1+1
      NY=NY1+1
      NZ=NZ1
      N2=MATRIX(NX,NY,NZ)
      MSCORE=MSCORE+NS(N1,N2)
      NX=NX1+1
      NY=NY1-1
      NZ=NZ1
      N2=MATRIX(NX,NY,NZ)
      MSCORE=MSCORE+NS(N1,N2)
      NX=NX1-1
      NY=NY1+1
      NZ=NZ1
      N2=MATRIX(NX,NY,NZ)
      MSCORE=MSCORE+NS(N1,N2)
      NX=NX1-1
      NY=NY1-1
      NZ=NZ1
      N2=MATRIX(NX,NY,NZ)
      MSCORE=MSCORE+NS(N1,N2)
      NX=NX1+1
      NY=NY1
      NZ=NZ1+1
      N2=MATRIX(NX,NY,NZ)
      MSCORE=MSCORE+NS(N1,N2)
      NX=NX1+1
      NY=NY1
      NZ=NZ1-1
      N2=MATRIX(NX,NY,NZ)
      MSCORE=MSCORE+NS(N1,N2)
      NX=NX1-1
      NY=NY1
      NZ=NZ1+1
      N2=MATRIX(NX,NY,NZ)
      MSCORE=MSCORE+NS(N1,N2)
      NX=NX1-1
      NY=NY1
      NZ=NZ1-1
      N2=MATRIX(NX,NY,NZ)
      MSCORE=MSCORE+NS(N1,N2)
      NX=NX1
      NY=NY1+1
      NZ=NZ1+1
      N2=MATRIX(NX,NY,NZ)
      MSCORE=MSCORE+NS(N1,N2)
      NX=NX1
      NY=NY1+1
      NZ=NZ1-1
      N2=MATRIX(NX,NY,NZ)
      MSCORE=MSCORE+NS(N1,N2)
      NX=NX1
      NY=NY1-1
      NZ=NZ1+1
      N2=MATRIX(NX,NY,NZ)
      MSCORE=MSCORE+NS(N1,N2)
      NX=NX1
      NY=NY1-1
      NZ=NZ1-1
      N2=MATRIX(NX,NY,NZ)
      MSCORE=MSCORE+NS(N1,N2)
  910 CONTINUE
      IF (NFL1.EQ.1) THEN
        DO 920 I=1,150
          IF (MSCORE.LE.BSCORE(I)) THEN
            DO 930 J=150,I+1,-1
              CALL COPY1(J,J-1)
  930       CONTINUE
            CALL COPY(I)
            BSCORE(I)=MSCORE
            GOTO 999
          END IF
  920   CONTINUE
      ELSE
        NSCORE=ABS(MSCORE)
        CALL GETVDP(NXCOR(NSTART),NYCOR(NSTART),NZCOR(NSTART),
     +    NPOS(NSTART),XBAR,YBAR,ZBAR,VDP)
        CSCORE=FLOAT(NSCORE)*(MFP**VDP)
        PROB1(NPOS(NSTART))=PROB1(NPOS(NSTART))+CSCORE
        RSCSUM = RSCSUM + CSCORE
      END IF
  999 RETURN
      END
C
C
C
      SUBROUTINE GETVDP(NX,NY,NZ,NDIR,XBAR,YBAR,ZBAR,VDP)
      REAL V1X,V1Y,V1Z,V2X,V2Y,V2Z
      V1X=0
      V1Y=0
      V1Z=0
      GOTO (100,200,300,400,500,600) NDIR+1
C
  100 CONTINUE
      V1Y=-1
      GOTO 700
C
  200 CONTINUE
      V1X=+1
      GOTO 700
C
  300 CONTINUE
      V1Y=+1
      GOTO 700
C
  400 CONTINUE
      V1X=-1
      GOTO 700
C
  500 CONTINUE
      V1Z=-1
      GOTO 700
C
  600 CONTINUE
      V1Z=+1
C
  700 CONTINUE
      V2X=FLOAT(NX)-XBAR
      V2Y=FLOAT(NY)-YBAR
      V2Z=FLOAT(NZ)-ZBAR
      VDP=(V1X*V2X)+(V1Y*V2Y)+(V1Z*V2Z)
      RETURN
      END
C
C
C
      SUBROUTINE COPY(K)
      IMPLICIT INTEGER (I,J,K,L,M,N)
      INTEGER*4 NTOT
      INTEGER MATRIX(50,50,50),NXBEST(150,150),NXCOR(150),NYCOR(150)
      INTEGER BSCORE(150),MSCORE
      INTEGER NYBEST(150,150),NZBEST(150,150),NZCOR(150)
      REAL PROB(6), PROB1(6),RSCSUM
      COMMON /A1/ MATRIX,NXBEST,NYBEST,BSCORE,NXCOR,NYCOR,
     + NZBEST,NZCOR
      COMMON /AA/ PROB,PROB1,RSCSUM,mscore
      COMMON /A4/ NUM, TEST, T1, NTOT, NMAR
      DO 30 I=1,NUM
      NXBEST(I,K)=NXCOR(I)
      NYBEST(I,K)=NYCOR(I)
      NZBEST(I,K)=NZCOR(I) 
   30 CONTINUE
      RETURN
      END
C
C
C
      SUBROUTINE COPY1(J,K)
      IMPLICIT INTEGER (I,J,K,L,M,N)
      INTEGER*4 NTOT
      INTEGER MATRIX(50,50,50),NXBEST(150,150),NXCOR(150),NYCOR(150)
      INTEGER BSCORE(150),MSCORE
      INTEGER NYBEST(150,150),NZBEST(150,150),NZCOR(150)
      REAL PROB(6), PROB1(6),RSCSUM
      COMMON /A1/ MATRIX,NXBEST,NYBEST,BSCORE,NXCOR,NYCOR,
     + NZBEST,NZCOR
      COMMON /AA/ PROB,PROB1,RSCSUM,mscore
      COMMON /A4/ NUM, TEST, T1, NTOT, NMAR
      DO 30 I=1,NUM
      NXBEST(I,J)=NXBEST(I,K)
      NYBEST(I,J)=NYBEST(I,K)
      NZBEST(I,J)=NZBEST(I,K)
   30 CONTINUE
      BSCORE(J)=BSCORE(K)
      RETURN
      END
C
C
C
      SUBROUTINE GETINFO

      IMPLICIT INTEGER (I,J,K,L,M,N)
      CHARACTER*1 RESP
      REAL MFP
      COMMON /AB/ MFP
      COMMON /D1/ NSIZE,NSTART,NSTOP,nfl1
      COMMON /E1/ NBRCHN
C
      WRITE (6,700)
      READ (5,710) NSIZE
      WRITE (6,720)
      READ (5,710) NBRCHN
      WRITE (6,730)
      READ (5,740) MFP
  700 FORMAT(/,' INPUT LOOK-AHEAD VALUE ')
  710 FORMAT(I5)
  720 FORMAT(/,' INPUT NUMBER OF RANDOM WALKS TO COMPUTE ')
  730 FORMAT(/,' INPUT VALUE FOR MEAN-FIELD PARM ')
  740 FORMAT(F5.4)
  999 RETURN
      END

