C      ALGORITHM 456, COLLECTED ALGORITHMS FROM ACM.
C      THIS WORK PUBLISHED IN COMMUNICATIONS OF THE ACM
C      VOL. 16, NO. 9, September, 1973, PP.572--574.
#! /bin/sh
# This is a shell archive, meaning:
# 1. Remove everything above the #! /bin/sh line.
# 2. Save the resulting text in a file.
# 3. Execute the file with /bin/sh (not csh) to create the files:
#	Fortran/
#	Fortran/Sp/
#	Fortran/Sp/Drivers/
#	Fortran/Sp/Drivers/Makefile
#	Fortran/Sp/Drivers/driver.f
#	Fortran/Sp/Drivers/res
#	Fortran/Sp/Src/
#	Fortran/Sp/Src/src.f
# This archive created: Thu Dec 15 13:28:03 2005
export PATH; PATH=/bin:$PATH
if test ! -d 'Fortran'
then
	mkdir 'Fortran'
fi
cd 'Fortran'
if test ! -d 'Sp'
then
	mkdir 'Sp'
fi
cd 'Sp'
if test ! -d 'Drivers'
then
	mkdir 'Drivers'
fi
cd 'Drivers'
if test -f 'Makefile'
then
	echo shar: will not over-write existing file "'Makefile'"
else
cat << "SHAR_EOF" > 'Makefile'
all: Res

src.o: src.f
	$(F77) $(F77OPTS) -c src.f

driver.o: driver.f
	$(F77) $(F77OPTS) -c driver.f

DRIVERS= driver
RESULTS= Res

Objs1= driver.o src.o
driver: $(Objs1)
	$(F77) $(F77OPTS) -o driver $(Objs1) $(SRCLIBS)
Res: driver 
	./driver >Res

diffres:Res res
	echo "Differences in results from driver"
	$(DIFF) Res res

clean: 
	rm -rf *.o $(DRIVERS) $(CLEANUP) $(RESULTS)
SHAR_EOF
fi # end of overwriting check
if test -f 'driver.f'
then
	echo shar: will not over-write existing file "'driver.f'"
else
cat << "SHAR_EOF" > 'driver.f'
      program main

