diff --git a/src/control/cam_comp.F90 b/src/control/cam_comp.F90 index e3a178f8..8e12e405 100644 --- a/src/control/cam_comp.F90 +++ b/src/control/cam_comp.F90 @@ -603,9 +603,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( & @@ -623,9 +623,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 !------------------------------------------- diff --git a/src/data/air_composition.F90 b/src/data/air_composition.F90 index 51e7dd6b..1528621a 100644 --- a/src/data/air_composition.F90 +++ b/src/data/air_composition.F90 @@ -128,6 +128,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 @@ -150,6 +151,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 @@ -173,6 +175,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. @@ -187,33 +191,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) diff --git a/src/data/cam_thermo.F90 b/src/data/cam_thermo.F90 index 8330ef64..2560cc4e 100644 --- a/src/data/cam_thermo.F90 +++ b/src/data/cam_thermo.F90 @@ -182,6 +182,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 @@ -190,16 +191,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 diff --git a/src/physics/utils/tropopause_climo_read.F90 b/src/physics/utils/tropopause_climo_read.F90 index c9369142..f423b9a7 100644 --- a/src/physics/utils/tropopause_climo_read.F90 +++ b/src/physics/utils/tropopause_climo_read.F90 @@ -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 @@ -121,7 +121,8 @@ subroutine tropopause_climo_read_file() real(kind_phys) :: to_lats(pcols), to_lons(pcols) 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 + character(len=shr_kind_cl) :: errmsg + character(len=*), parameter :: subname = "tropopause_climo_read_file" errmsg = '' @@ -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 @@ -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 @@ -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 !------------------------------------------------------------------ @@ -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) @@ -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 ) diff --git a/src/utils/cam_abortutils.F90 b/src/utils/cam_abortutils.F90 index 241c00ea..1eddccb4 100644 --- a/src/utils/cam_abortutils.F90 +++ b/src/utils/cam_abortutils.F90 @@ -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 is not zero, call endrun with an error message ! Dummy arguments @@ -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 @@ -48,11 +50,16 @@ subroutine check_allocate(errcode, subname, fieldname, file, line) ! Write error message with memory stats write(abort_msg, '(4a,i0,a,f10.2,a,f10.2,a)') & - trim(subname), ": Allocate of '", & + trim(subname), ": Allocation of '", & trim(fieldname), "' failed with code ", errcode, & ". 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