FMS 2025.01.02-dev
Flexible Modeling System
Loading...
Searching...
No Matches
fms_diag_elem_weight_procs.F90
1!***********************************************************************
2!* GNU Lesser General Public License
3!*
4!* This file is part of the GFDL Flexible Modeling System (FMS).
5!*
6!* FMS is free software: you can redistribute it and/or modify it under
7!* the terms of the GNU Lesser General Public License as published by
8!* the Free Software Foundation, either version 3 of the License, or (at
9!* your option) any later version.
10!*
11!* FMS is distributed in the hope that it will be useful, but WITHOUT
12!* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
13!* FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
14!* for more details.
15!*
16!* You should have received a copy of the GNU Lesser General Public
17!* License along with FMS. If not, see <http://www.gnu.org/licenses/>.
18!***********************************************************************
19
20!> @defgroup fms_diag_elem_weight_procs_mod fms_diag_elem_weight_procs_mod
21!> @ingroup diag_manager
22!> @brief fms_diag_elem_weight_procs_mod Contains elemental functions for uddating
23!! one element of a buffer array with field data.
24!!
25!> @author Miguel Zuniga
26!!
27!! <TT>fms_diag_elem_weight_procs_mod</TT> Contains elemental functions for uddating
28!! one element of a buffer array with field data,
29!!
30!> @file
31!> @brief File for @ref fms_diag_elem_weight_procs_mod
32!> @addtogroup fms_diag_elem_weight_procs_mod
33!> @{
34MODULE fms_diag_elem_weight_procs_mod
35 USE platform_mod
36
37 implicit none
38
39 !> @brief Interface for the elemental function addwf, which
40 !! Calculates and returns the value given by this formula:
41 !! returned_value = buff + (weight * field)**pow_value
42 !> @ingroup fms_diag_elem_weight_procs_mod
43 INTERFACE addwf
44 module procedure addwf_r4
45 module procedure addwf_r8
46 module procedure addwf_i4
47 module procedure addwf_i8
48 END INTERFACE
49
50CONTAINS
51
52 !!TODO: Note that in the functions below, the case for pow_value == 2 was
53 !! not in the original send_data_3d code and the power function was used.
54 !! So this case may need to be deleted if reproducability is an issue.
55
56 !!TODO: (MDM) Discuss whether or not the pow_value should be allowed to
57 !! also be real though legacy interface has it satic.
58
59 !> @brief Calculates and returns the value given by this formula:
60 !! returned_value = buff + (weight * field)**pow_value
61 !! Special cases when pow_value is equal to 1 or 2 do not explicitly use the power function.
62 ELEMENTAL REAL(r4_kind) FUNCTION addwf_r4(buff, field, weight, pow_value )
63 REAL(r4_kind), INTENT(in) :: buff !< The buffer cell (point) value
64 REAL(r4_kind), INTENT(IN) :: field !< The field value
65 REAL(r4_kind), INTENT(IN) :: weight !< The weight factor for the field
66 INTEGER, INTENT(IN) :: pow_value !< The power value for the power function
67
68 SELECT CASE(pow_value)
69 CASE (1)
70 addwf_r4 = buff + weight * field
71 CASE (2)
72 addwf_r4 = buff + (weight * field) * (weight * field)
73 CASE default
74 addwf_r4 = buff + (weight * field) ** pow_value
75 END SELECT
76 END FUNCTION addwf_r4
77
78 !> @brief Calculates and returns the value given by this formula:
79 !! returned_value = buff + (weight * field)**pow_value
80 !! Special cases when pow_value is equal to 1 or 2 do not explicitly use the power function.
81 ELEMENTAL REAL(r8_kind) FUNCTION addwf_r8(buff, field, weight, pow_value )
82 REAL(r8_kind), INTENT(in) :: buff !< The buffer cell (point) value
83 REAL(r8_kind) ,INTENT(IN) :: field !< The field value
84 REAL(r8_kind), INTENT(IN) :: weight !< The weight factor for the field
85 INTEGER, INTENT(IN) :: pow_value !< The power value for the power function
86
87 SELECT CASE(pow_value)
88 CASE (1)
89 addwf_r8 = buff + weight * field
90 CASE (2)
91 addwf_r8 = buff + (weight * field) * (weight * field)
92 CASE default
93 addwf_r8 = buff + (weight * field) ** pow_value
94 END SELECT
95 END FUNCTION addwf_r8
96
97 !> @brief Calculates and returns the value given by this formula:
98 !! returned_value = buff + (weight * field)**pow_value
99 !! Special cases when pow_value is equal to 1 or 2 do not explicitly use the power function.
100 ELEMENTAL INTEGER(i4_kind) FUNCTION addwf_i4(buff, field, weight, pow_value )
101 INTEGER(i4_kind), INTENT(in) :: buff !< The buffer cell (point) value
102 INTEGER(i4_kind), INTENT(IN) :: field !< The field value
103 INTEGER, INTENT(IN) :: weight !< The weight factor for the field
104 INTEGER, INTENT(IN) :: pow_value !< The power value for the power function
105 SELECT CASE(pow_value)
106 CASE (1)
107 addwf_i4 = buff + weight * field
108 CASE (2)
109 addwf_i4 = buff + (weight * field) * (weight * field)
110 CASE default
111 addwf_i4 = buff + (weight * field) ** pow_value
112 END SELECT
113 END FUNCTION addwf_i4
114
115 !> @brief Calculates and returns the value given by this formula:
116 !! returned_value = buff + (weight * field)**pow_value
117 !! Special cases when pow_value is equal to 1 or 2 do not explicitly use the power function.
118 ELEMENTAL INTEGER(i8_kind) FUNCTION addwf_i8(buff, field, weight, pow_value )
119 INTEGER(i8_kind), INTENT(in) :: buff !< The buffer cell (point) value
120 INTEGER(i8_kind) ,INTENT(IN) :: field !< The field value
121 INTEGER, INTENT(IN) :: weight !< The weight factor for the field
122 INTEGER, INTENT(IN) :: pow_value !< The power value for the power function
123
124 SELECT CASE(pow_value)
125 CASE (1)
126 addwf_i8 = buff + weight * field
127 CASE (2)
128 addwf_i8 = buff + (weight * field) * (weight * field)
129 CASE default
130 addwf_i8 = buff + (weight * field) ** pow_value
131 END SELECT
132 END FUNCTION addwf_i8
133END MODULE fms_diag_elem_weight_procs_mod
134!> @}
135! close documentation grouping
136
elemental real(r4_kind) function addwf_r4(buff, field, weight, pow_value)
Calculates and returns the value given by this formula: returned_value = buff + (weight * field)**pow...
elemental real(r8_kind) function addwf_r8(buff, field, weight, pow_value)
Calculates and returns the value given by this formula: returned_value = buff + (weight * field)**pow...
elemental integer(i4_kind) function addwf_i4(buff, field, weight, pow_value)
Calculates and returns the value given by this formula: returned_value = buff + (weight * field)**pow...
elemental integer(i8_kind) function addwf_i8(buff, field, weight, pow_value)
Calculates and returns the value given by this formula: returned_value = buff + (weight * field)**pow...
Interface for the elemental function addwf, which Calculates and returns the value given by this form...