- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
Hi, I want to build array of linked list, which will be used as temporary sparse matrix storage,
in case when the number of row of matrix is known, but the number of elements in each row is unknown.
So, I want to make array of linked list, whose size is the number of row of matrix,
and store the matrix by filling the colume as linked list.
below is my temporary version.
program test implicit none type :: pointCSR integer :: icol ! complex(8) :: cval -> will be added later type(pointCSR), pointer :: p end type type(pointCSR), dimension(:), pointer :: head, tail type(pointCSR), pointer :: ptr integer :: nrow = 3 integer :: i, istat integer :: n1, n2 logical, dimension(nrow) :: lswt allocatae(head(nrow), tail(nrow)) tail(1:nrow) => head(1:nrow) do i = 1, 3 nullify(tail(i)%p) end do lswt(:) = .true. open(1, file='input.dat') do read(1, '(2(I))', iostat=istat) n1, n2 if (istat.ne.0) exit if (lswt(n1)) then lswt(n1) = .false. tail(n1)%icol = n2 else allocate(tail(n1)%p) tail(n1) => tail(n1)%p nullify(tail(n1)%p) tail(n1)%icol = n2 end if end do close(1) !print results do i = 1, nrow print*, 'row: ', i ptr => head(i) do if (.not.associated(ptr)) exit print*, ptr%icol ptr => ptr%p dnd do end do end program test
when I compile the upper program the error message comes out:
error #8524: The syntax of this data pointer assignment is incorrect: either 'bound spec' or 'bound remapping' is expected in this context. [N1]
tail(n1) => tail(n1)%p
---------------------^
I don't know why and how to fix the code...
Also, I need code for successfully deallocating the array of linked list in order to prevent memory leak...
If you find error, or have better idea, please let me know.
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
Well, I looked over your code and there were a few things I noticed:
- Use of hardwired KIND numbers like COMPLEX(8) CVAL
- Use of hardwired unit numbers like OPEN(1,FILE='csriinput.dat')
- Duplication of information already stored in Fortran 'fat' pointers
- Bare pointers in tree-type data structures
the rest
The first 3 bullet points above are easily fixed, but the fourth needs some explanation. Fortran pointers aren't first-class data objects in the sense that you can't point at them, only their target, not to mention that you can't have arrays of them, only pointers to arrays. In tree-type data structures (I don't know if that is the right terminology, I just mean data structures which contain pointers to structures of the same type) you need pointers that are first-class data objects and the lack of them means you end up with all sorts of special cases to deal with that make code difficult to maintain.
The solution is to wrap the pointers that point at structures of the same type in their own structure that contains only the pointer. The enclosing structure then is a first-class data object and the code simplifies quite a bit. Here is llarray.f90
! llarray.f90 module M implicit none ! integer, parameter :: dp = kind([double precision ::]) type PTRllnode type(llnode), pointer :: p => NULL() end type PTRllnode type llnode integer col ! complex(dp) payload type(PTRllnode) next end type llnode end module M program Q use M implicit none type(PTRllnode), pointer :: p type(PTRllnode), allocatable, target :: heads(:) integer nrow integer row integer col integer iunit, istat ! complex(dp) payload open(newunit=iunit,file='csriinput.txt',status='old') read(iunit,*) nrow allocate(heads(nrow)) do read(iunit,*,iostat=istat) row,col !,payload if(istat /= 0 .OR. row < lbound(heads,1) .OR. row > ubound(heads,1)) exit p => heads(row) do while(associated(p%p)) p => p%p%next end do allocate(p%p) p%p%col = col ! p%p%payload = payload end do do row = lbound(heads,1),ubound(heads,1) print '(*(g0))', 'row: ',row p => heads(row) do while(associated(p%p)) print '(*(g0))', ' col: ',p%p%col p => p%p%next end do end do end program Q
And the input file, csriinput.txt
3 1 2 1 3 3 1 3 3
And the program output:
row: 1 col: 2 col: 3 row: 2 row: 3 col: 1 col: 3
I also used initializers so that all the pointers came out nullified from the start.
Link Copied
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
Fortran does not have the concept of an array of pointers. tail is a pointer that points to an array. One way to approach this is to make tail an array of a derived type containing a pointer. But I don't think that's the solution you're looking for.
I haven't yet figured out what you are trying to do with
allocate(tail(n1)%p) tail(n1) => tail(n1)%p nullify(tail(n1)%p) tail(n1)%icol = n2
Don't you want the p of the current tail to point to the newly allocated one? You'd maybe want something that has the effect of:
current_tail%p => tail(n1)%p
As you have it now, tail is an array of pointCSR items. I often find it helpful to sketch out diagrams on paper of what I want structures and pointers to look like before and after an operation.
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
Dear Steve
My code is based on the fortran book I read.
In that book, the basic algorithm of linked list is like below
program linked list implicit none type :: rlist real :: v type(rlist), pointer :: p end type rlist type(rlist), pointer :: head, tail integer :: istat real :: tmp open(1, file='input.dat') do read(1,*,iostat=istat) tmp if (istat.ne.0) exit if (.not.associated(head)) then ! no values in list allocate(head) ! allocate new value tail => head ! tail points to new value nullify(tail%p) ! nullify p in new value tail%v = tmp ! store number else ! values already in list allocate(tail%p) ! allocate new value tail=>tail%p ! tail points to new value nullify(tail%p) ! nullify p in new value tail%v = tmp ! store number end if end do close(1) end program
So, I just simply wanted to make that algorithm in array form like below..
but maybe this form is impossible in fortran and I can't figure out about it anyway...
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
I am not sure what you want to do, but are you aware of the CSR (compressed sparse row), CSC (compressed sparse column) and COO (row-column-value triplet array) sparse matrix storage schemes? MKL uses CSR, and you can see a description of these schemes at https://en.wikipedia.org/wiki/Sparse_matrix . Usually, in these schemes arrays are used, but you could use linked lists instead.
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
Dear mecej4
Yes, I'm thinking of CSR format.
What I'm working on is numerical modeling of wave equations( elastic, acoustic, electromagentic)
When I'm trying to use FEM and solve matrix equation by PARDISO, the main problem is constructing CSR arrays.
This is because I don't know how many components will be in system matrix, so I can't allocate CSR arrays(ja, a).
(I know the number of rows of matrix, but I don't know the number of components will be in each row)
What I think as a solution is store informations by using linked list since it does not need to be allocated in advance,
it can count the number of components while storing informations, sorting is also possible while inserting informations.
Then, the arrays for CSR format can be allocated and filled in from the data stored in linked list.
However, if I perform that process by using single linked list, the sorting process can be very inefficient.
So, I'm trying to make the number of rows of linked lists.
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
You can make two passes over your mesh. In the first pass, you simply keep counters for the number of non-zero entries in each row. You do only enough of the FEM element calculation to know that the value is not zero -- the actual non-zero value is not needed yet.
Once you have processed the whole mesh, you know the number of entries in each row; in other words, the entries in the IA (row pointer) array. Allocate the JA(1:nnz), V(1:nnz) arrays (column number, value) for the CSR representation.
Make a second pass over the mesh. This time, compute the element contributions completely, and fill in the JA and V array entries.
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
Dear mecej4
Since I'll use edge-based FEM in tetralhedral element and the mesh is generated by using mesh generator,
I think the problem is a little bit more complex.
In edge-based FEM, the number of components in each row is associated with the number of elements which share common edge.
Since the mesh is tetrahedron, the number of elements is irregular and it requires very inefficient loop to find the elements.
This is what I want to avoid.
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
Dear Steve
I think I've found the solution!
New code is like below.
program test implicit none type :: pointCSR integer :: v type(pointCSR), pointer :: p end type pointCSR type :: arrpointCSR logical :: switch type(pointCSR), pointer :: p end type arrpointCSR type(pointCSR), pointer :: ptr type(arrpointCSR), dimension(:), allocatable :: heads integer :: nrow = 3 integer :: i, istat integer :: n1, n2 allocate(heads(nrow)) heads(:)%switch = .False. open(1, file='csriinput.dat') do read(1,*,iostat=istat) n1, n2 if (istat.ne.0) exit if (.not.heads(n1)%swt) then allocate(ptr) ptr%v = n2 nullify(ptr%p) heads(n1)%p => ptr heads(n1)%swt = .True. else ptr => heads(n1)%p do if (associated(ptr%p)) then ptr => ptr%p else allocate(ptr%p) ptr => ptr%p ptr%v = n2 nullify(ptr%p) exit end if end do end if end do close(1) ! print results do i = 1, nrow print*, 'row: ', i ptr => heads(i)%p do if (.not.associated(ptr)) exit print*, ptr%v ptr => ptr%p end do end do end program test
This code seems good and the result is fine.
But if you have better ideas, it'll be very grateful to leave comments about the code.
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
What I might do is allocate your storage array at a first guess size. And then start populating the array. If I get to a point where the array is full I allocate a larger temp array (maybe x2), copy to the tmp array and the do a MOVE_ALLOC which dellocates the tmp array and replaces the original array with the temp array. The move_alloc avoids copying the data twice, there is only one copy operation. If you want an exactly full array you need a move_alloc at the end to an array of exactly the correct size.
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
Well, I looked over your code and there were a few things I noticed:
- Use of hardwired KIND numbers like COMPLEX(8) CVAL
- Use of hardwired unit numbers like OPEN(1,FILE='csriinput.dat')
- Duplication of information already stored in Fortran 'fat' pointers
- Bare pointers in tree-type data structures
the rest
The first 3 bullet points above are easily fixed, but the fourth needs some explanation. Fortran pointers aren't first-class data objects in the sense that you can't point at them, only their target, not to mention that you can't have arrays of them, only pointers to arrays. In tree-type data structures (I don't know if that is the right terminology, I just mean data structures which contain pointers to structures of the same type) you need pointers that are first-class data objects and the lack of them means you end up with all sorts of special cases to deal with that make code difficult to maintain.
The solution is to wrap the pointers that point at structures of the same type in their own structure that contains only the pointer. The enclosing structure then is a first-class data object and the code simplifies quite a bit. Here is llarray.f90
! llarray.f90 module M implicit none ! integer, parameter :: dp = kind([double precision ::]) type PTRllnode type(llnode), pointer :: p => NULL() end type PTRllnode type llnode integer col ! complex(dp) payload type(PTRllnode) next end type llnode end module M program Q use M implicit none type(PTRllnode), pointer :: p type(PTRllnode), allocatable, target :: heads(:) integer nrow integer row integer col integer iunit, istat ! complex(dp) payload open(newunit=iunit,file='csriinput.txt',status='old') read(iunit,*) nrow allocate(heads(nrow)) do read(iunit,*,iostat=istat) row,col !,payload if(istat /= 0 .OR. row < lbound(heads,1) .OR. row > ubound(heads,1)) exit p => heads(row) do while(associated(p%p)) p => p%p%next end do allocate(p%p) p%p%col = col ! p%p%payload = payload end do do row = lbound(heads,1),ubound(heads,1) print '(*(g0))', 'row: ',row p => heads(row) do while(associated(p%p)) print '(*(g0))', ' col: ',p%p%col p => p%p%next end do end do end program Q
And the input file, csriinput.txt
3 1 2 1 3 3 1 3 3
And the program output:
row: 1 col: 2 col: 3 row: 2 row: 3 col: 1 col: 3
I also used initializers so that all the pointers came out nullified from the start.
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
Dear Repeat Offender
I'm not sure about myself that I perfectly understood your explanations about first class data objects and tree-type data structures.
So, If it does not disturb you, may I ask some more questions about them?
Be rid of my special case (array of linked lists) and go to the basic linked list case, the simple form to make linked list is:
program linkedlist implicit none type :: list integer :: v ... type(list), pointer :: next end type list type(list), pointer :: ptr type(list), pointer :: head ... end program
If I understand clear, the upper formula has some internal problems. The right form is:
program linkedlist2 implicit none type :: ptrlist type(list), pointer :: p => null() end type ptrlist type :: list integer :: v .... type(ptrlist) :: next ! Does 'type(list), pointer :: next' is also not possible? end type list type(ptrlist), pointer :: ptr type(ptrlist), target :: head .... end program
Am I right? I can't make sure that the upper formula is generally better than the first simple formula or just appropriate for my array of linked list case.
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
The important idea that RO conveyed is that in Fortran, in contrast to, say, C, "pointer" is an attribute, not a type. Or, to use terms from grammar, "pointer" is an adjective, not a noun. Therefore, you cannot have an array of pointers in Fortran, in contrast to C, where you certainly can. You can have a set of sharp knives, but you cannot have a set of sharps (unless you are a seamster, to whom "sharp" is a kind of sewing needle).
The second difference is that when the name of a variable with the pointer attribute is used in an expression, etc., no special symbol is used to specify that dereferencing is to be done. In C, on the other hand, if p is a pointer to a certain variable v, *p is the value of the target. Thus, instead of the C code
p = &v; *p = expression;
in Fortran we do
p => v; p = expression
Given these differences, what RO does is to show how to accomplish something that is prohibited (given his title, that is his duty!), i.e., create an array of lightly clad pointers.
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
I was trying to make also the point that tree-type data structures are easier to work with if they don't have naked pointers. Here is an example where module M1 has naked pointers and module M2 has pointers wrapped in structures. Note that module M2 is a lot simpler because many special cases have been removed. I first saw this technique in IIRC Walt Brainerd's book and I was very impressed with it.
! tesll.f90 module M implicit none private type, public :: MyType integer key contains procedure GreaterOrEqual generic :: operator(>=) => GreaterOrEqual procedure Assign procedure Construct generic :: assignment(=) => Assign, Construct end type MyType enum, bind(C) enumerator :: & OpInsertAtHead = 1, & OpInsertInOrder = 2, & OpInsertATail = 3, & OpDelete = 4, & OpDeleteInOrder = 6, & OpFind = 7, & OpFindInOrder = 8, & OpPrintForward = -1, & OpPrintReverse = -2, & OpDestroy = -3 end enum public :: OpInsertAtHead, OpInsertInOrder, OpInsertATail, & OpDelete, OpDeleteInOrder, OpFind, OpFindInOrder, & OpPrintForward, OpPrintReverse, OpDestroy contains function GreaterOrEqual(this,that) logical GreaterOrEqual class(MyType), intent(in) :: this type(MyType), intent(in) :: that GreaterOrEqual = this%key >= that%key end function GreaterOrEqual subroutine Assign(this,that) class(MyType), intent(out) :: this type(MyType), intent(in) :: that this%key = that%key end subroutine Assign subroutine Construct(this,value) class(MyType), intent(out) :: this integer, intent(in) :: value this%key = value end subroutine Construct end module M module M1 use M, T => MyType implicit none private public sub type ListNode type(T) key type(ListNode), pointer :: next => NULL() end type ListNode contains subroutine InsertAtHead(head,value) type(ListNode), pointer :: head type(T), intent(in) :: value type(ListNode), pointer :: cursor allocate(cursor) cursor%next => head cursor%key = value head => cursor end subroutine InsertAtHead subroutine InsertInOrder(head,value) type(ListNode), pointer :: head type(T), intent(in) :: value type(ListNode), pointer :: cursor if(.NOT.associated(head)) then call InsertAtHead(head,value) else if(head%key >= value) then if(.NOT.value >= head%key) then call InsertAtHead(head,value) end if else cursor => head do while(associated(cursor%next)) if(cursor%next%key >= value) then if(.NOT.value >= cursor%next%key) then call InsertAtHead(cursor%next,value) end if return end if cursor => cursor%next end do allocate(cursor%next) cursor%next%key = value end if end subroutine InsertInOrder subroutine InsertAtTail(head,value) type(ListNode), pointer :: head type(T), intent(in) :: value type(ListNode), pointer :: cursor if(.NOT.associated(head)) then allocate(head) head%key = value else cursor => head do if(cursor%key >= value) then if(value >= cursor%key) then return end if end if if(.NOT.associated(cursor%next)) exit cursor => cursor%next end do allocate(cursor%next) cursor%next%key = value end if end subroutine InsertAtTail subroutine Delete(head,value) type(ListNode), pointer :: head type(T), intent(in) :: value type(ListNode), pointer :: cursor, temp if(.NOT.associated(head)) then return else if(value >= head%key .AND. head%key >= value) then cursor => head head => head%next deallocate(cursor) else cursor => head do while(associated(cursor%next)) if(value >= cursor%next%key .AND. cursor%next%key >= value) then temp => cursor%next cursor%next => cursor%next%next deallocate(temp) return end if cursor => cursor%next end do end if end subroutine Delete subroutine DeleteInOrder(head,value) type(ListNode), pointer :: head type(T), intent(in) :: value type(ListNode), pointer :: cursor, temp if(.NOT.associated(head)) then return else if(head%key >= value) then if(value >= head%key) then cursor => head head => head%next deallocate(cursor) end if else cursor => head do while(associated(cursor%next)) if(cursor%next%key >= value) then if(value >= cursor%next%key) then temp => cursor%next cursor%next => cursor%next%next deallocate(temp) end if return end if cursor => cursor%next end do end if end subroutine DeleteInOrder function Find(head,value) logical Find type(ListNode), pointer :: head type(T), intent(in) :: value type(ListNode), pointer :: cursor if(.NOT.associated(head)) then Find = .FALSE. else cursor => head do while(associated(cursor)) if(value >= cursor%key .AND. cursor%key >= value) then Find = .TRUE. return end if cursor => cursor%next end do Find = .FALSE. end if end function Find function FindInOrder(head,value) logical FindInOrder type(ListNode), pointer :: head type(T), intent(in) :: value type(ListNode), pointer :: cursor if(.NOT.associated(head)) then FindInOrder = .FALSE. else cursor => head do while(associated(cursor)) if(cursor%key >= value) then FindInOrder = value >= cursor%key return end if cursor => cursor%next end do FindInOrder = .FALSE. end if end function FindInOrder subroutine PrintForward(head) type(ListNode), pointer :: head type(ListNode), pointer :: cursor cursor => head do while(associated(cursor)) write(*,*) cursor%key cursor => cursor%next end do end subroutine PrintForward recursive subroutine PrintReverse(head) type(ListNode), pointer :: head if(associated(head)) then call PrintReverse(head%next) write(*,*) head%key end if end subroutine PrintReverse subroutine Destroy(head) type(ListNode), pointer :: head type(ListNode), pointer :: cursor do while(associated(head)) cursor => head head => head%next deallocate(cursor) end do end subroutine Destroy subroutine sub(filename) character(*), intent(in) :: filename integer iunit integer op, value, i type(ListNode), pointer :: head => NULL() open(newunit=iunit,file=filename,status='old') do read(iunit,*,end=10) op,(value,i=1,merge(1,0,op >= 0)) select case(op) case(OpInsertAtHead) call InsertAtHead(head,T(value)) case(OpInsertInOrder) call InsertInOrder(head,T(value)) case(OpInsertATail) call InsertAtTail(head,T(value)) case(OpDelete) call Delete(head,T(value)) case(OpDeleteInOrder) call DeleteInOrder(head,T(value)) case(OpFind) write(*,'(*(g0))') 'Value: ',value,' was', & trim(merge(' ',' NOT',Find(head,T(value)))),' found' case(OpFindInOrder) write(*,'(*(g0))') 'Value: ',value,' was', & trim(merge(' ',' NOT',FindInOrder(head,T(value)))),' found' case(OpPrintForward) write(*,'(a)') 'Printing list forward' call PrintForward(head) case(OpPrintReverse) write(*,'(a)') 'Printing list backward' call PrintReverse(head) case(OpDestroy) call Destroy(head) case default write(*,'(*(g0))') 'Unrecognized op: ',op exit end select end do 10 continue close(iunit) end subroutine sub end module M1 module M2 use M, T => MyType implicit none private public sub type PtrNode type(ListNode), pointer :: p => NULL() end type PtrNode type ListNode type(T) key type(PtrNode) next end type ListNode contains subroutine InsertAtHead(head,value) type(PtrNode) :: head type(T), intent(in) :: value type(PtrNode) :: cursor allocate(cursor%p) cursor%p%next = head cursor%p%key = value head = cursor end subroutine InsertAtHead subroutine InsertInOrder(head,value) type(PtrNode), target :: head type(T), intent(in) :: value type(PtrNode), pointer :: cursor cursor => head do while(associated(cursor%p)) if(cursor%p%key >= value) then if(.NOT.value >= cursor%p%key) then call InsertAtHead(cursor,value) end if return end if cursor => cursor%p%next end do allocate(cursor%p) cursor%p%key = value end subroutine InsertInOrder subroutine InsertAtTail(head,value) type(PtrNode), target :: head type(T), intent(in) :: value type(PtrNode), pointer :: cursor cursor => head do while(associated(cursor%p)) if(cursor%p%key >= value) then if(value >= cursor%p%key) then return end if end if cursor => cursor%p%next end do allocate(cursor%p) cursor%p%key = value end subroutine InsertAtTail subroutine Delete(head,value) type(PtrNode), target :: head type(T), intent(in) :: value type(PtrNode), pointer :: cursor type(PtrNode) temp cursor => head do while(associated(cursor%p)) if(cursor%p%key >= value) then if(value >= cursor%p%key) then temp = cursor cursor = cursor%p%next deallocate(temp%p) return end if end if cursor => cursor%p%next end do end subroutine Delete subroutine DeleteInOrder(head,value) type(PtrNode), target :: head type(T), intent(in) :: value type(PtrNode), pointer :: cursor type(PtrNode) temp cursor => head do while(associated(cursor%p)) if(cursor%p%key >= value) then if(value >= cursor%p%key) then temp = cursor cursor = cursor%p%next deallocate(temp%p) end if return end if cursor => cursor%p%next end do end subroutine DeleteInOrder function Find(head,value) logical Find type(PtrNode) :: head type(T), intent(in) :: value type(PtrNode) :: cursor cursor = head do while(associated(cursor%p)) if(value >= cursor%p%key .AND. cursor%p%key >= value) then Find = .TRUE. return end if cursor = cursor%p%next end do Find = .FALSE. end function Find function FindInOrder(head,value) logical FindInOrder type(PtrNode) :: head type(T), intent(in) :: value type(PtrNode) :: cursor cursor = head do while(associated(cursor%p)) if(cursor%p%key >= value) then if(value >= cursor%p%key) then FindInOrder = .TRUE. end if return end if cursor = cursor%p%next end do FindInOrder = .FALSE. end function FindInOrder subroutine PrintForward(head) type(PtrNode) :: head type(PtrNode) :: cursor cursor = head do while(associated(cursor%p)) write(*,*) cursor%p%key cursor = cursor%p%next end do end subroutine PrintForward recursive subroutine PrintReverse(head) type(PtrNode) :: head if(associated(head%p)) then call PrintReverse(head%p%next) write(*,*) head%p%key end if end subroutine PrintReverse subroutine Destroy(head) type(PtrNode) :: head type(PtrNode) :: cursor do while(associated(head%p)) cursor = head head = head%p%next deallocate(cursor%p) end do end subroutine Destroy subroutine sub(filename) character(*), intent(in) :: filename integer iunit integer op, value, i type(PtrNode) :: head open(newunit=iunit,file=filename,status='old') do read(iunit,*,end=10) op,(value,i=1,merge(1,0,op >= 0)) select case(op) case(OpInsertAtHead) call InsertAtHead(head,T(value)) case(OpInsertInOrder) call InsertInOrder(head,T(value)) case(OpInsertATail) call InsertAtTail(head,T(value)) case(OpDelete) call Delete(head,T(value)) case(OpDeleteInOrder) call DeleteInOrder(head,T(value)) case(OpFind) write(*,'(*(g0))') 'Value: ',value,' was', & trim(merge(' ',' NOT',Find(head,T(value)))),' found' case(OpFindInOrder) write(*,'(*(g0))') 'Value: ',value,' was', & trim(merge(' ',' NOT',FindInOrder(head,T(value)))),' found' case(OpPrintForward) write(*,'(a)') 'Printing list forward' call PrintForward(head) case(OpPrintReverse) write(*,'(a)') 'Printing list backward' call PrintReverse(head) case(OpDestroy) call Destroy(head) case default write(*,'(*(g0))') 'Unrecognized op: ',op exit end select end do 10 continue close(iunit) end subroutine sub end module M2 program P use M1, only: sub1 => sub use M2, only: sub2 => sub implicit none write(*,'(a)') 'Testing version 1' call sub1('testll.txt') write(*,'(a)') 'Testing version 2' call sub2('testll.txt') end program P
Here is a sample input file, testll.txt:
-3 Destroy empty list 4 10 Delete from empty list -1 Print empty list forward -2 Print empty list backwards 7 1 Find in empty list 1 5 Prepend 5 to empty list 1 4 Prepend 4 1 1 Prepend 1 3 6 Append 6 3 7 Append 7 3 10 Append 10 3 6 Append duplicate -1 Print list forward 7 1 Find first value 7 6 Find middle value 7 10 Find last value 7 11 Find absent value 4 11 Delete absent element 4 1 Delete first element 4 6 Delete from middle 4 10 Delete last element -2 Print backwards -3 Destroy list 3 7 Append 7 to empty list 3 6 Append 6 -1 Print forward 4 7 Delete first element 4 6 Delete final element -1 Print empty list forward 8 1 Find in empty list 2 4 Insert 4 in order 2 1 Insert 1 in order 2 6 Insert 6 in order 2 10 Insert 10 in order 2 5 Insert 5 in order 2 8 Insert 8 in order 2 6 Insert duplicate -1 Print forward 8 1 Find first value 8 6 Find middle value 8 10 Find last value 8 11 Find absent value 6 7 Delete absent element 6 1 Delete first element 6 6 Delete middle element 6 10 Delete last element -1 Print forward -3 Clean up -4 Exit
And output with ifort:
Testing version 1 Printing list forward Printing list backward Value: 1 was NOT found Printing list forward 1 4 5 6 7 10 Value: 1 was found Value: 6 was found Value: 10 was found Value: 11 was NOT found Printing list backward 7 5 4 Printing list forward 7 6 Printing list forward Value: 1 was NOT found Printing list forward 1 4 5 6 8 10 Value: 1 was found Value: 6 was found Value: 10 was found Value: 11 was NOT found Printing list forward 4 5 8 Unrecognized op: -4 Testing version 2 Printing list forward Printing list backward Value: 1 was NOT found Printing list forward 1 4 5 6 7 10 Value: 1 was found Value: 6 was found Value: 10 was found Value: 11 was NOT found Printing list backward 7 5 4 Printing list forward 7 6 Printing list forward Value: 1 was NOT found Printing list forward 1 4 5 6 8 10 Value: 1 was found Value: 6 was found Value: 10 was found Value: 11 was NOT found Printing list forward 4 5 8 Unrecognized op: -4
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
Dear Repeat Offender
Yeah, I got it. Now I can see the difference bewteen two types of declaration of tree-type structures clearly.
The technique you recommended is very impressive and interesting and I think the final version of my code will be excellent
Thank you very very much :)
- Subscribe to RSS Feed
- Mark Topic as New
- Mark Topic as Read
- Float this Topic for Current User
- Bookmark
- Subscribe
- Printer Friendly Page