Update pio and netcdf error checking

- add ice_check_nc subroutine to check netcdf status, update netcdf checks

- update pio error checks

- add USE_PIO1 cpp, pio_strerror does not exist in pio1

- fix a couple of minor IO bugs detected by new checks, nothing significant

- update some abort_ice calls to add file and line

- update indentation

cicecore/cicedyn/analysis/ice_history.F90

@@ -3,7 +3,7 @@
 !
 ! The following variables are currently hard-wired as snapshots
 ! (instantaneous rather than time-averages):
-! divu, shear, vort, sig1, sig2, sigP, trsig, mlt_onset, 
+! divu, shear, vort, sig1, sig2, sigP, trsig, mlt_onset,
 ! frz_onset, hisnap, aisnap
 !
 ! Options for histfreq: '1','h','d','m','y','x', where x means that

cicecore/cicedyn/analysis/ice_history_shared.F90

@@ -4,7 +4,7 @@
 !
 ! The following variables are currently hard-wired as snapshots
 ! (instantaneous rather than time-averages):
-! divu, shear, vort, sig1, sig2, sigP, trsig, mlt_onset, 
+! divu, shear, vort, sig1, sig2, sigP, trsig, mlt_onset,
 ! frz_onset, hisnap, aisnap
 !
 ! Options for histfreq: '1','h','d','m','y','x', where x means that

cicecore/cicedyn/dynamics/ice_dyn_shared.F90

