C--***********************************************************************-- C--** **-- C--** POUR "LE PETIT AMIGA ILLUSTRE" **-- C--** **-- C--** LE PROBLEME DE LA BOITE NOIRE **-- C--** ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ **-- C--** **-- C--** SOURCE EN ABSOFT FORTRAN F77 **-- C--** **-- C--** ANALYSE & PROGRAMMATION : S.M. | X.L | J.M. V. **-- C--** ~~~~~~~~~~~~~~~~~~~~~~~~~ **-- C--** **-- C--** CE SOURCE EST PLACE DANS LE DOMAINE PUBLIC EN FREEWARE **-- C--** **-- C--** ©1992 S.M. **-- C--***********************************************************************-- C234567 INTEGER*2 M(12,12),LIGNE,COLON,I,NBILLE,LANC2,SORTIE,FACE,DIRECT INTEGER*2 LANCE,SORT,C INTEGER*4 A,B,IAMORCE INTEGER*2 LX,LY,CLX,CLY,M2(12,12),NBT,VALEUR,ILFAC(4),FS,TOURNE REAL*4 VAL2 C COMMON M,SORTIE,DIRECT,LX,CLX,LY,CLY,LANC2,LANCE,FACE COMMON /STRAT/M2,ILFAC,NBT,FS,SORT C OPEN(1,FILE='BOITE_NOIRE.RES_1') OPEN(2,FILE='BOITE_NOIRE.RES_2') A=1 B=64 C--************************************************************************* C--** C--** C'est ici que l'on place le nombre de billes et la valeur de "l'amorce" C--** pour le générateur de nombre alléaloire. C--** Les places des billes sont de cette manière générées aléatoirement. C--** (Le double signe '**' représente 1 bille dans BOITE_NOIRE.RES_1) C--** NBILLE = 4 IAMORCE = 1019 C--************************************************************************* DO 3 I=1,4 3 ILFAC(I)=0 DO 5 I=1,12 DO 5 J=1,12 M(I,J)=0 5 M2(I,J)=0 DO 10 I=3,10 M(I,1)=I-2 M2(I,1)=I-2 M(I,12)=27-I M2(I,12)=27-I M(1,I)=35-I M2(1,I)=35-I M(12,I)=6+I 10 M2(12,I)=6+I DO 20 I=2,11 M(I,2)=100 M(I,11)=100 M(2,I)=100 20 M(11,I)=100 DO 30 I=1,NBILLE VAL2=RANDOM(IAMORCE) VALEUR=A+(B-A)*VAL2 VAL2=(VALEUR/8.)+0.875 LIGNE=2+VAL2 COLON=10-(8*(LIGNE-2)-VALEUR) DO 45 WHILE (M(LIGNE,COLON).EQ.999) VAL2=RANDOM(IAMORCE) VALEUR=A+(B-A)*VAL2 VAL2=(VALEUR/8.)+0.875 LIGNE=2+VAL2 COLON=10-(8*(LIGNE-2)-VALEUR) 45 END DO 30 M(LIGNE,COLON)=999 C NBT=0 LANC2=1 DO 65 WHILE ((LANC2.NE.0).AND.(NBT.LT.NBILLE)) SORTIE=0 VAL2=(LANC2/8.)+0.875 FACE=VAL2 CALL AVT1(TOURNE) CALL PERMUT(TOURNE) CALL SFACE CALL LRAYON CALL DSORTIE CALL AVT2(TOURNE) CALL STRATEGIE(TOURNE) C=4-TOURNE CALL PERMUT(C) LANC2=LANC2+8 IF ((LANC2.GT.32).AND.(LANC2.LT.40)) THEN LANC2=LANC2-31 ELSE IF (LANC2.EQ.40) THEN LANC2=0 ENDIF ENDIF 65 END DO DO 60 I=1,12 60 WRITE(1,15) (M(I,J),J=1,12) 15 FORMAT(12(I2,1X)) CALL FINI(NBILLE) WRITE(1,17) (M(1,J),J=1,12) 17 FORMAT(/,12(I2,1X)) WRITE(1,15) (M(2,J),J=1,12) DO 70 I=3,10 70 WRITE(1,15) M(I,1),M(I,2),(M2(I,J),J=3,10),M(I,11),M(I,12) WRITE(1,15) (M(11,J),J=1,12) WRITE(1,15) (M(12,J),J=1,12) STOP END FUNCTION RANDOM(X) INTEGER A,X M=2**20 FM=M A=2**10+3 X=MOD(A*X,M) FX=X RANDOM=FX/FM RETURN END SUBROUTINE SFACE INTEGER*2 M(12,12),SORTIE,DIRECT,LX,LY,CLX,CLY,FACE INTEGER*2 M2(12,12),ILFAC(4),NBT,FS,LANCE,LANC2,SORT COMMON M,SORTIE,DIRECT,LX,CLX,LY,CLY,LANC2,LANCE,FACE COMMON /STRAT/M2,ILFAC,NBT,FS,SORT LX=LANCE+2 LY=3 DIRECT=2 IF (((M(LX-1,LY).EQ.999).OR.(M(LX+1,LY).EQ.999)).AND. 1 (M(LX,LY).NE.999)) THEN SORTIE=M(LX,1) ENDIF CLX=LX CLY=LY IF (M(LX,LY).EQ.999) THEN SORTIE=50 ENDIF RETURN END SUBROUTINE LRAYON INTEGER*2 M(12,12),SORTIE,LX,LY,CLX,CLY,LANC2,FACE,CHANGE,DIRECT INTEGER*2 LANCE COMMON M,SORTIE,DIRECT,LX,CLX,LY,CLY,LANC2,LANCE,FACE CHANGE=0 DO 10 WHILE ((M(LX,LY).NE.100).AND.(SORTIE.EQ.0) 1 .AND.(CHANGE.LT.30)) IF (DIRECT.EQ.2) THEN IF (M(LX+1,LY-1).EQ.999) THEN DIRECT=1 LX=LX-1 ELSE IF ((M(LX-1,LY+1).EQ.999).AND.(M(LX+1,LY+1).EQ.999).AND. 1 (M(LX,LY+1).EQ.0)) THEN DIRECT=4 LY=LY-1 ELSE IF ((M(LX-1,LY+1).EQ.999).OR.(M(LX+1,LY+1).EQ.999)) THEN DIRECT=1 LX=LX-1 ELSE IF (M(LX,LY+1).EQ.999) THEN SORTIE=50 ELSE LY=LY+1 ENDIF ENDIF ENDIF ENDIF ELSE IF (DIRECT.EQ.1) THEN IF (M(LX+1,LY+1).EQ.999) THEN DIRECT=4 LY=LY-1 ELSE IF ((M(LX-1,LY+1).EQ.999).AND.(M(LX-1,LY-1).EQ.999).AND. 1 (M(LX-1,LY).EQ.0)) THEN DIRECT=3 LX=LX+1 ELSE IF ((M(LX-1,LY+1).EQ.999).OR.(M(LX-1,LY-1).EQ.999)) THEN DIRECT=4 LY=LY-1 ELSE IF (M(LX-1,LY).EQ.999) THEN SORTIE=50 ELSE LX=LX-1 ENDIF ENDIF ENDIF ENDIF ELSE IF (DIRECT.EQ.4) THEN IF (M(LX-1,LY+1).EQ.999) THEN DIRECT=3 LX=LX+1 ELSE IF ((M(LX-1,LY-1).EQ.999).AND.(M(LX+1,LY-1).EQ.999).AND. 1 (M(LX,LY-1).EQ.0)) THEN DIRECT=2 LY=LY+1 ELSE IF ((M(LX-1,LY-1).EQ.999).OR.(M(LX+1,LY-1).EQ.999)) THEN DIRECT=3 LX=LX+1 ELSE IF (M(LX,LY-1).EQ.999) THEN SORTIE=50 ELSE LY=LY-1 ENDIF ENDIF ENDIF ENDIF ELSE IF (M(LX-1,LY-1).EQ.999) THEN DIRECT=2 LY=LY+1 ELSE IF ((M(LX+1,LY-1).EQ.999).AND.(M(LX+1,LY+1).EQ.999).AND. 1 (M(LX+1,LY).EQ.0)) THEN DIRECT=1 LX=LX-1 ELSE IF ((M(LX+1,LY-1).EQ.999).OR.(M(LX+1,LY+1).EQ.999)) THEN DIRECT=2 LY=LY+1 ELSE IF (M(LX+1,LY).EQ.999) THEN SORTIE=50 ELSE LX=LX+1 ENDIF ENDIF ENDIF ENDIF ENDIF ENDIF ENDIF CHANGE=CHANGE+1 10 END DO IF (CHANGE.EQ.30) THEN SORTIE=50 ENDIF RETURN END SUBROUTINE DSORTIE INTEGER*2 M(12,12),SORTIE,DIRECT,LX,LY,CLX,CLY,LANC2,FACE,LANCE COMMON M,SORTIE,DIRECT,LX,CLX,LY,CLY,LANC2,LANCE,FACE IF ((SORTIE.NE.0).AND.(SORTIE.LT.50)) THEN WRITE(2,15) LANC2,SORTIE ELSE IF (SORTIE.EQ.0) THEN IF (DIRECT.EQ.4) THEN SORTIE=M(LX,LY-1) ELSE IF (DIRECT.EQ.3) THEN SORTIE=M(LX+1,LY) ELSE IF (DIRECT.EQ.2) THEN SORTIE=M(LX,LY+1) ELSE SORTIE=M(LX-1,LY) ENDIF ENDIF ENDIF WRITE(2,15) LANC2,SORTIE 15 FORMAT(' ','LANCEMENT : ',I2,' SORTIE : ',I2) ELSE WRITE(2,25) LANC2 25 FORMAT(' ','LANCEMENT : ',I2,' ABSORPTION OU BOUCLE') ENDIF ENDIF RETURN END SUBROUTINE STRATEGIE(IND1) INTEGER*2 M(12,12),SORTIE,DIRECT,LX,LY,CLX,CLY,LANCE,FACE,FS,IND1 INTEGER*2 ILFAC(4),DPEAU,CPTEUR,M2(12,12),NBT,LANC2,SORT COMMON M,SORTIE,DIRECT,LX,CLX,LY,CLY,LANC2,LANCE,FACE COMMON /STRAT/M2,ILFAC,NBT,FS,SORT IF (SORT.EQ.50) THEN IF ((M2(CLX-1,3).EQ.999).OR.(M2(CLX+1,3).EQ.999)) THEN IF (M2(CLX,3).NE.999) THEN NBT=NBT+1 ENDIF M2(CLX,3)=999 ELSE IF ((LANCE.EQ.1).AND.(M2(3,3).EQ.0)) THEN ILFAC(1+IND1)=1 ENDIF ENDIF ELSE IF ((FS.EQ.3).AND.(LX.EQ.CLX)) THEN DO 10 I=3,10 M2(LX,I)=1 10 M2(LX+1,I)=1 M2(CLX-1,3)=1 M2(CLX+1,3)=1 M2(CLX,3)=1 ELSE IF (FS.EQ.4) THEN IF (LANCE.EQ.2) THEN DO 20 I=3,LY M2(CLX,I)=1 M2(CLX-1,I)=1 20 M2(CLX+1,I)=1 M2(CLX,LY+1)=1 IF ((M2(3,LY+1).EQ.10).AND.(M2(5,LY+1).NE.0)) THEN IF (M2(3,LY+1).NE.999) THEN NBT=NBT+1 ENDIF M2(3,LY+1)=999 ELSE IF (M2(3,LY+1).EQ.1) THEN IF (M2(5,LY+1).NE.999) THEN NBT=NBT+1 ENDIF M2(5,LY+1)=999 ELSE IF (M2(5,LY+1).EQ.1) THEN IF (M2(3,LY+1).NE.999) THEN NBT=NBT+1 ENDIF M2(3,LY+1)=999 ELSE IF (M2(3,LY+1).EQ.999) THEN M2(5,LY+1)=1 ELSE IF (M2(5,LY+1).EQ.999) THEN M2(3,LY+1)=1 ELSE IF (M2(3,LY+1).EQ.10) THEN M2(5,LY+1)=9 ELSE M2(3,LY+1)=9 M2(5,LY+1)=9 ENDIF ENDIF ENDIF ENDIF ENDIF ENDIF ELSE DO 30 I=3,LY M2(CLX,I)=1 30 M2(CLX+1,I)=1 IF (CLX.GT.3) THEN DO 40 I=3,CLX M2(I,LY+1)=1 40 M2(I,LY)=1 ENDIF IF (M2(CLX+1,LY+1).NE.999) THEN NBT=NBT+1 ENDIF M2(CLX+1,LY+1)=999 ENDIF M2(CLX-1,3)=1 M2(CLX+1,3)=1 M2(CLX,3)=1 ELSE IF (FS.EQ.1) THEN IF (LANCE.EQ.1) THEN IF (M2(CLX+1,3).NE.999) THEN NBT=NBT+1 ENDIF M2(CLX+1,3)=999 ELSE IF ((LANCE.EQ.8).AND.(SORT.EQ.8)) THEN IF (M2(CLX-1,3).NE.999) THEN NBT=NBT+1 ENDIF M2(CLX-1,3)=999 ELSE IF (SORT.EQ.LANCE) THEN IF (M2(CLX-1,3).NE.999) THEN IF ((M2(CLX-1,3).EQ.10).AND. 1 (M2(CLX+1,3).NE.999)) THEN IF (M2(CLX-1,3).NE.999) THEN NBT=NBT+1 ENDIF M2(CLX-1,3)=999 IF (((M2(CLX+1,3).EQ.0).OR.(M2(CLX+1,3).EQ.9)) 1 .AND.(M2(CLX+3,3).NE.999)) THEN M2(CLX+1,3)=10 ENDIF ELSE IF (M2(CLX+1,3).EQ.1) THEN LY=3 DO 90 WHILE (M2(CLX-1,LY).EQ.1) LY=LY+1 90 END DO IF (M2(CLX-1,LY).EQ.999) THEN IF (M2(CLX+1,LY).NE.999) THEN NBT=NBT+1 ENDIF M2(CLX+1,LY)=999 DO 100 I=3,LY-1 M2(CLX,I)=1 100 M2(CLX+1,I)=1 ELSE LY=3 DO 95 WHILE (M2(CLX+1,LY).EQ.1) LY=LY+1 95 END DO IF (M2(CLX+1,LY).EQ.999) THEN IF (M2(CLX-1,LY).NE.999) THEN NBT=NBT+1 ENDIF M2(CLX-1,LY)=999 DO 105 I=3,LY-1 M2(CLX,I)=1 105 M2(CLX+1,I)=1 ENDIF ENDIF ELSE IF (M2(CLX+1,3).NE.999) THEN M2(CLX+1,3)=10 ENDIF ENDIF ENDIF ENDIF ELSE IF (SORT.EQ.LANCE-1) THEN LY=3 DPEAU=0 DO 110 WHILE ((M2(CLX,LY).EQ.1) 1 .AND.(DPEAU.EQ.0)) IF ((M2(CLX-1,LY).EQ.999).OR. 1 (M2(CLX+1,LY).EQ.999)) THEN DPEAU=1 ENDIF LY=LY+1 110 END DO IF ((M2(CLX,LY).EQ.999).AND.(DPEAU.EQ.0)) THEN IF (M2(CLX-1,LY).EQ.1) THEN IF (M2(CLX+1,LY).NE.1) THEN IF (M2(CLX+1,LY).NE.999) THEN NBT=NBT+1 ENDIF M2(CLX+1,LY)=999 DO 120 I=3,LY-1 M2(CLX,I)=1 M2(CLX-1,I)=1 120 M2(CLX+1,I)=1 ENDIF ELSE IF (M2(CLX+1,LY).EQ.1) THEN IF (M2(CLX-1,LY).NE.1) THEN IF (M2(CLX-1,LY).NE.999) THEN NBT=NBT+1 ENDIF M2(CLX-1,LY)=999 DO 130 I=3,LY-1 M2(CLX,I)=1 M2(CLX-1,I)=1 130 M2(CLX+1,I)=1 ENDIF ELSE IF ((M2(CLX-1,LY).NE.999).AND. 1 (M2(CLX+1,LY).NE.999)) THEN M2(CLX-1,LY)=9 M2(CLX+1,LY)=9 ENDIF ENDIF ENDIF ENDIF ELSE IF (SORT.EQ.LANCE-2) THEN LY=3 DO 50 WHILE (M2(CLX-3,LY).EQ.1) LY=LY+1 50 END DO IF ((M2(CLX-3,LY).EQ.999).AND.(LX.GT.3) 1 .AND.(LY.GT.3)) THEN DPEAU=0 CPTEUR=3 DO 60 WHILE ((DPEAU.EQ.0).AND.(CPTEUR.LE.LY)) IF ((M2(CLX,CPTEUR).NE.999).AND. 1 (M2(CLX-2,CPTEUR).NE.999).AND. 2 (M2(CLX-1,CPTEUR).NE.999)) THEN CPTEUR=CPTEUR+1 ELSE DPEAU=1 ENDIF 60 END DO IF (DPEAU.EQ.0) THEN IF (M2(CLX+1,LY).NE.999) THEN NBT=NBT+1 ENDIF M2(CLX+1,LY)=999 DO 70 I=3,LY M2(CLX,I)=1 M2(CLX-2,I)=1 70 M2(CLX-1,I)=1 DO 80 I=3,LY-1 M2(CLX+1,I)=1 80 M2(CLX-3,I)=1 ENDIF ENDIF ENDIF ENDIF M2(CLX-1,3)=1 M2(CLX+1,3)=1 M2(CLX,3)=1 ENDIF ENDIF ENDIF ENDIF ENDIF ENDIF ENDIF RETURN END SUBROUTINE FINI(P) INTEGER*2 M2(12,12),ILFAC(4),V1,NBT,RETEN(10,2),FS,SORT,P COMMON /STRAT/M2,ILFAC,NBT,FS,SORT V1=0 IF (NBT.LT.P) THEN IF ((ILFAC(1).EQ.1).AND.(M2(3,3).NE.999).AND. 1 (M2(3,3).NE.1)) THEN M2(3,3)=999 NBT=NBT+1 ENDIF IF ((ILFAC(2).EQ.1).AND.(M2(10,3).NE.999).AND.(NBT.LT.P).AND. 1 (M2(10,3).NE.1)) THEN M2(10,3)=999 NBT=NBT+1 ENDIF IF ((ILFAC(3).EQ.1).AND.(M2(10,10).NE.999).AND.(NBT.LT.P).AND. 1 (M2(10,10).NE.1)) THEN M2(10,10)=999 NBT=NBT+1 ENDIF IF ((ILFAC(4).EQ.1).AND.(M2(3,10).NE.999).AND.(NBT.LT.P).AND. 1 (M2(3,10).NE.1)) THEN M2(3,10)=999 NBT=NBT+1 ENDIF IF (NBT.LT.P) THEN DO 10 I=3,10 DO 10 J=3,10 IF ((M2(I,J).EQ.9).OR.(M2(I,J).EQ.10)) THEN V1=V1+1 RETEN(V1,1)=I RETEN(V1,2)=J ENDIF 10 CONTINUE IF ((V1+NBT).EQ.P) THEN DO 20 I=1,V1 20 M2(RETEN(I,1),RETEN(I,2))=999 ENDIF ENDIF ENDIF RETURN END SUBROUTINE AVT1(TOURNE) INTEGER*2 M(12,12),SORTIE,FS,DIRECT,LX,CLX,LY,CLY,LANC2,FACE INTEGER*2 M2(12,12),ILFAC(4),NBT,TOURNE,LANCE,SORT REAL*4 VAL2 C COMMON M,SORTIE,DIRECT,LX,CLX,LY,CLY,LANC2,LANCE,FACE COMMON /STRAT/M2,ILFAC,NBT,FS,SORT IF (FACE.EQ.1) THEN TOURNE=0 ELSE IF (FACE.EQ.2) THEN TOURNE=1 ELSE IF (FACE.EQ.3) THEN TOURNE=2 ELSE TOURNE=3 ENDIF ENDIF ENDIF VAL2=LANC2-8*TOURNE LANCE=VAL2 RETURN END SUBROUTINE PERMUT(IND1) INTEGER*2 M2(12,12),ILFAC(4),NBT,M(12,12),FS,IND1,M3(12,12),COMP INTEGER*2 M4(12,12),SORT C COMMON M COMMON /STRAT/M2,ILFAC,NBT,FS,SORT COMP=1 DO 10 WHILE (COMP.LE.IND1) K=12 DO 20 I=1,12 DO 15 J=1,12 M4(J,K)=M(I,J) 15 M3(J,K)=M2(I,J) 20 K=K-1 COMP=COMP+1 IF (IND1.GT.0) THEN DO 40 I=1,12 DO 40 J=1,12 M(I,J)=M4(I,J) 40 M2(I,J)=M3(I,J) ENDIF 10 END DO RETURN END SUBROUTINE AVT2(IND1) INTEGER*2 M(12,12),SORTIE,FS,DIRECT,LX,CLX,LY,CLY,LANC2,FACE INTEGER*2 M2(12,12),ILFAC(4),NBT,LANCE,SORT,IND1 REAL*4 VAL2 C COMMON M,SORTIE,DIRECT,LX,CLX,LY,CLY,LANC2,LANCE,FACE COMMON /STRAT/M2,ILFAC,NBT,FS,SORT IF (SORTIE.NE.50) THEN VAL2=(SORTIE/8.)+0.875 FS=VAL2 SORT=SORTIE-8*IND1 ELSE SORT=50 ENDIF IF (FACE.NE.1) THEN IF (FACE.EQ.2) THEN IF (FS.EQ.1) THEN FS=4 ELSE FS=FS-1 ENDIF ELSE IF (FACE.EQ.3) THEN IF (FS.EQ.1) THEN FS=3 ELSE IF (FS.EQ.2) THEN FS=4 ELSE FS=FS-2 ENDIF ENDIF ELSE IF (FS.EQ.4) THEN FS=1 ELSE FS=FS+1 ENDIF ENDIF ENDIF ENDIF RETURN END