program example
    implicit none
    call test
    call test2
end program example
module ModDoLinkList
    implicit none
    integer, parameter :: sgl=selected_real_kind(p=1)
    type :: doNode
        real(sgl) :: var1
        type(doNode), pointer :: before
        type(doNode), pointer :: next
    end type
contains
    recursive subroutine DoNodeAdd(newNode, ptr)
        type(doNode), intent(inout), pointer :: newNode
        type(doNode), intent(inout), pointer :: ptr
        if ( .not. associated(newNode) ) stop ""
        if ( associated(ptr) ) then
            if ( associated(ptr%next) ) then
                call DoNodeAdd(newNode, ptr%next)
            else
                ptr%next => newNode
                newNode%before => ptr
            end if
        else
            ptr => newNode
        end if
    end subroutine DoNodeAdd
    subroutine test1(value, ptr)
        type(doNode), intent(inout), target :: value
        type(doNode), intent(inout), pointer :: ptr
        type(doNode), pointer :: temp => null()
        type(doNode), target :: a
        type(doNode), pointer :: newNode => null()
        allocate(newNode)
        newNode%var1 = 200.
        newNode%before => null()
        newNode%next => null()
        a%var1 = 100.
        a%before => null()
        a%next => null()
        temp => value%before
        temp%next => a
        write(*, *)
        write(*, *) '如果传递的是值, 则     ', value%var1
        temp => ptr%before
        ptr%before%next => a
        write(*, *) '如果传递的是指针, 则   ', ptr%var1
        newNode%before => ptr                           ! 插入结点前指针                    => 操作结点
        temp => ptr%next
        temp%before => newNode                      ! 操作结点后指针指向的结点的前指针  => 插入结点
        newNode%next => temp                        ! 插入结点的后指针                  => 操作结点后指针指向的结点
        ptr%next => newNode
    end subroutine
    recursive subroutine DoNodeSortForword(newNode, ptr)        ! 向前排序
        implicit none
        type(doNode), intent(inout), target :: newNode            ! 插入结点
        type(doNode), intent(inout), target :: ptr             ! 操作结点
        type(doNode), pointer :: temp
        write(*, *) '当前操作结点为: ', ptr%var1, '; 当前插入结点为:', newNode%var1
        ! if ( .not. associated(newNode) ) then                   ! 如果插入结点未关联
        !     stop ""                                             ! 报错退出
        ! else                                                    ! 如果插入结点已关联
            write(*, *) '  插入结点存在'
            if ( newNode%var1 < ptr%var1 ) then                 ! 如果插入结点值比操作结点值小
                write(*, *) '  插入结点值小于操作结点值'
                if ( associated(ptr%before) ) then              ! 如果操作结点前指针已关联
                    write(*, *) '  由于操作结点值前指针已关联, 检测前一结点'
                    call DoNodeSortForword(newNode, ptr%before) ! 递归调用
                else                                            ! 如果操作结点前指针为空
                    write(*, *) '  由于操作结点值前指针未关联, 则在最前端插入插入节点'
                    ptr%before => newNode                       ! 操作结点前指针 => 插入结点
                    newNode%next => ptr                         ! 插入结点后指针 => 操作节点
                end if
            else                                                ! 如果插入结点值比操作结点值大
                write(*, *) '  插入结点值大于操作结点值, 将结点插入操作结点之后'
                newNode%before => ptr                           ! 插入结点前指针                    => 操作结点
                write(*, *) '  插入结点前指针指向:      ', newNode%before%var1
                temp => ptr%next
                ! ptr%next => newNode                             ! 操作结点的后指针                  => 插入结点
                temp%before => newNode                      ! 操作结点后指针指向的结点的前指针  => 插入结点
                write(*, *) '  操作结点后结点前指针指向:', temp%before%var1
                newNode%next => temp                        ! 插入结点的后指针                  => 操作结点后指针指向的结点
                write(*, *) '  插入结点后指针指向:      ', newNode%next%var1
                ptr%next => newNode
                write(*, *) '  操作结点后指针指向:      ', ptr%next%var1
            end if
            ! if ( .not. associated(ptr) ) then                   ! 如果操作结点前指针为空
            !     write(*, '(A)', advance='no') '10'
            !     ptr%before => newNode                           ! 
            !     newNode%next => ptr
            ! else
            !     write(*, '(A)', advance='no') '11'
            !     if ( newNode%var1 < ptr%var1 ) then
            !         call DoNodeSortForword(newNode, ptr%before)
            !     else
            !         newNode%before => ptr
            !         ptr%next%before => newNode
            !         newNode%next => ptr%next
            !         ptr%next => newNode
            !     end if
            ! end if
            ! newNode => null()
            call DoNodePrint1(ptr)
            write(*, *)
            ! ptr => null()
        ! end if
    end subroutine DoNodeSortForword
    recursive subroutine DoNodeSortForword1(newNode, ptr)        ! 向前排序
        implicit none
        type(doNode), intent(in), pointer :: newNode            ! 插入结点
        type(doNode), intent(in), pointer :: ptr             ! 操作结点
        type(doNode), pointer :: temp
        write(*, *) '当前操作结点为: ', ptr%var1, '; 当前插入结点为:', newNode%var1
        if ( .not. associated(newNode) ) then                   ! 如果插入结点未关联
            stop ""                                             ! 报错退出
        else                                                    ! 如果插入结点已关联
            write(*, *) '  插入结点存在'
            if ( newNode%var1 < ptr%var1 ) then                 ! 如果插入结点值比操作结点值小
                write(*, *) '  插入结点值小于操作结点值'
                if ( associated(ptr%before) ) then              ! 如果操作结点前指针已关联
                    write(*, *) '  由于操作结点值前指针已关联, 检测前一结点'
                    call DoNodeSortForword1(newNode, ptr%before) ! 递归调用
                else                                            ! 如果操作结点前指针为空
                    write(*, *) '  由于操作结点值前指针未关联, 则在最前端插入插入节点'
                    ptr%before => newNode                       ! 操作结点前指针 => 插入结点
                    newNode%next => ptr                         ! 插入结点后指针 => 操作节点
                end if
            else                                                ! 如果插入结点值比操作结点值大
                ! write(*, *) '  插入结点值大于操作结点值, 将结点插入操作结点之后'
                ! newNode%before => ptr                           ! 插入结点前指针                    => 操作结点
                ! write(*, *) '  插入结点前指针指向:      ', newNode%before%var1
                ! temp => ptr%next
                ! ptr%next => newNode                             ! 操作结点的后指针                  => 插入结点
                ! ptr%next%before => newNode                      ! 操作结点后指针指向的结点的前指针  => 插入结点
                ! write(*, *) '  操作结点后结点前指针指向:', temp%before%var1
                ! newNode%next => ptr%next                        ! 插入结点的后指针                  => 操作结点后指针指向的结点
                ! write(*, *) '  插入结点后指针指向:      ', newNode%next%var1
                ! ptr%next => newNode
                ! write(*, *) '  操作结点后指针指向:      ', ptr%next%var1
                ! 
                ! newNode%before => ptr
                ! newNode%next => ptr%next
                ! ptr%next => newNode
                ! newNode%next%before => newNode
                ! 
                write(*, *) ptr%next%var1
                newNode%before => ptr
                write(*, *) ptr%next%var1
                temp => ptr%next
                write(*, *) ptr%next%var1
                ! temp%before => newNode
                write(*, *) ptr%next%var1
                newNode%next => ptr%next
                write(*, *) ptr%next%var1
                ! ptr%next => newNode
                newNode%next%before => newNode
                ! ptr%next%before => newNode
                write(*, *) ptr%next%var1
                ptr%next => newNode
                write(*, *) ptr%next%var1, newNode%next%var1
            end if
            call DoNodePrint1(ptr)
            write(*, *)
        end if
    end subroutine DoNodeSortForword1
    recursive subroutine DoNodePrint(ptr)
        type(doNode), intent(in), pointer :: ptr
        if ( associated(ptr) ) then
            write(*, '(F6.2)', advance='no') ptr%var1
            call DoNodePrint(ptr%next)
        end if
    end subroutine DoNodePrint
    recursive subroutine DoNodePrint1(ptr)
        type(doNode), intent(in), pointer :: ptr
        if ( associated(ptr) ) then
            write(*, '(F6.2)', advance='no') ptr%var1
            call DoNodePrint1(ptr%before)
        end if
    end subroutine DoNodePrint1
