Skip to content
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.

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

Add errmsg to check_allocate abort message #311

Merged
merged 7 commits into from
Dec 19, 2024
Merged
8 changes: 4 additions & 4 deletions src/control/cam_comp.F90
Original file line number Diff line number Diff line change
Expand Up @@ -596,9 +596,9 @@ subroutine cam_register_constituents(cam_runtime_opts)
if (.not. is_constituent) then

! Allocate host_constituents object:
allocate(host_constituents(1), stat=errflg)
allocate(host_constituents(1), stat=errflg, errmsg=errmsg)
call check_allocate(errflg, subname, 'host_constituents(1)', &
file=__FILE__, line=__LINE__)
file=__FILE__, line=__LINE__, errmsg=errmsg)

! Register the constituents so they can be advected:
call host_constituents(1)%instantiate( &
Expand All @@ -616,9 +616,9 @@ subroutine cam_register_constituents(cam_runtime_opts)
else
! Allocate zero-size object so nothing is added
! to main constituents object:
allocate(host_constituents(0), stat=errflg)
allocate(host_constituents(0), stat=errflg, errmsg=errmsg)
call check_allocate(errflg, subname, 'host_constituents(0)', &
file=__FILE__, line=__LINE__)
file=__FILE__, line=__LINE__, errmsg=errmsg)
end if
!-------------------------------------------

Expand Down
40 changes: 22 additions & 18 deletions src/data/air_composition.F90
Original file line number Diff line number Diff line change
Expand Up @@ -125,6 +125,7 @@ module air_composition
!===========================================================================

subroutine air_composition_init()
use shr_kind_mod, only: shr_kind_cl
use string_utils, only: to_str
use spmd_utils, only: masterproc
use cam_logfile, only: iulog
Expand All @@ -147,6 +148,7 @@ subroutine air_composition_init()
character(len=std_name_len) :: cnst_stdname

character(len=*), parameter :: subname = 'air_composition_init'
character(len=shr_kind_cl) :: errmsg

!
! define cp and R for species in species_name
Expand All @@ -170,6 +172,8 @@ subroutine air_composition_init()
real(kind_phys), parameter :: cv3 = 0.5_kind_phys * r_universal * dof3
real(kind_phys), parameter :: cp3 = 0.5_kind_phys * r_universal * (2._kind_phys + dof3)

errmsg = ''

liq_num = 0
ice_num = 0
has_liq = .false.
Expand All @@ -184,33 +188,33 @@ subroutine air_composition_init()

! init for variable composition dry air

allocate(thermodynamic_active_species_idx(0:num_advected), stat=ierr)
allocate(thermodynamic_active_species_idx(0:num_advected), stat=ierr, errmsg=errmsg)
call check_allocate(ierr, subname,'thermodynamic_active_species_idx(num_advected)', &
file=__FILE__, line=__LINE__)
allocate(thermodynamic_active_species_idx_dycore(num_advected), stat=ierr)
file=__FILE__, line=__LINE__, errmsg=errmsg)
allocate(thermodynamic_active_species_idx_dycore(num_advected), stat=ierr, errmsg=errmsg)
call check_allocate(ierr, subname,'thermodynamic_active_species_idx_dycore(num_advected)', &
file=__FILE__, line=__LINE__)
allocate(thermodynamic_active_species_cp(0:num_advected), stat=ierr)
file=__FILE__, line=__LINE__, errmsg=errmsg)
allocate(thermodynamic_active_species_cp(0:num_advected), stat=ierr, errmsg=errmsg)
call check_allocate(ierr, subname,'thermodynamic_active_species_cp(0:num_advected)', &
file=__FILE__, line=__LINE__)
allocate(thermodynamic_active_species_cv(0:num_advected), stat=ierr)
file=__FILE__, line=__LINE__, errmsg=errmsg)
allocate(thermodynamic_active_species_cv(0:num_advected), stat=ierr, errmsg=errmsg)
call check_allocate(ierr, subname,'thermodynamic_active_species_cv(0:num_advected)', &
file=__FILE__, line=__LINE__)
allocate(thermodynamic_active_species_R(0:num_advected), stat=ierr)
file=__FILE__, line=__LINE__, errmsg=errmsg)
allocate(thermodynamic_active_species_R(0:num_advected), stat=ierr, errmsg=errmsg)
call check_allocate(ierr, subname,'thermodynamic_active_species_R(0:num_advected)', &
file=__FILE__, line=__LINE__)
file=__FILE__, line=__LINE__, errmsg=errmsg)

