program deepvsshallow type :: myvec integer :: length, max_len real, kind(0d0), pointer :: array(:) end type myvec end program deepvsshallow subroutine resize(x,new_len) type(myvec), intent(inout) :: x integer, intent(in) :: new_len real, kind(0d0), pointer :: new_ptr integer :: i if ( new_len <= 0 ) then return end if if ( new_len > x%max_len ) then ! allocate new memory allocate(new_ptr(new_len)) ! copy old data do i = 1, x%length new_ptr(i) = x%array(i) end do ! deallocate old memory deallocate(x%array) ! and update x with new info x%array => new_ptr x%max_len = new_len x%length = new_len else ! we already have enough memory ! set extra entries to zero do i = x%length+1, new_len x%array(i) = 0.0d0 end do ! and update x with new info x%length = new_len end if end subroutine resize subroutine shallowcopy(x,y) type(myvec), intent(in) :: x type(myvec), intent(inout) :: y y%array => x%array y%length = x%length y%max_len = x%max_len end subroutine shallowcopy subroutine deepcopy(x,y) type(myvec), intent(in) :: x type(myvec), intent(inout) :: y integer :: i if ( allocated(y%array) ) then deallocate(y%array) end if allocate(y%array(x%length)) y%length = x%length y%max_len = y%length do i = 1, x%length y%array(i) = x%arra(i) end do end subroutine deepcopy