SourceIMP/utilities/RocfracPrep/GENII_LinkedList.f90

Go to the documentation of this file.

!*********************************************************************
!* Illinois Open Source License                                      *
!*                                                                   *
!* University of Illinois/NCSA                                       * 
!* Open Source License                                               *
!*                                                                   *
!* Copyright@2008, University of Illinois.  All rights reserved.     *
!*                                                                   *
!*  Developed by:                                                    *
!*                                                                   *
!*     Center for Simulation of Advanced Rockets                     *
!*                                                                   *
!*     University of Illinois                                        *
!*                                                                   *
!*     www.csar.uiuc.edu                                             *
!*                                                                   *
!* Permission is hereby granted, free of charge, to any person       *
!* obtaining a copy of this software and associated documentation    *
!* files (the "Software"), to deal with the Software without         *
!* restriction, including without limitation the rights to use,      *
!* copy, modify, merge, publish, distribute, sublicense, and/or      *
!* sell copies of the Software, and to permit persons to whom the    *
!* Software is furnished to do so, subject to the following          *
!* conditions:                                                       *
!*                                                                   *
!*                                                                   *
!* @ Redistributions of source code must retain the above copyright  * 
!*   notice, this list of conditions and the following disclaimers.  *
!*                                                                   * 
!* @ Redistributions in binary form must reproduce the above         *
!*   copyright notice, this list of conditions and the following     *
!*   disclaimers in the documentation and/or other materials         *
!*   provided with the distribution.                                 *
!*                                                                   *
!* @ Neither the names of the Center for Simulation of Advanced      *
!*   Rockets, the University of Illinois, nor the names of its       *
!*   contributors may be used to endorse or promote products derived * 
!*   from this Software without specific prior written permission.   *
!*                                                                   *
!* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,   *
!* EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES   *
!* OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND          *
!* NONINFRINGEMENT.  IN NO EVENT SHALL THE CONTRIBUTORS OR           *
!* COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER       * 
!* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE,   *
!* ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE    *
!* USE OR OTHER DEALINGS WITH THE SOFTWARE.                          *
!*********************************************************************
!* Please acknowledge The University of Illinois Center for          *
!* Simulation of Advanced Rockets in works and publications          *
!* resulting from this software or its derivatives.                  *
!*********************************************************************
! The problem is how to treat generic lists in Fortran 90. 
! Lists can be (1) homogeneous (elements all of the same type) or 
! (2) heterogeneous.
! 
! (1) Often there is a need to work with many (homogeneous) lists which
! may be of different types. Patrice Lignelet has shown how generic list
! properties may be logically treated in Fortran 90. However it still
! appears that the list operations (initialization, addition/removal of
! elements etc) must be separately defined for each list type, which
! leads to considerable duplication of code.
! 
! (2) Jean Vezina has shown how to handle a heterogeneous list by employing the 
! F90 TRANSFER() function. 
! 
! Peter McGavin at Industrial Research Limited (p.mcgavin@irl.cri.nz)
! has constructed a species of generic list for Fortran 90. The method
! is based on 2 ideas: the properties of the TRANSFER() function, and
! the fact that a pointer to a derived data type also points to the
! *first field* within the data type (and conversely). 
! 
! Since the TRANSFER() function does not accept pointer arguments the
! method requires the introduction of 2 auxilliary data types which
! contain the pointers, one in the generic list module and one for each
! list type in the calling program (the same construction is adopted
! when defining "arrays of pointers"). In spite of this complication the
! method represents a big saving, both conceptually and practically, when
! many lists of different types are involved.
! 
! To make clear the method we present a simple generic list module
! together with a calling program. The list module defines a
! uni-directional linked list with a few sample operations, but
! obviously more complicated generic lists could be substituted in its
! place (eg include back pointers).
! 
! Roger Young
! Peter McGavin
! 
! .........................................................................

MODULE generic_list
! Defines a generic uni-directional linked list with a few sample operations

IMPLICIT NONE

PRIVATE

PUBLIC :: &
     link_type,        &! Put a Link_Type field first in your structure
     link_ptr_type,    &! Mold this to and from your type ptr with TRANSFER
     list_type          ! You should declare a List_Type variable