@@ -1742,7 +1742,7 @@ subroutine deformations (nx_block, ny_block, &
  tarear ! 1/tarea
 
  real (kind=dbl_kind), dimension (nx_block,ny_block), intent(inout) :: &
- vort , & ! vorticity (1/s) 
+ vort , & ! vorticity (1/s)
  shear , & ! strain rate II component (1/s)
  divu , & ! strain rate I component, velocity divergence (1/s)
  rdg_conv , & ! convergence term for ridging (1/s)

cicecore/cicedyn/dynamics/ice_transport_remap.F90

@@ -1177,7 +1177,7 @@ subroutine construct_fields (nx_block, ny_block, &
 
  ! center of mass (mxav,myav) for each cell
 
- mxav(i,j) = mx(i,j)*xxav / mm(i,j) 
+ mxav(i,j) = mx(i,j)*xxav / mm(i,j)
  myav(i,j) = my(i,j)*yyav / mm(i,j)
 
  enddo

cicecore/cicedyn/general/ice_forcing.F90

@@ -29,7 +29,7 @@ module ice_forcing
  daymo, days_per_year, compute_days_between
  use ice_fileunits, only: nu_diag, nu_forcing
  use ice_exit, only: abort_ice
- use ice_read_write, only: ice_open, ice_read, &
+ use ice_read_write, only: ice_open, ice_read, ice_check_nc, &
  ice_get_ncvarsize, ice_read_vec_nc, &
  ice_open_nc, ice_read_nc, ice_close_nc
  use ice_timers, only: ice_timer_start, ice_timer_stop, timer_readwrite, &
@@ -3701,11 +3701,15 @@ subroutine ocn_data_ncar_init
 
 ! status = nf90_inq_dimid(fid,'nlon',dimid)
  status = nf90_inq_dimid(fid,'ni',dimid)
+ call ice_check_nc(status, subname//'ERROR: inq dimid ni', file=__FILE__, line=__LINE__)
  status = nf90_inquire_dimension(fid,dimid,len=nlon)
+ call ice_check_nc(status, subname//'ERROR: inq dim ni', file=__FILE__, line=__LINE__)
 
 ! status = nf90_inq_dimid(fid,'nlat',dimid)
  status = nf90_inq_dimid(fid,'nj',dimid)
+ call ice_check_nc(status, subname//'ERROR: inq dimid nj', file=__FILE__, line=__LINE__)
  status = nf90_inquire_dimension(fid,dimid,len=nlat)
+ call ice_check_nc(status, subname//'ERROR: inq dim nj', file=__FILE__, line=__LINE__)
 
  if( nlon .ne. nx_global ) then
  call abort_ice (error_message=subname//'ice: ocn frc file nlon ne nx_global', &
@@ -3862,11 +3866,15 @@ subroutine ocn_data_ncar_init_3D
 
 ! status = nf90_inq_dimid(fid,'nlon',dimid)
  status = nf90_inq_dimid(fid,'ni',dimid)
+ call ice_check_nc(status, subname//'ERROR: inq dimid ni', file=__FILE__, line=__LINE__)
  status = nf90_inquire_dimension(fid,dimid,len=nlon)
+ call ice_check_nc(status, subname//'ERROR: inq dim ni', file=__FILE__, line=__LINE__)
 
 ! status = nf90_inq_dimid(fid,'nlat',dimid)
  status = nf90_inq_dimid(fid,'nj',dimid)
+ call ice_check_nc(status, subname//'ERROR: inq dimid nj', file=__FILE__, line=__LINE__)
  status = nf90_inquire_dimension(fid,dimid,len=nlat)
+ call ice_check_nc(status, subname//'ERROR: inq dim nj', file=__FILE__, line=__LINE__)
 
  if( nlon .ne. nx_global ) then
  call abort_ice (error_message=subname//'ice: ocn frc file nlon ne nx_global', &

cicecore/cicedyn/infrastructure/ice_domain.F90

@@ -177,8 +177,7 @@ subroutine init_domain_blocks
  open (nu_nml, file=trim(nml_filename), status='old',iostat=nml_error)
  if (nml_error /= 0) then
  call abort_ice(subname//'ERROR: domain_nml open file '// &
- trim(nml_filename), &
- file=__FILE__, line=__LINE__)
+ trim(nml_filename), file=__FILE__, line=__LINE__)
  endif
 
  call goto_nml(nu_nml,trim(nml_name),nml_error)
@@ -242,7 +241,7 @@ subroutine init_domain_blocks
  !***
  !*** domain size zero or negative
  !***
- call abort_ice(subname//'ERROR: Invalid domain: size < 1') ! no domain
+ call abort_ice(subname//'ERROR: Invalid domain: size < 1', file=__FILE__, line=__LINE__) ! no domain
  else if (nprocs /= get_num_procs()) then
  !***
  !*** input nprocs does not match system (eg MPI) request
@@ -251,13 +250,13 @@ subroutine init_domain_blocks
  nprocs = get_num_procs()
 #else
  write(nu_diag,*) subname,'ERROR: nprocs, get_num_procs = ',nprocs,get_num_procs()
- call abort_ice(subname//'ERROR: Input nprocs not same as system request')
+ call abort_ice(subname//'ERROR: Input nprocs not same as system request', file=__FILE__, line=__LINE__)
 #endif
  else if (nghost < 1) then
  !***
  !*** must have at least 1 layer of ghost cells
  !***
- call abort_ice(subname//'ERROR: Not enough ghost cells allocated')
+ call abort_ice(subname//'ERROR: Not enough ghost cells allocated', file=__FILE__, line=__LINE__)
  endif
 
 !----------------------------------------------------------------------
@@ -385,7 +384,7 @@ subroutine init_domain_distribution(KMTG,ULATG,grid_ice)
  file=__FILE__, line=__LINE__)
 
  if (trim(ns_boundary_type) == 'closed') then
- call abort_ice(subname//'ERROR: ns_boundary_type = closed not supported')
+ call abort_ice(subname//'ERROR: ns_boundary_type = closed not supported', file=__FILE__, line=__LINE__)
  allocate(nocn(nblocks_tot))
  nocn = 0
  do n=1,nblocks_tot
@@ -418,13 +417,13 @@ subroutine init_domain_distribution(KMTG,ULATG,grid_ice)
  endif
  if (nocn(n) > 0) then
  write(nu_diag,*) subname,'ns closed, Not enough land cells along ns edge'
- call abort_ice(subname//'ERROR: Not enough land cells along ns edge for ns closed')
+ call abort_ice(subname//'ERROR: Not enough land cells along ns edge for ns closed', file=__FILE__, line=__LINE__)
  endif
  enddo
  deallocate(nocn)
  endif
  if (trim(ew_boundary_type) == 'closed') then
- call abort_ice(subname//'ERROR: ew_boundary_type = closed not supported')
+ call abort_ice(subname//'ERROR: ew_boundary_type = closed not supported', file=__FILE__, line=__LINE__)
  allocate(nocn(nblocks_tot))
  nocn = 0
  do n=1,nblocks_tot
@@ -457,7 +456,7 @@ subroutine init_domain_distribution(KMTG,ULATG,grid_ice)
  endif
  if (nocn(n) > 0) then
  write(nu_diag,*) subname,'ew closed, Not enough land cells along ew edge'
- call abort_ice(subname//'ERROR: Not enough land cells along ew edge for ew closed')
+ call abort_ice(subname//'ERROR: Not enough land cells along ew edge for ew closed', file=__FILE__, line=__LINE__)
  endif
  enddo
  deallocate(nocn)
@@ -487,11 +486,20 @@ subroutine init_domain_distribution(KMTG,ULATG,grid_ice)
 #ifdef USE_NETCDF
  status = nf90_open(distribution_wght_file, NF90_NOWRITE, fid)
  if (status /= nf90_noerr) then
- call abort_ice (subname//'ERROR: Cannot open '//trim(distribution_wght_file))
+ call abort_ice(subname//'ERROR: Cannot open '//trim(distribution_wght_file), file=__FILE__, line=__LINE__)
  endif
  status = nf90_inq_varid(fid, 'wght', varid)
+ if (status /= nf90_noerr) then
+ call abort_ice(subname//'ERROR: Cannot find wght '//trim(distribution_wght_file), file=__FILE__, line=__LINE__)
+ endif
  status = nf90_get_var(fid, varid, wght)
+ if (status /= nf90_noerr) then
+ call abort_ice(subname//'ERROR: Cannot get wght '//trim(distribution_wght_file), file=__FILE__, line=__LINE__)
+ endif
  status = nf90_close(fid)
+ if (status /= nf90_noerr) then
+ call abort_ice(subname//'ERROR: Cannot close '//trim(distribution_wght_file), file=__FILE__, line=__LINE__)
+ endif
  write(nu_diag,*) 'read ',trim(distribution_wght_file),minval(wght),maxval(wght)
 #else
  call abort_ice(subname//'ERROR: USE_NETCDF cpp not defined', &
@@ -581,11 +589,11 @@ subroutine init_domain_distribution(KMTG,ULATG,grid_ice)
  allocate(work_per_block(nblocks_tot))
 
  where (nocn > 1)
- work_per_block = nocn/work_unit + 2
+  work_per_block = nocn/work_unit + 2
  elsewhere (nocn == 1)
- work_per_block = nocn/work_unit + 1
+  work_per_block = nocn/work_unit + 1
  elsewhere
- work_per_block = 0
+  work_per_block = 0
  end where
  if (my_task == master_task) then
  write(nu_diag,*) 'ice_domain work_unit, max_work_unit = ',work_unit, max_work_unit
@@ -701,10 +709,10 @@ subroutine init_domain_distribution(KMTG,ULATG,grid_ice)
  nblocks_max = 0
  tblocks_tmp = 0
  do n=0,distrb_info%nprocs - 1
- nblocks_tmp = nblocks
- call broadcast_scalar(nblocks_tmp, n)
- nblocks_max = max(nblocks_max,nblocks_tmp)
- tblocks_tmp = tblocks_tmp + nblocks_tmp
+  nblocks_tmp = nblocks
+  call broadcast_scalar(nblocks_tmp, n)
+  nblocks_max = max(nblocks_max,nblocks_tmp)
+  tblocks_tmp = tblocks_tmp + nblocks_tmp
  end do
 
  if (my_task == master_task) then
@@ -713,19 +721,16 @@ subroutine init_domain_distribution(KMTG,ULATG,grid_ice)
  endif
 
  if (nblocks_max > max_blocks) then
- write(outstring,*) &
- 'ERROR: num blocks exceed max: increase max to', nblocks_max
- call abort_ice(subname//trim(outstring), &
- file=__FILE__, line=__LINE__)
+ write(outstring,*) 'ERROR: num blocks exceed max: increase max to', nblocks_max
+ call abort_ice(subname//trim(outstring), file=__FILE__, line=__LINE__)
  else if (nblocks_max < max_blocks) then
- write(outstring,*) &
- 'WARNING: ice no. blocks too large: decrease max to', nblocks_max
- if (my_task == master_task) then
- write(nu_diag,*) ' ********WARNING***********'
- write(nu_diag,*) subname,trim(outstring)
- write(nu_diag,*) ' **************************'
- write(nu_diag,*) ' '
- endif
+ write(outstring,*) 'WARNING: ice no. blocks too large: decrease max to', nblocks_max
+ if (my_task == master_task) then
+ write(nu_diag,*) ' ********WARNING***********'
+ write(nu_diag,*) subname,trim(outstring)
+ write(nu_diag,*) ' **************************'
+ write(nu_diag,*) ' '
+ endif
  endif
 
 !----------------------------------------------------------------------