Merge pull request #2295 from stfc/2294_support_char_in_extraction

2294 support char in extraction

changelog

@@ -578,6 +578,9 @@
 	194 PR #2241 for #2215. Adds support for Fortran names being the
 	same as Python keywords when using sympy within PSyclone, e.g. in
 	comparisons between expressions.
+
+  195) PR #2295 for #2294. Extends the PSyData extraction library
+  to support character variables
 
 release 2.3.1 17th of June 2022
 

doc/developer_guide/psy_data.rst

@@ -654,6 +654,8 @@ takes the following parameters:
         64-bit integer value
     ``logical``:
         32-bit logical value
+    ``char``:
+        A default string value
 
     Default value is ``real,double,int``.
 

lib/extract/netcdf/Makefile

@@ -53,7 +53,7 @@ F90FLAGS += $$(nf-config --fflags)
 
 # The extract library is implemented for int, real and
 # double scalars and 1- to 4-dimensional arrays
-PROCESS_ARGS = -prefix=extract_ -types=int,long,logical,real,double \
+PROCESS_ARGS = -prefix=extract_ -types=char,int,long,logical,real,double \
 		       -dims=1,2,3,4
 PROCESS = $$($(PSYDATA_LIB_DIR)/get_python.sh) $(PSYDATA_LIB_DIR)/process.py
 

lib/extract/netcdf/extract_netcdf_base.jinja

@@ -35,6 +35,7 @@
 {% if ALL_TYPES is not defined -%}
    {% set ALL_TYPES = [ ("Double", "real(kind=real64)",   64),
                         ("Real",   "real(kind=real32)",   32),
+                        ("Character",   "character(*)",   32),
                         ("Long",   "real(kind=int64)",    64),
                         ("Int",    "integer(kind=int32)", 32) ] %}
 {% endif -%}
@@ -279,6 +280,7 @@ contains
 {% set NCDF_TYPE_MAPPING = { "Double": "NF90_DOUBLE",
                              "Real":   "NF90_REAL",
                              "Logical":"NF90_INT",
+                             "Char":   "NF90_CHAR",
                              "Long":   "NF90_INT64",
                              "Int":    "NF90_INT"} -%}
 

lib/extract/netcdf/lfric/Makefile

@@ -65,7 +65,7 @@ LFRIC_INCLUDE_FLAGS += $$(nf-config --fflags)
 PSYDATA_LIB_NAME = _extract
 PSYDATA_LIB = lib$(PSYDATA_LIB_NAME).a
 
-PROCESS_ARGS = -prefix=extract_ -types=int,logical,real,double \
+PROCESS_ARGS = -prefix=extract_ -types=char,int,logical,real,double \
                        -dims=1,2,3,4
 PROCESS = $$($(PSYDATA_LIB_DIR)/get_python.sh) $(PSYDATA_LIB_DIR)/process.py
 

lib/extract/netcdf/read_kernel_data_mod.f90

@@ -66,6 +66,11 @@ module read_kernel_data_mod
         ! The various procedures used
         procedure :: OpenRead
 
+        procedure :: ReadScalarChar
+        procedure :: ReadArray1dChar
+        procedure :: ReadArray2dChar
+        procedure :: ReadArray3dChar
+        procedure :: ReadArray4dChar
         procedure :: ReadScalarInt
         procedure :: ReadArray1dInt
         procedure :: ReadArray2dInt
@@ -96,6 +101,11 @@ module read_kernel_data_mod
         !! This is not part of the official PSyData API, but is used in
         !! the drivers created by PSyclone.
         generic, public :: ReadVariable => &
+            ReadScalarChar, &
+            ReadArray1dChar, &
+            ReadArray2dChar, &
+            ReadArray3dChar, &
+            ReadArray4dChar, &
             ReadScalarInt, &
             ReadArray1dInt, &
             ReadArray2dInt, &
@@ -177,6 +187,253 @@ subroutine OpenRead(this, module_name, region_name)
     end subroutine OpenRead
 
 
