{# 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                             !" }}
{{ "! ================================================== !" }}

{# This jinja template file creates a base class for a not-NAN
   verification library. It produces the required ProvideVariable()
   functions for the specified Fortran basic types. Any library
   using this base class can provide the required Fortran basic
   types (see ALL_TYPES below) and the list of array dimensions
   (see ALL_DIMS) that need to be supported when processing this
   template. 

   This NANTest base class depends on the PSyData base
   class, which will provide the other Fortran-type-specific
   functions for PreDeclarVariable(). Any function can obviously
   be overwritten by a derived class.
#}

{% if ALL_DIMS is not defined %}
   {# Support 1 to 4 dimensional arrays if not specified #}
   {% set ALL_DIMS = [1, 2, 3, 4] %}
{% endif %}

{# The types that are supported. The first entry of each tuple
   is the name used when naming subroutines and in user messages.
   The second entry is the Fortran declaration. The third entry
   is the number of bits. There is slightly different code
   required for 32 and 64 bit values (due to the fact that the
   Fortran transfer(value, mould) function leaves undefined bits
   when mould is larger than value.) #}

{% if ALL_TYPES is not defined %}
   {% set ALL_TYPES = [ ("Double", "real(kind=real64)",   64),
                        ("Real",   "real(kind=real32)",   32),
                        ("Int",    "integer(kind=int32)", 32) ] %}
{% endif %}

! -----------------------------------------------------------------------------
! BSD 3-Clause License
!
! Copyright (c) 2020-2021, 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 PSyData-based verification that floating point
!! input and output parameters are not NAN and not infinite.
!!

module nan_test_base_mod

    use, intrinsic :: iso_fortran_env, only : int64, int32,   &
                                              real32, real64, &
                                              stderr => Error_Unit
    use psy_data_base_mod, only : PSyDataBaseType, &
        nan_test_PSyDataShutdown, &
        nan_test_PSyDataInit, is_enabled, &
        nan_test_PSyDataStart, nan_test_PSyDataStop

    implicit none

    type, extends(PSyDataBaseType), public :: NANTestBaseType

    contains

        ! The various procedures used

        {# Collect and declare the various procedures for the same generic interface -#}
        {# ------------------------------------------------------------------------- -#}
        {% set all_declares=[] -%}
        {% set all_provides=[] -%}
        {% for name, type, bits in ALL_TYPES %}
        procedure :: ProvideScalar{{name}}
          {{- all_provides.append("ProvideScalar"~name) or "" }}
          {% for dim in ALL_DIMS %}
        procedure :: ProvideArray{{dim}}d{{name}}
            {{- all_provides.append("ProvideArray"~dim~"d"~name) or "" }}
          {% endfor %}
        {% endfor %}

        {% set indent="            " %}
        {% if GENERIC_PROVIDE %}
        !> The generic interface for providing the value of variables:
        generic, public :: ProvideVariable => &
            {{all_provides|join(", &\n"+indent) }}
        {% endif %}

    end type NANTestBaseType

contains

    ! =========================================================================
    ! Jinja created code.
    ! =========================================================================

{% for name, type, bits in ALL_TYPES %}

    ! =========================================================================
    ! Implementation for all {{type}} types
    ! =========================================================================
    ! -------------------------------------------------------------------------
    !> This subroutine checks if a floating point value is NAN or infinite
    !! using the IEEE_IS_FINIT function (and does nothing for integer types).
    !! @param[in,out] this The instance of the NANTestBaseType.
    !! @param[in] name The name of the variable (string).
    !! @param[in] value The value of the variable.
    subroutine ProvideScalar{{name}}(this, name, value)

        use, intrinsic :: ieee_arithmetic

        implicit none

        class(NANTestBaseType), intent(inout), target :: this
        character(*), intent(in)                      :: name
        {{type}}, intent(in)                          :: value

        {% if name != "Int" %}
        if (.not. is_enabled) return

        if (IEEE_SUPPORT_DATATYPE(value)) then
            if (.not. IEEE_IS_FINITE(value)) then
                write(stderr, '(8G0)') "PSyData: Variable ", name," has invalid value ", &
                                 value, " in module '", trim(this%module_name), &
                                 "' region '", trim(this%region_name),"'."
            endif
        endif
        {% else %}
        ! Variables of type {{type}} do not have NANs
        ! So nothing to do here.
        {% endif %}

        call this%PSyDataBaseType%ProvideScalar{{name}}(name, value)

    end subroutine ProvideScalar{{name}}

  {# Now provide the array implementations #}
  {# ------------------------------------- #}
  {% for dim in ALL_DIMS %}
    {# Create the ':,:,:,:' string
       We repeat the list [":"] DIM-times, which is then joined #}
    {% set DIMENSION=([":"]*dim)|join(",") %}

    {# Create list of variables: "i1, i2, i3, i4" #}
    {% set vars = "i"~range(1,dim+1)|join(", i") %}
    {% set indent = " "*3*dim %}

    ! -------------------------------------------------------------------------
    !> This method checks if an array contains NAN or infinite IEEE values (it
    !! does nothing in case that the array is an integer type).
    !! @param[in,out] this The instance of the NANTestBaseType.
    !! @param[in] name The name of the variable (string).
    !! @param[in] value The value of the variable.
    subroutine ProvideArray{{dim}}d{{name}}(this, name, value)

        use, intrinsic :: ieee_arithmetic

        implicit none

        class(NANTestBaseType), intent(inout), target :: this
        character(*), intent(in) :: name
        {{type}}, dimension({{DIMENSION}}), intent(in) :: value

        {# IEEE_SUPPORT_DATATYPE does not even compile for int data types #}
        {% if name != "Int" %}
        integer :: {{vars}}

        if (.not. is_enabled) return
        if (IEEE_SUPPORT_DATATYPE(value)) then
            {# The spaces take care of proper indentation #}
            {% for j in range(dim, 0, -1) %}
            {{ " "*3*(dim-j)}}do i{{j}}=1, size(value, {{j}})
            {% endfor %}
            {{indent}}if (.not. IEEE_IS_FINITE(value({{vars}}))) then
            {{indent}}    write(stderr, '(5G0,{{dim}}(G0,X),5G0)') "PSyData: Variable ", &
            {{indent}}                     name," has the invalid value ", &
            {{indent}}                     value({{vars}}), " at index/indices ", {{vars}}, &
            {{indent}}                     "in module '", trim(this%module_name), &
            {{indent}}                     "' region '", trim(this%region_name),"'."
            {{indent}}endif
            {% for j in range(dim, 0, -1) %}
            {{" "*3*(j-1)}}enddo
            {% endfor %}
        endif
        {% else %}
        ! Variables of type {{type}} do not have NANs
        ! So nothing to do here.
        {% endif %}

        call this%PSyDataBaseType%ProvideArray{{dim}}d{{name}}(name, value)

    end subroutine ProvideArray{{dim}}d{{name}}

  {% endfor -%}   {# for dim #}
{%- endfor -%}   {# for #}

    ! -------------------------------------------------------------------------

end module nan_test_base_mod
