Merge pull request #2919 from GEOS-ESM/verify_after_mpi_call

VERIFY Statement after MPI call

Apps/Regrid_Util.F90

@@ -424,6 +424,7 @@ subroutine main()
          call t_prof%stop("Read")
 
          call MPI_BARRIER(MPI_COMM_WORLD,STATUS)
+         _VERIFY(status)
 
          call t_prof%start("write")
 

Apps/time_ave_util.F90

@@ -133,9 +133,13 @@ program  time_ave
 
 !call timebeg ('main')
 
-   call mpi_init                ( ierror ) ; comm = mpi_comm_world
+   call mpi_init                ( ierror ) 
+   _VERIFY(ierror)
+   comm = mpi_comm_world
    call mpi_comm_rank ( comm,myid,ierror )
+   _VERIFY(ierror)
    call mpi_comm_size ( comm,npes,ierror )
+   _VERIFY(ierror)
    call ESMF_Initialize(logKindFlag=ESMF_LOGKIND_NONE,mpiCommunicator=MPI_COMM_WORLD, _RC)
    call MAPL_Initialize(_RC)
    t_prof = DistributedProfiler('time_ave_util',MpiTImerGauge(),MPI_COMM_WORLD)
@@ -813,6 +817,7 @@ program  time_ave
       enddo    ! End ntime Loop within file
 
       call MPI_BARRIER(comm,status)
+      _VERIFY(status)
    enddo
 
    do k=0,ntods
@@ -1064,7 +1069,9 @@ program  time_ave
          endif
 
          call mpi_reduce( qmin(nloc(n)+L-1),qming,1,mpi_real,mpi_min,0,comm,ierror )
+         _VERIFY(ierror)
          call mpi_reduce( qmax(nloc(n)+L-1),qmaxg,1,mpi_real,mpi_max,0,comm,ierror )
+         _VERIFY(ierror)
          if( root ) then
             if(L.eq.1) then
                write(6,3101) trim(vname2(n)),plev,qming,qmaxg
@@ -1076,6 +1083,7 @@ program  time_ave
 3102     format(1x,'               ',a20,' Level: ',f9.3,'  Min: ',g15.8,'  Max: ',g15.8)
       enddo
       call MPI_BARRIER(comm,status)
+      _VERIFY(status)
       if( root ) print *
    enddo
    if( root ) print *
@@ -1676,7 +1684,7 @@ end function is_leap_year
 
    subroutine usage(root)
       logical, intent(in) :: root
-      integer :: status,errorcode
+      integer :: status,errorcode,rc
       if(root) then
          write(6,100)
 100      format(  "usage:  ",/,/ &
@@ -1710,6 +1718,7 @@ subroutine usage(root)
                )
       endif
       call MPI_Abort(MPI_COMM_WORLD,errorcode,status)
+      _VERIFY(status)
    end subroutine usage
 
     subroutine generate_report()

Tests/ExtDataDriverMod.F90

@@ -217,6 +217,7 @@ subroutine initialize_mpi(this, unusable, rc)
       _UNUSED_DUMMY(unusable)
 
       call MPI_Init(ierror)
+      _VERIFY(ierror)
 
       this%comm_world=MPI_COMM_WORLD
       call MPI_Comm_rank(this%comm_world, this%rank, ierror); _VERIFY(ierror)

Tests/pfio_MAPL_demo.F90

@@ -1,4 +1,4 @@
-
+#define I_AM_MAIN
 #include "MAPL_ErrLog.h"
 #include "unused_dummy.H"
 !------------------------------------------------------------------------------
@@ -91,7 +91,7 @@ program main
       ! Initialize MPI if MPI_Init has not been called
       call initialize_mpi(MPI_COMM_WORLD)
 
-      call MPI_Comm_size(MPI_COMM_WORLD, npes, ierror)
+      call MPI_Comm_size(MPI_COMM_WORLD, npes, _IERROR)
       if ( cap_options%npes_model == -1) then
           cap_options%npes_model = npes
       endif
