! 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