program main use omp_lib use ISO_C_Binding implicit none (external, type) type (omp_alloctrait) :: traits(3) integer (omp_allocator_handle_kind) :: a traits = [omp_alloctrait (omp_atk_alignment, 64), & omp_alloctrait (omp_atk_fallback, omp_atv_null_fb), & omp_alloctrait (omp_atk_pool_size, 4096)] a = omp_init_allocator (omp_default_mem_space, 3, traits) if (a == omp_null_allocator) stop 1 !$omp parallel num_threads(4) block integer :: n real(8) :: r type(c_ptr) :: cp, cq real(8), pointer, volatile :: p(:), q(:) n = omp_get_thread_num () if (mod (n, 2) /= 0) then call omp_set_default_allocator (a) else call omp_set_default_allocator (omp_default_mem_alloc) endif cp = omp_alloc (1696_c_size_t, omp_null_allocator) if (.not. c_associated (cp)) stop 2 call c_f_pointer (cp, p, [1696 / c_sizeof (r)]) p(1) = 1.0 p(1696 / c_sizeof (r)) = 2.0 !$omp barrier if (mod (n, 2) /= 0) then call omp_set_default_allocator (omp_default_mem_alloc) else call omp_set_default_allocator (a) endif cq = omp_alloc (1696_c_size_t, omp_null_allocator) if (mod (n, 2) /= 0) then if (.not. c_associated (cq)) stop 3 call c_f_pointer (cq, q, [1696 / c_sizeof (r)]) q(1) = 3.0 q(1696 / c_sizeof (r)) = 4.0 else if (c_associated (cq)) then stop 4 end if !$omp barrier call omp_free (cp, omp_null_allocator) call omp_free (cq, omp_null_allocator) call omp_set_default_allocator (omp_default_mem_alloc) end block !$omp end parallel call omp_destroy_allocator (a) end program main