C C FILENAMES: CHARACTER*80 FILE2 C C LOGICAL UNIT NUMBERS: INTEGER LU2 PARAMETER (LU2=2) C C ARRAY DIMENSIONS: INTEGER MLE,MH,MSPINE PARAMETER (MLE=600,MH=MLE**2+1,MSPINE=MLE*(MLE+1)/2) C INTEGER ISP1(MSPINE),ISP2(MSPINE),ISP3(MSPINE) C C....................................................................... C NH=100 FILE2='NET.FS' WRITE(*,'(A)') *'+ENTER MAXIMUM F.S. SIZE (100), AND F.S. FILENAME (''NET.FS''): ' READ(*,*) NH,FILE2 NH=NH*NH+1 IF(NH.GT.MH) THEN STOP 'ERROR: TOO LARGE FORWARD STAR.' END IF OPEN(LU2,FILE=FILE2) C DH=1./SQRT(12.*FLOAT(NH)) DH=DH/2. NFS=1 NSPINE=0 DO 69 IH=1,NH DO 58 I1=INT(SQRT(FLOAT(IH)/3.)-DH+1.),INT(SQRT(FLOAT(IH))+DH) I=IH-I1*I1 DO 57 I2=INT(SQRT(FLOAT(I)/2.)-DH+1.), * MIN0(INT(SQRT(FLOAT(I))+DH),I1) I3I3=I-I2*I2 I3=INT(SQRT(FLOAT(I3I3))+0.500) IF(I3*I3.EQ.I3I3.AND.I3.LE.I2) THEN IF(I3.EQ.0) THEN DO 10 J=2,I1 IF(MOD(I1,J).EQ.0.AND.MOD(I2,J).EQ.0) THEN GO TO 56 END IF 10 CONTINUE C C NEW SPINE NSPINE=NSPINE+1 IF(NSPINE.GT.MSPINE) THEN STOP 'ERROR: TOO MANY SPINES.' END IF ISP1(NSPINE)=I3 ISP2(NSPINE)=I2 ISP3(NSPINE)=I1 C 56 CONTINUE END IF END IF 57 CONTINUE 58 CONTINUE C IF(IH.EQ.NFS*NFS+1) THEN WRITE(*,'(A,I7,2I8)') '+',NFS,NSPINE WRITE(LU2,'(I3,I6,I7,E13.6)') NFS,NSPINE WRITE(LU2,'(8(3I3,1X))') (ISP1(I),ISP2(I),ISP3(I),I=1,NSPINE) NFS=NFS+1 END IF 69 CONTINUE WRITE(LU2,'(I3,I6,I7,E13.6)') 0,0 C STOP END C C======================================================================= C