c***********************************************************************
c
cc TOMS456_PRB tests ROUTNG.
c
      implicit none

      integer m
      integer n

      parameter ( m = 15 )
      parameter ( n = 15 )

      integer d(m,m)
      integer en
      integer i
      integer l
      integer n2
      integer p(n)
      integer r
      integer sn
      integer total

      save d

      data d /
     &   0, 29, 82, 46, 68, 52, 72, 42, 51, 55, 29, 74, 23, 72, 46,  
     &  29,  0, 55, 46, 42, 43, 43, 23, 23, 31, 41, 51, 11, 52, 21,  
     &  82, 55,  0, 68, 46, 55, 23, 43, 41, 29, 79, 21, 64, 31, 51,  
     &  46, 46, 68,  0, 82, 15, 72, 31, 62, 42, 21, 51, 51, 43, 64,  
     &  68, 42, 46, 82,  0, 74, 23, 52, 21, 46, 82, 58, 46, 65, 23,  
     &  52, 43, 55, 15, 74,  0, 61, 23, 55, 31, 33, 37, 51, 29, 59,  
     &  72, 43, 23, 72, 23, 61,  0, 42, 23, 31, 77, 37, 51, 46, 33,  
     &  42, 23, 43, 31, 52, 23, 42,  0, 33, 15, 37, 33, 33, 31, 37,  
     &  51, 23, 41, 62, 21, 55, 23, 33,  0, 29, 62, 46, 29, 51, 11,  
     &  55, 31, 29, 42, 46, 31, 31, 15, 29,  0, 51, 21, 41, 23, 37,  
     &  29, 41, 79, 21, 82, 33, 77, 37, 62, 51,  0, 65, 42, 59, 61,  
     &  74, 51, 21, 51, 58, 37, 37, 33, 46, 21, 65,  0, 61, 11, 55,  
     &  23, 11, 64, 51, 46, 51, 51, 33, 29, 41, 42, 61,  0, 62, 23,  
     &  72, 52, 31, 43, 65, 29, 46, 31, 51, 23, 59, 11, 62,  0, 59,  
     &  46, 21, 51, 64, 23, 59, 33, 37, 11, 37, 61, 55, 23, 59,  0 /

      write ( *, '(a)' ) ' '
      write ( *, '(a)' ) 'TOMS456_PRB'
      write ( *, '(a)' ) '  Test TOMS algorithm 456, for'
      write ( *, '(a)' ) '  the routing problem.'

      sn = 1
      en = 1
      r = 5
      do i = 1, n
        p(i) = i
      end do
     
      write ( *, '(a)' ) ' '
      write ( *, '(a,i6)' ) '  Start node SN =    ', sn
      write ( *, '(a,i6)' ) '  End node EN =      ', en
      write ( *, '(a,i6)' ) '  Number of trials = ', r

      call routng ( n, p, sn, en, m, d, l, r )

      write ( *, '(a)' ) ' '
      write ( *, '(a,i6)' ) 
     &  '  The length of the optimal connection is ', l

      write ( *, '(a)' ) ' '
      write ( *, '(a)' ) '  Connection sequence:'
      write ( *, '(a)' ) ' '

      total = 0.0
      do i = 1, n
        write ( *, '(2x,i6,2x,i6)' ) p(i), total
        if ( i .lt. n ) then
          total = total + d(p(i),p(i+1))
        end if
      end do

      sn = 1
      en = 13
      r = 5
      do i = 1, n
        p(i) = i
      end do

      write ( *, '(a)' ) ' '
      write ( *, '(a,i6)' ) '  Start node SN =    ', sn
      write ( *, '(a,i6)' ) '  End node EN =      ', en
      write ( *, '(a,i6)' ) '  Number of trials = ', r

      call routng ( n, p, sn, en, m, d, l, r )

      write ( *, '(a)' ) ' '
      write ( *, '(a,i6)' ) 
     &  '  The length of the optimal connection is ', l

      write ( *, '(a)' ) ' '
      write ( *, '(a)' ) '  Connection sequence:'
      write ( *, '(a)' ) ' '

      total = 0.0
      do i = 1, n
        write ( *, '(2x,i6,2x,i6)' ) p(i), total
        if ( i .lt. n ) then
          total = total + d(p(i),p(i+1))
        end if
      end do

      sn = 1
      en = 0
      r = 5
      do i = 1, n
        p(i) = i
      end do

      write ( *, '(a)' ) ' '
      write ( *, '(a,i6)' ) '  Start node SN =    ', sn
      write ( *, '(a,i6)' ) '  End node EN =      ', en
      write ( *, '(a,i6)' ) '  Number of trials = ', r

      call routng ( n, p, sn, en, m, d, l, r )

      write ( *, '(a)' ) ' '
      write ( *, '(a,i6)' ) 
     &  '  The length of the optimal connection is ', l

      write ( *, '(a)' ) ' '
      write ( *, '(a)' ) '  Connection sequence:'
      write ( *, '(a)' ) ' '

      total = 0.0
      do i = 1, n
        write ( *, '(2x,i6,2x,i6)' ) p(i), total
        if ( i .lt. n ) then
          total = total + d(p(i),p(i+1))
        end if
      end do

      n2 = 5
      sn = 1
      en = 5
      r = 5
      do i = 1, n2
        p(i) = i
      end do

      write ( *, '(a)' ) ' '
      write ( *, '(a,i6)' ) '  Start node SN =    ', sn
      write ( *, '(a,i6)' ) '  End node EN =      ', en
      write ( *, '(a,i6)' ) '  Number of trials = ', r

      call routng ( n2, p, sn, en, m, d, l, r )

      write ( *, '(a)' ) ' '
      write ( *, '(a,i6)' ) 
     &  '  The length of the optimal connection is ', l

      write ( *, '(a)' ) ' '
      write ( *, '(a)' ) '  Connection sequence:'
      write ( *, '(a)' ) ' '

      total = 0.0
      do i = 1, n2
        write ( *, '(2x,i6,2x,i6)' ) p(i), total
        if ( i .lt. n2 ) then
          total = total + d(p(i),p(i+1))
        end if
      end do

      write ( *, '(a)' ) ' '
      write ( *, '(a)' ) 'TOMS456_PRB'
      write ( *, '(a)' ) '  Normal end of execution.'

      stop
      end
