OpenMP reduction for derived-type variable.

[oleglebedev]

Good day,

I have coded a simple test:

[fxfortran]MODULE foo_module
    IMPLICIT NONE
!
!
    PRIVATE
!
type, public :: foo
  integer :: xx
    CONTAINS
      procedure :: set => set_sub
      procedure :: bar => bar_fn
      generic :: operator(+) => foo_plus_foo
      procedure, private :: foo_plus_foo => foo_plus_foo_fn
end type foo
!

    CONTAINS
!

ELEMENTAL subroutine set_sub(this, xx)
    implicit none
    class(foo), intent(INOUT) :: this
    integer, intent(IN) :: xx
this%xx = xx
return
end subroutine set_sub
!
!
ELEMENTAL integer function bar_fn(this) RESULT(res)
    implicit none
    class(foo), intent(IN) :: this
res = this%xx * this%xx
return
end function bar_fn
!
!
ELEMENTAL type(foo) function foo_plus_foo_fn(f1, f2) RESULT(res)
    implicit none
    class(foo), intent(IN) :: f1, f2
res%xx = f1%xx + f2%xx
return
end function foo_plus_foo_fn
!
!
END MODULE foo_module


PROGRAM main
    USE foo_module
    IMPLICIT NONE
    type(foo) :: f, f_sum
    integer :: i, y

!$OMP parallel
!$OMP single
  call f_sum%set(0)
!$OMP end single

!$OMP do PRIVATE(i,f,y) ! REDUCTION(+:f_sum)
  do i = 1, 10
    call f%set(i)
    y = f%bar()
    write( *, * ) i, y
    call f%set(y)
    f_sum = f_sum + f
  end do
!$OMP end do

!$OMP single
  write( *, * ) 'f_sum is ', f_sum%xx
!$OMP end single

!$OMP end parallel

y = 0
do i = 1, 10
  y = y + i**2
end do
write( *, * ) 'y', y ! 

END PROGRAM main
[/fxfortran]

Is it correct example? In this case each threads get private i,f,y variables and work with them copies.

Should I specify a REDUCTION directive in a OMP-pragma?

Best regards, Oleg.

[oleglebedev]

I think a bit about it.

This is a model code that reproduces a piece of my prject code. This realization is closer to my project than first one.

[fortran]MODULE foo_module
    IMPLICIT NONE
!
!
    PRIVATE
!
type, public :: foo
  double precision :: xx
    CONTAINS
      procedure :: init => init_sub
      generic :: operator(+) => foo_plus_foo_fn
      procedure, private :: foo_plus_foo_fn
end type foo

!
    CONTAINS
!
subroutine init_sub(this, xx)
    implicit none
    class(foo), intent(INOUT) :: this
    double precision, intent(IN) :: xx
this%xx = xx
return
end subroutine init_sub
!
!
ELEMENTAL type(foo) function foo_plus_foo_fn(f1, f2) RESULT(res)
    implicit none
    class(foo), intent(IN) :: f1, f2
res%xx = f1%xx + f2%xx
return
end function foo_plus_foo_fn
!
!
END MODULE foo_module


PROGRAM main
    USE foo_module
    IMPLICIT NONE
    type(foo) :: f, f_sum
    double precision :: y = 0.
    integer :: i

!$OMP parallel

!$OMP do PRIVATE(i,f) REDUCTION(+:y)
  do i = 1, 5
    call f%init(dble(i))
    y = y + f%xx
    f_sum = f_sum + f ! I would like to implement this behaviour.
  end do
!$OMP end do

!$OMP single
  write( *, '( :, 1X, 3(1X, A, f17.10) )' ) 'f_sum is ', f_sum%xx, 'y_sum is ', y, 'abs', abs(y-f_sum%xx)
!$OMP end single

!$OMP end parallel

END PROGRAM main[/fortran]

Does anybody have any idea how to sum a derived-type variable?

Best, Oleg.

[jimdempseyatthecove]

type(foo) :: f, f_sum, f_sumLocal
...
call f_sum%init(0.0D0)
!$omp parallel private(i, f, f_sumLocal)
call f_sumLocal%init(0.0D0)
$omp do...
...
f_sumLocal = f_sumLocal + f
end do
!$omp end do
!$omp critical(critical_for_f_sum)
f_sum = f_sum + f_sumLocal
!$omp end critical(critical_for_f_sum)
!$omp end parallel

Jim Dempsey

[jimdempseyatthecove]

Or you could add a type member function called... reduce that contains the critical section with the +.

...
!$omp end do
f_sum%reduce(f_sumLocal)
!$omp end parallel

Jim Dempsey