(closes #1312) fix scalar array functionality

doc/tutorials_and_examples/lfric_examples.rst

@@ -21,7 +21,8 @@ kernels, one :ref:`user-supplied <lfric-kernel>`, the other a
 :ref:`Built-in <lfric-built-ins>`. Code is generated both with and
 without distributed-memory support. Also demonstrates the use of the
 ``-d`` flag to specify where to search for user-supplied kernel code
-(see :ref:`psyclone_command` section for more details).
+(see :ref:`psyclone_command` section for more details), and shows
+compilation of the algorithm layer in the Makefile.
 
 Example 2: Applying Transformations
 -----------------------------------

doc/user_guide/lfric.rst

@@ -124,8 +124,9 @@ Scalar Array
 
 In the LFRic API a scalar array represents a Fortran array of scalars, of at
 least rank (number of dimensions) one. Scalar arrays are identified with
-``GH_SCALAR_ARRAY`` metadata. As with scalars, array arguments can have
-``real``, ``integer`` or ``logical`` data type in
+``GH_SCALAR_ARRAY`` metadata, which has the required metadata:
+``arg_type(GH_SCALAR_ARRAY, <datatype>, GH_READ, <rank>)``. As with scalars,
+array arguments can have ``real``, ``integer`` or ``logical`` data type in
 :ref:`user-defined Kernels <lfric-kernel-valid-data-type>`.
 
 .. _lfric-field:
@@ -1242,8 +1243,9 @@ has. More details about the supported function spaces are in subsection
 For example, the metadata for a kernel that applies a column-wise
 operator to a field might look like::
 
-  type(arg_type) :: meta_args(3) = (/                              &
+  type(arg_type) :: meta_args(4) = (/                              &
        arg_type(GH_FIELD, GH_REAL, GH_INC, W1),                    &
+       arg_type(GH_SCALAR_ARRAY, GH_INTEGER, GH_READ, 5),          &
        arg_type(GH_FIELD, GH_REAL, GH_READ, W2H),                  &
        arg_type(GH_COLUMNWISE_OPERATOR, GH_REAL, GH_READ, W1, W2H) &
        /)

examples/lfric/code/testkern_mod.F90

@@ -15,12 +15,13 @@ module testkern_mod
   implicit none
 
   type, extends(kernel_type) :: testkern_type
-     type(arg_type), dimension(5) :: meta_args =        &
-          (/ arg_type(gh_scalar, gh_real, gh_read),     &
-             arg_type(gh_field,  gh_real, gh_inc,  w1), &
-             arg_type(gh_field,  gh_real, gh_read, w2), &
-             arg_type(gh_field,  gh_real, gh_read, w2), &
-             arg_type(gh_field,  gh_real, gh_read, w3)  &
+     type(arg_type), dimension(6) :: meta_args =              &
+          (/ arg_type(gh_scalar,       gh_real, gh_read   ),  &
+             arg_type(gh_scalar_array, gh_real, gh_read, 2 ), &
+             arg_type(gh_field,        gh_real, gh_inc,  w1), &
+             arg_type(gh_field,        gh_real, gh_read, w2), &
+             arg_type(gh_field,        gh_real, gh_read, w2), &
+             arg_type(gh_field,        gh_real, gh_read, w3)  &
            /)
      integer :: operates_on = cell_column
    contains
@@ -29,10 +30,11 @@ module testkern_mod
 
 contains
 
-  subroutine testkern_code(nlayers, ascalar,        &
-                           fld1, fld2, fld3, fld4,  &
-                           ndf_w1, undf_w1, map_w1, &
-                           ndf_w2, undf_w2, map_w2, &
+  subroutine testkern_code(nlayers, ascalar,                  &
+                           dims_ascalar_array, ascalar_array, &
+                           fld1, fld2, fld3, fld4,            &
+                           ndf_w1, undf_w1, map_w1,           &
+                           ndf_w2, undf_w2, map_w2,           &
                            ndf_w3, undf_w3, map_w3)
     implicit none
 
@@ -44,6 +46,8 @@ subroutine testkern_code(nlayers, ascalar,        &
     integer(kind=i_def), intent(in), dimension(ndf_w1) :: map_w1
     integer(kind=i_def), intent(in), dimension(ndf_w2) :: map_w2
     integer(kind=i_def), intent(in), dimension(ndf_w3) :: map_w3
+    integer(kind=i_def), intent(in), dimension(2) :: dims_ascalar_array
+    real(kind=r_def), intent(in), dimension(dims_ascalar_array(1), dims_ascalar_array(2)) :: ascalar_array
     real(kind=r_def), intent(in) :: ascalar
     real(kind=r_def), intent(inout), dimension(undf_w1) :: fld1
     real(kind=r_def), intent(in), dimension(undf_w2)  :: fld2

examples/lfric/eg1/Makefile

@@ -34,20 +34,47 @@
 # Author: A. R. Porter, STFC Daresbury Laboratory
 # Modified J. Henrichs, Bureau of Meteorology
 
-include ../../common.mk
+# The compiler to use may be specified via the F90 environment variable
+#
+# export F90=gfortran
+# export F90FLAGS="-g -O0"
+
+include ../lfric_common.mk
+
+GENERATED_FILES = single_invoke_alg.f90 single_invoke_psy.f90 \
+	single_invoke_psy.o *.mod testkern_mod.o
+
+F90 ?= gfortran
+F90FLAGS ?= -g -O0
 
 .PHONY: transform compile run
 
 # The '-d ../code' argument specifies that PSyclone should search the
 # '../code' directory when looking for user-supplied kernels.
-transform:
-	@echo "Sequential code:"
-	${PSYCLONE} -api lfric -d ../code -nodm ./single_invoke.x90
+transform: single_invoke_alg.f90
 	@echo "With distributed-memory support:"
 	${PSYCLONE} -api lfric -d ../code ./single_invoke.x90
 
-compile: transform
-	@echo "No compilation supported for lfric/eg1"
+single_invoke_alg.f90 single_invoke_psy.f90: single_invoke.x90
+	@echo "Sequential code:"
+	${PSYCLONE} -api lfric -d ../code -nodm ./single_invoke.x90 \
+		-oalg single_invoke_alg.f90 \
+		-opsy single_invoke_psy.f90
+
+compile: $(LFRIC_LIB) single_invoke_psy.o single_invoke_alg.o
+
+testkern_mod.o: ../code/testkern_mod.F90
+	$(F90) $(F90FLAGS) -c $<
+
+%.o: %.f90
+	$(F90) $(F90FLAGS) -c $<
+
+%.o: %.F90
+	$(F90) $(F90FLAGS) -c $<
+
+single_invoke_alg.o: single_invoke_psy.o
+single_invoke_psy.o: testkern_mod.o
+testkern_mod.o: $(LFRIC_LIB)
 
 run: compile
 	@echo "No run targets for lfric/eg1"

examples/lfric/eg1/single_invoke.x90

@@ -32,7 +32,7 @@
 ! POSSIBILITY OF SUCH DAMAGE.
 ! -----------------------------------------------------------------------------
 ! Authors: A. R. Porter and R. W. Ford, STFC Daresbury Laboratory
-!          I. Kavcic, Met Office
+!          I. Kavcic and A. Pirrie, Met Office
 
 program single_invoke
 
@@ -44,10 +44,11 @@ program single_invoke
 
   implicit none
 
-  type(field_type) :: f1, f2, m1, m2
-  real(r_def)      :: a
+  type(field_type)               :: f1, f2, m1, m2
+  real(r_def)                    :: a
+  real(r_def), dimension(50,100) :: ascalar_array
 
   call invoke( setval_c(f1, 0.0_r_def), &
-               testkern_type(a, f1, f2, m1, m2) )
+               testkern_type(a, ascalar_array, f1, f2, m1, m2) )
 
 end program single_invoke

examples/lfric/eg2/multi_invoke_mod.x90

@@ -32,7 +32,7 @@
 ! POSSIBILITY OF SUCH DAMAGE.
 ! -----------------------------------------------------------------------------
 ! Author R. W. Ford and A. R. Porter, STFC Daresbury Laboratory
-! Modified I. Kavcic, Met Office
+! Modified I. Kavcic and A. Pirrie, Met Office
 
 program multi_invoke
 
@@ -45,16 +45,17 @@ program multi_invoke
 
   implicit none
 
-  type(field_type) :: f1, f2, m1, m2
-  real(r_def)      :: a
+  type(field_type)               :: f1, f2, m1, m2
+  real(r_def)                    :: a
+  real(r_def), dimension(50,100) :: ascalar_array
 
   call invoke( setval_c(f1, 0.0_r_def), &
                setval_c(f2, 0.0_r_def), &
                setval_c(m1, 0.0_r_def), &
                setval_c(m2, 0.0_r_def) )
   ! This example artificially has two separate 'invoke()' calls. In practice
   ! these would be merged into a single call.
-  call invoke( testkern_type(a, f1, f2, m1, m2), &
-               testkern_type(a, f1, f2, m1, m2) )
+  call invoke( testkern_type(a, ascalar_array, f1, f2, m1, m2), &
+               testkern_type(a, ascalar_array, f1, f2, m1, m2) )
 
 end program multi_invoke

src/psyclone/domain/lfric/kern_call_invoke_arg_list.py

@@ -137,6 +137,15 @@ def scalar(self,
         precision_name = consts.SCALAR_PRECISION_MAP[scalar_arg.intrinsic_type]
         LFRicTypes.add_precision_symbol(self._symtab, precision_name)
 
+        if scalar_arg.is_scalar_array:
+            dims_sym = self._symtab.find_or_create_tag(
+                    tag="dims_" + scalar_arg.name,
+                    symbol_type=DataSymbol,
+                    datatype=ArrayType(
+                        LFRicTypes("LFRicIntegerScalarDataType")(),
+                        [scalar_arg._array_ndims]))
+            self.psyir_append(dims_sym)
+
         sym = self._symtab.new_symbol(scalar_arg.name,
                                       symbol_type=DataSymbol,
                                       datatype=datatype)

src/psyclone/tests/domain/lfric/conftest.py

@@ -28,15 +28,15 @@ def lfrickern_fixture():
     mdata_code = '''
 module testkern_field_mod
   type, extends(kernel_type) :: testkern_field_type
-     type(arg_type), meta_args(8) =                               &
-          (/ arg_type(gh_scalar, gh_real,    gh_read),            &
-             arg_type(gh_field,  gh_real,    gh_readinc, w0),     &
-             arg_type(gh_field,  gh_real,    gh_inc,     w1),     &
-             arg_type(gh_field*3,gh_integer, gh_read,    w2),     &
-             arg_type(gh_field,  gh_integer, gh_write,   wtheta), &
-             arg_type(gh_field,  gh_integer, gh_read,    w3),     &
-             arg_type(gh_scalar, gh_integer, gh_read),            &
-             arg_type(gh_scalar, gh_logical, gh_read)             &
+     type(arg_type), meta_args(8) =                                     &
+          (/ arg_type(gh_scalar,       gh_real,    gh_read),            &
+             arg_type(gh_field,        gh_real,    gh_readinc, w0),     &
+             arg_type(gh_field,        gh_real,    gh_inc,     w1),     &
+             arg_type(gh_field*3,      gh_integer, gh_read,    w2),     &
+             arg_type(gh_field,        gh_integer, gh_write,   wtheta), &
+             arg_type(gh_field,        gh_integer, gh_read,    w3),     &
+             arg_type(gh_scalar_array, gh_integer, gh_read, 3),         &
+             arg_type(gh_scalar,       gh_logical, gh_read)             &
            /)
      type(func_type), dimension(2) :: meta_funcs =  &
           (/ func_type(w1, gh_basis),               &