forums.silverfrost.com Forum Index forums.silverfrost.com
Welcome to the Silverfrost forums
 
 FAQFAQ   SearchSearch   MemberlistMemberlist   UsergroupsUsergroups   RegisterRegister 
 ProfileProfile   Log in to check your private messagesLog in to check your private messages   Log inLog in 

Using PACK on TYPE's
Goto page 1, 2  Next
 
Post new topic   Reply to topic    forums.silverfrost.com Forum Index -> Support
View previous topic :: View next topic  
Author Message
wahorger



Joined: 13 Oct 2014
Posts: 825
Location: Morrison, CO, USA

PostPosted: Thu Jul 23, 2020 4:33 am    Post subject: Using PACK on TYPE's Reply with quote

The following code fails with an Access Violation. It is attempting to PACK a user defined TYPE. Is this not permitted?

Code:

    program main
    type :: my_type
    sequence
    integer:: a
    integer:: b
    integer:: c
    end type
    type (my_type) mine(10)
    logical:: selection(10)
    data selection/.true.,8*.false.,.true./
    integer:: i
    do i=1,10
      mine(i)%a = i*i*1
      mine(i)%b = i*i*2
      mine(i)%c = i*i*3
    end do
    print *,mine(1)%a,mine(10)%a
    mine = pack(mine,selection)
    print *,mine(1)%a,mine(2)%a
    end
Back to top
View user's profile Send private message Visit poster's website
JohnCampbell



Joined: 16 Feb 2006
Posts: 2227
Location: Sydney

PostPosted: Thu Jul 23, 2020 4:45 am    Post subject: Reply with quote

