Skip to content

Commit

Permalink
feat: add separate error log file for mpp_error (NOAA-GFDL#1544)
Browse files Browse the repository at this point in the history
  • Loading branch information
rem1776 authored Jun 25, 2024
1 parent 7d565db commit eeedbab
Show file tree
Hide file tree
Showing 8 changed files with 200 additions and 8 deletions.
2 changes: 2 additions & 0 deletions mpp/include/mpp_comm_mpi.inc
Original file line number Diff line number Diff line change
Expand Up @@ -111,6 +111,7 @@
if (t_level == 3) return

call mpp_init_logfile()
call mpp_init_warninglog()
if (present(alt_input_nml_path)) then
call read_input_nml(alt_input_nml_path=alt_input_nml_path)
else
Expand Down Expand Up @@ -205,6 +206,7 @@ subroutine mpp_exit()

call mpp_sync()
call FLUSH( out_unit )
close(warn_unit)

if( pe.EQ.root_pe )then
write( out_unit,'(/a,i6,a)' ) 'Tabulating mpp_clock statistics across ', npes, ' PEs...'
Expand Down
30 changes: 30 additions & 0 deletions mpp/include/mpp_util.inc
Original file line number Diff line number Diff line change
Expand Up @@ -119,6 +119,36 @@
end do
end if
end subroutine mpp_init_logfile

!> Opens the warning log file, called during mpp_init
subroutine mpp_init_warninglog()
integer :: p
logical :: exist
character(len=11) :: this_pe
if( pe.EQ.root_pe )then
write(this_pe,'(a,i6.6,a)') '.',p,'.out'
inquire( file=trim(warnfile)//this_pe, exist=exist )
if(exist)then
open(newunit=warn_unit, file=trim(warnfile)//this_pe, status='REPLACE' )
else
open(newunit=warn_unit, file=trim(warnfile)//this_pe, status='NEW' )
endif
end if
end subroutine mpp_init_warninglog

!> @brief This function returns unit number for the warning log
!! if on the root pe, otherwise returns the etc_unit value (usually /dev/null)
function warnlog()
integer :: warnlog
if(.not. module_is_initialized) call mpp_error(FATAL, "mpp_mod: warnlog cannot be called before mpp_init")
if(root_pe .eq. pe) then
warnlog = warn_unit
else
warnlog = etc_unit
endif
return
end function warnlog

!#####################################################################
subroutine mpp_set_warn_level(flag)
integer, intent(in) :: flag
Expand Down
12 changes: 10 additions & 2 deletions mpp/include/mpp_util_mpi.inc
Original file line number Diff line number Diff line change
Expand Up @@ -60,13 +60,21 @@ subroutine mpp_error_basic( errortype, errormsg )
!$OMP CRITICAL (MPP_ERROR_CRITICAL)
select case( errortype )
case(NOTE)
if(pe==root_pe)write( out_unit,'(a)' )trim(text)
if(pe==root_pe) then
write( out_unit,'(a)' )trim(text)
write( warn_unit,'(a)' )trim(text)
endif
case default
errunit = stderr()
write( errunit, '(/a/)' )trim(text)
if(pe==root_pe)write( out_unit,'(/a/)' )trim(text)
if(pe==root_pe) then
write( out_unit,'(/a/)' )trim(text)
write( warn_unit,'(/a/)' )trim(text)
endif
if( errortype.EQ.FATAL .OR. warnings_are_fatal )then
FLUSH(out_unit)
FLUSH(warn_unit)
close(warn_unit)
#ifdef __INTEL_COMPILER
! Get traceback and return quietly for correct abort
call TRACEBACKQQ(user_exit_code=-1)
Expand Down
6 changes: 4 additions & 2 deletions mpp/mpp.F90
Original file line number Diff line number Diff line change
Expand Up @@ -202,7 +202,7 @@ module mpp_mod
public :: mpp_init_test_read_namelist, mpp_init_test_etc_unit, mpp_init_test_requests_allocated

!--- public interface from mpp_util.h ------------------------------
public :: stdin, stdout, stderr, stdlog, lowercase, uppercase, mpp_error, mpp_error_state
public :: stdin, stdout, stderr, stdlog, warnlog, lowercase, uppercase, mpp_error, mpp_error_state
public :: mpp_set_warn_level, mpp_sync, mpp_sync_self, mpp_pe
public :: mpp_npes, mpp_root_pe, mpp_set_root_pe, mpp_declare_pelist
public :: mpp_get_current_pelist, mpp_set_current_pelist, mpp_get_current_pelist_name
Expand Down Expand Up @@ -1273,7 +1273,9 @@ module mpp_mod
logical :: mpp_record_timing_data=.TRUE.
type(clock),save :: clocks(MAX_CLOCKS)
integer :: log_unit, etc_unit
character(len=32) :: configfile='logfile'
integer :: warn_unit !< unit number of the warning log
character(len=32), parameter :: configfile='logfile'
character(len=32), parameter :: warnfile='warnfile' !< base name for warninglog (appends ".<PE>.out")
integer :: peset_num=0, current_peset_num=0
integer :: world_peset_num !<the world communicator
integer :: error
Expand Down
2 changes: 1 addition & 1 deletion test_fms/fms/Makefile.am
Original file line number Diff line number Diff line change
Expand Up @@ -49,7 +49,7 @@ TESTS = test_fms2.sh
# These will also be included in the distribution.
EXTRA_DIST = test_fms2.sh

CLEANFILES = input.nml logfile.*.out *.mod *.o *.dpi *.spi *.dyn *.spl
CLEANFILES = input.nml *.out *.mod *.o *.dpi *.spi *.dyn *.spl

clean-local:
rm -rf RESTART
10 changes: 7 additions & 3 deletions test_fms/mpp/Makefile.am
Original file line number Diff line number Diff line change
Expand Up @@ -67,7 +67,8 @@ check_PROGRAMS = test_mpp \
test_mpp_init_logfile \
test_mpp_clock_begin_end_id \
test_mpp_nesting \
test_mpp_chksum
test_mpp_chksum \
test_stdlog

# These are the sources for the tests.
test_mpp_SOURCES = test_mpp.F90
Expand Down Expand Up @@ -133,6 +134,7 @@ test_mpp_init_logfile_SOURCES=test_mpp_init_logfile.F90
test_mpp_clock_begin_end_id_SOURCES=test_mpp_clock_begin_end_id.F90
test_super_grid_SOURCES = test_super_grid.F90
test_mpp_chksum_SOURCES = test_mpp_chksum.F90
test_stdlog_SOURCES = test_stdlog.F90

# ifort gets a internal error during compilation for this test, issue #1071
# we'll just remove the openmp flag if present since it doesn't use openmp at all
Expand Down Expand Up @@ -177,7 +179,8 @@ TESTS = test_mpp_domains2.sh \
test_mpp_clock_begin_end_id.sh \
test_super_grid.sh \
test_mpp_nesting.sh \
test_mpp_chksum.sh
test_mpp_chksum.sh \
test_stdlog.sh

# Define test file extensions and log driver
TEST_EXTENSIONS = .sh
Expand Down Expand Up @@ -221,7 +224,8 @@ EXTRA_DIST = test_mpp_domains2.sh \
test_mpp_clock_begin_end_id.sh \
test_super_grid.sh \
test_mpp_nesting.sh \
test_mpp_chksum.sh
test_mpp_chksum.sh \
test_stdlog.sh

fill_halo.mod: fill_halo.$(OBJEXT)
compare_data_checksums.mod: compare_data_checksums.$(OBJEXT)
Expand Down
94 changes: 94 additions & 0 deletions test_fms/mpp/test_stdlog.F90
Original file line number Diff line number Diff line change
@@ -0,0 +1,94 @@
!***********************************************************************
!* GNU Lesser General Public License
!*
!* This file is part of the GFDL Flexible Modeling System (FMS).
!*
!* FMS is free software: you can redistribute it and/or modify it under
!* the terms of the GNU Lesser General Public License as published by
!* the Free Software Foundation, either version 3 of the License, or (at
!* your option) any later version.
!*
!* FMS is distributed in the hope that it will be useful, but WITHOUT
!* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
!* FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
!* for more details.
!*
!* You should have received a copy of the GNU Lesser General Public
!* License along with FMS. If not, see <http://www.gnu.org/licenses/>.
!***********************************************************************

!> @file
!! @brief Unit test for the stdlog and checking warning log functionality
!! @author Ryan Mulhall
!! @email gfdl.climate.model.info@noaa.gov
program test_stdlog
use mpp_mod, only : mpp_init, mpp_init_test_peset_allocated, stdlog
use mpp_mod, only : mpp_pe, mpp_root_pe, mpp_error, FATAL, WARNING, NOTE
use fms_mod, only : input_nml_file, check_nml_error

integer :: log_unit !< Stores the returned standard log unit number
integer :: warn_unit
integer :: pe !< pe value
integer :: root_pe !< root pe value
integer :: ierr !< Error code

integer :: test_num = 1
namelist / test_stdlog_nml / test_num

call mpp_init()

read(input_nml_file, nml=test_stdlog_nml, iostat=io)
ierr = check_nml_error(io, 'test_stdlog_nml')

pe = mpp_pe()
root_pe = mpp_root_pe()
log_unit = stdlog()

print * , "running test num: ", test_num

select case(test_num)
case(1)
call test_write(.false.)
case(2)
call test_write(.true.)
case(3)
call check_write()
end select

call MPI_FINALIZE(ierr)

contains

subroutine test_write(do_error_test)
logical, intent(in) :: do_error_test !< causes a fatal error to check output if true

write(log_unit, *) "asdf"
call mpp_error(NOTE, "test note output")
call mpp_error(WARNING, "test warning output")
if(do_error_test) call mpp_error(FATAL, "test fatal output")
end subroutine test_write

subroutine check_write()
integer :: i, ref_num, u_num_warn
character(len=128) :: line
character(len=23), parameter :: warn_fname = 'warnfile.000000.out.old'
character(len=128) :: ref_line(4)

ref_line(1) = "NOTE from PE 0: MPP_DOMAINS_SET_STACK_SIZE: stack size set to 32768."
ref_line(2) = "NOTE from PE 0: test note output"
ref_line(3) = "WARNING from PE 0: test warning output"
ref_line(4) = "FATAL from PE 0: test fatal output"
open(newunit=u_num_warn, file=warn_fname, status="old", action="read")
ref_num = 1
do i=1, 7
read(u_num_warn, '(A)') line
if (trim(line) == '') cycle
if(trim(line) .ne. trim(ref_line(ref_num))) call mpp_error(FATAL, "warnfile output does not match reference data"&
//"reference line:"//ref_line(ref_num) &
//"output line:"//line)
ref_num = ref_num + 1
enddo
close(u_num_warn)
end subroutine check_write

end program test_stdlog
52 changes: 52 additions & 0 deletions test_fms/mpp/test_stdlog.sh
Original file line number Diff line number Diff line change
@@ -0,0 +1,52 @@
#!/bin/sh

#***********************************************************************
# GNU Lesser General Public License
#
# This file is part of the GFDL Flexible Modeling System (FMS).
#
# FMS is free software: you can redistribute it and/or modify it under
# the terms of the GNU Lesser General Public License as published by
# the Free Software Foundation, either version 3 of the License, or (at
# your option) any later version.
#
# FMS is distributed in the hope that it will be useful, but WITHOUT
# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
# FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU Lesser General Public
# License along with FMS. If not, see <http://www.gnu.org/licenses/>.
#***********************************************************************

# This is part of the GFDL FMS package. This is a shell script to
# execute tests in the test_fms/mpp directory.

# Ryan Mulhall 02/2021

# Set common test settings.
. ../test-lib.sh

output_dir

# ensure input.nml file present
cat <<_EOF > input.nml
&test_stdlog_nml
test_num = 1
/
_EOF
# Run test with one processor
test_expect_success "test stdlog and stdwarn" '
mpirun -n 2 ../test_stdlog
'
sed -i 's/1/2/' input.nml
test_expect_failure "test stdlog and stdwarn with fatal output" '
mpirun -n 2 ../test_stdlog
'
# move file so we don't overwrite
mv warnfile.*.out warnfile.000000.out.old
sed -i 's/2/3/' input.nml
test_expect_success "check stdwarn output" '
mpirun -n 1 ../test_stdlog
'
test_done

0 comments on commit eeedbab

Please sign in to comment.