Strange result with polymorphic variables
Arjen Markus
arjen.markus895@gmail.com
Mon Aug 29 10:59:00 GMT 2011
Hello,
the program below produces the following unexpected result:
Two-dimensional walk:
0.9951 0.1832
0.9951 0.1794
0.9951 0.0804
0.9951 0.0489
0.9951 -0.0245
0.9951 -0.0471
0.9951 -0.0147
0.9951 0.0154
0.9951 -0.0200
0.9951 -0.0397
Three-dimensional walk:
-0.5517 0.9285 0.1628
-0.6316 0.9795 0.1839
-0.5878 1.0590 0.2156
-0.6576 1.0815 0.3113
-0.5578 1.0328 0.3215
-0.5260 1.0436 0.4170
-0.4456 1.0752 0.4628
-0.4651 1.1609 0.3924
-0.4302 1.2149 0.3602
-0.5070 1.2377 0.4244
In the first part the x-coordinate does not change, whereas it should.
Also I need to deallocate a _local_ variable (the one holding the
result) in the routine add_vector_2d
and scale_by_factor_2d, because otherwise the program complains that
the result variable is
already allocated.
Funny enough, if I compile and build this program with Intel Fortran,
the first part works fine, but
the 3D part does not.
It is quite possible that I am doing something wrong, but at least the
complaint about an already
allocated variable seems a compiler error to me.
Can anyone solve these riddles?
For your information, gfortran -v gives (perhaps this has been solved
already, in that case, I
apologize for the noise):
Built by Equation Solution <http://www.Equation.com>.
Using built-in specs.
COLLECT_GCC=gfortran
COLLECT_LTO_WRAPPER=d:/gcc4.6/bin/../libexec/gcc/i686-pc-mingw32/4.6.0/lto-wrapper.exe
Target: i686-pc-mingw32
Thread model: win32
gcc version 4.6.0 20110101 (experimental) (GCC)
Regards,
Arjen
------------
! random_walk.f90 --
! Simulate a random walk in two and three dimensions
!
module points2d3d
implicit none
type point2d
real :: x, y
contains
procedure :: print => print_2d
procedure :: random_vector => random_vector_2d
procedure :: add_vector => add_vector_2d
procedure, pass(vector) :: scale_by_factor => scale_by_factor_2d
procedure :: assign => assign_2d
generic :: operator(+) => add_vector
generic :: operator(*) => scale_by_factor
generic :: assignment(=) => assign
end type point2d
type, extends(point2d) :: point3d
real :: z
contains
procedure :: print => print_3d
procedure :: random_vector => random_vector_3d
procedure :: add_vector => add_vector_3d
procedure, pass(vector) :: scale_by_factor => scale_by_factor_3d
procedure :: assign => assign_3d
end type point3d
contains
!
! Auxiliary routine to convert from class to point
!
subroutine assign_2d( point1, point2 )
class(point2d), intent(inout) :: point1
class(point2d), intent(in) :: point2
point1%x = point2%x
point1%y = point2%y
end subroutine assign_2d
subroutine assign_3d( point1, point2 )
class(point3d), intent(inout) :: point1
class(point2d), intent(in) :: point2
point1%x = point2%x
point1%y = point2%y
point1%z = 0.0
select type (point2)
class is (point3d)
point1%z = point2%z
end select
end subroutine assign_3d
subroutine print_2d( point )
class(point2d) :: point
write(*,'(2f10.4)') point%x, point%y
end subroutine print_2d
subroutine print_3d( point )
class(point3d) :: point
write(*,'(3f10.4)') point%x, point%y, point%z
end subroutine print_3d
subroutine random_vector_2d( point )
class(point2d) :: point
call random_number( point%x )
call random_number( point%y )
point%x = 2.0 * (point%x - 0.5)
point%y = 2.0 * (point%y - 0.5)
end subroutine random_vector_2d
subroutine random_vector_3d( point )
class(point3d) :: point
call point%point2d%random_vector
call random_number( point%z )
point%z = 2.0 * (point%z - 0.5)
end subroutine random_vector_3d
function add_vector_2d( point, vector )
class(point2d), intent(in) :: point, vector
class(point2d), allocatable :: add_vector_2d
! Workaround for gfortran 4.6
if ( allocated( add_vector_2d ) ) then
deallocate( add_vector_2d )
endif
allocate( add_vector_2d )
add_vector_2d%x = point%x + vector%x
add_vector_2d%y = point%y + vector%y
end function add_vector_2d
function add_vector_3d( point, vector )
class(point3d), intent(in) :: point
class(point2d), intent(in) :: vector
class(point2d), allocatable :: add_vector_3d
class(point3d), allocatable :: add_result
allocate( add_result )
select type (vector)
class is (point3d)
!add_result%point2d = point%point2d + vector%point2d
add_result%point2d = point%point2d%add_vector( vector%point2d )
add_result%z = point%z + vector%z
class default
add_result%point2d = point%point2d + vector
add_result%z = 0.0
end select
call move_alloc( add_result, add_vector_3d )
end function add_vector_3d
function scale_by_factor_2d( factor, vector )
real, intent(in) :: factor
class(point2d), intent(in) :: vector
class(point2d), allocatable :: scale_by_factor_2d
! Workaround for gfortran 4.6
if ( allocated( scale_by_factor_2d ) ) then
deallocate( scale_by_factor_2d )
endif
allocate( scale_by_factor_2d )
scale_by_factor_2d%x = factor * vector%x
scale_by_factor_2d%y = factor * vector%y
end function scale_by_factor_2d
function scale_by_factor_3d( factor, vector )
real, intent(in) :: factor
class(point3d), intent(in) :: vector
class(point2d), allocatable :: scale_by_factor_3d
class(point3d), allocatable :: scale_result
allocate( scale_result )
scale_result%point2d = factor * vector%point2d
scale_result%z = factor * vector%z
call move_alloc( scale_result, scale_by_factor_3d )
end function scale_by_factor_3d
end module points2d3d
program random_walk
use points2d3d ! Both 2D and 3D points available
type(point2d), target :: point_2d
type(point3d), target :: point_3d
type(point2d), target :: vector_2d
type(point3d), target :: vector_3d
!
! A variable of class point2d can point to point_2d but
! also to point_3d
!
class(point2d), pointer :: point
class(point2d), pointer :: vector
integer :: nsteps = 10
integer :: i
integer :: trial
real :: deltt = 0.1
do trial = 1,2
! Select what type of point ...
if ( trial == 1 ) then
point => point_2d
vector => vector_2d
write(*,*) 'Two-dimensional walk:'
else
point => point_3d
vector => vector_3d
write(*,*) 'Three-dimensional walk:'
endif
call point%random_vector
do i = 1,nsteps
call vector%random_vector
point = point + deltt * vector
call point%print
enddo
enddo
end program random_walk
More information about the Fortran
mailing list