[J3] [EXTERNAL] Re: Self-assignment of allocatable component

[Vipul Parekh]

On Sat, Jul 31, 2021 at 6:30 PM Clune, Thomas L. (GSFC-6101) <
thomas.l.clune at nasa.gov> wrote:

> Sorry for the noise everyone.    I meant to be responding in a private
> exchange with Damian, but apparently did not read the subject line
> carefully before hitting reply …
>
>
>
>
>
> *From: *J3 <j3-bounces at mailman.j3-fortran.org> on behalf of j3 <
> j3 at mailman.j3-fortran.org>
> *Reply-To: *j3 <j3 at mailman.j3-fortran.org>
> *Date: *Saturday, July 31, 2021 at 5:12 PM
> *To: *j3 <j3 at mailman.j3-fortran.org>, Vipul Parekh <parekhvs at gmail.com>
> *Cc: *"Clune, Thomas L. (GSFC-6101)" <thomas.l.clune at nasa.gov>
> *Subject: *Re: [J3] [EXTERNAL] Re: Self-assignment of allocatable
> component
>
>
>
> Hi Damian,
>
>
>
> I was being silly,  the moment I thought about this issue again during an
> idle moment, I immediately saw how one could do this through the pointer to
> the parent node.  The snippet below shows swapping a depth-2 node on the
> rhs with the depth-1 node on th elhs
>
> TYPE :: node
>
>      TYPE(node), ALLOCATABLE :: rhs, lhs
>
>      INTEGER :: payload
>
> END TYPE node
>
>
>
> TYPE(node), TARGET :: root
>
> TYPE(node), POINTER :: p
>
>
>
> ALLOCATE(root%rhs);  root%rhs = 1
>
> ALLOCATE(root%lhs); root%lhs = 2
>
> ALLOCATE(root%rhs%rhs); root%rhs%rhs=3
>
>
>
> p => root%rhs
>
> *call move_alloc(from=p%rhs, to=t) ! ALLOCATABLE component of target of
> pointer*
>
> call move_alloc(from=root%lhs, to p%rhs)
>
> call move_alloc(from=t, to=root%lhs)
>
>
>
> This works with intel 2021 and gfortran 10.3.   Unfortunately, the latest
> NAG does not support recursive allocatable types, so I probably cannot use
> this approach yet …
>


Hi Tom,

Thanks for the clarification on your note, without the *context* of your
exchange it was proving rather difficult, shall I say impossible even, to
understand your point.

In fact, with respect to the original question by Daniel involving a
variable with a POINTER attribute and the subsequent comment by Damian re:
this feature, your note was further confusing.  Because, as you know, the
example you shared, the one that was meant for a private note to Damian,
ordinarily will *not* involve an intermediate object 'p' with a POINTER
attribute - see below.

Nonetheless, the increasing use of tree-like recursive data structures in
many an application, especially in our "neck of the woods" in industry
with burgeoning amounts of large data sets thanks to decades of powerful
computerization and years of storage becoming less and less expensive, also
leads to 'swap' of branches in the manner you indicate.  Thus your example
looks not only a good one as part of the *use cases* for generics but also
for a new intrinsic procedure itself, say 'SWAP' (c.f. std::swap in C++
https://en.cppreference.com/w/cpp/algorithm/swap):

module node_m
   type :: node_t
      type(node_t), allocatable :: right, left
      integer :: payload = 0
   end type node_t
contains
   subroutine swap( lhs, rhs )
      type(node_t), allocatable, intent(inout) :: lhs
      type(node_t), allocatable, intent(inout) :: rhs
      type(node_t), allocatable :: tmp
      call move_alloc( from=rhs, to=tmp )
      call move_alloc( from=lhs, to=rhs )
      call move_alloc( from=tmp, to=lhs )
   end subroutine
end module
   use node_m

   type(node_t) :: root

   allocate(root%right) ; root%right%payload = 1
   allocate(root%left ); root%left%payload = 2
   allocate(root%right%right) ; root%right%right%payload = 3

   print *, "Before the swap:"
   print *, "root%right%payload = ", root%right%payload, "; expected is 1"
   print *, "root%right%right%payload = ", root%right%right%payload, ";
expected is 3"
   print *, "root%left%payload = ", root%left%payload, "; expected is 2"

   ! Swap node on right at depth 2 with the one on the left at depth 1
   call swap( lhs=root%left, rhs=root%right%right )

   print *, "Following the swap:"
   print *, "root%right%payload = ", root%right%payload, "; expected is 1"
   print *, "root%right%right%payload = ", root%right%right%payload, ";
expected is 2"
   print *, "root%left%payload = ", root%left%payload, "; expected is 3"

end

The output is the same with 2 processors as follows:
 Before the swap:
 root%right%payload =            1 ; expected is 1
 root%right%right%payload =            3 ; expected is 3
 root%left%payload =            2 ; expected is 2
 Following the swap:
 root%right%payload =            1 ; expected is 1
 root%right%right%payload =            2 ; expected is 2
 root%left%payload =            3 ; expected is 3

Regards,
Vipul Parekh

>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <https://mailman.j3-fortran.org/pipermail/j3/attachments/20210731/40d6fe77/attachment.htm>