PROGRAM linked_list

IMPLICIT NONE

! define list types
TYPE node
  INTEGER :: value
  TYPE (node),POINTER :: next
END TYPE node
TYPE list
  TYPE (node),POINTER :: first
END TYPE list

! declare a list
TYPE (list) :: lst

! begin executable code
lst = new_list ()
CALL insert (lst,83)
CALL insert (lst,14)
CALL insert (lst,17)

PRINT*,'the list '
CALL print_list(lst) 

CALL delete (lst,17)

PRINT*,'the list again'
CALL print_list(lst) 


CONTAINS

!!!!!!!!!!!!!!!!!!!!!!!!

FUNCTION new_list () RESULT (lst)
  TYPE (list) :: lst
  ALLOCATE (lst%first)
  NULLIFY (lst%first%next)
END FUNCTION new_list

!!!!!!!!!!!!!!!!!!!!!!!!

 SUBROUTINE insert (lst,number)
 TYPE (list) :: lst
 INTEGER :: number
 TYPE (node),POINTER :: ptr1,ptr2
! find location to put new number
 ptr1 => lst%first
 ptr2 => ptr1%next
 DO
   IF (.NOT.ASSOCIATED (ptr2)) EXIT
   IF (number < ptr2%value) EXIT
   ptr1 => ptr2
   ptr2 => ptr2%next
ENDDO
! insert new node
 ALLOCATE (ptr1%next)
 ptr1%next%value = number
 ptr1%next%next => ptr2
 END SUBROUTINE insert
 
!!!!!!!!!!!!!!!!!!!!!!!!

  SUBROUTINE delete (lst,number)
 TYPE (list) :: lst
 INTEGER :: number
 LOGICAL :: found
 TYPE (node),POINTER :: ptr1,ptr2
! find location to delete number
 ptr1 => lst%first
 ptr2 => ptr1%next
 DO
   IF (.NOT.ASSOCIATED (ptr2)) THEN
     found = .FALSE.
     EXIT
   ELSE IF (number==ptr2%value) THEN
     found = .TRUE.
     EXIT
   ELSE
     ptr1 => ptr2
     ptr2 => ptr2%next
   ENDIF
 ENDDO
! delete node if found
 IF (found) THEN
   ptr1%next => ptr2%next
   DEALLOCATE (ptr2)
 ENDIF
 END SUBROUTINE delete

 SUBROUTINE print_list (lst)
 TYPE (list) :: lst
 TYPE (node),POINTER :: ptr1,ptr2

! find location to put new number
 ptr1 => lst%first
 ptr2 => ptr1%next
 DO
   IF (.NOT.ASSOCIATED (ptr2)) EXIT
   PRINT*,'value ',ptr1%next%value
   ptr1 => ptr2
   ptr2 => ptr2%next
ENDDO

END SUBROUTINE print_list

!!!!!!!!!!!!!!!!!!!!!!!!

 
END PROGRAM linked_list
