!

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