put safe_endrun back

src/history/cam_history.F90

@@ -764,7 +764,7 @@ subroutine history_wrap_up(restart_write, last_timestep)
       ! This routine will close any full hist. files
       ! or any hist. file that has data on it when restart files are being
       ! written.
-      ! If a partially full history file was disposed (for restart
+      ! If a partially full history file was written (for restart
       ! purposes), then wrapup will open that unit back up and position
       ! it for appending new data.
       !
@@ -793,7 +793,7 @@ subroutine history_wrap_up(restart_write, last_timestep)
       !-----------------------------------------------------------------------
       !
       ! Begin loop over hist_configs (the no. of declared history files - primary
-      ! and auxiliary).  This loop disposes a history file to disk
+      ! and auxiliary).  This loop writes a history file to disk
       ! when appropriate.
       !
 

src/utils/cam_abortutils.F90

@@ -80,6 +80,7 @@ subroutine cam_register_open_file(file, file_name)
       ! If we get here, go ahead and register the file
       if (associated(open_files_pool)) then
          of_new => open_files_pool
+         allocate(of_new%file_desc)
          of_new%file_desc = file
          of_new%file_name = file_name
          allocate(open_files_pool%next)

src/utils/cam_field_read.F90

@@ -14,7 +14,7 @@ module cam_field_read
    use pio,            only: pio_max_var_dims, io_desc_t
    use pio,            only: pio_double, pio_setframe
    use spmd_utils,     only: masterproc
-   use cam_abortutils, only: endrun
+   use cam_abortutils, only: safe_endrun
    use cam_logfile,    only: iulog, debug_output, DEBUGOUT_INFO, DEBUGOUT_DEBUG
    !!XXgoldyXX: v support SCAM?
    !  use shr_scam_mod,   only: shr_scam_getCloseLatLon  ! Standardized system subroutines
