trying to fix problem with put on some platforms

E3SM-Project · May 31, 2016 · 30be388 · 30be388
1 parent a9c9029
commit 30be388
Show file tree

Hide file tree

Showing 4 changed files with 41 additions and 5 deletions.
diff --git a/src/clib/pio_put_nc_async.c b/src/clib/pio_put_nc_async.c
@@ -156,9 +156,12 @@ int PIOc_put_vars_tc(int ncid, int varid, const PIO_Offset *start, const PIO_Off
 	}
 
 	/* Handle MPI errors. */
+	LOG((2, "checking mpierr = %d", mpierr));
 	if ((mpierr2 = MPI_Bcast(&mpierr, 1, MPI_INT, ios->ioroot, ios->my_comm)))
 	    return check_mpi(file, mpierr2, __FILE__, __LINE__);
-	check_mpi(file, mpierr, __FILE__, __LINE__);
+	if (mpierr)
+	    check_mpi(file, mpierr, __FILE__, __LINE__);
+	LOG((2, "checked mpierr = %d", mpierr));
 
 	/* /\* Broadcast values currently only known on computation tasks to IO tasks. *\/ */
 	/* if ((mpierr = MPI_Bcast(&ndims, 1, MPI_INT, ios->comproot, ios->my_comm))) */

diff --git a/src/flib/pio.F90 b/src/flib/pio.F90
@@ -53,6 +53,7 @@ module pio
        PIO_def_var   ,        &
        PIO_def_var_deflate   ,        &
        PIO_redef     ,          &
+       PIO_set_log_level,          &
        PIO_inquire_variable , &
        PIO_inquire_dimension, &
        PIO_set_chunk_cache, &

diff --git a/src/flib/pio_nf.F90 b/src/flib/pio_nf.F90
@@ -36,7 +36,8 @@ module pio_nf
        pio_get_chunk_cache                                  , &
        pio_set_var_chunk_cache                              , &
        pio_get_var_chunk_cache                              , &
-       pio_redef
+       pio_redef                                            , &
+       pio_set_log_level
 !       pio_copy_att    to be done
 
   interface pio_def_var
@@ -187,6 +188,11 @@ module pio_nf
           redef_id
   end interface
 
+  interface pio_set_log_level
+     module procedure &
+          set_log_level                                      
+  end interface
+
   interface pio_inquire
      module procedure &
           inquire_desc                                      , &
@@ -648,18 +654,42 @@ integer function redef_desc(File) result(ierr)
     type (File_desc_t)                                      , intent(inout) :: File
     ierr = redef_id(file%fh)
   end function redef_desc
+
+!>
+!! @defgroup PIO_set_log_level
+!<
+!> 
+!! @public
+!! @ingroup PIO_set_log_level
+!! @brief Sets the logging level. Only takes effect if PIO was built with
+!! PIO_ENABLE_LOGGING=On
+!! @details
+!! @param log_level the logging level.
+!! @retval ierr @copydoc error_return
+!<
+  integer function set_log_level(log_level) result(ierr)
+    integer, intent(in) :: log_level
+    interface
+       integer(C_INT) function PIOc_set_log_level(log_level) &
+            bind(C ,name="PIOc_set_log_level")
+         use iso_c_binding
+         integer(C_INT), value :: log_level
+       end function PIOc_set_log_level
+    end interface
+    ierr = PIOc_set_log_level(log_level)
+  end function set_log_level
 !> 
 !! @public
 !! @ingroup PIO_redef
 !! @brief Wrapper for the C function \ref PIOc_redef .
 !<
   integer function redef_id(ncid) result(ierr)
-    integer                                                 ,intent(in) :: ncid
+    integer, intent(in) :: ncid
     interface
        integer(C_INT) function PIOc_redef(ncid) &
-            bind(C                                          ,name="PIOc_redef")
+            bind(C, name="PIOc_redef")
          use iso_c_binding
-         integer(C_INT)                                     , value :: ncid
+         integer(C_INT), value :: ncid
        end function PIOc_redef
     end interface
     ierr = PIOc_redef(ncid)

diff --git a/tests/unit/basic_tests.F90 b/tests/unit/basic_tests.F90
@@ -276,13 +276,15 @@ Subroutine test_open(test_id, err_msg)
           call mpi_abort(MPI_COMM_WORLD,0,ret_val)
         end if
 
+        PIO_set_log_level(2)
         ret_val = PIO_inq_unlimdim(pio_file, unlimdimid)
         if(unlimdimid /= -1) then
            err_msg = "Error in inq_unlimdim"
            call PIO_closefile(pio_file)
            print *,__FILE__,__LINE__,iotype, trim(err_msg)
            call mpi_abort(MPI_COMM_WORLD,0,ret_val)
         end if
+        PIO_set_log_level(0)