Replace do loops with reshape intrinsic

Replace nested do loops in mpp_pack.fh with calls to Fortran's `reshape`
intrinsic. Additionally, the new `mpp_global_field` tests have been
enabled.

Author: Jesse Lentz

mpp/include/mpp_pack.fh

@@ -36,11 +36,11 @@
         integer, allocatable, dimension(:) :: lb, ub !< These are 1 and shape(arr) respectively for all dimensions
                                                      !! except the domain-decomposed dimensions, for which they are
                                                      !! set according to the is,ie,js,je options.
-        integer :: n, m
+        integer :: ndims, n
         integer :: i1, i2, i3, i4, i5
 
-        n = rank(arr)
-        allocate (lb(n), ub(n))
+        ndims = rank(arr)
+        allocate (lb(ndims), ub(ndims))
 
         lb = 1
         ub = shape(arr)
@@ -51,48 +51,17 @@
         ub(xdim) = ie
         ub(ydim) = je
 
-        m = 0
+        n = product(ub - lb + 1)
+
         select rank(arr)
           rank (2)
-            do i2=lb(2),ub(2)
-              do i1=lb(1),ub(1)
-                m = m + 1
-                vec(m) = arr(i1, i2)
-              enddo
-            enddo
+            vec(1:n) = reshape(arr(lb(1):ub(1), lb(2):ub(2)), [n])
           rank (3)
-            do i3=lb(3),ub(3)
-              do i2=lb(2),ub(2)
-                do i1=lb(1),ub(1)
-                  m = m + 1
-                  vec(m) = arr(i1, i2, i3)
-                enddo
-              enddo
-            enddo
+            vec(1:n) = reshape(arr(lb(1):ub(1), lb(2):ub(2), lb(3):ub(3)), [n])
           rank (4)
-            do i4=lb(4),ub(4)
-              do i3=lb(3),ub(3)
-                do i2=lb(2),ub(2)
-                  do i1=lb(1),ub(1)
-                    m = m + 1
-                    vec(m) = arr(i1, i2, i3, i4)
-                  enddo
-                enddo
-              enddo
-            enddo
+            vec(1:n) = reshape(arr(lb(1):ub(1), lb(2):ub(2), lb(3):ub(3), lb(4):ub(4)), [n])
           rank (5)
-            do i5=lb(5),ub(5)
-              do i4=lb(4),ub(4)
-                do i3=lb(3),ub(3)
-                  do i2=lb(2),ub(2)
-                    do i1=lb(1),ub(1)
-                      m = m + 1
-                      vec(m) = arr(i1, i2, i3, i4, i5)
-                    enddo
-                  enddo
-                enddo
-              enddo
-            enddo
+            vec(1:n) = reshape(arr(lb(1):ub(1), lb(2):ub(2), lb(3):ub(3), lb(4):ub(4), lb(5):ub(5)), [n])
         end select
       end subroutine ARR2VEC_
 
@@ -116,11 +85,11 @@
         integer, allocatable, dimension(:) :: lb, ub !< These are 1 and shape(arr) respectively for all dimensions
                                                      !! except the domain-decomposed dimensions, for which they are
                                                      !! set according to the is,ie,js,je options.
-        integer :: n, m
+        integer :: ndims, n
         integer :: i1, i2, i3, i4, i5
 
-        n = rank(arr)
-        allocate (lb(n), ub(n))
+        ndims = rank(arr)
+        allocate (lb(ndims), ub(ndims))
 
         lb = 1
         ub = shape(arr)
@@ -131,49 +100,19 @@
         ub(xdim) = ie
         ub(ydim) = je
 
-        m = 0
-        select rank(arr)
-          rank (2)
-            do i2=lb(2),ub(2)
-              do i1=lb(1),ub(1)
-                m = m + 1
-                arr(i1, i2) = vec(m)
-              enddo
-            enddo
-          rank (3)
-            do i3=lb(3),ub(3)
-              do i2=lb(2),ub(2)
-                do i1=lb(1),ub(1)
-                  m = m + 1
-                  arr(i1, i2, i3) = vec(m)
-                enddo
-              enddo
-            enddo
-          rank (4)
-            do i4=lb(4),ub(4)
-              do i3=lb(3),ub(3)
-                do i2=lb(2),ub(2)
-                  do i1=lb(1),ub(1)
-                    m = m + 1
-                    arr(i1, i2, i3, i4) = vec(m)
-                  enddo
-                enddo
-              enddo
-            enddo
-          rank (5)
-            do i5=lb(5),ub(5)
-              do i4=lb(4),ub(4)
-                do i3=lb(3),ub(3)
-                  do i2=lb(2),ub(2)
-                    do i1=lb(1),ub(1)
-                      m = m + 1
-                      arr(i1, i2, i3, i4, i5) = vec(m)
-                    enddo
-                  enddo
-                enddo
-              enddo
-            enddo
-        end select
+        associate (s => ub - lb + 1)
+          n = product(s)
+          select rank(arr)
+            rank (2)
+              arr(lb(1):ub(1), lb(2):ub(2)) = reshape(vec(1:n), s(1:2))
+            rank (3)
+              arr(lb(1):ub(1), lb(2):ub(2), lb(3):ub(3)) = reshape(vec(1:n), s(1:3))
+            rank (4)
+              arr(lb(1):ub(1), lb(2):ub(2), lb(3):ub(3), lb(4):ub(4)) = reshape(vec(1:n), s(1:4))
+            rank (5)
+              arr(lb(1):ub(1), lb(2):ub(2), lb(3):ub(3), lb(4):ub(4), lb(5):ub(5)) = reshape(vec(1:n), s(1:5))
+          end select
+        end associate
       end subroutine VEC2ARR_
 
       !> @brief Initialize an assumed-rank array to `val`. This is used when initializing an assumed-rank array

test_fms/mpp/test_mpp_global_field.sh

@@ -26,12 +26,6 @@
 # Set common test settings.
 . ../test-lib.sh
 
-# TODO: Enable these tests once generalized indices work is complete
-SKIP_TESTS="test_mpp_global_field.1 \
-            test_mpp_global_field.2 \
-            test_mpp_global_field.3 \
-            test_mpp_global_field.4"
-
 touch input.nml
 
 for datatype in r4 r8 i4 i8