@@ -62,7 +62,7 @@ subroutine get_grid_diminfo(grid_name, grid_id, dim1name, dim2name,        &
 
       grid_id = cam_grid_id(trim(grid_name))
       if (.not. cam_grid_check(grid_id)) then
-         call endrun(subname//': Internal error, no "'//grid_name//'" grid')
+         call safe_endrun(subname//': Internal error, no "'//grid_name//'" grid')
       end if
       call cam_grid_get_dim_names(grid_id, dim1name, dim2name)
       call cam_grid_get_array_bounds(grid_id, dim_bounds)
@@ -101,17 +101,17 @@ subroutine print_input_field_info(dimlens, ndims, min_ndims, max_ndims,    &
       character(len=8)             :: syntax(9)
 
       if (ndims < max(min_ndims, 1)) then
-         call endrun(subname//': too few dimensions for '//trim(varname))
+         call safe_endrun(subname//': too few dimensions for '//trim(varname))
       else if (ndims > max_ndims) then
          write(errormsg, '(3a,i0)') ': too many dimensions for, ',      &
               trim(varname), ', ', ndims
-         call endrun(subname//trim(errormsg))
+         call safe_endrun(subname//trim(errormsg))
       else if (num_bounds < 1) then
-         call endrun(subname//': too few dimension boundss for '//trim(varname))
+         call safe_endrun(subname//': too few dimension boundss for '//trim(varname))
       else if (num_bounds > 3) then
          write(errormsg, '(3a,i0)') ': too many dimension bounds for, ',      &
               trim(varname), ', ', num_bounds
-         call endrun(subname//trim(errormsg))
+         call safe_endrun(subname//trim(errormsg))
       else if (debug_output >= DEBUGOUT_DEBUG) then
          num_vals = 0
          do ind = 1, num_bounds
@@ -170,7 +170,7 @@ integer function num_target_dims(num_field_dims, unstruct)
          num_target_dims = num_target_dims - 1
       end if
       if (num_target_dims < 1) then
-         call endrun('num_target_dims, bad inputs')
+         call safe_endrun('num_target_dims, bad inputs')
       end if
    end function num_target_dims
 
@@ -270,7 +270,7 @@ subroutine infld_real8_1d(varname, ncid, field, readvar, gridname,         &
       ! Is this an unstructured grid (i.e., one column dimension on file)?
       unstruct = cam_grid_is_unstructured(grid_id)
       if (block_indexed) then
-         call endrun(subname//': Block indexed 1D field is invalid')
+         call safe_endrun(subname//': Block indexed 1D field is invalid')
       else
          target_ndims = num_target_dims(2, unstruct)
       end if
@@ -305,21 +305,21 @@ subroutine infld_real8_1d(varname, ncid, field, readvar, gridname,         &
               varname, subname)
          ! Check to make sure that any 'extra' dimension is time
          if (ndims > target_ndims + 1) then
-            call endrun(subname//': too many dimensions for '//trim(varname))
+            call safe_endrun(subname//': too many dimensions for '//trim(varname))
          else if (ndims == target_ndims + 1) then
             ierr = pio_inq_dimname(ncid, dimids(ndims), tmpname)
             if (trim(tmpname) /= 'time') then
-               call endrun(subname//': dimension mismatch for '//trim(varname))
+               call safe_endrun(subname//': dimension mismatch for '//trim(varname))
             end if
             if (present(timelevel)) then
                if (timelevel > dimlens(ndims)) then
                   write(errormsg, '(a,i0,a,i0)') ': timelevel, ', timelevel,  &
                        ', exceeds file limit, ', dimlens(ndims)
-                  call endrun(subname//errormsg)
+                  call safe_endrun(subname//errormsg)
                end if
             end if
          else if (ndims < target_ndims) then
-            call endrun(subname//': too few dimensions for '//trim(varname))
+            call safe_endrun(subname//': too few dimensions for '//trim(varname))
          end if ! No else, things are okay
          !
          ! Get array dimension id's and sizes
@@ -328,7 +328,7 @@ subroutine infld_real8_1d(varname, ncid, field, readvar, gridname,         &
          if (arraydimsize(1) /= size(field, 1)) then
             write(errormsg, '(4a,i0)') ': Mismatch between array bounds ',    &
                  'and field size for ', trim(varname), ', dimension ', 1
-            call endrun(subname//errormsg)
+            call safe_endrun(subname//errormsg)
          end if
 
          ! Check that the number of columns in the file matches the number of
@@ -339,15 +339,15 @@ subroutine infld_real8_1d(varname, ncid, field, readvar, gridname,         &
                     trim(varname), ', file = ', dimlens(1), ', grid = ',      &
                     grid_dimlens(1), ' * ', grid_dimlens(2), ' = ',           &
                     (grid_dimlens(1) * grid_dimlens(2))
-               call endrun(subname//trim(errormsg))
+               call safe_endrun(subname//trim(errormsg))
             end if
          else
             do jndex = 1, target_ndims
                if (dimlens(jndex) /= grid_dimlens(jndex)) then
                   write(errormsg, '(a,i0,2a,2(a,i0))') ': Dim ', jndex,       &
                        ' mismatch for ', trim(varname), ', file = ',          &
                        dimlens(jndex), 'grid = ', grid_dimlens(jndex)
-                  call endrun(subname//trim(errormsg))
+                  call safe_endrun(subname//trim(errormsg))
                end if
             end do
          end if
@@ -365,9 +365,9 @@ subroutine infld_real8_1d(varname, ncid, field, readvar, gridname,         &
          if (single_column) then
             if (unstruct) then
                ! Clearly, this will not work for an unstructured dycore
-               call endrun(subname//': SCAM not supported in this configuration')
+               call safe_endrun(subname//': SCAM not supported in this configuration')
             else
-               call endrun(subname//': SCAM support not implemented')
+               call safe_endrun(subname//': SCAM support not implemented')
             end if
          else
             ! All distributed array processing
@@ -383,7 +383,7 @@ subroutine infld_real8_1d(varname, ncid, field, readvar, gridname,         &
             if (ierr /= PIO_NOERR) then
                write(errormsg, *) subname,                                    &
                     ': cam_pio_inq_var_fill failed with PIO error: ', ierr
-               call endrun(errormsg)
+               call safe_endrun(errormsg)
             end if
          end if
 
@@ -524,9 +524,9 @@ subroutine infld_real8_2d(varname, ncid, field, readvar, gridname,         &
       ! If <field> is a 3D quantity, fix up its dimensions
       if ((dim_bounds(2,2) <= 0) .or. (dim_bounds(2,2) < dim_bounds(2,1))) then
          if (.not. present(dim3name)) then
-            call endrun(subname//': dim3name must be present for 3D field')
+            call safe_endrun(subname//': dim3name must be present for 3D field')
          else if (.not. present(dim3_bnds)) then
-            call endrun(subname//': dim3_bnds must be present for 3D field')
+            call safe_endrun(subname//': dim3_bnds must be present for 3D field')
          end if
          dim_bounds(2,:) = dim3_bnds(:)
          dim2name = trim(dim3name)
@@ -546,22 +546,22 @@ subroutine infld_real8_2d(varname, ncid, field, readvar, gridname,         &
          pdims = ndims
          ! Check to make sure that any 'extra' dimension is time
          if (ndims > target_ndims + 1) then
-            call endrun(subname//': too many dimensions for '//trim(varname))
+            call safe_endrun(subname//': too many dimensions for '//trim(varname))
          else if (ndims == target_ndims + 1) then
             ierr = pio_inq_dimname(ncid, dimids(ndims), tmpname)
             if (trim(tmpname) /= 'time') then
-               call endrun(subname//': dimension mismatch for '//trim(varname))
+               call safe_endrun(subname//': dimension mismatch for '//trim(varname))
             end if
             if (present(timelevel)) then
                if (timelevel > dimlens(ndims)) then
                   write(errormsg, '(a,i0,a,i0)') ': timelevel, ', timelevel,  &
                        ', exceeds file limit, ', dimlens(ndims)
-                  call endrun(subname//errormsg)
+                  call safe_endrun(subname//errormsg)
                end if
             end if
             pdims = target_ndims
          else if (ndims < target_ndims) then
-            call endrun(subname//': too few dimensions for '//trim(varname))
+            call safe_endrun(subname//': too few dimensions for '//trim(varname))
          end if ! No else, things are okay
          call print_input_field_info(dimlens, pdims, 1, 3, dim_bounds, 2,     &
               varname, subname)
@@ -576,7 +576,7 @@ subroutine infld_real8_2d(varname, ncid, field, readvar, gridname,         &
                     ': Mismatch between array size (', arraydimsize(jndex),   &
                     ') and field size (', size(field, jndex), ') for ',       &
                     trim(varname), ', dimension = ', jndex
-               call endrun(subname//errormsg)
+               call safe_endrun(subname//errormsg)
             end if
          end do
 
@@ -588,7 +588,7 @@ subroutine infld_real8_2d(varname, ncid, field, readvar, gridname,         &
                     trim(varname), ', file = ', dimlens(1), ', grid = ',      &
                     grid_dimlens(1), ' * ', grid_dimlens(2), ' = ',           &
                     (grid_dimlens(1) * grid_dimlens(2))
-               call endrun(subname//trim(errormsg))
+               call safe_endrun(subname//trim(errormsg))
             end if
          else if (unstruct) then
             index = 0
@@ -605,7 +605,7 @@ subroutine infld_real8_2d(varname, ncid, field, readvar, gridname,         &
                   write(errormsg, '(a,i0,2a,2(a,i0))') ': Dim ', jndex,       &
                        ' mismatch for ', trim(varname), ', file = ',          &
                        dimlens(jndex), 'grid = ', grid_dimlens(jndex+index)
-                  call endrun(subname//trim(errormsg))
+                  call safe_endrun(subname//trim(errormsg))
                end if
             end do
          end if
@@ -632,9 +632,9 @@ subroutine infld_real8_2d(varname, ncid, field, readvar, gridname,         &
          if (single_column) then
             if (unstruct) then
                ! Clearly, this will not work for an unstructured dycore
-               call endrun(subname//': SCAM not supported in this configuration')
+               call safe_endrun(subname//': SCAM not supported in this configuration')
             else
-               call endrun(subname//': SCAM support not implemented')
+               call safe_endrun(subname//': SCAM support not implemented')
             end if
          else
             ! All distributed array processing
@@ -652,7 +652,7 @@ subroutine infld_real8_2d(varname, ncid, field, readvar, gridname,         &
             if (ierr /= PIO_NOERR) then
                write(errormsg, *) subname,                                    &
                     ': cam_pio_inq_var_fill failed with PIO error: ', ierr
-               call endrun(errormsg)
+               call safe_endrun(errormsg)
             end if
          end if
 
@@ -797,7 +797,7 @@ subroutine infld_real8_3d(varname, ncid, field, readvar, dim3name,         &
       else
          if (present(dim3_pos)) then
             if ((dim3_pos < 1) .or. (dim3_pos > 3)) then
-               call endrun(subname//': Bad value for dim3_pos')
+               call safe_endrun(subname//': Bad value for dim3_pos')
             end if
             index = dim3_pos
          else
@@ -826,21 +826,21 @@ subroutine infld_real8_3d(varname, ncid, field, readvar, dim3name,         &
               varname, subname)
          ! Check to make sure that any 'extra' dimension is time
          if (ndims > target_ndims + 1) then
-            call endrun(subname//': too many dimensions for '//trim(varname))
+            call safe_endrun(subname//': too many dimensions for '//trim(varname))
          else if (ndims == target_ndims + 1) then
             ierr = pio_inq_dimname(ncid, dimids(ndims), tmpname)
             if (trim(tmpname) /= 'time') then
-               call endrun(subname//': dimension mismatch for '//trim(varname))
+               call safe_endrun(subname//': dimension mismatch for '//trim(varname))
             end if
             if (present(timelevel)) then
                if (timelevel > dimlens(ndims)) then
                   write(errormsg, '(a,i0,a,i0)') ': timelevel, ', timelevel,  &
                        ', exceeds file limit, ', dimlens(ndims)
-                  call endrun(subname//errormsg)
+                  call safe_endrun(subname//errormsg)
                end if
             end if
          else if (ndims < target_ndims) then
-            call endrun(subname//': too few dimensions for '//trim(varname))
+            call safe_endrun(subname//': too few dimensions for '//trim(varname))
          end if ! No else, things are okay
          !
          ! Get array dimension id's and sizes
@@ -852,7 +852,7 @@ subroutine infld_real8_3d(varname, ncid, field, readvar, dim3name,         &
             if (arraydimsize(jndex) /= size(field, jndex)) then
                write(errormsg, '(4a,i0)') ': Mismatch between array bounds ', &
                     'and field size for ', trim(varname), ', dimension ', jndex
-               call endrun(subname//errormsg)
+               call safe_endrun(subname//errormsg)
             end if
          end do
 
@@ -864,7 +864,7 @@ subroutine infld_real8_3d(varname, ncid, field, readvar, dim3name,         &
                     trim(varname), ', file = ', dimlens(1), ', grid = ',      &
                     grid_dimlens(1), ' * ', grid_dimlens(2), ' = ',           &
                     (grid_dimlens(1) * grid_dimlens(2))
-               call endrun(subname//trim(errormsg))
+               call safe_endrun(subname//trim(errormsg))
             end if
          else
             do jndex = 1, target_ndims
@@ -878,7 +878,7 @@ subroutine infld_real8_3d(varname, ncid, field, readvar, dim3name,         &
                   write(errormsg, '(a,i0,2a,2(a,i0))') ': Dim ', jndex,       &
                        ' mismatch for ', trim(varname), ', file = ',          &
                        dimlens(jndex), 'grid = ', grid_dimlens(jndex+index)
-                  call endrun(subname//trim(errormsg))
+                  call safe_endrun(subname//trim(errormsg))
                end if
             end do
          end if
@@ -896,9 +896,9 @@ subroutine infld_real8_3d(varname, ncid, field, readvar, dim3name,         &
          if (single_column) then
             if (unstruct) then
                ! Clearly, this will not work for an unstructured dycore
-               call endrun(subname//': SCAM not supported in this configuration')
+               call safe_endrun(subname//': SCAM not supported in this configuration')
             else
-               call endrun(subname//': SCAM support not implemented')
+               call safe_endrun(subname//': SCAM support not implemented')
             end if
          else
             ! All distributed array processing
@@ -914,7 +914,7 @@ subroutine infld_real8_3d(varname, ncid, field, readvar, dim3name,         &
             if (ierr /= PIO_NOERR) then
                write(errormsg, *) subname,                                    &
                     ': cam_pio_inq_var_fill failed with PIO error: ', ierr
-               call endrun(errormsg)
+               call safe_endrun(errormsg)
             end if
          end if
 

src/utils/cam_pio_utils.F90

@@ -1227,9 +1227,9 @@ end subroutine clean_iodesc_list
 
    !===========================================================================
    subroutine cam_pio_createfile(file, fname, mode_in)
-      use pio,            only : pio_createfile, file_desc_t, pio_noerr
+      use pio,            only : pio_createfile, file_desc_t, pio_noerr, pio_nowrite
       use pio,            only: pio_64bit_offset, pio_iotask_rank, pio_clobber
-      use cam_abortutils, only : endrun
+      use cam_abortutils, only : endrun, cam_register_open_file
 
       ! Dummy arguments
       type(file_desc_t),          intent(inout) :: file
@@ -1249,15 +1249,18 @@ subroutine cam_pio_createfile(file, fname, mode_in)
 
       if(ierr /= PIO_NOERR) then
          call endrun('Failed to open file,'//trim(fname)//', to write')
+      else if (pio_iotask_rank(pio_subsystem) == 0 .and. mode /= pio_nowrite) then
+         write(iulog,*) 'Opened file ', trim(fname), ' to write', file%fh
+         call cam_register_open_file(file, trim(fname))
       end if
 
    end subroutine cam_pio_createfile
 
    !===========================================================================
    subroutine cam_pio_openfile(file, fname, mode, log_info)
-      use pio,           only: pio_openfile, file_desc_t
+      use pio,           only: pio_openfile, file_desc_t, pio_nowrite
       use pio,           only: pio_noerr, pio_iotask_rank
-      use cam_abortutils, only: endrun
+      use cam_abortutils, only: endrun, cam_register_open_file
 
       type(file_desc_t), intent(inout), target :: file
       character(len=*), intent(in) :: fname
@@ -1277,6 +1280,10 @@ subroutine cam_pio_openfile(file, fname, mode, log_info)
 
       if(ierr /= PIO_NOERR) then
          call endrun('Failed to open '//trim(fname)//' to read')
+      else if(pio_iotask_rank(pio_subsystem) == 0 .and. log_information &
+              .and. mode /= pio_nowrite) then
+         write(iulog,*) 'Opened existing file ', trim(fname), file%fh
+         call cam_register_open_file(file, trim(fname))
       end if
 
    end subroutine cam_pio_openfile
@@ -1285,10 +1292,12 @@ end subroutine cam_pio_openfile
    subroutine cam_pio_closefile(file)
 
       use pio, only: pio_closefile, file_desc_t
+      use cam_abortutils, only: cam_register_close_file
 
       type(file_desc_t), intent(inout), target :: file
 
       call pio_closefile(file)
+      call cam_register_close_file(file)
 
    end subroutine cam_pio_closefile