!

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