end module ModDoLinkList
subroutine Test
    use ModDoLinkList
    implicit none
    type(doNode), pointer :: newNode => null()
    type(doNode), pointer :: head => null()
    type(doNode), pointer :: tail => null()
    type(doNode), pointer :: ptr => null()
    real(sgl) :: temp
    integer :: i
    integer :: errorLevel
    do i = 1, 21
        allocate(newNode)
        newNode%var1 = real(i)
        newNode%before => null()
        newNode%next => null()
        if ( .not. associated(head) ) head => newNode
        ! if ( .not. associated(head) ) then
        !     head => newNode
        !     write(*, *) '已插入首结点   ', newNode%var1
        ! else
        !     call DoNodeAdd(newNode, head)
        !     write(*, *) '已插入结点     ', newNode%var1
        ! end if
        call DoNodeAdd(newNode, tail)
        tail => newNode
    end do
    allocate(newNode)
    newNode%var1 = 17.5
    newNode%before => null()
    newNode%next => null()
    ptr => head
    do
        if ( associated(ptr) ) then
            write(*, '(F6.2)', advance='no') ptr%var1
            ptr => ptr%next
        else
            exit
        end if
    end do
    write(*, *)
    ptr => tail
    call DoNodeSortForword1(newNode, ptr)
    call DoNodePrint(head)
    write(*, *)
    call DoNodePrint1(tail)
    write(*, *)
    do
        if ( associated(head%before) ) then
            head => head%before
        else
            exit
        end if
    end do
    ptr => tail
    ptr => head
    write(*, *)
    do
        if ( associated(ptr) ) then
            write(*, '(F6.2)', advance='no') ptr%var1
            ! write(*, *) '当前结点值为:', ptr%var1, '; 下一结点值为:', ptr%before%var1
            ! ptr => ptr%before
            ptr => ptr%next
        else
            exit
        end if
    end do
    ptr => tail%before
    call test1(ptr, ptr)
    write(*, *) ptr%before%var1, ptr%var1, ptr%next%var1, ptr%next%next%var1
