feat(intrinsic_array_m): add 2D array support

Author: Damian Rouson

src/intrinsic_array_m.f90 src/intrinsic_array_m.F90src/intrinsic_array_m.f90 renamed to src/intrinsic_array_m.F90

@@ -7,10 +7,15 @@ module intrinsic_array_m
   public :: intrinsic_array_t
 
   type, extends(characterizable_t) :: intrinsic_array_t
-    complex, allocatable :: c(:)
-    integer, allocatable :: i(:)
-    logical, allocatable :: l(:)
-    real, allocatable :: r(:)
+    complex, allocatable :: complex_1D(:)
+    integer, allocatable :: integer_1D(:)
+    logical, allocatable :: logical_1D(:)
+    real,    allocatable :: real_1D(:)
+
+    complex, allocatable :: complex_2D(:,:)
+    integer, allocatable :: integer_2D(:,:)
+    logical, allocatable :: logical_2D(:,:)
+    real,    allocatable :: real_2D(:,:)
   contains
     procedure :: as_character
   end type

src/intrinsic_array_s.F90

@@ -0,0 +1,82 @@
+submodule(intrinsic_array_m) intrinsic_array_s
+  implicit none
+
+contains
+
+  module procedure construct
+
+#ifndef NAGFOR
+    select rank(array)
+    rank(1)
+#endif
+      select type(array)
+      type is(complex)
+        intrinsic_array%complex_1D = array
+      type is(integer)
+        intrinsic_array%integer_1D = array
+      type is(logical)
+        intrinsic_array%logical_1D = array
+      type is(real)
+        intrinsic_array%real_1D = array
+      class default
+        error  stop "intrinsic_array_t construct: unsupported rank-2 type"
+      end select
+#ifndef NAGFOR
+    rank(2)
+      select type(array)
+      type is(complex)
+        intrinsic_array%complex_2D = array
+      type is(integer)
+        intrinsic_array%integer_2D = array
+      type is(logical)
+        intrinsic_array%logical_2D = array
+      type is(real)
+        intrinsic_array%real_2D = array
+      class default
+        error  stop "intrinsic_array_t construct: unsupported rank-2 type"
+      end select
+    rank default
+      error  stop "intrinsic_array_t construct: unsupported rank"
+    end select
+#endif
+
+  end procedure
+  
+  module procedure as_character
+    integer, parameter :: single_number_width=32
+
+    if (1 /= count( & 
+      [ allocated(self%complex_1D), allocated(self%integer_1D), allocated(self%logical_1D), allocated(self%real_1D) & 
+       ,allocated(self%complex_2D), allocated(self%integer_2D), allocated(self%logical_2D), allocated(self%real_2D) &
+      ])) error stop "intrinsic_array_t as_character: ambiguous component allocation status."
+
+    if (allocated(self%complex_1D)) then
+      character_self = repeat(" ", ncopies = single_number_width*size(self%complex_1D))
+      write(character_self, *) self%complex_1D
+    else if (allocated(self%integer_1D)) then
+      character_self = repeat(" ", ncopies = single_number_width*size(self%integer_1D))
+      write(character_self, *) self%integer_1D
+    else if (allocated(self%logical_1D)) then
+      character_self = repeat(" ", ncopies = single_number_width*size(self%logical_1D))
+      write(character_self, *) self%logical_1D
+    else if (allocated(self%real_1D)) then
+      character_self = repeat(" ", ncopies = single_number_width*size(self%real_1D))
+      write(character_self, *) self%real_1D
+    else if (allocated(self%complex_2D)) then
+      character_self = repeat(" ", ncopies = single_number_width*size(self%complex_2D))
+      write(character_self, *) self%complex_2D
+    else if (allocated(self%integer_2D)) then
+      character_self = repeat(" ", ncopies = single_number_width*size(self%integer_2D))
+      write(character_self, *) self%integer_2D
+    else if (allocated(self%logical_2D)) then
+      character_self = repeat(" ", ncopies = single_number_width*size(self%logical_1D))
+      write(character_self, *) self%logical_2D
+    else if (allocated(self%real_2D)) then
+      character_self = repeat(" ", ncopies = single_number_width*size(self%real_2D))
+      write(character_self, *) self%real_2D
+    end if
+
+    character_self = trim(adjustl(character_self))
+  end procedure 
+
+end submodule intrinsic_array_s