From 4aa085fccab78a8ae2c788626170e861c3cb2a07 Mon Sep 17 00:00:00 2001 From: Joerg Henrichs Date: Thu, 30 Jan 2025 16:13:20 +1100 Subject: [PATCH 01/15] #2878 Added missing trim() calls to verbose output. --- lib/extract/netcdf/extract_netcdf_base.jinja | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/lib/extract/netcdf/extract_netcdf_base.jinja b/lib/extract/netcdf/extract_netcdf_base.jinja index d175142e7b..be46502adb 100644 --- a/lib/extract/netcdf/extract_netcdf_base.jinja +++ b/lib/extract/netcdf/extract_netcdf_base.jinja @@ -222,7 +222,8 @@ contains call this%PSyDataBaseType%PreStart(module_name, region_name, & num_pre_vars, num_post_vars) if (this%verbosity >= 1) then - write(stderr,*) "Opening ", trim(module_name//"-"//region_name//".nc") + write(stderr,*) "Opening ", trim(module_name) // "-" // & + trim(region_name) // ".nc" endif @@ -275,8 +276,8 @@ contains call this%PSyDataBaseType%PreEndDeclaration() if (this%verbosity >= 1) then - write(stderr,*) "Ending definition ", this%module_name // & - "-"//this%region_name//".nc" + write(stderr,*) "Ending definition ", trim(this%module_name) // & + "-"//trim(this%region_name)//".nc" endif retval = CheckError(nf90_enddef(this%ncid)) @@ -297,8 +298,8 @@ contains integer :: retval if (this%verbosity >= 1) then - write(stderr,*) "Closing ", this%module_name//"-" //& - this%region_name//".nc" + write(stderr,*) "Closing ", trim(this%module_name) // "-" // & + trim(this%region_name) // ".nc" endif retval = CheckError(nf90_close(this%ncid)) call this%PSyDataBaseType%PostEnd() From 77f505b51ce844628f36ab492d1abbdd4aca9c04 Mon Sep 17 00:00:00 2001 From: Joerg Henrichs Date: Thu, 30 Jan 2025 16:14:52 +1100 Subject: [PATCH 02/15] #2878 Added modified version of lfric kernel_data_netcdf file to support the new names of the various lfric fields. --- .../kernel_data_netcdf.jinja-new-field-types | 347 ++++++++++++++++++ 1 file changed, 347 insertions(+) create mode 100644 lib/extract/netcdf/lfric/kernel_data_netcdf.jinja-new-field-types diff --git a/lib/extract/netcdf/lfric/kernel_data_netcdf.jinja-new-field-types b/lib/extract/netcdf/lfric/kernel_data_netcdf.jinja-new-field-types new file mode 100644 index 0000000000..50fa18bc36 --- /dev/null +++ b/lib/extract/netcdf/lfric/kernel_data_netcdf.jinja-new-field-types @@ -0,0 +1,347 @@ +{# Added this as Jinja code so that it is understood that the + comment does not apply to THIS file. #} +{{ "! ================================================== !" }} +{{ "! THIS FILE IS CREATED FROM THE JINJA TEMPLATE FILE. !" }} +{{ "! DO NOT MODIFY DIRECTLY! !" }} +{{ "! ================================================== !" }} + +! ----------------------------------------------------------------------------- +! BSD 3-Clause License +! +! Copyright (c) 2020-2025, Science and Technology Facilities Council. +! All rights reserved. +! +! Redistribution and use in source and binary forms, with or without +! modification, are permitted provided that the following conditions are met: +! +! * Redistributions of source code must retain the above copyright notice, this +! list of conditions and the following disclaimer. +! +! * Redistributions in binary form must reproduce the above copyright notice, +! this list of conditions and the following disclaimer in the documentation +! and/or other materials provided with the distribution. +! +! * Neither the name of the copyright holder nor the names of its +! contributors may be used to endorse or promote products derived from +! this software without specific prior written permission. +! +! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +! "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +! LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS +! FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE +! COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, +! INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, +! BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; +! LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +! CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT +! LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN +! ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +! POSSIBILITY OF SUCH DAMAGE. +! ----------------------------------------------------------------------------- +! Author J. Henrichs, Bureau of Meteorology +! Modified I. Kavcic, Met Office + +!> This module implements a simple NetCDF writer using the PSyData +!! interface. It is specific to the LFRic infrastructure library. +!! A Fortran code instrumented with corresponding calls +!! to the PSyData API and linked in with this library will write +!! the requested input and output parameters to a NetCDF file. +!! + +{% set ALL_PREC = ["32", "64"] -%} + +module extract_psy_data_mod + + use, intrinsic :: iso_fortran_env, only : int64, int32 + use extract_netcdf_base_mod, only : ExtractNetcdfBaseType, CheckError + + implicit none + + !> This is the data type that manages the information required + !! to write data to a NetCDF file using the PSyData API. A + !! static instance of this type is created for each instrumented + !! region with PSyclone (and each region will write a separate + !! file). + type, extends(ExtractNetcdfBaseType), public :: extract_PSyDataType + + contains + {% set all_declares=[] -%} + {% set all_writes=[] -%} + {% for prec in ALL_PREC %} + procedure :: DeclareField_r{{prec}} + procedure :: WriteField_r{{prec}} + procedure :: DeclareFieldVector_r{{prec}} + procedure :: WriteFieldVector_r{{prec}} + {{- all_declares.append("DeclareField_r{{prec}}") or ""}} + {{- all_declares.append("DeclareFieldVector_r{{prec}}") or ""}} + {{- all_writes.append("WriteField_r{{prec}}") or ""}} + {{- all_writes.append("WriteFieldVector_r{{prec}}") or ""}} + {% endfor %} + + ! The various procedures defined here + procedure :: DeclareIntField + procedure :: WriteIntField + procedure :: DeclareIntFieldVector + procedure :: WriteIntFieldVector + + !> Declare generic interface for PreDeclareVariable: + generic, public :: PreDeclareVariable => & + {% for prec in ALL_PREC %} + DeclareField_r{{prec}}, & + DeclareFieldVector_r{{prec}}, & + {% endfor %} + DeclareIntField, & + DeclareIntFieldVector + + !> The generic interface for providing the value of variables, + !! which in case of the kernel extraction writes the data to + !! the NetCDF file. + generic, public :: ProvideVariable => & + {% for prec in ALL_PREC %} + WriteField_r{{prec}}, & + WriteFieldVector_r{{prec}}, & + {% endfor %} + WriteIntField, & + WriteIntFieldVector + + end type extract_PSyDataType + +contains + + + {% for prec in ALL_PREC %} + + ! ------------------------------------------------------------------------- + !> @brief This subroutine declares an LFRic field with real-valued + !! {{prec}}-bit data. + !! It calls the PreDeclareVariable function provided by the base class + !! (depending on the type of the argument, e.g. it might call + !! DeclareArray1dDouble). + !! @param[in,out] this The instance of the extract_PSyDataType. + !! @param[in] name The name of the variable (string). + !! @param[in] value The value of the variable. + subroutine DeclareField_r{{prec}}(this, name, value) + + use field_real{{prec}}_mod, only : field_real{{prec}}_type, field_real{{prec}}_proxy_type + + implicit none + + class(extract_PSyDataType), intent(inout), target :: this + character(*), intent(in) :: name + type(field_real{{prec}}_type), intent(in) :: value + + type(field_real{{prec}}_proxy_type) :: value_proxy + + value_proxy = value%get_proxy() + call this%PreDeclareVariable(name, value_proxy%data) + + end subroutine DeclareField_r{{prec}} + + ! ------------------------------------------------------------------------- + !> @brief This subroutine writes the values of an LFRic real-valued {{prec}}-bit + !! field to the NetCDF file. It uses the corresponding function + !! provided by the base class. + !! @param[in,out] this The instance of the extract_PSyDataType. + !! @param[in] name The name of the variable (string). + !! @param[in] value The value of the variable. + subroutine WriteField_r{{prec}}(this, name, value) + + use field_real{{prec}}_mod, only : field_real{{prec}}_type, field_real{{prec}}_proxy_type + + implicit none + + class(extract_PSyDataType), intent(inout), target :: this + character(*), intent(in) :: name + type(field_real{{prec}}_type), intent(in) :: value + + type(field_real{{prec}}_proxy_type) :: value_proxy + + value_proxy = value%get_proxy() + call this%ProvideVariable(name, value_proxy%data) + + end subroutine WriteField_r{{prec}} + + ! ------------------------------------------------------------------------- + !> @brief This subroutine declares an LFRic real-valued {{prec}}-bit field vector. + !! Each component of the vector is stored as a separate variable, using the + !! corresponding array function of the base class. + !! @param[in,out] this The instance of the extract_PSyDataType. + !! @param[in] name The name of the variable (string). + !! @param[in] value The value of the variable. + subroutine DeclareFieldVector_r{{prec}}(this, name, value) + + use field_real{{prec}}_mod, only : field_real{{prec}}_type, field_real{{prec}}_proxy_type + + implicit none + + class(extract_PSyDataType), intent(inout), target :: this + character(*), intent(in) :: name + type(field_real{{prec}}_type), dimension(:), intent(in) :: value + + integer :: i + type(field_real{{prec}}_proxy_type) :: value_proxy + character(9) :: number + + ! Provide each component of the vector as an individual 1D array. + ! The base class will re-allocate internal array sizes if required. + do i = 1, size(value) + value_proxy = value(i)%get_proxy() + ! We add a '%' here to avoid a potential name clash if + ! the user should have a vector field 'a' (which is now stored + ! as a%1, a%2, ...), and a field 'a1' + write(number, '("%",i0)') i + call this%PreDeclareVariable(name//trim(number), value_proxy%data) + enddo + + end subroutine DeclareFieldVector_r{{prec}} + + ! ------------------------------------------------------------------------- + !> @brief This subroutine writes an LFRic real-valued {{prec}}-bit field vector to + !! the NetCDF file. Each component is stored as an individual variable using + !! the corresponding array function of the base class. + !! @param[in,out] this The instance of the extract_PSyDataType. + !! @param[in] name The name of the variable (string). + !! @param[in] value The value of the variable. + subroutine WriteFieldVector_r{{prec}}(this, name, value) + + use field_real{{prec}}_mod, only : field_real{{prec}}_type, field_real{{prec}}_proxy_type + + implicit none + + class(extract_PSyDataType), intent(inout), target :: this + character(*), intent(in) :: name + type(field_real{{prec}}_type), dimension(:), intent(in) :: value + + integer :: i + type(field_real{{prec}}_proxy_type) :: value_proxy + character(9) :: number + + ! Provide each dimension of the vector as an individual 1D array. + do i = 1, size(value, 1) + value_proxy = value(i)%get_proxy() + write(number, '("%",i0)') i + call this%ProvideVariable(name//trim(number), value_proxy%data) + enddo + + end subroutine WriteFieldVector_r{{prec}} + + {% endfor %} + + ! ------------------------------------------------------------------------- + !> @brief This subroutine declares an LFRic field with integer-valued data. + !! It calls the PreDeclareVariable function provided by the base class + !! (depending on the type of the argument, e.g. it might call + !! DeclareArray1dInt). + !! @param[in,out] this The instance of the extract_PSyDataType. + !! @param[in] name The name of the variable (string). + !! @param[in] value The value of the variable. + subroutine DeclareIntField(this, name, value) + + use integer_field_mod, only : integer_field_type, & + integer_field_proxy_type + + implicit none + + class(extract_PSyDataType), intent(inout), target :: this + character(*), intent(in) :: name + type(integer_field_type), intent(in) :: value + + type(integer_field_proxy_type) :: value_proxy + + value_proxy = value%get_proxy() + call this%PreDeclareVariable(name, value_proxy%data) + + end subroutine DeclareIntField + + ! ------------------------------------------------------------------------- + !> @brief This subroutine writes the values of an LFRic integer-valued field. + !! to the NetCDF file. It uses the corresponding function + !! provided by the base class. + !! @param[in,out] this The instance of the extract_PSyDataType. + !! @param[in] name The name of the variable (string). + !! @param[in] value The value of the variable. + subroutine WriteIntField(this, name, value) + + use integer_field_mod, only : integer_field_type, & + integer_field_proxy_type + + implicit none + + class(extract_PSyDataType), intent(inout), target :: this + character(*), intent(in) :: name + type(integer_field_type), intent(in) :: value + + type(integer_field_proxy_type) :: value_proxy + + value_proxy = value%get_proxy() + call this%ProvideVariable(name, value_proxy%data) + + end subroutine WriteIntField + + ! ------------------------------------------------------------------------- + !> @brief This subroutine declares an LFRic integer-valued field vector. Each + !! component of the vector is stored as a separate variable, using the + !! corresponding array function of the base class. + !! @param[in,out] this The instance of the extract_PSyDataType. + !! @param[in] name The name of the variable (string). + !! @param[in] value The value of the variable. + subroutine DeclareIntFieldVector(this, name, value) + + use integer_field_mod, only : integer_field_type, & + integer_field_proxy_type + + implicit none + + class(extract_PSyDataType), intent(inout), target :: this + character(*), intent(in) :: name + type(integer_field_type), dimension(:), intent(in) :: value + + integer :: i + type(integer_field_proxy_type) :: value_proxy + character(9) :: number + + ! Provide each component of the vector as an individual 1D array. + ! The base class will re-allocate internal array sizes if required. + do i = 1, size(value) + value_proxy = value(i)%get_proxy() + ! We add a '%' here to avoid a potential name clash if + ! the user should have a vector field 'a' (which is now stored + ! as a%1, a%2, ...), and a field 'a1'. + write(number, '("%",i0)') i + call this%PreDeclareVariable(name//trim(number), value_proxy%data) + enddo + + end subroutine DeclareIntFieldVector + +! ------------------------------------------------------------------------- + !> @brief This subroutine writes an LFRic integer-valued field vector to the + !! NetCDF file. Each component is stored as an individual variable + !! using the corresponding array function of the base class. + !! @param[in,out] this The instance of the extract_PSyDataType. + !! @param[in] name The name of the variable (string). + !! @param[in] value The value of the variable. + subroutine WriteIntFieldVector(this, name, value) + + use integer_field_mod, only : integer_field_type, & + integer_field_proxy_type + + implicit none + + class(extract_PSyDataType), intent(inout), target :: this + character(*), intent(in) :: name + type(integer_field_type), dimension(:), intent(in) :: value + + integer :: i + type(integer_field_proxy_type) :: value_proxy + character(9) :: number + + ! Provide each dimension of the vector as an individual 1D array. + do i = 1, size(value, 1) + value_proxy = value(i)%get_proxy() + write(number, '("%",i0)') i + call this%ProvideVariable(name//trim(number), value_proxy%data) + enddo + + end subroutine WriteIntFieldVector + +end module extract_psy_data_mod From 68b4925889e4cedff9497522d2b993bfdcce9a77 Mon Sep 17 00:00:00 2001 From: Joerg Henrichs Date: Fri, 31 Jan 2025 12:50:11 +1100 Subject: [PATCH 03/15] #2878 Support long ints for LFRic (just in case). --- lib/extract/netcdf/lfric/Makefile | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/extract/netcdf/lfric/Makefile b/lib/extract/netcdf/lfric/Makefile index 058c779361..76d3e4c5fc 100644 --- a/lib/extract/netcdf/lfric/Makefile +++ b/lib/extract/netcdf/lfric/Makefile @@ -71,7 +71,7 @@ LFRIC_INCLUDE_FLAGS += $$(nf-config --fflags) PSYDATA_LIB_NAME = _extract PSYDATA_LIB = lib$(PSYDATA_LIB_NAME).a -PROCESS_ARGS = -prefix=extract_ -types=char,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 From d24acd5e0344658d6586ad694209458cb36a4f34 Mon Sep 17 00:00:00 2001 From: Joerg Henrichs Date: Fri, 31 Jan 2025 12:50:50 +1100 Subject: [PATCH 04/15] #2878 Remove unused variables and mappings. --- lib/extract/netcdf/read_kernel_data_mod.jinja | 7 ------- 1 file changed, 7 deletions(-) diff --git a/lib/extract/netcdf/read_kernel_data_mod.jinja b/lib/extract/netcdf/read_kernel_data_mod.jinja index 1e04f3ae31..6346f1bf17 100644 --- a/lib/extract/netcdf/read_kernel_data_mod.jinja +++ b/lib/extract/netcdf/read_kernel_data_mod.jinja @@ -187,14 +187,7 @@ contains end subroutine OpenReadFilename -{# This defines a mapping of the 'userfriendly' names to the NetCDF data types. #} -{% set NCDF_TYPE_MAPPING = { "Double": "NF90_DOUBLE", - "Real": "NF90_REAL", - "Logical":"NF90_INT", - "Int": "NF90_INT"} -%} - {% for name, type in ALL_TYPES %} - {% set NETCDF_TYPE = NCDF_TYPE_MAPPING[name] %} ! ------------------------------------------------------------------------- !> @brief This subroutine reads the value of a scalar {{type}} From acb6ca1c70ba6b26e16c132780ceee9e774ea5f7 Mon Sep 17 00:00:00 2001 From: Joerg Henrichs Date: Mon, 3 Feb 2025 11:18:40 +1100 Subject: [PATCH 05/15] #2878 Add some support for dependency analysis involving array ranges. --- src/psyclone/psyir/tools/dependency_tools.py | 49 +++++++++++++- .../psyir/tools/dependency_tools_test.py | 66 ++++++++++++++++++- 2 files changed, 113 insertions(+), 2 deletions(-) diff --git a/src/psyclone/psyir/tools/dependency_tools.py b/src/psyclone/psyir/tools/dependency_tools.py index e29e4b87a0..c0380d2814 100644 --- a/src/psyclone/psyir/tools/dependency_tools.py +++ b/src/psyclone/psyir/tools/dependency_tools.py @@ -48,7 +48,7 @@ from psyclone.errors import InternalError, LazyString from psyclone.psyir.backend.sympy_writer import SymPyWriter from psyclone.psyir.backend.visitor import VisitorError -from psyclone.psyir.nodes import Loop +from psyclone.psyir.nodes import Loop, Node, Range # pylint: disable=too-many-lines @@ -281,6 +281,50 @@ def _partition(comp_ind1, comp_ind2, loop_variables): return partition_infos + # ------------------------------------------------------------------------- + @staticmethod + def _ranges_overlap(range1: Node, + range2: Node) -> bool: + '''This function tests if two ranges overlap. It also accepts a simple + index as 'range' (e.g. just `i`), which will be converted into `i:i:1` + before comparing. At this stage, this function simple checks if one of + the ranges starts after the other (e.g. 1:3, and 5:7). It will handle + unspecified ranges (":"), and will report an overlap. + Additional tests e.g. using the step value are not yet implemented + (e.g. 1:10:2 and 2:10:2 will not overlap, but this will not be + detected atm). + + :param range1: The first range or expression. + :param range2: The second range or expression. + + :returns: whether the ranges (or an index expression with a range) + overlap or not + + ''' + if not isinstance(range1, Range): + # Not a range, must be some index `i`. Create a range `i:i:1` + range1 = Range.create(range1.copy(), range1.copy()) + if not isinstance(range2, Range): + # Not a range, must be some index `i`. Create a range `i:i:1` + range2 = Range.create(range2.copy(), range2.copy()) + + sm = SymbolicMaths.get() + + # Check if the first range is smaller than the second one, e.g.: + # 1:3:1 and 4:6:1 + if sm.greater_than(range2.start, range1.stop) == sm.Fuzzy.TRUE: + # The first range is before the second range, so no overlap + return False + # Check if the second range is smaller than the first one, e.g.: + # 4:6:1 and 1:3:1 + if sm.greater_than(range1.start, range2.stop) == sm.Fuzzy.TRUE: + # The second range is before the first range, so no overlap + return False + + # We could do additional tests here, e.g. including step to determine + # that 1:10:2 does not overlap with 2:10:2 + return True + # ------------------------------------------------------------------------- @staticmethod def _independent_0_var(index_exp1, index_exp2): @@ -296,6 +340,9 @@ def _independent_0_var(index_exp1, index_exp2): :type index_exp2: :py:class:`psyclone.psyir.nodes.Node` ''' + if isinstance(index_exp1, Range) or isinstance(index_exp2, Range): + return not DependencyTools._ranges_overlap(index_exp1, index_exp2) + sym_maths = SymbolicMaths.get() # If the indices can be shown to be never equal, the accesses diff --git a/src/psyclone/tests/psyir/tools/dependency_tools_test.py b/src/psyclone/tests/psyir/tools/dependency_tools_test.py index 8c4e28995f..a0eff77f40 100644 --- a/src/psyclone/tests/psyir/tools/dependency_tools_test.py +++ b/src/psyclone/tests/psyir/tools/dependency_tools_test.py @@ -41,7 +41,7 @@ from psyclone.configuration import Config from psyclone.core import AccessType, Signature, VariablesAccessInfo from psyclone.errors import InternalError -from psyclone.psyir.nodes import Loop +from psyclone.psyir.nodes import Assignment, Loop from psyclone.psyir.tools import DependencyTools, DTCode from psyclone.tests.utilities import get_invoke @@ -1107,3 +1107,67 @@ def test_fuse_dimension_change(fortran_reader): "in different index locations: s%comp1(jj)%comp2(ji) and " "s%comp1(ji)%comp2(jj)." in str(msg)) + + +# ---------------------------------------------------------------------------- +@pytest.mark.parametrize("range1, range2, overlap", + [("1:3", "4:6", False), + ("3:9", "-1:-3", False), + ("1:3", "4", False), + ("5", "-1:-3", False), + ("i:i+3", "i+5:i+7", False), + ("i:i+3", "i+2", True), + ("i:i+3", "i+5", False), + ("i:i+3", "i-1", False), + (":", "1", True), + (":", "i", True), + ("::", "1", True), + ("::", "i", True), + ("1", ":", True), + ("i", ":", True), + ]) +def test_ranges_overlap(range1, range2, overlap, fortran_reader): + '''Test the detection of overlapping ranges. + ''' + source = f'''program test + integer i, ji, inbj + integer, parameter :: jpi=5, jpj=10 + real, dimension(jpi,jpi) :: ldisoce + + ldisoce({range1},{range2}) = 1.0 + end program test''' + + psyir = fortran_reader.psyir_from_source(source) + dep_tools = DependencyTools() + assign = psyir.walk(Assignment)[0] + r1 = assign.lhs.children[0] + r2 = assign.lhs.children[1] + assert dep_tools._ranges_overlap(r1, r2) == overlap + # Also make sure that _independent_0_var handles this correctly: + assert dep_tools._independent_0_var(r1, r2) is not overlap + + +# ---------------------------------------------------------------------------- +def test_nemo_example_ranges(fortran_reader): + '''Tests an actual NEMO example + ''' + source = '''program test + integer ji, inbj + integer, parameter :: jpi=5, jpj=10 + real, dimension(jpi,jpi) :: ldisoce + do jj = 1, inbj, 1 + if (COUNT(ldisoce(:,jj)) == 0) then + ldisoce(1,jj) = .true. + end if + enddo + end program test''' + + psyir = fortran_reader.psyir_from_source(source) + loops = psyir.children[0].children[0] + dep_tools = DependencyTools() + + # This loop can be parallelised because all instances of ldisoce use + # the index jj in position 2 (the overlap between ":" and "1" + # is tested in test_ranges_overlap above, here we check that this + # overlap is indeed ignored because of the jj index). + assert dep_tools.can_loop_be_parallelised(loops) From a4f0773d0194fab02a5676ad45a290c482780e33 Mon Sep 17 00:00:00 2001 From: Joerg Henrichs Date: Tue, 25 Feb 2025 10:45:48 +1100 Subject: [PATCH 06/15] #2878 Updated documentation. --- doc/user_guide/psyke.rst | 37 +++++++++++++++++++++---------------- 1 file changed, 21 insertions(+), 16 deletions(-) diff --git a/doc/user_guide/psyke.rst b/doc/user_guide/psyke.rst index 2132429cdb..54ecce541b 100644 --- a/doc/user_guide/psyke.rst +++ b/doc/user_guide/psyke.rst @@ -529,10 +529,10 @@ Therefore, compilation for a created driver, e.g. the one created in $ gfortran -g -O0 driver-main-update.F90 -o driver-main-update $ ./driver-main-update - Variable max_abs max_rel l2_diff l2_cos identical #rel<1E-9 #rel<1E-6 #rel<1E-3 - cell .0000000E+00 .0000000E+00 .0000000E+00 .1000000E+01 .1000000E+01 .0000000E+00 .0000000E+00 .0000000E+00 - field1_data .0000000E+00 .0000000E+00 .0000000E+00 .1000000E+01 .5390000E+03 .0000000E+00 .0000000E+00 .0000000E+00 - dummy_var1 .0000000E+00 .0000000E+00 .0000000E+00 .1000000E+01 .1000000E+01 .0000000E+00 .0000000E+00 .0000000E+00 + Variable count identical #rel<1E-9 #rel<1E-6 #rel<1E-3 #rel>=1E-3 max_abs max_rel l2_diff l2_cos + cell 1 1 0 0 0 0 .0000000E+00 .0000000E+00 .0000000E+00 .1000000E+01 + field1_data 539 539 0 0 0 0 .0000000E+00 .0000000E+00 .0000000E+00 .1000000E+01 + dummy_var1 1 1 0 0 0 0 .0000000E+00 .0000000E+00 .0000000E+00 .1000000E+01 (see :ref:`driver_summary_statistics` for details about the statistics`). Note that the Makefile in the example will actually provide additional include @@ -587,10 +587,10 @@ by changing the compilation options, or compiler version. Example output: .. code-block:: output - Variable max_abs max_rel l2_diff l2_cos identical #rel<1E-9 #rel<1E-6 #rel<1E-3 - cell .0000000E+00 .0000000E+00 .0000000E+00 .1000000E+01 .1000000E+01 .0000000E+00 .0000000E+00 .0000000E+00 - field1_data .0000000E+00 .0000000E+00 .0000000E+00 .1000000E+01 .5390000E+03 .0000000E+00 .0000000E+00 .0000000E+00 - dummy_var1 .0000000E+00 .0000000E+00 .0000000E+00 .1000000E+01 .1000000E+01 .0000000E+00 .0000000E+00 .0000000E+00 + Variable count identical #rel<1E-9 #rel<1E-6 #rel<1E-3 #rel>=1E-3 max_abs max_rel l2_diff l2_cos + cell 1 1 0 0 0 0 .0000000E+00 .0000000E+00 .0000000E+00 .1000000E+01 + field1_data 539 539 0 0 0 0 .0000000E+00 .0000000E+00 .0000000E+00 .1000000E+01 + dummy_var1 1 1 0 0 0 0 .0000000E+00 .0000000E+00 .0000000E+00 .1000000E+01 The columns from left to right are: @@ -606,28 +606,33 @@ The columns from left to right are: .. only:: latex or has_dvipng * The variable name. + * The number of elements for this variable (i.e. 1 for scalar). + * How many values are identical. + * How many values have a relative error of less than 10\ :sup:`-9` but are not identical. Note that + single precision variables typically do not have enough significant digits to have an error of 10\ :sup:`-9`. + * How many values have a relative error of less than 10\ :sup:`-6` but more than 10\ :sup:`-9`. + * How many values have a relative error of less than 10\ :sup:`-3` but more than 10\ :sup:`-6`. + * How many values have a relative error of more than 10\ :sup:`-3`. * The maximum absolute error of all elements. * The maximum relative error of all elements. If an element has the value 0, the relative error for this element is considered to be 1.0. * The L2 difference: :math:`\sqrt{\sum{(original-new)^2}}`. * The cosine of the angle between the two vectors: :math:`\frac{\sum{original*new}}{\sqrt{\sum{original*original}}*\sqrt{\sum{new*new}}}`. - * How many values are identical. - * How many values have a relative error of less than 10\ :sup:`-9` but are not identical. - * How many values have a relative error of less than 10\ :sup:`-6` but more than 10\ :sup:`-9`. - * How many values have a relative error of less than 10\ :sup:`-3` but more than 10\ :sup:`-6`. .. only:: html and not has_dvipng * The variable name. + * The number of elements for this variable (i.e. 1 for scalar). + * How many values are identical. + * How many values have a relative error of less than 10\ :sup:`-9` but are not identical. Note that + single precision variables typically do not have enough significant digits to have an error of 10\ :sup:`-9`. + * How many values have a relative error of less than 10\ :sup:`-6` but more than 10\ :sup:`-9`. + * How many values have a relative error of less than 10\ :sup:`-3` but more than 10\ :sup:`-6`. * The maximum absolute error of all elements. * The maximum relative error of all elements. If an element has the value 0, the relative error for this element is considered to be 1.0. * The L2 difference: `sqrt(sum((original-new)`\ :sup:`2` `))`. * The cosine of the angle between the two vectors: `sum(original*new)/(sqrt(sum(original*original))*sqrt(sum(new*new)))`. - * How many values are identical. - * How many values have a relative error of less than 10\ :sup:`-9` but are not identical. - * How many values have a relative error of less than 10\ :sup:`-6` but more than 10\ :sup:`-9`. - * How many values have a relative error of less than 10\ :sup:`-3` but more than 10\ :sup:`-6`. .. note:: The usefulness of the columns printed is still being evaluated. Early indications are that the cosine of the angle between the two vectors, From 2f307f5d50e7a35153a70510ab74c1b0a5118f2b Mon Sep 17 00:00:00 2001 From: Joerg Henrichs Date: Tue, 25 Feb 2025 12:12:44 +1100 Subject: [PATCH 07/15] #2878 Fixed incorrect computation of number of errors, and added two more fields. Improved output format. --- lib/extract/compare_variables_mod.jinja | 55 ++++++++++++++----------- 1 file changed, 32 insertions(+), 23 deletions(-) diff --git a/lib/extract/compare_variables_mod.jinja b/lib/extract/compare_variables_mod.jinja index 6329b43545..18ffadfd92 100644 --- a/lib/extract/compare_variables_mod.jinja +++ b/lib/extract/compare_variables_mod.jinja @@ -74,16 +74,18 @@ module compare_variables_mod use, intrinsic :: iso_fortran_env, only : real64, stderr => Error_Unit implicit None - integer, parameter :: MAX_ABS_ERROR = 1 - integer, parameter :: MAX_REL_ERROR = 2 - integer, parameter :: L2_DIFF = 3 - integer, parameter :: L2_COS_SIMILAR = 4 - integer, parameter :: count_0 = 5 ! No error - integer, parameter :: count_neg_9 = 6 ! 10^-9 > rel error > 0 - integer, parameter :: count_neg_6 = 7 ! 10^-6 > rel error >=10^-9 - integer, parameter :: count_neg_3 = 8 ! 10^-3 > rel error >=10^-6 - - integer, parameter :: NUM_RESULTS = 8 + integer, parameter :: COUNT_ALL = 1 + integer, parameter :: COUNT_0 = 2 ! No error + integer, parameter :: COUNT_NEG_9 = 3 ! 10^-9 > rel error > 0 + integer, parameter :: COUNT_NEG_6 = 4 ! 10^-6 > rel error >=10^-9 + integer, parameter :: COUNT_NEG_3 = 5 ! 10^-3 > rel error >=10^-6 + integer, parameter :: COUNT_LARGER = 6 ! rel error >=10^-3 + integer, parameter :: MAX_ABS_ERROR = 7 + integer, parameter :: MAX_REL_ERROR = 8 + integer, parameter :: L2_DIFF = 9 + integer, parameter :: L2_COS_SIMILAR = 10 + + integer, parameter :: NUM_RESULTS = 10 integer, parameter :: MAX_STRING_LENGTH=512 character(MAX_STRING_LENGTH), dimension(:), allocatable :: all_names @@ -141,14 +143,16 @@ contains enddo write(out_format, "('(A',I0)" ) max_name_len - write(*,out_format//",8A13)") "Variable", "max_abs", "max_rel",& - "l2_diff", "l2_cos", "identical", "#rel<1E-9", "#rel<1E-6", "#rel<1E-3" + write(*,out_format//",10A13)") "Variable", "count", "identical", & + "#rel<1E-9", "#rel<1E-6", "#rel<1E-3", "#rel>=1E-3", & + "max_abs", "max_rel", "l2_diff", "l2_cos" - out_format = trim(out_format)//"' ',8(E12.7,' '))" + out_format = trim(out_format)//"' ',6(I12, ' '),4(E12.7,' '))" ! Then write out the results for each variable: do i=1, current_index - write(*,out_format) trim(all_names(i)), all_results(i,:) + write(*,out_format) trim(all_names(i)), int(all_results(i,1:6)), & + all_results(i,7:) enddo end subroutine compare_summary @@ -181,6 +185,7 @@ contains current_index = current_index + 1 all_names(current_index) = name all_results(current_index,:) = 0.0 + all_results(current_index,COUNT_ALL) = 1.0 if (value {{EQUAL}} correct_value) then ! All other values have already been initialised with 0 all_results(current_Index, L2_COS_SIMILAR) = 1 @@ -192,7 +197,7 @@ contains all_results(current_index, L2_DIFF ) = 1.0 all_results(current_index, L2_COS_SIMILAR) = 0.0 all_results(current_index, MAX_REL_ERROR ) = 1.0 - all_results(current_Index, COUNT_NEG_3 ) = 1 + all_results(current_Index, COUNT_LARGER ) = 1 {% else %} all_results(current_index, MAX_ABS_ERROR ) = correct_value - value if (correct_value /= 0) then @@ -254,6 +259,7 @@ contains current_index = current_index + 1 all_names(current_index) = name all_results(current_index,:) = 0.0 + all_results(current_index, COUNT_ALL) = size(values) if (all(values {{EQUAL}} correct_values)) then ! All values correct. Notice that all results are already initialised ! to 0, so only set the non-zero values here: @@ -287,7 +293,7 @@ contains sum(double_values*double_correct) & / sqrt(real(sum(double_values*double_values))) & / sqrt(real(sum(double_correct*double_correct))) - all_results(current_index, count_0) = count(tmp == 0.0d0) + all_results(current_index, COUNT_0) = count(tmp == 0.0d0) where(double_correct /= 0) tmp = abs(tmp/double_correct) @@ -295,13 +301,16 @@ contains tmp = -1 endwhere all_results(current_index, MAX_REL_ERROR) = maxval(tmp) - all_results(current_index, COUNT_NEG_3) = count(tmp > 1.0d-3) - ! Count elements >10^-6, and subtract the ones larger than 10^-3 - all_results(current_index, COUNT_NEG_6) = count(tmp > 1.0d-6) & - - all_results(current_Index, COUNT_NEG_3) - all_results(current_index, COUNT_NEG_9) = count(tmp > 1.0d-9) & - - all_results(current_Index, COUNT_NEG_6) - + all_results(current_index, COUNT_LARGER) = count(tmp >= 1.0d-3) + all_results(current_index, COUNT_NEG_9) = count(tmp < 1.0d-9) & + - all_results(current_Index, COUNT_0) + all_results(current_index, COUNT_NEG_6) = count(tmp < 1.0d-6) & + - all_results(current_Index, COUNT_NEG_9) & + - all_results(current_Index, COUNT_0) + all_results(current_index, COUNT_NEG_3) = count(tmp < 1.0d-3) & + - all_results(current_Index, COUNT_NEG_9) & + - all_results(current_Index, COUNT_NEG_6) & + - all_results(current_Index, COUNT_0) endif end subroutine Compare_array_{{dim}}d{{name}} From cc83c719682b511919d1612e4aa101adda19490a Mon Sep 17 00:00:00 2001 From: Joerg Henrichs Date: Tue, 25 Feb 2025 12:17:04 +1100 Subject: [PATCH 08/15] #2878 Added compile&runtime test for compare library. --- lib/extract/Makefile | 20 +- .../lfric/compare_variables_mod.F90 | 441 +++++++++++------- 2 files changed, 282 insertions(+), 179 deletions(-) diff --git a/lib/extract/Makefile b/lib/extract/Makefile index e38eea484d..2b8ddcec16 100644 --- a/lib/extract/Makefile +++ b/lib/extract/Makefile @@ -52,16 +52,29 @@ PSYDATA_LIB_DIR ?= ./.. # the listed data types and scalar and 2-dimensional arrays. Note that # domain-specific implementation will create their own version with different # number of dimensions if required. -PROCESS_ARGS = -types=char,int,long,logical,real,double -dims=2 +PROCESS_ARGS = -types=char,int,long,logical,real,double -dims=1,2,3,4 PROCESS = $$($(PSYDATA_LIB_DIR)/get_python.sh) $(PSYDATA_LIB_DIR)/process.py -.PHONY: all compare +.PHONY: all compare test compare: compare_variables_mod.o +test_compare: compare_variables_mod.o test_compare.o + $(F90) $(F90FLAGS) $^ -o $@ + +make test: test_compare + # Check all the counts only, to avoid that floating point + # differences invalidate this test. + ./test_compare | grep "a_dbl *15 *1 *2 *3 *4 *5" > /dev/null + ./test_compare | grep "a_single *10 *1 *0 *2 *3 *4" > /dev/null + ./test_compare | grep "a_int *15 *1 *2 *3 *4 *5" > /dev/null + %.o: %.F90 $(F90) -c $(F90FLAGS) $< +%.o: %.f90 + $(F90) -c $(F90FLAGS) $< + # ------------------------------------------------ compare_variables_mod.F90: compare_variables_mod.jinja Makefile $(PROCESS) $(PROCESS_ARGS) $< > compare_variables_mod.F90 @@ -73,4 +86,5 @@ all: compare clean: rm -f compare_variables_mod.mod compare_variables_mod.o \ - compare_variables_mod.F90 + compare_variables_mod.F90 test_compare.mod test_compare.o \ + test_compare diff --git a/lib/extract/standalone/lfric/compare_variables_mod.F90 b/lib/extract/standalone/lfric/compare_variables_mod.F90 index aa6f228bbd..11f44eadc0 100644 --- a/lib/extract/standalone/lfric/compare_variables_mod.F90 +++ b/lib/extract/standalone/lfric/compare_variables_mod.F90 @@ -45,16 +45,18 @@ module compare_variables_mod use, intrinsic :: iso_fortran_env, only : real64, stderr => Error_Unit implicit None - integer, parameter :: MAX_ABS_ERROR = 1 - integer, parameter :: MAX_REL_ERROR = 2 - integer, parameter :: L2_DIFF = 3 - integer, parameter :: L2_COS_SIMILAR = 4 - integer, parameter :: count_0 = 5 ! No error - integer, parameter :: count_neg_9 = 6 ! 10^-9 > rel error > 0 - integer, parameter :: count_neg_6 = 7 ! 10^-6 > rel error >=10^-9 - integer, parameter :: count_neg_3 = 8 ! 10^-3 > rel error >=10^-6 - - integer, parameter :: NUM_RESULTS = 8 + integer, parameter :: COUNT_ALL = 1 + integer, parameter :: COUNT_0 = 2 ! No error + integer, parameter :: COUNT_NEG_9 = 3 ! 10^-9 > rel error > 0 + integer, parameter :: COUNT_NEG_6 = 4 ! 10^-6 > rel error >=10^-9 + integer, parameter :: COUNT_NEG_3 = 5 ! 10^-3 > rel error >=10^-6 + integer, parameter :: COUNT_LARGER = 6 ! rel error >=10^-3 + integer, parameter :: MAX_ABS_ERROR = 7 + integer, parameter :: MAX_REL_ERROR = 8 + integer, parameter :: L2_DIFF = 9 + integer, parameter :: L2_COS_SIMILAR = 10 + + integer, parameter :: NUM_RESULTS = 10 integer, parameter :: MAX_STRING_LENGTH=512 character(MAX_STRING_LENGTH), dimension(:), allocatable :: all_names @@ -128,14 +130,16 @@ subroutine compare_summary() enddo write(out_format, "('(A',I0)" ) max_name_len - write(*,out_format//",8A13)") "Variable", "max_abs", "max_rel",& - "l2_diff", "l2_cos", "identical", "#rel<1E-9", "#rel<1E-6", "#rel<1E-3" + write(*,out_format//",10A13)") "Variable", "count", "identical", & + "#rel<1E-9", "#rel<1E-6", "#rel<1E-3", "#rel>=1E-3", & + "max_abs", "max_rel", "l2_diff", "l2_cos" - out_format = trim(out_format)//"' ',8(E12.7,' '))" + out_format = trim(out_format)//"' ',6(I12, ' '),4(E12.7,' '))" ! Then write out the results for each variable: do i=1, current_index - write(*,out_format) trim(all_names(i)), all_results(i,:) + write(*,out_format) trim(all_names(i)), int(all_results(i,1:6)), & + all_results(i,7:) enddo end subroutine compare_summary @@ -161,6 +165,7 @@ subroutine compare_scalar_Char(name, value, correct_value) current_index = current_index + 1 all_names(current_index) = name all_results(current_index,:) = 0.0 + all_results(current_index,COUNT_ALL) = 1.0 if (value == correct_value) then ! All other values have already been initialised with 0 all_results(current_Index, L2_COS_SIMILAR) = 1 @@ -171,7 +176,7 @@ subroutine compare_scalar_Char(name, value, correct_value) all_results(current_index, L2_DIFF ) = 1.0 all_results(current_index, L2_COS_SIMILAR) = 0.0 all_results(current_index, MAX_REL_ERROR ) = 1.0 - all_results(current_Index, COUNT_NEG_3 ) = 1 + all_results(current_Index, COUNT_LARGER ) = 1 endif end subroutine compare_scalar_Char @@ -204,6 +209,7 @@ subroutine compare_array_1dChar(name, values, correct_values) current_index = current_index + 1 all_names(current_index) = name all_results(current_index,:) = 0.0 + all_results(current_index, COUNT_ALL) = size(values) if (all(values == correct_values)) then ! All values correct. Notice that all results are already initialised ! to 0, so only set the non-zero values here: @@ -227,7 +233,7 @@ subroutine compare_array_1dChar(name, values, correct_values) sum(double_values*double_correct) & / sqrt(real(sum(double_values*double_values))) & / sqrt(real(sum(double_correct*double_correct))) - all_results(current_index, count_0) = count(tmp == 0.0d0) + all_results(current_index, COUNT_0) = count(tmp == 0.0d0) where(double_correct /= 0) tmp = abs(tmp/double_correct) @@ -235,13 +241,16 @@ subroutine compare_array_1dChar(name, values, correct_values) tmp = -1 endwhere all_results(current_index, MAX_REL_ERROR) = maxval(tmp) - all_results(current_index, COUNT_NEG_3) = count(tmp > 1.0d-3) - ! Count elements >10^-6, and subtract the ones larger than 10^-3 - all_results(current_index, COUNT_NEG_6) = count(tmp > 1.0d-6) & - - all_results(current_Index, COUNT_NEG_3) - all_results(current_index, COUNT_NEG_9) = count(tmp > 1.0d-9) & - - all_results(current_Index, COUNT_NEG_6) - + all_results(current_index, COUNT_LARGER) = count(tmp >= 1.0d-3) + all_results(current_index, COUNT_NEG_9) = count(tmp < 1.0d-9) & + - all_results(current_Index, COUNT_0) + all_results(current_index, COUNT_NEG_6) = count(tmp < 1.0d-6) & + - all_results(current_Index, COUNT_NEG_9) & + - all_results(current_Index, COUNT_0) + all_results(current_index, COUNT_NEG_3) = count(tmp < 1.0d-3) & + - all_results(current_Index, COUNT_NEG_9) & + - all_results(current_Index, COUNT_NEG_6) & + - all_results(current_Index, COUNT_0) endif end subroutine Compare_array_1dChar @@ -273,6 +282,7 @@ subroutine compare_array_2dChar(name, values, correct_values) current_index = current_index + 1 all_names(current_index) = name all_results(current_index,:) = 0.0 + all_results(current_index, COUNT_ALL) = size(values) if (all(values == correct_values)) then ! All values correct. Notice that all results are already initialised ! to 0, so only set the non-zero values here: @@ -296,7 +306,7 @@ subroutine compare_array_2dChar(name, values, correct_values) sum(double_values*double_correct) & / sqrt(real(sum(double_values*double_values))) & / sqrt(real(sum(double_correct*double_correct))) - all_results(current_index, count_0) = count(tmp == 0.0d0) + all_results(current_index, COUNT_0) = count(tmp == 0.0d0) where(double_correct /= 0) tmp = abs(tmp/double_correct) @@ -304,13 +314,16 @@ subroutine compare_array_2dChar(name, values, correct_values) tmp = -1 endwhere all_results(current_index, MAX_REL_ERROR) = maxval(tmp) - all_results(current_index, COUNT_NEG_3) = count(tmp > 1.0d-3) - ! Count elements >10^-6, and subtract the ones larger than 10^-3 - all_results(current_index, COUNT_NEG_6) = count(tmp > 1.0d-6) & - - all_results(current_Index, COUNT_NEG_3) - all_results(current_index, COUNT_NEG_9) = count(tmp > 1.0d-9) & - - all_results(current_Index, COUNT_NEG_6) - + all_results(current_index, COUNT_LARGER) = count(tmp >= 1.0d-3) + all_results(current_index, COUNT_NEG_9) = count(tmp < 1.0d-9) & + - all_results(current_Index, COUNT_0) + all_results(current_index, COUNT_NEG_6) = count(tmp < 1.0d-6) & + - all_results(current_Index, COUNT_NEG_9) & + - all_results(current_Index, COUNT_0) + all_results(current_index, COUNT_NEG_3) = count(tmp < 1.0d-3) & + - all_results(current_Index, COUNT_NEG_9) & + - all_results(current_Index, COUNT_NEG_6) & + - all_results(current_Index, COUNT_0) endif end subroutine Compare_array_2dChar @@ -342,6 +355,7 @@ subroutine compare_array_3dChar(name, values, correct_values) current_index = current_index + 1 all_names(current_index) = name all_results(current_index,:) = 0.0 + all_results(current_index, COUNT_ALL) = size(values) if (all(values == correct_values)) then ! All values correct. Notice that all results are already initialised ! to 0, so only set the non-zero values here: @@ -365,7 +379,7 @@ subroutine compare_array_3dChar(name, values, correct_values) sum(double_values*double_correct) & / sqrt(real(sum(double_values*double_values))) & / sqrt(real(sum(double_correct*double_correct))) - all_results(current_index, count_0) = count(tmp == 0.0d0) + all_results(current_index, COUNT_0) = count(tmp == 0.0d0) where(double_correct /= 0) tmp = abs(tmp/double_correct) @@ -373,13 +387,16 @@ subroutine compare_array_3dChar(name, values, correct_values) tmp = -1 endwhere all_results(current_index, MAX_REL_ERROR) = maxval(tmp) - all_results(current_index, COUNT_NEG_3) = count(tmp > 1.0d-3) - ! Count elements >10^-6, and subtract the ones larger than 10^-3 - all_results(current_index, COUNT_NEG_6) = count(tmp > 1.0d-6) & - - all_results(current_Index, COUNT_NEG_3) - all_results(current_index, COUNT_NEG_9) = count(tmp > 1.0d-9) & - - all_results(current_Index, COUNT_NEG_6) - + all_results(current_index, COUNT_LARGER) = count(tmp >= 1.0d-3) + all_results(current_index, COUNT_NEG_9) = count(tmp < 1.0d-9) & + - all_results(current_Index, COUNT_0) + all_results(current_index, COUNT_NEG_6) = count(tmp < 1.0d-6) & + - all_results(current_Index, COUNT_NEG_9) & + - all_results(current_Index, COUNT_0) + all_results(current_index, COUNT_NEG_3) = count(tmp < 1.0d-3) & + - all_results(current_Index, COUNT_NEG_9) & + - all_results(current_Index, COUNT_NEG_6) & + - all_results(current_Index, COUNT_0) endif end subroutine Compare_array_3dChar @@ -411,6 +428,7 @@ subroutine compare_array_4dChar(name, values, correct_values) current_index = current_index + 1 all_names(current_index) = name all_results(current_index,:) = 0.0 + all_results(current_index, COUNT_ALL) = size(values) if (all(values == correct_values)) then ! All values correct. Notice that all results are already initialised ! to 0, so only set the non-zero values here: @@ -434,7 +452,7 @@ subroutine compare_array_4dChar(name, values, correct_values) sum(double_values*double_correct) & / sqrt(real(sum(double_values*double_values))) & / sqrt(real(sum(double_correct*double_correct))) - all_results(current_index, count_0) = count(tmp == 0.0d0) + all_results(current_index, COUNT_0) = count(tmp == 0.0d0) where(double_correct /= 0) tmp = abs(tmp/double_correct) @@ -442,13 +460,16 @@ subroutine compare_array_4dChar(name, values, correct_values) tmp = -1 endwhere all_results(current_index, MAX_REL_ERROR) = maxval(tmp) - all_results(current_index, COUNT_NEG_3) = count(tmp > 1.0d-3) - ! Count elements >10^-6, and subtract the ones larger than 10^-3 - all_results(current_index, COUNT_NEG_6) = count(tmp > 1.0d-6) & - - all_results(current_Index, COUNT_NEG_3) - all_results(current_index, COUNT_NEG_9) = count(tmp > 1.0d-9) & - - all_results(current_Index, COUNT_NEG_6) - + all_results(current_index, COUNT_LARGER) = count(tmp >= 1.0d-3) + all_results(current_index, COUNT_NEG_9) = count(tmp < 1.0d-9) & + - all_results(current_Index, COUNT_0) + all_results(current_index, COUNT_NEG_6) = count(tmp < 1.0d-6) & + - all_results(current_Index, COUNT_NEG_9) & + - all_results(current_Index, COUNT_0) + all_results(current_index, COUNT_NEG_3) = count(tmp < 1.0d-3) & + - all_results(current_Index, COUNT_NEG_9) & + - all_results(current_Index, COUNT_NEG_6) & + - all_results(current_Index, COUNT_0) endif end subroutine Compare_array_4dChar @@ -472,6 +493,7 @@ subroutine compare_scalar_Int(name, value, correct_value) current_index = current_index + 1 all_names(current_index) = name all_results(current_index,:) = 0.0 + all_results(current_index,COUNT_ALL) = 1.0 if (value == correct_value) then ! All other values have already been initialised with 0 all_results(current_Index, L2_COS_SIMILAR) = 1 @@ -524,6 +546,7 @@ subroutine compare_array_1dInt(name, values, correct_values) current_index = current_index + 1 all_names(current_index) = name all_results(current_index,:) = 0.0 + all_results(current_index, COUNT_ALL) = size(values) if (all(values == correct_values)) then ! All values correct. Notice that all results are already initialised ! to 0, so only set the non-zero values here: @@ -543,7 +566,7 @@ subroutine compare_array_1dInt(name, values, correct_values) sum(double_values*double_correct) & / sqrt(real(sum(double_values*double_values))) & / sqrt(real(sum(double_correct*double_correct))) - all_results(current_index, count_0) = count(tmp == 0.0d0) + all_results(current_index, COUNT_0) = count(tmp == 0.0d0) where(double_correct /= 0) tmp = abs(tmp/double_correct) @@ -551,13 +574,16 @@ subroutine compare_array_1dInt(name, values, correct_values) tmp = -1 endwhere all_results(current_index, MAX_REL_ERROR) = maxval(tmp) - all_results(current_index, COUNT_NEG_3) = count(tmp > 1.0d-3) - ! Count elements >10^-6, and subtract the ones larger than 10^-3 - all_results(current_index, COUNT_NEG_6) = count(tmp > 1.0d-6) & - - all_results(current_Index, COUNT_NEG_3) - all_results(current_index, COUNT_NEG_9) = count(tmp > 1.0d-9) & - - all_results(current_Index, COUNT_NEG_6) - + all_results(current_index, COUNT_LARGER) = count(tmp >= 1.0d-3) + all_results(current_index, COUNT_NEG_9) = count(tmp < 1.0d-9) & + - all_results(current_Index, COUNT_0) + all_results(current_index, COUNT_NEG_6) = count(tmp < 1.0d-6) & + - all_results(current_Index, COUNT_NEG_9) & + - all_results(current_Index, COUNT_0) + all_results(current_index, COUNT_NEG_3) = count(tmp < 1.0d-3) & + - all_results(current_Index, COUNT_NEG_9) & + - all_results(current_Index, COUNT_NEG_6) & + - all_results(current_Index, COUNT_0) endif end subroutine Compare_array_1dInt @@ -589,6 +615,7 @@ subroutine compare_array_2dInt(name, values, correct_values) current_index = current_index + 1 all_names(current_index) = name all_results(current_index,:) = 0.0 + all_results(current_index, COUNT_ALL) = size(values) if (all(values == correct_values)) then ! All values correct. Notice that all results are already initialised ! to 0, so only set the non-zero values here: @@ -608,7 +635,7 @@ subroutine compare_array_2dInt(name, values, correct_values) sum(double_values*double_correct) & / sqrt(real(sum(double_values*double_values))) & / sqrt(real(sum(double_correct*double_correct))) - all_results(current_index, count_0) = count(tmp == 0.0d0) + all_results(current_index, COUNT_0) = count(tmp == 0.0d0) where(double_correct /= 0) tmp = abs(tmp/double_correct) @@ -616,13 +643,16 @@ subroutine compare_array_2dInt(name, values, correct_values) tmp = -1 endwhere all_results(current_index, MAX_REL_ERROR) = maxval(tmp) - all_results(current_index, COUNT_NEG_3) = count(tmp > 1.0d-3) - ! Count elements >10^-6, and subtract the ones larger than 10^-3 - all_results(current_index, COUNT_NEG_6) = count(tmp > 1.0d-6) & - - all_results(current_Index, COUNT_NEG_3) - all_results(current_index, COUNT_NEG_9) = count(tmp > 1.0d-9) & - - all_results(current_Index, COUNT_NEG_6) - + all_results(current_index, COUNT_LARGER) = count(tmp >= 1.0d-3) + all_results(current_index, COUNT_NEG_9) = count(tmp < 1.0d-9) & + - all_results(current_Index, COUNT_0) + all_results(current_index, COUNT_NEG_6) = count(tmp < 1.0d-6) & + - all_results(current_Index, COUNT_NEG_9) & + - all_results(current_Index, COUNT_0) + all_results(current_index, COUNT_NEG_3) = count(tmp < 1.0d-3) & + - all_results(current_Index, COUNT_NEG_9) & + - all_results(current_Index, COUNT_NEG_6) & + - all_results(current_Index, COUNT_0) endif end subroutine Compare_array_2dInt @@ -654,6 +684,7 @@ subroutine compare_array_3dInt(name, values, correct_values) current_index = current_index + 1 all_names(current_index) = name all_results(current_index,:) = 0.0 + all_results(current_index, COUNT_ALL) = size(values) if (all(values == correct_values)) then ! All values correct. Notice that all results are already initialised ! to 0, so only set the non-zero values here: @@ -673,7 +704,7 @@ subroutine compare_array_3dInt(name, values, correct_values) sum(double_values*double_correct) & / sqrt(real(sum(double_values*double_values))) & / sqrt(real(sum(double_correct*double_correct))) - all_results(current_index, count_0) = count(tmp == 0.0d0) + all_results(current_index, COUNT_0) = count(tmp == 0.0d0) where(double_correct /= 0) tmp = abs(tmp/double_correct) @@ -681,13 +712,16 @@ subroutine compare_array_3dInt(name, values, correct_values) tmp = -1 endwhere all_results(current_index, MAX_REL_ERROR) = maxval(tmp) - all_results(current_index, COUNT_NEG_3) = count(tmp > 1.0d-3) - ! Count elements >10^-6, and subtract the ones larger than 10^-3 - all_results(current_index, COUNT_NEG_6) = count(tmp > 1.0d-6) & - - all_results(current_Index, COUNT_NEG_3) - all_results(current_index, COUNT_NEG_9) = count(tmp > 1.0d-9) & - - all_results(current_Index, COUNT_NEG_6) - + all_results(current_index, COUNT_LARGER) = count(tmp >= 1.0d-3) + all_results(current_index, COUNT_NEG_9) = count(tmp < 1.0d-9) & + - all_results(current_Index, COUNT_0) + all_results(current_index, COUNT_NEG_6) = count(tmp < 1.0d-6) & + - all_results(current_Index, COUNT_NEG_9) & + - all_results(current_Index, COUNT_0) + all_results(current_index, COUNT_NEG_3) = count(tmp < 1.0d-3) & + - all_results(current_Index, COUNT_NEG_9) & + - all_results(current_Index, COUNT_NEG_6) & + - all_results(current_Index, COUNT_0) endif end subroutine Compare_array_3dInt @@ -719,6 +753,7 @@ subroutine compare_array_4dInt(name, values, correct_values) current_index = current_index + 1 all_names(current_index) = name all_results(current_index,:) = 0.0 + all_results(current_index, COUNT_ALL) = size(values) if (all(values == correct_values)) then ! All values correct. Notice that all results are already initialised ! to 0, so only set the non-zero values here: @@ -738,7 +773,7 @@ subroutine compare_array_4dInt(name, values, correct_values) sum(double_values*double_correct) & / sqrt(real(sum(double_values*double_values))) & / sqrt(real(sum(double_correct*double_correct))) - all_results(current_index, count_0) = count(tmp == 0.0d0) + all_results(current_index, COUNT_0) = count(tmp == 0.0d0) where(double_correct /= 0) tmp = abs(tmp/double_correct) @@ -746,13 +781,16 @@ subroutine compare_array_4dInt(name, values, correct_values) tmp = -1 endwhere all_results(current_index, MAX_REL_ERROR) = maxval(tmp) - all_results(current_index, COUNT_NEG_3) = count(tmp > 1.0d-3) - ! Count elements >10^-6, and subtract the ones larger than 10^-3 - all_results(current_index, COUNT_NEG_6) = count(tmp > 1.0d-6) & - - all_results(current_Index, COUNT_NEG_3) - all_results(current_index, COUNT_NEG_9) = count(tmp > 1.0d-9) & - - all_results(current_Index, COUNT_NEG_6) - + all_results(current_index, COUNT_LARGER) = count(tmp >= 1.0d-3) + all_results(current_index, COUNT_NEG_9) = count(tmp < 1.0d-9) & + - all_results(current_Index, COUNT_0) + all_results(current_index, COUNT_NEG_6) = count(tmp < 1.0d-6) & + - all_results(current_Index, COUNT_NEG_9) & + - all_results(current_Index, COUNT_0) + all_results(current_index, COUNT_NEG_3) = count(tmp < 1.0d-3) & + - all_results(current_Index, COUNT_NEG_9) & + - all_results(current_Index, COUNT_NEG_6) & + - all_results(current_Index, COUNT_0) endif end subroutine Compare_array_4dInt @@ -776,6 +814,7 @@ subroutine compare_scalar_Logical(name, value, correct_value) current_index = current_index + 1 all_names(current_index) = name all_results(current_index,:) = 0.0 + all_results(current_index,COUNT_ALL) = 1.0 if (value .EQV. correct_value) then ! All other values have already been initialised with 0 all_results(current_Index, L2_COS_SIMILAR) = 1 @@ -786,7 +825,7 @@ subroutine compare_scalar_Logical(name, value, correct_value) all_results(current_index, L2_DIFF ) = 1.0 all_results(current_index, L2_COS_SIMILAR) = 0.0 all_results(current_index, MAX_REL_ERROR ) = 1.0 - all_results(current_Index, COUNT_NEG_3 ) = 1 + all_results(current_Index, COUNT_LARGER ) = 1 endif end subroutine compare_scalar_Logical @@ -819,6 +858,7 @@ subroutine compare_array_1dLogical(name, values, correct_values) current_index = current_index + 1 all_names(current_index) = name all_results(current_index,:) = 0.0 + all_results(current_index, COUNT_ALL) = size(values) if (all(values .EQV. correct_values)) then ! All values correct. Notice that all results are already initialised ! to 0, so only set the non-zero values here: @@ -840,7 +880,7 @@ subroutine compare_array_1dLogical(name, values, correct_values) sum(double_values*double_correct) & / sqrt(real(sum(double_values*double_values))) & / sqrt(real(sum(double_correct*double_correct))) - all_results(current_index, count_0) = count(tmp == 0.0d0) + all_results(current_index, COUNT_0) = count(tmp == 0.0d0) where(double_correct /= 0) tmp = abs(tmp/double_correct) @@ -848,13 +888,16 @@ subroutine compare_array_1dLogical(name, values, correct_values) tmp = -1 endwhere all_results(current_index, MAX_REL_ERROR) = maxval(tmp) - all_results(current_index, COUNT_NEG_3) = count(tmp > 1.0d-3) - ! Count elements >10^-6, and subtract the ones larger than 10^-3 - all_results(current_index, COUNT_NEG_6) = count(tmp > 1.0d-6) & - - all_results(current_Index, COUNT_NEG_3) - all_results(current_index, COUNT_NEG_9) = count(tmp > 1.0d-9) & - - all_results(current_Index, COUNT_NEG_6) - + all_results(current_index, COUNT_LARGER) = count(tmp >= 1.0d-3) + all_results(current_index, COUNT_NEG_9) = count(tmp < 1.0d-9) & + - all_results(current_Index, COUNT_0) + all_results(current_index, COUNT_NEG_6) = count(tmp < 1.0d-6) & + - all_results(current_Index, COUNT_NEG_9) & + - all_results(current_Index, COUNT_0) + all_results(current_index, COUNT_NEG_3) = count(tmp < 1.0d-3) & + - all_results(current_Index, COUNT_NEG_9) & + - all_results(current_Index, COUNT_NEG_6) & + - all_results(current_Index, COUNT_0) endif end subroutine Compare_array_1dLogical @@ -886,6 +929,7 @@ subroutine compare_array_2dLogical(name, values, correct_values) current_index = current_index + 1 all_names(current_index) = name all_results(current_index,:) = 0.0 + all_results(current_index, COUNT_ALL) = size(values) if (all(values .EQV. correct_values)) then ! All values correct. Notice that all results are already initialised ! to 0, so only set the non-zero values here: @@ -907,7 +951,7 @@ subroutine compare_array_2dLogical(name, values, correct_values) sum(double_values*double_correct) & / sqrt(real(sum(double_values*double_values))) & / sqrt(real(sum(double_correct*double_correct))) - all_results(current_index, count_0) = count(tmp == 0.0d0) + all_results(current_index, COUNT_0) = count(tmp == 0.0d0) where(double_correct /= 0) tmp = abs(tmp/double_correct) @@ -915,13 +959,16 @@ subroutine compare_array_2dLogical(name, values, correct_values) tmp = -1 endwhere all_results(current_index, MAX_REL_ERROR) = maxval(tmp) - all_results(current_index, COUNT_NEG_3) = count(tmp > 1.0d-3) - ! Count elements >10^-6, and subtract the ones larger than 10^-3 - all_results(current_index, COUNT_NEG_6) = count(tmp > 1.0d-6) & - - all_results(current_Index, COUNT_NEG_3) - all_results(current_index, COUNT_NEG_9) = count(tmp > 1.0d-9) & - - all_results(current_Index, COUNT_NEG_6) - + all_results(current_index, COUNT_LARGER) = count(tmp >= 1.0d-3) + all_results(current_index, COUNT_NEG_9) = count(tmp < 1.0d-9) & + - all_results(current_Index, COUNT_0) + all_results(current_index, COUNT_NEG_6) = count(tmp < 1.0d-6) & + - all_results(current_Index, COUNT_NEG_9) & + - all_results(current_Index, COUNT_0) + all_results(current_index, COUNT_NEG_3) = count(tmp < 1.0d-3) & + - all_results(current_Index, COUNT_NEG_9) & + - all_results(current_Index, COUNT_NEG_6) & + - all_results(current_Index, COUNT_0) endif end subroutine Compare_array_2dLogical @@ -953,6 +1000,7 @@ subroutine compare_array_3dLogical(name, values, correct_values) current_index = current_index + 1 all_names(current_index) = name all_results(current_index,:) = 0.0 + all_results(current_index, COUNT_ALL) = size(values) if (all(values .EQV. correct_values)) then ! All values correct. Notice that all results are already initialised ! to 0, so only set the non-zero values here: @@ -974,7 +1022,7 @@ subroutine compare_array_3dLogical(name, values, correct_values) sum(double_values*double_correct) & / sqrt(real(sum(double_values*double_values))) & / sqrt(real(sum(double_correct*double_correct))) - all_results(current_index, count_0) = count(tmp == 0.0d0) + all_results(current_index, COUNT_0) = count(tmp == 0.0d0) where(double_correct /= 0) tmp = abs(tmp/double_correct) @@ -982,13 +1030,16 @@ subroutine compare_array_3dLogical(name, values, correct_values) tmp = -1 endwhere all_results(current_index, MAX_REL_ERROR) = maxval(tmp) - all_results(current_index, COUNT_NEG_3) = count(tmp > 1.0d-3) - ! Count elements >10^-6, and subtract the ones larger than 10^-3 - all_results(current_index, COUNT_NEG_6) = count(tmp > 1.0d-6) & - - all_results(current_Index, COUNT_NEG_3) - all_results(current_index, COUNT_NEG_9) = count(tmp > 1.0d-9) & - - all_results(current_Index, COUNT_NEG_6) - + all_results(current_index, COUNT_LARGER) = count(tmp >= 1.0d-3) + all_results(current_index, COUNT_NEG_9) = count(tmp < 1.0d-9) & + - all_results(current_Index, COUNT_0) + all_results(current_index, COUNT_NEG_6) = count(tmp < 1.0d-6) & + - all_results(current_Index, COUNT_NEG_9) & + - all_results(current_Index, COUNT_0) + all_results(current_index, COUNT_NEG_3) = count(tmp < 1.0d-3) & + - all_results(current_Index, COUNT_NEG_9) & + - all_results(current_Index, COUNT_NEG_6) & + - all_results(current_Index, COUNT_0) endif end subroutine Compare_array_3dLogical @@ -1020,6 +1071,7 @@ subroutine compare_array_4dLogical(name, values, correct_values) current_index = current_index + 1 all_names(current_index) = name all_results(current_index,:) = 0.0 + all_results(current_index, COUNT_ALL) = size(values) if (all(values .EQV. correct_values)) then ! All values correct. Notice that all results are already initialised ! to 0, so only set the non-zero values here: @@ -1041,7 +1093,7 @@ subroutine compare_array_4dLogical(name, values, correct_values) sum(double_values*double_correct) & / sqrt(real(sum(double_values*double_values))) & / sqrt(real(sum(double_correct*double_correct))) - all_results(current_index, count_0) = count(tmp == 0.0d0) + all_results(current_index, COUNT_0) = count(tmp == 0.0d0) where(double_correct /= 0) tmp = abs(tmp/double_correct) @@ -1049,13 +1101,16 @@ subroutine compare_array_4dLogical(name, values, correct_values) tmp = -1 endwhere all_results(current_index, MAX_REL_ERROR) = maxval(tmp) - all_results(current_index, COUNT_NEG_3) = count(tmp > 1.0d-3) - ! Count elements >10^-6, and subtract the ones larger than 10^-3 - all_results(current_index, COUNT_NEG_6) = count(tmp > 1.0d-6) & - - all_results(current_Index, COUNT_NEG_3) - all_results(current_index, COUNT_NEG_9) = count(tmp > 1.0d-9) & - - all_results(current_Index, COUNT_NEG_6) - + all_results(current_index, COUNT_LARGER) = count(tmp >= 1.0d-3) + all_results(current_index, COUNT_NEG_9) = count(tmp < 1.0d-9) & + - all_results(current_Index, COUNT_0) + all_results(current_index, COUNT_NEG_6) = count(tmp < 1.0d-6) & + - all_results(current_Index, COUNT_NEG_9) & + - all_results(current_Index, COUNT_0) + all_results(current_index, COUNT_NEG_3) = count(tmp < 1.0d-3) & + - all_results(current_Index, COUNT_NEG_9) & + - all_results(current_Index, COUNT_NEG_6) & + - all_results(current_Index, COUNT_0) endif end subroutine Compare_array_4dLogical @@ -1079,6 +1134,7 @@ subroutine compare_scalar_Real(name, value, correct_value) current_index = current_index + 1 all_names(current_index) = name all_results(current_index,:) = 0.0 + all_results(current_index,COUNT_ALL) = 1.0 if (value == correct_value) then ! All other values have already been initialised with 0 all_results(current_Index, L2_COS_SIMILAR) = 1 @@ -1130,6 +1186,7 @@ subroutine compare_array_1dReal(name, values, correct_values) current_index = current_index + 1 all_names(current_index) = name all_results(current_index,:) = 0.0 + all_results(current_index, COUNT_ALL) = size(values) if (all(values == correct_values)) then ! All values correct. Notice that all results are already initialised ! to 0, so only set the non-zero values here: @@ -1149,7 +1206,7 @@ subroutine compare_array_1dReal(name, values, correct_values) sum(double_values*double_correct) & / sqrt(real(sum(double_values*double_values))) & / sqrt(real(sum(double_correct*double_correct))) - all_results(current_index, count_0) = count(tmp == 0.0d0) + all_results(current_index, COUNT_0) = count(tmp == 0.0d0) where(double_correct /= 0) tmp = abs(tmp/double_correct) @@ -1157,13 +1214,16 @@ subroutine compare_array_1dReal(name, values, correct_values) tmp = -1 endwhere all_results(current_index, MAX_REL_ERROR) = maxval(tmp) - all_results(current_index, COUNT_NEG_3) = count(tmp > 1.0d-3) - ! Count elements >10^-6, and subtract the ones larger than 10^-3 - all_results(current_index, COUNT_NEG_6) = count(tmp > 1.0d-6) & - - all_results(current_Index, COUNT_NEG_3) - all_results(current_index, COUNT_NEG_9) = count(tmp > 1.0d-9) & - - all_results(current_Index, COUNT_NEG_6) - + all_results(current_index, COUNT_LARGER) = count(tmp >= 1.0d-3) + all_results(current_index, COUNT_NEG_9) = count(tmp < 1.0d-9) & + - all_results(current_Index, COUNT_0) + all_results(current_index, COUNT_NEG_6) = count(tmp < 1.0d-6) & + - all_results(current_Index, COUNT_NEG_9) & + - all_results(current_Index, COUNT_0) + all_results(current_index, COUNT_NEG_3) = count(tmp < 1.0d-3) & + - all_results(current_Index, COUNT_NEG_9) & + - all_results(current_Index, COUNT_NEG_6) & + - all_results(current_Index, COUNT_0) endif end subroutine Compare_array_1dReal @@ -1195,6 +1255,7 @@ subroutine compare_array_2dReal(name, values, correct_values) current_index = current_index + 1 all_names(current_index) = name all_results(current_index,:) = 0.0 + all_results(current_index, COUNT_ALL) = size(values) if (all(values == correct_values)) then ! All values correct. Notice that all results are already initialised ! to 0, so only set the non-zero values here: @@ -1214,7 +1275,7 @@ subroutine compare_array_2dReal(name, values, correct_values) sum(double_values*double_correct) & / sqrt(real(sum(double_values*double_values))) & / sqrt(real(sum(double_correct*double_correct))) - all_results(current_index, count_0) = count(tmp == 0.0d0) + all_results(current_index, COUNT_0) = count(tmp == 0.0d0) where(double_correct /= 0) tmp = abs(tmp/double_correct) @@ -1222,13 +1283,16 @@ subroutine compare_array_2dReal(name, values, correct_values) tmp = -1 endwhere all_results(current_index, MAX_REL_ERROR) = maxval(tmp) - all_results(current_index, COUNT_NEG_3) = count(tmp > 1.0d-3) - ! Count elements >10^-6, and subtract the ones larger than 10^-3 - all_results(current_index, COUNT_NEG_6) = count(tmp > 1.0d-6) & - - all_results(current_Index, COUNT_NEG_3) - all_results(current_index, COUNT_NEG_9) = count(tmp > 1.0d-9) & - - all_results(current_Index, COUNT_NEG_6) - + all_results(current_index, COUNT_LARGER) = count(tmp >= 1.0d-3) + all_results(current_index, COUNT_NEG_9) = count(tmp < 1.0d-9) & + - all_results(current_Index, COUNT_0) + all_results(current_index, COUNT_NEG_6) = count(tmp < 1.0d-6) & + - all_results(current_Index, COUNT_NEG_9) & + - all_results(current_Index, COUNT_0) + all_results(current_index, COUNT_NEG_3) = count(tmp < 1.0d-3) & + - all_results(current_Index, COUNT_NEG_9) & + - all_results(current_Index, COUNT_NEG_6) & + - all_results(current_Index, COUNT_0) endif end subroutine Compare_array_2dReal @@ -1260,6 +1324,7 @@ subroutine compare_array_3dReal(name, values, correct_values) current_index = current_index + 1 all_names(current_index) = name all_results(current_index,:) = 0.0 + all_results(current_index, COUNT_ALL) = size(values) if (all(values == correct_values)) then ! All values correct. Notice that all results are already initialised ! to 0, so only set the non-zero values here: @@ -1279,7 +1344,7 @@ subroutine compare_array_3dReal(name, values, correct_values) sum(double_values*double_correct) & / sqrt(real(sum(double_values*double_values))) & / sqrt(real(sum(double_correct*double_correct))) - all_results(current_index, count_0) = count(tmp == 0.0d0) + all_results(current_index, COUNT_0) = count(tmp == 0.0d0) where(double_correct /= 0) tmp = abs(tmp/double_correct) @@ -1287,13 +1352,16 @@ subroutine compare_array_3dReal(name, values, correct_values) tmp = -1 endwhere all_results(current_index, MAX_REL_ERROR) = maxval(tmp) - all_results(current_index, COUNT_NEG_3) = count(tmp > 1.0d-3) - ! Count elements >10^-6, and subtract the ones larger than 10^-3 - all_results(current_index, COUNT_NEG_6) = count(tmp > 1.0d-6) & - - all_results(current_Index, COUNT_NEG_3) - all_results(current_index, COUNT_NEG_9) = count(tmp > 1.0d-9) & - - all_results(current_Index, COUNT_NEG_6) - + all_results(current_index, COUNT_LARGER) = count(tmp >= 1.0d-3) + all_results(current_index, COUNT_NEG_9) = count(tmp < 1.0d-9) & + - all_results(current_Index, COUNT_0) + all_results(current_index, COUNT_NEG_6) = count(tmp < 1.0d-6) & + - all_results(current_Index, COUNT_NEG_9) & + - all_results(current_Index, COUNT_0) + all_results(current_index, COUNT_NEG_3) = count(tmp < 1.0d-3) & + - all_results(current_Index, COUNT_NEG_9) & + - all_results(current_Index, COUNT_NEG_6) & + - all_results(current_Index, COUNT_0) endif end subroutine Compare_array_3dReal @@ -1325,6 +1393,7 @@ subroutine compare_array_4dReal(name, values, correct_values) current_index = current_index + 1 all_names(current_index) = name all_results(current_index,:) = 0.0 + all_results(current_index, COUNT_ALL) = size(values) if (all(values == correct_values)) then ! All values correct. Notice that all results are already initialised ! to 0, so only set the non-zero values here: @@ -1344,7 +1413,7 @@ subroutine compare_array_4dReal(name, values, correct_values) sum(double_values*double_correct) & / sqrt(real(sum(double_values*double_values))) & / sqrt(real(sum(double_correct*double_correct))) - all_results(current_index, count_0) = count(tmp == 0.0d0) + all_results(current_index, COUNT_0) = count(tmp == 0.0d0) where(double_correct /= 0) tmp = abs(tmp/double_correct) @@ -1352,13 +1421,16 @@ subroutine compare_array_4dReal(name, values, correct_values) tmp = -1 endwhere all_results(current_index, MAX_REL_ERROR) = maxval(tmp) - all_results(current_index, COUNT_NEG_3) = count(tmp > 1.0d-3) - ! Count elements >10^-6, and subtract the ones larger than 10^-3 - all_results(current_index, COUNT_NEG_6) = count(tmp > 1.0d-6) & - - all_results(current_Index, COUNT_NEG_3) - all_results(current_index, COUNT_NEG_9) = count(tmp > 1.0d-9) & - - all_results(current_Index, COUNT_NEG_6) - + all_results(current_index, COUNT_LARGER) = count(tmp >= 1.0d-3) + all_results(current_index, COUNT_NEG_9) = count(tmp < 1.0d-9) & + - all_results(current_Index, COUNT_0) + all_results(current_index, COUNT_NEG_6) = count(tmp < 1.0d-6) & + - all_results(current_Index, COUNT_NEG_9) & + - all_results(current_Index, COUNT_0) + all_results(current_index, COUNT_NEG_3) = count(tmp < 1.0d-3) & + - all_results(current_Index, COUNT_NEG_9) & + - all_results(current_Index, COUNT_NEG_6) & + - all_results(current_Index, COUNT_0) endif end subroutine Compare_array_4dReal @@ -1382,6 +1454,7 @@ subroutine compare_scalar_Double(name, value, correct_value) current_index = current_index + 1 all_names(current_index) = name all_results(current_index,:) = 0.0 + all_results(current_index,COUNT_ALL) = 1.0 if (value == correct_value) then ! All other values have already been initialised with 0 all_results(current_Index, L2_COS_SIMILAR) = 1 @@ -1433,6 +1506,7 @@ subroutine compare_array_1dDouble(name, values, correct_values) current_index = current_index + 1 all_names(current_index) = name all_results(current_index,:) = 0.0 + all_results(current_index, COUNT_ALL) = size(values) if (all(values == correct_values)) then ! All values correct. Notice that all results are already initialised ! to 0, so only set the non-zero values here: @@ -1452,7 +1526,7 @@ subroutine compare_array_1dDouble(name, values, correct_values) sum(double_values*double_correct) & / sqrt(real(sum(double_values*double_values))) & / sqrt(real(sum(double_correct*double_correct))) - all_results(current_index, count_0) = count(tmp == 0.0d0) + all_results(current_index, COUNT_0) = count(tmp == 0.0d0) where(double_correct /= 0) tmp = abs(tmp/double_correct) @@ -1460,13 +1534,16 @@ subroutine compare_array_1dDouble(name, values, correct_values) tmp = -1 endwhere all_results(current_index, MAX_REL_ERROR) = maxval(tmp) - all_results(current_index, COUNT_NEG_3) = count(tmp > 1.0d-3) - ! Count elements >10^-6, and subtract the ones larger than 10^-3 - all_results(current_index, COUNT_NEG_6) = count(tmp > 1.0d-6) & - - all_results(current_Index, COUNT_NEG_3) - all_results(current_index, COUNT_NEG_9) = count(tmp > 1.0d-9) & - - all_results(current_Index, COUNT_NEG_6) - + all_results(current_index, COUNT_LARGER) = count(tmp >= 1.0d-3) + all_results(current_index, COUNT_NEG_9) = count(tmp < 1.0d-9) & + - all_results(current_Index, COUNT_0) + all_results(current_index, COUNT_NEG_6) = count(tmp < 1.0d-6) & + - all_results(current_Index, COUNT_NEG_9) & + - all_results(current_Index, COUNT_0) + all_results(current_index, COUNT_NEG_3) = count(tmp < 1.0d-3) & + - all_results(current_Index, COUNT_NEG_9) & + - all_results(current_Index, COUNT_NEG_6) & + - all_results(current_Index, COUNT_0) endif end subroutine Compare_array_1dDouble @@ -1498,6 +1575,7 @@ subroutine compare_array_2dDouble(name, values, correct_values) current_index = current_index + 1 all_names(current_index) = name all_results(current_index,:) = 0.0 + all_results(current_index, COUNT_ALL) = size(values) if (all(values == correct_values)) then ! All values correct. Notice that all results are already initialised ! to 0, so only set the non-zero values here: @@ -1517,7 +1595,7 @@ subroutine compare_array_2dDouble(name, values, correct_values) sum(double_values*double_correct) & / sqrt(real(sum(double_values*double_values))) & / sqrt(real(sum(double_correct*double_correct))) - all_results(current_index, count_0) = count(tmp == 0.0d0) + all_results(current_index, COUNT_0) = count(tmp == 0.0d0) where(double_correct /= 0) tmp = abs(tmp/double_correct) @@ -1525,13 +1603,16 @@ subroutine compare_array_2dDouble(name, values, correct_values) tmp = -1 endwhere all_results(current_index, MAX_REL_ERROR) = maxval(tmp) - all_results(current_index, COUNT_NEG_3) = count(tmp > 1.0d-3) - ! Count elements >10^-6, and subtract the ones larger than 10^-3 - all_results(current_index, COUNT_NEG_6) = count(tmp > 1.0d-6) & - - all_results(current_Index, COUNT_NEG_3) - all_results(current_index, COUNT_NEG_9) = count(tmp > 1.0d-9) & - - all_results(current_Index, COUNT_NEG_6) - + all_results(current_index, COUNT_LARGER) = count(tmp >= 1.0d-3) + all_results(current_index, COUNT_NEG_9) = count(tmp < 1.0d-9) & + - all_results(current_Index, COUNT_0) + all_results(current_index, COUNT_NEG_6) = count(tmp < 1.0d-6) & + - all_results(current_Index, COUNT_NEG_9) & + - all_results(current_Index, COUNT_0) + all_results(current_index, COUNT_NEG_3) = count(tmp < 1.0d-3) & + - all_results(current_Index, COUNT_NEG_9) & + - all_results(current_Index, COUNT_NEG_6) & + - all_results(current_Index, COUNT_0) endif end subroutine Compare_array_2dDouble @@ -1563,6 +1644,7 @@ subroutine compare_array_3dDouble(name, values, correct_values) current_index = current_index + 1 all_names(current_index) = name all_results(current_index,:) = 0.0 + all_results(current_index, COUNT_ALL) = size(values) if (all(values == correct_values)) then ! All values correct. Notice that all results are already initialised ! to 0, so only set the non-zero values here: @@ -1582,7 +1664,7 @@ subroutine compare_array_3dDouble(name, values, correct_values) sum(double_values*double_correct) & / sqrt(real(sum(double_values*double_values))) & / sqrt(real(sum(double_correct*double_correct))) - all_results(current_index, count_0) = count(tmp == 0.0d0) + all_results(current_index, COUNT_0) = count(tmp == 0.0d0) where(double_correct /= 0) tmp = abs(tmp/double_correct) @@ -1590,13 +1672,16 @@ subroutine compare_array_3dDouble(name, values, correct_values) tmp = -1 endwhere all_results(current_index, MAX_REL_ERROR) = maxval(tmp) - all_results(current_index, COUNT_NEG_3) = count(tmp > 1.0d-3) - ! Count elements >10^-6, and subtract the ones larger than 10^-3 - all_results(current_index, COUNT_NEG_6) = count(tmp > 1.0d-6) & - - all_results(current_Index, COUNT_NEG_3) - all_results(current_index, COUNT_NEG_9) = count(tmp > 1.0d-9) & - - all_results(current_Index, COUNT_NEG_6) - + all_results(current_index, COUNT_LARGER) = count(tmp >= 1.0d-3) + all_results(current_index, COUNT_NEG_9) = count(tmp < 1.0d-9) & + - all_results(current_Index, COUNT_0) + all_results(current_index, COUNT_NEG_6) = count(tmp < 1.0d-6) & + - all_results(current_Index, COUNT_NEG_9) & + - all_results(current_Index, COUNT_0) + all_results(current_index, COUNT_NEG_3) = count(tmp < 1.0d-3) & + - all_results(current_Index, COUNT_NEG_9) & + - all_results(current_Index, COUNT_NEG_6) & + - all_results(current_Index, COUNT_0) endif end subroutine Compare_array_3dDouble @@ -1628,6 +1713,7 @@ subroutine compare_array_4dDouble(name, values, correct_values) current_index = current_index + 1 all_names(current_index) = name all_results(current_index,:) = 0.0 + all_results(current_index, COUNT_ALL) = size(values) if (all(values == correct_values)) then ! All values correct. Notice that all results are already initialised ! to 0, so only set the non-zero values here: @@ -1647,7 +1733,7 @@ subroutine compare_array_4dDouble(name, values, correct_values) sum(double_values*double_correct) & / sqrt(real(sum(double_values*double_values))) & / sqrt(real(sum(double_correct*double_correct))) - all_results(current_index, count_0) = count(tmp == 0.0d0) + all_results(current_index, COUNT_0) = count(tmp == 0.0d0) where(double_correct /= 0) tmp = abs(tmp/double_correct) @@ -1655,13 +1741,16 @@ subroutine compare_array_4dDouble(name, values, correct_values) tmp = -1 endwhere all_results(current_index, MAX_REL_ERROR) = maxval(tmp) - all_results(current_index, COUNT_NEG_3) = count(tmp > 1.0d-3) - ! Count elements >10^-6, and subtract the ones larger than 10^-3 - all_results(current_index, COUNT_NEG_6) = count(tmp > 1.0d-6) & - - all_results(current_Index, COUNT_NEG_3) - all_results(current_index, COUNT_NEG_9) = count(tmp > 1.0d-9) & - - all_results(current_Index, COUNT_NEG_6) - + all_results(current_index, COUNT_LARGER) = count(tmp >= 1.0d-3) + all_results(current_index, COUNT_NEG_9) = count(tmp < 1.0d-9) & + - all_results(current_Index, COUNT_0) + all_results(current_index, COUNT_NEG_6) = count(tmp < 1.0d-6) & + - all_results(current_Index, COUNT_NEG_9) & + - all_results(current_Index, COUNT_0) + all_results(current_index, COUNT_NEG_3) = count(tmp < 1.0d-3) & + - all_results(current_Index, COUNT_NEG_9) & + - all_results(current_Index, COUNT_NEG_6) & + - all_results(current_Index, COUNT_0) endif end subroutine Compare_array_4dDouble From 4313484d8233a48bc21ce15e3496e080847d517f Mon Sep 17 00:00:00 2001 From: Joerg Henrichs Date: Tue, 25 Feb 2025 12:40:52 +1100 Subject: [PATCH 09/15] #2878 Try to add variable comparison library to compilation tests. --- .github/workflows/compilation.yml | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/.github/workflows/compilation.yml b/.github/workflows/compilation.yml index d45d194e2a..5015e74d27 100644 --- a/.github/workflows/compilation.yml +++ b/.github/workflows/compilation.yml @@ -109,6 +109,18 @@ jobs: module load hdf5/${HDF5_VERSION} netcdf_c/${NETCDF_C_VERSION} netcdf_fortran/${NETCDF_FORTRAN_VERSION} module load cuda/${CUDA_VERSION} F90=gfortran make -C examples compile + - name: Libraries with compilation - gfortran + run: | + . .runner_venv/bin/activate + make -C lib/extract clean + module load gcc/${GFORTRAN_VERSION} + make -C lib/extract test + - name: Libraries with compilation - nvfortran + run: | + . .runner_venv/bin/activate + make -C lib/extract clean + module load nvidia-hpcsdk/${NVFORTRAN_VERSION} + F90=nvfortran make -C lib/extract test - name: Tutorials with compilation - gfortran run: | . .runner_venv/bin/activate From e1779a5dfccad000489dfd5cab3b0823c1a2774b Mon Sep 17 00:00:00 2001 From: Joerg Henrichs Date: Tue, 25 Feb 2025 22:22:24 +1100 Subject: [PATCH 10/15] #2878 Added missing file. --- lib/extract/test_compare.f90 | 44 ++++++++++++++++++++++++++++++++++++ 1 file changed, 44 insertions(+) create mode 100644 lib/extract/test_compare.f90 diff --git a/lib/extract/test_compare.f90 b/lib/extract/test_compare.f90 new file mode 100644 index 0000000000..046aadf288 --- /dev/null +++ b/lib/extract/test_compare.f90 @@ -0,0 +1,44 @@ +program test_compare + + use compare_variables_mod, only: compare_init, compare, compare_summary + + implicit none + + real, dimension(10) :: a_single, a_single_correct + double precision, dimension(15) :: a_dbl, a_dbl_correct + integer, dimension(15) :: a_int, a_int_correct + + a_dbl_correct = 1.0d0 + ! This should result in counts of: + ! 1 2 3 4 5 (identical, <1e-9, <1e-6, <1e-3, >=1e-3) + a_dbl( 1: 1) = 1.0d0 + a_dbl( 2: 3) = 1.0+1d-10 + a_dbl( 4: 6) = 1.0+1d-7 + a_dbl( 7:10) = 1.0+1d-4 + a_dbl(11:15) = 1.0+1d-1 + + ! Test single precision. Note that single precision cannot store an + ! error of 1e-9, so we only test up to 1e-6: + ! resulting in counts of: 1 0 2 3 4 + a_single_correct = 1.0 + a_single( 1: 1) = 1.0 + a_single( 2: 3) = 1.0+1d-7 + a_single( 4: 6) = 1.0+1d-4 + a_single( 7:10) = 1.0+1d-1 + + ! Test integer, max. value is 2147483648, so use 2*10^9 + ! to create errors with 1e-9 etc + a_int_correct = 2000000000 + a_int( 1: 1) = 2000000000 + a_int( 2: 3) = 2000000001 + a_int( 4: 6) = 2000001000 + a_int( 7:10) = 2001000000 + a_int(11:15) = 2100000000 + + call compare_init(3) + call compare("a_dbl", a_dbl, a_dbl_correct) + call compare("a_single", a_single, a_single_correct) + call compare("a_int", a_int, a_int_correct) + call compare_summary() + +end program test_compare \ No newline at end of file From cf1cbfbbf87c47b3308c5d14221daf30c50e8420 Mon Sep 17 00:00:00 2001 From: Joerg Henrichs Date: Sat, 5 Jul 2025 02:10:53 +1000 Subject: [PATCH 11/15] #2878 Removed new field type version, which will be part of a separate PR. --- .../kernel_data_netcdf.jinja-new-field-types | 347 ------------------ 1 file changed, 347 deletions(-) delete mode 100644 lib/extract/netcdf/lfric/kernel_data_netcdf.jinja-new-field-types diff --git a/lib/extract/netcdf/lfric/kernel_data_netcdf.jinja-new-field-types b/lib/extract/netcdf/lfric/kernel_data_netcdf.jinja-new-field-types deleted file mode 100644 index 50fa18bc36..0000000000 --- a/lib/extract/netcdf/lfric/kernel_data_netcdf.jinja-new-field-types +++ /dev/null @@ -1,347 +0,0 @@ -{# Added this as Jinja code so that it is understood that the - comment does not apply to THIS file. #} -{{ "! ================================================== !" }} -{{ "! THIS FILE IS CREATED FROM THE JINJA TEMPLATE FILE. !" }} -{{ "! DO NOT MODIFY DIRECTLY! !" }} -{{ "! ================================================== !" }} - -! ----------------------------------------------------------------------------- -! BSD 3-Clause License -! -! Copyright (c) 2020-2025, Science and Technology Facilities Council. -! All rights reserved. -! -! Redistribution and use in source and binary forms, with or without -! modification, are permitted provided that the following conditions are met: -! -! * Redistributions of source code must retain the above copyright notice, this -! list of conditions and the following disclaimer. -! -! * Redistributions in binary form must reproduce the above copyright notice, -! this list of conditions and the following disclaimer in the documentation -! and/or other materials provided with the distribution. -! -! * Neither the name of the copyright holder nor the names of its -! contributors may be used to endorse or promote products derived from -! this software without specific prior written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -! "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -! LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS -! FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE -! COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, -! INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, -! BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; -! LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER -! CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT -! LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN -! ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE -! POSSIBILITY OF SUCH DAMAGE. -! ----------------------------------------------------------------------------- -! Author J. Henrichs, Bureau of Meteorology -! Modified I. Kavcic, Met Office - -!> This module implements a simple NetCDF writer using the PSyData -!! interface. It is specific to the LFRic infrastructure library. -!! A Fortran code instrumented with corresponding calls -!! to the PSyData API and linked in with this library will write -!! the requested input and output parameters to a NetCDF file. -!! - -{% set ALL_PREC = ["32", "64"] -%} - -module extract_psy_data_mod - - use, intrinsic :: iso_fortran_env, only : int64, int32 - use extract_netcdf_base_mod, only : ExtractNetcdfBaseType, CheckError - - implicit none - - !> This is the data type that manages the information required - !! to write data to a NetCDF file using the PSyData API. A - !! static instance of this type is created for each instrumented - !! region with PSyclone (and each region will write a separate - !! file). - type, extends(ExtractNetcdfBaseType), public :: extract_PSyDataType - - contains - {% set all_declares=[] -%} - {% set all_writes=[] -%} - {% for prec in ALL_PREC %} - procedure :: DeclareField_r{{prec}} - procedure :: WriteField_r{{prec}} - procedure :: DeclareFieldVector_r{{prec}} - procedure :: WriteFieldVector_r{{prec}} - {{- all_declares.append("DeclareField_r{{prec}}") or ""}} - {{- all_declares.append("DeclareFieldVector_r{{prec}}") or ""}} - {{- all_writes.append("WriteField_r{{prec}}") or ""}} - {{- all_writes.append("WriteFieldVector_r{{prec}}") or ""}} - {% endfor %} - - ! The various procedures defined here - procedure :: DeclareIntField - procedure :: WriteIntField - procedure :: DeclareIntFieldVector - procedure :: WriteIntFieldVector - - !> Declare generic interface for PreDeclareVariable: - generic, public :: PreDeclareVariable => & - {% for prec in ALL_PREC %} - DeclareField_r{{prec}}, & - DeclareFieldVector_r{{prec}}, & - {% endfor %} - DeclareIntField, & - DeclareIntFieldVector - - !> The generic interface for providing the value of variables, - !! which in case of the kernel extraction writes the data to - !! the NetCDF file. - generic, public :: ProvideVariable => & - {% for prec in ALL_PREC %} - WriteField_r{{prec}}, & - WriteFieldVector_r{{prec}}, & - {% endfor %} - WriteIntField, & - WriteIntFieldVector - - end type extract_PSyDataType - -contains - - - {% for prec in ALL_PREC %} - - ! ------------------------------------------------------------------------- - !> @brief This subroutine declares an LFRic field with real-valued - !! {{prec}}-bit data. - !! It calls the PreDeclareVariable function provided by the base class - !! (depending on the type of the argument, e.g. it might call - !! DeclareArray1dDouble). - !! @param[in,out] this The instance of the extract_PSyDataType. - !! @param[in] name The name of the variable (string). - !! @param[in] value The value of the variable. - subroutine DeclareField_r{{prec}}(this, name, value) - - use field_real{{prec}}_mod, only : field_real{{prec}}_type, field_real{{prec}}_proxy_type - - implicit none - - class(extract_PSyDataType), intent(inout), target :: this - character(*), intent(in) :: name - type(field_real{{prec}}_type), intent(in) :: value - - type(field_real{{prec}}_proxy_type) :: value_proxy - - value_proxy = value%get_proxy() - call this%PreDeclareVariable(name, value_proxy%data) - - end subroutine DeclareField_r{{prec}} - - ! ------------------------------------------------------------------------- - !> @brief This subroutine writes the values of an LFRic real-valued {{prec}}-bit - !! field to the NetCDF file. It uses the corresponding function - !! provided by the base class. - !! @param[in,out] this The instance of the extract_PSyDataType. - !! @param[in] name The name of the variable (string). - !! @param[in] value The value of the variable. - subroutine WriteField_r{{prec}}(this, name, value) - - use field_real{{prec}}_mod, only : field_real{{prec}}_type, field_real{{prec}}_proxy_type - - implicit none - - class(extract_PSyDataType), intent(inout), target :: this - character(*), intent(in) :: name - type(field_real{{prec}}_type), intent(in) :: value - - type(field_real{{prec}}_proxy_type) :: value_proxy - - value_proxy = value%get_proxy() - call this%ProvideVariable(name, value_proxy%data) - - end subroutine WriteField_r{{prec}} - - ! ------------------------------------------------------------------------- - !> @brief This subroutine declares an LFRic real-valued {{prec}}-bit field vector. - !! Each component of the vector is stored as a separate variable, using the - !! corresponding array function of the base class. - !! @param[in,out] this The instance of the extract_PSyDataType. - !! @param[in] name The name of the variable (string). - !! @param[in] value The value of the variable. - subroutine DeclareFieldVector_r{{prec}}(this, name, value) - - use field_real{{prec}}_mod, only : field_real{{prec}}_type, field_real{{prec}}_proxy_type - - implicit none - - class(extract_PSyDataType), intent(inout), target :: this - character(*), intent(in) :: name - type(field_real{{prec}}_type), dimension(:), intent(in) :: value - - integer :: i - type(field_real{{prec}}_proxy_type) :: value_proxy - character(9) :: number - - ! Provide each component of the vector as an individual 1D array. - ! The base class will re-allocate internal array sizes if required. - do i = 1, size(value) - value_proxy = value(i)%get_proxy() - ! We add a '%' here to avoid a potential name clash if - ! the user should have a vector field 'a' (which is now stored - ! as a%1, a%2, ...), and a field 'a1' - write(number, '("%",i0)') i - call this%PreDeclareVariable(name//trim(number), value_proxy%data) - enddo - - end subroutine DeclareFieldVector_r{{prec}} - - ! ------------------------------------------------------------------------- - !> @brief This subroutine writes an LFRic real-valued {{prec}}-bit field vector to - !! the NetCDF file. Each component is stored as an individual variable using - !! the corresponding array function of the base class. - !! @param[in,out] this The instance of the extract_PSyDataType. - !! @param[in] name The name of the variable (string). - !! @param[in] value The value of the variable. - subroutine WriteFieldVector_r{{prec}}(this, name, value) - - use field_real{{prec}}_mod, only : field_real{{prec}}_type, field_real{{prec}}_proxy_type - - implicit none - - class(extract_PSyDataType), intent(inout), target :: this - character(*), intent(in) :: name - type(field_real{{prec}}_type), dimension(:), intent(in) :: value - - integer :: i - type(field_real{{prec}}_proxy_type) :: value_proxy - character(9) :: number - - ! Provide each dimension of the vector as an individual 1D array. - do i = 1, size(value, 1) - value_proxy = value(i)%get_proxy() - write(number, '("%",i0)') i - call this%ProvideVariable(name//trim(number), value_proxy%data) - enddo - - end subroutine WriteFieldVector_r{{prec}} - - {% endfor %} - - ! ------------------------------------------------------------------------- - !> @brief This subroutine declares an LFRic field with integer-valued data. - !! It calls the PreDeclareVariable function provided by the base class - !! (depending on the type of the argument, e.g. it might call - !! DeclareArray1dInt). - !! @param[in,out] this The instance of the extract_PSyDataType. - !! @param[in] name The name of the variable (string). - !! @param[in] value The value of the variable. - subroutine DeclareIntField(this, name, value) - - use integer_field_mod, only : integer_field_type, & - integer_field_proxy_type - - implicit none - - class(extract_PSyDataType), intent(inout), target :: this - character(*), intent(in) :: name - type(integer_field_type), intent(in) :: value - - type(integer_field_proxy_type) :: value_proxy - - value_proxy = value%get_proxy() - call this%PreDeclareVariable(name, value_proxy%data) - - end subroutine DeclareIntField - - ! ------------------------------------------------------------------------- - !> @brief This subroutine writes the values of an LFRic integer-valued field. - !! to the NetCDF file. It uses the corresponding function - !! provided by the base class. - !! @param[in,out] this The instance of the extract_PSyDataType. - !! @param[in] name The name of the variable (string). - !! @param[in] value The value of the variable. - subroutine WriteIntField(this, name, value) - - use integer_field_mod, only : integer_field_type, & - integer_field_proxy_type - - implicit none - - class(extract_PSyDataType), intent(inout), target :: this - character(*), intent(in) :: name - type(integer_field_type), intent(in) :: value - - type(integer_field_proxy_type) :: value_proxy - - value_proxy = value%get_proxy() - call this%ProvideVariable(name, value_proxy%data) - - end subroutine WriteIntField - - ! ------------------------------------------------------------------------- - !> @brief This subroutine declares an LFRic integer-valued field vector. Each - !! component of the vector is stored as a separate variable, using the - !! corresponding array function of the base class. - !! @param[in,out] this The instance of the extract_PSyDataType. - !! @param[in] name The name of the variable (string). - !! @param[in] value The value of the variable. - subroutine DeclareIntFieldVector(this, name, value) - - use integer_field_mod, only : integer_field_type, & - integer_field_proxy_type - - implicit none - - class(extract_PSyDataType), intent(inout), target :: this - character(*), intent(in) :: name - type(integer_field_type), dimension(:), intent(in) :: value - - integer :: i - type(integer_field_proxy_type) :: value_proxy - character(9) :: number - - ! Provide each component of the vector as an individual 1D array. - ! The base class will re-allocate internal array sizes if required. - do i = 1, size(value) - value_proxy = value(i)%get_proxy() - ! We add a '%' here to avoid a potential name clash if - ! the user should have a vector field 'a' (which is now stored - ! as a%1, a%2, ...), and a field 'a1'. - write(number, '("%",i0)') i - call this%PreDeclareVariable(name//trim(number), value_proxy%data) - enddo - - end subroutine DeclareIntFieldVector - -! ------------------------------------------------------------------------- - !> @brief This subroutine writes an LFRic integer-valued field vector to the - !! NetCDF file. Each component is stored as an individual variable - !! using the corresponding array function of the base class. - !! @param[in,out] this The instance of the extract_PSyDataType. - !! @param[in] name The name of the variable (string). - !! @param[in] value The value of the variable. - subroutine WriteIntFieldVector(this, name, value) - - use integer_field_mod, only : integer_field_type, & - integer_field_proxy_type - - implicit none - - class(extract_PSyDataType), intent(inout), target :: this - character(*), intent(in) :: name - type(integer_field_type), dimension(:), intent(in) :: value - - integer :: i - type(integer_field_proxy_type) :: value_proxy - character(9) :: number - - ! Provide each dimension of the vector as an individual 1D array. - do i = 1, size(value, 1) - value_proxy = value(i)%get_proxy() - write(number, '("%",i0)') i - call this%ProvideVariable(name//trim(number), value_proxy%data) - enddo - - end subroutine WriteIntFieldVector - -end module extract_psy_data_mod From b90f4ebbbfcaa1a651674a91ed0bd53bb61617f5 Mon Sep 17 00:00:00 2001 From: Joerg Henrichs Date: Tue, 8 Jul 2025 13:40:29 +1000 Subject: [PATCH 12/15] #2878 Addressed issued raised in review. --- .github/workflows/compilation.yml | 22 +++++++++++----------- lib/extract/Makefile | 15 +++++++++------ lib/extract/test_compare.f90 | 2 +- 3 files changed, 21 insertions(+), 18 deletions(-) diff --git a/.github/workflows/compilation.yml b/.github/workflows/compilation.yml index bf6ff4da73..e30523ccfa 100644 --- a/.github/workflows/compilation.yml +++ b/.github/workflows/compilation.yml @@ -100,27 +100,27 @@ jobs: module load nvidia-hpcsdk/${NVFORTRAN_VERSION} module load hdf5/${HDF5_VERSION} netcdf_c/${NETCDF_C_VERSION} netcdf_fortran/${NETCDF_FORTRAN_VERSION} pytest -n 4 --f90=nvfortran --compile --compileopencl src/psyclone/tests - - name: Examples with compilation - gfortran - run: | - . .runner_venv/bin/activate - make -C examples allclean - # Although we're using gfortran, we link with CUDA's OpenCL library - module load gcc/${GFORTRAN_VERSION} openmpi/${OPENMPI_VERSION} - module load hdf5/${HDF5_VERSION} netcdf_c/${NETCDF_C_VERSION} netcdf_fortran/${NETCDF_FORTRAN_VERSION} - module load cuda/${CUDA_VERSION} - F90=gfortran make -C examples compile - - name: Libraries with compilation - gfortran + - name: Libraries compilation - gfortran run: | . .runner_venv/bin/activate make -C lib/extract clean module load gcc/${GFORTRAN_VERSION} make -C lib/extract test - - name: Libraries with compilation - nvfortran + - name: Libraries compilation - nvfortran run: | . .runner_venv/bin/activate make -C lib/extract clean module load nvidia-hpcsdk/${NVFORTRAN_VERSION} F90=nvfortran make -C lib/extract test + - name: Examples with compilation - gfortran + run: | + . .runner_venv/bin/activate + make -C examples allclean + # Although we're using gfortran, we link with CUDA's OpenCL library + module load gcc/${GFORTRAN_VERSION} openmpi/${OPENMPI_VERSION} + module load hdf5/${HDF5_VERSION} netcdf_c/${NETCDF_C_VERSION} netcdf_fortran/${NETCDF_FORTRAN_VERSION} + module load cuda/${CUDA_VERSION} + F90=gfortran make -C examples compile - name: Tutorials with compilation - gfortran run: | . .runner_venv/bin/activate diff --git a/lib/extract/Makefile b/lib/extract/Makefile index 2b8ddcec16..725edbaf16 100644 --- a/lib/extract/Makefile +++ b/lib/extract/Makefile @@ -49,10 +49,11 @@ PSYDATA_LIB_DIR ?= ./.. # These arguments are responsible for creating the Fortran # `compare_variables_mod` file based on the jinja template. It will support -# the listed data types and scalar and 2-dimensional arrays. Note that -# domain-specific implementation will create their own version with different -# number of dimensions if required. -PROCESS_ARGS = -types=char,int,long,logical,real,double -dims=1,2,3,4 +# the listed data types and scalar and 2-dimensional arrays. +# The type and n-arity of the comparable type may need to be adjusted to +# match the capabilities of the target application using the arguments below. + +PROCESS_ARGS ?= -types=char,int,long,logical,real,double -dims=1,2,3,4 PROCESS = $$($(PSYDATA_LIB_DIR)/get_python.sh) $(PSYDATA_LIB_DIR)/process.py .PHONY: all compare test @@ -63,8 +64,10 @@ test_compare: compare_variables_mod.o test_compare.o $(F90) $(F90FLAGS) $^ -o $@ make test: test_compare - # Check all the counts only, to avoid that floating point - # differences invalidate this test. + # The first 6 fields of the output contain the counts of various + # errors. Only check these counts, not the computed floating point + # differences (which are the next 4 columns), since they might + # slightly vary between compilers and hardware platforms. ./test_compare | grep "a_dbl *15 *1 *2 *3 *4 *5" > /dev/null ./test_compare | grep "a_single *10 *1 *0 *2 *3 *4" > /dev/null ./test_compare | grep "a_int *15 *1 *2 *3 *4 *5" > /dev/null diff --git a/lib/extract/test_compare.f90 b/lib/extract/test_compare.f90 index 046aadf288..5084fd7cff 100644 --- a/lib/extract/test_compare.f90 +++ b/lib/extract/test_compare.f90 @@ -41,4 +41,4 @@ program test_compare call compare("a_int", a_int, a_int_correct) call compare_summary() -end program test_compare \ No newline at end of file +end program test_compare From 41e7b39cdcf5644f4781e96dc5fbeb7c7e2badb0 Mon Sep 17 00:00:00 2001 From: Joerg Henrichs Date: Tue, 8 Jul 2025 13:43:29 +1000 Subject: [PATCH 13/15] #2878 Ignore test binary. --- lib/extract/.gitignore | 1 + 1 file changed, 1 insertion(+) diff --git a/lib/extract/.gitignore b/lib/extract/.gitignore index d430e03be5..d283fa9128 100644 --- a/lib/extract/.gitignore +++ b/lib/extract/.gitignore @@ -1,2 +1,3 @@ # The leading / means only ignore the file in this directory /compare_variables_mod.F90 +test_ignore From c68f031615d5ecd29f3f10b0e8e99a397d1d6f85 Mon Sep 17 00:00:00 2001 From: Sergi Siso Date: Fri, 25 Jul 2025 08:42:18 +0100 Subject: [PATCH 14/15] #2878 Update changelog and gitignore --- changelog | 4 +++- lib/extract/.gitignore | 2 +- 2 files changed, 4 insertions(+), 2 deletions(-) diff --git a/changelog b/changelog index 4b54480a62..4713a5ec47 100644 --- a/changelog +++ b/changelog @@ -1,4 +1,6 @@ - 59) PR #2137 towards #1312: adds metadata support for read-only ScalarArrays + 60) PR #2907 for #2878. Improves Extraction library output stats. + + 59) PR #2137 towards #1312. Adds metadata support for read-only ScalarArrays in the LFRic DSL. 58) PR #3057 for 3056. Demote OpenMP lowering error to warning. diff --git a/lib/extract/.gitignore b/lib/extract/.gitignore index d283fa9128..3558d478b2 100644 --- a/lib/extract/.gitignore +++ b/lib/extract/.gitignore @@ -1,3 +1,3 @@ # The leading / means only ignore the file in this directory /compare_variables_mod.F90 -test_ignore +test_compare From df8ee64967087712787d746241059867f200aec6 Mon Sep 17 00:00:00 2001 From: Joerg Henrichs Date: Mon, 28 Jul 2025 18:10:47 +1000 Subject: [PATCH 15/15] #2878 Try to fix gfortran 15 compilation. --- lib/extract/compare_variables_mod.jinja | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/extract/compare_variables_mod.jinja b/lib/extract/compare_variables_mod.jinja index 18ffadfd92..5f595ea6ff 100644 --- a/lib/extract/compare_variables_mod.jinja +++ b/lib/extract/compare_variables_mod.jinja @@ -147,7 +147,7 @@ contains "#rel<1E-9", "#rel<1E-6", "#rel<1E-3", "#rel>=1E-3", & "max_abs", "max_rel", "l2_diff", "l2_cos" - out_format = trim(out_format)//"' ',6(I12, ' '),4(E12.7,' '))" + out_format = trim(out_format)//",' ',6(I12, ' '),4(E12.7,' '))" ! Then write out the results for each variable: do i=1, current_index