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