{# 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 ReadOnly
   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 template will also provide checksum computing
   functions for any combination of dimension and basic type.
   These function can be used in any derived type to do the
   actual checksum computation.

   This ReadOnly 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 verification that read-only fields are
!! not overwritten (due to memory overwrites etc)
!!

module read_only_base_mod

    use, intrinsic :: iso_fortran_env, only : int64, int32,   &
                                              real32, real64, &
                                              stderr => Error_Unit
    use psy_data_base_mod, only : PSyDataBaseType, &
        read_only_verify_PSyDataShutdown, &
        read_only_verify_PSyDataInit, is_enabled, &
        read_only_verify_PSyDataStart, read_only_verify_PSyDataStop

    implicit none

    !> This is the data type that stores a checksum for each read-only
    !! variable. A static instance of this type is created for each
    !! instrumented region with PSyclone.

    type, extends(PSyDataBaseType), public :: ReadOnlyBaseType

        !> This field stores a 64-bit integer checksum for each
        !! variable.
        integer(kind=int64), dimension(:), allocatable :: checksums

        !> This boolean flag switches from 'computing and storing checksum'
        !! to 'verify checksum'.
        logical :: verify_checksums

    contains

        ! The various procedures used
        procedure :: PreStart
        procedure :: PreEndDeclaration
        procedure :: PostStart

        {# Collect the various procedures for the same generic interface -#}
        {# ------------------------------------------------------------- -#}
        {% 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,
        !! which in case of the read-only verification either computes
        !! the checksum (before a kernel), or compares a checksum (after
        !! a kernel call). The generic interface is only defined if
        !! explicitly requested. This allows a derived class to implement
        !! its own functions and provide them as part of the generic
        !! interface.
        generic, public :: ProvideVariable => &
            {{all_provides|join(", &\n"+indent) }}
        {% endif %}

    end type ReadOnlyBaseType

    {# Create a generic interface for all ComputeChecksum functions #}
    {# ------------------------------------------------------------ #}
    {% set all_compute = [] -%}
    {% for name, type, bits in ALL_TYPES %}
      {% for dim in ALL_DIMS %}
        {{- all_compute.append("ComputeChecksum"~dim~"d"~name) or "" -}}
      {% endfor %}
    {% endfor %}
    {% set indent="        " %}

    ! Generic interface for all ComputeChecksum functions
    interface ComputeChecksum
      module procedure &
        {{ all_compute|join(", &\n"+indent) }}
    end interface ComputeChecksum

    public ComputeChecksum

contains

    ! -------------------------------------------------------------------------
    !> This subroutine is the first function called when an instrumented region
    !! is entered. It initialises this object, and stores module and regin
    !! names.
    !! @param[in,out] this The instance of the ReadOnlyBaseType.
    !! @param[in] module_name The name of the module of the instrumented
    !!            region.
    !! @param[in] kernel_name The name of the instrumented region.
    !! @param[in] num_pre_vars The number of variables that are declared and
    !!            checksum'ed before the instrumented region.
    !! @param[in] num_post_vars The number of variables that are also declared
    !!            before an instrumented region of code, but are checksum'ed
    !!            after this region.
    subroutine PreStart(this, module_name, region_name, num_pre_vars, &
                        num_post_vars)

        implicit none

        class(ReadOnlyBaseType), intent(inout), target :: this
        character(*), intent(in) :: module_name, region_name
        integer, intent(in)      :: num_pre_vars, num_post_vars

        character(1) :: verbose
        integer :: status

        call this%PSyDataBaseType%PreStart(module_name, region_name, &
                                           num_pre_vars, num_post_vars)
        this%verify_checksums = .false.

        if (.not. is_enabled) return

        if (num_pre_vars /= num_post_vars) then
            write(stderr, *) "PSyData: The same number of variables must be provided before"
            write(stderr, *) "and after the instrumented region. But the values are:"
            write(stderr, *) "Before: ", num_pre_vars, " after: ", num_post_vars
            call this%Abort("PreStart: Inconsistent parameters")
        endif

    end subroutine PreStart

    ! -------------------------------------------------------------------------
    !> This subroutine is called once all variables are declared. It makes
    !! sure that the next variable index is starting at 1 again.
    !! @param[in,out] this The instance of the ReadOnlyBaseType.
    subroutine PreEndDeclaration(this)

        implicit none

        class(ReadOnlyBaseType), intent(inout), target :: this
        integer :: err

        if (.not. is_enabled) return

        ! During the declaration the number of checksums to be
        ! stored was counted in next_var_index, so allocate the array
        ! now (if it has not been allocated already in a previous call):
        if (.not. allocated(this%checksums)) then
            allocate(this%checksums(this%next_var_index-1), stat=err)
            if(err/=0) then
                write(stderr, *) "PSyData: Could not allocate ", &
                                 this%next_var_index-1,          &
                                 " integers, aborting."
                call this%Abort("Out of memory")
            endif
        endif

        call this%PSyDataBaseType%PreEndDeclaration()

    end subroutine PreEndDeclaration

    ! -------------------------------------------------------------------------
    !> This subroutine is called after the instrumented region has been
    !! executed. After this call the value of variables after the instrumented
    !! region will be provided. This subroutine sets the 'verify_checksum'
    !! flag to true, causing all further checksum calls to verify that the
    !! checksum has not changed. It also resets the next variable index to 1
    !! again.
    !! @param[in,out] this The instance of the ReadOnlyBaseType.
    subroutine PostStart(this)

        implicit none

        class(ReadOnlyBaseType), intent(inout), target :: this

        call this%PSyDataBaseType%PostStart()
        ! The pointer mst be reset to 1 to make sure we compare
        ! with the previously computed checksums
        this%next_var_index = 1
        this%verify_checksums = .true.

    end subroutine PostStart


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

{# Note that we create stand-alone functions for computing the checksums
   of arrays. They can be useful for any derived class that need that
   functionality for API-specific classes (e.g. ProvideFieldDouble in
    LFRic which uses ComputeChecksum1dDouble)
#}

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

    ! =========================================================================
    ! Implementation for all {{type}} types
    ! =========================================================================
    ! -------------------------------------------------------------------------
    !> This subroutine either computes a checksum or compares a checksum
    !! (depending on this%verify_checksums) for a single {{name}}.
    !! @param[in,out] this The instance of the ReadOnlyBaseType.
    !! @param[in] name The name of the variable (string).
    !! @param[in] value The value of the variable.
    subroutine ProvideScalar{{name}}(this, name, value)

        implicit none

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

        {{type}}            :: orig_value
        integer(kind=int64) :: checksum, int_64

        {% if bits==32 %}
        integer(kind=int32) :: int_32
        {% endif %}

        if (.not. is_enabled) return

        {% if bits == 32 %}
        ! `transfer` leaves undefined bits in a 64-bit value
        ! so assign to 32-bit, then assign to 64-bit to have all bits defined
        int_32 = transfer(value, int_32)
        checksum = int_32
        {% elif bits == 64 %}
        checksum = transfer(value, int_64)
        {% else %}
        ERROR - UNSUPPORTED BIT SIZE {{bits}}!
        {% endif %}

        if (this%verify_checksums) then
            if (checksum /= this%checksums(this%next_var_index)) then
                write(stderr,*) "------------- PSyData -------------------------"
                write(stderr,*) "{{type}} variable ", name, " has been modified in ", &
                    trim(this%module_name)," : ", trim(this%region_name)
                ! We can recreate the original value which is stored as
                ! 64-bit integer as the checksum:
                {% if bits == 32 %}
                int_32 = this%checksums(this%next_var_index)
                orig_value = transfer(int_32, orig_value)
                {% elif bits == 64 %}
                orig_value = transfer(this%checksums(this%next_var_index), orig_value)
                {% else %}
                ERROR - UNSUPPORTED BIT SIZE {{bits}}!
                {% endif %}
                write(stderr,*) "Original value: ", orig_value
                write(stderr,*) "New value:      ", value
                write(stderr,*) "------------- PSyData -------------------------"
            else if(this%verbosity>1) then
                write(stderr,*) "PSyData: checked variable ", trim(name)
            endif
        else
            this%checksums(this%next_var_index) = checksum
        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(",") %}
    ! -------------------------------------------------------------------------
    !> This subroutine either computes a checksum or compares a checksum
    !! (depending on this%verify_checksums) for a {{dim}}d-array of integer
    !! @param[in,out] this The instance of the ReadOnlyBaseType.
    !! @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)

        implicit none

        class(ReadOnlyBaseType), intent(inout), target :: this
        character(*), intent(in) :: name
        {{type}}, dimension({{DIMENSION}}), intent(in) :: value
        integer(kind=int64) :: checksum
        integer :: i, j

        if (.not. is_enabled) return

        checksum = ComputeChecksum(value)
        if (this%verify_checksums) then
            if (checksum /= this%checksums(this%next_var_index)) then
                write(stderr,*) "------------- PSyData -------------------------"
                write(stderr,*) "{{dim}}d {{name}} array ", name, " has been modified in ", &
                    trim(this%module_name)," : ", trim(this%region_name)
                write(stderr,*) "Original checksum: ", this%checksums(this%next_var_index)
                write(stderr,*) "New checksum:      ", checksum
                write(stderr,*) "------------- PSyData -------------------------"
            else if(this%verbosity>1) then
                write(stderr,*) "PSyData: checked variable ", trim(name)
            endif
        else
            this%checksums(this%next_var_index) = checksum
        endif

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

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

    {# Now declare the checksum computing helper functions. #}
    {# Create list of variables: "i1,i2,i3,i4" #}
    {% set vars = "i"~range(1,dim+1)|join(",i") %}
    {% set indent = " "*3*dim %}

    ! -------------------------------------------------------------------------
    !> This function computes a 64-bit integer checksum for a {{dim}}d
    !! {{type}} Fortran array.
    function ComputeChecksum{{dim}}d{{name}}(field) result(checksum)

        implicit none

        {{type}}, dimension({{DIMENSION}}) :: field

        integer :: {{vars}}
        {% if bits == 32 %}
        integer(kind=int32) :: int_32
        {% endif %}
        integer(kind=int64) :: checksum, int_64

        {# The spaces take care of proper indentation #}
        checksum = 0
        {% for j in range(dim, 0, -1) %}
        {{" "*3*(dim-j)}}do i{{j}}=1, size(field, {{j}})
        {% endfor %}
        {% if bits == 32 %}
        {{indent}}! transfer leaves undefined bits in a 64-bit target
        {{indent}}! so we transfer to 32-bits and then assign to 64-bit
        {{indent}}int_32 = transfer(field({{vars}}), int_32)
        {{indent}}int_64 = int_32
        {% elif bits == 64 %}
        {{indent}}int_64 = transfer(field({{vars}}), checksum)
        {% else %}
        ERROR - UNSUPPORTED BIT SIZE {{bits}}!
        {% endif %}
        {{indent}}checksum = checksum + int_64
        {% for j in range(dim, 0, -1) %}
        {{" "*3*(j-1)}}enddo
        {% endfor %}

    end function ComputeChecksum{{dim}}d{{name}}

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

end module read_only_base_mod
