1
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#include "fc_feature_defs.inc"
47PROGRAM test_xmap_all2all_fail
48 USE iso_c_binding, ONLY: c_int
49 USE mpi
50 USE ftest_common, ONLY: init_mpi, finish_mpi, test_abort
51 USE test_idxlist_utils, ONLY: test_err_count
54 USE test_xmap_common, ONLY : test_self_xmap_construct
55 IMPLICIT NONE
56 INTERFACE
57 FUNCTION xmap_new_fail3(src_idxlist, dst_idxlist, comm) RESULT(xmap)
58#if __INTEL_COMPILER == 1500
60#else
62#endif
63 TYPE(xt_xmap) :: xmap
64 TYPE(xt_idxlist), INTENT(in) :: src_idxlist, dst_idxlist
65 INTEGER, INTENT(in) :: comm
66 END FUNCTION xmap_new_fail3
67 END INTERFACE
68 INTEGER, PARAMETER :: xi = xt_int_kind
69 CHARACTER(len=*), PARAMETER :: filename = 'test_xmap_all2all_fail_f.f90'
70 INTEGER :: my_rank, ierror, list_size
71 CALL init_mpi
73 CALL mpi_comm_rank(mpi_comm_world, my_rank, ierror)
74 CALL parse_options
75 CALL test_xmap1(list_size, mpi_comm_world)
76
77 IF (test_err_count() /= 0) &
78 CALL test_abort("non-zero error count!", filename, __line__)
80 CALL finish_mpi
81CONTAINS
82 SUBROUTINE test_xmap1(num_idx, comm)
83 INTEGER, INTENT(in) :: num_idx, comm
84 TYPE(xt_stripe) :: src_stripe(1), dst_stripe(1)
85
86
87 src_stripe(1)%nstrides = int(num_idx, c_int)
88 src_stripe(1)%start = 1_xi + int(my_rank, xi) * int(num_idx, xi)
89 src_stripe(1)%stride = 1_xi
90
91
92 dst_stripe(1)%nstrides = int(num_idx, c_int)
93 dst_stripe(1)%start = src_stripe(1)%start + src_stripe(1)%nstrides
94 dst_stripe(1)%stride = -1_xi
95
96 CALL test_self_xmap_construct(src_stripe, dst_stripe,&
97 & xmap_new_fail3, comm)
98 END SUBROUTINE test_xmap1
99
100 SUBROUTINE parse_options
101 INTEGER :: i, num_cmd_args, arg_len
102 INTEGER, PARAMETER :: max_opt_arg_len = 80
103 CHARACTER(max_opt_arg_len) :: optarg
104 num_cmd_args = command_argument_count()
105 i = 1
106 DO WHILE (i < num_cmd_args)
107 CALL get_command_argument(i, optarg, arg_len)
108 IF (optarg(1:2) == '-s' .AND. i < num_cmd_args .AND. arg_len == 2) THEN
109 CALL get_command_argument(i + 1, optarg, arg_len)
110 IF (arg_len > max_opt_arg_len) &
111 CALL test_abort('incorrect argument to command-line option -s', &
112 filename, __line__)
113 IF (optarg(1:arg_len) == "big") THEN
114 list_size = 1023
115 ELSE IF (optarg(1:arg_len) == "small") THEN
116 list_size = 7
117 ELSE
118 WRITE (0, *) 'arg to -s: ', optarg(1:arg_len)
119 CALL test_abort('incorrect argument to command-line option -s', &
120 filename, __line__)
121 END IF
122 i = i + 2
123 ELSE
124 WRITE (0, *) 'unexpected command-line argument parsing error: ', &
125 optarg(1:arg_len)
126 FLUSH(0)
127 CALL test_abort('unexpected command-line argument', &
128 filename, __line__)
129 END IF
130 END DO
131 END SUBROUTINE parse_options
132
133END PROGRAM test_xmap_all2all_fail
134
135SUBROUTINE xfail_abort(comm, msg, source, line)
136 USE iso_c_binding, ONLY: c_int
137 USE mpi
138 USE ftest_common, ONLY: posix_exit
139 INTEGER, INTENT(in) :: comm, line
140 CHARACTER(len=*), INTENT(in) :: msg, source
141 INTEGER :: ierror
142#ifdef XT_NEED_MPI_ABORT_WORK_AROUND
143 INTEGER :: abort_msg_lun
144#endif
145 WRITE (0, '(4a,i0)') msg, ' at ', source, ', line ', line
146
147#ifdef XT_NEED_MPI_ABORT_WORK_AROUND
148# if XT_NEED_MPI_ABORT_WORK_AROUND == 1
149 abort_msg_lun = 0
150# elif XT_NEED_MPI_ABORT_WORK_AROUND == 2
151 FLUSH(0)
152 abort_msg_lun = 10
153 OPEN(unit=abort_msg_lun, status='replace', &
154 file='test_xmap_all2all_fail.result.txt', &
155 action='write', iostat=ierror)
156# endif
157 WRITE (abort_msg_lun, '(a)') 'MPI_Abort(0xdeadbeef, 3)'
158 FLUSH(abort_msg_lun)
159#endif
160
161 CALL mpi_abort(comm, 3, ierror)
162 CALL posix_exit(3_c_int)
163END SUBROUTINE xfail_abort
164
165FUNCTION xmap_new_fail3(src_idxlist, dst_idxlist, comm) RESULT(xmap)
167 xt_set_abort_handler, xt_restore_default_abort_hndl
168 TYPE(xt_xmap) :: xmap
169 TYPE(xt_idxlist), INTENT(in) :: src_idxlist, dst_idxlist
170 INTEGER, INTENT(in) :: comm
171 INTERFACE
172 SUBROUTINE xfail_abort(comm, msg, source, line)
173 INTEGER, INTENT(in) :: comm, line
174 CHARACTER(len=*), INTENT(in) :: msg, source
175 END SUBROUTINE xfail_abort
176 END INTERFACE
177 CALL xt_set_abort_handler(xfail_abort)
179 CALL xt_restore_default_abort_hndl
180END FUNCTION xmap_new_fail3
181
182
183
184
185
186
187
188
189
190
void xt_initialize(MPI_Comm default_comm)
Xt_xmap xt_xmap_all2all_new(Xt_idxlist src_idxlist, Xt_idxlist dst_idxlist, MPI_Comm comm)