allocate(thermodynamic_active_species_mwi(0:num_advected), stat=ierr)
allocate(thermodynamic_active_species_mwi(0:num_advected), stat=ierr, errmsg=errmsg)
call check_allocate(ierr, subname,'thermodynamic_active_species_mwi(0:num_advected)', &
file=__FILE__, line=__LINE__)
allocate(thermodynamic_active_species_kv(0:num_advected), stat=ierr)
file=__FILE__, line=__LINE__, errmsg=errmsg)
allocate(thermodynamic_active_species_kv(0:num_advected), stat=ierr, errmsg=errmsg)
call check_allocate(ierr, subname,'thermodynamic_active_species_kv(0:num_advected)', &
file=__FILE__, line=__LINE__)
allocate(thermodynamic_active_species_kc(0:num_advected), stat=ierr)
file=__FILE__, line=__LINE__, errmsg=errmsg)
allocate(thermodynamic_active_species_kc(0:num_advected), stat=ierr, errmsg=errmsg)
call check_allocate(ierr, subname,'thermodynamic_active_species_kc(0:num_advected)', &
file=__FILE__, line=__LINE__)
allocate(const_is_water_species(num_advected), stat=ierr)
call check_allocate(ierr, subname, 'const_is_water_species', file=__FILE__, line=__LINE__)
file=__FILE__, line=__LINE__, errmsg=errmsg)
allocate(const_is_water_species(num_advected), stat=ierr, errmsg=errmsg)
call check_allocate(ierr, subname, 'const_is_water_species', file=__FILE__, line=__LINE__, errmsg=errmsg)

thermodynamic_active_species_idx = -HUGE(1)
thermodynamic_active_species_idx_dycore = -HUGE(1)
Expand Down
12 changes: 8 additions & 4 deletions src/data/cam_thermo.F90
Original file line number Diff line number Diff line change
Expand Up @@ -179,6 +179,7 @@ module cam_thermo

subroutine cam_thermo_init(pcols, pver, pverp)
use shr_infnan_mod, only: assignment(=), shr_infnan_qnan
use shr_kind_mod, only: shr_kind_cl
use physconst, only: cpair, rair, mwdry

integer, intent(in) :: pcols
Expand All @@ -187,16 +188,19 @@ subroutine cam_thermo_init(pcols, pver, pverp)

integer :: ierr
character(len=*), parameter :: subname = "cam_thermo_init"
character(len=shr_kind_cl) :: errmsg

errmsg = ''

!------------------------------------------------------------------------
! Allocate constituent dependent properties
!------------------------------------------------------------------------
allocate(kmvis(pcols,pverp), stat=ierr)
allocate(kmvis(pcols,pverp), stat=ierr, errmsg=errmsg)
call check_allocate(ierr, subname, 'kmvis(pcols,pverp)', &
file=__FILE__, line=__LINE__)
allocate(kmcnd(pcols,pverp), stat=ierr)
file=__FILE__, line=__LINE__, errmsg=errmsg)
allocate(kmcnd(pcols,pverp), stat=ierr, errmsg=errmsg)
call check_allocate(ierr, subname, 'kmcnd(pcols,pverp)', &
file=__FILE__, line=__LINE__)
file=__FILE__, line=__LINE__, errmsg=errmsg)

!------------------------------------------------------------------------
! Initialize constituent dependent properties
Expand Down
38 changes: 15 additions & 23 deletions src/physics/utils/tropopause_climo_read.F90
Original file line number Diff line number Diff line change
Expand Up @@ -85,7 +85,7 @@ subroutine tropopause_climo_read_file()
!------------------------------------------------------------------
use shr_kind_mod, only: shr_kind_cm
use cam_logfile, only: iulog
use cam_abortutils, only: endrun
use cam_abortutils, only: endrun, check_allocate
use spmd_utils, only: masterproc
use interpolate_data, only: lininterp_init, lininterp, interp_type, lininterp_finish
use physics_grid, only: get_rlat_all_p, get_rlon_all_p
Expand Down Expand Up @@ -122,6 +122,7 @@ subroutine tropopause_climo_read_file()
real(kind_phys), parameter :: d2r=pi/180._kind_phys, zero=0._kind_phys, twopi=pi*2._kind_phys
character(len=shr_kind_cl) :: locfn
character(len=shr_kind_cm) :: errmsg
Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

would it make sense to change this errmsg to "shr_kind_cl" as well to match the other error messages? It's probably unlikely to be too short, but would be consistent with the other usage.

Copy link
Member Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Thanks, updated!

character(len=*), parameter :: subname = "tropopause_climo_read_file"

errmsg = ''

