diff --git a/src/history/cam_history.F90 b/src/history/cam_history.F90 index 9f9ad843..bfd86769 100644 --- a/src/history/cam_history.F90 +++ b/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. ! diff --git a/src/utils/cam_abortutils.F90 b/src/utils/cam_abortutils.F90 index b2ac2fc2..06794ebc 100644 --- a/src/utils/cam_abortutils.F90 +++ b/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) diff --git a/src/utils/cam_field_read.F90 b/src/utils/cam_field_read.F90 index 32f51305..af3e5080 100644 --- a/src/utils/cam_field_read.F90 +++ b/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,7 +339,7 @@ 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 @@ -347,7 +347,7 @@ subroutine infld_real8_1d(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) - 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 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 diff --git a/src/utils/cam_pio_utils.F90 b/src/utils/cam_pio_utils.F90 index 5e0e5ebe..69683cba 100644 --- a/src/utils/cam_pio_utils.F90 +++ b/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