Merge pull request #2395 from GEOS-ESM/feature/mathomp4/nvhpc-fixes

Fixes for NVHPC

Apps/Regrid_Util.F90

@@ -338,7 +338,7 @@ Program Regrid_Util
 
     subroutine main()
 
-   type(regrid_support) :: support
+   type(regrid_support), target :: support
 
    type(ESMF_VM)       :: vm             ! ESMF Virtual Machine
 

CHANGELOG.md

@@ -51,6 +51,8 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0
 - Add explicit `Fortran_MODULE_DIRECTORY` to `CMakeLists.txt` in benchmarks to avoid race condition in Ninja builds
 - Add check to make sure ESMF was not built as `mpiuni`
 - Fixed failing tests for `field_utils`.
+- Various fixes for NVHPC work
+
 
 ### Removed
 

docs/tutorial/driver_app/Example_Driver.F90

@@ -5,6 +5,7 @@
 program Example_Driver
    use MPI
    use MAPL
+   use mapl_CapOptionsMod, only: MAPL_CapOptions
    implicit none
 
    type (MAPL_Cap) :: cap

generic/OpenMP_Support.F90

@@ -595,6 +595,7 @@ subroutine copy_callbacks(state, multi_states, rc)
        type(CallbackMethodWrapper), pointer :: wrapper
        type(CallbackMap), pointer :: callbacks
        type(CallbackMapIterator) :: iter
+       procedure(), pointer :: userRoutine
 
        n_multi = size(multi_states)
        call get_callbacks(state, callbacks, _RC)
@@ -604,7 +605,8 @@ subroutine copy_callbacks(state, multi_states, rc)
           do while (iter /= e)
              wrapper => iter%second()
              do i = 1, n_multi
-                call ESMF_MethodAdd(multi_states(i), label=iter%first(), userRoutine=wrapper%userRoutine, _RC)
+                userRoutine => wrapper%userRoutine
+                call ESMF_MethodAdd(multi_states(i), label=iter%first(), userRoutine=userRoutine, _RC)
              end do
              call iter%next()
           end do

gridcomps/Cap/FargparseCLI.F90

@@ -8,7 +8,7 @@ module MAPL_FargparseCLIMod
    use gFTL2_IntegerVector
    use mapl_KeywordEnforcerMod
    use mapl_ExceptionHandling
-   use mapl_CapOptionsMod, only:  MAPL_CapOptions !Rename is for backward compatibility. Remove renaming for 3.0
+   use mapl_CapOptionsMod, only:  MAPL_CapOptions_ => MAPL_CapOptions !Rename is for backward compatibility. Remove renaming for 3.0
    implicit none
    private
 
@@ -45,7 +45,7 @@ subroutine I_extraoptions(parser, rc)
 
    function new_CapOptions_from_fargparse(unusable, dummy, extra, rc) result (cap_options)
       class(KeywordEnforcer), optional, intent(in) :: unusable
-      type (MAPL_CapOptions) :: cap_options
+      type (MAPL_CapOptions_) :: cap_options
       character(*), intent(in) :: dummy !Needed for backward compatibility. Remove after 3.0
       procedure(I_extraoptions), optional :: extra
       integer, optional, intent(out) :: rc
@@ -231,7 +231,7 @@ end subroutine add_command_line_options
 
    subroutine fill_cap_options(fargparseCLI, cap_options, unusable, rc)
       class(MAPL_FargparseCLI), intent(inout) :: fargparseCLI
-      type(MAPL_CapOptions), intent(out) :: cap_options
+      type(MAPL_CapOptions_), intent(out) :: cap_options
       class(KeywordEnforcer), optional, intent(in) :: unusable
       integer, optional, intent(out) :: rc
       integer :: status
@@ -417,7 +417,7 @@ end subroutine fill_cap_options
 
    !Function for backward compatibility. Remove for 3.0
    function old_CapOptions_from_Fargparse( fargparseCLI, unusable, rc) result (cap_options)
-      type (MAPL_CapOptions) :: cap_options
+      type (MAPL_CapOptions_) :: cap_options
       type (MAPL_FargparseCLI), intent(inout) :: fargparseCLI
       class (KeywordEnforcer), optional, intent(in) :: unusable
       integer, optional, intent(out) :: rc

gridcomps/History/MAPL_HistoryTrajectoryMod.F90

@@ -68,7 +68,7 @@ module HistoryTrajectoryMod
      integer                        :: obsfile_Te_index
      logical                        :: active
    contains
-     procedure :: initialize
+     procedure :: initialize => initialize_
      procedure :: create_variable => create_metadata_variable
      procedure :: create_file_handle
      procedure :: close_file_handle