Expand All @@ -146,10 +147,9 @@ subroutine tropopause_climo_read_file()
ierr = pio_inq_dimid( pio_id, 'lat', dimid )
ierr = pio_inq_dimlen( pio_id, dimid, nlat )
allocate( lat(nlat), stat=ierr, errmsg=errmsg )
if( ierr /= 0 ) then
write(iulog,*) 'tropopause_climo_read_file: lat allocation error = ',ierr
call endrun('tropopause_climo_read_file: failed to allocate lat, error = ' // errmsg)
end if
call check_allocate(ierr, subname, 'lat(nlat)', &
file=__FILE__, line=__LINE__, errmsg=errmsg)

ierr = pio_inq_varid( pio_id, 'lat', vid )
ierr = pio_get_var( pio_id, vid, lat )
lat(:nlat) = lat(:nlat) * d2r
Expand All @@ -159,10 +159,9 @@ subroutine tropopause_climo_read_file()
ierr = pio_inq_dimid( pio_id, 'lon', dimid )
ierr = pio_inq_dimlen( pio_id, dimid, nlon )
allocate( lon(nlon), stat=ierr, errmsg=errmsg )
if( ierr /= 0 ) then
write(iulog,*) 'tropopause_climo_read_file: lon allocation error = ',ierr
call endrun('tropopause_climo_read_file: failed to allocate lon, error = ' // errmsg)
end if
call check_allocate(ierr, subname, 'lon(nlon)', &
file=__FILE__, line=__LINE__, errmsg=errmsg)

ierr = pio_inq_varid( pio_id, 'lon', vid )
ierr = pio_get_var( pio_id, vid, lon )
lon(:nlon) = lon(:nlon) * d2r
Expand All @@ -171,10 +170,9 @@ subroutine tropopause_climo_read_file()
! ... allocate arrays
!------------------------------------------------------------------
allocate( tropp_p_in(nlon,nlat,ntimes), stat=ierr, errmsg=errmsg )
if( ierr /= 0 ) then
write(iulog,*) 'tropopause_climo_read_file: tropp_p_in allocation error = ',ierr
call endrun('tropopause_climo_read_file: failed to allocate tropp_p_in, error = ' // errmsg)
end if
call check_allocate(ierr, subname, 'tropp_p_in(nlon,nlat,ntimes)', &
file=__FILE__, line=__LINE__, errmsg=errmsg)

!------------------------------------------------------------------
! ... read in the tropopause pressure
!------------------------------------------------------------------
Expand All @@ -191,13 +189,9 @@ subroutine tropopause_climo_read_file()
!--------------------------------------------------------------------
! ... regrid
!--------------------------------------------------------------------

allocate( tropp_p_loc(pcols,ntimes), stat=ierr, errmsg=errmsg )

if( ierr /= 0 ) then
write(iulog,*) 'tropopause_climo_read_file: tropp_p_loc allocation error = ',ierr
call endrun('tropopause_climo_read_file: failed to allocate tropp_p_loc, error = ' // errmsg)
end if
call check_allocate(ierr, subname, 'tropp_p_loc(pcols,ntimes)', &
file=__FILE__, line=__LINE__, errmsg=errmsg)

call get_rlat_all_p(pcols, to_lats)
call get_rlon_all_p(pcols, to_lons)
Expand All @@ -217,10 +211,8 @@ subroutine tropopause_climo_read_file()
!--------------------------------------------------------

allocate( tropp_days(tropp_slices), stat=ierr, errmsg=errmsg )
if( ierr /= 0 ) then
write(iulog,*) 'tropopause_climo_read_file: tropp_days allocation error = ',ierr
call endrun('tropopause_climo_read_file: failed to allocate tropp_days, error = ' // errmsg)
end if
call check_allocate(ierr, subname, 'tropp_days(tropp_slices)', &
file=__FILE__, line=__LINE__, errmsg=errmsg)

do n = 1,tropp_slices
tropp_days(n) = get_calday( dates(n), 0 )
Expand Down
9 changes: 8 additions & 1 deletion src/utils/cam_abortutils.F90
Original file line number Diff line number Diff line change
Expand Up @@ -29,7 +29,7 @@ module cam_abortutils

CONTAINS

subroutine check_allocate(errcode, subname, fieldname, file, line)
subroutine check_allocate(errcode, subname, fieldname, file, line, errmsg)
! If <errcode> is not zero, call endrun with an error message

! Dummy arguments
Expand All @@ -38,6 +38,8 @@ subroutine check_allocate(errcode, subname, fieldname, file, line)
character(len=*), intent(in) :: fieldname
character(len=*), optional, intent(in) :: file
integer, optional, intent(in) :: line
character(len=*), optional, intent(in) :: errmsg

! Local variables
character(len=max_chars) :: abort_msg
real(r8) :: mem_val, mem_hw_val
Expand All @@ -53,6 +55,11 @@ subroutine check_allocate(errcode, subname, fieldname, file, line)
". Memory highwater is ", mem_hw_val, &
" mb, current memory usage is ", mem_val, " mb"

! If the optional fortran allocate error message is passed in, include it in the abort message
if(present(errmsg)) then
write(abort_msg, '(a)') trim(abort_msg) // new_line('a') // "Allocation failed with: " // trim(errmsg)
endif

! End the simulation
call endrun(abort_msg, file=file, line=line)
end if
Expand Down
Loading