! PROGRAM P106 ! ! ! CLASS LIST UPDATE PROGRAM ! USES LINKED LIST WITH THE NAME AS THE KEY ! ! DECLARATION STATEMENTS ! IMPLICIT NONE CHARACTER (LEN=25) :: NAMES(100),NAME INTEGER :: ID(100),MARKS(100,7),GRADES(7),LINK(100) INTEGER :: TOP,LAST,I,J,K,NREC,NLINES,M,KPOS INTERFACE SUBROUTINE LOOK(LIST,LINK,NAME,KPOS,TOP,LAST) IMPLICIT NONE CHARACTER (LEN=25) :: LIST(:),NAME INTEGER ,INTENT(IN OUT) :: LINK(:),KPOS,LAST END SUBROUTINE LOOK END INTERFACE ! PRINT *, 'This is Program >> P106 = Linked Lists' ! ! Tell program where data for READ* is coming from OPEN(UNIT=5, FILE='P106.DAT') ! UNIT=5 is the default input ! TOP=1 ! !=== 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) ! SETUP POINTER TO NEXT RECORD LINK(J)=J+1 END DO L1 PRINT 16 16 FORMAT(/'TOO MUCH DATA FOR DEFINED ARRAYS'/ &'INCREASE ARRAY SIZE AND RERUN'//) STOP 101 NREC=J-1 ! !==== MARK THE LAST RECORD AS END OF THE FILE ! WITH A ZERO IN THE LINK FIELD ! LINK(NREC)=0 ! PRINT 102,NREC 102 FORMAT(/'CLASS LIST UPDATE PROGRAM'/ &I5,' RECORDS ON FILE') L2: DO J=1,100 READ(5,15) KID,NAME,GRADES IF (KID == 0) THEN PRINT 202,J-1 202 FORMAT(/I5,' UPDATES PROCESSED'// &'UPDATED CLASS LIST') ! !===== PRINT OUT A LINKED LIST - IT'S EASY ! START AT THE TOP OF THE LIST AND FOLLOW THE POINTERS ! UNTIL YOU HIT A ZERO POINTER ! K=TOP NLINES=0 210 PRINT 211,ID(K),NAMES(K),(MARKS(K,L),L=1,7) 211 FORMAT(I9,' ',A25,7I5) NLINES=NLINES+1 ! !=== LEAVE A BLANK LINE EVERY FIVE LINES OF OUTPUT ! IF (MOD(NLINES,5) == 0) PRINT * IF(LINK(K) == 0) STOP K=LINK(K) GO TO 210 ELSE CALL LOOK(NAMES,LINK,NAME,KPOS,TOP,LAST) IF (KPOS <= 0) THEN ! !==== PROGRAM SECTION TO ADD A NEW MEMBER TO CLASS LIST ! INSERT RECORD AT THE END OF THE FILE ! WHERE THE FREE SPACE IS, BUT LINK IN CORRECT ORDER ! NREC=NREC+1 IF(NREC > 100) THEN PRINT 220,KID,NAME 220 FORMAT(/'ARRAYS FULL - UNABLE TO ADD',I10,2X,A25) STOP ENDIF !===== NOW ADD NEW DATA IN EMPTY SLOT AT END OF FILE ID(NREC)=KID NAMES(NREC)=NAME L3: DO M=1,7 MARKS(NREC,M)=GRADES(M) END DO L3 KPOS=-KPOS LINK(NREC)=KPOS IF(LAST == 0) THEN ! !=== HAVE AN ADDITION IN FRONT OF FIRST RECORD ! TOP=NREC ELSE LINK(LAST)=NREC END IF ! !==== STUDENT FOUND - UPDATE ANY NONZERO GRADES ! ELSE L4: DO I=1,7 IF (GRADES(I) /= 0) THEN MARKS(KPOS,I)=GRADES(I) ENDIF END DO L4 ENDIF ENDIF END DO L2 STOP END PROGRAM P106 ! SUBROUTINE LOOK(LIST,LINK,NAME,KPOS,TOP,LAST) IMPLICIT NONE CHARACTER (LEN=25) :: LIST(:),NAME INTEGER ,INTENT(IN OUT) :: LINK(:),KPOS,LAST INTEGER :: NEXT ! ! LINKED LIST LOOKUP ROUTINE ! NEXT=TOP LAST=0 1 IF(LIST(NEXT) == NAME) THEN !=== YES WE FOUND THE ONE WE WANT AND KPOS IS ITS POSITION KPOS=NEXT RETURN ELSE IF(NAME < LIST(NEXT)) THEN !=== THE ONE WE WANT IS NOT IN LIST - KPOS POINT TO NEXT ONE ! NEGATIVE KPOS SAYS WE CAN'T FIND IT KPOS=-NEXT RETURN ENDIF ENDIF ! REMEMBER PREVIOUS POINTER VALUE LAST=NEXT IF(LINK(NEXT) == 0) THEN !=== WE HAVE REACHED END OF LIST AND STILL NOT FOUND THE ONE KPOS=0 RETURN ELSE !=== HAVE NOT FOUND IT YET ! POINT TO NEXT ONE NEXT=LINK(NEXT) GO TO 1 ENDIF RETURN END SUBROUTINE LOOK