!
      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