連結リストの fortran 95 プログラム

自分用の覚書。連結リスト (linked list) はデータの要素の個数を自由に変えられる便利なデータ構造なのだが、「連結リスト」でググっても fortran は出てこないので*1、fortran の POINTER の練習も兼ねて書いてみた。fortran の POINTER という[対象]は、C の pointer とは全く似て非なるものである。なぜ "ALIAS" みたいな名称にしなかったのだろうかと訝しく思う。

      MODULE LinkedList
        !
        ! a sample fortran code of (uni-directional) linked list
        !
        PRIVATE
        TYPE node
          TYPE(node),POINTER::next
          REAL::x
        END TYPE
        TYPE(node),TARGET::nodeInit
        PUBLIC:: node ,nodeInit ,appendNode ,deleteNodeNextTo
      CONTAINS

        SUBROUTINE appendNode (nodeCurr)
          !
          ! this subroutine adds a new node next to "nodeCurr".
          !
          ! ...->[node0]->[nodeCurr]->.->[node1]->...
          !                           |
          !                a new node is appended here
          !
          ! result: ...->[node0]->[nodeCurr]->[nodeNew]->[node1]->...
          !
          TYPE(node),POINTER::nodeCurr,nodeBuff
          ALLOCATE(nodeBuff)
          nodeBuff%next=> nodeCurr%next
          nodeCurr%next=> nodeBuff
          nodeBuff%x= nodeCurr%x + 1
        END SUBROUTINE

        SUBROUTINE deleteNodeNextTo (nodeCurr)
          !
          ! this subroutine deallocates the node that locates next to
          ! the node given by "nodeCurr" pointer.
          !
          ! ...->[node0]->[nodeCurr]->[node1]->[node2]->...
          !                            |
          !                  this node is to be deallocated.
          !                 (is the memory really freed? or leaked?)
          !
          ! result: ...->[node0]->[nodeCurr]->[node2]->...
          !
          TYPE(node),POINTER::nodeCurr,nodeBuff
          nodeBuff=> nodeCurr%next
          nodeCurr%next=> nodeCurr%next%next
          DEALLOCATE(nodeBuff)
        END SUBROUTINE

      END MODULE
************************************************************************
      PROGRAM main
        USE LinkedList ,ONLY: node,nodeInit,appendNode,deleteNodeNextTo
        TYPE(node),POINTER::nodeCurr ,nodeBuff

        nodeInit%x= 1;
        nodeInit%next=> nodeInit;
          ! result
          ! [n0:1]->[n0:1]->[n0:1]->...
          !  |  |
          !  |  data in %x
          !  id number of the node

        nodeCurr=> nodeInit
        CALL printer(nodeCurr)

        CALL appendNode(nodeCurr)
          ! action: append
          !    nodeCurr
          !    |
          !   [n0:1]->.->[n0:1]->...
          !           |
          !        [n1:1+1]
          ! result
          !   [n0:1]->[n1:2]->[n0:1]->...
          !    |
          !    nodeCurr
        CALL printer(nodeCurr)

        nodeCurr=> nodeCurr%next
        CALL appendNode(nodeCurr)
          ! action: append
          !            nodeCurr
          !            |
          !   [n0:1]->[n1:2]->.->[n0:1]->...
          !                   |
          !                [n2:2+1]
          ! result
          !   [n0:1]->[n1:2]->[n2:3]->[n0:1]->...
          !            |
          !            nodeCurr
        CALL printer(nodeCurr)

        nodeCurr=> nodeCurr%next
        CALL appendNode(nodeCurr)
          ! action: append
          !                    nodeCurr
          !                    |
          !   [n0:1]->[n1:2]->[n2:3]->.->[n0:1]->...
          !                           |
          !                        [n3:3+1]
          ! result
          !   [n0:1]->[n1:2]->[n2:3]->[n3:4]->[n0:1]->...
          !                    |
          !                    nodeCurr
        CALL printer(nodeCurr)

        nodeCurr=> nodeInit%next
        nodeBuff=> nodeCurr%next
        CALL deleteNodeNextTo(nodeCurr)
          ! action: delete
          !            nodeCurr
          !            |       nodeBuff
          !            |       |
          !   [n0:1]->[n1:2]->[n2:3]->[n3:4]->[n0:1]->...
          !                    |
          !                    delete this node
          ! result
          !   [n0:1]->[n1:2]->[n3:4]->[n0:1]->...
          !            |
          !            nodeCurr
        CALL printer(nodeCurr)
        PRINT*,'---'
        PRINT*,nodeBuff%x

        nodeCurr=> nodeCurr%next
        nodeBuff=> nodeCurr%next
        CALL deleteNodeNextTo(nodeCurr)
          ! action: delete
          !                    nodeCurr
          !                    |
          !   [n0:1]->[n1:2]->[n3:4]->[n0:1]->[n1:2]->...
          !                            |
          !                            delete this node
          !        however, this node is not a pointer allocated,
          !        but an entity declared in the module.
          ! result
          !         ->[n1:2]->[n3:4]->[n1:2]->...
          !                    |
          !                    nodeCurr
          !
          !   [n0:1]->[n1:2]->[n3:4]->[n1:2]->...
          !    |
          !    n0 survives, but the link never returned here.
        CALL printer(nodeCurr)
        PRINT*,'---'
        PRINT*,nodeBuff%x
        nodeCurr=> nodeInit
        CALL printer(nodeCurr)

      CONTAINS
        SUBROUTINE printer(nodeQ)
          TYPE(node),POINTER::nodeQ
          print*,'---'
          print*,nodeQ%x
          print*,nodeQ%next%x
          print*,nodeQ%next%next%x
          print*,nodeQ%next%next%next%x
          print*,nodeQ%next%next%next%next%x
          print*,nodeQ%next%next%next%next%next%x
        END SUBROUTINE
      END PROGRAM

*1:英語でググるとたくさん出てくる。fortran linked list - Google 検索