! PROGRAM P104 ! ! ! CLASS LIST UPDATE PROGRAM ! USES BINARY SEARCH BY NAME ! ! DECLARATION STATEMENTS ! IMPLICIT NONE CHARACTER (LEN=25) :: NAMES(100),CNAME INTEGER :: ID(100),MARKS(100,7),GRADES(7) INTEGER :: J,I,NREC,KID,M,K,INSERT INTERFACE SUBROUTINE BSERCH(NAMES,N,NAME,KPOS) IMPLICIT NONE CHARACTER (LEN=25) :: NAMES(:),NAME INTEGER ,INTENT(IN OUT) :: N,KPOS END SUBROUTINE BSERCH END INTERFACE ! 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,' ',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,' ',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 PROGRAM P104 ! SUBROUTINE BSERCH(NAMES,N,NAME,KPOS) IMPLICIT NONE CHARACTER (LEN=25) :: NAMES(:),NAME INTEGER ,INTENT(IN OUT) :: N,KPOS INTEGER :: LOW,LAST,MID ! ! 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 SUBROUTINE BSERCH