@@ -112,10 +112,10 @@ program main
             CALL ESMF_Initialize(logKindFlag=ESMF_LOGKIND_NONE, mpiCommunicator=client_comm, rc=status)
 
             ! Get the number of PEs used for the model
-            call MPi_Comm_size(client_comm, npes, ierror)
+            call MPi_Comm_size(client_comm, npes, _IERROR)
 
             ! Get the PE id
-            call MPI_Comm_rank(client_comm, pe_id, ierror)
+            call MPI_Comm_rank(client_comm, pe_id, _IERROR)
             if (npes /= cap_options%npes_model) stop "sanity check failed"
 
             !------------------------------------------------
@@ -155,7 +155,7 @@ program main
 
       call ioserver_manager%finalize()
 
-      call MPI_finalize(ierror)
+      call MPI_finalize(_IERROR)
 
 !------------------------------------------------------------------------------
 CONTAINS

base/ApplicationSupport.F90

@@ -118,6 +118,7 @@ subroutine initialize_pflogger(unusable,comm,logging_config,rc)
       else
 
          call MPI_COMM_Rank(comm_world,rank,status)
+         _VERIFY(status)
          console = StreamHandler(OUTPUT_UNIT)
          call console%set_level(INFO)
          call console%set_formatter(MpiFormatter(comm_world, fmt='%(short_name)a10~: %(message)a'))
@@ -186,7 +187,9 @@ subroutine report_global_profiler(unusable,comm,rc)
       call reporter%add_column(exclusive)
 
       call MPI_Comm_size(world_comm, npes, ierror)
+      _VERIFY(ierror)
       call MPI_Comm_Rank(world_comm, my_rank, ierror)
+      _VERIFY(ierror)
 
       if (my_rank == 0) then
          report_lines = reporter%generate_report(t_p)
@@ -197,6 +200,7 @@ subroutine report_global_profiler(unusable,comm,rc)
          end do
       end if
       call MPI_Barrier(world_comm, ierror)
+      _VERIFY(ierror)
 
       _RETURN(_SUCCESS)
    end subroutine report_global_profiler

base/FileIOShared.F90