I don't use PACK often.
The Lahey F95 documentation I have states "mask must be of type LOGICAL and must be conformable with array".
"array" can be of any type. It must not be scalar.
The "result" is an array of rank one with the same type and kind as array.
(Doesn't say "intrinsic data type")

What is "conformable" ?
If means count of elements, could it work with logical:: selection(30) ?
I would not be sure of the order or if standard conforming.
Back to top
View user's profile Send private message
wahorger



Joined: 13 Oct 2014
Posts: 825
Location: Morrison, CO, USA

PostPosted: Thu Jul 23, 2020 5:28 am    Post subject: Reply with quote

PACK gives a very easy way to remove items from a list (array) selected by a logical. Unfortunately, it would appear that the type of the ARRAY must be an intrinsic type and not a user defined type. The example code will cause an access violation. If MINE were an intrinsic type, it would all work. Indeed, in my actual code, this works great!
Back to top
View user's profile Send private message Visit poster's website
PaulLaidler
Site Admin


Joined: 21 Feb 2005
Posts: 6564
Location: Salford, UK

PostPosted: Thu Jul 23, 2020 7:18 am    Post subject: Reply with quote

This failure looks like a bug in FTN95 - perhaps a context that was not anticipated. I have logged it for further investigation.
Back to top
View user's profile Send private message AIM Address
Kenneth_Smith



Joined: 18 May 2012
Posts: 373
Location: Hamilton, Lanarkshire, Scotland.

PostPosted: Thu Jul 23, 2020 10:28 am    Post subject: Reply with quote

The code posted above runs correctly with an alternative compiler.

A second alternative compiler also appears to run the code correctly, but examination of the full contents of the arrays before and after the application of PACK reveals that things are not entirely as they should be - but that's not an issue for FTN95.

Ken
Back to top
View user's profile Send private message Visit poster's website
mecej4



Joined: 31 Oct 2006
Posts: 1423

PostPosted: Thu Jul 23, 2020 12:19 pm    Post subject: Reply with quote

I think that the program is in error, and FTN95 /checkmate does not catch the error.

The error is in the assignment statement

Code:
mine = pack(mine,selection)


The expression on the right of the '=' is an array of type my_type with two elements. The variable on the left, on the other hand, is an array of the same type with ten elements.

Such an assignment is not allowed. The variable and expression must match in size, if statically allocated, or the expression must be a scalar, in which case every element of the array variable will be set to the value of the scalar.

Try

Code:
mine(1:2) = pack(mine,selection)


In a larger code, you may have to put in more lines of code to ascertain how many elements are being assigned and the positions in the array variable where the new values need to be deposited.

P.S. I tried the original code with Lahey Fortran 95, without the "(1:2)" added, with error checking turned on. The run aborted with the message

Code:
jwe0329i-s line 18 Two entities must be in shape conformance (mine,PACK)


Last edited by mecej4 on Thu Jul 23, 2020 5:03 pm; edited 1 time in total
Back to top
View user's profile Send private message
Kenneth_Smith



Joined: 18 May 2012
Posts: 373
Location: Hamilton, Lanarkshire, Scotland.

PostPosted: Thu Jul 23, 2020 1:17 pm    Post subject: Reply with quote

I think you are correct Mecej4, both alternative compilers return consistient results with your suggested change.

Code:
!   WITH mine = pack(mine,selection)

    Before pack
           1           2           3
           4           8          12
           9          18          27
          16          32          48
          25          50          75
          36          72         108
          49          98         147
          64         128         192
          81         162         243
         100         200         300

 After pack
           1           2           3
         100         200         300
           0           0           0
           0           0           0
           0           0           0
           0           0           0
           0           0           0
           0           0           0
           0           0           0
           0           1           0


!   WITH mine(1:2) = pack(mine,selection)

Before pack
           1           2           3
           4           8          12
           9          18          27
          16          32          48
          25          50          75
          36          72         108
          49          98         147
          64         128         192
          81         162         243
         100         200         300

 After pack
           1           2           3
         100         200         300
           9          18          27
          16          32          48
          25          50          75
          36          72         108
          49          98         147
          64         128         192
          81         162         243
         100         200         300


The data that was in row two is lost. NB above output not from FTN95.
Back to top
View user's profile Send private message Visit poster's website
wahorger



Joined: 13 Oct 2014
Posts: 825
Location: Morrison, CO, USA

PostPosted: Thu Jul 23, 2020 2:00 pm    Post subject: Reply with quote

Paul, thanks for the investigation.

Kenneth and mecej4,

To expand on the "code error" idea, if I were to code this as:
Code:
MINE(1:2)=PACK(MINE,SELECTION)
it will still fail with Access Violation.

The implication from the documentation is if the PACK operation succeeds, the remainder of the type is filled with zeroes. I see that when I'm using intrinsic types in the PACK.

Of course, what happens with user-defined types is unclear. That is part of why I am experimenting and found this result (unexpected).
Back to top
View user's profile Send private message Visit poster's website
Kenneth_Smith



Joined: 18 May 2012
Posts: 373
Location: Hamilton, Lanarkshire, Scotland.

PostPosted: Thu Jul 23, 2020 2:38 pm    Post subject: Reply with quote

This is interesting.
Only one of the two alternative compilers results in zeros for all the remaining elements - and that is without Mecej4's suggestion. One compiler sneeks a 1 into the last row as shown above.
With Mecej4's suggestion both alternative compilers return identical non-zero values for the remaining elements!
So for this particular code, looking at other compilers does not help very much.
I guess we will have to wait and see Paul's verdict on this one.
Back to top
View user's profile Send private message Visit poster's website
mecej4



Joined: 31 Oct 2006
Posts: 1423

PostPosted: Thu Jul 23, 2020 6:44 pm    Post subject: Re: Reply with quote

Kenneth_Smith wrote:
This is interesting... With Mecej4's suggestion both alternative compilers return identical non-zero values for the remaining elements!


Rather, those remaining elements simply retain their previous contents. Those contents may be read when evaluating the expression, but only the first two are altered.
Back to top
View user's profile Send private message
JohnCampbell



Joined: 16 Feb 2006
Posts: 2227
Location: Sydney

PostPosted: Fri Jul 24, 2020 4:29 am    Post subject: Reply with quote

This adaptation runs until "mine(1:n) = pack(mine,selection)",
appearing to work for "n = size(pack(mine,selection))"
Code:
    program main
    type :: my_type
    sequence
    integer:: a
    integer:: b
    integer:: c
    end type
    type (my_type) mine(10)
   
    logical:: selection(10)
    data selection/.true.,8*.false.,.true./
    integer:: i, n
   
    print *, 'size(mine)',size(mine)
    do i=1,10
      mine(i)%a = i*i*1
      mine(i)%b = i*i*2
      mine(i)%c = i*i*3
    end do
    n = size(pack(mine,selection))
    print *, size(pack(mine,selection)),n
    mine(1:n) = pack(mine,selection)
    print *,mine(1)%a,mine(10)%a
    print *,mine(1)%a,mine(2)%a
    print *,mine(1)%b,mine(10)%b
    print *,mine(1)%b,mine(2)%b
    end
Back to top
View user's profile Send private message
mecej4



Joined: 31 Oct 2006
Posts: 1423

PostPosted: Fri Jul 24, 2020 8:11 am    Post subject: Reply with quote

Fortran 2008 provides a feature that enables one to avoid repetitions (three in JohnC's code, one of which can be avoided) of the expression pack(mine,selection), since in a large program such repeated evaluations can carry a significant penalty in execution speed. This is the "reallocate on assignment" feature, which is supported by many compilers.

Code:
   program main
    type :: my_type
      sequence
      integer:: a, b, c
    end type
    type (my_type), allocatable :: mine(:)
   
    logical:: selection(10)
    data selection/.true.,8*.false.,.true./
    integer:: i
   
    allocate(mine(10))
    print *, 'Original size(mine)',size(mine)
    do i=1,10
      mine(i)%a = i*i*1
      mine(i)%b = i*i*2
      mine(i)%c = i*i*3
    end do
   
    mine = pack(mine,selection)
   
    print *, 'Size(mine) after packing',size(mine)
    end


With the reallocate on assign enabled, we should see the output

Code:
 Original size(mine)          10
 Size(mine) after packing           2


If the reduction in size is not wanted, one would write, instead,

Code:
  mine(:) = pack(mine,selection)
Back to top
View user's profile Send private message
wahorger



Joined: 13 Oct 2014
Posts: 825
Location: Morrison, CO, USA

PostPosted: Wed Jul 29, 2020 4:15 am    Post subject: Reply with quote

mecej4,

Thanks for the continued interest in this. I appreciate the alternate coding; interesting.

For my application, since it is done under user control, it is infrequent so a performance penalty is insignificant, even for my largest data sets.

Bill
Back to top
View user's profile Send private message Visit poster's website
JohnCampbell



Joined: 16 Feb 2006
Posts: 2227
Location: Sydney

PostPosted: Sat Aug 01, 2020 5:51 am    Post subject: Reply with quote

Interesting consideration of PACK, including it's inability to notify of the size of the result. ( this would need F08 re-allocate to be useful)

I will persist with my DO loop approach, whare any ambiguity is removed.
array.
Code:
    program main
    type :: my_type
      sequence
      integer :: a
      integer :: b
      integer :: c
    end type
    type (my_type), allocatable :: mine(:)
   
    logical :: selection(10)
    integer :: i, n,m
!
    ALLOCATE (MINE(size(selection)))
    m = size(mine)
    print *, 'size(mine) =',m,' : ALLOCATE (MINE(10))'
    do i=1,m
      selection(i) = i==1 .or. i==m
      mine(i)%a = i*i*1
      mine(i)%b = i*i*2
      mine(i)%c = i*i*3
      write (*,*) i, mine(i)
    end do
!
    n = 0
    do i = 1,size(mine)
      if ( .not. selection(i) ) cycle
      n = n+1 ; if ( n==i ) cycle
      mine(n) = mine(i)
    end do
    print *, 'active size of mine reduced to',n,' using DO'
!
    mine = mine(1:n)                           ! redefine size of mine
    m = size(mine)
    print *, 'size(mine) =',m,' : mine = mine(1:2)'
    do i=1,m
      write (*,*) i, mine(i)
    end do
!
    end
Back to top
View user's profile Send private message
JohnCampbell



Joined: 16 Feb 2006
Posts: 2227
Location: Sydney

PostPosted: Sat Aug 01, 2020 5:58 am    Post subject: Reply with quote

Below is an interesting use of PACK, which claims to require F90, but may be F03/F08?
It is extremely brief but is expensive on memory. It works well.
I have modified to do a forward sort and included code to test for various sizes.
Code:
! qsort_reals.f90 --
!
!     Example belonging to "Modern Fortran in Practice" by Arjen Markus
!
!     This work is licensed under the Creative Commons Attribution 3.0 Unported License.
!     To view a copy of this license, visit http://creativecommons.org/licenses/by/3.0/
!     or send a letter to:
!     Creative Commons, 444 Castro Street, Suite 900, Mountain View, California, 94041, USA.
!
!     Compact implementation of the QuickSort algorithm
!
!     Note:
!     Because the function uses Fortran 90 features, its interface should be made
!     explicit when using it in an actual program. This is easiest via a module.
!
module qsort_functions
    implicit none
 contains
  recursive function qsort_reals ( data ) result ( sorted )
    real, dimension(:), intent(in) :: data
    real, dimension(1:size(data))  :: sorted

    write (*,*) size(data)
    if ( size(data) > 1 ) then
        sorted = &
            (/ qsort_reals( pack( data(2:), data(2:) <= data(1) ) ),   &
               data(1),                                                &
               qsort_reals( pack( data(2:), data(2:) >  data(1) ) ) /)
    else
        sorted = data
    endif
  end function qsort_reals

end module qsort_functions

  Program test_sort_reals
   real*8 t1,t2
   integer i,n,j

    open (11,file='markus_sort.txt', position='append')

    do i = 2,5 ! 25
      N = 2**i
      call test_sort(N,j,t1, t2)
      write ( *,11) i,' sort',n,j,' errors ',t1,t2
      write (11,11) i,' sort',n,j,' errors ',t1,t2
    end do
 11 format (i3,a,2i10,a,2f12.6)
 
 end Program test_sort_reals
 
 real*8 function elapse_second ()
   integer*8 :: clock, tick, start = -1
    call system_clock ( clock, tick )
    if ( start < 0 ) start = clock
    elapse_second = dble(clock-start) / dble (tick)
 end function elapse_second


 subroutine test_sort (N, j, t, x)
use qsort_functions
   integer N
!z   real    aa(N), aa_sort(N)    ! automatic arrays
   real, allocatable :: aa(:), aa_sort(:)    ! allocate arrays
   real*8 t, x
   real*8, external :: elapse_second
   integer i,j
!
    allocate ( aa(N), aa_sort(N) )
    call random_number (aa)
    write (*,*) n, aa
!
! do sort
      t = elapse_second ()
    aa_sort = qsort_reals ( aa )
      t = elapse_second () - t
!
! test sort is correct
      x = elapse_second ()
    j = 0
    do i = 2, size(aa)
      if ( aa_sort(i) >= aa_sort(i-1) ) cycle
      j = j+1
      write (*,*) i, aa_sort(i-1), aa_sort(i)
    end do
      x = elapse_second () - x
 end subroutine test_sort
Back to top
View user's profile Send private message
Display posts from previous:   
Post new topic   Reply to topic    forums.silverfrost.com Forum Index -> Support All times are GMT + 1 Hour
Goto page 1, 2  Next
Page 1 of 2

 
Jump to:  
You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum
You cannot vote in polls in this forum


Powered by phpBB © 2001, 2005 phpBB Group