SHAR_EOF
fi # end of overwriting check
if test -f 'res'
then
	echo shar: will not over-write existing file "'res'"
else
cat << "SHAR_EOF" > 'res'
 
TOMS456_PRB
  Test TOMS algorithm 456, for
  the routing problem.
 
  Start node SN =         1
  End node EN =           1
  Number of trials =      5
 
  The length of the optimal connection is    291
 
  Connection sequence:
 
       1       0
      11      29
       4      50
       6      65
       8      88
      10     103
      14     126
      12     137
       3     158
       7     181
       5     204
       9     225
      15     236
       2     257
      13     268
 
  Start node SN =         1
  End node EN =          13
  Number of trials =      5
 
  The length of the optimal connection is    268
 
  Connection sequence:
 
       1       0
      11      29
       4      50
       6      65
       8      88
      10     103
      14     126
      12     137
       3     158
       7     181
       5     204
       9     225
      15     236
       2     257
      13     268
 
  Start node SN =         1
  End node EN =           0
  Number of trials =      5
 
  The length of the optimal connection is    262
 
  Connection sequence:
 
       1       0
      13      23
       2      34
      15      55
       9      66
       5      87
       7     110
       3     133
      12     154
      14     165
      10     188
       8     203
       6     226
       4     241
      11     262
 
  Start node SN =         1
  End node EN =           5
  Number of trials =      5
 
  The length of the optimal connection is    189
 
  Connection sequence:
 
       1       0
       2      29
       4      75
       3     143
       5     189
 
TOMS456_PRB
  Normal end of execution.
SHAR_EOF
fi # end of overwriting check
cd ..
if test ! -d 'Src'
then
	mkdir 'Src'
fi
cd 'Src'
if test -f 'src.f'
then
	echo shar: will not over-write existing file "'src.f'"
else
cat << "SHAR_EOF" > 'src.f'
      SUBROUTINE ROUTNG ( N, P, SN, EN, M, D, L, R )
C     .. Scalar Arguments ..
      INTEGER EN,L,M,N,R,SN
C     ..
C     .. Array Arguments ..
      INTEGER D(M,M),P(N)
C     ..
C     .. Local Scalars ..
      INTEGER I,I1,ICOR,ICOUNT,INC,IP,IP1,IR,IR1,IRS,J,J1,JE,JP,JP1,JS,
     +        K,K1,L1,LARGE,LN,LR,MININC,N1
C     ..
C     .. Local Arrays ..
      INTEGER ID(60),Q(60)
C     ..
C  N  - NUMBER OF NODES TO BE CONNECTED.
C  P  - NODE NUMBER VECTOR (IN OUTPUT, OPTIMAL CONNECTION).
C  SN - START NODE NUMBER.
C  EN - END NODE NUMBER.
C  M  - DISTANCE MATRIX ORDER.
C  D  - DISTANCE MATRIX.
C  L  - SHORTEST CONNECTION LENGTH (OUTPUT).
C  R  - NUMBER OF RUNS.
C  GET LARGE NUMBER ( = N X MAX D(I,J) ).
      LARGE = 0
      DO 20 I = 1, M
        DO 10 J = 1, M
          IF ( D(I,J) .GT. LARGE ) LARGE = D(I,J)
