Skip to content

Commit 949afbc

Browse files
author
Steve Goldhaber
committed
Implement constituent index lookup routines
ccpp_constituent_index: Lookup index constituent by name ccpp_constituent_indices: Lookup indices of consitutents by name Add tests of this functionality into advection_test Minor code cleanup Update DDThost test for new CCPP source file
1 parent fca3a9e commit 949afbc

23 files changed

+464
-30
lines changed

‎scripts/ccpp_datafile.py‎

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1067,6 +1067,8 @@ def _add_generated_files(parent, host_files, suite_files, ccpp_kinds, src_dir):
10671067
entry = ET.SubElement(utilities, "file")
10681068
entry.text = os.path.join(src_dir, "ccpp_constituent_prop_mod.F90")
10691069
entry = ET.SubElement(utilities, "file")
1070+
entry.text = os.path.join(src_dir, "ccpp_scheme_utils.F90")
1071+
entry = ET.SubElement(utilities, "file")
10701072
entry.text = os.path.join(src_dir, "ccpp_hashable.F90")
10711073
entry = ET.SubElement(utilities, "file")
10721074
entry.text = os.path.join(src_dir, "ccpp_hash_table.F90")

‎scripts/constituents.py‎

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -608,6 +608,8 @@ def write_host_routines(cap, host, reg_funcname, init_funcname, num_const_funcna
608608
cap.write(f"{substmt}(ncols, num_layers, {err_dummy_str})", 1)
609609
cap.comment("Initialize constituent data", 2)
610610
cap.blank_line()
611+
cap.write("use ccpp_scheme_utils, only: ccpp_initialize_constituent_ptr", 2)
612+
cap.blank_line()
611613
cap.comment("Dummy arguments", 2)
612614
cap.write("integer, intent(in) :: ncols", 2)
613615
cap.write("integer, intent(in) :: num_layers", 2)
@@ -617,6 +619,7 @@ def write_host_routines(cap, host, reg_funcname, init_funcname, num_const_funcna
617619
cap.blank_line()
618620
call_str = f"call {const_obj_name}%lock_data(ncols, num_layers, {obj_err_callstr})"
619621
cap.write(call_str, 2)
622+
cap.write(f"call ccpp_initialize_constituent_ptr({const_obj_name})", 2)
620623
cap.write(f"end {substmt}", 1)
621624
# Write num_consts routine
622625
substmt = f"subroutine {num_const_funcname}"

‎scripts/host_cap.py‎

Lines changed: 0 additions & 16 deletions
Original file line numberDiff line numberDiff line change
@@ -101,14 +101,6 @@ def constituent_initialize_subname(host_model):
101101
Because this is a user interface API function, the name is fixed."""
102102
return f"{host_model.name}_ccpp_initialize_constituents"
103103

104-
###############################################################################
105-
def constituent_initialize_subname(host_model):
106-
###############################################################################
107-
"""Return the name of the subroutine used to initialize the
108-
constituents for this run.
109-
Because this is a user interface API function, the name is fixed."""
110-
return f"{host_model.name}_ccpp_initialize_constituents"
111-
112104
###############################################################################
113105
def constituent_num_consts_funcname(host_model):
114106
###############################################################################
@@ -125,14 +117,6 @@ def query_scheme_constituents_funcname(host_model):
125117
Because this is a user interface API function, the name is fixed."""
126118
return f"{host_model.name}_ccpp_is_scheme_constituent"
127119

128-
###############################################################################
129-
def query_scheme_constituents_funcname(host_model):
130-
###############################################################################
131-
"""Return the name of the function to return True if the standard name
132-
passed in matches an existing constituent
133-
Because this is a user interface API function, the name is fixed."""
134-
return f"{host_model.name}_ccpp_is_scheme_constituent"
135-
136120
###############################################################################
137121
def constituent_copyin_subname(host_model):
138122
###############################################################################

‎src/ccpp_constituent_prop_mod.F90‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -23,7 +23,7 @@ module ccpp_constituent_prop_mod
2323
integer, parameter :: mass_mixing_ratio = -5
2424
integer, parameter :: volume_mixing_ratio = -6
2525
integer, parameter :: number_concentration = -7
26-
integer, parameter :: int_unassigned = -HUGE(1)
26+
integer, public, parameter :: int_unassigned = -HUGE(1)
2727
real(kind_phys), parameter :: kphys_unassigned = HUGE(1.0_kind_phys)
2828

2929
!! \section arg_table_ccpp_constituent_properties_t

‎src/ccpp_scheme_utils.F90‎

Lines changed: 101 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,101 @@
1+
module ccpp_scheme_utils
2+
3+
! Module of utilities available to CCPP schemes
4+
5+
use ccpp_constituent_prop_mod, only: ccpp_model_constituents_t, int_unassigned
6+
7+
implicit none
8+
private
9+
10+
!! Public interfaces
11+
public :: ccpp_initialize_constituent_ptr ! Used by framework to initialize
12+
public :: ccpp_constituent_index ! Lookup index constituent by name
13+
public :: ccpp_constituent_indices ! Lookup indices of consitutents by name
14+
15+
!! Private module variables & interfaces
16+
17+
! initialized set to .true. once hash table pointer is initialized
18+
logical :: initialized = .false.
19+
type(ccpp_model_constituents_t), pointer :: constituent_obj => NULL()
20+
21+
private :: uninitialized
22+
23+
contains
24+
25+
subroutine uninitialized(caller, errcode, errmsg)
26+
! Dummy arguments
27+
character(len=*), intent(in) :: caller
28+
integer, optional, intent(out) :: errcode
29+
character(len=*), optional, intent(out) :: errmsg
30+
31+
if (.not. initialized) then
32+
if (present(errcode)) then
33+
errcode = 1
34+
end if
35+
if (present(errmsg)) then
36+
errmsg = trim(caller)//' FAILED, module not initialized'
37+
end if
38+
end if
39+
end subroutine uninitialized
40+
41+
subroutine ccpp_initialize_constituent_ptr(const_obj)
42+
! Dummy arguments
43+
type(ccpp_model_constituents_t), pointer, intent(in) :: const_obj
44+
45+
if (.not. initialized) then
46+
constituent_obj => const_obj
47+
initialized = .true.
48+
end if
49+
end subroutine ccpp_initialize_constituent_ptr
50+
51+
subroutine ccpp_constituent_index(standard_name, const_index, errcode, errmsg)
52+
! Dummy arguments
53+
character(len=*), intent(in) :: standard_name
54+
integer, intent(out) :: const_index
55+
integer, optional, intent(out) :: errcode
56+
character(len=*), optional, intent(out) :: errmsg
57+
58+
! Local variable
59+
character(len=*), parameter :: subname = 'ccpp_constituent_index'
60+
61+
if (initialized) then
62+
call constituent_obj%const_index(const_index, standard_name, &
63+
errcode, errmsg)
64+
else
65+
const_index = int_unassigned
66+
call uninitialized(subname)
67+
end if
68+
end subroutine ccpp_constituent_index
69+
70+
subroutine ccpp_constituent_indices(standard_names, const_inds, errcode, errmsg)
71+
! Dummy arguments
72+
character(len=*), intent(in) :: standard_names(:)
73+
integer, intent(out) :: const_inds(:)
74+
integer, optional, intent(out) :: errcode
75+
character(len=*), optional, intent(out) :: errmsg
76+
77+
! Local variables
78+
integer :: indx
79+
character(len=*), parameter :: subname = 'ccpp_constituent_indices'
80+
81+
const_inds = int_unassigned
82+
if (initialized) then
83+
if (size(const_inds) < size(standard_names)) then
84+
errcode = 1
85+
errmsg = subname//': const_inds too small'
86+
else
87+
do indx = 1, size(standard_names)
88+
! For each std name in <standard_names>, find the const. index
89+
call constituent_obj%const_index(const_inds(indx), &
90+
standard_names(indx), errcode, errmsg)
91+
if (errcode /= 0) then
92+
exit
93+
end if
94+
end do
95+
end if
96+
else
97+
call uninitialized(subname)
98+
end if
99+
end subroutine ccpp_constituent_indices
100+
101+
end module ccpp_scheme_utils

‎test/advection_test/cld_suite.xml‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -2,6 +2,7 @@
22

33
<suite name="cld_suite" version="1.0">
44
<group name="physics">
5+
<scheme>const_indices</scheme>
56
<scheme>cld_liq</scheme>
67
<scheme>apply_constituent_tendencies</scheme>
78
<scheme>cld_ice</scheme>

‎test/advection_test/cld_suite_files.txt‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,4 @@
11
cld_liq.meta
22
cld_ice.meta
33
apply_constituent_tendencies.meta
4+
const_indices.meta

‎test/advection_test/const_indices.F90‎

Lines changed: 77 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,77 @@
1+
! Test collection of constituent indices
2+
!
3+
4+
MODULE const_indices
5+
6+
USE ccpp_kinds, ONLY: kind_phys
7+
8+
IMPLICIT NONE
9+
PRIVATE
10+
11+
PUBLIC :: const_indices_init
12+
PUBLIC :: const_indices_run
13+
14+
CONTAINS
15+
16+
!> \section arg_table_const_indices_run Argument Table
17+
!! \htmlinclude arg_table_const_indices_run.html
18+
!!
19+
subroutine const_indices_run(const_std_name, num_consts, test_stdname_array, &
20+
const_index, const_inds, errmsg, errflg)
21+
use ccpp_scheme_utils, only: ccpp_constituent_index, ccpp_constituent_indices
22+
23+
character(len=*), intent(in) :: const_std_name
24+
integer, intent(in) :: num_consts
25+
character(len=*), intent(in) :: test_stdname_array(:)
26+
integer, intent(out) :: const_index
27+
integer, intent(out) :: const_inds(:)
28+
character(len=512), intent(out) :: errmsg
29+
integer, intent(out) :: errflg
30+
!----------------------------------------------------------------
31+
32+
integer :: indx
33+
34+
errmsg = ''
35+
errflg = 0
36+
37+
! Find the constituent index for <const_std_name>
38+
call ccpp_constituent_index(const_std_name, const_index, errflg, errmsg)
39+
if (errflg == 0) then
40+
call ccpp_constituent_indices(test_stdname_array, const_inds, errflg, errmsg)
41+
end if
42+
43+
end subroutine const_indices_run
44+
45+
!> \section arg_table_const_indices_init Argument Table
46+
!! \htmlinclude arg_table_const_indices_init.html
47+
!!
48+
subroutine const_indices_init(const_std_name, num_consts, test_stdname_array, &
49+
const_index, const_inds, errmsg, errflg)
50+
use ccpp_scheme_utils, only: ccpp_constituent_index, ccpp_constituent_indices
51+
52+
character(len=*), intent(in) :: const_std_name
53+
integer, intent(in) :: num_consts
54+
character(len=*), intent(in) :: test_stdname_array(:)
55+
integer, intent(out) :: const_index
56+
integer, intent(out) :: const_inds(:)
57+
character(len=512), intent(out) :: errmsg
58+
integer, intent(out) :: errflg
59+
!----------------------------------------------------------------
60+
61+
integer :: indx
62+
63+
errmsg = ''
64+
errflg = 0
65+
66+
! Find the constituent index for <const_std_name>
67+
call ccpp_constituent_index(const_std_name, const_index, errflg, errmsg)
68+
if (errflg == 0) then
69+
call ccpp_constituent_indices(test_stdname_array, const_inds, errflg, errmsg)
70+
end if
71+
72+
end subroutine const_indices_init
73+
74+
!! @}
75+
!! @}
76+
77+
END MODULE const_indices

