Skip to content

Commit 77f505b

Browse files
committed
#2878 Added modified version of lfric kernel_data_netcdf file to support the new names of the various lfric fields.
1 parent 4aa085f commit 77f505b

File tree

1 file changed

+347
-0
lines changed

1 file changed

+347
-0
lines changed
Lines changed: 347 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,347 @@
1+
{# Added this as Jinja code so that it is understood that the
2+
comment does not apply to THIS file. #}
3+
{{ "! ================================================== !" }}
4+
{{ "! THIS FILE IS CREATED FROM THE JINJA TEMPLATE FILE. !" }}
5+
{{ "! DO NOT MODIFY DIRECTLY! !" }}
6+
{{ "! ================================================== !" }}
7+
8+
! -----------------------------------------------------------------------------
9+
! BSD 3-Clause License
10+
!
11+
! Copyright (c) 2020-2025, Science and Technology Facilities Council.
12+
! All rights reserved.
13+
!
14+
! Redistribution and use in source and binary forms, with or without
15+
! modification, are permitted provided that the following conditions are met:
16+
!
17+
! * Redistributions of source code must retain the above copyright notice, this
18+
! list of conditions and the following disclaimer.
19+
!
20+
! * Redistributions in binary form must reproduce the above copyright notice,
21+
! this list of conditions and the following disclaimer in the documentation
22+
! and/or other materials provided with the distribution.
23+
!
24+
! * Neither the name of the copyright holder nor the names of its
25+
! contributors may be used to endorse or promote products derived from
26+
! this software without specific prior written permission.
27+
!
28+
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
29+
! "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
30+
! LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
31+
! FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
32+
! COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
33+
! INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
34+
! BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
35+
! LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
36+
! CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
37+
! LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
38+
! ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
39+
! POSSIBILITY OF SUCH DAMAGE.
40+
! -----------------------------------------------------------------------------
41+
! Author J. Henrichs, Bureau of Meteorology
42+
! Modified I. Kavcic, Met Office
43+
44+
!> This module implements a simple NetCDF writer using the PSyData
45+
!! interface. It is specific to the LFRic infrastructure library.
46+
!! A Fortran code instrumented with corresponding calls
47+
!! to the PSyData API and linked in with this library will write
48+
!! the requested input and output parameters to a NetCDF file.
49+
!!
50+
51+
{% set ALL_PREC = ["32", "64"] -%}
52+
53+
module extract_psy_data_mod
54+
55+
use, intrinsic :: iso_fortran_env, only : int64, int32
56+
use extract_netcdf_base_mod, only : ExtractNetcdfBaseType, CheckError
57+
58+
implicit none
59+
60+
!> This is the data type that manages the information required
61+
!! to write data to a NetCDF file using the PSyData API. A
62+
!! static instance of this type is created for each instrumented
63+
!! region with PSyclone (and each region will write a separate
64+
!! file).
65+
type, extends(ExtractNetcdfBaseType), public :: extract_PSyDataType
66+
67+
contains
68+
{% set all_declares=[] -%}
69+
{% set all_writes=[] -%}
70+
{% for prec in ALL_PREC %}
71+
procedure :: DeclareField_r{{prec}}
72+
procedure :: WriteField_r{{prec}}
73+
procedure :: DeclareFieldVector_r{{prec}}
74+
procedure :: WriteFieldVector_r{{prec}}
75+
{{- all_declares.append("DeclareField_r{{prec}}") or ""}}
76+
{{- all_declares.append("DeclareFieldVector_r{{prec}}") or ""}}
77+
{{- all_writes.append("WriteField_r{{prec}}") or ""}}
78+
{{- all_writes.append("WriteFieldVector_r{{prec}}") or ""}}
79+
{% endfor %}
80+
81+
! The various procedures defined here
82+
procedure :: DeclareIntField
83+
procedure :: WriteIntField
84+
procedure :: DeclareIntFieldVector
85+
procedure :: WriteIntFieldVector
86+
87+
!> Declare generic interface for PreDeclareVariable:
88+
generic, public :: PreDeclareVariable => &
89+
{% for prec in ALL_PREC %}
90+
DeclareField_r{{prec}}, &
91+
DeclareFieldVector_r{{prec}}, &
92+
{% endfor %}
93+
DeclareIntField, &
94+
DeclareIntFieldVector
95+
96+
!> The generic interface for providing the value of variables,
97+
!! which in case of the kernel extraction writes the data to
98+
!! the NetCDF file.
99+
generic, public :: ProvideVariable => &
100+
{% for prec in ALL_PREC %}
101+
WriteField_r{{prec}}, &
102+
WriteFieldVector_r{{prec}}, &
103+
{% endfor %}
104+
WriteIntField, &
105+
WriteIntFieldVector
106+
107+
end type extract_PSyDataType
108+
109+
contains
110+
111+
112+
{% for prec in ALL_PREC %}
113+
114+
! -------------------------------------------------------------------------
115+
!> @brief This subroutine declares an LFRic field with real-valued
116+
!! {{prec}}-bit data.
117+
!! It calls the PreDeclareVariable function provided by the base class
118+
!! (depending on the type of the argument, e.g. it might call
119+
!! DeclareArray1dDouble).
120+
!! @param[in,out] this The instance of the extract_PSyDataType.
121+
!! @param[in] name The name of the variable (string).
122+
!! @param[in] value The value of the variable.
123+
subroutine DeclareField_r{{prec}}(this, name, value)
124+
125+
use field_real{{prec}}_mod, only : field_real{{prec}}_type, field_real{{prec}}_proxy_type
126+
127+
implicit none
128+
129+
class(extract_PSyDataType), intent(inout), target :: this
130+
character(*), intent(in) :: name
131+
type(field_real{{prec}}_type), intent(in) :: value
132+
133+
type(field_real{{prec}}_proxy_type) :: value_proxy
134+
135+
value_proxy = value%get_proxy()
136+
call this%PreDeclareVariable(name, value_proxy%data)
137+
138+
end subroutine DeclareField_r{{prec}}
139+
140+
! -------------------------------------------------------------------------
141+
!> @brief This subroutine writes the values of an LFRic real-valued {{prec}}-bit
142+
!! field to the NetCDF file. It uses the corresponding function
143+
!! provided by the base class.
144+
!! @param[in,out] this The instance of the extract_PSyDataType.
145+
!! @param[in] name The name of the variable (string).
146+
!! @param[in] value The value of the variable.
147+
subroutine WriteField_r{{prec}}(this, name, value)
148+
149+
use field_real{{prec}}_mod, only : field_real{{prec}}_type, field_real{{prec}}_proxy_type
150+
151+
implicit none
152+
153+
class(extract_PSyDataType), intent(inout), target :: this
154+
character(*), intent(in) :: name
155+
type(field_real{{prec}}_type), intent(in) :: value
156+
157+
type(field_real{{prec}}_proxy_type) :: value_proxy
158+
159+
value_proxy = value%get_proxy()
160+
call this%ProvideVariable(name, value_proxy%data)
161+
162+
end subroutine WriteField_r{{prec}}
163+
164+
! -------------------------------------------------------------------------
165+
!> @brief This subroutine declares an LFRic real-valued {{prec}}-bit field vector.
166+
!! Each component of the vector is stored as a separate variable, using the
167+
!! corresponding array function of the base class.
168+
!! @param[in,out] this The instance of the extract_PSyDataType.
169+
!! @param[in] name The name of the variable (string).
170+
!! @param[in] value The value of the variable.
171+
subroutine DeclareFieldVector_r{{prec}}(this, name, value)
172+
173+
use field_real{{prec}}_mod, only : field_real{{prec}}_type, field_real{{prec}}_proxy_type
174+
175+
implicit none
176+
177+
class(extract_PSyDataType), intent(inout), target :: this
178+
character(*), intent(in) :: name
179+
type(field_real{{prec}}_type), dimension(:), intent(in) :: value
180+
181+
integer :: i
182+
type(field_real{{prec}}_proxy_type) :: value_proxy
183+
character(9) :: number
184+
185+
! Provide each component of the vector as an individual 1D array.
186+
! The base class will re-allocate internal array sizes if required.
187+
do i = 1, size(value)
188+
value_proxy = value(i)%get_proxy()
189+
! We add a '%' here to avoid a potential name clash if
190+
! the user should have a vector field 'a' (which is now stored
191+
! as a%1, a%2, ...), and a field 'a1'
192+
write(number, '("%",i0)') i
193+
call this%PreDeclareVariable(name//trim(number), value_proxy%data)
194+
enddo
195+
196+
end subroutine DeclareFieldVector_r{{prec}}
197+
198+
! -------------------------------------------------------------------------
199+
!> @brief This subroutine writes an LFRic real-valued {{prec}}-bit field vector to
200+
!! the NetCDF file. Each component is stored as an individual variable using
201+
!! the corresponding array function of the base class.
202+
!! @param[in,out] this The instance of the extract_PSyDataType.
203+
!! @param[in] name The name of the variable (string).
204+
!! @param[in] value The value of the variable.
205+
subroutine WriteFieldVector_r{{prec}}(this, name, value)
206+
207+
use field_real{{prec}}_mod, only : field_real{{prec}}_type, field_real{{prec}}_proxy_type
208+
209+
implicit none
210+
211+
class(extract_PSyDataType), intent(inout), target :: this
212+
character(*), intent(in) :: name
213+
type(field_real{{prec}}_type), dimension(:), intent(in) :: value
214+
215+
integer :: i
216+
type(field_real{{prec}}_proxy_type) :: value_proxy
217+
character(9) :: number
218+
219+
! Provide each dimension of the vector as an individual 1D array.
220+
do i = 1, size(value, 1)
221+
value_proxy = value(i)%get_proxy()
222+
write(number, '("%",i0)') i
223+
call this%ProvideVariable(name//trim(number), value_proxy%data)
224+
enddo
225+
226+
end subroutine WriteFieldVector_r{{prec}}
227+
228+
{% endfor %}
229+
230+
! -------------------------------------------------------------------------
231+
!> @brief This subroutine declares an LFRic field with integer-valued data.
232+
!! It calls the PreDeclareVariable function provided by the base class
233+
!! (depending on the type of the argument, e.g. it might call
234+
!! DeclareArray1dInt).
235+
!! @param[in,out] this The instance of the extract_PSyDataType.
236+
!! @param[in] name The name of the variable (string).
237+
!! @param[in] value The value of the variable.
238+
subroutine DeclareIntField(this, name, value)
239+
240+
use integer_field_mod, only : integer_field_type, &
241+
integer_field_proxy_type
242+
243+
implicit none
244+
245+
class(extract_PSyDataType), intent(inout), target :: this
246+
character(*), intent(in) :: name
247+
type(integer_field_type), intent(in) :: value
248+
249+
type(integer_field_proxy_type) :: value_proxy
250+
251+
value_proxy = value%get_proxy()
252+
call this%PreDeclareVariable(name, value_proxy%data)
253+
254+
end subroutine DeclareIntField
255+
256+
! -------------------------------------------------------------------------
257+
!> @brief This subroutine writes the values of an LFRic integer-valued field.
258+
!! to the NetCDF file. It uses the corresponding function
259+
!! provided by the base class.
260+
!! @param[in,out] this The instance of the extract_PSyDataType.
261+
!! @param[in] name The name of the variable (string).
262+
!! @param[in] value The value of the variable.
263+
subroutine WriteIntField(this, name, value)
264+
265+
use integer_field_mod, only : integer_field_type, &
266+
integer_field_proxy_type
267+
268+
implicit none
269+
270+
class(extract_PSyDataType), intent(inout), target :: this
271+
character(*), intent(in) :: name
272+
type(integer_field_type), intent(in) :: value
273+
274+
type(integer_field_proxy_type) :: value_proxy
275+
276+
value_proxy = value%get_proxy()
277+
call this%ProvideVariable(name, value_proxy%data)
278+
279+
end subroutine WriteIntField
280+
281+
! -------------------------------------------------------------------------
282+
!> @brief This subroutine declares an LFRic integer-valued field vector. Each
283+
!! component of the vector is stored as a separate variable, using the
284+
!! corresponding array function of the base class.
285+
!! @param[in,out] this The instance of the extract_PSyDataType.
286+
!! @param[in] name The name of the variable (string).
287+
!! @param[in] value The value of the variable.
288+
subroutine DeclareIntFieldVector(this, name, value)
289+
290+
use integer_field_mod, only : integer_field_type, &
291+
integer_field_proxy_type
292+
293+
implicit none
294+
295+
class(extract_PSyDataType), intent(inout), target :: this
296+
character(*), intent(in) :: name
297+
type(integer_field_type), dimension(:), intent(in) :: value
298+
299+
integer :: i
300+
type(integer_field_proxy_type) :: value_proxy
301+
character(9) :: number
302+
303+
! Provide each component of the vector as an individual 1D array.
304+
! The base class will re-allocate internal array sizes if required.
305+
do i = 1, size(value)
306+
value_proxy = value(i)%get_proxy()
307+
! We add a '%' here to avoid a potential name clash if
308+
! the user should have a vector field 'a' (which is now stored
309+
! as a%1, a%2, ...), and a field 'a1'.
310+
write(number, '("%",i0)') i
311+
call this%PreDeclareVariable(name//trim(number), value_proxy%data)
312+
enddo
313+
314+
end subroutine DeclareIntFieldVector
315+
316+
! -------------------------------------------------------------------------
317+
!> @brief This subroutine writes an LFRic integer-valued field vector to the
318+
!! NetCDF file. Each component is stored as an individual variable
319+
!! using the corresponding array function of the base class.
320+
!! @param[in,out] this The instance of the extract_PSyDataType.
321+
!! @param[in] name The name of the variable (string).
322+
!! @param[in] value The value of the variable.
323+
subroutine WriteIntFieldVector(this, name, value)
324+
325+
use integer_field_mod, only : integer_field_type, &
326+
integer_field_proxy_type
327+
328+
implicit none
329+
330+
class(extract_PSyDataType), intent(inout), target :: this
331+
character(*), intent(in) :: name
332+
type(integer_field_type), dimension(:), intent(in) :: value
333+
334+
integer :: i
335+
type(integer_field_proxy_type) :: value_proxy
336+
character(9) :: number
337+
338+
! Provide each dimension of the vector as an individual 1D array.
339+
do i = 1, size(value, 1)
340+
value_proxy = value(i)%get_proxy()
341+
write(number, '("%",i0)') i
342+
call this%ProvideVariable(name//trim(number), value_proxy%data)
343+
enddo
344+
345+
end subroutine WriteIntFieldVector
346+
347+
end module extract_psy_data_mod

0 commit comments

Comments
 (0)