!
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