+    ! -------------------------------------------------------------------------
+    !> @brief This subroutine reads the value of a scalar character(*)
+    !! variable from the NetCDF file and returns it to the user. Note that
+    !! this function is not part of the PSyData API, but it is convenient to
+    !! have these functions together here. The driver can then be linked with
+    !! this  PSyData library and will be able to read the files.
+    !! @param[in,out] this The instance of the ReadKernelDataType.
+    !! @param[in] name The name of the variable (string).
+    !! @param[out] value The read value is stored here.
+    subroutine ReadScalarChar(this, name, value)
+
+        use netcdf, only : nf90_inq_varid, nf90_get_var
+
+        implicit none
+
+        class(ReadKernelDataType), intent(inout), target :: this
+        character(*), intent(in)                         :: name
+        character(*), intent(out)                            :: value
+
+        integer                                          :: retval, varid
+
+        retval = CheckError(nf90_inq_varid(this%ncid, name, varid))
+        retval = CheckError(nf90_get_var(this%ncid, varid, value))
+
+    end subroutine ReadScalarChar
+
+
+
+    ! -------------------------------------------------------------------------
+    !> @brief This subroutine reads the values of a 1D array of character(*)
+    !! It allocates memory for the allocatable parameter 'value' to store the
+    !! read values which is then returned to the caller. If the memory for the
+    !! array cannot be allocated, the application will be stopped.
+    !! @param[in,out] this The instance of the extract_PsyDataType.
+    !! @param[in] name The name of the variable (string).
+    !! @param[out] value An allocatable, unallocated 2d-double precision array
+    !!             which is allocated here and stores the values read.
+    subroutine ReadArray1dChar(this, name, value)
+
+        use netcdf
+
+        implicit none
+
+        class(ReadKernelDataType), intent(inout), target             :: this
+        character(*), intent(in)                                     :: name
+        character(*), dimension(:), allocatable, intent(out) :: value
+
+        integer        :: retval, varid
+        integer        :: dim_id
+        integer        :: dim_size1
+        integer        :: ierr
+
+        ! First query the dimensions of the original array from the
+        ! NetCDF file
+        retval = CheckError(nf90_inq_dimid(this%ncid, trim(name//"dim%1"), &
+                                           dim_id))
+        retval = CheckError(nf90_inquire_dimension(this%ncid, dim_id, &
+                                                   len=dim_size1))
+
+        ! Allocate enough space to store the values to be read:
+        allocate(value(dim_size1), Stat=ierr)
+        if (ierr /= 0) then
+            write(stderr,*) "Cannot allocate array for ", name, &
+                            " of size ", dim_size1, &
+                            " in ReadArray1dChar."
+            stop
+        endif
+
+        retval = CheckError(nf90_inq_varid(this%ncid, name, varid))
+        ! Initialise the whole array with "".
+        value = ""
+        retval = CheckError(nf90_get_var(this%ncid, varid, value))
+
+    end subroutine ReadArray1dChar
+
+
+
+    ! -------------------------------------------------------------------------
+    !> @brief This subroutine reads the values of a 2D array of character(*)
+    !! It allocates memory for the allocatable parameter 'value' to store the
+    !! read values which is then returned to the caller. If the memory for the
+    !! array cannot be allocated, the application will be stopped.
+    !! @param[in,out] this The instance of the extract_PsyDataType.
+    !! @param[in] name The name of the variable (string).
+    !! @param[out] value An allocatable, unallocated 2d-double precision array
+    !!             which is allocated here and stores the values read.
+    subroutine ReadArray2dChar(this, name, value)
+
+        use netcdf
+
+        implicit none
+
+        class(ReadKernelDataType), intent(inout), target             :: this
+        character(*), intent(in)                                     :: name
+        character(*), dimension(:,:), allocatable, intent(out) :: value
+
+        integer        :: retval, varid
+        integer        :: dim_id
+        integer        :: dim_size1,dim_size2
+        integer        :: ierr
+
+        ! First query the dimensions of the original array from the
+        ! NetCDF file
+        retval = CheckError(nf90_inq_dimid(this%ncid, trim(name//"dim%1"), &
+                                           dim_id))
+        retval = CheckError(nf90_inquire_dimension(this%ncid, dim_id, &
+                                                   len=dim_size1))
+        retval = CheckError(nf90_inq_dimid(this%ncid, trim(name//"dim%2"), &
+                                           dim_id))
+        retval = CheckError(nf90_inquire_dimension(this%ncid, dim_id, &
+                                                   len=dim_size2))
+
+        ! Allocate enough space to store the values to be read:
+        allocate(value(dim_size1,dim_size2), Stat=ierr)
+        if (ierr /= 0) then
+            write(stderr,*) "Cannot allocate array for ", name, &
+                            " of size ", dim_size1,dim_size2, &
+                            " in ReadArray2dChar."
+            stop
+        endif
+
+        retval = CheckError(nf90_inq_varid(this%ncid, name, varid))
+        ! Initialise the whole array with "".
+        value = ""
+        retval = CheckError(nf90_get_var(this%ncid, varid, value))
+
+    end subroutine ReadArray2dChar
+
+
+
+    ! -------------------------------------------------------------------------
+    !> @brief This subroutine reads the values of a 3D array of character(*)
+    !! It allocates memory for the allocatable parameter 'value' to store the
+    !! read values which is then returned to the caller. If the memory for the
+    !! array cannot be allocated, the application will be stopped.
+    !! @param[in,out] this The instance of the extract_PsyDataType.
+    !! @param[in] name The name of the variable (string).
+    !! @param[out] value An allocatable, unallocated 2d-double precision array
+    !!             which is allocated here and stores the values read.
+    subroutine ReadArray3dChar(this, name, value)
+
+        use netcdf
+
+        implicit none
+
+        class(ReadKernelDataType), intent(inout), target             :: this
+        character(*), intent(in)                                     :: name
+        character(*), dimension(:,:,:), allocatable, intent(out) :: value
+
+        integer        :: retval, varid
+        integer        :: dim_id
+        integer        :: dim_size1,dim_size2,dim_size3
+        integer        :: ierr
+
+        ! First query the dimensions of the original array from the
+        ! NetCDF file
+        retval = CheckError(nf90_inq_dimid(this%ncid, trim(name//"dim%1"), &
+                                           dim_id))
+        retval = CheckError(nf90_inquire_dimension(this%ncid, dim_id, &
+                                                   len=dim_size1))
+        retval = CheckError(nf90_inq_dimid(this%ncid, trim(name//"dim%2"), &
+                                           dim_id))
+        retval = CheckError(nf90_inquire_dimension(this%ncid, dim_id, &
+                                                   len=dim_size2))
+        retval = CheckError(nf90_inq_dimid(this%ncid, trim(name//"dim%3"), &
+                                           dim_id))
+        retval = CheckError(nf90_inquire_dimension(this%ncid, dim_id, &
+                                                   len=dim_size3))
+
+        ! Allocate enough space to store the values to be read:
+        allocate(value(dim_size1,dim_size2,dim_size3), Stat=ierr)
+        if (ierr /= 0) then
+            write(stderr,*) "Cannot allocate array for ", name, &
+                            " of size ", dim_size1,dim_size2,dim_size3, &
+                            " in ReadArray3dChar."
+            stop
+        endif
+
+        retval = CheckError(nf90_inq_varid(this%ncid, name, varid))
+        ! Initialise the whole array with "".
+        value = ""
+        retval = CheckError(nf90_get_var(this%ncid, varid, value))
+
+    end subroutine ReadArray3dChar
+
+
+
+    ! -------------------------------------------------------------------------
+    !> @brief This subroutine reads the values of a 4D array of character(*)
+    !! It allocates memory for the allocatable parameter 'value' to store the
+    !! read values which is then returned to the caller. If the memory for the
+    !! array cannot be allocated, the application will be stopped.
+    !! @param[in,out] this The instance of the extract_PsyDataType.
+    !! @param[in] name The name of the variable (string).
+    !! @param[out] value An allocatable, unallocated 2d-double precision array
+    !!             which is allocated here and stores the values read.
+    subroutine ReadArray4dChar(this, name, value)
+
+        use netcdf
+
+        implicit none
+
+        class(ReadKernelDataType), intent(inout), target             :: this
+        character(*), intent(in)                                     :: name
+        character(*), dimension(:,:,:,:), allocatable, intent(out) :: value
+
+        integer        :: retval, varid
+        integer        :: dim_id
+        integer        :: dim_size1,dim_size2,dim_size3,dim_size4
+        integer        :: ierr
+
+        ! First query the dimensions of the original array from the
+        ! NetCDF file
+        retval = CheckError(nf90_inq_dimid(this%ncid, trim(name//"dim%1"), &
+                                           dim_id))
+        retval = CheckError(nf90_inquire_dimension(this%ncid, dim_id, &
+                                                   len=dim_size1))
+        retval = CheckError(nf90_inq_dimid(this%ncid, trim(name//"dim%2"), &
+                                           dim_id))
+        retval = CheckError(nf90_inquire_dimension(this%ncid, dim_id, &
+                                                   len=dim_size2))
+        retval = CheckError(nf90_inq_dimid(this%ncid, trim(name//"dim%3"), &
+                                           dim_id))
+        retval = CheckError(nf90_inquire_dimension(this%ncid, dim_id, &
+                                                   len=dim_size3))
+        retval = CheckError(nf90_inq_dimid(this%ncid, trim(name//"dim%4"), &
+                                           dim_id))
+        retval = CheckError(nf90_inquire_dimension(this%ncid, dim_id, &
+                                                   len=dim_size4))
+
+        ! Allocate enough space to store the values to be read:
+        allocate(value(dim_size1,dim_size2,dim_size3,dim_size4), Stat=ierr)
+        if (ierr /= 0) then
+            write(stderr,*) "Cannot allocate array for ", name, &
+                            " of size ", dim_size1,dim_size2,dim_size3,dim_size4, &
+                            " in ReadArray4dChar."
+            stop
+        endif
+
+        retval = CheckError(nf90_inq_varid(this%ncid, name, varid))
+        ! Initialise the whole array with "".
+        value = ""
+        retval = CheckError(nf90_get_var(this%ncid, varid, value))
+
+    end subroutine ReadArray4dChar
+
+
     ! -------------------------------------------------------------------------
     !> @brief This subroutine reads the value of a scalar integer(kind=int32)
     !! variable from the NetCDF file and returns it to the user. Note that

lib/extract/netcdf/read_kernel_data_mod.jinja

@@ -28,6 +28,7 @@
 {% if ALL_TYPES is not defined -%}
    {% set ALL_TYPES = [ ("Double", "real(kind=real64)",   64),
                         ("Real",   "real(kind=real32)",   32),
+                        ("Char",   "character(*)",        8),
                         ("Logical","integer(kind=real32)",32),
                         ("Int",    "integer(kind=int32)", 32) ] %}
 {% endif -%}
@@ -288,11 +289,16 @@ contains
         value = tmp == 1
         deallocate(tmp)
         {% else %}
+        {% if name == "Char" %}
+        ! Initialise the whole array with "".
+        value = ""
+        {% else %}
         ! Initialise it with 0, so that an array comparison will work
         ! even though e.g. boundary areas or so might not be set at all.
         ! The compiler will convert the double precision value to the right
         ! type (e.g. int or single precision).
         value = 0.0d0
+        {% endif %}
         retval = CheckError(nf90_get_var(this%ncid, varid, value))
         {% endif %}
 

lib/extract/standalone/Makefile

@@ -51,7 +51,7 @@ PSYDATA_LIB_DIR ?= ./../..
 
 # The extract library is implemented for int, real and
 # double scalars and 1- to 4-dimensional arrays
-PROCESS_ARGS = -prefix=extract_ -types=int,logical,real,double \
+PROCESS_ARGS = -prefix=extract_ -types=char,int,long,logical,real,double \
 		       -dims=1,2,3,4
 PROCESS = $$($(PSYDATA_LIB_DIR)/get_python.sh) $(PSYDATA_LIB_DIR)/process.py
 

lib/extract/standalone/extract_standalone_base.jinja

@@ -35,14 +35,16 @@
 {% if ALL_TYPES is not defined -%}
    {% set ALL_TYPES = [ ("Double", "real(kind=real64)",   64),
                         ("Real",   "real(kind=real32)",   32),
+                        ("Character",   "character(*)",    8),
+                        ("Long",   "real(kind=int64)",    64),
                         ("Int",    "integer(kind=int32)", 32) ] %}
 {% endif -%}
 
 
 ! -----------------------------------------------------------------------------
 ! BSD 3-Clause License
 !
-! Copyright (c) 2022, Science and Technology Facilities Council.
+! Copyright (c) 2022-2023, Science and Technology Facilities Council.
 ! All rights reserved.
 !
 ! Redistribution and use in source and binary forms, with or without

lib/extract/standalone/lfric/Makefile

@@ -61,7 +61,7 @@ include $(LFRIC_PATH)/lfric_include_flags.inc
 PSYDATA_LIB_NAME = _extract
 PSYDATA_LIB = lib$(PSYDATA_LIB_NAME).a
 
-PROCESS_ARGS = -prefix=extract_ -types=int,logical,real,double \
+PROCESS_ARGS = -prefix=extract_ -types=char,int,logical,real,double \
                        -dims=1,2,3,4
 PROCESS = $$($(PSYDATA_LIB_DIR)/get_python.sh) $(PSYDATA_LIB_DIR)/process.py