@@ -94,15 +94,15 @@ module function HistoryTrajectory_from_config(config,string,clock,rc) result(tra
        integer, optional, intent(out)          :: rc
      end function HistoryTrajectory_from_config
 
-     module subroutine initialize(this,items,bundle,timeInfo,vdata,reinitialize,rc)
+     module subroutine initialize_(this,items,bundle,timeInfo,vdata,reinitialize,rc)
        class(HistoryTrajectory), intent(inout) :: this
        type(GriddedIOitemVector), optional, intent(inout) :: items
        type(ESMF_FieldBundle), optional, intent(inout)   :: bundle
        type(TimeData), optional, intent(inout)           :: timeInfo
        type(VerticalData), optional, intent(inout) :: vdata
        logical, optional, intent(in)           :: reinitialize
        integer, optional, intent(out)          :: rc
-     end subroutine initialize
+     end subroutine initialize_
 
      module subroutine  create_metadata_variable(this,vname,rc)
        class(HistoryTrajectory), intent(inout) :: this

gridcomps/History/MAPL_HistoryTrajectoryMod_smod.F90

@@ -130,6 +130,7 @@
          enddo
 
 
+
          ! __ s2. find nobs  &&  distinguish design with vs wo  '------'
          nobs=0
          call ESMF_ConfigFindLabel( config, trim(string)//'obs_files:', _RC)
@@ -230,6 +231,7 @@
 
          _RETURN(_SUCCESS)
 
+
 105      format (1x,a,2x,a)
 106      format (1x,a,2x,i8)
        end procedure HistoryTrajectory_from_config
@@ -238,7 +240,7 @@
        !
        !-- integrate both initialize and reinitialize
        !
-       module procedure initialize
+       module procedure initialize_
          integer :: status
          type(ESMF_Grid) :: grid
          type(variable) :: v
@@ -330,7 +332,7 @@
 
          _RETURN(_SUCCESS)
 
-       end procedure initialize
+       end procedure initialize_
 
 
 
@@ -642,8 +644,10 @@
          call MAPL_CommsBcast(vm, this%datetime_units, N=ESMF_MAXSTR, ROOT=MAPL_Root, _RC)
 
 
+
          if (mapl_am_I_root()) then
-            call sort_multi_arrays_by_time(lons_full, lats_full, times_R8_full, obstype_id_full, _RC)
+            ! NVHPC dies with NVFORTRAN-S-0155-Could not resolve generic procedure sort_multi_arrays_by_time
+            call sort_four_arrays_by_time(lons_full, lats_full, times_R8_full, obstype_id_full, _RC)
             call ESMF_ClockGet(this%clock,currTime=current_time,_RC)
             timeset(1) = current_time
             timeset(2) = current_time + this%epoch_frequency

griddedio/TileIO.F90

@@ -12,6 +12,10 @@ module MAPL_TileIOMod
 
    private
 
+   type tile_buffer
+      real, allocatable :: ptr(:)
+   end type
+
    type, public :: MAPL_TileIO
      private
       type(ESMF_FieldBundle) :: bundle
@@ -22,10 +26,6 @@ module MAPL_TileIOMod
          procedure :: process_data_from_file
    end type MAPL_TileIO
 
-   type tile_buffer
-      real, allocatable :: ptr(:)
-   end type
-
    interface MAPL_TileIO
       module procedure new_MAPL_TileIO
    end interface MAPL_TileIO
@@ -40,13 +40,13 @@ function new_MAPL_TileIO(bundle,read_collection_id) result(TileIO)
          TileIO%bundle = bundle
          TileIO%read_collection_id = read_collection_id
       end function
-  
+
       subroutine request_data_from_file(this,filename,timeindex,rc)
          class(MAPL_TileIO), intent(inout) :: this
          character(len=*), intent(in) :: filename
          integer, intent(in) :: timeindex
          integer, intent(out), optional :: rc
-    
+
          integer :: status
          integer :: num_vars,i,rank
          type(ArrayReference) :: ref
@@ -76,10 +76,10 @@ subroutine request_data_from_file(this,filename,timeindex,rc)
                   allocate(this%tile_buffer(i)%ptr((0)),_STAT)
                end if
                ref = ArrayReference(this%tile_buffer(i)%ptr)
-               call i_clients%collective_prefetch_data(this%read_collection_id, filename, trim(names(i)), ref,  & 
+               call i_clients%collective_prefetch_data(this%read_collection_id, filename, trim(names(i)), ref,  &
                   start=local_start, global_start=global_start, global_count = global_count)
-               deallocate(local_start,global_start,global_count) 
-            else 
+               deallocate(local_start,global_start,global_count)
+            else
                _FAIL("rank >1 tile fields not supported")
             end if
          end do
@@ -117,5 +117,5 @@ subroutine process_data_from_file(this,rc)
          deallocate(this%tile_buffer)
          _RETURN(_SUCCESS)
       end subroutine
-       
+
 end module