10      CONTINUE
20    CONTINUE
      LARGE = LARGE * N
C  DEFINE NON-EXISTING ARCS BY ASSIGNING
C  THEIR DISTANCES LARGE NEGATIVE VALUES.
      IF ( EN .NE. 0 ) GO TO 40
      DO 30 I = 1, M
        ID(I) = D(I,SN)
        D(I,SN) = -LARGE
        D(SN,SN) = 0
30    CONTINUE
40    IF ( SN .EQ. EN .OR. EN .EQ. 0 ) GO TO 50
      ID(1) = D(EN,SN)
      D(EN,SN) = -LARGE
C  RUN R TRIALS.
50    L = LARGE
      DO 280 IRS = 1, R
C  BUILD TOUR BY SUCCESSIVE INSERTING
C  NOT-YET-INVOLVED NODES.
C  INITIATE TOUR IS CONSIDERED AS 
C  ARC P(1) TO P(1).
        DO 90 JS = 2, N
          MININC = LARGE
C  TRACE ALL NOT-YET-INVOLVED NODES
C  TO CHOOSE THE ONE WITH MINIMUM INCREMENT.
          DO 70 J = JS, N
            JP = P(J)
            JE = JS - 1
C  FOR EACH NOT-YET-INVOLVED NODE TRACE ALREADY
C  BUILT-UP TOUR TO CHOOSE THE MINIMUM INCREMENT ARC.
            DO 60 I = 1, JE
              IP = P(I)
              IP1 = P(I+1)
              IF ( I .EQ. JE ) IP1 = P(1)
              INC = D(IP,JP) + D(JP,IP1) - D(IP,IP1)
              IF ( INC .GE. MININC ) GO TO 60
              J1 = J
              I1 = I
              MININC = INC
60          CONTINUE
70        CONTINUE
C  STRETCH TOUR BY INSERTING THE CHOSEN NODE P(J1)
C  BETWEEN THE NODES P(I1) AND P(I1+1).
80        J1 = J1 - 1
          IF ( J1 .EQ. I1 ) GO TO 90
          IP = P(J1)
          P(J1) = P(J1+1)
          P(J1+1) = IP
          GO TO 80
90      CONTINUE
C  CORRECT TOUR BY 3-OPT METHOD.
C  VARY CONSECUTIVE CHAIN LENGTH K.
        N1 = N - 1
        IF ( N .LT. 3 ) GO TO 210
        DO 200 K = 1, N1
          ICOUNT = 0
C  SHIFT CONSECUTIVE CHAIN
C  THROUGHOUT SEQUENCE OF N NODES.
100       ICOR = 0
          DO 190 J = 1, N
C  CALCULATE CHAIN LENGTH IN FORWARD
C  AND BACKWARD DIRECTION.
            L1 = 0
            LR = 0
            IF ( K .EQ. 1 ) GO TO 120
            I = J
            K1 = 1
110         IF ( I .GT. N ) I = I - N
            IP = P(I)
            IP1 = I + 1
            IF ( IP1 .GT. N ) IP1 = 1
            IP1 = P(IP1)
            L1 = L1 + D(IP,IP1)
            LR = LR + D(IP1,IP)
            I = I + 1
            K1 = K1 + 1
            IF ( K1 .LT. K ) GO TO 110
C  FOR EACH POSITIONED CHAIN (AS IS AND INVERTED)
C  CHECK ALL ARCS IF INSERTION IMPROVES TOUR.
120         MININC = LARGE
            J1 = J + K - 1
            IF ( J1 .GT. N ) J1 = J1 - N
            DO 150 I = 1, N
              IF ( J .LE. J1 .AND. ( I .GE. J .AND. I .LE. J1 ) )
     &          GO TO 150
              IF ( J .GT. J1 .AND. ( I .LE. J1 .OR. I .GE. J ) )
     &          GO TO 150
              IP = P(I)
              JP = P(J)
              JP1 = P(J1)
              IP1 = I + 1
              IF ( IP1 .GT. N ) IP1 = 1
              JE = IP1
              IF ( IP1 .EQ. J ) IP1 = J1 + 1
              IF ( IP1 .GT. N ) IP1 = 1
              IP1 = P(IP1)
              LN = L1
              IR = 0
