!
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