Paul
I have had a look at the example kindly supplied by Mike and added a few
enhancements to that you can assign a vector or a scalar to the derived
type. If you add enough code you can make it behave like a native part of
the language!
Good luck.
Alistair
Here is my re-work of Mike's code:
module d
IMPLICIT NONE
! Define pointer_vector type
TYPE pointer_vector
INTEGER, POINTER, DIMENSION(:) :: vect
END TYPE pointer_vector
interface assignment(=)
module procedure ass, ass1, ass2
end interface
contains
subroutine ass(a1, a2)
type(pointer_vector), intent(out) :: a1
type(pointer_vector), intent(in) :: a2
a1%vect = a2%vect
end subroutine ass
subroutine ass1(a1, a2)
type(pointer_vector), intent(out) :: a1
integer, dimension(:), intent(in) :: a2
a1%vect = a2
end subroutine ass1
subroutine ass2(a1, a2)
type(pointer_vector), intent(out) :: a1
integer, intent(in) :: a2
a1%vect = a2
end subroutine ass2
end module d
PROGRAM test_pointer_vector_prog
use d
IMPLICIT NONE
INTEGER, DIMENSION(8), TARGET :: target_array
TYPE(pointer_vector) :: p_vect1
TYPE(pointer_vector) :: p_vect2
integer :: i
! Initialise the target
target_array=(/ (i*10, i=1, size(target_array)) /)
! p_vect1%vect points to a section of target array
p_vect1%vect => target_array(2:size(target_array)-1)
! Allocate p_vect2%vect so that it is the same size as p_vect1%vect
ALLOCATE(p_vect2%vect(SIZE(p_vect1%vect)))
! Set p_vect2%vect
p_vect2%vect(:) = (/ (i, i=1, size(p_vect2%vect)) /)
p_vect2 = (/ (i, i=1, size(p_vect2%vect)) /)
! Then, do either statement A:
! p_vect1%vect=p_vect2%vect
! ...or statement B:
p_vect1=p_vect2
!
! or with some more definitions, you can do other interesting things like
!
p_vect1 = (/ (i, i=1, size(p_vect1%vect)) /) ! assign a vector to the
derived type
PRINT 100, 'p_vect1%vect:',p_vect1%vect
p_vect1 = 66 ! assign a scalar to the derived type
PRINT 100, 'p_vect1%vect:',p_vect1%vect
! Check what has happened to the target array
PRINT 100, 'target_array:........',target_array
100 format(a, t25, 50I5)
END PROGRAM test_pointer_vector_prog
-----Original Message-----
From: Fortran 90 List [mailto:[log in to unmask]] On Behalf Of
Michael Metcalf
Sent: 31 March 2003 19:21
To: [log in to unmask]
Subject: Re: Derived types and pointers
>
> Could someone explain why there is a difference in the effect on the
target of
> statements A and B please? I expected that equating the derived types
> in statement B would involve equating the components of the derived
> types,
and
> hence be equivalent to statement A, but it must be more subtle than
> that.
It is. Statement B is a copy between 2 objects of the same derived data
type. The rule is that non-pointer components have their values copied from
the RHS to the LHS, whereas, as here, pointer components undergo a pointer
assignment: whatever the RHS is pointing at is now pointed at also by the
LHS (see also "Fortran 90/95 Explained", Section 3.12).
>
> Also, is it possible to write an INTERFACE ASSIGNMENT(=) operator for
> the pointer_vector type that equates the components as statement A
> does, so
that
> statement B has the same effect as A on the target?
Yes. Attached below. It replaces the implicit pointer assignment by an
ordinary assignment.
Hope that helps,
Mike Metcalf
module d
IMPLICIT NONE
! Define pointer_vector type
TYPE pointer_vector
INTEGER, POINTER, DIMENSION(:) :: vect
END TYPE pointer_vector
interface assignment(=)
module procedure ass
end interface
contains
subroutine ass(a1, a2)
type(pointer_vector), intent(out) :: a1
type(pointer_vector), intent(in) :: a2
a1%vect = a2%vect
end subroutine ass
end module d
PROGRAM test_pointer_vector_prog
use d
IMPLICIT NONE
INTEGER, DIMENSION(5), TARGET :: target_array
TYPE(pointer_vector) :: p_vect1
TYPE(pointer_vector) :: p_vect2
! Initialise the target
target_array=0
! p_vect1%vect points to a section of target array
p_vect1%vect => target_array(2:4)
! Allocate p_vect2%vect so that it is the same size as p_vect1%vect
ALLOCATE(p_vect2%vect(SIZE(p_vect1%vect)))
! Set p_vect2%vect
p_vect2%vect=1
! Then, do either statement A:
!p_vect1%vect=p_vect2%vect
! ...or statement B:
p_vect1=p_vect2
! Check what has happened to p_vect1%vect
PRINT '(A,5I2)',' p_vect%vect: ',p_vect1%vect
! Check what has happened to the target array
PRINT '(A,5I2)','target_array: ',target_array
END PROGRAM test_pointer_vector_prog
|