commit
c9c6a2967a
@ -0,0 +1,2 @@
|
|||||||
|
*.mod
|
||||||
|
build/
|
||||||
@ -0,0 +1,28 @@
|
|||||||
|
.PHONY: all
|
||||||
|
all: build/array_copy_ifort build/array_copy_ifx build/array_copy_gfortran build/array_copy_ifort_debug build/array_copy_ifx_debug build/array_copy_gfortran_debug
|
||||||
|
|
||||||
|
.PHONY: mkbuilddir
|
||||||
|
mkbuilddir:
|
||||||
|
@mkdir -p build
|
||||||
|
|
||||||
|
build/array_copy_ifort: array_copy.f90 mkbuilddir
|
||||||
|
ifort -O2 -g -check arg_temp_created $< -o $@
|
||||||
|
|
||||||
|
build/array_copy_ifx: array_copy.f90 mkbuilddir
|
||||||
|
ifx -O2 -g -check arg_temp_created $< -o $@
|
||||||
|
|
||||||
|
build/array_copy_gfortran: array_copy.f90 mkbuilddir
|
||||||
|
gfortran -O2 -g -fcheck-array-temporaries $< -o $@
|
||||||
|
|
||||||
|
build/array_copy_ifort_debug: array_copy.f90 mkbuilddir
|
||||||
|
ifort -g -check arg_temp_created $< -o $@
|
||||||
|
|
||||||
|
build/array_copy_ifx_debug: array_copy.f90 mkbuilddir
|
||||||
|
ifx -g -check arg_temp_created $< -o $@
|
||||||
|
|
||||||
|
build/array_copy_gfortran_debug: array_copy.f90 mkbuilddir
|
||||||
|
gfortran -g -fcheck-array-temporaries $< -o $@
|
||||||
|
|
||||||
|
.PHONY: clean
|
||||||
|
clean:
|
||||||
|
@rm -f build/*
|
||||||
@ -0,0 +1,61 @@
|
|||||||
|
module test_m
|
||||||
|
|
||||||
|
contains
|
||||||
|
|
||||||
|
subroutine sliceAndPrintAddress(s, a)
|
||||||
|
character(len=*), intent(in) :: s
|
||||||
|
complex, dimension(:,:,:,:), intent(in) :: a
|
||||||
|
|
||||||
|
call printAddress(s, a(:,:,:,1))
|
||||||
|
end subroutine sliceAndPrintAddress
|
||||||
|
|
||||||
|
subroutine sliceAndPrintAddress2(s, a)
|
||||||
|
character(len=*), intent(in) :: s
|
||||||
|
complex, dimension(:,:,:,2:), intent(inout) :: a
|
||||||
|
|
||||||
|
do n=2,3
|
||||||
|
a(1,1,1,n) = n
|
||||||
|
call printAddress(s, a(:,:,:,n))
|
||||||
|
end do
|
||||||
|
end subroutine sliceAndPrintAddress2
|
||||||
|
|
||||||
|
subroutine sliceAndPrintAddress3(s, a)
|
||||||
|
character(len=*), intent(in) :: s
|
||||||
|
complex, dimension(:,:,1:,2:), intent(inout) :: a
|
||||||
|
|
||||||
|
do n=2,3
|
||||||
|
a(1,1,1,n) = n
|
||||||
|
call printAddress(s, a(:,:,:,n))
|
||||||
|
end do
|
||||||
|
end subroutine sliceAndPrintAddress3
|
||||||
|
|
||||||
|
subroutine printAddress(s, a)
|
||||||
|
character(len=*), intent(in) :: s
|
||||||
|
complex, dimension(*), intent(in), target :: a
|
||||||
|
|
||||||
|
write(*,"(A,' & 0x',Z0)") s, loc(a)
|
||||||
|
end subroutine printAddress
|
||||||
|
end module test_m
|
||||||
|
|
||||||
|
program test
|
||||||
|
use test_m
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
complex, dimension(:), allocatable, target :: alloc
|
||||||
|
complex, dimension(:), pointer, contiguous :: stor
|
||||||
|
complex, dimension(:,:,:,:), pointer, contiguous :: p
|
||||||
|
|
||||||
|
allocate(alloc(10240))
|
||||||
|
stor => alloc
|
||||||
|
p(0:15,0:15,1:2,1:20) => stor
|
||||||
|
|
||||||
|
call printAddress("p ", p)
|
||||||
|
call printAddress("p slice 1", p(:,:,:,1))
|
||||||
|
call printAddress("p slice 2", p(:,:,:,2))
|
||||||
|
|
||||||
|
call sliceAndPrintAddress("sub p slice ", p)
|
||||||
|
|
||||||
|
call sliceAndPrintAddress2("sub p slice2", p)
|
||||||
|
|
||||||
|
call sliceAndPrintAddress3("sub p slice3", p)
|
||||||
|
end program test
|
||||||
@ -0,0 +1,32 @@
|
|||||||
|
module reg_storage_m
|
||||||
|
type, public :: reg_storage_t
|
||||||
|
integer :: n_elements
|
||||||
|
complex, dimension(:), allocatable :: alloc
|
||||||
|
contains
|
||||||
|
procedure :: malloc
|
||||||
|
procedure :: free
|
||||||
|
procedure :: get_4D_ptr
|
||||||
|
end type reg_storage_t
|
||||||
|
contains
|
||||||
|
subroutine malloc(this, n)
|
||||||
|
class(reg_storage_t) :: this
|
||||||
|
integer, intent(in) :: n
|
||||||
|
|
||||||
|
allocate(this%alloc(n))
|
||||||
|
end subroutine malloc
|
||||||
|
|
||||||
|
subroutine free(this)
|
||||||
|
class(reg_storage_t) :: this
|
||||||
|
deallocate(this%alloc)
|
||||||
|
end subroutine free
|
||||||
|
|
||||||
|
function get_4D_ptr(this, l1, u1, l2, u2, l3, u3, l4, u4)
|
||||||
|
class(reg_storage_t), target :: this
|
||||||
|
integer :: l1, u1, l2, u2, l3, u3, l4, u4
|
||||||
|
complex, dimension(:,:,:,:), pointer, contiguous :: get_4D_ptr
|
||||||
|
|
||||||
|
get_4D_ptr(l1:u1, l2:u2, l3:u3, l4:u4) => this%alloc
|
||||||
|
end function get_4D_ptr
|
||||||
|
end module reg_storage_m
|
||||||
|
|
||||||
|
|
||||||
Loading…
Reference in new issue