gcc/testsuite/gfortran.dg/coarray/collectives_2.f90

   1 ! { dg-do run }
   2 !
   3 ! CO_SUM/CO_MIN/CO_MAX
   4 !
   5 program test
   6   implicit none
   7   intrinsic co_max
   8   intrinsic co_min
   9   intrinsic co_sum
  10   integer :: val(3), tmp_val(3)
  11   integer :: vec(3)
  12   vec = [2,3,1]
  13   if (this_image() == 1) then
  14     val(1) = 42
  15   else
  16     val(1) = -99
  17   endif
  18   val(2) = this_image()
  19   if (this_image() == num_images()) then
  20     val(3) = -55
  21   else
  22     val(3) = 101
  23   endif
  24   tmp_val = val
  25   call test_min
  26   val = tmp_val
  27   call test_max
  28   val = tmp_val
  29   call test_sum
  30 contains
  31   subroutine test_max
  32     integer :: tmp
  33     call co_max (val(::2))
  34     if (num_images() > 1) then
  35       if (any (val /= [42, this_image(), 101])) call abort()
  36     else
  37       if (any (val /= [42, this_image(), -55])) call abort()
  38     endif
  39
  40     val = tmp_val
  41     call co_max (val(:))
  42     if (num_images() > 1) then
  43       if (any (val /= [42, num_images(), 101])) call abort()
  44     else
  45       if (any (val /= [42, num_images(), -55])) call abort()
  46     endif
  47   end subroutine test_max
  48
  49   subroutine test_min
  50     call co_min (val, result_image=num_images())
  51     if (this_image() == num_images()) then
  52       !write(*,*) "Minimal value", val
  53       if (num_images() > 1) then
  54         if (any (val /= [-99, 1, -55])) call abort()
  55       else
  56         if (any (val /= [42, 1, -55])) call abort()
  57       endif
  58     else
  59       if (any (val /= tmp_val)) call abort()
  60     endif
  61   end subroutine test_min
  62
  63   subroutine test_sum
  64     integer :: n
  65     n = 88
  66     call co_sum (val, result_image=1, stat=n)
  67     if (n /= 0) call abort()
  68     if (this_image() == 1) then
  69       n = num_images()
  70       !write(*,*) "The sum is ", val
  71       if (any (val /= [42 + (n-1)*(-99), (n**2 + n)/2, -55+(n-1)*101])) call abort()
  72     else
  73       if (any (val /= tmp_val)) call abort()
  74     end if
  75   end subroutine test_sum
  76 end program test