130           INC = D(IP,JP) + LN + D(JP1,IP1) - D(IP,IP1)
              IF ( INC .GT. MININC .OR. ( INC .EQ. MININC .AND.
     &          ( JE .NE. J .OR. ( JE .EQ. J .AND. IR .EQ. 1 ) ) ) ) 
     &          GO TO 140
              I1 = I
              IR1 = IR
              MININC = INC
140           IF ( IR .EQ. 1 ) GO TO 150
              IR = 1
              LN = LR
              JS = JP
              JP = JP1
              JP1 = JS
              GO TO 130
150         CONTINUE
            I = I1 + 1
            IF ( I .GT. N ) I = 1
            IF ( I .EQ. J .AND. IR1 .EQ. 0 ) GO TO 190
C  REINSERT CHAIN OF LENGTH K STARTING IN J
C  BETWEEN NODES P(I1) AND P(I1+1).
            ICOR = 1
            JS = J
            JE = 0
            IF ( IR1 .EQ. 0 ) GO TO 160
            JS = J1
            JE = -1
160         K1 = 0
170         K1 = K1 + 1
            IF ( K1 .GT. K ) GO TO 190
            I = JS
            JS = JS + JE
            IF ( JS .LT. 1 ) JS = N
180         IP = I + 1
            IF ( IP .GT. N ) IP = 1
            JP = P(I)
            P(I) = P(IP)
            P(IP) = JP
            I = I + 1
            IF ( I .GT. N ) I = 1
            IF ( IP - I1 ) 180, 170, 180
190       CONTINUE
          IF ( ICOR .EQ. 0 ) GO TO 200
          ICOUNT = ICOUNT + 1
          IF ( ICOUNT .LT. N ) GO TO 100
200     CONTINUE
C  ORIENT TOUR WITH SN IN P(1).
210     DO 230 I = 1, N
          IF ( P(1) .EQ. SN ) GO TO 240
          JS = P(1)
          DO 220 J = 1, N1
            P(J) = P(J+1)
220       CONTINUE
          P(N) = JS
230     CONTINUE
C  CALCULATE TOUR LENGTH.
240     L1 = 0
        DO 250 I = 1, N1
          IP = P(I)
          IP1 = P(I+1)
          L1 = L1 + D(IP,IP1)
250     CONTINUE
        IP = P(1)
        IF ( SN .EQ. EN ) L1 = L1 + D(IP1,IP)
C  SAVE SOLUTION, IF BETTER, AND SET NEW INITIATE NODE.
        IF ( L1 .GE. L ) GO TO 270
        L = L1
        DO 260 I = 1,  N
          Q(I) = P(I)
260     CONTINUE
270     J = IRS + 1
        IF ( J .GT. N ) J = J - N
        JS = P(1)
        P(1) = P(J)
        P(J) = JS
280   CONTINUE
C  RESTORE P AND DUMMY DISTANCES.
      DO 290 I = 1, N
        P(I) = Q(I)
290   CONTINUE
      IF ( EN .NE. 0 ) GO TO 310
      DO 300 I = 1, M
        D(I,SN) = ID(I)
300   CONTINUE
310   IF ( SN .EQ. EN .OR. EN .EQ. 0 ) GO TO 320
      D(EN,SN) = ID(1)
320   RETURN
      END
SHAR_EOF
fi # end of overwriting check
cd ..
cd ..
cd ..
#       End of shell archive
exit 0