Print

---

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