@@ -431,8 +431,10 @@ subroutine ArrDescrInit(ArrDes,comm,im_world,jm_world,lm_world,nx,ny,num_readers
 
          integer :: status
 
-         call MPI_Comm_Rank(comm,myid,_IERROR)
-         call MPI_COMM_Size(comm,npes,_IERROR)
+         call MPI_Comm_Rank(comm,myid,status)
+         _VERIFY(status)
+         call MPI_COMM_Size(comm,npes,status)
+         _VERIFY(status)
 
          allocate(iminw(npes),imaxw(npes),jminw(npes),jmaxw(npes),stat=status)
          iminw=-1
@@ -489,9 +491,11 @@ subroutine ArrDescrInit(ArrDes,comm,im_world,jm_world,lm_world,nx,ny,num_readers
          NX0 = mod(myid,nx) + 1
          NY0 = myid/nx + 1
          color = nx0
-         call MPI_Comm_Split(comm,color,myid,ycomm,_IERROR)
+         call MPI_Comm_Split(comm,color,myid,ycomm,status)
+         _VERIFY(status)
          color = ny0
-         call MPI_Comm_Split(comm,color,myid,xcomm,_IERROR)
+         call MPI_Comm_Split(comm,color,myid,xcomm,status)
+         _VERIFY(status)
          ! reader communicators
          if (num_readers > ny .or. mod(ny,num_readers) /= 0) then
             _RETURN(ESMF_FAILURE)
@@ -502,12 +506,14 @@ subroutine ArrDescrInit(ArrDes,comm,im_world,jm_world,lm_world,nx,ny,num_readers
          else
             color = MPI_UNDEFINED
          end if
-         call MPI_COMM_SPLIT(comm,color,myid,readers_comm,_IERROR)
+         call MPI_COMM_SPLIT(comm,color,myid,readers_comm,status)
+         _VERIFY(status)
          if (num_readers==ny) then
             IOscattercomm = xcomm
          else
             j = ny0 - mod(ny0-1,ny_by_readers)
-            call MPI_Comm_Split(comm,j,myid,IOScattercomm,_IERROR)
+            call MPI_Comm_Split(comm,j,myid,IOScattercomm,status)
+            _VERIFY(status)
          endif
          ! writer communicators
          if (num_writers > ny .or. mod(ny,num_writers) /= 0) then
@@ -519,12 +525,14 @@ subroutine ArrDescrInit(ArrDes,comm,im_world,jm_world,lm_world,nx,ny,num_readers
          else
             color = MPI_UNDEFINED
          end if
-         call MPI_COMM_SPLIT(comm,color,myid,writers_comm,_IERROR)
+         call MPI_COMM_SPLIT(comm,color,myid,writers_comm,status)
+         _VERIFY(status)
          if (num_writers==ny) then
             IOgathercomm = xcomm
          else
             j = ny0 - mod(ny0-1,ny_by_writers)
-            call MPI_Comm_Split(comm,j,myid,IOgathercomm,_IERROR)
+            call MPI_Comm_Split(comm,j,myid,IOgathercomm,status)
+            _VERIFY(status)
          endif
 
          ArrDes%im_world=im_world
@@ -537,7 +545,8 @@ subroutine ArrDescrInit(ArrDes,comm,im_world,jm_world,lm_world,nx,ny,num_readers
          ArrDes%iogathercomm  = iogathercomm
          ArrDes%xcomm = xcomm
          ArrDes%ycomm = ycomm
-         call mpi_comm_rank(arrdes%ycomm,arrdes%myrow,_IERROR)
+         call mpi_comm_rank(arrdes%ycomm,arrdes%myrow,status)
+         _VERIFY(status)
 
          allocate(arrdes%i1(size(i1)),_STAT)
          arrdes%i1=i1
@@ -605,23 +614,28 @@ subroutine ArrDescrCreateWriterComm(arrdes, full_comm, num_writers, rc)
        ny = size(arrdes%j1)
        _ASSERT(num_writers <= ny,'num writers must be less or equal to than NY')
        _ASSERT(mod(ny,num_writers)==0,'num writerss must evenly divide NY')
-       call mpi_comm_rank(full_comm,myid, _IERROR)
+       call mpi_comm_rank(full_comm,myid, status)
+       _VERIFY(status)
        color =  arrdes%NX0
-       call MPI_COMM_SPLIT(full_comm, color, MYID, arrdes%Ycomm, _IERROR)
+       call MPI_COMM_SPLIT(full_comm, color, MYID, arrdes%Ycomm, status)
+       _VERIFY(status)
        color = arrdes%NY0
-       call MPI_COMM_SPLIT(full_comm, color, MYID, arrdes%Xcomm, _IERROR)
+       call MPI_COMM_SPLIT(full_comm, color, MYID, arrdes%Xcomm, status)
+       _VERIFY(status)
        ny_by_writers = ny/num_writers
        if (mod(myid,nx*ny/num_writers) == 0) then
           color = 0
        else
           color = MPI_UNDEFINED
        endif
-       call MPI_COMM_SPLIT(full_comm, color, myid, arrdes%writers_comm, _IERROR)
+       call MPI_COMM_SPLIT(full_comm, color, myid, arrdes%writers_comm, status)
+       _VERIFY(status)
        if (num_writers==ny) then
           arrdes%IOgathercomm = arrdes%Xcomm
        else
             j = arrdes%NY0 - mod(arrdes%NY0-1,ny_by_writers)
-          call MPI_COMM_SPLIT(full_comm, j, myid, arrdes%IOgathercomm, _IERROR)
+          call MPI_COMM_SPLIT(full_comm, j, myid, arrdes%IOgathercomm, status)
+          _VERIFY(status)
        endif
        if (arrdes%writers_comm /= MPI_COMM_NULL) then
           call mpi_comm_rank(arrdes%writers_comm,writer_rank,status)
@@ -648,23 +662,28 @@ subroutine ArrDescrCreateReaderComm(arrdes, full_comm, num_readers, rc)
        _ASSERT(num_readers <= ny,'num readers must be less than or equal to NY')
        _ASSERT(mod(ny,num_readers)==0,'num readers must evenly divide NY')
 
-       call mpi_comm_rank(full_comm,myid, _IERROR)
+       call mpi_comm_rank(full_comm,myid, status)
+       _VERIFY(status)
        color =  arrdes%NX0
-       call MPI_COMM_SPLIT(full_comm, color, MYID, arrdes%Ycomm, _IERROR)
+       call MPI_COMM_SPLIT(full_comm, color, MYID, arrdes%Ycomm, status)
+       _VERIFY(status)
        color = arrdes%NY0
-       call MPI_COMM_SPLIT(full_comm, color, MYID, arrdes%Xcomm, _IERROR)
+       call MPI_COMM_SPLIT(full_comm, color, MYID, arrdes%Xcomm, status)
+       _VERIFY(status)
        ny_by_readers = ny/num_readers
        if (mod(myid,nx*ny/num_readers) == 0) then
           color = 0
        else
           color = MPI_UNDEFINED
        endif
-       call MPI_COMM_SPLIT(full_comm, color, MYID, arrdes%readers_comm, _IERROR)
+       call MPI_COMM_SPLIT(full_comm, color, MYID, arrdes%readers_comm, status)
+       _VERIFY(status)
        if (num_readers==ny) then
           arrdes%IOscattercomm = arrdes%Xcomm
        else
           j = arrdes%NY0 - mod(arrdes%NY0-1,ny_by_readers)
-          call MPI_COMM_SPLIT(full_comm, j, MYID, arrdes%IOscattercomm, _IERROR)
+          call MPI_COMM_SPLIT(full_comm, j, MYID, arrdes%IOscattercomm, status)
+          _VERIFY(status)
        endif
 
        _RETURN(_SUCCESS)

base/MAPL_Comms.F90

@@ -677,6 +677,7 @@ subroutine MAPL_CollectiveWait(request, DstArray, rc)
              call MPI_Recv(request%Var, size(request%Var), MPI_REAL, &
                            request%Root, request%tag, request%comm,  &
                            MPI_STATUS_IGNORE, status)
+             _VERIFY(status)
           endif
           k=0
           do J=1,request%JM0

base/MAPL_LocStreamMod.F90

@@ -2741,6 +2741,7 @@ subroutine MAPL_LocStreamCreateXform ( Xform, LocStreamOut, LocStreamIn, NAME, M
           call MPI_GATHER(  lNumReceivers, 1, MPI_INTEGER, &
                allSenders(:,1), 1, MPI_INTEGER, &
                I-1, Xform%Ptr%Comm,  status )
+          _VERIFY(status)
        enddo
      end block
      call ESMF_VMBarrier(vm, rc=status)

base/MAPL_MemUtils.F90

@@ -403,6 +403,7 @@ subroutine MAPL_MemUtilsWriteComm( text, comm, always, RC )
     call mem_dump(mhwm, mrss, memused, swapused, commitlimit, committed_as)
 #endif
     call MPI_Comm_Size(comm_,npes,status)
+    _VERIFY(status)
     if (MAPL_MemUtilsMode == MAPL_MemUtilsModeFull) then
        lhwm = mhwm; call MPI_AllReduce(lhwm,ghwm,1,MPI_REAL,MPI_MAX,comm_,status)
        _VERIFY(STATUS)
@@ -414,6 +415,7 @@ subroutine MAPL_MemUtilsWriteComm( text, comm, always, RC )
        _VERIFY(STATUS)
        gavg = gavg/npes
        mstd = (mrss-gavg)**2; call MPI_AllReduce(mstd,gstd,1,MPI_REAL,MPI_SUM,comm_,status)
+       _VERIFY(STATUS)
        gstd = sqrt( gstd/npes )
        gmax_save = gmax
        lcommitlimit  = commitlimit;  call MPI_AllReduce(lcommitlimit,gcommitlimit,1,MPI_REAL,MPI_MAX,comm_,status)
@@ -784,6 +786,7 @@ subroutine MAPL_MemReport(comm,file_name,line,decorator,rc)
     _RETURN(ESMF_SUCCESS)
 #endif
     call MPI_Barrier(comm,status)
+    _VERIFY(status)
     if (present(decorator)) then
        extra_message = decorator
     else
@@ -792,6 +795,7 @@ subroutine MAPL_MemReport(comm,file_name,line,decorator,rc)
     call MAPL_MemUsed(mem_total,mem_used,percent_used)
     call MAPL_MemCommited(committed_total,committed,percent_committed)
     call MPI_Comm_Rank(comm,rank,status)
+    _VERIFY(status)
     if (rank == 0) write(*,'("Mem report ",A20," ",A30," ",i7," ",f5.1,"% : ",f5.1,"% Mem Comm:Used")')trim(extra_message),file_name,line,percent_committed,percent_used
 
 end subroutine

base/MAPL_SwathGridFactory.F90

@@ -551,6 +551,7 @@ subroutine initialize_from_config_with_prefix(this, config, prefix, unusable, rc
       !
       call ESMF_VMGet(vm, mpiCommunicator=mpic, _RC)
       call MPI_COMM_RANK(mpic, irank, ierror)
+      _VERIFY(ierror)
 
       if (irank==0) &
            write(6,'(10(2x,a20,2x,a40,/))') &
@@ -690,14 +691,21 @@ subroutine initialize_from_config_with_prefix(this, config, prefix, unusable, rc
 
 
       call MPI_bcast(this%M_file, 1, MPI_INTEGER, 0, mpic, ierror)
+      _VERIFY(ierror)
       do i=1, this%M_file
          call MPI_bcast(this%filenames(i), ESMF_MAXSTR, MPI_CHARACTER, 0, mpic, ierror)
+         _VERIFY(ierror)
       end do
       call MPI_bcast(this%epoch_index, 4, MPI_INTEGER8, 0, mpic, ierror)
+      _VERIFY(ierror)
       call MPI_bcast(this%im_world, 1, MPI_INTEGER, 0, mpic, ierror)
+      _VERIFY(ierror)
       call MPI_bcast(this%jm_world, 1, MPI_INTEGER, 0, mpic, ierror)
+      _VERIFY(ierror)
       call MPI_bcast(this%cell_across_swath, 1, MPI_INTEGER, 0, mpic, ierror)
+      _VERIFY(ierror)
       call MPI_bcast(this%cell_along_swath, 1, MPI_INTEGER, 0, mpic, ierror)
+      _VERIFY(ierror)
       ! donot need to bcast this%along_track (root only)
 
 
@@ -1352,6 +1360,7 @@ subroutine get_xy_subset(this, interval, xy_subset, rc)
       call ESMF_VmGetCurrent(VM, _RC)
       call ESMF_VMGet(vm, mpiCommunicator=mpic, _RC)
       call MPI_COMM_RANK(mpic, irank, ierror)
+      _VERIFY(ierror)
 
       if (irank==0) then
          ! xtrack
@@ -1406,6 +1415,7 @@ subroutine get_xy_subset(this, interval, xy_subset, rc)
       end if
 
       call MPI_bcast(xy_subset, 4, MPI_INTEGER, 0, mpic, ierror)
+      _VERIFY(ierror)
 
       _RETURN(_SUCCESS)
     end subroutine get_xy_subset