‎test/advection_test/const_indices.meta‎

Lines changed: 108 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,108 @@
1+
# const_indices just returns some constituent indices as a test
2+
[ccpp-table-properties]
3+
name = const_indices
4+
type = scheme
5+
[ccpp-arg-table]
6+
name = const_indices_run
7+
type = scheme
8+
[ const_std_name ]
9+
standard_name = test_banana_name
10+
type = character | kind = len=*
11+
units = 1
12+
dimensions = ()
13+
protected = true
14+
intent = in
15+
[ num_consts ]
16+
standard_name = banana_array_dim
17+
long_name = Size of test_banana_name_array
18+
units = 1
19+
dimensions = ()
20+
type = integer
21+
intent = in
22+
[ test_stdname_array ]
23+
standard_name = test_banana_name_array
24+
type = character | kind = len=*
25+
units = count
26+
dimensions = (banana_array_dim)
27+
intent = in
28+
[ const_index ]
29+
standard_name = test_banana_constituent_index
30+
long_name = Constituent index
31+
units = 1
32+
dimensions = ()
33+
type = integer
34+
intent = out
35+
[ const_inds ]
36+
standard_name = test_banana_constituent_indices
37+
long_name = Array of constituent indices
38+
units = 1
39+
dimensions = (banana_array_dim)
40+
type = integer
41+
intent = out
42+
[ errmsg ]
43+
standard_name = ccpp_error_message
44+
long_name = Error message for error handling in CCPP
45+
units = none
46+
dimensions = ()
47+
type = character
48+
kind = len=512
49+
intent = out
50+
[ errflg ]
51+
standard_name = ccpp_error_code
52+
long_name = Error flag for error handling in CCPP
53+
units = 1
54+
dimensions = ()
55+
type = integer
56+
intent = out
57+
[ccpp-arg-table]
58+
name = const_indices_init
59+
type = scheme
60+
[ const_std_name ]
61+
standard_name = test_banana_name
62+
type = character | kind = len=*
63+
units = 1
64+
dimensions = ()
65+
protected = true
66+
intent = in
67+
[ num_consts ]
68+
standard_name = banana_array_dim
69+
long_name = Size of test_banana_name_array
70+
units = 1
71+
dimensions = ()
72+
type = integer
73+
intent = in
74+
[ test_stdname_array ]
75+
standard_name = test_banana_name_array
76+
type = character | kind = len=*
77+
units = count
78+
dimensions = (banana_array_dim)
79+
intent = in
80+
[ const_index ]
81+
standard_name = test_banana_constituent_index
82+
long_name = Constituent index
83+
units = 1
84+
dimensions = ()
85+
type = integer
86+
intent = out
87+
[ const_inds ]
88+
standard_name = test_banana_constituent_indices
89+
long_name = Array of constituent indices
90+
units = 1
91+
dimensions = (banana_array_dim)
92+
type = integer
93+
intent = out
94+
[ errmsg ]
95+
standard_name = ccpp_error_message
96+
long_name = Error message for error handling in CCPP
97+
units = none
98+
dimensions = ()
99+
type = character
100+
kind = len=512
101+
intent = out
102+
[ errflg ]
103+
standard_name = ccpp_error_code
104+
long_name = Error flag for error handling in CCPP
105+
units = 1
106+
dimensions = ()
107+
type = integer
108+
intent = out

0 commit comments

Comments
 (0)