Silverfrost Forums

Welcome to our forums

Using PACK on TYPE's

23 Jul 2020 3:33 #26081

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

    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
23 Jul 2020 3:45 #26082

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.

23 Jul 2020 4:28 #26083

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!

23 Jul 2020 6:18 #26084

This failure looks like a bug in FTN95 - perhaps a context that was not anticipated. I have logged it for further investigation.

23 Jul 2020 9:28 #26085

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

23 Jul 2020 11:19 (Edited: 23 Jul 2020 4:03) #26086

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

The error is in the assignment statement

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

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

jwe0329i-s line 18 Two entities must be in shape conformance (mine,PACK)
23 Jul 2020 12:17 #26087

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

!   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.

23 Jul 2020 1:00 #26088

Paul, thanks for the investigation.

Kenneth and mecej4,

To expand on the 'code error' idea, if I were to code this as:

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).

23 Jul 2020 1:38 #26089

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.

23 Jul 2020 5:44 #26090

Quoted from Kenneth_Smith 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.

24 Jul 2020 3:29 #26091

This adaptation runs until 'mine(1:n) = pack(mine,selection)', appearing to work for 'n = size(pack(mine,selection))' 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
24 Jul 2020 7:11 #26092

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.

   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

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

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

  mine(:) = pack(mine,selection)
29 Jul 2020 3:15 #26107

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

1 Aug 2020 4:51 #26128

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. 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
1 Aug 2020 4:58 #26129

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.

! 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
1 Aug 2020 6:23 #26131

For instructional purposes, that code for Qsort is fine. However, it is neither stable (in the sense of preserving the order of items with equal sort keys), nor efficient.

It is not stable since items equal to data(1) are placed earlier than data(1), regardless of their prior positions.

It is well-known (as you recognised with your own Qsort code a few months ago) that when the sublists become smaller than a cutoff (about 50 to 100, depending on the size of the data associated with the sort key), one should use insertion sort on the sublists. Furthermore, the heavy reliance on PACK makes the efficiency of the sorting highly dependent on the efficiency of the algorithm used by PACK itself.

The choice of data(1) as the pivot element will cause O(n^2) performance deterioration when the list is already sorted. There are, of course, remedies for this.

Arjen Markus posts regularly on CLF and in the Intel forums, and I am impressed by his willingness to make helpful comments and his prompt responses to questions.

7 Aug 2020 11:24 #26185

The bug reported at the start of this thread has now been fixed for the next release of FTN95.

9 Aug 2020 2:30 #26201

Paul,

Thanks for the fix. What will be the response to 'mine = pack(mine,selection)'? I presume it will not re-allocate mine ? (F03)

The sort example I posted also fails with FTN95. Is that a similar problem ? I don't think there is a requirement for F03+ re-allocate capability in the sort.

9 Aug 2020 7:23 #26202

John

There is no re-allocation. I don't know if it is relevant in this context.

I have not tested other code in this thread. If you want to post it on a new thread then I will test it for you.

10 Aug 2020 12:17 #26205

Paul,

I noticed several problems when attempting to compile simplified versions of John Campbell's quicksort test code. One of these versions causes the compiler to abort with an access violation, as I have reported in a new thread:

https://forums.silverfrost.com/Forum/Topic/3829

I believe that the code in that thread is free of errors.

Please login to reply.