!
! =====> 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