From 33373c9b65702d8cd069249e2c2cf3df30046c62 Mon Sep 17 00:00:00 2001
From: Ryan Mulhall <35538242+rem1776@users.noreply.github.com>
Date: Wed, 18 Dec 2024 15:25:40 -0500
Subject: [PATCH] fix: format string overflow in diag_integral (#1624)
---
diag_integral/diag_integral.F90 | 44 ++++++++++++-------
test_fms/diag_integral/test_diag_integral.F90 | 1 -
test_fms/diag_integral/test_diag_integral2.sh | 3 --
3 files changed, 27 insertions(+), 21 deletions(-)
diff --git a/diag_integral/diag_integral.F90 b/diag_integral/diag_integral.F90
index f4c2e75ab1..4bf39b8ebe 100644
--- a/diag_integral/diag_integral.F90
+++ b/diag_integral/diag_integral.F90
@@ -40,7 +40,7 @@ module diag_integral_mod
fms_init, &
mpp_pe, mpp_root_pe,&
FATAL, write_version_number, &
- stdlog
+ stdlog, string
use fms2_io_mod, only: file_exists
use constants_mod, only: radius, constants_init
use mpp_mod, only: mpp_sum, mpp_init
@@ -195,7 +195,6 @@ module diag_integral_mod
!-------------------------------------------------------------------------------
character(len=160) :: format_text !< format statement for header
character(len=160) :: format_data !< format statement for data output
-logical :: do_format_data = .true. !< a data format needs to be generated ?
integer :: nd !< number of characters in data format statement
integer :: nt !< number of characters in text format statement
@@ -711,6 +710,8 @@ subroutine write_field_averages (Time)
integer :: nn, ninc, nst, nend, fields_to_print
integer :: i, kount
integer(i8_kind) :: icount
+ character(len=128) :: xtime_str
+ logical :: use_exp_format
!-------------------------------------------------------------------------------
! each header and data format may be different and must be generated
@@ -764,6 +765,12 @@ subroutine write_field_averages (Time)
!-------------------------------------------------------------------------------
xtime = get_axis_time (Time-Time_init_save, time_units)
+!-------------------------------------------------------------------------------
+! check if the time value is too long for decimal output
+!-------------------------------------------------------------------------------
+ xtime_str = trim(string(xtime))
+ use_exp_format = len_trim(xtime_str(1:INDEX(xtime_str, "."))) .ge. 9
+
!-------------------------------------------------------------------------------
! generate the new header and data formats.
!-------------------------------------------------------------------------------
@@ -774,7 +781,7 @@ subroutine write_field_averages (Time)
nst = 1 + (nn-1)*fields_per_print_line
nend = MIN (nn*fields_per_print_line, num_field)
if (print_header) call format_text_init (nst, nend)
- call format_data_init (nst, nend)
+ call format_data_init (nst, nend, use_exp_format)
if (diag_unit /= 0) then
write (diag_unit,format_data(1:nd)) &
xtime, (field_avg(i),i=nst,nend)
@@ -890,18 +897,22 @@ end subroutine format_text_init
!! Parameters:
!!
!! @code{.f90}
-!! integer, intent(in), optional :: nst_in, nend_in
+!! integer, intent(in) :: nst_in, nend_in
!! @endcode
!!
!! @param [in] starting/ending integral index which will be
!! included in this format statement
+!! @param [in] if true, uses exponent notation for the first format code
+!! to avoid overflow with larger time values
!!
-subroutine format_data_init (nst_in, nend_in)
+subroutine format_data_init (nst_in, nend_in, use_exp_format)
-integer, intent(in), optional :: nst_in !< starting/ending integral index which will be
+integer, intent(in) :: nst_in !< starting/ending integral index which will be
!! included in this format statement
-integer, intent(in), optional :: nend_in !< starting/ending integral index which will be
+integer, intent(in) :: nend_in !< starting/ending integral index which will be
!! included in this format statement
+logical, intent(in) :: use_exp_format !< if true, uses exponent notation for the first format code
+ !! to avoid overflow with larger time values
!-------------------------------------------------------------------------------
! local variables:
@@ -917,19 +928,18 @@ subroutine format_data_init (nst_in, nend_in)
! integrals. this section is 9 characters long.
!-------------------------------------------------------------------------------
nd = 9
- format_data(1:nd) = '(1x,f10.2'
+ if( use_exp_format ) then
+ format_data(1:nd) = '(1x,e10.2'
+ else
+ format_data(1:nd) = '(1x,f10.2'
+ endif
!-------------------------------------------------------------------------------
! define the indices of the integrals that are to be written by this
! format statement.
!-------------------------------------------------------------------------------
- if ( present (nst_in) ) then
- nst = nst_in
- nend = nend_in
- else
- nst = 1
- nend = num_field
- endif
+ nst = nst_in
+ nend = nend_in
!-------------------------------------------------------------------------------
! complete the data format. use the format defined for the
@@ -937,8 +947,8 @@ subroutine format_data_init (nst_in, nend_in)
!-------------------------------------------------------------------------------
do i=nst,nend
nc = len_trim(field_format(i))
- format_data(nd+1:nd+nc+5) = ',1x,' // field_format(i)(1:nc)
- nd = nd+nc+5
+ format_data(nd+1:nd+nc+4) = ',1x,' // field_format(i)(1:nc)
+ nd = nd+nc+4
end do
!-------------------------------------------------------------------------------
diff --git a/test_fms/diag_integral/test_diag_integral.F90 b/test_fms/diag_integral/test_diag_integral.F90
index 2a1b2eecb1..e8b25413c6 100644
--- a/test_fms/diag_integral/test_diag_integral.F90
+++ b/test_fms/diag_integral/test_diag_integral.F90
@@ -62,7 +62,6 @@ program test_diag_integral
type(time_type) :: Time_init, Time
!testing and generating answers
- integer :: i, j, k !> counters for do loop
real(r8_kind) :: area_sum !> global area. sum of the grid cell areas.
real(r8_kind) :: itime !> made up time
!> The field_avg* values are only declared as r8_kind because they correspond to the values
diff --git a/test_fms/diag_integral/test_diag_integral2.sh b/test_fms/diag_integral/test_diag_integral2.sh
index 8a50c4c014..53df2327fc 100755
--- a/test_fms/diag_integral/test_diag_integral2.sh
+++ b/test_fms/diag_integral/test_diag_integral2.sh
@@ -30,11 +30,8 @@ EOF
mkdir -p INPUT
test_expect_success "test_diag_integral r4" 'mpirun -n 1 ./test_diag_integral_r4'
-rm diag_integral.out
test_expect_success "test_diag_integral r8" 'mpirun -n 1 ./test_diag_integral_r8'
-rm diag_integral.out
-rm input.nml
rm -rf INPUT
test_done