!************************************************************* !* THE TRANSPORT MODEL * !* -------------------- * !* * !* LIST OF MAIN VARIABLES: * !* * !* ISOU : NUMBER OF SOURCES * !* IDES : NUMBER OF DESTINATIONS * !* XM(ISOU,IDES) : RESOURCES DISTRIBUTION * !* C(ISOU,IDES) : UNITARY TRANSPORT COSTS * !* R(ISOU,IDES) : PATH SEARCH * !* P(4,ISOU+IDES): TABLE OF FOUND PATHS * !* DAO(ISOU) : AVAILABLE SOURCE QUANTITIES * !* RAD(IDES) : REQUIRED DESTINATION QUANTITIES * !* IX, IY : AUXILIARY VARIABLES AT TRANSPORT PATH * !* CC : PATH COST * !* XINFCC : MINIMUM OF PATH COSTS * !* NR : NUMBER OF KNOWN MARKS * !* IF1 : FLAG FOR MARKS STILL TO ELIMINATE * !* ID : DISPLACEMENT LENGTH * !* TT : TRANSPORT TOTAL QUANTITY * !* LT : TOTAL PATH LENGTH * !* CT : TOTAL TRANSPORT COST * !* IOPTIMAL : FLAG=1, IF OPTIMALITY IS FOUND * !* QT : TRANSPORT QUANTUTY FOR ONE PATH * !* --------------------------------------------------------- * !* PROBLEM DESCRIPTION * !* A papermaker owns three factories respectively producing * !* monthly 5000, 10000 and 6000 tons. He has to deliver the * !* following quantities respectively to four customers in * !* different cities: 2000 T (Paris), 11000 T (Lyon), 4000 T * !* (Marseille) and 4000 T (Grenoble) at the lowest total * !* transportation cost. The transport costs grid is the * !* following: * !* PARIS LYON MARSEILLE GRENOBLE * !* FACTORY 1 200 700 800 very high * !* FACTORY 2 400 400 500 500 * !* FACTORY 3 400 500 600 600 * !* --------------------------------------------------------- * !* SAMPLE RUN: * !* * !* TRANSPORT MODEL * !* * !* NUMBER OF SOURCES ? 3 * !* * !* NUMBER OF DESTINATIONS ? 4 * !* * !* INPUT THE AVAILABLE SOURCE QUANTITIES: * !* SOURCE #1 ? 5000 * !* SOURCE #2 ? 10000 * !* SOURCE #3 ? 6000 * !* * !* INPUT THE REQUIRED DESTINATION QUANTITIES: * !* DESTINATION #1 ? 2000 * !* DESTINATION #2 ? 11000 * !* DESTINATION #3 ? 4000 * !* DESTINATION #4 ? 4000 * !* * !* INPUT TRANSPORT COSTS MATRIX: * !* FROM SOURCE #1 TO DESTINATION #1 ? 200 * !* FROM SOURCE #1 TO DESTINATION #2 ? 700 * !* FROM SOURCE #1 TO DESTINATION #3 ? 800 * !* FROM SOURCE #1 TO DESTINATION #4 ? 9999 * !* FROM SOURCE #2 TO DESTINATION #1 ? 400 * !* FROM SOURCE #2 TO DESTINATION #2 ? 400 * !* FROM SOURCE #2 TO DESTINATION #3 ? 500 * !* FROM SOURCE #2 TO DESTINATION #4 ? 500 * !* FROM SOURCE #3 TO DESTINATION #1 ? 400 * !* FROM SOURCE #3 TO DESTINATION #2 ? 500 * !* FROM SOURCE #3 TO DESTINATION #3 ? 600 * !* FROM SOURCE #3 TO DESTINATION #4 ? 600 * !* * !* TRANSPORT MODEL * !* * !* TRANSPORTS: * !* FROM SOURCE #1 TO DESTINATION #1: 2000.00 * !* FROM SOURCE #1 TO DESTINATION #2: 3000.00 * !* FROM SOURCE #2 TO DESTINATION #2: 8000.00 * !* FROM SOURCE #2 TO DESTINATION #3: 2000.00 * !* FROM SOURCE #3 TO DESTINATION #3: 2000.00 * !* FROM SOURCE #3 TO DESTINATION #4: 4000.00 * !* * !* TOTAL TRANSPORT COST: 10300000.0 * !* * !* --------------------------------------------------------- * !* REFERENCE: * !* Modèles pratiques de décision Tome 2, By Jean-Pierre * !* Blanger, PSI Editions, France, 1982. * !* * !* F90 Release 1.0 By J-P Moreau, Paris. * !* (www.jpmoreau.fr) * !************************************************************* PROGRAM TRANSPORT parameter(NMAX=10) real DAO(1:NMAX), RAD(1:NMAX) real C(1:NMAX, 1:NMAX) Call Init(ISOU,IDES,DAO,RAD,C) !INITIALIZE DATA Call Main(ISOU,IDES,DAO,RAD,C) !STEPPING STONE stop END Subroutine Init(ISOU,IDES,DAO,RAD,C) !INITIALIZE DATA parameter(NMAX=10) real DAO(1:NMAX), RAD(1:NMAX) real C(1:NMAX, 1:NMAX) PRINT *,' ' PRINT *,' TRANSPORT MODEL' PRINT *,' ' WRITE(*,10,advance='no'); READ *, ISOU PRINT *,' ' WRITE(*,20,advance='no'); READ *, IDES PRINT *,' ' PRINT *,' INPUT THE AVAILABLE SOURCE QUANTITIES:' DO I = 1, ISOU WRITE(*,30,advance='no') I; READ *, DAO(I) END DO PRINT *,' ' PRINT *,' INPUT THE REQUIRED DESTINATION QUANTITIES:' DO I = 1, IDES WRITE(*,40,advance='no') I; READ *, RAD(I) END DO PRINT *,' ' PRINT *,' INPUT TRANSPORT COSTS MATRIX:' DO I=1, ISOU DO J=1, IDES WRITE(*,50,advance='no') I, J READ *, C(I,J) END DO END DO PRINT *,' ' PRINT *,' TRANSPORT MODEL' PRINT *,' ' RETURN 10 FORMAT(' NUMBER OF SOURCES ? ') 20 FORMAT(' NUMBER OF DESTINATIONS ? ') 30 FORMAT(' SOURCE #',I1,' ? ') 40 FORMAT(' DESTINATION #',I1,' ? ') 50 FORMAT(' FROM SOURCE #',I1,' TO DESTINATION #',I1,' ? ') END Subroutine Main(ISOU,IDES,DAO,RAD,C) !STEPPING STONE MAIN ALGORITHM parameter(NMAX=10) real DAO(1:NMAX), RAD(1:NMAX) real C(1:NMAX, 1:NMAX) real XM(1:NMAX,1:NMAX) call CORNER(ISOU,IDES,DAO,RAD,C,XM) !N-W CORNER call OPTIMAL(ISOU,IDES,DAO,RAD,C,XM) !PATH OPTIMIZATIONS call TCOST(ISOU,IDES,C,XM) !TOTAL COST RETURN END Subroutine CORNER(ISOU,IDES,DAO,RAD,C,XM) !N-W CORNER parameter(NMAX=10) real DAO(1:NMAX), RAD(1:NMAX) real C(1:NMAX, 1:NMAX) real XM(1:NMAX,1:NMAX) I=1; J=1 20 IF (DAO(I)<=RAD(J)) GOTO 50 XM(I,J)=XM(I,J)+RAD(J); DAO(I)=DAO(I)-RAD(J) RAD(J)=0; J=J+1 GOTO 60 !ELSE 50 XM(I,J)=XM(I,J)+DAO(I); RAD(J)=RAD(J)-DAO(I) DAO(I)=0; I=I+1 60 IF (I<=ISOU.AND.J<=IDES) GOTO 20 RETURN End Subroutine OPTIMAL(ISOU,IDES,DAO,RAD,C,XM) !PATH OPTIMIZATIONS parameter(NMAX=10) real DAO(1:NMAX), RAD(1:NMAX) real C(1:NMAX, 1:NMAX) real XM(1:NMAX,1:NMAX) real R(0:NMAX,0:NMAX) integer P(4, 2*NMAX+5) 10 XINFCC=0 DO I=1, ISOU DO J=1, IDES IF (XM(I,J).NE.0) GOTO 70 CALL SEEKPATH(I,J,ISOU,IDES,DAO,RAD,C,R,XM,XINFCC) CALL INCREASE(I,J,ISOU,IDES,DAO,RAD,C,P,R,XM,XINFCC,TT,LT) 70 END DO END DO IF (XINFCC>=0) THEN IOPTIMAL=1 GOTO 150 END IF DO I=1, LT IX=P(3,I); IY=P(4,I) IF (I/2.EQ.INT(I/2)) THEN XM(IX,IY)=XM(IX,IY)-TT GOTO 140 END IF XM(IX,IY)=XM(IX,IY)+TT 140 END DO 150 IF (IOPTIMAL.EQ.0) GOTO 10 RETURN END SUBROUTINE SEEKPATH(I,J,ISOU,IDES,DAO,RAD,C,R,XM,XINFCC) parameter(NMAX=10) real DAO(1:NMAX), RAD(1:NMAX) real C(1:NMAX, 1:NMAX) real XM(1:NMAX,1:NMAX) real R(0:NMAX,0:NMAX) DO I1=1, ISOU DO I2=1, IDES R(I1,I2)=XM(I1,I2) END DO END DO DO I1=1, ISOU R(I1,0)=0. END DO DO I2=1, IDES R(0,I2)=0. END DO R(I,J)=1. 70 DO I2=1, IDES IF (R(0,I2).EQ.1.) GOTO 160 NR=0 DO I1=1, ISOU IF (R(I1,I2).NE.0.) NR=NR+1 END DO IF (NR.NE.1) GOTO 160 DO I1=1, ISOU R(I1,I2)=0. END DO R(0,I2)=1.; IF1=1 160 END DO DO I1=1, ISOU IF (R(I1,0).EQ.1.) GOTO 260 NR=0 DO I2=1, IDES IF (R(I1,I2).NE.0.) NR=NR+1 END DO IF (NR.NE.1) GOTO 260 DO I2=1, IDES R(I1,I2)=0. END DO R(I1,0)=1.; IF1=1 260 END DO IF (IF1.EQ.1) THEN IF1=0; GOTO 70 END IF RETURN END Subroutine INCREASE(I,J,ISOU,IDES,DAO,RAD,C,P,R,XM,XINFCC,TT,LT) parameter(NMAX=10) real DAO(1:NMAX), RAD(1:NMAX) real C(1:NMAX, 1:NMAX) real XM(1:NMAX,1:NMAX) real R(0:NMAX,0:NMAX) integer P(4, 2*NMAX+5) P(1,1)=I; P(2,1)=J; IX=I; IY=J; ID=1; CC=0; QT=999999. 20 ID=ID+1; IF1=0 DO I1=1, ISOU IF (R(I1,IY).EQ.0..OR.I1.EQ.IX) GOTO 70 P(1,ID)=I1; P(2,ID)=IY; IX=I1; CC=CC-C(IX,IY) IF1=1 IF (XM(IX,IY)0) QT=XM(IX,IY) GOTO 80 70 END DO 80 IF (IF1.EQ.0) GOTO 170 ID=ID+1; IF1=0 DO I2=1, IDES IF (R(IX,I2).EQ.0..OR.I2.EQ.IY) GOTO 130 P(1,ID)=IX; P(2,ID)=I2; IY=I2; CC=CC+C(IX,IY) IF1=1 GOTO 140 130 END DO 140 IF (IF1.EQ.0) GOTO 170 IF (IX.NE.I.OR.IY.NE.J) GOTO 20 GOTO 180 170 PRINT *,' DEGENERATE SOLUTION !' STOP 180 IF (CC>0.OR.CC>XINFCC) GOTO 230 TT=QT; XINFCC=CC; ID=ID-1; LT=ID DO I1=1, ID P(3,I1)=P(1,I1); P(4,I1)=P(2,I1) END DO 230 RETURN END Subroutine TCOST(ISOU,IDES,C,XM) !TOTAL COST parameter(NMAX=10) real C(1:NMAX, 1:NMAX) real XM(1:NMAX,1:NMAX) CT=0. PRINT *,' ' PRINT *,' TRANSPORTS:' DO I=1, ISOU DO J=1, IDES CT=CT+XM(I,J)*C(I,J) IF (XM(I,J).EQ.0.) GOTO 10 WRITE(*,20) I, J, XM(I,J) 10 END DO END DO PRINT *,' ' WRITE(*,30) CT PRINT *,' ' RETURN 20 FORMAT(' FROM SOURCE #',I1,' TO DESTINATION #',I1,': ',F8.2) 30 FORMAT(' TOTAL TRANSPORT COST: ',F10.1) END !end of file transpor.f90