!
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