elementcopy Interface

elementcopy(3f) - [M_LA] copy elements from IN to OUT regardless
of rank until hit end of one of them

 Subroutine elementcopy (IN, OUT)

  ${TYPE} (kind=${KIND}), Intent (In) :: IN(..)
  ${TYPE} (kind=${KIND})              :: OUT(..)

Where ${TYPE}(kind=${KIND}) may be

   o Real(kind=real32)
   o Real(kind=real64)
   o Real(kind=real128)
   o Integer(kind=int8)
   o Integer(kind=int16)
   o Integer(kind=int32)
   o Integer(kind=int64)

Copy the elements from scalar or array IN to array or scalar OUT
until either the end of IN or OUT is reached, regardless of rank
of the arguments.

 IN          input array or scalar
 OUT         output array or scalar

program demo_elementcopy
use m_la, only : elementcopy
implicit none
character(len=*),parameter :: g='(*(g0:,","))'
real :: b, b1(3), b2(2,3), b3(2,2,2)
real :: c8(8), c6(6), c3(3), c
integer :: ib, ib1(3), ib2(2,3), ib3(2,2,2)
integer :: ic8(8), ic6(6), ic3(3), ic
   ! default real
   call elementcopy(100.0,b)
   write(*,g)'b',b
   call elementcopy([1.0,2.0,3.0],b1)
   write(*,g)'b1',b1
   call elementcopy(reshape([1.0,2.0,3.0,4.0,5.0,6.0],[2,3]),b2)
   write(*,g)'b2',b2
   call elementcopy(reshape([1.0,2.0,3.0,4.0,5.0,6.0,7.0,8.0],[2,2,2]),b3)
   write(*,g)'b3',b3
   call elementcopy(b3,c8) ! pack
   write(*,g)'c8',c8
   call elementcopy(b3*10,c3) ! smaller
   write(*,g)'c3',c3
   call elementcopy(pack(b3*111.0,.true.),b) ! to scalar
   write(*,g)'b',b
   c6=-999.0
   call elementcopy(b1*10,c6) ! bigger
   write(*,g)'c6',c6
   call elementcopy(b3(2:,2,2),c) !  to scalar from vector
   write(*,g)'c',c
   call elementcopy(b3(2,1,1),c) !  to scalar from element
   write(*,g)'c',c
   call elementcopy(b3,c) !  to scalar
   write(*,g)'c',c
   ! default integer
   call elementcopy(100,ib)
   write(*,g)'ib',ib
   call elementcopy([1,2,3],ib1)
   write(*,g)'ib1',ib1
   call elementcopy(reshape([1,2,3,4,5,6],[2,3]),ib2)
   write(*,g)'ib2',ib2
   call elementcopy(reshape([1,2,3,4,5,6,7,8],[2,2,2]),ib3)
   write(*,g)'ib3',ib3
   call elementcopy(ib3,ic8) ! pack
   write(*,g)'ic8',ic8
   call elementcopy(ib3*10,ic3) ! smaller
   write(*,g)'ic3',ic3
   call elementcopy(pack(ib3*111,.true.),ib) ! to scalar
   write(*,g)'ib',ib
   ic6=-999
   call elementcopy(ib1*10,ic6) ! bigger
   write(*,g)'ic6',ic6
   call elementcopy(ib3(2:,2,2),ic) !  to scalar from vector
   write(*,g)'ic',ic
   call elementcopy(ib3(2,1,1),ic) !  to scalar from element
   write(*,g)'ic',ic
   call elementcopy(ib3,ic) !  to scalar
   write(*,g)'ic',ic
   !
   tesseract: block
   integer :: box(2,3,4,5)
   integer :: i
      call elementcopy([(i,i=1,size(box))],box)
      write(*,g)'box',box
   endblock tesseract
end program demo_elementcopy

b,100.0000
b1,1.00000,2.00000,3.00000
b2,1.00000,2.00000,3.00000,4.00000,5.00000,6.00000
b3,1.00000,2.00000,3.00000,4.00000,5.00000,6.00000,7.00000,8.00000
c8,1.00000,2.00000,3.00000,4.00000,5.00000,6.00000,7.00000,8.00000
c3,10.0000,20.0000,30.0000
b,111.0000
c6,10.00000,20.00000,30.00000,-999.0000,-999.0000,-999.0000
c,8.000000
c,2.000000
c,1.000000
ib,100
ib1,1,2,3
ib2,1,2,3,4,5,6
ib3,1,2,3,4,5,6,7,8
ic8,1,2,3,4,5,6,7,8
ic3,10,20,30
ib,111
ic6,10,20,30,-999,-999,-999
ic,8
ic,2
ic,1
box,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,
19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,
36,37,38,39,40,41,42,43,44,45,46,47,48,49,50,51,52,
53,54,55,56,57,58,59,60,61,62,63,64,65,66,67,68,69,
70,71,72,73,74,75,76,77,78,79,80,81,82,83,84,85,86,
87,88,89,90,91,92,93,94,95,96,97,98,99,100,101,102,
103,104,105,106,107,108,109,110,111,112,113,114,115,116,
117,118,119,120

John S. Urban, 2022.05.07

CC0-1.0