diff --git a/.github/workflows/mpas_dynamical_core_ci.yml b/.github/workflows/mpas_dynamical_core_ci.yml index f78757368..90c3d9aa3 100644 --- a/.github/workflows/mpas_dynamical_core_ci.yml +++ b/.github/workflows/mpas_dynamical_core_ci.yml @@ -131,6 +131,7 @@ jobs: runs-on: ubuntu-24.04 needs: - conditional-check + - source-code-linting - unit-tests if: ${{ always() }} steps: @@ -167,6 +168,18 @@ jobs: ;; esac + case "${{ needs.source-code-linting.result }}" in + skipped|success) + : + ;; + cancelled|failure) + write_result_and_exit false + ;; + *) + write_result_and_exit error + ;; + esac + case "${{ needs.unit-tests.result }}" in skipped|success) : @@ -180,6 +193,45 @@ jobs: esac write_result_and_exit true + source-code-linting: + name: Lint Fortran source code + timeout-minutes: 10 + runs-on: ubuntu-24.04 + needs: conditional-check + if: ${{ needs.conditional-check.outputs.should-run == 'true' }} + env: + FORTITUDE_VERSION: '0.7.*' + SOURCE_CODE_PATH: ${{ github.workspace }}/src/dynamics/mpas + steps: + - name: Checkout CAM-SIMA + uses: actions/checkout@v5 + + - name: Setup Python + uses: actions/setup-python@v6 + with: + cache: pip + python-version: '3.12' + + - name: Install Fortitude + run: | + python3 -m venv venv-fortitude + source venv-fortitude/bin/activate + python3 -m pip install "fortitude-lint==$FORTITUDE_VERSION" + + - name: Lint Fortran source code + run: | + source venv-fortitude/bin/activate + fortitude --config-file "$SOURCE_CODE_PATH/assets/fortitude_config.toml" check --exit-zero --output-file "$SOURCE_CODE_PATH/source-code-linting.log" --preview "$SOURCE_CODE_PATH" + cat "$SOURCE_CODE_PATH/source-code-linting.log" + + - name: Upload Fortran source code linting log + if: ${{ always() }} + uses: actions/upload-artifact@v4 + with: + if-no-files-found: ignore + name: source-code-linting-log + path: ${{ env.SOURCE_CODE_PATH }}/source-code-linting.log + retention-days: 7 unit-tests: name: Build and run unit tests (GCC ${{ matrix.gcc-version }}) timeout-minutes: 10 diff --git a/src/dynamics/mpas/assets/fortitude_config.toml b/src/dynamics/mpas/assets/fortitude_config.toml new file mode 100644 index 000000000..3bcf5cdda --- /dev/null +++ b/src/dynamics/mpas/assets/fortitude_config.toml @@ -0,0 +1,29 @@ +[check] +exclude = [ + 'src/dynamics/mpas/dycore' +] +file-extensions = [ + 'F', + 'f', + 'F90', + 'f90' +] +# When ignoring a linting rule, a reason should be provided. +ignore = [ + 'C003', # Temporarily ignored due to lack of support for Fortran 2018 `implicit none (external)` statement + # in the NVIDIA HPC SDK as of version 25.9. + 'C182', # Requiring separate allocations and deallocations for each variable is too restrictive. + # Related variables can be grouped together at the discretion of developers. + 'S102' # Prefer only one space instead of two. +] +line-length = 132 +output-format = 'grouped' +select = [ + 'ALL' +] + +[check.exit-unlabelled-loops] +allow-unnested-loops = true + +[check.strings] +quotes = 'single' diff --git a/src/dynamics/mpas/driver/dyn_mpas_subdriver.F90 b/src/dynamics/mpas/driver/dyn_mpas_subdriver.F90 index a5ef43e94..371a3af78 100644 --- a/src/dynamics/mpas/driver/dyn_mpas_subdriver.F90 +++ b/src/dynamics/mpas/driver/dyn_mpas_subdriver.F90 @@ -37,6 +37,7 @@ module dyn_mpas_subdriver !> This procedure interface is modeled after the `endrun` subroutine from CAM-SIMA. !> It will be called whenever MPAS dynamical core encounters a fatal error and cannot continue. subroutine model_error_if(message, file, line) + implicit none character(*), intent(in) :: message character(*), optional, intent(in) :: file integer, optional, intent(in) :: line @@ -375,7 +376,7 @@ end subroutine dyn_mpas_debug_print subroutine dyn_mpas_init_phase1(self, mpi_comm, model_error_impl, log_level, log_unit, mpas_log_unit) ! Module(s) from MPAS. use atm_core_interface, only: atm_setup_core, atm_setup_domain - use dyn_mpas_procedures, only: clamp + use dyn_mpas_procedures, only: clamp, stringify use mpas_domain_routines, only: mpas_allocate_domain use mpas_framework, only: mpas_framework_init_phase1 @@ -391,6 +392,7 @@ subroutine dyn_mpas_init_phase1(self, mpi_comm, model_error_impl, log_level, log integer, intent(in) :: mpas_log_unit(2) character(*), parameter :: subname = 'dyn_mpas_subdriver::dyn_mpas_init_phase1' + character(strkind) :: cerr integer :: ierr self % mpi_comm = mpi_comm @@ -414,20 +416,24 @@ subroutine dyn_mpas_init_phase1(self, mpi_comm, model_error_impl, log_level, log call self % debug_print(log_level_info, 'Allocating core') - allocate(self % corelist, stat=ierr) + allocate(self % corelist, errmsg=cerr, stat=ierr) if (ierr /= 0) then - call self % model_error('Failed to allocate corelist', subname, __LINE__) + call self % model_error('Failed to allocate corelist' // new_line('') // & + 'Allocation returned with ' // stringify([ierr]) // ': ' // trim(adjustl(cerr)), & + subname, __LINE__) end if nullify(self % corelist % next) call self % debug_print(log_level_info, 'Allocating domain') - allocate(self % corelist % domainlist, stat=ierr) + allocate(self % corelist % domainlist, errmsg=cerr, stat=ierr) if (ierr /= 0) then - call self % model_error('Failed to allocate corelist % domainlist', subname, __LINE__) + call self % model_error('Failed to allocate corelist % domainlist' // new_line('') // & + 'Allocation returned with ' // stringify([ierr]) // ': ' // trim(adjustl(cerr)), & + subname, __LINE__) end if nullify(self % corelist % domainlist % next) @@ -830,14 +836,16 @@ subroutine dyn_mpas_define_scalar(self, constituent_name, is_water_species) !> Possible CCPP standard names of `qv`, which denotes water vapor mixing ratio. !> They are hard-coded here because MPAS needs to know where `qv` is. !> Index 1 is exactly what MPAS wants. Others also work, but need to be converted. - character(*), parameter :: mpas_scalar_qv_standard_name(*) = [ character(strkind) :: & + character(*), parameter :: mpas_scalar_qv_standard_name(*) = [character(strkind) :: & 'water_vapor_mixing_ratio_wrt_dry_air', & 'water_vapor_mixing_ratio_wrt_moist_air', & 'water_vapor_mixing_ratio_wrt_moist_air_and_condensed_water' & ] character(*), parameter :: subname = 'dyn_mpas_subdriver::dyn_mpas_define_scalar' - integer :: i, j, ierr + character(strkind) :: cerr + integer :: i, j + integer :: ierr integer :: index_qv, index_water_start, index_water_end integer :: time_level type(field3dreal), pointer :: field_3d_real @@ -861,16 +869,20 @@ subroutine dyn_mpas_define_scalar(self, constituent_name, is_water_species) if (size(constituent_name) == 0 .and. self % number_of_constituents == 1) then ! If constituent definitions are empty, `qv` is the only constituent per MPAS requirements. ! See `dyn_mpas_init_phase3` for details. - allocate(self % constituent_name(1), stat=ierr) + allocate(self % constituent_name(1), errmsg=cerr, stat=ierr) if (ierr /= 0) then - call self % model_error('Failed to allocate constituent_name', subname, __LINE__) + call self % model_error('Failed to allocate constituent_name' // new_line('') // & + 'Allocation returned with ' // stringify([ierr]) // ': ' // trim(adjustl(cerr)), & + subname, __LINE__) end if - allocate(self % is_water_species(1), stat=ierr) + allocate(self % is_water_species(1), errmsg=cerr, stat=ierr) if (ierr /= 0) then - call self % model_error('Failed to allocate is_water_species', subname, __LINE__) + call self % model_error('Failed to allocate is_water_species' // new_line('') // & + 'Allocation returned with ' // stringify([ierr]) // ': ' // trim(adjustl(cerr)), & + subname, __LINE__) end if self % constituent_name(1) = mpas_scalar_qv_standard_name(1) @@ -884,18 +896,22 @@ subroutine dyn_mpas_define_scalar(self, constituent_name, is_water_species) call self % model_error('Constituent names are too long', subname, __LINE__) end if - allocate(self % constituent_name(self % number_of_constituents), stat=ierr) + allocate(self % constituent_name(self % number_of_constituents), errmsg=cerr, stat=ierr) if (ierr /= 0) then - call self % model_error('Failed to allocate constituent_name', subname, __LINE__) + call self % model_error('Failed to allocate constituent_name' // new_line('') // & + 'Allocation returned with ' // stringify([ierr]) // ': ' // trim(adjustl(cerr)), & + subname, __LINE__) end if self % constituent_name(:) = adjustl(constituent_name) - allocate(self % is_water_species(self % number_of_constituents), stat=ierr) + allocate(self % is_water_species(self % number_of_constituents), errmsg=cerr, stat=ierr) if (ierr /= 0) then - call self % model_error('Failed to allocate is_water_species', subname, __LINE__) + call self % model_error('Failed to allocate is_water_species' // new_line('') // & + 'Allocation returned with ' // stringify([ierr]) // ': ' // trim(adjustl(cerr)), & + subname, __LINE__) end if self % is_water_species(:) = is_water_species(:) @@ -931,10 +947,12 @@ subroutine dyn_mpas_define_scalar(self, constituent_name, is_water_species) call self % debug_print(log_level_info, 'Creating index mapping between MPAS scalars and CAM-SIMA constituents') - allocate(self % index_mpas_scalar_to_constituent(self % number_of_constituents), stat=ierr) + allocate(self % index_mpas_scalar_to_constituent(self % number_of_constituents), errmsg=cerr, stat=ierr) if (ierr /= 0) then - call self % model_error('Failed to allocate index_mpas_scalar_to_constituent', subname, __LINE__) + call self % model_error('Failed to allocate index_mpas_scalar_to_constituent' // new_line('') // & + 'Allocation returned with ' // stringify([ierr]) // ': ' // trim(adjustl(cerr)), & + subname, __LINE__) end if self % index_mpas_scalar_to_constituent(:) = 0 @@ -964,10 +982,12 @@ subroutine dyn_mpas_define_scalar(self, constituent_name, is_water_species) call self % debug_print(log_level_info, 'Creating inverse index mapping between MPAS scalars and CAM-SIMA constituents') - allocate(self % index_constituent_to_mpas_scalar(self % number_of_constituents), stat=ierr) + allocate(self % index_constituent_to_mpas_scalar(self % number_of_constituents), errmsg=cerr, stat=ierr) if (ierr /= 0) then - call self % model_error('Failed to allocate index_constituent_to_mpas_scalar', subname, __LINE__) + call self % model_error('Failed to allocate index_constituent_to_mpas_scalar' // new_line('') // & + 'Allocation returned with ' // stringify([ierr]) // ': ' // trim(adjustl(cerr)), & + subname, __LINE__) end if self % index_constituent_to_mpas_scalar(:) = 0 @@ -1114,7 +1134,8 @@ subroutine dyn_mpas_read_write_stream(self, pio_file, stream_mode, stream_name) character(*), intent(in) :: stream_name character(*), parameter :: subname = 'dyn_mpas_subdriver::dyn_mpas_read_write_stream' - integer :: i, ierr + integer :: i + integer :: ierr type(mpas_pool_type), pointer :: mpas_pool type(mpas_stream_type), pointer :: mpas_stream type(var_info_type), allocatable :: var_info_list(:) @@ -1239,8 +1260,11 @@ subroutine dyn_mpas_init_stream_with_pool(self, mpas_pool, mpas_stream, pio_file end interface add_stream_attribute character(*), parameter :: subname = 'dyn_mpas_subdriver::dyn_mpas_init_stream_with_pool' + character(strkind) :: cerr character(strkind) :: stream_filename - integer :: i, ierr, stream_format + integer :: i + integer :: ierr + integer :: stream_format !> Whether a variable is present on the file (i.e., `pio_file`). logical, allocatable :: var_is_present(:) !> Whether a variable is type, kind, and rank compatible with what MPAS expects on the file (i.e., `pio_file`). @@ -1276,10 +1300,12 @@ subroutine dyn_mpas_init_stream_with_pool(self, mpas_pool, mpas_stream, pio_file call mpas_pool_create_pool(mpas_pool) - allocate(mpas_stream, stat=ierr) + allocate(mpas_stream, errmsg=cerr, stat=ierr) if (ierr /= 0) then - call self % model_error('Failed to allocate stream "' // trim(adjustl(stream_name)) // '"', subname, __LINE__) + call self % model_error('Failed to allocate stream "' // trim(adjustl(stream_name)) // '"' // new_line('') // & + 'Allocation returned with ' // stringify([ierr]) // ': ' // trim(adjustl(cerr)), & + subname, __LINE__) end if ! Not actually used because a PIO file descriptor is directly supplied. @@ -1820,8 +1846,11 @@ subroutine dyn_mpas_check_variable_status(self, var_is_present, var_is_tkr_compa type(var_info_type), intent(in) :: var_info character(*), parameter :: subname = 'dyn_mpas_subdriver::dyn_mpas_check_variable_status' + character(strkind) :: cerr character(strkind), allocatable :: var_name_list(:) - integer :: i, ierr, varid, varndims, vartype + integer :: i + integer :: ierr + integer :: varid, varndims, vartype type(field0dchar), pointer :: field_0d_char type(field1dchar), pointer :: field_1d_char type(field0dinteger), pointer :: field_0d_integer @@ -1866,10 +1895,12 @@ subroutine dyn_mpas_check_variable_status(self, var_is_present, var_is_tkr_compa end if if (field_0d_char % isvararray .and. associated(field_0d_char % constituentnames)) then - allocate(var_name_list(size(field_0d_char % constituentnames)), stat=ierr) + allocate(var_name_list(size(field_0d_char % constituentnames)), errmsg=cerr, stat=ierr) if (ierr /= 0) then - call self % model_error('Failed to allocate var_name_list', subname, __LINE__) + call self % model_error('Failed to allocate var_name_list' // new_line('') // & + 'Allocation returned with ' // stringify([ierr]) // ': ' // trim(adjustl(cerr)), & + subname, __LINE__) end if var_name_list(:) = field_0d_char % constituentnames(:) @@ -1886,10 +1917,12 @@ subroutine dyn_mpas_check_variable_status(self, var_is_present, var_is_tkr_compa end if if (field_1d_char % isvararray .and. associated(field_1d_char % constituentnames)) then - allocate(var_name_list(size(field_1d_char % constituentnames)), stat=ierr) + allocate(var_name_list(size(field_1d_char % constituentnames)), errmsg=cerr, stat=ierr) if (ierr /= 0) then - call self % model_error('Failed to allocate var_name_list', subname, __LINE__) + call self % model_error('Failed to allocate var_name_list' // new_line('') // & + 'Allocation returned with ' // stringify([ierr]) // ': ' // trim(adjustl(cerr)), & + subname, __LINE__) end if var_name_list(:) = field_1d_char % constituentnames(:) @@ -1912,10 +1945,12 @@ subroutine dyn_mpas_check_variable_status(self, var_is_present, var_is_tkr_compa end if if (field_0d_integer % isvararray .and. associated(field_0d_integer % constituentnames)) then - allocate(var_name_list(size(field_0d_integer % constituentnames)), stat=ierr) + allocate(var_name_list(size(field_0d_integer % constituentnames)), errmsg=cerr, stat=ierr) if (ierr /= 0) then - call self % model_error('Failed to allocate var_name_list', subname, __LINE__) + call self % model_error('Failed to allocate var_name_list' // new_line('') // & + 'Allocation returned with ' // stringify([ierr]) // ': ' // trim(adjustl(cerr)), & + subname, __LINE__) end if var_name_list(:) = field_0d_integer % constituentnames(:) @@ -1932,10 +1967,12 @@ subroutine dyn_mpas_check_variable_status(self, var_is_present, var_is_tkr_compa end if if (field_1d_integer % isvararray .and. associated(field_1d_integer % constituentnames)) then - allocate(var_name_list(size(field_1d_integer % constituentnames)), stat=ierr) + allocate(var_name_list(size(field_1d_integer % constituentnames)), errmsg=cerr, stat=ierr) if (ierr /= 0) then - call self % model_error('Failed to allocate var_name_list', subname, __LINE__) + call self % model_error('Failed to allocate var_name_list' // new_line('') // & + 'Allocation returned with ' // stringify([ierr]) // ': ' // trim(adjustl(cerr)), & + subname, __LINE__) end if var_name_list(:) = field_1d_integer % constituentnames(:) @@ -1952,10 +1989,12 @@ subroutine dyn_mpas_check_variable_status(self, var_is_present, var_is_tkr_compa end if if (field_2d_integer % isvararray .and. associated(field_2d_integer % constituentnames)) then - allocate(var_name_list(size(field_2d_integer % constituentnames)), stat=ierr) + allocate(var_name_list(size(field_2d_integer % constituentnames)), errmsg=cerr, stat=ierr) if (ierr /= 0) then - call self % model_error('Failed to allocate var_name_list', subname, __LINE__) + call self % model_error('Failed to allocate var_name_list' // new_line('') // & + 'Allocation returned with ' // stringify([ierr]) // ': ' // trim(adjustl(cerr)), & + subname, __LINE__) end if var_name_list(:) = field_2d_integer % constituentnames(:) @@ -1972,10 +2011,12 @@ subroutine dyn_mpas_check_variable_status(self, var_is_present, var_is_tkr_compa end if if (field_3d_integer % isvararray .and. associated(field_3d_integer % constituentnames)) then - allocate(var_name_list(size(field_3d_integer % constituentnames)), stat=ierr) + allocate(var_name_list(size(field_3d_integer % constituentnames)), errmsg=cerr, stat=ierr) if (ierr /= 0) then - call self % model_error('Failed to allocate var_name_list', subname, __LINE__) + call self % model_error('Failed to allocate var_name_list' // new_line('') // & + 'Allocation returned with ' // stringify([ierr]) // ': ' // trim(adjustl(cerr)), & + subname, __LINE__) end if var_name_list(:) = field_3d_integer % constituentnames(:) @@ -1998,10 +2039,12 @@ subroutine dyn_mpas_check_variable_status(self, var_is_present, var_is_tkr_compa end if if (field_0d_real % isvararray .and. associated(field_0d_real % constituentnames)) then - allocate(var_name_list(size(field_0d_real % constituentnames)), stat=ierr) + allocate(var_name_list(size(field_0d_real % constituentnames)), errmsg=cerr, stat=ierr) if (ierr /= 0) then - call self % model_error('Failed to allocate var_name_list', subname, __LINE__) + call self % model_error('Failed to allocate var_name_list' // new_line('') // & + 'Allocation returned with ' // stringify([ierr]) // ': ' // trim(adjustl(cerr)), & + subname, __LINE__) end if var_name_list(:) = field_0d_real % constituentnames(:) @@ -2018,10 +2061,12 @@ subroutine dyn_mpas_check_variable_status(self, var_is_present, var_is_tkr_compa end if if (field_1d_real % isvararray .and. associated(field_1d_real % constituentnames)) then - allocate(var_name_list(size(field_1d_real % constituentnames)), stat=ierr) + allocate(var_name_list(size(field_1d_real % constituentnames)), errmsg=cerr, stat=ierr) if (ierr /= 0) then - call self % model_error('Failed to allocate var_name_list', subname, __LINE__) + call self % model_error('Failed to allocate var_name_list' // new_line('') // & + 'Allocation returned with ' // stringify([ierr]) // ': ' // trim(adjustl(cerr)), & + subname, __LINE__) end if var_name_list(:) = field_1d_real % constituentnames(:) @@ -2038,10 +2083,12 @@ subroutine dyn_mpas_check_variable_status(self, var_is_present, var_is_tkr_compa end if if (field_2d_real % isvararray .and. associated(field_2d_real % constituentnames)) then - allocate(var_name_list(size(field_2d_real % constituentnames)), stat=ierr) + allocate(var_name_list(size(field_2d_real % constituentnames)), errmsg=cerr, stat=ierr) if (ierr /= 0) then - call self % model_error('Failed to allocate var_name_list', subname, __LINE__) + call self % model_error('Failed to allocate var_name_list' // new_line('') // & + 'Allocation returned with ' // stringify([ierr]) // ': ' // trim(adjustl(cerr)), & + subname, __LINE__) end if var_name_list(:) = field_2d_real % constituentnames(:) @@ -2058,10 +2105,12 @@ subroutine dyn_mpas_check_variable_status(self, var_is_present, var_is_tkr_compa end if if (field_3d_real % isvararray .and. associated(field_3d_real % constituentnames)) then - allocate(var_name_list(size(field_3d_real % constituentnames)), stat=ierr) + allocate(var_name_list(size(field_3d_real % constituentnames)), errmsg=cerr, stat=ierr) if (ierr /= 0) then - call self % model_error('Failed to allocate var_name_list', subname, __LINE__) + call self % model_error('Failed to allocate var_name_list' // new_line('') // & + 'Allocation returned with ' // stringify([ierr]) // ': ' // trim(adjustl(cerr)), & + subname, __LINE__) end if var_name_list(:) = field_3d_real % constituentnames(:) @@ -2078,10 +2127,12 @@ subroutine dyn_mpas_check_variable_status(self, var_is_present, var_is_tkr_compa end if if (field_4d_real % isvararray .and. associated(field_4d_real % constituentnames)) then - allocate(var_name_list(size(field_4d_real % constituentnames)), stat=ierr) + allocate(var_name_list(size(field_4d_real % constituentnames)), errmsg=cerr, stat=ierr) if (ierr /= 0) then - call self % model_error('Failed to allocate var_name_list', subname, __LINE__) + call self % model_error('Failed to allocate var_name_list' // new_line('') // & + 'Allocation returned with ' // stringify([ierr]) // ': ' // trim(adjustl(cerr)), & + subname, __LINE__) end if var_name_list(:) = field_4d_real % constituentnames(:) @@ -2098,10 +2149,12 @@ subroutine dyn_mpas_check_variable_status(self, var_is_present, var_is_tkr_compa end if if (field_5d_real % isvararray .and. associated(field_5d_real % constituentnames)) then - allocate(var_name_list(size(field_5d_real % constituentnames)), stat=ierr) + allocate(var_name_list(size(field_5d_real % constituentnames)), errmsg=cerr, stat=ierr) if (ierr /= 0) then - call self % model_error('Failed to allocate var_name_list', subname, __LINE__) + call self % model_error('Failed to allocate var_name_list' // new_line('') // & + 'Allocation returned with ' // stringify([ierr]) // ': ' // trim(adjustl(cerr)), & + subname, __LINE__) end if var_name_list(:) = field_5d_real % constituentnames(:) @@ -2118,27 +2171,33 @@ subroutine dyn_mpas_check_variable_status(self, var_is_present, var_is_tkr_compa end select if (.not. allocated(var_name_list)) then - allocate(var_name_list(1), stat=ierr) + allocate(var_name_list(1), errmsg=cerr, stat=ierr) if (ierr /= 0) then - call self % model_error('Failed to allocate var_name_list', subname, __LINE__) + call self % model_error('Failed to allocate var_name_list' // new_line('') // & + 'Allocation returned with ' // stringify([ierr]) // ': ' // trim(adjustl(cerr)), & + subname, __LINE__) end if var_name_list(1) = var_info % name end if - allocate(var_is_present(size(var_name_list)), stat=ierr) + allocate(var_is_present(size(var_name_list)), errmsg=cerr, stat=ierr) if (ierr /= 0) then - call self % model_error('Failed to allocate var_is_present', subname, __LINE__) + call self % model_error('Failed to allocate var_is_present' // new_line('') // & + 'Allocation returned with ' // stringify([ierr]) // ': ' // trim(adjustl(cerr)), & + subname, __LINE__) end if var_is_present(:) = .false. - allocate(var_is_tkr_compatible(size(var_name_list)), stat=ierr) + allocate(var_is_tkr_compatible(size(var_name_list)), errmsg=cerr, stat=ierr) if (ierr /= 0) then - call self % model_error('Failed to allocate var_is_tkr_compatible', subname, __LINE__) + call self % model_error('Failed to allocate var_is_tkr_compatible' // new_line('') // & + 'Allocation returned with ' // stringify([ierr]) // ': ' // trim(adjustl(cerr)), & + subname, __LINE__) end if var_is_tkr_compatible(:) = .false. @@ -2619,10 +2678,14 @@ end subroutine dyn_mpas_compute_edge_wind ! !------------------------------------------------------------------------------- subroutine dyn_mpas_compute_cell_relative_vorticity(self, cell_relative_vorticity) + ! Module(s) from MPAS. + use dyn_mpas_procedures, only: stringify + class(mpas_dynamical_core_type), intent(in) :: self real(rkind), allocatable, intent(out) :: cell_relative_vorticity(:, :) character(*), parameter :: subname = 'dyn_mpas_subdriver::dyn_mpas_compute_cell_relative_vorticity' + character(strkind) :: cerr integer :: i, k integer :: ierr integer, pointer :: ncellssolve, nvertlevels @@ -2646,10 +2709,12 @@ subroutine dyn_mpas_compute_cell_relative_vorticity(self, cell_relative_vorticit call self % get_variable_pointer(vorticity, 'diag', 'vorticity') ! Output. - allocate(cell_relative_vorticity(nvertlevels, ncellssolve), stat=ierr) + allocate(cell_relative_vorticity(nvertlevels, ncellssolve), errmsg=cerr, stat=ierr) if (ierr /= 0) then - call self % model_error('Failed to allocate cell_relative_vorticity', subname, __LINE__) + call self % model_error('Failed to allocate cell_relative_vorticity' // new_line('') // & + 'Allocation returned with ' // stringify([ierr]) // ': ' // trim(adjustl(cerr)), & + subname, __LINE__) end if do i = 1, ncellssolve @@ -3216,7 +3281,6 @@ end subroutine dyn_mpas_final pure function dyn_mpas_get_constituent_name(self, constituent_index) result(constituent_name) class(mpas_dynamical_core_type), intent(in) :: self integer, intent(in) :: constituent_index - character(:), allocatable :: constituent_name ! Catch segmentation fault. @@ -3250,9 +3314,9 @@ end function dyn_mpas_get_constituent_name pure function dyn_mpas_get_constituent_index(self, constituent_name) result(constituent_index) class(mpas_dynamical_core_type), intent(in) :: self character(*), intent(in) :: constituent_name + integer :: constituent_index integer :: i - integer :: constituent_index ! Catch segmentation fault. if (.not. allocated(self % constituent_name)) then @@ -3286,7 +3350,6 @@ end function dyn_mpas_get_constituent_index pure function dyn_mpas_map_mpas_scalar_index(self, constituent_index) result(mpas_scalar_index) class(mpas_dynamical_core_type), intent(in) :: self integer, intent(in) :: constituent_index - integer :: mpas_scalar_index ! Catch segmentation fault. @@ -3320,7 +3383,6 @@ end function dyn_mpas_map_mpas_scalar_index pure function dyn_mpas_map_constituent_index(self, mpas_scalar_index) result(constituent_index) class(mpas_dynamical_core_type), intent(in) :: self integer, intent(in) :: mpas_scalar_index - integer :: constituent_index ! Catch segmentation fault. @@ -3924,6 +3986,9 @@ end subroutine dyn_mpas_get_variable_pointer_r5 ! !------------------------------------------------------------------------------- subroutine dyn_mpas_get_variable_value_c0(self, variable_value, pool_name, variable_name, time_level) + ! Module(s) from MPAS. + use dyn_mpas_procedures, only: stringify + class(mpas_dynamical_core_type), intent(in) :: self character(strkind), allocatable, intent(out) :: variable_value character(*), intent(in) :: pool_name @@ -3931,21 +3996,27 @@ subroutine dyn_mpas_get_variable_value_c0(self, variable_value, pool_name, varia integer, optional, intent(in) :: time_level character(*), parameter :: subname = 'dyn_mpas_subdriver::dyn_mpas_get_variable_value_c0' + character(strkind) :: cerr character(strkind), pointer :: variable_pointer integer :: ierr nullify(variable_pointer) call self % get_variable_pointer(variable_pointer, pool_name, variable_name, time_level=time_level) - allocate(variable_value, source=variable_pointer, stat=ierr) + allocate(variable_value, source=variable_pointer, errmsg=cerr, stat=ierr) if (ierr /= 0) then - call self % model_error('Failed to allocate variable "' // trim(adjustl(variable_name)) // '"', subname, __LINE__) + call self % model_error('Failed to allocate variable "' // trim(adjustl(variable_name)) // '"' // new_line('') // & + 'Allocation returned with ' // stringify([ierr]) // ': ' // trim(adjustl(cerr)), & + subname, __LINE__) end if nullify(variable_pointer) end subroutine dyn_mpas_get_variable_value_c0 subroutine dyn_mpas_get_variable_value_c1(self, variable_value, pool_name, variable_name, time_level) + ! Module(s) from MPAS. + use dyn_mpas_procedures, only: stringify + class(mpas_dynamical_core_type), intent(in) :: self character(strkind), allocatable, intent(out) :: variable_value(:) character(*), intent(in) :: pool_name @@ -3953,21 +4024,27 @@ subroutine dyn_mpas_get_variable_value_c1(self, variable_value, pool_name, varia integer, optional, intent(in) :: time_level character(*), parameter :: subname = 'dyn_mpas_subdriver::dyn_mpas_get_variable_value_c1' + character(strkind) :: cerr character(strkind), pointer :: variable_pointer(:) integer :: ierr nullify(variable_pointer) call self % get_variable_pointer(variable_pointer, pool_name, variable_name, time_level=time_level) - allocate(variable_value, source=variable_pointer, stat=ierr) + allocate(variable_value, source=variable_pointer, errmsg=cerr, stat=ierr) if (ierr /= 0) then - call self % model_error('Failed to allocate variable "' // trim(adjustl(variable_name)) // '"', subname, __LINE__) + call self % model_error('Failed to allocate variable "' // trim(adjustl(variable_name)) // '"' // new_line('') // & + 'Allocation returned with ' // stringify([ierr]) // ': ' // trim(adjustl(cerr)), & + subname, __LINE__) end if nullify(variable_pointer) end subroutine dyn_mpas_get_variable_value_c1 subroutine dyn_mpas_get_variable_value_i0(self, variable_value, pool_name, variable_name, time_level) + ! Module(s) from MPAS. + use dyn_mpas_procedures, only: stringify + class(mpas_dynamical_core_type), intent(in) :: self integer, allocatable, intent(out) :: variable_value character(*), intent(in) :: pool_name @@ -3975,21 +4052,27 @@ subroutine dyn_mpas_get_variable_value_i0(self, variable_value, pool_name, varia integer, optional, intent(in) :: time_level character(*), parameter :: subname = 'dyn_mpas_subdriver::dyn_mpas_get_variable_value_i0' + character(strkind) :: cerr integer, pointer :: variable_pointer integer :: ierr nullify(variable_pointer) call self % get_variable_pointer(variable_pointer, pool_name, variable_name, time_level=time_level) - allocate(variable_value, source=variable_pointer, stat=ierr) + allocate(variable_value, source=variable_pointer, errmsg=cerr, stat=ierr) if (ierr /= 0) then - call self % model_error('Failed to allocate variable "' // trim(adjustl(variable_name)) // '"', subname, __LINE__) + call self % model_error('Failed to allocate variable "' // trim(adjustl(variable_name)) // '"' // new_line('') // & + 'Allocation returned with ' // stringify([ierr]) // ': ' // trim(adjustl(cerr)), & + subname, __LINE__) end if nullify(variable_pointer) end subroutine dyn_mpas_get_variable_value_i0 subroutine dyn_mpas_get_variable_value_i1(self, variable_value, pool_name, variable_name, time_level) + ! Module(s) from MPAS. + use dyn_mpas_procedures, only: stringify + class(mpas_dynamical_core_type), intent(in) :: self integer, allocatable, intent(out) :: variable_value(:) character(*), intent(in) :: pool_name @@ -3997,21 +4080,27 @@ subroutine dyn_mpas_get_variable_value_i1(self, variable_value, pool_name, varia integer, optional, intent(in) :: time_level character(*), parameter :: subname = 'dyn_mpas_subdriver::dyn_mpas_get_variable_value_i1' + character(strkind) :: cerr integer, pointer :: variable_pointer(:) integer :: ierr nullify(variable_pointer) call self % get_variable_pointer(variable_pointer, pool_name, variable_name, time_level=time_level) - allocate(variable_value, source=variable_pointer, stat=ierr) + allocate(variable_value, source=variable_pointer, errmsg=cerr, stat=ierr) if (ierr /= 0) then - call self % model_error('Failed to allocate variable "' // trim(adjustl(variable_name)) // '"', subname, __LINE__) + call self % model_error('Failed to allocate variable "' // trim(adjustl(variable_name)) // '"' // new_line('') // & + 'Allocation returned with ' // stringify([ierr]) // ': ' // trim(adjustl(cerr)), & + subname, __LINE__) end if nullify(variable_pointer) end subroutine dyn_mpas_get_variable_value_i1 subroutine dyn_mpas_get_variable_value_i2(self, variable_value, pool_name, variable_name, time_level) + ! Module(s) from MPAS. + use dyn_mpas_procedures, only: stringify + class(mpas_dynamical_core_type), intent(in) :: self integer, allocatable, intent(out) :: variable_value(:, :) character(*), intent(in) :: pool_name @@ -4019,21 +4108,27 @@ subroutine dyn_mpas_get_variable_value_i2(self, variable_value, pool_name, varia integer, optional, intent(in) :: time_level character(*), parameter :: subname = 'dyn_mpas_subdriver::dyn_mpas_get_variable_value_i2' + character(strkind) :: cerr integer, pointer :: variable_pointer(:, :) integer :: ierr nullify(variable_pointer) call self % get_variable_pointer(variable_pointer, pool_name, variable_name, time_level=time_level) - allocate(variable_value, source=variable_pointer, stat=ierr) + allocate(variable_value, source=variable_pointer, errmsg=cerr, stat=ierr) if (ierr /= 0) then - call self % model_error('Failed to allocate variable "' // trim(adjustl(variable_name)) // '"', subname, __LINE__) + call self % model_error('Failed to allocate variable "' // trim(adjustl(variable_name)) // '"' // new_line('') // & + 'Allocation returned with ' // stringify([ierr]) // ': ' // trim(adjustl(cerr)), & + subname, __LINE__) end if nullify(variable_pointer) end subroutine dyn_mpas_get_variable_value_i2 subroutine dyn_mpas_get_variable_value_i3(self, variable_value, pool_name, variable_name, time_level) + ! Module(s) from MPAS. + use dyn_mpas_procedures, only: stringify + class(mpas_dynamical_core_type), intent(in) :: self integer, allocatable, intent(out) :: variable_value(:, :, :) character(*), intent(in) :: pool_name @@ -4041,21 +4136,27 @@ subroutine dyn_mpas_get_variable_value_i3(self, variable_value, pool_name, varia integer, optional, intent(in) :: time_level character(*), parameter :: subname = 'dyn_mpas_subdriver::dyn_mpas_get_variable_value_i3' + character(strkind) :: cerr integer, pointer :: variable_pointer(:, :, :) integer :: ierr nullify(variable_pointer) call self % get_variable_pointer(variable_pointer, pool_name, variable_name, time_level=time_level) - allocate(variable_value, source=variable_pointer, stat=ierr) + allocate(variable_value, source=variable_pointer, errmsg=cerr, stat=ierr) if (ierr /= 0) then - call self % model_error('Failed to allocate variable "' // trim(adjustl(variable_name)) // '"', subname, __LINE__) + call self % model_error('Failed to allocate variable "' // trim(adjustl(variable_name)) // '"' // new_line('') // & + 'Allocation returned with ' // stringify([ierr]) // ': ' // trim(adjustl(cerr)), & + subname, __LINE__) end if nullify(variable_pointer) end subroutine dyn_mpas_get_variable_value_i3 subroutine dyn_mpas_get_variable_value_l0(self, variable_value, pool_name, variable_name, time_level) + ! Module(s) from MPAS. + use dyn_mpas_procedures, only: stringify + class(mpas_dynamical_core_type), intent(in) :: self logical, allocatable, intent(out) :: variable_value character(*), intent(in) :: pool_name @@ -4063,21 +4164,27 @@ subroutine dyn_mpas_get_variable_value_l0(self, variable_value, pool_name, varia integer, optional, intent(in) :: time_level character(*), parameter :: subname = 'dyn_mpas_subdriver::dyn_mpas_get_variable_value_l0' + character(strkind) :: cerr logical, pointer :: variable_pointer integer :: ierr nullify(variable_pointer) call self % get_variable_pointer(variable_pointer, pool_name, variable_name, time_level=time_level) - allocate(variable_value, source=variable_pointer, stat=ierr) + allocate(variable_value, source=variable_pointer, errmsg=cerr, stat=ierr) if (ierr /= 0) then - call self % model_error('Failed to allocate variable "' // trim(adjustl(variable_name)) // '"', subname, __LINE__) + call self % model_error('Failed to allocate variable "' // trim(adjustl(variable_name)) // '"' // new_line('') // & + 'Allocation returned with ' // stringify([ierr]) // ': ' // trim(adjustl(cerr)), & + subname, __LINE__) end if nullify(variable_pointer) end subroutine dyn_mpas_get_variable_value_l0 subroutine dyn_mpas_get_variable_value_r0(self, variable_value, pool_name, variable_name, time_level) + ! Module(s) from MPAS. + use dyn_mpas_procedures, only: stringify + class(mpas_dynamical_core_type), intent(in) :: self real(rkind), allocatable, intent(out) :: variable_value character(*), intent(in) :: pool_name @@ -4085,21 +4192,27 @@ subroutine dyn_mpas_get_variable_value_r0(self, variable_value, pool_name, varia integer, optional, intent(in) :: time_level character(*), parameter :: subname = 'dyn_mpas_subdriver::dyn_mpas_get_variable_value_r0' + character(strkind) :: cerr real(rkind), pointer :: variable_pointer integer :: ierr nullify(variable_pointer) call self % get_variable_pointer(variable_pointer, pool_name, variable_name, time_level=time_level) - allocate(variable_value, source=variable_pointer, stat=ierr) + allocate(variable_value, source=variable_pointer, errmsg=cerr, stat=ierr) if (ierr /= 0) then - call self % model_error('Failed to allocate variable "' // trim(adjustl(variable_name)) // '"', subname, __LINE__) + call self % model_error('Failed to allocate variable "' // trim(adjustl(variable_name)) // '"' // new_line('') // & + 'Allocation returned with ' // stringify([ierr]) // ': ' // trim(adjustl(cerr)), & + subname, __LINE__) end if nullify(variable_pointer) end subroutine dyn_mpas_get_variable_value_r0 subroutine dyn_mpas_get_variable_value_r1(self, variable_value, pool_name, variable_name, time_level) + ! Module(s) from MPAS. + use dyn_mpas_procedures, only: stringify + class(mpas_dynamical_core_type), intent(in) :: self real(rkind), allocatable, intent(out) :: variable_value(:) character(*), intent(in) :: pool_name @@ -4107,21 +4220,27 @@ subroutine dyn_mpas_get_variable_value_r1(self, variable_value, pool_name, varia integer, optional, intent(in) :: time_level character(*), parameter :: subname = 'dyn_mpas_subdriver::dyn_mpas_get_variable_value_r1' + character(strkind) :: cerr real(rkind), pointer :: variable_pointer(:) integer :: ierr nullify(variable_pointer) call self % get_variable_pointer(variable_pointer, pool_name, variable_name, time_level=time_level) - allocate(variable_value, source=variable_pointer, stat=ierr) + allocate(variable_value, source=variable_pointer, errmsg=cerr, stat=ierr) if (ierr /= 0) then - call self % model_error('Failed to allocate variable "' // trim(adjustl(variable_name)) // '"', subname, __LINE__) + call self % model_error('Failed to allocate variable "' // trim(adjustl(variable_name)) // '"' // new_line('') // & + 'Allocation returned with ' // stringify([ierr]) // ': ' // trim(adjustl(cerr)), & + subname, __LINE__) end if nullify(variable_pointer) end subroutine dyn_mpas_get_variable_value_r1 subroutine dyn_mpas_get_variable_value_r2(self, variable_value, pool_name, variable_name, time_level) + ! Module(s) from MPAS. + use dyn_mpas_procedures, only: stringify + class(mpas_dynamical_core_type), intent(in) :: self real(rkind), allocatable, intent(out) :: variable_value(:, :) character(*), intent(in) :: pool_name @@ -4129,21 +4248,27 @@ subroutine dyn_mpas_get_variable_value_r2(self, variable_value, pool_name, varia integer, optional, intent(in) :: time_level character(*), parameter :: subname = 'dyn_mpas_subdriver::dyn_mpas_get_variable_value_r2' + character(strkind) :: cerr real(rkind), pointer :: variable_pointer(:, :) integer :: ierr nullify(variable_pointer) call self % get_variable_pointer(variable_pointer, pool_name, variable_name, time_level=time_level) - allocate(variable_value, source=variable_pointer, stat=ierr) + allocate(variable_value, source=variable_pointer, errmsg=cerr, stat=ierr) if (ierr /= 0) then - call self % model_error('Failed to allocate variable "' // trim(adjustl(variable_name)) // '"', subname, __LINE__) + call self % model_error('Failed to allocate variable "' // trim(adjustl(variable_name)) // '"' // new_line('') // & + 'Allocation returned with ' // stringify([ierr]) // ': ' // trim(adjustl(cerr)), & + subname, __LINE__) end if nullify(variable_pointer) end subroutine dyn_mpas_get_variable_value_r2 subroutine dyn_mpas_get_variable_value_r3(self, variable_value, pool_name, variable_name, time_level) + ! Module(s) from MPAS. + use dyn_mpas_procedures, only: stringify + class(mpas_dynamical_core_type), intent(in) :: self real(rkind), allocatable, intent(out) :: variable_value(:, :, :) character(*), intent(in) :: pool_name @@ -4151,21 +4276,27 @@ subroutine dyn_mpas_get_variable_value_r3(self, variable_value, pool_name, varia integer, optional, intent(in) :: time_level character(*), parameter :: subname = 'dyn_mpas_subdriver::dyn_mpas_get_variable_value_r3' + character(strkind) :: cerr real(rkind), pointer :: variable_pointer(:, :, :) integer :: ierr nullify(variable_pointer) call self % get_variable_pointer(variable_pointer, pool_name, variable_name, time_level=time_level) - allocate(variable_value, source=variable_pointer, stat=ierr) + allocate(variable_value, source=variable_pointer, errmsg=cerr, stat=ierr) if (ierr /= 0) then - call self % model_error('Failed to allocate variable "' // trim(adjustl(variable_name)) // '"', subname, __LINE__) + call self % model_error('Failed to allocate variable "' // trim(adjustl(variable_name)) // '"' // new_line('') // & + 'Allocation returned with ' // stringify([ierr]) // ': ' // trim(adjustl(cerr)), & + subname, __LINE__) end if nullify(variable_pointer) end subroutine dyn_mpas_get_variable_value_r3 subroutine dyn_mpas_get_variable_value_r4(self, variable_value, pool_name, variable_name, time_level) + ! Module(s) from MPAS. + use dyn_mpas_procedures, only: stringify + class(mpas_dynamical_core_type), intent(in) :: self real(rkind), allocatable, intent(out) :: variable_value(:, :, :, :) character(*), intent(in) :: pool_name @@ -4173,21 +4304,27 @@ subroutine dyn_mpas_get_variable_value_r4(self, variable_value, pool_name, varia integer, optional, intent(in) :: time_level character(*), parameter :: subname = 'dyn_mpas_subdriver::dyn_mpas_get_variable_value_r4' + character(strkind) :: cerr real(rkind), pointer :: variable_pointer(:, :, :, :) integer :: ierr nullify(variable_pointer) call self % get_variable_pointer(variable_pointer, pool_name, variable_name, time_level=time_level) - allocate(variable_value, source=variable_pointer, stat=ierr) + allocate(variable_value, source=variable_pointer, errmsg=cerr, stat=ierr) if (ierr /= 0) then - call self % model_error('Failed to allocate variable "' // trim(adjustl(variable_name)) // '"', subname, __LINE__) + call self % model_error('Failed to allocate variable "' // trim(adjustl(variable_name)) // '"' // new_line('') // & + 'Allocation returned with ' // stringify([ierr]) // ': ' // trim(adjustl(cerr)), & + subname, __LINE__) end if nullify(variable_pointer) end subroutine dyn_mpas_get_variable_value_r4 subroutine dyn_mpas_get_variable_value_r5(self, variable_value, pool_name, variable_name, time_level) + ! Module(s) from MPAS. + use dyn_mpas_procedures, only: stringify + class(mpas_dynamical_core_type), intent(in) :: self real(rkind), allocatable, intent(out) :: variable_value(:, :, :, :, :) character(*), intent(in) :: pool_name @@ -4195,15 +4332,18 @@ subroutine dyn_mpas_get_variable_value_r5(self, variable_value, pool_name, varia integer, optional, intent(in) :: time_level character(*), parameter :: subname = 'dyn_mpas_subdriver::dyn_mpas_get_variable_value_r5' + character(strkind) :: cerr real(rkind), pointer :: variable_pointer(:, :, :, :, :) integer :: ierr nullify(variable_pointer) call self % get_variable_pointer(variable_pointer, pool_name, variable_name, time_level=time_level) - allocate(variable_value, source=variable_pointer, stat=ierr) + allocate(variable_value, source=variable_pointer, errmsg=cerr, stat=ierr) if (ierr /= 0) then - call self % model_error('Failed to allocate variable "' // trim(adjustl(variable_name)) // '"', subname, __LINE__) + call self % model_error('Failed to allocate variable "' // trim(adjustl(variable_name)) // '"' // new_line('') // & + 'Allocation returned with ' // stringify([ierr]) // ': ' // trim(adjustl(cerr)), & + subname, __LINE__) end if nullify(variable_pointer) diff --git a/src/dynamics/mpas/dyn_comp.F90 b/src/dynamics/mpas/dyn_comp.F90 index 76e50e379..fd7353421 100644 --- a/src/dynamics/mpas/dyn_comp.F90 +++ b/src/dynamics/mpas/dyn_comp.F90 @@ -41,24 +41,28 @@ module dyn_comp interface module subroutine dyn_readnl(namelist_path) + implicit none character(*), intent(in) :: namelist_path end subroutine dyn_readnl module subroutine dyn_init(cam_runtime_opts, dyn_in, dyn_out) use runtime_obj, only: runtime_options - + implicit none type(runtime_options), intent(in) :: cam_runtime_opts type(dyn_import_t), intent(in) :: dyn_in type(dyn_export_t), intent(in) :: dyn_out end subroutine dyn_init module subroutine dyn_run() + implicit none end subroutine dyn_run module subroutine dyn_final() + implicit none end subroutine dyn_final module subroutine dyn_debug_print(level, message, printer) + implicit none integer, intent(in) :: level character(*), intent(in) :: message integer, optional, intent(in) :: printer diff --git a/src/dynamics/mpas/dyn_comp_impl.F90 b/src/dynamics/mpas/dyn_comp_impl.F90 index 5550d31b7..8336798eb 100644 --- a/src/dynamics/mpas/dyn_comp_impl.F90 +++ b/src/dynamics/mpas/dyn_comp_impl.F90 @@ -139,6 +139,8 @@ module subroutine dyn_init(cam_runtime_opts, dyn_in, dyn_out) use time_manager, only: get_step_size ! Module(s) from CCPP. use phys_vars_init_check, only: std_name_len + ! Module(s) from CESM Share. + use shr_kind_mod, only: len_cx => shr_kind_cx ! Module(s) from external libraries. use pio, only: file_desc_t @@ -147,6 +149,7 @@ module subroutine dyn_init(cam_runtime_opts, dyn_in, dyn_out) type(dyn_export_t), intent(in) :: dyn_out character(*), parameter :: subname = 'dyn_comp::dyn_init' + character(len_cx) :: cerr character(std_name_len), allocatable :: constituent_name(:) integer :: coupling_time_interval integer :: i @@ -160,11 +163,13 @@ module subroutine dyn_init(cam_runtime_opts, dyn_in, dyn_out) nullify(pio_init_file) nullify(pio_topo_file) - allocate(constituent_name(num_advected), stat=ierr) - call check_allocate(ierr, subname, 'constituent_name(num_advected)', 'dyn_comp', __LINE__) + allocate(constituent_name(num_advected), errmsg=cerr, stat=ierr) + call check_allocate(ierr, subname, 'constituent_name(num_advected)', & + file='dyn_comp', line=__LINE__, errmsg=trim(adjustl(cerr))) - allocate(is_water_species(num_advected), stat=ierr) - call check_allocate(ierr, subname, 'is_water_species(num_advected)', 'dyn_comp', __LINE__) + allocate(is_water_species(num_advected), errmsg=cerr, stat=ierr) + call check_allocate(ierr, subname, 'is_water_species(num_advected)', & + file='dyn_comp', line=__LINE__, errmsg=trim(adjustl(cerr))) do i = 1, num_advected constituent_name(i) = const_name(i) @@ -327,7 +332,8 @@ subroutine check_topography_data(pio_file) use dyn_grid, only: ncells_solve use dynconst, only: constant_g => gravit ! Module(s) from CESM Share. - use shr_kind_mod, only: kind_r8 => shr_kind_r8 + use shr_kind_mod, only: kind_r8 => shr_kind_r8, & + len_cx => shr_kind_cx ! Module(s) from external libraries. use pio, only: file_desc_t, pio_file_is_open ! Module(s) from MPAS. @@ -336,6 +342,7 @@ subroutine check_topography_data(pio_file) type(file_desc_t), pointer, intent(in) :: pio_file character(*), parameter :: subname = 'dyn_comp::check_topography_data' + character(len_cx) :: cerr integer :: ierr logical :: success real(kind_r8), parameter :: error_tolerance = 1.0E-3_kind_r8 ! Error tolerance for consistency check. @@ -356,11 +363,13 @@ subroutine check_topography_data(pio_file) call endrun('Invalid PIO file descriptor', subname, __LINE__) end if - allocate(surface_geopotential(ncells_solve), stat=ierr) - call check_allocate(ierr, subname, 'surface_geopotential(ncells_solve)', 'dyn_comp', __LINE__) + allocate(surface_geopotential(ncells_solve), errmsg=cerr, stat=ierr) + call check_allocate(ierr, subname, 'surface_geopotential(ncells_solve)', & + file='dyn_comp', line=__LINE__, errmsg=trim(adjustl(cerr))) - allocate(surface_geometric_height(ncells_solve), stat=ierr) - call check_allocate(ierr, subname, 'surface_geometric_height(ncells_solve)', 'dyn_comp', __LINE__) + allocate(surface_geometric_height(ncells_solve), errmsg=cerr, stat=ierr) + call check_allocate(ierr, subname, 'surface_geometric_height(ncells_solve)', & + file='dyn_comp', line=__LINE__, errmsg=trim(adjustl(cerr))) surface_geopotential(:) = 0.0_kind_r8 surface_geometric_height(:) = 0.0_kind_r8 @@ -441,8 +450,11 @@ subroutine init_shared_variables() use dyn_procedures, only: reverse use dynconst, only: deg_to_rad use vert_coord, only: pverp + ! Module(s) from CESM Share. + use shr_kind_mod, only: len_cx => shr_kind_cx character(*), parameter :: subname = 'dyn_comp::set_analytic_initial_condition::init_shared_variables' + character(len_cx) :: cerr integer :: i integer :: ierr integer, pointer :: indextocellid(:) @@ -454,8 +466,9 @@ subroutine init_shared_variables() nullify(indextocellid) nullify(lat_deg, lon_deg) - allocate(global_grid_index(ncells_solve), stat=ierr) - call check_allocate(ierr, subname, 'global_grid_index(ncells_solve)', 'dyn_comp', __LINE__) + allocate(global_grid_index(ncells_solve), errmsg=cerr, stat=ierr) + call check_allocate(ierr, subname, 'global_grid_index(ncells_solve)', & + file='dyn_comp', line=__LINE__, errmsg=trim(adjustl(cerr))) call mpas_dynamical_core % get_variable_pointer(indextocellid, 'mesh', 'indexToCellID') @@ -463,11 +476,13 @@ subroutine init_shared_variables() nullify(indextocellid) - allocate(lat_rad(ncells_solve), stat=ierr) - call check_allocate(ierr, subname, 'lat_rad(ncells_solve)', 'dyn_comp', __LINE__) + allocate(lat_rad(ncells_solve), errmsg=cerr, stat=ierr) + call check_allocate(ierr, subname, 'lat_rad(ncells_solve)', & + file='dyn_comp', line=__LINE__, errmsg=trim(adjustl(cerr))) - allocate(lon_rad(ncells_solve), stat=ierr) - call check_allocate(ierr, subname, 'lon_rad(ncells_solve)', 'dyn_comp', __LINE__) + allocate(lon_rad(ncells_solve), errmsg=cerr, stat=ierr) + call check_allocate(ierr, subname, 'lon_rad(ncells_solve)', & + file='dyn_comp', line=__LINE__, errmsg=trim(adjustl(cerr))) ! "mpas_cell" is a registered grid name that is defined in `dyn_grid`. lat_deg => cam_grid_get_latvals(cam_grid_id('mpas_cell')) @@ -486,8 +501,9 @@ subroutine init_shared_variables() nullify(lat_deg, lon_deg) - allocate(z_int(ncells_solve, pverp), stat=ierr) - call check_allocate(ierr, subname, 'z_int(ncells_solve, pverp)', 'dyn_comp', __LINE__) + allocate(z_int(ncells_solve, pverp), errmsg=cerr, stat=ierr) + call check_allocate(ierr, subname, 'z_int(ncells_solve, pverp)', & + file='dyn_comp', line=__LINE__, errmsg=trim(adjustl(cerr))) call mpas_dynamical_core % get_variable_pointer(zgrid, 'mesh', 'zgrid') @@ -520,8 +536,11 @@ subroutine set_mpas_state_u() use dyn_tests_utils, only: vc_height use inic_analytic, only: dyn_set_inic_col use vert_coord, only: pver + ! Module(s) from CESM Share. + use shr_kind_mod, only: len_cx => shr_kind_cx character(*), parameter :: subname = 'dyn_comp::set_analytic_initial_condition::set_mpas_state_u' + character(len_cx) :: cerr integer :: i integer :: ierr real(kind_dyn_mpas), pointer :: ucellzonal(:, :), ucellmeridional(:, :) @@ -530,8 +549,9 @@ subroutine set_mpas_state_u() nullify(ucellzonal, ucellmeridional) - allocate(buffer_2d_real(ncells_solve, pver), stat=ierr) - call check_allocate(ierr, subname, 'buffer_2d_real(ncells_solve, pver)', 'dyn_comp', __LINE__) + allocate(buffer_2d_real(ncells_solve, pver), errmsg=cerr, stat=ierr) + call check_allocate(ierr, subname, 'buffer_2d_real(ncells_solve, pver)', & + file='dyn_comp', line=__LINE__, errmsg=trim(adjustl(cerr))) call mpas_dynamical_core % get_variable_pointer(ucellzonal, 'diag', 'uReconstructZonal') call mpas_dynamical_core % get_variable_pointer(ucellmeridional, 'diag', 'uReconstructMeridional') @@ -597,12 +617,15 @@ subroutine set_mpas_state_scalars() use dyn_tests_utils, only: vc_height use inic_analytic, only: dyn_set_inic_col use vert_coord, only: pver + ! Module(s) from CESM Share. + use shr_kind_mod, only: len_cx => shr_kind_cx ! CCPP standard name of `qv`, which denotes water vapor mixing ratio. character(*), parameter :: constituent_qv_standard_name = & 'water_vapor_mixing_ratio_wrt_dry_air' character(*), parameter :: subname = 'dyn_comp::set_analytic_initial_condition::set_mpas_state_scalars' + character(len_cx) :: cerr integer :: i, j integer :: ierr integer, allocatable :: constituent_index(:) @@ -614,11 +637,13 @@ subroutine set_mpas_state_scalars() nullify(index_qv) nullify(scalars) - allocate(buffer_3d_real(ncells_solve, pver, num_advected), stat=ierr) - call check_allocate(ierr, subname, 'buffer_3d_real(ncells_solve, pver, num_advected)', 'dyn_comp', __LINE__) + allocate(buffer_3d_real(ncells_solve, pver, num_advected), errmsg=cerr, stat=ierr) + call check_allocate(ierr, subname, 'buffer_3d_real(ncells_solve, pver, num_advected)', & + file='dyn_comp', line=__LINE__, errmsg=trim(adjustl(cerr))) - allocate(constituent_index(num_advected), stat=ierr) - call check_allocate(ierr, subname, 'constituent_index(num_advected)', 'dyn_comp', __LINE__) + allocate(constituent_index(num_advected), errmsg=cerr, stat=ierr) + call check_allocate(ierr, subname, 'constituent_index(num_advected)', & + file='dyn_comp', line=__LINE__, errmsg=trim(adjustl(cerr))) call mpas_dynamical_core % get_variable_pointer(index_qv, 'dim', 'index_qv') call mpas_dynamical_core % get_variable_pointer(scalars, 'state', 'scalars', time_level=1) @@ -675,8 +700,11 @@ subroutine set_mpas_state_rho_theta() constant_rd => rair, constant_rv => rh2o use inic_analytic, only: dyn_set_inic_col use vert_coord, only: pver + ! Module(s) from CESM Share. + use shr_kind_mod, only: len_cx => shr_kind_cx character(*), parameter :: subname = 'dyn_comp::set_analytic_initial_condition::set_mpas_state_rho_theta' + character(len_cx) :: cerr integer :: i, k integer :: ierr integer, pointer :: index_qv @@ -701,18 +729,21 @@ subroutine set_mpas_state_rho_theta() nullify(theta) nullify(scalars) - allocate(p_sfc(ncells_solve), stat=ierr) - call check_allocate(ierr, subname, 'p_sfc(ncells_solve)', 'dyn_comp', __LINE__) + allocate(p_sfc(ncells_solve), errmsg=cerr, stat=ierr) + call check_allocate(ierr, subname, 'p_sfc(ncells_solve)', & + file='dyn_comp', line=__LINE__, errmsg=trim(adjustl(cerr))) p_sfc(:) = 0.0_kind_r8 call dyn_set_inic_col(vc_height, lat_rad, lon_rad, global_grid_index, zint=z_int, ps=p_sfc) - allocate(buffer_2d_real(ncells_solve, pver), stat=ierr) - call check_allocate(ierr, subname, 'buffer_2d_real(ncells_solve, pver)', 'dyn_comp', __LINE__) + allocate(buffer_2d_real(ncells_solve, pver), errmsg=cerr, stat=ierr) + call check_allocate(ierr, subname, 'buffer_2d_real(ncells_solve, pver)', & + file='dyn_comp', line=__LINE__, errmsg=trim(adjustl(cerr))) - allocate(t_mid(pver, ncells_solve), stat=ierr) - call check_allocate(ierr, subname, 't_mid(pver, ncells_solve)', 'dyn_comp', __LINE__) + allocate(t_mid(pver, ncells_solve), errmsg=cerr, stat=ierr) + call check_allocate(ierr, subname, 't_mid(pver, ncells_solve)', & + file='dyn_comp', line=__LINE__, errmsg=trim(adjustl(cerr))) buffer_2d_real(:, :) = 0.0_kind_r8 @@ -725,17 +756,21 @@ subroutine set_mpas_state_rho_theta() deallocate(buffer_2d_real) - allocate(p_mid_col(pver), stat=ierr) - call check_allocate(ierr, subname, 'p_mid_col(pver)', 'dyn_comp', __LINE__) + allocate(p_mid_col(pver), errmsg=cerr, stat=ierr) + call check_allocate(ierr, subname, 'p_mid_col(pver)', & + file='dyn_comp', line=__LINE__, errmsg=trim(adjustl(cerr))) - allocate(qv_mid_col(pver), stat=ierr) - call check_allocate(ierr, subname, 'qv_mid_col(pver)', 'dyn_comp', __LINE__) + allocate(qv_mid_col(pver), errmsg=cerr, stat=ierr) + call check_allocate(ierr, subname, 'qv_mid_col(pver)', & + file='dyn_comp', line=__LINE__, errmsg=trim(adjustl(cerr))) - allocate(tm_mid_col(pver), stat=ierr) - call check_allocate(ierr, subname, 'tm_mid_col(pver)', 'dyn_comp', __LINE__) + allocate(tm_mid_col(pver), errmsg=cerr, stat=ierr) + call check_allocate(ierr, subname, 'tm_mid_col(pver)', & + file='dyn_comp', line=__LINE__, errmsg=trim(adjustl(cerr))) - allocate(tv_mid_col(pver), stat=ierr) - call check_allocate(ierr, subname, 'tv_mid_col(pver)', 'dyn_comp', __LINE__) + allocate(tv_mid_col(pver), errmsg=cerr, stat=ierr) + call check_allocate(ierr, subname, 'tv_mid_col(pver)', & + file='dyn_comp', line=__LINE__, errmsg=trim(adjustl(cerr))) call mpas_dynamical_core % get_variable_pointer(index_qv, 'dim', 'index_qv') call mpas_dynamical_core % get_variable_pointer(rho, 'diag', 'rho') @@ -810,8 +845,11 @@ subroutine set_mpas_state_rho_base_theta_base() use dynconst, only: constant_cpd => cpair, constant_g => gravit, constant_p0 => pref, & constant_rd => rair use vert_coord, only: pver + ! Module(s) from CESM Share. + use shr_kind_mod, only: len_cx => shr_kind_cx character(*), parameter :: subname = 'dyn_comp::set_analytic_initial_condition::set_mpas_state_rho_base_theta_base' + character(len_cx) :: cerr integer :: i, k integer :: ierr real(kind_r8), parameter :: t_base = 250.0_kind_r8 ! Base state temperature (K) of dry isothermal atmosphere. @@ -827,8 +865,9 @@ subroutine set_mpas_state_rho_base_theta_base() nullify(theta_base) nullify(zz) - allocate(p_base(pver), stat=ierr) - call check_allocate(ierr, subname, 'p_base(pver)', 'dyn_comp', __LINE__) + allocate(p_base(pver), errmsg=cerr, stat=ierr) + call check_allocate(ierr, subname, 'p_base(pver)', & + file='dyn_comp', line=__LINE__, errmsg=trim(adjustl(cerr))) call mpas_dynamical_core % get_variable_pointer(rho_base, 'diag', 'rho_base') call mpas_dynamical_core % get_variable_pointer(theta_base, 'diag', 'theta_base') @@ -984,11 +1023,13 @@ subroutine dyn_variable_dump() use dyn_grid, only: ncells_solve use physics_types, only: phys_state ! Module(s) from CESM Share. + use shr_kind_mod, only: len_cx => shr_kind_cx use shr_pio_mod, only: shr_pio_getioformat, shr_pio_getiosys, shr_pio_getiotype ! Module(s) from external libraries. use pio, only: file_desc_t, iosystem_desc_t, pio_createfile, pio_closefile, pio_clobber, pio_noerr character(*), parameter :: subname = 'dyn_comp::dyn_variable_dump' + character(len_cx) :: cerr integer :: ierr integer :: pio_ioformat, pio_iotype real(kind_dyn_mpas), pointer :: surface_pressure(:) @@ -1007,8 +1048,9 @@ subroutine dyn_variable_dump() call mpas_dynamical_core % exchange_halo('surface_pressure') - allocate(pio_file, stat=ierr) - call check_allocate(ierr, subname, 'pio_file', 'dyn_comp', __LINE__) + allocate(pio_file, errmsg=cerr, stat=ierr) + call check_allocate(ierr, subname, 'pio_file', & + file='dyn_comp', line=__LINE__, errmsg=trim(adjustl(cerr))) pio_iosystem => shr_pio_getiosys(atm_id) diff --git a/src/dynamics/mpas/dyn_coupling.F90 b/src/dynamics/mpas/dyn_coupling.F90 index 29ab2ed9e..54efbd116 100644 --- a/src/dynamics/mpas/dyn_coupling.F90 +++ b/src/dynamics/mpas/dyn_coupling.F90 @@ -18,15 +18,18 @@ module dyn_coupling interface module subroutine dyn_exchange_constituent_states(direction, exchange, conversion) + implicit none character(*), intent(in) :: direction logical, intent(in) :: exchange logical, intent(in) :: conversion end subroutine dyn_exchange_constituent_states module subroutine dynamics_to_physics_coupling() + implicit none end subroutine dynamics_to_physics_coupling module subroutine physics_to_dynamics_coupling() + implicit none end subroutine physics_to_dynamics_coupling end interface end module dyn_coupling diff --git a/src/dynamics/mpas/dyn_coupling_impl.F90 b/src/dynamics/mpas/dyn_coupling_impl.F90 index c3b9cbb86..68eebfb97 100644 --- a/src/dynamics/mpas/dyn_coupling_impl.F90 +++ b/src/dynamics/mpas/dyn_coupling_impl.F90 @@ -35,13 +35,15 @@ module subroutine dyn_exchange_constituent_states(direction, exchange, conversio use cam_ccpp_cap, only: cam_constituents_array use ccpp_kinds, only: kind_phys ! Module(s) from CESM Share. - use shr_kind_mod, only: kind_r8 => shr_kind_r8 + use shr_kind_mod, only: kind_r8 => shr_kind_r8, & + len_cx => shr_kind_cx character(*), intent(in) :: direction logical, intent(in) :: exchange logical, intent(in) :: conversion character(*), parameter :: subname = 'dyn_coupling::dyn_exchange_constituent_states' + character(len_cx) :: cerr integer :: i, j integer :: ierr integer, allocatable :: is_water_species_index(:) @@ -77,15 +79,15 @@ module subroutine dyn_exchange_constituent_states(direction, exchange, conversio nullify(constituents) nullify(scalars) - allocate(is_conversion_needed(num_advected), stat=ierr) + allocate(is_conversion_needed(num_advected), errmsg=cerr, stat=ierr) call check_allocate(ierr, subname, & 'is_conversion_needed(num_advected)', & - 'dyn_comp', __LINE__) + file='dyn_coupling', line=__LINE__, errmsg=trim(adjustl(cerr))) - allocate(is_water_species(num_advected), stat=ierr) + allocate(is_water_species(num_advected), errmsg=cerr, stat=ierr) call check_allocate(ierr, subname, & 'is_water_species(num_advected)', & - 'dyn_comp', __LINE__) + file='dyn_coupling', line=__LINE__, errmsg=trim(adjustl(cerr))) do j = 1, num_advected ! All constituent mixing ratios in MPAS are dry. @@ -94,15 +96,15 @@ module subroutine dyn_exchange_constituent_states(direction, exchange, conversio is_water_species(j) = const_is_water_species(j) end do - allocate(is_water_species_index(count(is_water_species)), stat=ierr) + allocate(is_water_species_index(count(is_water_species)), errmsg=cerr, stat=ierr) call check_allocate(ierr, subname, & 'is_water_species_index(count(is_water_species))', & - 'dyn_comp', __LINE__) + file='dyn_coupling', line=__LINE__, errmsg=trim(adjustl(cerr))) - allocate(sigma_all_q(pver), stat=ierr) + allocate(sigma_all_q(pver), errmsg=cerr, stat=ierr) call check_allocate(ierr, subname, & 'sigma_all_q(pver)', & - 'dyn_comp', __LINE__) + file='dyn_coupling', line=__LINE__, errmsg=trim(adjustl(cerr))) constituents => cam_constituents_array() @@ -254,8 +256,11 @@ subroutine init_shared_variables() use cam_constituents, only: const_is_water_species, num_advected use dyn_comp, only: mpas_dynamical_core use vert_coord, only: pver, pverp + ! Module(s) from CESM Share. + use shr_kind_mod, only: len_cx => shr_kind_cx character(*), parameter :: subname = 'dyn_coupling::dynamics_to_physics_coupling::init_shared_variables' + character(len_cx) :: cerr integer :: i integer :: ierr logical, allocatable :: is_water_species(:) @@ -271,54 +276,55 @@ subroutine init_shared_variables() nullify(zgrid) nullify(zz) - allocate(is_water_species(num_advected), stat=ierr) + allocate(is_water_species(num_advected), errmsg=cerr, stat=ierr) call check_allocate(ierr, subname, & 'is_water_species(num_advected)', & - 'dyn_coupling', __LINE__) + file='dyn_coupling', line=__LINE__, errmsg=trim(adjustl(cerr))) do i = 1, num_advected is_water_species(i) = const_is_water_species(i) end do - allocate(is_water_species_index(count(is_water_species)), stat=ierr) + allocate(is_water_species_index(count(is_water_species)), errmsg=cerr, stat=ierr) call check_allocate(ierr, subname, & 'is_water_species_index(count(is_water_species))', & - 'dyn_coupling', __LINE__) + file='dyn_coupling', line=__LINE__, errmsg=trim(adjustl(cerr))) is_water_species_index(:) = & pack([(mpas_dynamical_core % map_mpas_scalar_index(i), i = 1, num_advected)], is_water_species) deallocate(is_water_species) - allocate(pd_int_col(pverp), pd_mid_col(pver), p_int_col(pverp), p_mid_col(pver), z_int_col(pverp), stat=ierr) + allocate(pd_int_col(pverp), pd_mid_col(pver), p_int_col(pverp), p_mid_col(pver), z_int_col(pverp), & + errmsg=cerr, stat=ierr) call check_allocate(ierr, subname, & 'pd_int_col(pverp), pd_mid_col(pver), p_int_col(pverp), p_mid_col(pver), z_int_col(pverp)', & - 'dyn_coupling', __LINE__) + file='dyn_coupling', line=__LINE__, errmsg=trim(adjustl(cerr))) - allocate(dpd_col(pver), dp_col(pver), dz_col(pver), stat=ierr) + allocate(dpd_col(pver), dp_col(pver), dz_col(pver), errmsg=cerr, stat=ierr) call check_allocate(ierr, subname, & 'dpd_col(pver), dp_col(pver), dz_col(pver)', & - 'dyn_coupling', __LINE__) + file='dyn_coupling', line=__LINE__, errmsg=trim(adjustl(cerr))) - allocate(qv_mid_col(pver), sigma_all_q_mid_col(pver), stat=ierr) + allocate(qv_mid_col(pver), sigma_all_q_mid_col(pver), errmsg=cerr, stat=ierr) call check_allocate(ierr, subname, & 'qv_mid_col(pver), sigma_all_q_mid_col(pver)', & - 'dyn_coupling', __LINE__) + file='dyn_coupling', line=__LINE__, errmsg=trim(adjustl(cerr))) - allocate(rhod_mid_col(pver), rho_mid_col(pver), stat=ierr) + allocate(rhod_mid_col(pver), rho_mid_col(pver), errmsg=cerr, stat=ierr) call check_allocate(ierr, subname, & 'rhod_mid_col(pver), rho_mid_col(pver)', & - 'dyn_coupling', __LINE__) + file='dyn_coupling', line=__LINE__, errmsg=trim(adjustl(cerr))) - allocate(t_mid_col(pver), tm_mid_col(pver), tv_mid_col(pver), stat=ierr) + allocate(t_mid_col(pver), tm_mid_col(pver), tv_mid_col(pver), errmsg=cerr, stat=ierr) call check_allocate(ierr, subname, & 't_mid_col(pver), tm_mid_col(pver), tv_mid_col(pver)', & - 'dyn_coupling', __LINE__) + file='dyn_coupling', line=__LINE__, errmsg=trim(adjustl(cerr))) - allocate(u_mid_col(pver), v_mid_col(pver), omega_mid_col(pver), stat=ierr) + allocate(u_mid_col(pver), v_mid_col(pver), omega_mid_col(pver), errmsg=cerr, stat=ierr) call check_allocate(ierr, subname, & 'u_mid_col(pver), v_mid_col(pver), omega_mid_col(pver)', & - 'dyn_coupling', __LINE__) + file='dyn_coupling', line=__LINE__, errmsg=trim(adjustl(cerr))) call mpas_dynamical_core % get_variable_pointer(index_qv, 'dim', 'index_qv') call mpas_dynamical_core % get_variable_pointer(exner, 'diag', 'exner') @@ -375,7 +381,7 @@ subroutine update_shared_variables(i) real(kind_r8), parameter :: p_int_mid_proximity_limit = 0.05_kind_r8 ! The summation term of equation 5 in doi:10.1029/2017MS001257. - sigma_all_q_mid_col(:) = 1.0_kind_r8 + sum(scalars(is_water_species_index, :, i), 1) + sigma_all_q_mid_col(:) = 1.0_kind_r8 + sum(real(scalars(is_water_species_index, :, i), kind_r8), 1) ! Compute thermodynamic variables. @@ -519,10 +525,10 @@ subroutine set_physics_state_external() nullify(constituents) nullify(constituent_properties) - allocate(minimum_constituents(num_advected), stat=ierr) + allocate(minimum_constituents(num_advected), errmsg=cerr, stat=ierr) call check_allocate(ierr, subname, & 'minimum_constituents(num_advected)', & - 'dyn_coupling', __LINE__) + file='dyn_coupling', line=__LINE__, errmsg=trim(adjustl(cerr))) do i = 1, num_advected minimum_constituents(i) = const_qmin(i) @@ -643,8 +649,11 @@ subroutine init_shared_variables() use dyn_comp, only: mpas_dynamical_core use dyn_grid, only: ncells_solve use vert_coord, only: pver + ! Module(s) from CESM Share. + use shr_kind_mod, only: len_cx => shr_kind_cx character(*), parameter :: subname = 'dyn_coupling::physics_to_dynamics_coupling::init_shared_variables' + character(len_cx) :: cerr integer :: ierr call dyn_debug_print(debugout_info, 'Preparing for physics-dynamics coupling') @@ -659,10 +668,10 @@ subroutine init_shared_variables() call mpas_dynamical_core % get_variable_pointer(scalars, 'state', 'scalars', time_level=1) call mpas_dynamical_core % get_variable_pointer(zz, 'mesh', 'zz') - allocate(qv_prev(pver, ncells_solve), stat=ierr) + allocate(qv_prev(pver, ncells_solve), errmsg=cerr, stat=ierr) call check_allocate(ierr, subname, & 'qv_prev(pver, ncells_solve)', & - 'dyn_coupling', __LINE__) + file='dyn_coupling', line=__LINE__, errmsg=trim(adjustl(cerr))) ! Save water vapor mixing ratio before being updated by physics because `set_mpas_physics_tendency_rtheta` ! needs it. This must be done before calling `dyn_exchange_constituent_states`. @@ -758,8 +767,11 @@ subroutine set_mpas_physics_tendency_rtheta() constant_rd => rair, constant_rv => rh2o use physics_types, only: dtime_phys, phys_tend use vert_coord, only: pver + ! Module(s) from CESM Share. + use shr_kind_mod, only: len_cx => shr_kind_cx character(*), parameter :: subname = 'dyn_coupling::physics_to_dynamics_coupling::set_mpas_physics_tendency_rtheta' + character(len_cx) :: cerr integer :: i integer :: ierr ! Variable name suffixes have the following meanings: @@ -779,30 +791,30 @@ subroutine set_mpas_physics_tendency_rtheta() nullify(theta_m) nullify(theta_m_tendency) - allocate(qv_col_prev(pver), qv_col_curr(pver), stat=ierr) + allocate(qv_col_prev(pver), qv_col_curr(pver), errmsg=cerr, stat=ierr) call check_allocate(ierr, subname, & 'qv_col_prev(pver), qv_col_curr(pver)', & - 'dyn_coupling', __LINE__) + file='dyn_coupling', line=__LINE__, errmsg=trim(adjustl(cerr))) - allocate(rhod_col(pver), stat=ierr) + allocate(rhod_col(pver), errmsg=cerr, stat=ierr) call check_allocate(ierr, subname, & 'rhod_col(pver)', & - 'dyn_coupling', __LINE__) + file='dyn_coupling', line=__LINE__, errmsg=trim(adjustl(cerr))) - allocate(t_col_prev(pver), t_col_curr(pver), stat=ierr) + allocate(t_col_prev(pver), t_col_curr(pver), errmsg=cerr, stat=ierr) call check_allocate(ierr, subname, & 't_col_prev(pver), t_col_curr(pver)', & - 'dyn_coupling', __LINE__) + file='dyn_coupling', line=__LINE__, errmsg=trim(adjustl(cerr))) - allocate(theta_col_prev(pver), theta_col_curr(pver), stat=ierr) + allocate(theta_col_prev(pver), theta_col_curr(pver), errmsg=cerr, stat=ierr) call check_allocate(ierr, subname, & 'theta_col_prev(pver), theta_col_curr(pver)', & - 'dyn_coupling', __LINE__) + file='dyn_coupling', line=__LINE__, errmsg=trim(adjustl(cerr))) - allocate(thetam_col_prev(pver), thetam_col_curr(pver), stat=ierr) + allocate(thetam_col_prev(pver), thetam_col_curr(pver), errmsg=cerr, stat=ierr) call check_allocate(ierr, subname, & 'thetam_col_prev(pver), thetam_col_curr(pver)', & - 'dyn_coupling', __LINE__) + file='dyn_coupling', line=__LINE__, errmsg=trim(adjustl(cerr))) call mpas_dynamical_core % get_variable_pointer(theta_m, 'state', 'theta_m', time_level=1) call mpas_dynamical_core % get_variable_pointer(theta_m_tendency, 'tend_physics', 'tend_rtheta_physics') diff --git a/src/dynamics/mpas/dyn_grid.F90 b/src/dynamics/mpas/dyn_grid.F90 index 8f44e39fe..265b2f7c4 100644 --- a/src/dynamics/mpas/dyn_grid.F90 +++ b/src/dynamics/mpas/dyn_grid.F90 @@ -26,12 +26,15 @@ module dyn_grid interface module subroutine model_grid_init() + implicit none end subroutine model_grid_init module subroutine dyn_inquire_mesh_dimensions() + implicit none end subroutine dyn_inquire_mesh_dimensions module pure function dyn_grid_id(name) + implicit none character(*), intent(in) :: name integer :: dyn_grid_id end function dyn_grid_id @@ -39,7 +42,7 @@ end function dyn_grid_id ! Grid names that are to be registered with CAM-SIMA by calling `cam_grid_register`. ! Grid ids can be determined by calling `dyn_grid_id`. - character(*), parameter :: dyn_grid_name(*) = [ character(max_hcoordname_len) :: & + character(*), parameter :: dyn_grid_name(*) = [character(max_hcoordname_len) :: & 'mpas_cell', & 'cam_cell', & 'mpas_edge', & diff --git a/src/dynamics/mpas/dyn_grid_impl.F90 b/src/dynamics/mpas/dyn_grid_impl.F90 index 62ce433d1..e95a977f5 100644 --- a/src/dynamics/mpas/dyn_grid_impl.F90 +++ b/src/dynamics/mpas/dyn_grid_impl.F90 @@ -141,9 +141,11 @@ subroutine init_reference_pressure() use string_utils, only: stringify use vert_coord, only: pver, pverp ! Module(s) from CESM Share. - use shr_kind_mod, only: kind_r8 => shr_kind_r8 + use shr_kind_mod, only: kind_r8 => shr_kind_r8, & + len_cx => shr_kind_cx character(*), parameter :: subname = 'dyn_grid::init_reference_pressure' + character(len_cx) :: cerr ! Number of pure pressure levels at model top. integer, parameter :: num_pure_p_lev = 0 integer :: ierr @@ -172,17 +174,20 @@ subroutine init_reference_pressure() ! Compute reference height. call mpas_dynamical_core % get_variable_pointer(rdzw, 'mesh', 'rdzw') - allocate(dzw(pver), stat=ierr) - call check_allocate(ierr, subname, 'dzw(pver)', 'dyn_grid', __LINE__) + allocate(dzw(pver), errmsg=cerr, stat=ierr) + call check_allocate(ierr, subname, 'dzw(pver)', & + file='dyn_grid', line=__LINE__, errmsg=trim(adjustl(cerr))) dzw(:) = 1.0_kind_r8 / real(rdzw(:), kind_r8) nullify(rdzw) - allocate(zw(pverp), stat=ierr) - call check_allocate(ierr, subname, 'zw(pverp)', 'dyn_grid', __LINE__) - allocate(zu(pver), stat=ierr) - call check_allocate(ierr, subname, 'zu(pver)', 'dyn_grid', __LINE__) + allocate(zw(pverp), errmsg=cerr, stat=ierr) + call check_allocate(ierr, subname, 'zw(pverp)', & + file='dyn_grid', line=__LINE__, errmsg=trim(adjustl(cerr))) + allocate(zu(pver), errmsg=cerr, stat=ierr) + call check_allocate(ierr, subname, 'zu(pver)', & + file='dyn_grid', line=__LINE__, errmsg=trim(adjustl(cerr))) ! In MPAS, zeta coordinates are stored in increasing order (i.e., bottom to top of atmosphere). ! In CAM-SIMA, however, index order is reversed (i.e., top to bottom of atmosphere). @@ -203,13 +208,15 @@ subroutine init_reference_pressure() positive='up') ! Compute reference pressure from reference height. - allocate(p_ref_int(pverp), stat=ierr) - call check_allocate(ierr, subname, 'p_ref_int(pverp)', 'dyn_grid', __LINE__) + allocate(p_ref_int(pverp), errmsg=cerr, stat=ierr) + call check_allocate(ierr, subname, 'p_ref_int(pverp)', & + file='dyn_grid', line=__LINE__, errmsg=trim(adjustl(cerr))) call std_atm_pres(zw, p_ref_int, user_specified_ps=constant_p0) - allocate(p_ref_mid(pver), stat=ierr) - call check_allocate(ierr, subname, 'p_ref_mid(pver)', 'dyn_grid', __LINE__) + allocate(p_ref_mid(pver), errmsg=cerr, stat=ierr) + call check_allocate(ierr, subname, 'p_ref_mid(pver)', & + file='dyn_grid', line=__LINE__, errmsg=trim(adjustl(cerr))) p_ref_mid(:) = 0.5_kind_r8 * (p_ref_int(1:pver) + p_ref_int(2:pverp)) @@ -258,9 +265,11 @@ subroutine init_physics_grid() use spmd_utils, only: iam use string_utils, only: stringify ! Module(s) from CESM Share. - use shr_kind_mod, only: kind_r8 => shr_kind_r8 + use shr_kind_mod, only: kind_r8 => shr_kind_r8, & + len_cx => shr_kind_cx character(*), parameter :: subname = 'dyn_grid::init_physics_grid' + character(len_cx) :: cerr character(max_hcoordname_len), allocatable :: dyn_attribute_name(:) integer :: hdim1_d, hdim2_d ! First and second horizontal dimensions of physics grid. integer :: i @@ -288,8 +297,9 @@ subroutine init_physics_grid() call mpas_dynamical_core % get_variable_pointer(latcell, 'mesh', 'latCell') call mpas_dynamical_core % get_variable_pointer(loncell, 'mesh', 'lonCell') - allocate(dyn_column(ncells_solve), stat=ierr) - call check_allocate(ierr, subname, 'dyn_column(ncells_solve)', 'dyn_grid', __LINE__) + allocate(dyn_column(ncells_solve), errmsg=cerr, stat=ierr) + call check_allocate(ierr, subname, 'dyn_column(ncells_solve)', & + file='dyn_grid', line=__LINE__, errmsg=trim(adjustl(cerr))) do i = 1, ncells_solve ! Column information. @@ -314,9 +324,9 @@ subroutine init_physics_grid() dyn_column(i) % global_dyn_block = indextocellid(i) dyn_column(i) % local_dyn_block = i ! `dyn_block_index` is not used due to no dynamics block offset, but it still needs to be allocated. - allocate(dyn_column(i) % dyn_block_index(0), stat=ierr) + allocate(dyn_column(i) % dyn_block_index(0), errmsg=cerr, stat=ierr) call check_allocate(ierr, subname, 'dyn_column(' // stringify([i]) // ') % dyn_block_index(0)', & - 'dyn_grid', __LINE__) + file='dyn_grid', line=__LINE__, errmsg=trim(adjustl(cerr))) end do nullify(areacell) @@ -326,8 +336,9 @@ subroutine init_physics_grid() ! `phys_grid_init` expects to receive the `area` attribute from dynamics. ! However, do not let it because dynamics grid is different from physics grid. - allocate(dyn_attribute_name(0), stat=ierr) - call check_allocate(ierr, subname, 'dyn_attribute_name(0)', 'dyn_grid', __LINE__) + allocate(dyn_attribute_name(0), errmsg=cerr, stat=ierr) + call check_allocate(ierr, subname, 'dyn_attribute_name(0)', & + file='dyn_grid', line=__LINE__, errmsg=trim(adjustl(cerr))) call phys_grid_init(hdim1_d, hdim2_d, 'mpas', dyn_column, 'mpas_cell', dyn_attribute_name) @@ -355,9 +366,11 @@ subroutine define_cam_grid() use dynconst, only: constant_pi => pi, rad_to_deg use string_utils, only: stringify ! Module(s) from CESM Share. - use shr_kind_mod, only: kind_r8 => shr_kind_r8 + use shr_kind_mod, only: kind_r8 => shr_kind_r8, & + len_cx => shr_kind_cx character(*), parameter :: subname = 'dyn_grid::define_cam_grid' + character(len_cx) :: cerr integer :: i integer :: ierr integer, pointer :: indextocellid(:) ! Global indexes of cell centers. @@ -412,8 +425,9 @@ subroutine define_cam_grid() call mpas_dynamical_core % get_variable_pointer(latcell, 'mesh', 'latCell') call mpas_dynamical_core % get_variable_pointer(loncell, 'mesh', 'lonCell') - allocate(global_grid_index(ncells_solve), stat=ierr) - call check_allocate(ierr, subname, 'global_grid_index(ncells_solve)', 'dyn_grid', __LINE__) + allocate(global_grid_index(ncells_solve), errmsg=cerr, stat=ierr) + call check_allocate(ierr, subname, 'global_grid_index(ncells_solve)', & + file='dyn_grid', line=__LINE__, errmsg=trim(adjustl(cerr))) global_grid_index(:) = int(indextocellid(1:ncells_solve), kind_imap) @@ -422,12 +436,15 @@ subroutine define_cam_grid() lon_coord => horiz_coord_create('lonCell', 'nCells', ncells_global, 'longitude', 'degrees_east', & 1, ncells_solve, real(loncell, kind_r8) * rad_to_deg, map=global_grid_index) - allocate(cell_area(ncells_solve), stat=ierr) - call check_allocate(ierr, subname, 'cell_area(ncells_solve)', 'dyn_grid', __LINE__) - allocate(cell_weight(ncells_solve), stat=ierr) - call check_allocate(ierr, subname, 'cell_weight(ncells_solve)', 'dyn_grid', __LINE__) - allocate(global_grid_map(3, ncells_solve), stat=ierr) - call check_allocate(ierr, subname, 'global_grid_map(3, ncells_solve)', 'dyn_grid', __LINE__) + allocate(cell_area(ncells_solve), errmsg=cerr, stat=ierr) + call check_allocate(ierr, subname, 'cell_area(ncells_solve)', & + file='dyn_grid', line=__LINE__, errmsg=trim(adjustl(cerr))) + allocate(cell_weight(ncells_solve), errmsg=cerr, stat=ierr) + call check_allocate(ierr, subname, 'cell_weight(ncells_solve)', & + file='dyn_grid', line=__LINE__, errmsg=trim(adjustl(cerr))) + allocate(global_grid_map(3, ncells_solve), errmsg=cerr, stat=ierr) + call check_allocate(ierr, subname, 'global_grid_map(3, ncells_solve)', & + file='dyn_grid', line=__LINE__, errmsg=trim(adjustl(cerr))) do i = 1, ncells_solve cell_area(i) = real(areacell(i), kind_r8) @@ -480,8 +497,9 @@ subroutine define_cam_grid() call mpas_dynamical_core % get_variable_pointer(latedge, 'mesh', 'latEdge') call mpas_dynamical_core % get_variable_pointer(lonedge, 'mesh', 'lonEdge') - allocate(global_grid_index(nedges_solve), stat=ierr) - call check_allocate(ierr, subname, 'global_grid_index(nedges_solve)', 'dyn_grid', __LINE__) + allocate(global_grid_index(nedges_solve), errmsg=cerr, stat=ierr) + call check_allocate(ierr, subname, 'global_grid_index(nedges_solve)', & + file='dyn_grid', line=__LINE__, errmsg=trim(adjustl(cerr))) global_grid_index(:) = int(indextoedgeid(1:nedges_solve), kind_imap) @@ -490,8 +508,9 @@ subroutine define_cam_grid() lon_coord => horiz_coord_create('lonEdge', 'nEdges', nedges_global, 'longitude', 'degrees_east', & 1, nedges_solve, real(lonedge, kind_r8) * rad_to_deg, map=global_grid_index) - allocate(global_grid_map(3, nedges_solve), stat=ierr) - call check_allocate(ierr, subname, 'global_grid_map(3, nedges_solve)', 'dyn_grid', __LINE__) + allocate(global_grid_map(3, nedges_solve), errmsg=cerr, stat=ierr) + call check_allocate(ierr, subname, 'global_grid_map(3, nedges_solve)', & + file='dyn_grid', line=__LINE__, errmsg=trim(adjustl(cerr))) do i = 1, nedges_solve global_grid_map(1, i) = int(i, kind_imap) @@ -519,8 +538,9 @@ subroutine define_cam_grid() call mpas_dynamical_core % get_variable_pointer(latvertex, 'mesh', 'latVertex') call mpas_dynamical_core % get_variable_pointer(lonvertex, 'mesh', 'lonVertex') - allocate(global_grid_index(nvertices_solve), stat=ierr) - call check_allocate(ierr, subname, 'global_grid_index(nvertices_solve)', 'dyn_grid', __LINE__) + allocate(global_grid_index(nvertices_solve), errmsg=cerr, stat=ierr) + call check_allocate(ierr, subname, 'global_grid_index(nvertices_solve)', & + file='dyn_grid', line=__LINE__, errmsg=trim(adjustl(cerr))) global_grid_index(:) = int(indextovertexid(1:nvertices_solve), kind_imap) @@ -529,8 +549,9 @@ subroutine define_cam_grid() lon_coord => horiz_coord_create('lonVertex', 'nVertices', nvertices_global, 'longitude', 'degrees_east', & 1, nvertices_solve, real(lonvertex, kind_r8) * rad_to_deg, map=global_grid_index) - allocate(global_grid_map(3, nvertices_solve), stat=ierr) - call check_allocate(ierr, subname, 'global_grid_map(3, nvertices_solve)', 'dyn_grid', __LINE__) + allocate(global_grid_map(3, nvertices_solve), errmsg=cerr, stat=ierr) + call check_allocate(ierr, subname, 'global_grid_map(3, nvertices_solve)', & + file='dyn_grid', line=__LINE__, errmsg=trim(adjustl(cerr))) do i = 1, nvertices_solve global_grid_map(1, i) = int(i, kind_imap) diff --git a/src/dynamics/mpas/dyn_procedures.F90 b/src/dynamics/mpas/dyn_procedures.F90 index 5d6e8e6bf..cc014fc04 100644 --- a/src/dynamics/mpas/dyn_procedures.F90 +++ b/src/dynamics/mpas/dyn_procedures.F90 @@ -230,8 +230,8 @@ pure elemental function t_of_theta_rhod_qv(constant_cpd, constant_p0, constant_r ! In all, solve the below equation set for $T$ in terms of $\theta$, $\rho_d$ and $q_v$: ! \begin{equation*} ! \begin{cases} - ! \theta &= T (\frac{P_0}{P})^{\frac{R_d}{C_{pd}}} \\ - ! P &= \rho_d R_d T_m \\ + ! \theta &= T (\frac{P_0}{P})^{\frac{R_d}{C_{pd}}} \\[0pt] + ! P &= \rho_d R_d T_m \\[0pt] ! T_m &= T (1 + \frac{R_v}{R_d} q_v) ! \end{cases} ! \end{equation*} @@ -268,8 +268,8 @@ pure elemental function theta_of_t_rhod_qv(constant_cpd, constant_p0, constant_r ! In all, solve the below equation set for $\theta$ in terms of $T$, $\rho_d$ and $q_v$: ! \begin{equation*} ! \begin{cases} - ! \theta &= T (\frac{P_0}{P})^{\frac{R_d}{C_{pd}}} \\ - ! P &= \rho_d R_d T_m \\ + ! \theta &= T (\frac{P_0}{P})^{\frac{R_d}{C_{pd}}} \\[0pt] + ! P &= \rho_d R_d T_m \\[0pt] ! T_m &= T (1 + \frac{R_v}{R_d} q_v) ! \end{cases} ! \end{equation*} diff --git a/src/dynamics/mpas/tests/unit/test_dyn_mpas_procedures.pf b/src/dynamics/mpas/tests/unit/test_dyn_mpas_procedures.pf index 98e0f5bbe..ea8721113 100644 --- a/src/dynamics/mpas/tests/unit/test_dyn_mpas_procedures.pf +++ b/src/dynamics/mpas/tests/unit/test_dyn_mpas_procedures.pf @@ -883,7 +883,7 @@ contains use dyn_mpas_procedures, only: index_unique use funit - character(*), parameter :: test_data_letters(*) = [ character(1) :: & + character(*), parameter :: test_data_letters(*) = [character(1) :: & 'T', 'H', 'E', & 'Q', 'U', 'I', 'C', 'K', & 'B', 'R', 'O', 'W', 'N', & @@ -894,7 +894,7 @@ contains 'L', 'A', 'Z', 'Y', & 'D', 'O', 'G' & ] - character(*), parameter :: test_data_words(*) = [ character(128) :: & + character(*), parameter :: test_data_words(*) = [character(128) :: & 'Mercury', & 'Mercury', 'Venus', & 'Mercury', 'Venus', 'Earth', &