49 use,
INTRINSIC :: iso_c_binding, only: c_char, c_null_char, c_int, &
50 c_long, c_short, c_long_long
55 INTEGER,
PUBLIC,
PARAMETER ::
pi2 = 4
56 INTEGER,
PUBLIC,
PARAMETER ::
pi4 = 9
57 INTEGER,
PUBLIC,
PARAMETER ::
pi8 = 14
58 INTEGER,
PUBLIC,
PARAMETER ::
i2 = selected_int_kind(
pi2)
59 INTEGER,
PUBLIC,
PARAMETER ::
i4 = selected_int_kind(
pi4)
60 INTEGER,
PUBLIC,
PARAMETER ::
i8 = selected_int_kind(
pi8)
64 PUBLIC ::
OPERATOR(==),
OPERATOR(/=)
68 INTEGER(xt_int_kind),
PARAMETER :: dummy = 0_xt_int_kind
72 = ceiling(1.0 + real(digits(dummy)) * log10(real(radix(dummy))))
73 CHARACTER(9),
PARAMETER :: xt_stripe_tag =
'xt_stripe'
78 TYPE,
BIND(C),
PUBLIC :: xt_stripe
79 INTEGER(xt_int_kind) :: start
80 INTEGER(xt_int_kind) :: stride
81 INTEGER(c_int) :: nstrides
84 TYPE,
BIND(C),
PUBLIC :: xt_bounds
85 INTEGER(xt_int_kind) :: start, size
91 TYPE,
BIND(c),
PUBLIC :: xt_pos_ext
92 INTEGER(c_int) :: start, size
98 bind(c, name=
'xt_get_default_comm_f')
99 IMPORT :: xt_mpi_fint_kind
101 INTEGER(xt_mpi_fint_kind) :: comm
104 SUBROUTINE xt_initialize(default_comm) bind(C, name='xt_initialize_f')
105 import:: c_int, xt_mpi_fint_kind
107 INTEGER(xt_mpi_fint_kind),
INTENT(in) :: default_comm
110 SUBROUTINE xt_finalize() bind(C, name='xt_finalize')
113 SUBROUTINE xt_restore_default_abort_hndl
114 END SUBROUTINE xt_restore_default_abort_hndl
119 MODULE PROCEDURE xt_abort4
120 MODULE PROCEDURE xt_abort3
121 END INTERFACE xt_abort
124 SUBROUTINE xt_abort_c(comm, msg, source, line) bind(c, name='xt_abort_f')
125 IMPORT :: c_char, c_int, xt_mpi_fint_kind
127 INTEGER(xt_mpi_fint_kind),
VALUE,
INTENT(in):: comm
128 CHARACTER(kind=c_char),
DIMENSION(*),
INTENT(in) :: msg
129 CHARACTER(kind=c_char),
DIMENSION(*),
INTENT(in) :: source
130 INTEGER(xt_mpi_fint_kind),
VALUE,
INTENT(in) :: line
131 END SUBROUTINE xt_abort_c
135 MODULE PROCEDURE xt_stripe2char
138 INTERFACE OPERATOR(==)
139 MODULE PROCEDURE xt_pos_ext_eq
140 END INTERFACE OPERATOR(==)
142 INTERFACE OPERATOR(/=)
143 MODULE PROCEDURE xt_pos_ext_ne
144 END INTERFACE OPERATOR(/=)
152 SUBROUTINE xt_abort4(comm, msg, source, line)
153 INTEGER,
INTENT(in) :: comm
154 CHARACTER(len=*),
INTENT(in) :: msg
155 CHARACTER(len=*),
INTENT(in) :: source
156 INTEGER,
INTENT(in) :: line
157 CALL xt_abort_c(comm, trim(msg)//c_null_char, &
158 trim(source)//c_null_char, int(line, c_int))
159 END SUBROUTINE xt_abort4
161 SUBROUTINE xt_abort3(msg, source, line)
162 CHARACTER(len=*),
INTENT(in) :: msg
163 CHARACTER(len=*),
INTENT(in) :: source
164 INTEGER,
INTENT(in) :: line
166 trim(source)//c_null_char, int(line, c_int))
167 END SUBROUTINE xt_abort3
169 ELEMENTAL FUNCTION xt_stripe2char(stripe)
RESULT(str)
170 CHARACTER(len=xt_stripe2s_len) :: str
172 WRITE (str,
'(2a,3(i0,a))') xt_stripe_tag,
'(', stripe%start,
', ', &
173 stripe%stride,
', ', stripe%nstrides,
')'
174 END FUNCTION xt_stripe2char
177 LOGICAL :: is_initialized
179 FUNCTION xt_initialized_c() bind(c, name='xt_initialized') &
180 result(is_initialized)
182 INTEGER(c_int) :: is_initialized
183 END FUNCTION xt_initialized_c
185 is_initialized = xt_initialized_c() /= 0
189 LOGICAL :: is_finalized
191 FUNCTION xt_finalized_c() bind(c, name='xt_finalized') &
194 INTEGER(c_int) :: is_finalized
195 END FUNCTION xt_finalized_c
197 is_finalized = xt_finalized_c() /= 0
200 ELEMENTAL FUNCTION xt_pos_ext_eq(a, b)
RESULT(p)
203 p = a%start == b%start .AND. (a%size == b%size &
204 .OR. (abs(a%size) == 1 .AND. abs(a%size) == abs(b%size)))
205 END FUNCTION xt_pos_ext_eq
207 ELEMENTAL FUNCTION xt_pos_ext_ne(a, b)
RESULT(p)
210 p = a%start /= b%start .OR. (a%size /= b%size &
211 .AND. .NOT. (abs(a%size) == 1 .AND. abs(a%size) == abs(b%size)))
212 END FUNCTION xt_pos_ext_ne
217 SUBROUTINE f(comm, msg, source, line)
218 INTEGER,
INTENT(in) :: comm, line
219 CHARACTER(len=*),
INTENT(in) :: msg, source
221 SUBROUTINE xt_set_abort_handler(f)
223 SUBROUTINE f(comm, msg, source, line)
224 INTEGER,
INTENT(in) :: comm, line
225 CHARACTER(len=*),
INTENT(in) :: msg, source
228 END SUBROUTINE xt_set_abort_handler
230 CALL xt_set_abort_handler(f)
integer, parameter, public xt_stripe2s_len
maximal length of string xt_stripe(a, b, c)
subroutine, public set_abort_handler(f)
set routine f to use as abort function which is called on xt_abort
integer, parameter, public i8
integer, parameter, public xt_int_kind
integer, parameter, public xt_int_mpidt
integer, parameter, public i4
integer, parameter, public pi4
integer, parameter, public xt_int_dec_len
number of decimal places needed to print any variable of type INTEGER(xt_int_kind)
external, public xt_slice_c_loc
integer, parameter, public i2
integer, parameter, public pi2
integer, parameter, public pi8
integer, parameter xt_mpi_fint_kind
describes range of positions starting with start up to start + size - 1 i.e. [start,...
void xt_initialize(MPI_Comm default_comm)