forked from lcompilers/lpython
-
Notifications
You must be signed in to change notification settings - Fork 0
/
coarrays_01.f90
71 lines (63 loc) · 1.63 KB
/
coarrays_01.f90
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
program coarrays_01
! This test should test most of coarray syntax:
! * declarations
! * allocations
! * coarray operations
!
! You can test the syntax manually with GFortran by:
! gfortran -fcoarray=lib -c coarrays_01.f90 -o a.o
!
use iso_fortran_env, only : event_type
implicit none
! Coarray Declarations
real, dimension(100), codimension[*] :: A
integer :: B[3,*]
integer :: c[*]
real :: D(100,2)[3,*]
real :: E(1,2,3)[1,2,-1:3,*]
real, allocatable :: F(:)[:]
real, allocatable :: g(:,:,:)[:,:,:]
real, dimension(20), codimension[20,*] :: h
real, codimension[:], allocatable :: z(:,:)
character :: r(20)[20,0:*]
type(event_type) :: ok_to_overwrite[*]
type(event_type), allocatable :: greeting_ready(:)[:]
integer :: i, n
! Allocation
n = 5
allocate(F(n)[*])
allocate(greeting_ready(num_images())[*])
allocate(g(50,50,50)[1:2, 1:2, *])
! Array access, events, teams
if (this_image() == 1) then
do i= 2,num_images()
c = c + c[i]
event post(ok_to_overwrite[i])
end do
else
event wait(ok_to_overwrite)
event post(greeting_ready(this_image())[1])
end if
syncall
syncall()
sync all(stat=status)
sync all(errmsg=status)
event wait(variable, until_count=status)
event wait(variable, until_count=status, errmsg=status)
event wait(variable, errmsg=status)
event wait(variable, stat=status)
event post (done (sub (i)) [parent (i)], stat=status)
event post(variable, stat=status)
event post(variable, errmsg=status)
s%a(3)(4) = 'S'
s%b[3] = c[4]
s%c(3)[4] = f(3)[4]
c[3] = c[4]
B[1,2] = B[3,4]
D(99,1)[3,4] = D(1,2)[1,2]
D(99,1)[3,3] = 5
D(:,1)[3,3] = 5
D(:,1)[3,3,team=3] = 5
D(:,1)[3,3,team=3,stat=i] = 5
D(:,1)[3,3,stat=i] = 5
end program