!
     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