!

PROGRAM P103

!

!

! CLASS LIST UPDATE PROGRAM

! USING A LINEAR SEARCH BY ID - NOT SORTED

! ADDITIONS AT END OF FILE

!

! DECLARE ARRAYS FOR FILE

!

IMPLICIT NONE

CHARACTER (LEN=25) :: NAMES(100),NAME

INTEGER :: ID(100),MARKS(100,7),GRADES(7),I,J

INTEGER :: NREC,NREQ,KID,NUPD,K

INTERFACE

SUBROUTINE SCANID(LIST,N,KEY,KPOS)

IMPLICIT NONE

INTEGER ,INTENT(IN OUT) :: LIST(:),KEY

INTEGER ,INTENT(IN OUT) :: N,KPOS

END SUBROUTINE SCANID

END INTERFACE

!

PRINT *, 'This is Program >> P103 = Update with Linear Search'

!

! Tell program where data for READ is coming from

OPEN(UNIT=5, FILE='P103.DAT') ! UNIT=5 is the default input

!

!

!==== READ IN FILE AND STORE IN MAIN MEMORY

!

L1: DO J=1,100

READ 15,ID(J),NAMES(J),(MARKS(J,I),I=1,7)

15 FORMAT(I7,' ',A25,7I3)

IF(ID(J) == 0) GO TO 101

Print 15,ID(J),NAMES(J),(MARKS(J,I),I=1,7)

END DO L1

16 FORMAT(/'TOO MUCH DATA FOR DEFINED ARRAYS'/ &

'INCREASE ARRAY SIZE AND RERUN'//)

STOP

!

!==== READ AND PROCESS UPDATE CARDS

!

101 NREC=J-1

PRINT 102,NREC

102 FORMAT(/'CLASS LIST UPDATE PROGRAM '/ &

I5,' RECORDS ON FILE')

L2: DO J=1,100

READ 15,KID,NAME,GRADES

IF(KID == 0) THEN

NUPD=J-1

PRINT 203,NUPD

203 FORMAT(/I5,' UPDATES PROCESSED'/ &

/ 'UPDATED CLASS LIST'//)

!

L3: DO K=1,NREC

PRINT 211,ID(K),NAMES(K),(MARKS(K,I),I=1,7)

211 FORMAT(I10,' ',A25,7I5)

!

!=== LEAVE A BLANK LINE EVERY 5

!

IF(MOD(K,5) == 0) PRINT * ! Nothing = a blank line

END DO L3

STOP

ELSE

CALL SCANID(ID,NREC,KID,KPOS)

IF(KPOS <= 0) THEN

!

!==== GOODIE! WE HAVE A NEW MEMBER OF THE CLASS

! ADD AT THE END

!

NREC=NREC+1

IF(NREC > 100) THEN

PRINT 220,KID,NAME

220 FORMAT(/'ARRAYS FULL - UNABLE TO ADD',I10,2X,A25)

STOP

ENDIF

!

!==== DO ACTUAL UPDATE

!

ID(NREC)=KID

NAMES(NREC)=NAME

L4: DO I=1,7

MARKS(NREC,I)=GRADES(I)

END DO L4

ELSE

!

!==== THIS STUDENT IS ON FILE - UPDATE ANY NONZERO ENTRY IN GRADES

! INTO THE ARRAY MARKS

!

L5: DO I=1,7

IF(GRADES(I) /= 0) THEN ! grades(i) not zero

MARKS(KPOS,I)=GRADES(I)

END IF

END DO L5

ENDIF

ENDIF

END DO L2

STOP

END PROGRAM P103

!

SUBROUTINE SCANID(LIST,N,KEY,KPOS)

IMPLICIT NONE

INTEGER ,INTENT(IN OUT) :: LIST(:),KEY

INTEGER ,INTENT(IN OUT) :: N,KPOS

INTEGER :: I

!

!==== LINEAR SEARCH

!

L1: DO I=1,N

IF(KEY == LIST(I)) GO TO 100

END DO L1

KPOS=0

RETURN

100 KPOS=I

RETURN

END SUBROUTINE SCANID