PUBLIC :: & 
     li_init_list,        &! Initialise the List_Type variable before use
     li_get_head,         &! Returns the first Link in the list
     li_get_next,         &! Return the next Link after a given one
     li_add_to_head,      &! Add a Link to the head of the list
     li_remove_head,      &! Remove the first Link and return it
     li_get_len,          &! Compute list length
     li_associated,       &! Check if list member is associated
     li_check_list         ! Aborts program if list is invalid or corrupt

TYPE link_type
  PRIVATE
  TYPE(link_type), POINTER :: Next
END TYPE link_type

! Auxilliary data type required for the transfer function 
TYPE link_ptr_type       ! Use TRANSFER() function to mold Link_Ptr_Type
  PRIVATE                ! to your pointer type and vice versa
  TYPE(link_type), POINTER :: P
END TYPE link_ptr_type

TYPE list_type             
  PRIVATE
  TYPE(link_type) :: Head   ! Dummy Link always at head of list
END TYPE list_type

CONTAINS

!-----------------------------------------------------------------------
SUBROUTINE abort(Message)
IMPLICIT NONE
CHARACTER *(*) message

WRITE(6,*) message
WRITE(6,*) 'Program aborted'
stop

END SUBROUTINE abort

!-----------------------------------------------------------------------
SUBROUTINE li_check_list(List,Message)
IMPLICIT NONE
TYPE(list_type) list
CHARACTER *(*) message

IF(.NOT.ASSOCIATED(list%Head%Next))THEN
   WRITE(6,*) message
   CALL abort('List is not initialised in call to LI_Check_List()')
ENDIF

END SUBROUTINE li_check_list

!-----------------------------------------------------------------------
SUBROUTINE li_init_list(List)
  IMPLICIT NONE
  integer :: numprocs
  TYPE(list_type),INTENT(INOUT),TARGET :: list

  nullify(list%Head%Next)

  RETURN
END SUBROUTINE li_init_list

!-----------------------------------------------------------------------
SUBROUTINE li_add_to_head(Link,List)
  IMPLICIT NONE
  TYPE(list_type),INTENT(INOUT)     :: list
  TYPE(link_ptr_type),INTENT(INOUT) :: link

  link%P%Next => list%Head%Next
  list%Head%Next => link%P

  RETURN
END SUBROUTINE li_add_to_head

!-----------------------------------------------------------------------
INTEGER FUNCTION li_get_len(List)
  IMPLICIT NONE
  TYPE(list_type), INTENT(IN),TARGET :: list
  TYPE(link_ptr_type) :: link
  INTEGER n

  link%P => list%Head
  n = 0
  DO WHILE(ASSOCIATED(link%P%Next))
     link%P => link%P%Next
     n = n+1
  ENDDO
  li_get_len = n

  RETURN
END FUNCTION li_get_len

!-----------------------------------------------------------------------
FUNCTION li_associated(Link)
  IMPLICIT NONE
  LOGICAL :: li_associated
  TYPE(link_ptr_type),INTENT(IN) :: link

  li_associated = .false.
  IF(ASSOCIATED(link%P))li_associated=.true.

  RETURN
END FUNCTION li_associated

!-----------------------------------------------------------------------
FUNCTION li_get_next(Link)
  IMPLICIT NONE
  Type(link_ptr_type)           :: li_get_next
  TYPE(link_ptr_type),INTENT(IN) :: link

  IF(.NOT.ASSOCIATED(link%P%Next))THEN
     nullify(li_get_next%P)
  ELSE   
     li_get_next%P => link%P%Next
  ENDIF

  RETURN
END FUNCTION li_get_next

!-----------------------------------------------------------------------
FUNCTION li_get_head(List)
  IMPLICIT NONE
  TYPE(link_ptr_type)               :: li_get_head
  TYPE(list_type),INTENT(IN),TARGET :: list

  li_get_head%P => list%Head%Next

  RETURN
END FUNCTION li_get_head

!-----------------------------------------------------------------------
FUNCTION li_remove_head(List)
  IMPLICIT NONE
  TYPE(link_ptr_type)                  :: li_remove_head
  TYPE(list_type),INTENT(INOUT),TARGET :: list
  TYPE(link_ptr_type) :: link

  link%P => list%Head%Next
  IF(ASSOCIATED(link%P))THEN
     list%Head%Next => link%P%Next
     nullify(link%P%Next)
  ENDIF
     li_remove_head%P => link%P

  RETURN
END FUNCTION li_remove_head

!-----------------------------------------------------------------------
END MODULE generic_list