! ! =====> Program - P104.F90 ! ! ! CLASS LIST UPDATE PROGRAM ! USES BINARY SEARCH BY NAME ! ! DECLARATION STATEMENTS ! CHARACTER (LEN=25) :: NAMES(100),CNAME INTEGER ID(100),MARKS(100,7),GRADES(7) ! PRINT *, 'This is Program >> P104 = Binary Search' ! ! Tell program where data for READ * is coming from OPEN(UNIT=5, FILE='P104.DAT') ! UNIT=5 is the default input ! ! !=== READ CURRENT STATE OF FILE ! L1: DO J=1,100 READ 15, ID(J),NAMES(J),(MARKS(J,K),K=1,7) 15 FORMAT(I7,1X,A25,7I3) IF (ID(J) == 0) GOTO 101 Print 15, ID(J),NAMES(J),(MARKS(J,K),K=1,7) END DO L1 PRINT 16 16 FORMAT(/'TOO MUCH DATA FOR DEFINED ARRAYS'/ & 'INCREASE ARRAY SIZE AND RERUN'//) STOP 101 NREC=J-1 PRINT 102,NREC 102 FORMAT(/'CLASS LIST UPDATE PROGRAM'/ & I5,' RECORDS ON FILE') L2: DO J=1,100 READ(5,15) KID,CNAME,(GRADES(M),M=1,7) IF (KID == 0) THEN PRINT 202,J-1 202 FORMAT(I5,' UPDATES PROCESSED'/ & / ' UPDATED CLASS LIST') L3: DO K=1,NREC PRINT 211,ID(K),NAMES(K),(MARKS(K,L),L=1,7) 211 FORMAT(I9,2X,A25,7I5) ! !=== LEAVE A BLANK LINE EVERY FIVE LINES OF OUTPUT ! IF (MOD(K,5) == 0) PRINT * END DO L3 STOP ELSE CALL BSERCH(NAMES,NREC,CNAME,KPOS) IF (KPOS < 0) THEN ! !==== PROGRAM SECTION TO ADD ANEW MEMBER TO CLASS LIST ! INSERT=(-KPOS)+1 NREC=NREC+1 ! STARTING FROM THE END OF THE LIST ! MOVE THE DATA DOWN 1 PLACE L4: DO K=NREC,INSERT+1,-1 ID(K)=ID(K-1) NAMES(K)=NAMES(K-1) L5: DO M=1,7 MARKS(K,M)=MARKS(K-1,M) END DO L5 END DO L4 ! NOW ADD NEW DATA IN EMPTY SLOT ID(INSERT)=KID NAMES(INSERT)=CNAME L6: DO M=1,7 MARKS(INSERT,M)=GRADES(M) END DO L6 ! !==== STUDENT FOUND - UPDATE ANY NONZERO GRADES ! ELSE L7: DO I=1,7 IF (GRADES(I) /= 0) THEN MARKS(KPOS,I)=GRADES(I) ENDIF END DO L7 ENDIF ENDIF END DO L2 STOP END ! SUBROUTINE BSERCH(NAMES,N,NAME,KPOS) CHARACTER (LEN=25) :: NAMES(N),NAME ! ! B I N A R Y S E A R C H ! ! USES 3 INTEGER POINTERS, INITIALLY ! LOW - POINTS TO LOCATION BEFORE FIRST ITEM OF LIST ! LAST - POINTS TO LOCATION AFTER LAST ITEM IN LIST ! MID - CALCULATED FROM LOW AND LAST, IS ESSENTIALLY ! HALF WAY BETWEEN LOW AND LAST ! LOW=0 LAST=N+1 10 MID=(LOW+LAST)/2 IF(LOW == MID) GO TO 99 IF(NAMES(MID) == NAME) GO TO 100 IF(NAMES(MID) < NAME) GO TO 200 ! ! NAME IN FIRST HALF OF LIST ! RESET LAST TO BE MID-POINT OF LIST - AND TRY AGAIN ! LAST=MID GO TO 10 ! ! NAME IN SECOND HALF OF LIST ! RESET LOW TO BE MID POINT AND TRY AGAIN ! 200 LOW=MID GO TO 10 ! ! NOT FOUND - SET POSITION POINTER NEGATIVE ! IF ADDITION NEEDED, THEN INSERT AFTER ABS(KPOS) 99 KPOS=-MID RETURN ! FOUND A MATCH 100 KPOS=MID RETURN END DATA: 9611684 Bloom Milo 14 0 16 16 15 0 67 9613986 Cat Bill the 12 13 13 14 13 31 65 9412978 Dallas Steven 14 15 16 16 17 42 72 9613693 John Cutter 15 15 14 16 17 35 73 9515010 Jones Oliver W 17 16 18 17 17 44 82 9510633 Mike Binkley 11 13 13 14 14 45 71 9513221 Opus 12 14 14 14 14 39 69 0000000 Dummy One 0 0 0 0 0 0 0 9510633 Mike Binkley 0 0 0 0 19 0 0 9973522 Charlie Brown 11 12 0 0 0 0 0 9611684 Bloom Milo 0 17 0 0 0 35 0 0000000 Dummy Two 0 0 0 0 0 0 0 OUTPUT: Program entered This is Program >> P104 = Binary Search 9611684 Bloom Milo 1 4 1 61 61 5 6 7 9613986 Cat Bill the 1 21 31 31 41 33 16 5 9412978 Dallas Steven 1 41 51 61 61 74 27 2 9613693 John Cutter 1 51 51 41 61 73 57 3 9515010 Jones Oliver W 1 71 61 81 71 74 48 2 9510633 Mike Binkley 1 11 31 31 41 44 57 1 9513221 Opus 1 21 41 41 41 43 96 9 CLASS LIST UPDATE PROGRAM 7 RECORDS ON FILE 3 UPDATES PROCESSED UPDATED CLASS LIST 9611684 Bloom Milo 1 4 1 61 61 5 6 7 9613986 Cat Bill the 1 21 31 31 41 33 16 5 9973522 Charlie Brown 1 11 2 0 0 0 0 0 9412978 Dallas Steven 1 41 51 61 61 74 27 2 9613693 John Cutter 1 51 51 41 61 73 57 3 9515010 Jones Oliver W 1 71 61 81 71 74 48 2 9510633 Mike Binkley 0 0 0 1 9 0 0 9510633 Mike Binkley 1 11 31 31 41 44 57 1 9513221 Opus 1 21 41 41 41 43 96 9 Fortran-90 STOP
Page builder: Charles Boivin
Last modified: 11/07/95