end subroutine Test
subroutine test2
    use ModDoLinkList
    integer :: i
    type(doNode), pointer :: newNode
    type(doNode), pointer :: head
    type(doNode), pointer :: middle
    type(doNode), pointer :: tail
    type(doNode), pointer :: ptr
    allocate(newNode)
    newNode%var1 = 1.
    newNode%before => null()
    newNode%next => null()
    head => newNode
    allocate(newNode)
    newNode%var1 = 2.
    newNode%before => null()
    newNode%next => null()
    head%next => newNode
    newNode%before => head
    middle => newNode
    allocate(newNode)
    newNode%var1 = 3.
    newNode%before => null()
    newNode%next => null()
    middle%next => newNode
    newNode%before => middle
    tail => newNode
    write(*, *) head%var1, middle%var1, tail%var1
    ! head%next => tail
    ! write(*, *) head%next%var1, middle%var1
    ! head%next%next => head
    ! write(*, *) head%next%next%var1, middle%next%var1, tail%var1
    ! ptr => head%next
    ! head%next => tail
    ! middle%var1 = 4.
    ! write(*, *) ptr%var1, head%next%var1
    allocate(newNode)
    newNode%var1 = 4.
    newNode%before => null()
    newNode%next => null()
    newNode%before => middle
    newNode%next => middle%next
    ! middle%next => newNode
    ! newNode%next%before => newNode
    middle%next%before => newNode
    middle%next => newNode
    ptr => head
    do
        if ( associated(ptr) ) then
            write(*, '(F10.2)', advance='no') ptr%var1
            ptr => ptr%next
        else
            exit
        end if
    end do
    write(*, *)
    ptr => tail
    do
        if ( associated(ptr) ) then
            write(*, '(F10.2)', advance='no') ptr%var1
            ptr => ptr%before
        else
            exit
        end if
    end do
    write(*, *)
end subroutine