Skip to content

+Add and use trim_trailing_commas() and ints_to_string() #1011

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Open
Hallberg-NOAA wants to merge 2 commits into
base: dev/gfdl
Choose a base branch
from
Open

+Add and use trim_trailing_commas() and ints_to_string() #1011

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
c0e68a0
+Add trim_trailing_commas and ints_to_string
Hallberg-NOAA Jan 2, 2026
d0c03c1
Call trim_trailing_commas from register_diag_field
Hallberg-NOAA Jan 2, 2026
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
46 changes: 5 additions & 41 deletions src/framework/MOM_diag_mediator.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -29,7 +29,7 @@ module MOM_diag_mediator
use MOM_io, only : slasher, vardesc, query_vardesc, MOM_read_data
use MOM_io, only : get_filename_appendix
use MOM_safe_alloc, only : safe_alloc_ptr, safe_alloc_alloc
use MOM_string_functions, only : lowercase
use MOM_string_functions, only : lowercase, ints_to_string, trim_trailing_commas
use MOM_time_manager, only : time_type
use MOM_time_manager, only : get_time
use MOM_unit_scaling, only : unit_scale_type
Expand Down Expand Up @@ -1056,7 +1056,7 @@ subroutine define_axes_group(diag_cs, handles, axes, nz, vertical_coordinate_num
n = size(handles)
if (n<1 .or. n>3) call MOM_error(FATAL, "define_axes_group: wrong size for list of handles!")
allocate( axes%handles(n) )
axes%id = i2s(handles, n) ! Identifying string
axes%id = ints_to_string(handles, max(n,3)) ! Identifying string
axes%rank = n
axes%handles(:) = handles(:)
axes%diag_cs => diag_cs ! A [circular] link back to the diag_cs structure
Expand Down Expand Up @@ -1169,7 +1169,7 @@ subroutine define_axes_group_dsamp(diag_cs, handles, axes, dl, nz, vertical_coor
n = size(handles)
if (n<1 .or. n>3) call MOM_error(FATAL, "define_axes_group: wrong size for list of handles!")
allocate( axes%handles(n) )
axes%id = i2s(handles, n) ! Identifying string
axes%id = ints_to_string(handles, max(n,3)) ! Identifying string
axes%rank = n
axes%handles(:) = handles(:)
axes%diag_cs => diag_cs ! A [circular] link back to the diag_cs structure
Expand Down Expand Up @@ -2437,14 +2437,7 @@ integer function register_diag_field(module_name, field_name, axes_in, init_time
if (axes_in%is_v_point) dimensions = trim(dimensions)//" xh, yq,"
if (axes_in%is_layer) dimensions = trim(dimensions)//" zl,"
if (axes_in%is_interface) dimensions = trim(dimensions)//" zi,"

if (len_trim(dimensions) > 0) then
dimensions = trim(adjustl(dimensions))
if (dimensions(len_trim(dimensions):len_trim(dimensions)) == ",") then
dimensions = dimensions(1:len_trim(dimensions) - 1)
endif
dimensions = trim(dimensions)
endif
if (len_trim(dimensions) > 0) dimensions = trim_trailing_commas(dimensions)

if (is_root_pe() .and. (diag_CS%available_diag_doc_unit > 0)) then
msg = ''
Expand Down Expand Up @@ -3181,14 +3174,7 @@ function register_static_field(module_name, field_name, axes, &
if (axes%is_v_point) dimensions = trim(dimensions)//" xh, yq,"
if (axes%is_layer) dimensions = trim(dimensions)//" zl,"
if (axes%is_interface) dimensions = trim(dimensions)//" zi,"

if (len_trim(dimensions) > 0) then
dimensions = trim(adjustl(dimensions))
if (dimensions(len_trim(dimensions):len_trim(dimensions)) == ",") then
dimensions = dimensions(1:len_trim(dimensions) - 1)
endif
dimensions = trim(dimensions)
endif
if (len_trim(dimensions) > 0) dimensions = trim_trailing_commas(dimensions)

! Document diagnostics in list of available diagnostics
if (is_root_pe() .and. diag_CS%available_diag_doc_unit > 0) then
Expand Down Expand Up @@ -3860,28 +3846,6 @@ subroutine diag_mediator_end(time, diag_CS, end_diag_manager)

end subroutine diag_mediator_end

!> Convert the first n elements (up to 3) of an integer array to an underscore delimited string.
function i2s(a,n_in)
! "Convert the first n elements of an integer array to a string."
! Perhaps this belongs elsewhere in the MOM6 code?
integer, dimension(:), intent(in) :: a !< The array of integers to translate
integer, optional , intent(in) :: n_in !< The number of elements to translate, by default all
character(len=15) :: i2s !< The returned string

character(len=15) :: i2s_temp
integer :: i,n

n=size(a)
if (present(n_in)) n = n_in

i2s = ''
do i=1,min(n,3)
write (i2s_temp, '(I4.4)') a(i)
i2s = trim(i2s) //'_'// trim(i2s_temp)
enddo
i2s = adjustl(i2s)
end function i2s

!> Returns a new diagnostic id, it may be necessary to expand the diagnostics array.
integer function get_new_diag_id(diag_cs)
type(diag_ctrl), intent(inout) :: diag_cs !< Diagnostics control structure
Expand Down
49 changes: 49 additions & 0 deletions src/framework/MOM_string_functions.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -17,6 +17,8 @@ module MOM_string_functions
public extract_real
public remove_spaces
public slasher
public trim_trailing_commas
public ints_to_string

contains

Expand Down Expand Up @@ -326,6 +328,10 @@ logical function string_functions_unit_tests(verbose)
fail = fail .or. localTestS(v,left_reals(r(:)),'0.0, 1.0, -2.0, 1.3, 3*3.0E-11, -5.1E+12')
fail = fail .or. localTestS(v,left_reals(r(:),sep=' '),'0.0 1.0 -2.0 1.3 3*3.0E-11 -5.1E+12')
fail = fail .or. localTestS(v,left_reals(r(:),sep=','),'0.0,1.0,-2.0,1.3,3*3.0E-11,-5.1E+12')
fail = fail .or. localTestS(v,ints_to_string(i(:),5),'_-0001_0001_0003_0003_0000')
fail = fail .or. localTestS(v,ints_to_string(i(2:),2),'_0001_0003')
fail = fail .or. localTestS(v,ints_to_string(i(:)),'_-0001_0001_0003')
fail = fail .or. localTestS(v,trim_trailing_commas("One, Two, Three, "), "One, Two, Three")
fail = fail .or. localTestS(v,extractWord("One Two,Three",1),"One")
fail = fail .or. localTestS(v,extractWord("One Two,Three",2),"Two")
fail = fail .or. localTestS(v,extractWord("One Two,Three",3),"Three")
Expand Down Expand Up @@ -417,6 +423,49 @@ function slasher(dir)
endif
end function slasher

!> Returns a left-adjusted string with trailing blanks and commas removed.
function trim_trailing_commas(in_str) result(out_str)
character(len=*), intent(in) :: in_str !< A string that is to be left adjusted and have
!! its trailing commas and white space removed.
character(len=len(in_str)) :: out_str !< A left-adjusted version of in_str with
!! trailing commas and white space removed

out_str = trim(adjustl(in_str))
if (len_trim(out_str) > 0) then
if (out_str(len_trim(out_str):len_trim(out_str)) == ",") then
out_str = out_str(1:len_trim(out_str) - 1)
endif
out_str = trim(out_str)
endif

end function trim_trailing_commas

!> Convert the first n elements (3 by default) of an integer array into an underscore delimited string.
function ints_to_string(a, n) result(i2s)
integer, dimension(:), intent(in) :: a !< The array of integers to translate
integer, optional , intent(in) :: n !< The number of elements to translate, by default the lesser
!! of 3 or all of the integers
character(len=5*size(a)+1) :: i2s !< The returned underscore delimited string of integers

character(len=8) :: i2s_temp
integer :: i, n_max

n_max = 3
if (present(n)) n_max = n

i2s = ''
do i=1,min(size(a), n_max)
if (a(i) < 0) then
write (i2s_temp, '(I5.4)') a(i)
else
write (i2s_temp, '(I4.4)') a(i)
endif
i2s = trim(i2s) //'_'// trim(i2s_temp)
enddo
i2s = adjustl(i2s)
end function ints_to_string


!> \namespace mom_string_functions
!!
!! By Alistair Adcroft and Robert Hallberg, last updated Sept. 2013.
Expand Down