      module city_list
      type river
           type (river), pointer :: upstream
           character (len=25)    :: city
           type (river), pointer :: downstream
      end  type river
      type ( river ), pointer    :: finish
      type ( river ), pointer    :: start
      type ( river ), pointer    :: travel
      end module city_list

      program tour
!
!     Use a doubly linked list to travel downstream and
!     upstream along a river.  The sample input file
!     lists the start and end points and selected cities
!     on the Mississippi.
!
      use city_list
      character (len=25)         :: city_input
      type ( river ), pointer    :: hannibal
      type ( river ), pointer    :: memphis
      type ( river ), pointer    :: natchez
      type ( river ), pointer    :: rock_island
      type ( river ), pointer    :: st_louis
      type ( river ), pointer    :: temp
      type ( river ), pointer    :: vicksburg
!
!     Initialize the first data element.
      allocate ( start )
      nullify ( start%upstream   )
      start%city = ' '
      nullify ( start%downstream )
      travel => start
!
!     Read the cities along the way.
      print *, " "
      print *, "Enter cities ..."
      do
         read ( *,100,end=200 ) city_input
100      format ( a25 )
!
!        Keep track of the previous city.
         temp => travel
!
!        Record the current city.
         travel%city = city_input
!
!        Allocate memory for the next city and
!        point to that storage.
         allocate ( travel%downstream )
         travel => travel%downstream
!
!        Link the previous city as "upstream" from
!        the current city.
         travel%upstream => temp
      end do
200   continue
!
!     Keep track of the last city.
      finish => temp
!
!     Clear the end-of-list.
      nullify ( travel%downstream )
!
!     Advise the user that all data have been read.
      print *, " "
      print *, "All city names have been read ..."
!
!     Show the cities going downstream.
      print *, " "
      print *, "LIST the original tour"
      print *, "======================"
      call droute
!
!     Replace Davenport with Dubuque.
      print *, " "
      print *, "REPLACE Davenport with Dubuque"
      print *, "=============================="
      travel => start
      do
         if ( travel%city(1:4) .eq. 'Dave' ) then
              travel%city = 'Dubuque, Iowa'
              exit
         else
              travel => travel%downstream
              if ( .not. associated ( travel%downstream ) ) exit
         end if
      end do
      call uroute
!
!     Insert Hannibal below Rock Island and above St. Louis.
      print *, " "
      print *, "INSERT Hannibal between Rock Island and St. Louis"
      print *, "================================================="
      travel => start
      do
         if ( travel%city(1:4) .eq. 'Rock' ) then
              rock_island => travel
              st_louis => rock_island%downstream
              allocate ( hannibal )
              hannibal%upstream => rock_island
              hannibal%city = 'Hannibal, Missouri'
              hannibal%downstream => st_louis
              rock_island%downstream => hannibal
              st_louis%upstream => hannibal
              exit
         else
              travel => travel%downstream
              if ( .not. associated ( travel%downstream ) ) exit
         end if
      end do
      call droute
!
!     Delete Vicksburg (below Memphis and above Natchez).
      print *, " "
      print *, "DELETE Vicksburg from between Memphis and Natchez"
      print *, "================================================="
      travel => start
      do
         if ( travel%city(1:4) .eq. 'Vick' ) then
              vicksburg => travel
              memphis => vicksburg%upstream
              natchez => vicksburg%downstream
              memphis%downstream => natchez
              natchez%upstream => memphis
              deallocate ( vicksburg )
              exit
         else
              travel => travel%downstream
              if ( .not. associated ( travel%downstream ) ) exit
         end if
      end do
      call uroute
!
!     Clear the linked list allocation.
      print *, " "
      print *, "DEALLOCATE the linked list"
      print *, "=========================="
      print *, " "
      print *, "     Cities deallocated going downstream ..."
      travel => start
      do
         print *, "     ", travel%city
         temp => travel%downstream
         deallocate ( travel )
         if ( .not. associated ( temp%downstream ) ) exit
         travel => temp
      end do
      nullify ( finish      )
      nullify ( hannibal    )
      nullify ( memphis     )
      nullify ( natchez     )
      nullify ( rock_island )
      nullify ( st_louis    )
      nullify ( start       )
      nullify ( temp        )
      nullify ( vicksburg   )
!
!     End of program.
      print *, " "
      end program tour
!
!     Show the downstream route.
      subroutine droute
      use city_list
      print *, " "
      print *, "     Cities passed going downstream ..."
      travel => start
      do
         print *, "     ", travel%city
         travel => travel%downstream
         if ( .not. associated ( travel%downstream ) ) exit
      end do
      end subroutine droute
!
!     Show the upstream route.
      subroutine uroute
      use city_list
      print *, " "
      print *, "     Cities passed going upstream ..."
      travel => finish
      do
         print *, "     ", travel%city
         if ( .not. associated ( travel%upstream ) ) exit
         travel => travel%upstream
      end do
      end subroutine uroute
