      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 detour
!
!     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    :: temp
!
!     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:11) .eq. 'Rock Island' ) then
              call city_insert ( "Hannibal, Missouri       " )
              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:9) .eq. 'Vicksburg' ) then
              temp => travel%downstream
              travel => travel%upstream
              deallocate ( travel%downstream )
              travel%downstream => temp
              temp%upstream => travel
              nullify ( temp )
              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 ( start       )
      nullify ( temp        )
!
!     End of program.
      print *, " "
      end program detour
!
!     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

      subroutine city_insert ( city_input )
      use city_list
      character (len=25)         :: city_input
      type ( river ), pointer    :: down, temp 
      down => travel%downstream
      allocate ( temp )
      temp%city = city_input
      temp%upstream => travel
      temp%downstream => travel%downstream
      travel%downstream => temp
      down%upstream => temp  
      nullify ( down, temp )
      end subroutine city_insert
