diff --git a/.github/PULL_REQUEST_TEMPLATE.md b/.github/PULL_REQUEST_TEMPLATE.md index 77cf56ddc..b0b5f57ff 100644 --- a/.github/PULL_REQUEST_TEMPLATE.md +++ b/.github/PULL_REQUEST_TEMPLATE.md @@ -29,4 +29,4 @@ please refer to: puny) then ! center of area*tracer - w1 = mc(i,j)*tc(i,j,nt) w2 = mc(i,j)*tx(i,j,nt) & + mx(i,j)*tc(i,j,nt) w3 = mc(i,j)*ty(i,j,nt) & + my(i,j)*tc(i,j,nt) -! w4 = mx(i,j)*tx(i,j,nt) -! w5 = mx(i,j)*ty(i,j,nt) & -! + my(i,j)*tx(i,j,nt) -! w6 = my(i,j)*ty(i,j,nt) w7 = c1 / (mm(i,j)*tm(i,j,nt)) ! echmod: grid arrays = 0 - mtxav(i,j,nt) = (w1*xav (i,j) + w2*xxav (i,j)) & - * w7 - mtyav(i,j,nt) = (w1*yav(i,j) + w3*yyav(i,j)) & - * w7 - -! mtxav(i,j,nt) = (w1*xav (i,j) + w2*xxav (i,j) & -! + w3*xyav (i,j) + w4*xxxav(i,j) & -! + w5*xxyav(i,j) + w6*xyyav(i,j)) & -! * w7 -! mtyav(i,j,nt) = (w1*yav(i,j) + w2*xyav (i,j) & -! + w3*yyav(i,j) + w4*xxyav(i,j) & -! + w5*xyyav(i,j) + w6*yyyav(i,j)) & -! * w7 + mtxav(i,j,nt) = w2*xxav *w7 + mtyav(i,j,nt) = w3*yyav * w7 endif ! tmask enddo ! ij @@ -1342,8 +1264,6 @@ subroutine construct_fields (nx_block, ny_block, & j = indxj(ij) tc(i,j,nt) = tm(i,j,nt) -! tx(i,j,nt) = c0 ! already initialized to 0. -! ty(i,j,nt) = c0 enddo ! ij endif ! tracer_type @@ -1355,7 +1275,6 @@ subroutine construct_fields (nx_block, ny_block, & end subroutine construct_fields !======================================================================= -! ! Compute a limited gradient of the scalar field phi in scaled coordinates. ! "Limited" means that we do not create new extrema in phi. For ! instance, field values at the cell corners can neither exceed the @@ -1379,12 +1298,14 @@ subroutine limited_gradient (nx_block, ny_block, & real (kind=dbl_kind), dimension (nx_block,ny_block), intent (in) :: & phi , & ! input tracer field (mean values in each grid cell) - cnx , & ! x-coordinate of phi relative to geometric center of cell - cny , & ! y-coordinate of phi relative to geometric center of cell phimask ! phimask(i,j) = 1 if phi(i,j) has physical meaning, = 0 otherwise. ! For instance, aice has no physical meaning in land cells, ! and hice no physical meaning where aice = 0. + real (kind=dbl_kind), dimension (nx_block,ny_block), intent (in) :: & + cnx , & ! x-coordinate of phi relative to geometric center of cell + cny ! y-coordinate of phi relative to geometric center of cell½ + real (kind=dbl_kind), dimension (nx_block,ny_block), intent(out) :: & gx , & ! limited x-direction gradient gy ! limited y-direction gradient @@ -3102,10 +3023,6 @@ subroutine locate_triangles (nx_block, ny_block, & write(nu_diag,*) '' write(nu_diag,*) 'WARNING: xp =', xp(i,j,nv,ng) write(nu_diag,*) 'm, i, j, ng, nv =', my_task, i, j, ng, nv -! write(nu_diag,*) 'yil,xdl,xcl,ydl=',yil,xdl,xcl,ydl -! write(nu_diag,*) 'yir,xdr,xcr,ydr=',yir,xdr,xcr,ydr -! write(nu_diag,*) 'ydm=',ydm -! stop endif if (abs(yp(i,j,nv,ng)) > p5+puny) then write(nu_diag,*) '' diff --git a/cicecore/cicedyn/general/ice_flux.F90 b/cicecore/cicedyn/general/ice_flux.F90 index 4c37a0696..2d61bf642 100644 --- a/cicecore/cicedyn/general/ice_flux.F90 +++ b/cicecore/cicedyn/general/ice_flux.F90 @@ -1022,7 +1022,7 @@ end subroutine init_history_therm subroutine init_history_dyn - use ice_state, only: aice, vice, trcr, strength, divu, shear + use ice_state, only: aice, vice, trcr, strength, divu, shear, vort use ice_grid, only: grid_ice logical (kind=log_kind) :: & @@ -1043,6 +1043,7 @@ subroutine init_history_dyn sig2 (:,:,:) = c0 divu (:,:,:) = c0 shear (:,:,:) = c0 + vort (:,:,:) = c0 taubxU (:,:,:) = c0 taubyU (:,:,:) = c0 strength (:,:,:) = c0 diff --git a/cicecore/cicedyn/general/ice_forcing.F90 b/cicecore/cicedyn/general/ice_forcing.F90 index 496e342f1..b977f54aa 100755 --- a/cicecore/cicedyn/general/ice_forcing.F90 +++ b/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', & diff --git a/cicecore/cicedyn/general/ice_init.F90 b/cicecore/cicedyn/general/ice_init.F90 index 8875c7a29..24ac40db3 100644 --- a/cicecore/cicedyn/general/ice_init.F90 +++ b/cicecore/cicedyn/general/ice_init.F90 @@ -59,29 +59,37 @@ module ice_init subroutine input_data use ice_broadcast, only: broadcast_scalar, broadcast_array - use ice_diagnostics, only: diag_file, print_global, print_points, latpnt, lonpnt, & - debug_model, debug_model_step, debug_model_task, & - debug_model_i, debug_model_j, debug_model_iblk + use ice_diagnostics, only: & + diag_file, print_global, print_points, latpnt, lonpnt, & + debug_model, debug_model_step, debug_model_task, & + debug_model_i, debug_model_j, debug_model_iblk use ice_domain, only: close_boundaries, orca_halogrid - use ice_domain_size, only: ncat, nilyr, nslyr, nblyr, nfsd, nfreq, & - n_iso, n_aero, n_zaero, n_algae, & - n_doc, n_dic, n_don, n_fed, n_fep, & - max_nstrm - use ice_calendar, only: year_init, month_init, day_init, sec_init, & - istep0, histfreq, histfreq_n, histfreq_base, & - dumpfreq, dumpfreq_n, diagfreq, dumpfreq_base, & - npt, dt, ndtd, days_per_year, use_leap_years, & - write_ic, dump_last, npt_unit + use ice_domain_size, only: & + ncat, nilyr, nslyr, nblyr, nfsd, nfreq, & + n_iso, n_aero, n_zaero, n_algae, & + n_doc, n_dic, n_don, n_fed, n_fep, & + max_nstrm + use ice_calendar, only: & + year_init, month_init, day_init, sec_init, & + istep0, histfreq, histfreq_n, histfreq_base, & + dumpfreq, dumpfreq_n, diagfreq, dumpfreq_base, & + npt, dt, ndtd, days_per_year, use_leap_years, & + write_ic, dump_last, npt_unit use ice_arrays_column, only: oceanmixed_ice - use ice_restart_column, only: restart_age, restart_FY, restart_lvl, & + use ice_restart_column, only: & + restart_age, restart_FY, restart_lvl, & restart_pond_lvl, restart_pond_topo, restart_aero, & restart_fsd, restart_iso, restart_snow use ice_restart_shared, only: & - restart, restart_ext, restart_coszen, restart_dir, restart_file, pointer_file, & - runid, runtype, use_restart_time, restart_format, lcdf64 - use ice_history_shared, only: hist_avg, history_dir, history_file, hist_suffix, & - incond_dir, incond_file, version_name, & - history_precision, history_format, hist_time_axis + restart, restart_ext, restart_coszen, use_restart_time, & + runtype, restart_file, restart_dir, runid, pointer_file, & + restart_format, restart_rearranger, restart_iotasks, restart_root, & + restart_stride, restart_deflate, restart_chunksize + use ice_history_shared, only: & + history_precision, hist_avg, history_format, history_file, incond_file, & + history_dir, incond_dir, version_name, history_rearranger, & + hist_suffix, history_iotasks, history_root, history_stride, & + history_deflate, history_chunksize, hist_time_axis use ice_flux, only: update_ocn_f, cpl_frazil, l_mpond_fresh use ice_flux, only: default_season use ice_flux_bgc, only: cpl_bgc @@ -97,29 +105,31 @@ subroutine input_data snw_tau_fname, snw_kappa_fname, snw_drdt0_fname, & snw_rhos_fname, snw_Tgrd_fname, snw_T_fname use ice_arrays_column, only: bgc_data_dir, fe_data_type - use ice_grid, only: grid_file, gridcpl_file, kmt_file, & - bathymetry_file, use_bathymetry, & - bathymetry_format, kmt_type, & - grid_type, grid_format, & - grid_ice, grid_ice_thrm, grid_ice_dynu, grid_ice_dynv, & - grid_ocn, grid_ocn_thrm, grid_ocn_dynu, grid_ocn_dynv, & - grid_atm, grid_atm_thrm, grid_atm_dynu, grid_atm_dynv, & - dxrect, dyrect, dxscale, dyscale, scale_dxdy, & - lonrefrect, latrefrect, save_ghte_ghtn - use ice_dyn_shared, only: ndte, kdyn, revised_evp, yield_curve, & - evp_algorithm, visc_method, & - seabed_stress, seabed_stress_method, & - k1, k2, alphab, threshold_hw, Ktens, & - e_yieldcurve, e_plasticpot, coriolis, & - ssh_stress, kridge, brlx, arlx, & - deltaminEVP, deltaminVP, capping, & - elasticDamp - - use ice_dyn_vp, only: maxits_nonlin, precond, dim_fgmres, dim_pgmres, maxits_fgmres, & - maxits_pgmres, monitor_nonlin, monitor_fgmres, & - monitor_pgmres, reltol_nonlin, reltol_fgmres, reltol_pgmres, & - algo_nonlin, fpfunc_andacc, dim_andacc, reltol_andacc, & - damping_andacc, start_andacc, use_mean_vrel, ortho_type + use ice_grid, only: & + grid_file, gridcpl_file, kmt_file, & + bathymetry_file, use_bathymetry, & + bathymetry_format, kmt_type, & + grid_type, grid_format, & + grid_ice, grid_ice_thrm, grid_ice_dynu, grid_ice_dynv, & + grid_ocn, grid_ocn_thrm, grid_ocn_dynu, grid_ocn_dynv, & + grid_atm, grid_atm_thrm, grid_atm_dynu, grid_atm_dynv, & + dxrect, dyrect, dxscale, dyscale, scale_dxdy, & + lonrefrect, latrefrect, save_ghte_ghtn + use ice_dyn_shared, only: & + ndte, kdyn, revised_evp, yield_curve, & + evp_algorithm, visc_method, & + seabed_stress, seabed_stress_method, & + k1, k2, alphab, threshold_hw, Ktens, & + e_yieldcurve, e_plasticpot, coriolis, & + ssh_stress, kridge, brlx, arlx, & + deltaminEVP, deltaminVP, capping, & + elasticDamp + use ice_dyn_vp, only: & + maxits_nonlin, precond, dim_fgmres, dim_pgmres, maxits_fgmres, & + maxits_pgmres, monitor_nonlin, monitor_fgmres, & + monitor_pgmres, reltol_nonlin, reltol_fgmres, reltol_pgmres, & + algo_nonlin, fpfunc_andacc, dim_andacc, reltol_andacc, & + damping_andacc, start_andacc, use_mean_vrel, ortho_type use ice_transport_driver, only: advection, conserv_check use ice_restoring, only: restore_ice use ice_timers, only: timer_stats @@ -163,6 +173,7 @@ subroutine input_data logical (kind=log_kind) :: tr_iso, tr_aero, tr_fsd, tr_snow logical (kind=log_kind) :: tr_pond_lvl, tr_pond_topo integer (kind=int_kind) :: numin, numax ! unit number limits + logical (kind=log_kind) :: lcdf64 ! deprecated, backwards compatibility integer (kind=int_kind) :: rplvl, rptopo real (kind=dbl_kind) :: Cf, ksno, puny, ice_ref_salinity, Tocnfrz @@ -183,12 +194,15 @@ subroutine input_data runtype, runid, bfbflag, numax, & ice_ic, restart, restart_dir, restart_file, & restart_ext, use_restart_time, restart_format, lcdf64, & + restart_root, restart_stride, restart_iotasks, restart_rearranger, & + restart_deflate, restart_chunksize, & pointer_file, dumpfreq, dumpfreq_n, dump_last, & diagfreq, diag_type, diag_file, history_format,& + history_root, history_stride, history_iotasks, history_rearranger, & hist_time_axis, & print_global, print_points, latpnt, lonpnt, & debug_forcing, histfreq, histfreq_n, hist_avg, & - hist_suffix, & + hist_suffix, history_deflate, history_chunksize, & history_dir, history_file, history_precision, cpl_bgc, & histfreq_base, dumpfreq_base, timer_stats, memory_stats, & conserv_check, debug_model, debug_model_step, & @@ -326,20 +340,25 @@ subroutine input_data histfreq_base(:) = 'zero' ! output frequency reference date hist_avg(:) = .true. ! if true, write time-averages (not snapshots) hist_suffix(:) = 'x' ! appended to 'history_file' in filename when not 'x' - history_format = 'default' ! history file format + history_format = 'cdf1'! history file format + history_root = -99 ! history iotasks, root, stride sets pes for pio + history_stride = -99 ! history iotasks, root, stride sets pes for pio + history_iotasks = -99 ! history iotasks, root, stride sets pes for pio + history_rearranger = 'default' ! history rearranger for pio hist_time_axis = 'end' ! History file time axis averaging interval position - history_dir = './' ! write to executable dir for default history_file = 'iceh' ! history file name prefix history_precision = 4 ! precision of history files + history_deflate = 0 ! compression level for netcdf4 + history_chunksize(:) = 0 ! chunksize for netcdf4 write_ic = .false. ! write out initial condition cpl_bgc = .false. ! couple bgc thru driver incond_dir = history_dir ! write to history dir for default incond_file = 'iceh_ic'! file prefix - dumpfreq(:)='x' ! restart frequency option + dumpfreq(:) = 'x' ! restart frequency option dumpfreq_n(:) = 1 ! restart frequency dumpfreq_base(:) = 'init' ! restart frequency reference date - dumpfreq(1)='y' ! restart frequency option + dumpfreq(1) = 'y' ! restart frequency option dumpfreq_n(1) = 1 ! restart frequency dump_last = .false. ! write restart on last time step restart_dir = './' ! write to executable dir for default @@ -347,7 +366,13 @@ subroutine input_data restart_ext = .false. ! if true, read/write ghost cells restart_coszen = .false. ! if true, read/write coszen pointer_file = 'ice.restart_file' - restart_format = 'default' ! restart file format + restart_format = 'cdf1' ! restart file format + restart_root = -99 ! restart iotasks, root, stride sets pes for pio + restart_stride = -99 ! restart iotasks, root, stride sets pes for pio + restart_iotasks = -99 ! restart iotasks, root, stride sets pes for pio + restart_rearranger = 'default' ! restart rearranger for pio + restart_deflate = 0 ! compression level for netcdf4 + restart_chunksize(:) = 0 ! chunksize for netcdf4 lcdf64 = .false. ! 64 bit offset for netCDF ice_ic = 'default' ! latitude and sst-dependent grid_format = 'bin' ! file format ('bin'=binary or 'nc'=netcdf) @@ -922,7 +947,13 @@ subroutine input_data call broadcast_scalar(history_file, master_task) call broadcast_scalar(history_precision, master_task) call broadcast_scalar(history_format, master_task) + call broadcast_scalar(history_iotasks, master_task) + call broadcast_scalar(history_root, master_task) + call broadcast_scalar(history_stride, master_task) + call broadcast_scalar(history_rearranger, master_task) call broadcast_scalar(hist_time_axis, master_task) + call broadcast_scalar(history_deflate, master_task) + call broadcast_array(history_chunksize, master_task) call broadcast_scalar(write_ic, master_task) call broadcast_scalar(cpl_bgc, master_task) call broadcast_scalar(incond_dir, master_task) @@ -935,6 +966,12 @@ subroutine input_data call broadcast_scalar(restart_coszen, master_task) call broadcast_scalar(use_restart_time, master_task) call broadcast_scalar(restart_format, master_task) + call broadcast_scalar(restart_iotasks, master_task) + call broadcast_scalar(restart_root, master_task) + call broadcast_scalar(restart_stride, master_task) + call broadcast_scalar(restart_rearranger, master_task) + call broadcast_scalar(restart_deflate, master_task) + call broadcast_array(restart_chunksize, master_task) call broadcast_scalar(lcdf64, master_task) call broadcast_scalar(pointer_file, master_task) call broadcast_scalar(ice_ic, master_task) @@ -1232,6 +1269,95 @@ subroutine input_data abort_list = trim(abort_list)//":1" endif + if (history_format /= 'cdf1' .and. & + history_format /= 'cdf2' .and. & + history_format /= 'cdf5' .and. & + history_format /= 'hdf5' .and. & + history_format /= 'pnetcdf1' .and. & + history_format /= 'pnetcdf2' .and. & + history_format /= 'pnetcdf5' .and. & + history_format /= 'pio_netcdf' .and. & ! backwards compatibility + history_format /= 'pio_pnetcdf' .and. & ! backwards compatibility + history_format /= 'binary' .and. & + history_format /= 'default') then ! backwards compatibility + if (my_task == master_task) then + write(nu_diag,*) subname//' ERROR: history_format unknown = ',trim(history_format) + endif + abort_list = trim(abort_list)//":50" + endif + + if (restart_format /= 'cdf1' .and. & + restart_format /= 'cdf2' .and. & + restart_format /= 'cdf5' .and. & + restart_format /= 'hdf5' .and. & + restart_format /= 'pnetcdf1' .and. & + restart_format /= 'pnetcdf2' .and. & + restart_format /= 'pnetcdf5' .and. & + restart_format /= 'pio_netcdf' .and. & ! backwards compatibility + restart_format /= 'pio_pnetcdf' .and. & ! backwards compatibility + restart_format /= 'binary' .and. & + restart_format /= 'default') then ! backwards compatibility + if (my_task == master_task) then + write(nu_diag,*) subname//' ERROR: restart_format unknown = ',trim(restart_format) + endif + abort_list = trim(abort_list)//":51" + endif + + ! backwards compatibility for history and restart formats, lcdf64 + + if (history_format == 'pio_pnetcdf' .or. history_format == 'pio_netcdf') then + if (my_task == master_task) then + write(nu_diag,*) subname//' WARNING: history_format='//trim(history_format)// & + ' is deprecated, please update namelist settings' + endif + endif + if (restart_format == 'pio_pnetcdf' .or. restart_format == 'pio_netcdf') then + if (my_task == master_task) then + write(nu_diag,*) subname//' WARNING: restart_format='//trim(restart_format)// & + ' is deprecated, please update namelist settings' + endif + endif + + if (lcdf64) then + if (my_task == master_task) then + write(nu_diag,*) subname//' WARNING: lcdf64 is deprecated, please update namelist settings' + endif + + if (history_format == 'default' .or. history_format == 'pio_netcdf') then + history_format = 'cdf2' + elseif (history_format == 'pio_pnetcdf') then + history_format = 'pnetcdf2' + else + if (my_task == master_task) then + write(nu_diag,*) subname//' ERROR: lcdf64 is T and history_format not supported for '//trim(history_format) + endif + abort_list = trim(abort_list)//":52" + endif + + if (restart_format == 'default' .or. restart_format == 'pio_netcdf') then + restart_format = 'cdf2' + elseif (restart_format == 'pio_pnetcdf') then + restart_format = 'pnetcdf2' + else + if (my_task == master_task) then + write(nu_diag,*) subname//' ERROR: lcdf64 is T and restart_format not supported for '//trim(restart_format) + endif + abort_list = trim(abort_list)//":53" + endif + else + if (history_format == 'default' .or. history_format == 'pio_netcdf') then + history_format = 'cdf1' + elseif (history_format == 'pio_pnetcdf') then + history_format = 'pnetcdf1' + endif + + if (restart_format == 'default' .or. restart_format == 'pio_netcdf') then + restart_format = 'cdf1' + elseif (restart_format == 'pio_pnetcdf') then + restart_format = 'pnetcdf1' + endif + endif + if (ktransport <= 0) then advection = 'none' endif @@ -1504,7 +1630,7 @@ subroutine input_data write (nu_diag,*) subname//' ERROR: snow grain radius is activated' write (nu_diag,*) subname//' ERROR: Must use shortwave=dEdd or dEdd_snicar_ad' endif - abort_list = trim(abort_list)//":29" + abort_list = trim(abort_list)//":17" endif if ((rfracmin < -puny .or. rfracmin > c1+puny) .or. & @@ -1590,18 +1716,18 @@ subroutine input_data abort_list = trim(abort_list)//":19" endif - if(history_precision .ne. 4 .and. history_precision .ne. 8) then + if (history_precision .ne. 4 .and. history_precision .ne. 8) then write (nu_diag,*) subname//' ERROR: bad value for history_precision, allowed values: 4, 8' abort_list = trim(abort_list)//":22" endif do n = 1,max_nstrm - if(histfreq_base(n) /= 'init' .and. histfreq_base(n) /= 'zero') then + if (histfreq_base(n) /= 'init' .and. histfreq_base(n) /= 'zero') then write (nu_diag,*) subname//' ERROR: bad value for histfreq_base, allowed values: init, zero: '//trim(histfreq_base(n)) abort_list = trim(abort_list)//":24" endif - if(dumpfreq_base(n) /= 'init' .and. dumpfreq_base(n) /= 'zero') then + if (dumpfreq_base(n) /= 'init' .and. dumpfreq_base(n) /= 'zero') then write (nu_diag,*) subname//' ERROR: bad value for dumpfreq_base, allowed values: init, zero: '//trim(dumpfreq_base(n)) abort_list = trim(abort_list)//":25" endif @@ -1616,11 +1742,63 @@ subroutine input_data endif enddo - if(trim(hist_time_axis) /= 'begin' .and. trim(hist_time_axis) /= 'middle' .and. trim(hist_time_axis) /= 'end') then + if (trim(hist_time_axis) /= 'begin' .and. trim(hist_time_axis) /= 'middle' .and. trim(hist_time_axis) /= 'end') then write (nu_diag,*) subname//' ERROR: hist_time_axis value not valid = '//trim(hist_time_axis) abort_list = trim(abort_list)//":29" endif +#ifdef USE_PIO1 + if (history_deflate/=0 .or. restart_deflate/=0 .or. & + history_chunksize(1)/=0 .or. history_chunksize(2)/=0 .or. & + restart_chunksize(1)/=0 .or. restart_chunksize(2)/=0) then + if (my_task == master_task) write (nu_diag,*) subname//' ERROR: _deflate and _chunksize not compatible with PIO1' + abort_list = trim(abort_list)//":54" + endif +#else +#ifndef CESMCOUPLED + ! history_format not used by nuopc driver + if (history_format/='hdf5' .and. history_deflate/=0) then + if (my_task == master_task) then + write (nu_diag,*) subname//' WARNING: history_deflate not compatible with '//history_format + write (nu_diag,*) subname//' WARNING: netcdf compression only possible with history_type="hdf5" ' + endif + endif + + if (history_format/='hdf5' .and. (history_chunksize(1)/=0 .or. history_chunksize(2)/=0)) then + if (my_task == master_task) then + write (nu_diag,*) subname//' WARNING: history_chunksize not compatible with '//history_format + write (nu_diag,*) subname//' WARNING: netcdf chunking only possible with history_type="hdf5" ' + endif + endif + + if (restart_format/='hdf5' .and. restart_deflate/=0) then + if (my_task == master_task) then + write (nu_diag,*) subname//' WARNING: restart_deflate not compatible with '//restart_format + write (nu_diag,*) subname//' WARNING: netcdf compression only possible with restart_type="hdf5" ' + endif + endif + + if (restart_format/='hdf5' .and. (restart_chunksize(1)/=0 .or. restart_chunksize(2)/=0)) then + if (my_task == master_task) then + write (nu_diag,*) subname//' WARNING: restart_chunksize not compatible with '//restart_format + write (nu_diag,*) subname//' WARNING: netcdf chunking only possible with restart_type="hdf5" ' + endif + endif +#endif + + if (history_deflate<0 .or. history_deflate>9) then + if (my_task == master_task) write (nu_diag,*) subname//& + ' ERROR: history_deflate value not valid. Allowed range: integers from 0 to 9 ' + abort_list = trim(abort_list)//":55" + endif + + if (restart_deflate<0 .or. restart_deflate>9) then + if (my_task == master_task) write (nu_diag,*) subname//& + ' ERROR: restart_deflate value not valid. Allowed range: integers from 0 to 9 ' + abort_list = trim(abort_list)//":56" + endif +#endif + ! Implicit solver input validation if (kdyn == 3) then if (.not. (trim(algo_nonlin) == 'picard' .or. trim(algo_nonlin) == 'anderson')) then @@ -2164,7 +2342,7 @@ subroutine input_data tmpstr2 = ' : dragio hard-coded' endif write(nu_diag,1010) ' calc_dragio = ', calc_dragio,trim(tmpstr2) - if(calc_dragio) then + if (calc_dragio) then write(nu_diag,1002) ' iceruf_ocn = ', iceruf_ocn,' : under-ice roughness length' endif @@ -2357,13 +2535,19 @@ subroutine input_data write(nu_diag,1033) ' histfreq = ', histfreq(:) write(nu_diag,1023) ' histfreq_n = ', histfreq_n(:) write(nu_diag,1033) ' histfreq_base = ', histfreq_base(:) - write(nu_diag,*) ' hist_avg = ', hist_avg(:) + write(nu_diag,1013) ' hist_avg = ', hist_avg(:) write(nu_diag,1033) ' hist_suffix = ', hist_suffix(:) write(nu_diag,1031) ' history_dir = ', trim(history_dir) write(nu_diag,1031) ' history_file = ', trim(history_file) write(nu_diag,1021) ' history_precision= ', history_precision write(nu_diag,1031) ' history_format = ', trim(history_format) + write(nu_diag,1031) ' history_rearranger = ', trim(history_rearranger) + write(nu_diag,1021) ' history_iotasks = ', history_iotasks + write(nu_diag,1021) ' history_root = ', history_root + write(nu_diag,1021) ' history_stride = ', history_stride write(nu_diag,1031) ' hist_time_axis = ', trim(hist_time_axis) + write(nu_diag,1021) ' history_deflate = ', history_deflate + write(nu_diag,1023) ' history_chunksize= ', history_chunksize if (write_ic) then write(nu_diag,1039) ' Initial condition will be written in ', & trim(incond_dir) @@ -2377,7 +2561,13 @@ subroutine input_data write(nu_diag,1011) ' restart_ext = ', restart_ext write(nu_diag,1011) ' restart_coszen = ', restart_coszen write(nu_diag,1031) ' restart_format = ', trim(restart_format) - write(nu_diag,1011) ' lcdf64 = ', lcdf64 + write(nu_diag,1021) ' restart_deflate = ', restart_deflate + write(nu_diag,1023) ' restart_chunksize= ', restart_chunksize +! write(nu_diag,1011) ' lcdf64 = ', lcdf64 ! deprecated + write(nu_diag,1031) ' restart_rearranger = ', trim(restart_rearranger) + write(nu_diag,1021) ' restart_iotasks = ', restart_iotasks + write(nu_diag,1021) ' restart_root = ', restart_root + write(nu_diag,1021) ' restart_stride = ', restart_stride write(nu_diag,1031) ' restart_file = ', trim(restart_file) write(nu_diag,1031) ' pointer_file = ', trim(pointer_file) write(nu_diag,1011) ' use_restart_time = ', use_restart_time @@ -2402,7 +2592,7 @@ subroutine input_data if (trim(atm_data_type) /= 'default') then write(nu_diag,1031) ' atm_data_dir = ', trim(atm_data_dir) write(nu_diag,1031) ' precip_units = ', trim(precip_units) - elseif (trim(atm_data_type)=='default') then + elseif (trim(atm_data_type) == 'default') then write(nu_diag,1031) ' default_season = ', trim(default_season) endif @@ -2560,6 +2750,7 @@ subroutine input_data 1009 format (a20,1x,d13.6,1x,a) 1010 format (a20,8x,l6,1x,a) ! logical 1011 format (a20,1x,l6) + 1013 format (a20,1x,6l3) 1020 format (a20,8x,i6,1x,a) ! integer 1021 format (a20,1x,i6) 1022 format (a20,1x,i12) diff --git a/cicecore/cicedyn/general/ice_state.F90 b/cicecore/cicedyn/general/ice_state.F90 index 862f0a8bc..21ddf562c 100644 --- a/cicecore/cicedyn/general/ice_state.F90 +++ b/cicecore/cicedyn/general/ice_state.F90 @@ -116,6 +116,7 @@ module ice_state vvelN , & ! y-component of velocity on N grid (m/s) divu , & ! strain rate I component, velocity divergence (1/s) shear , & ! strain rate II component (1/s) + vort , & ! vorticity (1/s) strength ! ice strength (N/m) !----------------------------------------------------------------- @@ -163,6 +164,7 @@ subroutine alloc_state vvelN (nx_block,ny_block,max_blocks) , & ! y-component of velocity on N grid (m/s) divu (nx_block,ny_block,max_blocks) , & ! strain rate I component, velocity divergence (1/s) shear (nx_block,ny_block,max_blocks) , & ! strain rate II component (1/s) + vort (nx_block,ny_block,max_blocks) , & ! vorticity (1/s) strength (nx_block,ny_block,max_blocks) , & ! ice strength (N/m) aice_init (nx_block,ny_block,max_blocks) , & ! initial concentration of ice, for diagnostics aicen (nx_block,ny_block,ncat,max_blocks) , & ! concentration of ice diff --git a/cicecore/cicedyn/infrastructure/comm/mpi/ice_global_reductions.F90 b/cicecore/cicedyn/infrastructure/comm/mpi/ice_global_reductions.F90 index 91daf53a8..1f7592749 100644 --- a/cicecore/cicedyn/infrastructure/comm/mpi/ice_global_reductions.F90 +++ b/cicecore/cicedyn/infrastructure/comm/mpi/ice_global_reductions.F90 @@ -40,6 +40,15 @@ module ice_global_reductions global_maxval, & global_minval + real (kind=dbl_kind), parameter :: & + bigdbl = 1.0e36_dbl_kind + + real (kind=real_kind), parameter :: & + bigreal = 1.0e36_real_kind + + real (kind=int_kind), parameter :: & + bigint = 9999999 + !----------------------------------------------------------------------- ! ! generic interfaces for module procedures @@ -1246,8 +1255,8 @@ function global_maxval_dbl (array, dist, lMask) & !----------------------------------------------------------------------- - localMaxval = -HUGE(0.0_dbl_kind) - globalMaxval = -HUGE(0.0_dbl_kind) + localMaxval = -bigdbl + globalMaxval = -bigdbl call ice_distributionGet(dist, & numLocalBlocks = numBlocks, & @@ -1264,7 +1273,7 @@ function global_maxval_dbl (array, dist, lMask) & jb = this_block%jlo je = this_block%jhi - blockMaxval = -HUGE(0.0_dbl_kind) + blockMaxval = -bigdbl if (present(lMask)) then do j=jb,je @@ -1353,8 +1362,8 @@ function global_maxval_real (array, dist, lMask) & !----------------------------------------------------------------------- - localMaxval = -HUGE(0.0_real_kind) - globalMaxval = -HUGE(0.0_real_kind) + localMaxval = -bigreal + globalMaxval = -bigreal call ice_distributionGet(dist, & numLocalBlocks = numBlocks, & @@ -1371,7 +1380,7 @@ function global_maxval_real (array, dist, lMask) & jb = this_block%jlo je = this_block%jhi - blockMaxval = -HUGE(0.0_real_kind) + blockMaxval = -bigreal if (present(lMask)) then do j=jb,je @@ -1460,8 +1469,8 @@ function global_maxval_int (array, dist, lMask) & !----------------------------------------------------------------------- - localMaxval = -HUGE(0_int_kind) - globalMaxval = -HUGE(0_int_kind) + localMaxval = -bigint + globalMaxval = -bigint call ice_distributionGet(dist, & numLocalBlocks = numBlocks, & @@ -1478,7 +1487,7 @@ function global_maxval_int (array, dist, lMask) & jb = this_block%jlo je = this_block%jhi - blockMaxval = -HUGE(0_int_kind) + blockMaxval = -bigint if (present(lMask)) then do j=jb,je @@ -1791,8 +1800,8 @@ function global_minval_dbl (array, dist, lMask) & !----------------------------------------------------------------------- - localMinval = HUGE(0.0_dbl_kind) - globalMinval = HUGE(0.0_dbl_kind) + localMinval = bigdbl + globalMinval = bigdbl call ice_distributionGet(dist, & numLocalBlocks = numBlocks, & @@ -1809,7 +1818,7 @@ function global_minval_dbl (array, dist, lMask) & jb = this_block%jlo je = this_block%jhi - blockMinval = HUGE(0.0_dbl_kind) + blockMinval = bigdbl if (present(lMask)) then do j=jb,je @@ -1898,8 +1907,8 @@ function global_minval_real (array, dist, lMask) & !----------------------------------------------------------------------- - localMinval = HUGE(0.0_real_kind) - globalMinval = HUGE(0.0_real_kind) + localMinval = bigreal + globalMinval = bigreal call ice_distributionGet(dist, & numLocalBlocks = numBlocks, & @@ -1916,7 +1925,7 @@ function global_minval_real (array, dist, lMask) & jb = this_block%jlo je = this_block%jhi - blockMinval = HUGE(0.0_real_kind) + blockMinval = bigreal if (present(lMask)) then do j=jb,je @@ -2005,8 +2014,8 @@ function global_minval_int (array, dist, lMask) & !----------------------------------------------------------------------- - localMinval = HUGE(0_int_kind) - globalMinval = HUGE(0_int_kind) + localMinval = bigint + globalMinval = bigint call ice_distributionGet(dist, & numLocalBlocks = numBlocks, & @@ -2023,7 +2032,7 @@ function global_minval_int (array, dist, lMask) & jb = this_block%jlo je = this_block%jhi - blockMinval = HUGE(0_int_kind) + blockMinval = bigint if (present(lMask)) then do j=jb,je diff --git a/cicecore/cicedyn/infrastructure/comm/serial/ice_global_reductions.F90 b/cicecore/cicedyn/infrastructure/comm/serial/ice_global_reductions.F90 index ed36cc6c0..e4eb95b56 100644 --- a/cicecore/cicedyn/infrastructure/comm/serial/ice_global_reductions.F90 +++ b/cicecore/cicedyn/infrastructure/comm/serial/ice_global_reductions.F90 @@ -41,6 +41,15 @@ module ice_global_reductions global_maxval, & global_minval + real (kind=dbl_kind), parameter :: & + bigdbl = 1.0e36_dbl_kind + + real (kind=real_kind), parameter :: & + bigreal = 1.0e36_real_kind + + real (kind=int_kind), parameter :: & + bigint = 9999999 + !----------------------------------------------------------------------- ! ! generic interfaces for module procedures @@ -1247,8 +1256,8 @@ function global_maxval_dbl (array, dist, lMask) & !----------------------------------------------------------------------- - localMaxval = -HUGE(0.0_dbl_kind) - globalMaxval = -HUGE(0.0_dbl_kind) + localMaxval = -bigdbl + globalMaxval = -bigdbl call ice_distributionGet(dist, & numLocalBlocks = numBlocks, & @@ -1265,7 +1274,7 @@ function global_maxval_dbl (array, dist, lMask) & jb = this_block%jlo je = this_block%jhi - blockMaxval = -HUGE(0.0_dbl_kind) + blockMaxval = -bigdbl if (present(lMask)) then do j=jb,je @@ -1354,8 +1363,8 @@ function global_maxval_real (array, dist, lMask) & !----------------------------------------------------------------------- - localMaxval = -HUGE(0.0_real_kind) - globalMaxval = -HUGE(0.0_real_kind) + localMaxval = -bigreal + globalMaxval = -bigreal call ice_distributionGet(dist, & numLocalBlocks = numBlocks, & @@ -1372,7 +1381,7 @@ function global_maxval_real (array, dist, lMask) & jb = this_block%jlo je = this_block%jhi - blockMaxval = -HUGE(0.0_real_kind) + blockMaxval = -bigreal if (present(lMask)) then do j=jb,je @@ -1461,8 +1470,8 @@ function global_maxval_int (array, dist, lMask) & !----------------------------------------------------------------------- - localMaxval = -HUGE(0_int_kind) - globalMaxval = -HUGE(0_int_kind) + localMaxval = -bigint + globalMaxval = -bigint call ice_distributionGet(dist, & numLocalBlocks = numBlocks, & @@ -1479,7 +1488,7 @@ function global_maxval_int (array, dist, lMask) & jb = this_block%jlo je = this_block%jhi - blockMaxval = -HUGE(0_int_kind) + blockMaxval = -bigint if (present(lMask)) then do j=jb,je @@ -1792,8 +1801,8 @@ function global_minval_dbl (array, dist, lMask) & !----------------------------------------------------------------------- - localMinval = HUGE(0.0_dbl_kind) - globalMinval = HUGE(0.0_dbl_kind) + localMinval = bigdbl + globalMinval = bigdbl call ice_distributionGet(dist, & numLocalBlocks = numBlocks, & @@ -1810,7 +1819,7 @@ function global_minval_dbl (array, dist, lMask) & jb = this_block%jlo je = this_block%jhi - blockMinval = HUGE(0.0_dbl_kind) + blockMinval = bigdbl if (present(lMask)) then do j=jb,je @@ -1899,8 +1908,8 @@ function global_minval_real (array, dist, lMask) & !----------------------------------------------------------------------- - localMinval = HUGE(0.0_real_kind) - globalMinval = HUGE(0.0_real_kind) + localMinval = bigreal + globalMinval = bigreal call ice_distributionGet(dist, & numLocalBlocks = numBlocks, & @@ -1917,7 +1926,7 @@ function global_minval_real (array, dist, lMask) & jb = this_block%jlo je = this_block%jhi - blockMinval = HUGE(0.0_real_kind) + blockMinval = bigreal if (present(lMask)) then do j=jb,je @@ -2006,8 +2015,8 @@ function global_minval_int (array, dist, lMask) & !----------------------------------------------------------------------- - localMinval = HUGE(0_int_kind) - globalMinval = HUGE(0_int_kind) + localMinval = bigint + globalMinval = bigint call ice_distributionGet(dist, & numLocalBlocks = numBlocks, & @@ -2024,7 +2033,7 @@ function global_minval_int (array, dist, lMask) & jb = this_block%jlo je = this_block%jhi - blockMinval = HUGE(0_int_kind) + blockMinval = bigint if (present(lMask)) then do j=jb,je diff --git a/cicecore/cicedyn/infrastructure/ice_blocks.F90 b/cicecore/cicedyn/infrastructure/ice_blocks.F90 index fb7483914..ccaf23999 100644 --- a/cicecore/cicedyn/infrastructure/ice_blocks.F90 +++ b/cicecore/cicedyn/infrastructure/ice_blocks.F90 @@ -173,7 +173,7 @@ subroutine create_blocks(nx_global, ny_global, ew_boundary_type, & do jblock=1,nblocks_y js = (jblock-1)*block_size_y + 1 if (js > ny_global) call abort_ice(subname// & - 'ERROR: Bad block decomp: ny_block too large?') + ' ERROR: Bad block decomp: ny_block too large?') je = js + block_size_y - 1 if (je > ny_global) je = ny_global ! pad array @@ -182,7 +182,7 @@ subroutine create_blocks(nx_global, ny_global, ew_boundary_type, & is = (iblock-1)*block_size_x + 1 if (is > nx_global) call abort_ice(subname// & - 'ERROR: Bad block decomp: nx_block too large?') + ' ERROR: Bad block decomp: nx_block too large?') ie = is + block_size_x - 1 if (ie > nx_global) ie = nx_global @@ -223,7 +223,7 @@ subroutine create_blocks(nx_global, ny_global, ew_boundary_type, & case ('tripoleT') j_global(j,n) = -j_global(j,n) + 1 ! open case default - call abort_ice(subname//'ERROR: unknown n-s bndy type') + call abort_ice(subname//' ERROR: unknown n-s bndy type') end select endif @@ -247,7 +247,7 @@ subroutine create_blocks(nx_global, ny_global, ew_boundary_type, & case ('tripoleT') j_global(j,n) = -j_global(j,n) case default - call abort_ice(subname//'ERROR: unknown n-s bndy type') + call abort_ice(subname//' ERROR: unknown n-s bndy type') end select !*** set last physical point if padded domain @@ -275,7 +275,7 @@ subroutine create_blocks(nx_global, ny_global, ew_boundary_type, & case ('closed') i_global(i,n) = 0 case default - call abort_ice(subname//'ERROR: unknown e-w bndy type') + call abort_ice(subname//' ERROR: unknown e-w bndy type') end select endif @@ -295,7 +295,7 @@ subroutine create_blocks(nx_global, ny_global, ew_boundary_type, & case ('closed') i_global(i,n) = 0 case default - call abort_ice(subname//'ERROR: unknown e-w bndy type') + call abort_ice(subname//' ERROR: unknown e-w bndy type') end select !*** last physical point in padded domain @@ -427,7 +427,7 @@ function ice_blocksGetNbrID(blockID, direction, iBoundary, jBoundary) & inbr = nblocks_x - iBlock + 1 jnbr = -jBlock case default - call abort_ice(subname//'ERROR: unknown north boundary') + call abort_ice(subname//' ERROR: unknown north boundary') end select endif @@ -448,7 +448,7 @@ function ice_blocksGetNbrID(blockID, direction, iBoundary, jBoundary) & case ('tripoleT') jnbr = 0 ! do not write into the neighbor's ghost cells case default - call abort_ice(subname//'ERROR: unknown south boundary') + call abort_ice(subname//' ERROR: unknown south boundary') end select endif @@ -465,7 +465,7 @@ function ice_blocksGetNbrID(blockID, direction, iBoundary, jBoundary) & case ('cyclic') inbr = 1 case default - call abort_ice(subname//'ERROR: unknown east boundary') + call abort_ice(subname//' ERROR: unknown east boundary') end select endif @@ -482,7 +482,7 @@ function ice_blocksGetNbrID(blockID, direction, iBoundary, jBoundary) & case ('cyclic') inbr = nblocks_x case default - call abort_ice(subname//'ERROR: unknown west boundary') + call abort_ice(subname//' ERROR: unknown west boundary') end select endif @@ -499,7 +499,7 @@ function ice_blocksGetNbrID(blockID, direction, iBoundary, jBoundary) & case ('cyclic') inbr = 1 case default - call abort_ice(subname//'ERROR: unknown east boundary') + call abort_ice(subname//' ERROR: unknown east boundary') end select endif if (jnbr > nblocks_y) then @@ -521,7 +521,7 @@ function ice_blocksGetNbrID(blockID, direction, iBoundary, jBoundary) & if (inbr == 0) inbr = nblocks_x jnbr = -jBlock case default - call abort_ice(subname//'ERROR: unknown north boundary') + call abort_ice(subname//' ERROR: unknown north boundary') end select endif @@ -538,7 +538,7 @@ function ice_blocksGetNbrID(blockID, direction, iBoundary, jBoundary) & case ('cyclic') inbr = nblocks_x case default - call abort_ice(subname//'ERROR: unknown west boundary') + call abort_ice(subname//' ERROR: unknown west boundary') end select endif if (jnbr > nblocks_y) then @@ -560,7 +560,7 @@ function ice_blocksGetNbrID(blockID, direction, iBoundary, jBoundary) & if (inbr > nblocks_x) inbr = 1 jnbr = -jBlock case default - call abort_ice(subname//'ERROR: unknown north boundary') + call abort_ice(subname//' ERROR: unknown north boundary') end select endif @@ -577,7 +577,7 @@ function ice_blocksGetNbrID(blockID, direction, iBoundary, jBoundary) & case ('cyclic') inbr = 1 case default - call abort_ice(subname//'ERROR: unknown east boundary') + call abort_ice(subname//' ERROR: unknown east boundary') end select endif if (jnbr < 1) then @@ -593,7 +593,7 @@ function ice_blocksGetNbrID(blockID, direction, iBoundary, jBoundary) & case ('tripoleT') jnbr = 0 ! do not write into the neighbor's ghost cells case default - call abort_ice(subname//'ERROR: unknown south boundary') + call abort_ice(subname//' ERROR: unknown south boundary') end select endif @@ -609,7 +609,7 @@ function ice_blocksGetNbrID(blockID, direction, iBoundary, jBoundary) & case ('cyclic') inbr = nblocks_x case default - call abort_ice(subname//'ERROR: unknown west boundary') + call abort_ice(subname//' ERROR: unknown west boundary') end select endif if (jnbr < 1) then @@ -625,7 +625,7 @@ function ice_blocksGetNbrID(blockID, direction, iBoundary, jBoundary) & case ('tripoleT') jnbr = 0 ! do not write into the neighbor's ghost cells case default - call abort_ice(subname//'ERROR: unknown south boundary') + call abort_ice(subname//' ERROR: unknown south boundary') end select endif @@ -642,7 +642,7 @@ function ice_blocksGetNbrID(blockID, direction, iBoundary, jBoundary) & case ('cyclic') inbr = inbr - nblocks_x case default - call abort_ice(subname//'ERROR: unknown east boundary') + call abort_ice(subname//' ERROR: unknown east boundary') end select endif @@ -658,7 +658,7 @@ function ice_blocksGetNbrID(blockID, direction, iBoundary, jBoundary) & case ('cyclic') inbr = nblocks_x + inbr case default - call abort_ice(subname//'ERROR: unknown west boundary') + call abort_ice(subname//' ERROR: unknown west boundary') end select endif @@ -675,7 +675,7 @@ function ice_blocksGetNbrID(blockID, direction, iBoundary, jBoundary) & case ('cyclic') inbr = inbr - nblocks_x case default - call abort_ice(subname//'ERROR: unknown east boundary') + call abort_ice(subname//' ERROR: unknown east boundary') end select endif if (jnbr > nblocks_y) then @@ -697,7 +697,7 @@ function ice_blocksGetNbrID(blockID, direction, iBoundary, jBoundary) & if (inbr <= 0) inbr = inbr + nblocks_x jnbr = -jBlock case default - call abort_ice(subname//'ERROR: unknown north boundary') + call abort_ice(subname//' ERROR: unknown north boundary') end select endif @@ -714,7 +714,7 @@ function ice_blocksGetNbrID(blockID, direction, iBoundary, jBoundary) & case ('cyclic') inbr = nblocks_x + inbr case default - call abort_ice(subname//'ERROR: unknown west boundary') + call abort_ice(subname//' ERROR: unknown west boundary') end select endif if (jnbr > nblocks_y) then @@ -736,13 +736,13 @@ function ice_blocksGetNbrID(blockID, direction, iBoundary, jBoundary) & if (inbr > nblocks_x) inbr = inbr - nblocks_x jnbr = -jBlock case default - call abort_ice(subname//'ERROR: unknown north boundary') + call abort_ice(subname//' ERROR: unknown north boundary') end select endif case default - call abort_ice(subname//'ERROR: unknown direction') + call abort_ice(subname//' ERROR: unknown direction') return end select @@ -789,7 +789,7 @@ function get_block(block_id,local_id) !---------------------------------------------------------------------- if (block_id < 1 .or. block_id > nblocks_tot) then - call abort_ice(subname//'ERROR: invalid block_id') + call abort_ice(subname//' ERROR: invalid block_id') endif get_block = all_blocks(block_id) @@ -834,7 +834,7 @@ subroutine get_block_parameter(block_id, local_id, & !---------------------------------------------------------------------- if (block_id < 1 .or. block_id > nblocks_tot) then - call abort_ice(subname//'ERROR: invalid block_id') + call abort_ice(subname//' ERROR: invalid block_id') endif if (present(local_id)) local_id = all_blocks(block_id)%local_id diff --git a/cicecore/cicedyn/infrastructure/ice_domain.F90 b/cicecore/cicedyn/infrastructure/ice_domain.F90 index 06d0d8ae1..8b680f2d4 100644 --- a/cicecore/cicedyn/infrastructure/ice_domain.F90 +++ b/cicecore/cicedyn/infrastructure/ice_domain.F90 @@ -176,14 +176,13 @@ subroutine init_domain_blocks call get_fileunit(nu_nml) 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__) + call abort_ice(subname//' ERROR: domain_nml open file '// & + trim(nml_filename), file=__FILE__, line=__LINE__) endif call goto_nml(nu_nml,trim(nml_name),nml_error) if (nml_error /= 0) then - call abort_ice(subname//'ERROR: searching for '// trim(nml_name), & + call abort_ice(subname//' ERROR: searching for '// trim(nml_name), & file=__FILE__, line=__LINE__) endif @@ -195,7 +194,7 @@ subroutine init_domain_blocks ! backspace and re-read erroneous line backspace(nu_nml) read(nu_nml,fmt='(A)') tmpstr2 - call abort_ice(subname//'ERROR: ' // trim(nml_name) // ' reading ' // & + call abort_ice(subname//' ERROR: ' // trim(nml_name) // ' reading ' // & trim(tmpstr2), file=__FILE__, line=__LINE__) endif end do @@ -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 @@ -250,14 +249,14 @@ subroutine init_domain_blocks #if (defined CESMCOUPLED) 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') + 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', 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,14 @@ 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 +457,8 @@ 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,14 +488,27 @@ 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', & + call abort_ice(subname//' ERROR: USE_NETCDF cpp not defined', & file=__FILE__, line=__LINE__) #endif endif @@ -581,11 +595,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 +715,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 +727,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 !---------------------------------------------------------------------- diff --git a/cicecore/cicedyn/infrastructure/ice_grid.F90 b/cicecore/cicedyn/infrastructure/ice_grid.F90 index ef2db8a11..c43b7989c 100644 --- a/cicecore/cicedyn/infrastructure/ice_grid.F90 +++ b/cicecore/cicedyn/infrastructure/ice_grid.F90 @@ -39,7 +39,7 @@ module ice_grid get_fileunit, release_fileunit, flush_fileunit use ice_gather_scatter, only: gather_global, scatter_global use ice_read_write, only: ice_read, ice_read_nc, ice_read_global, & - ice_read_global_nc, ice_open, ice_open_nc, ice_close_nc + ice_read_global_nc, ice_open, ice_open_nc, ice_close_nc, ice_check_nc use ice_timers, only: timer_bound, ice_timer_start, ice_timer_stop use ice_exit, only: abort_ice use ice_global_reductions, only: global_minval, global_maxval @@ -115,20 +115,6 @@ module ice_grid G_HTE , & ! length of eastern edge of T-cell (global ext.) G_HTN ! length of northern edge of T-cell (global ext.) - real (kind=dbl_kind), dimension (:,:,:), allocatable, public :: & - cyp , & ! 1.5*HTE(i,j)-0.5*HTW(i,j) = 1.5*HTE(i,j)-0.5*HTE(i-1,j) - cxp , & ! 1.5*HTN(i,j)-0.5*HTS(i,j) = 1.5*HTN(i,j)-0.5*HTN(i,j-1) - cym , & ! 0.5*HTE(i,j)-1.5*HTW(i,j) = 0.5*HTE(i,j)-1.5*HTE(i-1,j) - cxm , & ! 0.5*HTN(i,j)-1.5*HTS(i,j) = 0.5*HTN(i,j)-1.5*HTN(i,j-1) - dxhy , & ! 0.5*(HTE(i,j) - HTW(i,j)) = 0.5*(HTE(i,j) - HTE(i-1,j)) - dyhx ! 0.5*(HTN(i,j) - HTS(i,j)) = 0.5*(HTN(i,j) - HTN(i,j-1)) - - real (kind=dbl_kind), dimension (:,:,:), allocatable, public :: & - ratiodxN , & ! - dxN(i+1,j) / dxN(i,j) - ratiodyE , & ! - dyE(i ,j+1) / dyE(i,j) - ratiodxNr , & ! 1 / ratiodxN - ratiodyEr ! 1 / ratiodyE - ! grid dimensions for rectangular grid real (kind=dbl_kind), public :: & dxrect, & ! user_specified spacing (cm) in x-direction (uniform HTN) @@ -154,26 +140,6 @@ module ice_grid lone_bounds, & ! longitude of gridbox corners for E point late_bounds ! latitude of gridbox corners for E point - ! geometric quantities used for remapping transport - real (kind=dbl_kind), dimension (:,:,:), allocatable, public :: & - xav , & ! mean T-cell value of x - yav , & ! mean T-cell value of y - xxav , & ! mean T-cell value of xx -! xyav , & ! mean T-cell value of xy -! yyav , & ! mean T-cell value of yy - yyav ! mean T-cell value of yy -! xxxav, & ! mean T-cell value of xxx -! xxyav, & ! mean T-cell value of xxy -! xyyav, & ! mean T-cell value of xyy -! yyyav ! mean T-cell value of yyy - - real (kind=dbl_kind), & - dimension (:,:,:,:,:), allocatable, public :: & - mne, & ! matrices used for coordinate transformations in remapping - mnw, & ! ne = northeast corner, nw = northwest, etc. - mse, & - msw - ! masks real (kind=dbl_kind), dimension (:,:,:), allocatable, public :: & hm , & ! land/boundary mask, thickness (T-cell) @@ -256,19 +222,9 @@ subroutine alloc_grid ANGLET (nx_block,ny_block,max_blocks), & ! ANGLE converted to T-cells bathymetry(nx_block,ny_block,max_blocks),& ! ocean depth, for grounding keels and bergs (m) ocn_gridcell_frac(nx_block,ny_block,max_blocks),& ! only relevant for lat-lon grids - cyp (nx_block,ny_block,max_blocks), & ! 1.5*HTE - 0.5*HTW - cxp (nx_block,ny_block,max_blocks), & ! 1.5*HTN - 0.5*HTS - cym (nx_block,ny_block,max_blocks), & ! 0.5*HTE - 1.5*HTW - cxm (nx_block,ny_block,max_blocks), & ! 0.5*HTN - 1.5*HTS - dxhy (nx_block,ny_block,max_blocks), & ! 0.5*(HTE - HTW) - dyhx (nx_block,ny_block,max_blocks), & ! 0.5*(HTN - HTS) - xav (nx_block,ny_block,max_blocks), & ! mean T-cell value of x - yav (nx_block,ny_block,max_blocks), & ! mean T-cell value of y - xxav (nx_block,ny_block,max_blocks), & ! mean T-cell value of xx - yyav (nx_block,ny_block,max_blocks), & ! mean T-cell value of yy hm (nx_block,ny_block,max_blocks), & ! land/boundary mask, thickness (T-cell) bm (nx_block,ny_block,max_blocks), & ! task/block id - uvm (nx_block,ny_block,max_blocks), & ! land/boundary mask, velocity (U-cell) - water in case of all water point + uvm (nx_block,ny_block,max_blocks), & ! land/boundary mask, velocity (U-cell) npm (nx_block,ny_block,max_blocks), & ! land/boundary mask (N-cell) epm (nx_block,ny_block,max_blocks), & ! land/boundary mask (E-cell) kmt (nx_block,ny_block,max_blocks), & ! ocean topography mask for bathymetry (T-cell) @@ -288,22 +244,8 @@ subroutine alloc_grid latn_bounds(4,nx_block,ny_block,max_blocks), & ! latitude of gridbox corners for N point lone_bounds(4,nx_block,ny_block,max_blocks), & ! longitude of gridbox corners for E point late_bounds(4,nx_block,ny_block,max_blocks), & ! latitude of gridbox corners for E point - mne (2,2,nx_block,ny_block,max_blocks), & ! matrices used for coordinate transformations in remapping - mnw (2,2,nx_block,ny_block,max_blocks), & ! ne = northeast corner, nw = northwest, etc. - mse (2,2,nx_block,ny_block,max_blocks), & - msw (2,2,nx_block,ny_block,max_blocks), & stat=ierr) - if (ierr/=0) call abort_ice(subname//'ERROR: Out of memory1') - - if (grid_ice == 'CD' .or. grid_ice == 'C') then - allocate( & - ratiodxN (nx_block,ny_block,max_blocks), & - ratiodyE (nx_block,ny_block,max_blocks), & - ratiodxNr(nx_block,ny_block,max_blocks), & - ratiodyEr(nx_block,ny_block,max_blocks), & - stat=ierr) - if (ierr/=0) call abort_ice(subname//'ERROR: Out of memory2') - endif + if (ierr/=0) call abort_ice(subname//' ERROR: Out of memory1', file=__FILE__, line=__LINE__) if (save_ghte_ghtn) then if (my_task == master_task) then @@ -317,7 +259,7 @@ subroutine alloc_grid G_HTN(1,1), & ! never used in code stat=ierr) endif - if (ierr/=0) call abort_ice(subname//'ERROR: Out of memory3') + if (ierr/=0) call abort_ice(subname//' ERROR: Out of memory3', file=__FILE__, line=__LINE__) endif end subroutine alloc_grid @@ -335,7 +277,7 @@ subroutine dealloc_grid if (save_ghte_ghtn) then deallocate(G_HTE, G_HTN, stat=ierr) - if (ierr/=0) call abort_ice(subname//'ERROR: Dealloc error1') + if (ierr/=0) call abort_ice(subname//' ERROR: Dealloc error1', file=__FILE__, line=__LINE__) endif end subroutine dealloc_grid @@ -382,12 +324,12 @@ subroutine init_grid1 if (grid_type == 'tripole' .and. ns_boundary_type /= 'tripole' .and. & ns_boundary_type /= 'tripoleT') then - call abort_ice(subname//'ERROR: grid_type tripole needs tripole ns_boundary_type', & + call abort_ice(subname//' ERROR: grid_type tripole needs tripole ns_boundary_type', & file=__FILE__, line=__LINE__) endif if (grid_type == 'tripole' .and. (mod(nx_global,2)/=0)) then - call abort_ice(subname//'ERROR: grid_type tripole requires even nx_global number', & + call abort_ice(subname//' ERROR: grid_type tripole requires even nx_global number', & file=__FILE__, line=__LINE__) endif @@ -599,34 +541,6 @@ subroutine init_grid2 enddo enddo - do j = jlo, jhi - do i = ilo, ihi - dxhy(i,j,iblk) = p5*(HTE(i,j,iblk) - HTE(i-1,j,iblk)) - dyhx(i,j,iblk) = p5*(HTN(i,j,iblk) - HTN(i,j-1,iblk)) - enddo - enddo - - do j = jlo, jhi+1 - do i = ilo, ihi+1 - cyp(i,j,iblk) = (c1p5*HTE(i,j,iblk) - p5*HTE(i-1,j,iblk)) - cxp(i,j,iblk) = (c1p5*HTN(i,j,iblk) - p5*HTN(i,j-1,iblk)) - ! match order of operations in cyp, cxp for tripole grids - cym(i,j,iblk) = -(c1p5*HTE(i-1,j,iblk) - p5*HTE(i,j,iblk)) - cxm(i,j,iblk) = -(c1p5*HTN(i,j-1,iblk) - p5*HTN(i,j,iblk)) - enddo - enddo - - if (grid_ice == 'CD' .or. grid_ice == 'C') then - do j = jlo, jhi - do i = ilo, ihi - ratiodxN (i,j,iblk) = - dxN(i+1,j ,iblk) / dxN(i,j,iblk) - ratiodyE (i,j,iblk) = - dyE(i ,j+1,iblk) / dyE(i,j,iblk) - ratiodxNr(i,j,iblk) = c1 / ratiodxN(i,j,iblk) - ratiodyEr(i,j,iblk) = c1 / ratiodyE(i,j,iblk) - enddo - enddo - endif - enddo ! iblk !$OMP END PARALLEL DO @@ -642,13 +556,6 @@ subroutine init_grid2 call ice_timer_start(timer_bound) - call ice_HaloUpdate (dxhy, halo_info, & - field_loc_center, field_type_vector, & - fillValue=c1) - call ice_HaloUpdate (dyhx, halo_info, & - field_loc_center, field_type_vector, & - fillValue=c1) - ! Update just on the tripole seam to ensure bit-for-bit symmetry across seam call ice_HaloUpdate (tarea, halo_info, & field_loc_center, field_type_scalar, & @@ -769,7 +676,7 @@ subroutine init_grid2 elseif (trim(bathymetry_format) == 'pop') then call get_bathymetry_popfile else - call abort_ice(subname//'ERROR: bathymetry_format value must be default or pop', & + call abort_ice(subname//' ERROR: bathymetry_format value must be default or pop', & file=__FILE__, line=__LINE__) endif @@ -1084,7 +991,7 @@ subroutine popgrid_nc call ice_close_nc(fid_kmt) endif #else - call abort_ice(subname//'ERROR: USE_NETCDF cpp not defined', & + call abort_ice(subname//' ERROR: USE_NETCDF cpp not defined', & file=__FILE__, line=__LINE__) #endif @@ -1164,9 +1071,13 @@ subroutine latlongrid call ice_open_nc(kmt_file, ncid) status = nf90_inq_dimid (ncid, 'ni', dimid) + call ice_check_nc(status, subname//' ERROR: inq_dimid ni', file=__FILE__, line=__LINE__) status = nf90_inquire_dimension(ncid, dimid, len=ni) + call ice_check_nc(status, subname//' ERROR: inq dim ni', file=__FILE__, line=__LINE__) status = nf90_inq_dimid (ncid, 'nj', dimid) + call ice_check_nc(status, subname//' ERROR: inq_dimid nj', file=__FILE__, line=__LINE__) status = nf90_inquire_dimension(ncid, dimid, len=nj) + call ice_check_nc(status, subname//' ERROR: inq dim nj', file=__FILE__, line=__LINE__) end if ! Determine start/count to read in for either single column or global lat-lon grid @@ -1179,7 +1090,7 @@ subroutine latlongrid write(nu_diag,*) 'Because you have selected the column model flag' write(nu_diag,*) 'Please set nx_global=ny_global=1 in file' write(nu_diag,*) 'ice_domain_size.F and recompile' - call abort_ice (subname//'ERROR: check nx_global, ny_global') + call abort_ice (subname//' ERROR: check nx_global, ny_global', file=__FILE__, line=__LINE__) endif end if @@ -1192,17 +1103,17 @@ subroutine latlongrid start3=(/1,1,1/) count3=(/ni,nj,1/) status = nf90_inq_varid(ncid, 'xc' , varid) - if (status /= nf90_noerr) call abort_ice (subname//' inq_varid xc') + call ice_check_nc(status, subname//' ERROR: inq_varid xc', file=__FILE__, line=__LINE__) status = nf90_get_var(ncid, varid, glob_grid, start3, count3) - if (status /= nf90_noerr) call abort_ice (subname//' get_var xc') + call ice_check_nc(status, subname//' ERROR: get_var xc', file=__FILE__, line=__LINE__) do i = 1,ni lons(i) = glob_grid(i,1) end do status = nf90_inq_varid(ncid, 'yc' , varid) - if (status /= nf90_noerr) call abort_ice (subname//' inq_varid yc') + call ice_check_nc(status, subname//' ERROR: inq_varid yc', file=__FILE__, line=__LINE__) status = nf90_get_var(ncid, varid, glob_grid, start3, count3) - if (status /= nf90_noerr) call abort_ice (subname//' get_var yc') + call ice_check_nc(status, subname//' ERROR: get_var yc', file=__FILE__, line=__LINE__) do j = 1,nj lats(j) = glob_grid(1,j) end do @@ -1221,29 +1132,29 @@ subroutine latlongrid deallocate(glob_grid) status = nf90_inq_varid(ncid, 'xc' , varid) - if (status /= nf90_noerr) call abort_ice (subname//' inq_varid xc') + call ice_check_nc(status, subname//' ERROR: inq_varid xc', file=__FILE__, line=__LINE__) status = nf90_get_var(ncid, varid, scamdata, start) - if (status /= nf90_noerr) call abort_ice (subname//' get_var xc') + call ice_check_nc(status, subname//' ERROR: get_var xc', file=__FILE__, line=__LINE__) TLON = scamdata status = nf90_inq_varid(ncid, 'yc' , varid) - if (status /= nf90_noerr) call abort_ice (subname//' inq_varid yc') + call ice_check_nc(status, subname//' ERROR: inq_varid yc', file=__FILE__, line=__LINE__) status = nf90_get_var(ncid, varid, scamdata, start) - if (status /= nf90_noerr) call abort_ice (subname//' get_var yc') + call ice_check_nc(status, subname//' ERROR: get_var yc', file=__FILE__, line=__LINE__) TLAT = scamdata status = nf90_inq_varid(ncid, 'area' , varid) - if (status /= nf90_noerr) call abort_ice (subname//' inq_varid area') + call ice_check_nc(status, subname//' ERROR: inq_varid area', file=__FILE__, line=__LINE__) status = nf90_get_var(ncid, varid, scamdata, start) - if (status /= nf90_noerr) call abort_ice (subname//' get_var are') + call ice_check_nc(status, subname//' ERROR: get_var are', file=__FILE__, line=__LINE__) tarea = scamdata status = nf90_inq_varid(ncid, 'mask' , varid) - if (status /= nf90_noerr) call abort_ice (subname//' inq_varid mask') + call ice_check_nc(status, subname//' ERROR: inq_varid mask', file=__FILE__, line=__LINE__) status = nf90_get_var(ncid, varid, scamdata, start) - if (status /= nf90_noerr) call abort_ice (subname//' get_var mask') + call ice_check_nc(status, subname//' ERROR: get_var mask', file=__FILE__, line=__LINE__) hm = scamdata status = nf90_inq_varid(ncid, 'frac' , varid) - if (status /= nf90_noerr) call abort_ice (subname//' inq_varid frac') + call ice_check_nc(status, subname//' ERROR: inq_varid frac', file=__FILE__, line=__LINE__) status = nf90_get_var(ncid, varid, scamdata, start) - if (status /= nf90_noerr) call abort_ice (subname//' get_var frac') + call ice_check_nc(status, subname//' ERROR: get_var frac', file=__FILE__, line=__LINE__) ocn_gridcell_frac = scamdata else ! Check for consistency @@ -1251,7 +1162,8 @@ subroutine latlongrid if (nx_global /= ni .and. ny_global /= nj) then write(nu_diag,*) 'latlongrid: ni,nj = ',ni,nj write(nu_diag,*) 'latlongrid: nx_g,ny_g = ',nx_global, ny_global - call abort_ice (subname//'ERROR: ni,nj not equal to nx_global,ny_global') + call abort_ice (subname//' ERROR: ni,nj not equal to nx_global,ny_global', & + file=__FILE__, line=__LINE__) end if end if @@ -1353,12 +1265,6 @@ subroutine latlongrid dyN (i,j,iblk) = 1.e36_dbl_kind dxE (i,j,iblk) = 1.e36_dbl_kind dyE (i,j,iblk) = 1.e36_dbl_kind - dxhy (i,j,iblk) = 1.e36_dbl_kind - dyhx (i,j,iblk) = 1.e36_dbl_kind - cyp (i,j,iblk) = 1.e36_dbl_kind - cxp (i,j,iblk) = 1.e36_dbl_kind - cym (i,j,iblk) = 1.e36_dbl_kind - cxm (i,j,iblk) = 1.e36_dbl_kind enddo enddo enddo @@ -1366,7 +1272,7 @@ subroutine latlongrid call makemask #else - call abort_ice(subname//'ERROR: USE_NETCDF cpp not defined', & + call abort_ice(subname//' ERROR: USE_NETCDF cpp not defined', & file=__FILE__, line=__LINE__) #endif @@ -1549,7 +1455,8 @@ subroutine rectgrid else - call abort_ice(subname//'ERROR: unknown kmt_type '//trim(kmt_type)) + call abort_ice(subname//' ERROR: unknown kmt_type '//trim(kmt_type), & + file=__FILE__, line=__LINE__) endif ! kmt_type @@ -1751,7 +1658,8 @@ subroutine grid_boxislands_kmt (work) nyb = int(real(ny_global, dbl_kind) / c20, int_kind) if (nxb < 1 .or. nyb < 1) & - call abort_ice(subname//'ERROR: requires larger grid size') + call abort_ice(subname//' ERROR: requires larger grid size', & + file=__FILE__, line=__LINE__) ! initialize work area as all ocean (c1). work(:,:) = c1 @@ -2816,7 +2724,7 @@ subroutine grid_average_X2Y_NEversion(type,work1a,grid1a,work1b,grid1b,work2,gri call grid_average_X2Y_2('NE2TA',work1b,narea,npm,work1a,earea,epm,work2) case default - call abort_ice(subname//'ERROR: unknown X2Y '//trim(X2Y)) + call abort_ice(subname//' ERROR: unknown X2Y '//trim(X2Y), file=__FILE__, line=__LINE__) end select end subroutine grid_average_X2Y_NEversion @@ -2925,7 +2833,7 @@ subroutine grid_average_X2Y_1(X2Y,work1,work2) call grid_average_X2YA('SE',work1,narea,work2) case default - call abort_ice(subname//'ERROR: unknown X2Y '//trim(X2Y)) + call abort_ice(subname//' ERROR: unknown X2Y '//trim(X2Y), file=__FILE__, line=__LINE__) end select end subroutine grid_average_X2Y_1 @@ -3037,7 +2945,7 @@ subroutine grid_average_X2Y_1f(X2Y,work1,wght1,mask1,work2) call grid_average_X2YA('SE',work1,wght1,work2) case default - call abort_ice(subname//'ERROR: unknown X2Y '//trim(X2Y)) + call abort_ice(subname//' ERROR: unknown X2Y '//trim(X2Y), file=__FILE__, line=__LINE__) end select end subroutine grid_average_X2Y_1f @@ -3266,7 +3174,7 @@ subroutine grid_average_X2YS(dir,work1,wght1,mask1,work2) !$OMP END PARALLEL DO case default - call abort_ice(subname//'ERROR: unknown option '//trim(dir)) + call abort_ice(subname//' ERROR: unknown option '//trim(dir), file=__FILE__, line=__LINE__) end select end subroutine grid_average_X2YS @@ -3494,7 +3402,7 @@ subroutine grid_average_X2YA(dir,work1,wght1,work2) !$OMP END PARALLEL DO case default - call abort_ice(subname//'ERROR: unknown option '//trim(dir)) + call abort_ice(subname//' ERROR: unknown option '//trim(dir), file=__FILE__, line=__LINE__) end select end subroutine grid_average_X2YA @@ -3696,7 +3604,7 @@ subroutine grid_average_X2YF(dir,work1,wght1,work2,wght2) !$OMP END PARALLEL DO case default - call abort_ice(subname//'ERROR: unknown option '//trim(dir)) + call abort_ice(subname//' ERROR: unknown option '//trim(dir), file=__FILE__, line=__LINE__) end select end subroutine grid_average_X2YF @@ -3841,7 +3749,7 @@ subroutine grid_average_X2Y_2(dir,work1a,wght1a,mask1a,work1b,wght1b,mask1b,work !$OMP END PARALLEL DO case default - call abort_ice(subname//'ERROR: unknown option '//trim(dir)) + call abort_ice(subname//' ERROR: unknown option '//trim(dir), file=__FILE__, line=__LINE__) end select end subroutine grid_average_X2Y_2 @@ -3871,7 +3779,7 @@ real(kind=dbl_kind) function grid_neighbor_min(field, i, j, grid_location) resul case('N') mini = min(field(i,j), field(i,j+1)) case default - call abort_ice(subname // ' unknown grid_location: ' // grid_location) + call abort_ice(subname // ' unknown grid_location: ' // grid_location, file=__FILE__, line=__LINE__) end select end function grid_neighbor_min @@ -3902,7 +3810,7 @@ real(kind=dbl_kind) function grid_neighbor_max(field, i, j, grid_location) resul case('N') maxi = max(field(i,j), field(i,j+1)) case default - call abort_ice(subname // ' unknown grid_location: ' // grid_location) + call abort_ice(subname // ' unknown grid_location: ' // grid_location, file=__FILE__, line=__LINE__) end select end function grid_neighbor_max @@ -4577,7 +4485,8 @@ subroutine get_bathymetry do j = 1, ny_block do i = 1, nx_block k = min(nint(kmt(i,j,iblk)),nlevel) - if (k > nlevel) call abort_ice(subname//' kmt gt nlevel error') + if (k > nlevel) call abort_ice(subname//' kmt gt nlevel error', & + file=__FILE__, line=__LINE__) if (k > 0) bathymetry(i,j,iblk) = depth(k) enddo enddo @@ -4636,10 +4545,10 @@ subroutine get_bathymetry_popfile if (my_task == master_task) then call get_fileunit(fid) open(fid,file=bathymetry_file,form='formatted',iostat=ierr) - if (ierr/=0) call abort_ice(subname//' open error') + if (ierr/=0) call abort_ice(subname//' open error', file=__FILE__, line=__LINE__) do k = 1,nlevel read(fid,*,iostat=ierr) thick(k) - if (ierr/=0) call abort_ice(subname//' read error') + if (ierr/=0) call abort_ice(subname//' read error', file=__FILE__, line=__LINE__) enddo call release_fileunit(fid) endif @@ -4666,7 +4575,7 @@ subroutine get_bathymetry_popfile depth(1) = thick(1) do k = 2, nlevel depth(k) = depth(k-1) + thick(k) - if (depth(k) < 0.) call abort_ice(subname//' negative depth error') + if (depth(k) < 0.) call abort_ice(subname//' negative depth error', file=__FILE__, line=__LINE__) enddo if (my_task==master_task) then @@ -4680,7 +4589,7 @@ subroutine get_bathymetry_popfile do j = 1, ny_block do i = 1, nx_block k = nint(kmt(i,j,iblk)) - if (k > nlevel) call abort_ice(subname//' kmt gt nlevel error') + if (k > nlevel) call abort_ice(subname//' kmt gt nlevel error', file=__FILE__, line=__LINE__) if (k > 0) bathymetry(i,j,iblk) = depth(k) enddo enddo diff --git a/cicecore/cicedyn/infrastructure/ice_memusage.F90 b/cicecore/cicedyn/infrastructure/ice_memusage.F90 index 8dca4e621..323a9074e 100644 --- a/cicecore/cicedyn/infrastructure/ice_memusage.F90 +++ b/cicecore/cicedyn/infrastructure/ice_memusage.F90 @@ -74,7 +74,8 @@ subroutine ice_memusage_init(iunit) write(iunit,'(A,l4)') subname//' Initset conversion flag is ',initset write(iunit,'(A,f16.2)') subname//' 8 MB memory alloc in MB is ',(mrss1-mrss0)*mb_blk write(iunit,'(A,f16.2)') subname//' 8 MB memory dealloc in MB is ',(mrss1-mrss2)*mb_blk - write(iunit,'(A,f16.2)') subname//' Memory block size conversion in bytes is ',mb_blk*1024_dbl_kind*1024.0_dbl_kind + write(iunit,'(A,f16.2)') subname//' Memory block size conversion in bytes is ', & + mb_blk*1024_dbl_kind*1024.0_dbl_kind endif end subroutine ice_memusage_init diff --git a/cicecore/cicedyn/infrastructure/ice_read_write.F90 b/cicecore/cicedyn/infrastructure/ice_read_write.F90 index 041f3516b..4613843b5 100644 --- a/cicecore/cicedyn/infrastructure/ice_read_write.F90 +++ b/cicecore/cicedyn/infrastructure/ice_read_write.F90 @@ -33,8 +33,8 @@ module ice_read_write private integer (kind=int_kind), parameter, private :: & - bits_per_byte = 8 ! number of bits per byte. - ! used to determine RecSize in ice_open + bits_per_byte = 8 ! number of bits per byte. + ! used to determine RecSize in ice_open public :: ice_open, & ice_open_ext, & @@ -51,32 +51,33 @@ module ice_read_write ice_write_ext, & ice_read_vec_nc, & ice_get_ncvarsize, & + ice_check_nc, & ice_close_nc interface ice_write - module procedure ice_write_xyt, & - ice_write_xyzt + module procedure ice_write_xyt, & + ice_write_xyzt end interface interface ice_read - module procedure ice_read_xyt, & - ice_read_xyzt + module procedure ice_read_xyt, & + ice_read_xyzt end interface interface ice_read_nc - module procedure ice_read_nc_xy, & - ice_read_nc_xyz, & - !ice_read_nc_xyf, & - ice_read_nc_point, & - ice_read_nc_1D, & - ice_read_nc_2D, & - ice_read_nc_3D, & - ice_read_nc_z + module procedure ice_read_nc_xy, & + ice_read_nc_xyz, & + !ice_read_nc_xyf, & + ice_read_nc_point, & + ice_read_nc_1D, & + ice_read_nc_2D, & + ice_read_nc_3D, & + ice_read_nc_z end interface interface ice_write_nc - module procedure ice_write_nc_xy, & - ice_write_nc_xyz + module procedure ice_write_nc_xy, & + ice_write_nc_xyz end interface !======================================================================= @@ -93,8 +94,8 @@ module ice_read_write subroutine ice_open(nu, filename, nbits, algn) integer (kind=int_kind), intent(in) :: & - nu , & ! unit number - nbits ! no. of bits per variable (0 for sequential access) + nu , & ! unit number + nbits ! no. of bits per variable (0 for sequential access) integer (kind=int_kind), intent(in), optional :: algn integer (kind=int_kind) :: RecSize, Remnant, nbytes @@ -146,15 +147,15 @@ end subroutine ice_open subroutine ice_open_ext(nu, filename, nbits) integer (kind=int_kind), intent(in) :: & - nu , & ! unit number - nbits ! no. of bits per variable (0 for sequential access) + nu , & ! unit number + nbits ! no. of bits per variable (0 for sequential access) integer (kind=int_kind) :: RecSize, nbytes character (*) :: filename integer (kind=int_kind) :: & - nx, ny ! grid dimensions including ghost cells + nx, ny ! grid dimensions including ghost cells character(len=*), parameter :: subname = '(ice_open_ext)' @@ -200,22 +201,22 @@ subroutine ice_read_xyt(nu, nrec, work, atype, diag, & use ice_gather_scatter, only: scatter_global integer (kind=int_kind), intent(in) :: & - nu , & ! unit number - nrec ! record number (0 for sequential access) + nu , & ! unit number + nrec ! record number (0 for sequential access) real (kind=dbl_kind), dimension(nx_block,ny_block,max_blocks), intent(out) :: & - work ! output array (real, 8-byte) + work ! output array (real, 8-byte) character (len=4), intent(in) :: & - atype ! format for input array - ! (real/integer, 4-byte/8-byte) + atype ! format for input array + ! (real/integer, 4-byte/8-byte) logical (kind=log_kind), intent(in) :: & - diag ! if true, write diagnostic output + diag ! if true, write diagnostic output integer (kind=int_kind), optional, intent(in) :: & - field_loc, & ! location of field on staggered grid - field_type ! type of field (scalar, vector, angle) + field_loc, & ! location of field on staggered grid + field_type ! type of field (scalar, vector, angle) logical (kind=log_kind), optional, intent(in) :: ignore_eof logical (kind=log_kind), optional, intent(out) :: hit_eof @@ -225,7 +226,7 @@ subroutine ice_read_xyt(nu, nrec, work, atype, diag, & integer (kind=int_kind) :: i, j, ios real (kind=dbl_kind) :: & - amin, amax, asum ! min, max values and sum of input array + amin, amax, asum ! min, max values and sum of input array logical (kind=log_kind) :: ignore_eof_use @@ -251,9 +252,10 @@ subroutine ice_read_xyt(nu, nrec, work, atype, diag, & if (my_task == master_task) then - !------------------------------------------------------------------- - ! Read global array according to format atype - !------------------------------------------------------------------- + !------------------------------------------------------------------- + ! Read global array according to format atype + !------------------------------------------------------------------- + if (present(hit_eof)) hit_eof = .false. if (atype == 'ida4') then @@ -280,7 +282,7 @@ subroutine ice_read_xyt(nu, nrec, work, atype, diag, & ignore_eof_use = .false. endif if (ignore_eof_use) then - ! Read line from file, checking for end-of-file + ! Read line from file, checking for end-of-file read(nu, iostat=ios) ((work_g1(i,j),i=1,nx_global), & j=1,ny_global) if (present(hit_eof)) hit_eof = ios < 0 @@ -300,9 +302,10 @@ subroutine ice_read_xyt(nu, nrec, work, atype, diag, & endif endif - !------------------------------------------------------------------- - ! optional diagnostics - !------------------------------------------------------------------- + !------------------------------------------------------------------- + ! optional diagnostics + !------------------------------------------------------------------- + if (my_task==master_task .and. diag) then amin = minval(work_g1) amax = maxval(work_g1, mask = work_g1 /= spval_dbl) @@ -310,10 +313,10 @@ subroutine ice_read_xyt(nu, nrec, work, atype, diag, & write(nu_diag,*) subname,' read_global ',nu, nrec, amin, amax, asum endif - !------------------------------------------------------------------- - ! Scatter data to individual processors. - ! NOTE: Ghost cells are not updated unless field_loc is present. - !------------------------------------------------------------------- + !------------------------------------------------------------------- + ! Scatter data to individual processors. + ! NOTE: Ghost cells are not updated unless field_loc is present. + !------------------------------------------------------------------- if (present(field_loc)) then call scatter_global(work, work_g1, master_task, distrb_info, & @@ -345,22 +348,22 @@ subroutine ice_read_xyzt(nu, nrec, work, atype, diag, & use ice_domain_size, only: nblyr integer (kind=int_kind), intent(in) :: & - nu , & ! unit number - nrec ! record number (0 for sequential access) + nu , & ! unit number + nrec ! record number (0 for sequential access) real (kind=dbl_kind), dimension(nx_block,ny_block,nblyr+2,max_blocks), intent(out) :: & - work ! output array (real, 8-byte) + work ! output array (real, 8-byte) character (len=4), intent(in) :: & - atype ! format for input array - ! (real/integer, 4-byte/8-byte) + atype ! format for input array + ! (real/integer, 4-byte/8-byte) logical (kind=log_kind), intent(in) :: & - diag ! if true, write diagnostic output + diag ! if true, write diagnostic output integer (kind=int_kind), optional, intent(in) :: & - field_loc, & ! location of field on staggered grid - field_type ! type of field (scalar, vector, angle) + field_loc, & ! location of field on staggered grid + field_type ! type of field (scalar, vector, angle) logical (kind=log_kind), optional, intent(in) :: ignore_eof logical (kind=log_kind), optional, intent(out) :: hit_eof @@ -370,7 +373,7 @@ subroutine ice_read_xyzt(nu, nrec, work, atype, diag, & integer (kind=int_kind) :: i, j, k, ios real (kind=dbl_kind) :: & - amin, amax, asum ! min, max values and sum of input array + amin, amax, asum ! min, max values and sum of input array logical (kind=log_kind) :: ignore_eof_use @@ -397,9 +400,10 @@ subroutine ice_read_xyzt(nu, nrec, work, atype, diag, & if (my_task == master_task) then - !------------------------------------------------------------------- - ! Read global array according to format atype - !------------------------------------------------------------------- + !------------------------------------------------------------------- + ! Read global array according to format atype + !------------------------------------------------------------------- + if (present(hit_eof)) hit_eof = .false. if (atype == 'ida4') then @@ -426,7 +430,7 @@ subroutine ice_read_xyzt(nu, nrec, work, atype, diag, & ignore_eof_use = .false. endif if (ignore_eof_use) then - ! Read line from file, checking for end-of-file + ! Read line from file, checking for end-of-file read(nu, iostat=ios) (((work_g4(i,j,k),i=1,nx_global), & j=1,ny_global), & k=1,nblyr+2) @@ -448,9 +452,10 @@ subroutine ice_read_xyzt(nu, nrec, work, atype, diag, & endif endif - !------------------------------------------------------------------- - ! optional diagnostics - !------------------------------------------------------------------- + !------------------------------------------------------------------- + ! optional diagnostics + !------------------------------------------------------------------- + if (my_task==master_task .and. diag) then amin = minval(work_g4) amax = maxval(work_g4, mask = work_g4 /= spval_dbl) @@ -458,27 +463,27 @@ subroutine ice_read_xyzt(nu, nrec, work, atype, diag, & write(nu_diag,*) subname,' read_global ',nu, nrec, amin, amax, asum endif - !------------------------------------------------------------------- - ! Scatter data to individual processors. - ! NOTE: Ghost cells are not updated unless field_loc is present. - !------------------------------------------------------------------- + !------------------------------------------------------------------- + ! Scatter data to individual processors. + ! NOTE: Ghost cells are not updated unless field_loc is present. + !------------------------------------------------------------------- - do k = 1, nblyr+2 + do k = 1, nblyr+2 - if (present(field_loc)) then - call scatter_global(work(:,:,k,:), work_g4(:,:,k), master_task, distrb_info, & - field_loc, field_type) + if (present(field_loc)) then + call scatter_global(work(:,:,k,:), work_g4(:,:,k), master_task, distrb_info, & + field_loc, field_type) - else + else - call scatter_global(work(:,:,k,:), work_g4(:,:,k), master_task, distrb_info, & - field_loc_noupdate, field_type_noupdate) - endif + call scatter_global(work(:,:,k,:), work_g4(:,:,k), master_task, distrb_info, & + field_loc_noupdate, field_type_noupdate) + endif - enddo !k - deallocate(work_g4) + enddo !k + deallocate(work_g4) - end subroutine ice_read_xyzt + end subroutine ice_read_xyzt !======================================================================= @@ -492,18 +497,18 @@ subroutine ice_read_global (nu, nrec, work_g, atype, diag, & ignore_eof, hit_eof) integer (kind=int_kind), intent(in) :: & - nu , & ! unit number - nrec ! record number (0 for sequential access) + nu , & ! unit number + nrec ! record number (0 for sequential access) real (kind=dbl_kind), dimension(nx_global,ny_global), intent(out) :: & - work_g ! output array (real, 8-byte) + work_g ! output array (real, 8-byte) character (len=4) :: & - atype ! format for input array - ! (real/integer, 4-byte/8-byte) + atype ! format for input array + ! (real/integer, 4-byte/8-byte) logical (kind=log_kind) :: & - diag ! if true, write diagnostic output + diag ! if true, write diagnostic output logical (kind=log_kind), optional, intent(in) :: ignore_eof logical (kind=log_kind), optional, intent(out) :: hit_eof @@ -513,7 +518,7 @@ subroutine ice_read_global (nu, nrec, work_g, atype, diag, & integer (kind=int_kind) :: i, j, ios real (kind=dbl_kind) :: & - amin, amax, asum ! min, max values and sum of input array + amin, amax, asum ! min, max values and sum of input array logical (kind=log_kind) :: ignore_eof_use @@ -532,9 +537,10 @@ subroutine ice_read_global (nu, nrec, work_g, atype, diag, & if (my_task == master_task) then - !------------------------------------------------------------------- - ! Read global array according to format atype - !------------------------------------------------------------------- + !------------------------------------------------------------------- + ! Read global array according to format atype + !------------------------------------------------------------------- + if (present(hit_eof)) hit_eof = .false. if (atype == 'ida4') then @@ -578,9 +584,10 @@ subroutine ice_read_global (nu, nrec, work_g, atype, diag, & if (hit_eof) return endif - !------------------------------------------------------------------- - ! optional diagnostics - !------------------------------------------------------------------- + !------------------------------------------------------------------- + ! optional diagnostics + !------------------------------------------------------------------- + if (my_task == master_task .and. diag) then amin = minval(work_g) amax = maxval(work_g, mask = work_g /= spval_dbl) @@ -602,18 +609,18 @@ subroutine ice_read_ext(nu, nrec, work, atype, diag, & use ice_gather_scatter, only: scatter_global_ext integer (kind=int_kind), intent(in) :: & - nu , & ! unit number - nrec ! record number (0 for sequential access) + nu , & ! unit number + nrec ! record number (0 for sequential access) real (kind=dbl_kind), dimension(nx_block,ny_block,max_blocks), intent(out) :: & - work ! output array (real, 8-byte) + work ! output array (real, 8-byte) character (len=4), intent(in) :: & - atype ! format for input array - ! (real/integer, 4-byte/8-byte) + atype ! format for input array + ! (real/integer, 4-byte/8-byte) logical (kind=log_kind), intent(in) :: & - diag ! if true, write diagnostic output + diag ! if true, write diagnostic output logical (kind=log_kind), optional, intent(in) :: ignore_eof logical (kind=log_kind), optional, intent(out) :: hit_eof @@ -623,7 +630,7 @@ subroutine ice_read_ext(nu, nrec, work, atype, diag, & integer (kind=int_kind) :: i, j, ios, nx, ny real (kind=dbl_kind) :: & - amin, amax, asum ! min, max values and sum of input array + amin, amax, asum ! min, max values and sum of input array logical (kind=log_kind) :: ignore_eof_use @@ -652,9 +659,10 @@ subroutine ice_read_ext(nu, nrec, work, atype, diag, & if (my_task == master_task) then - !------------------------------------------------------------------- - ! Read global array according to format atype - !------------------------------------------------------------------- + !------------------------------------------------------------------- + ! Read global array according to format atype + !------------------------------------------------------------------- + if (present(hit_eof)) hit_eof = .false. if (atype == 'ida4') then @@ -681,7 +689,7 @@ subroutine ice_read_ext(nu, nrec, work, atype, diag, & ignore_eof_use = .false. endif if (ignore_eof_use) then - ! Read line from file, checking for end-of-file + ! Read line from file, checking for end-of-file read(nu, iostat=ios) ((work_g1(i,j),i=1,nx), & j=1,ny) if (present(hit_eof)) hit_eof = ios < 0 @@ -701,9 +709,10 @@ subroutine ice_read_ext(nu, nrec, work, atype, diag, & endif endif - !------------------------------------------------------------------- - ! optional diagnostics - !------------------------------------------------------------------- + !------------------------------------------------------------------- + ! optional diagnostics + !------------------------------------------------------------------- + if (my_task==master_task .and. diag) then amin = minval(work_g1) amax = maxval(work_g1, mask = work_g1 /= spval_dbl) @@ -711,10 +720,10 @@ subroutine ice_read_ext(nu, nrec, work, atype, diag, & write(nu_diag,*) subname,' read_global ',nu, nrec, amin, amax, asum endif - !------------------------------------------------------------------- - ! Scatter data to individual processors. - ! NOTE: Ghost cells are always updated - !------------------------------------------------------------------- + !------------------------------------------------------------------- + ! Scatter data to individual processors. + ! NOTE: Ghost cells are always updated + !------------------------------------------------------------------- call scatter_global_ext(work, work_g1, master_task, distrb_info) @@ -732,25 +741,25 @@ subroutine ice_write_xyt(nu, nrec, work, atype, diag) use ice_gather_scatter, only: gather_global integer (kind=int_kind), intent(in) :: & - nu , & ! unit number - nrec ! record number (0 for sequential access) + nu , & ! unit number + nrec ! record number (0 for sequential access) real (kind=dbl_kind), dimension(nx_block,ny_block,max_blocks), intent(in) :: & - work ! input array (real, 8-byte) + work ! input array (real, 8-byte) character (len=4), intent(in) :: & - atype ! format for output array - ! (real/integer, 4-byte/8-byte) + atype ! format for output array + ! (real/integer, 4-byte/8-byte) logical (kind=log_kind), intent(in) :: & - diag ! if true, write diagnostic output + diag ! if true, write diagnostic output ! local variables integer (kind=int_kind) :: i, j real (kind=dbl_kind) :: & - amin, amax, asum ! min, max values and sum of input array + amin, amax, asum ! min, max values and sum of input array real (kind=dbl_kind), dimension(:,:), allocatable :: & work_g1 @@ -766,9 +775,9 @@ subroutine ice_write_xyt(nu, nrec, work, atype, diag) character(len=*), parameter :: subname = '(ice_write_xyt)' - !------------------------------------------------------------------- - ! Gather data from individual processors - !------------------------------------------------------------------- + !------------------------------------------------------------------- + ! Gather data from individual processors + !------------------------------------------------------------------- if (my_task == master_task) then allocate(work_g1(nx_global,ny_global)) @@ -780,9 +789,10 @@ subroutine ice_write_xyt(nu, nrec, work, atype, diag) if (my_task == master_task) then - !------------------------------------------------------------------- - ! Write global array according to format atype - !------------------------------------------------------------------- + !------------------------------------------------------------------- + ! Write global array according to format atype + !------------------------------------------------------------------- + if (atype == 'ida4') then allocate(work_gi4(nx_global,ny_global)) work_gi4 = nint(work_g1) @@ -806,9 +816,10 @@ subroutine ice_write_xyt(nu, nrec, work, atype, diag) write(nu_diag,*) subname,' ERROR: writing unknown atype ',atype endif - !------------------------------------------------------------------- - ! diagnostics - !------------------------------------------------------------------- + !------------------------------------------------------------------- + ! diagnostics + !------------------------------------------------------------------- + if (diag) then amin = minval(work_g1) amax = maxval(work_g1, mask = work_g1 /= spval_dbl) @@ -833,26 +844,25 @@ subroutine ice_write_xyzt(nu, nrec, work, atype, diag) use ice_domain_size, only: nblyr integer (kind=int_kind), intent(in) :: & - nu , & ! unit number - nrec ! record number (0 for sequential access) + nu , & ! unit number + nrec ! record number (0 for sequential access) - real (kind=dbl_kind), dimension(nx_block,ny_block,nblyr+2,max_blocks), & - intent(in) :: & - work ! input array (real, 8-byte) + real (kind=dbl_kind), dimension(nx_block,ny_block,nblyr+2,max_blocks), intent(in) :: & + work ! input array (real, 8-byte) character (len=4), intent(in) :: & - atype ! format for output array - ! (real/integer, 4-byte/8-byte) + atype ! format for output array + ! (real/integer, 4-byte/8-byte) logical (kind=log_kind), intent(in) :: & - diag ! if true, write diagnostic output + diag ! if true, write diagnostic output ! local variables integer (kind=int_kind) :: i, j, k real (kind=dbl_kind) :: & - amin, amax, asum ! min, max values and sum of input array + amin, amax, asum ! min, max values and sum of input array real (kind=dbl_kind), dimension(:,:,:), allocatable :: & work_g4 @@ -868,9 +878,9 @@ subroutine ice_write_xyzt(nu, nrec, work, atype, diag) character(len=*), parameter :: subname = '(ice_write_xyzt)' - !------------------------------------------------------------------- - ! Gather data from individual processors - !------------------------------------------------------------------- + !------------------------------------------------------------------- + ! Gather data from individual processors + !------------------------------------------------------------------- if (my_task == master_task) then allocate(work_g4(nx_global,ny_global,nblyr+2)) @@ -878,15 +888,16 @@ subroutine ice_write_xyzt(nu, nrec, work, atype, diag) allocate(work_g4(1,1,nblyr+2)) ! to save memory endif do k = 1,nblyr+2 - call gather_global(work_g4(:,:,k), work(:,:,k,:), master_task, & - distrb_info, spc_val=c0) + call gather_global(work_g4(:,:,k), work(:,:,k,:), master_task, & + distrb_info, spc_val=c0) enddo !k if (my_task == master_task) then - !------------------------------------------------------------------- - ! Write global array according to format atype - !------------------------------------------------------------------- + !------------------------------------------------------------------- + ! Write global array according to format atype + !------------------------------------------------------------------- + if (atype == 'ida4') then allocate(work_gi5(nx_global,ny_global,nblyr+2)) work_gi5 = nint(work_g4) @@ -911,9 +922,10 @@ subroutine ice_write_xyzt(nu, nrec, work, atype, diag) write(nu_diag,*) subname,' ERROR: writing unknown atype ',atype endif - !------------------------------------------------------------------- - ! diagnostics - !------------------------------------------------------------------- + !------------------------------------------------------------------- + ! diagnostics + !------------------------------------------------------------------- + if (diag) then amin = minval(work_g4) amax = maxval(work_g4, mask = work_g4 /= spval_dbl) @@ -939,26 +951,25 @@ subroutine ice_write_ext(nu, nrec, work, atype, diag) use ice_gather_scatter, only: gather_global_ext integer (kind=int_kind), intent(in) :: & - nu , & ! unit number - nrec ! record number (0 for sequential access) + nu , & ! unit number + nrec ! record number (0 for sequential access) - real (kind=dbl_kind), dimension(nx_block,ny_block,max_blocks), & - intent(in) :: & - work ! input array (real, 8-byte) + real (kind=dbl_kind), dimension(nx_block,ny_block,max_blocks), intent(in) :: & + work ! input array (real, 8-byte) character (len=4), intent(in) :: & - atype ! format for output array - ! (real/integer, 4-byte/8-byte) + atype ! format for output array + ! (real/integer, 4-byte/8-byte) logical (kind=log_kind), intent(in) :: & - diag ! if true, write diagnostic output + diag ! if true, write diagnostic output ! local variables integer (kind=int_kind) :: i, j, nx, ny real (kind=dbl_kind) :: & - amin, amax, asum ! min, max values and sum of input array + amin, amax, asum ! min, max values and sum of input array real (kind=dbl_kind), dimension(:,:), allocatable :: & work_g1 @@ -974,9 +985,9 @@ subroutine ice_write_ext(nu, nrec, work, atype, diag) character(len=*), parameter :: subname = '(ice_write_ext)' - !------------------------------------------------------------------- - ! Gather data from individual processors - !------------------------------------------------------------------- + !------------------------------------------------------------------- + ! Gather data from individual processors + !------------------------------------------------------------------- nx = nx_global + 2*nghost ny = ny_global + 2*nghost @@ -991,9 +1002,10 @@ subroutine ice_write_ext(nu, nrec, work, atype, diag) if (my_task == master_task) then - !------------------------------------------------------------------- - ! Write global array according to format atype - !------------------------------------------------------------------- + !------------------------------------------------------------------- + ! Write global array according to format atype + !------------------------------------------------------------------- + if (atype == 'ida4') then allocate(work_gi4(nx,ny)) work_gi4 = nint(work_g1) @@ -1017,9 +1029,10 @@ subroutine ice_write_ext(nu, nrec, work, atype, diag) write(nu_diag,*) subname,' ERROR: writing unknown atype ',atype endif - !------------------------------------------------------------------- - ! diagnostics - !------------------------------------------------------------------- + !------------------------------------------------------------------- + ! diagnostics + !------------------------------------------------------------------- + if (diag) then amin = minval(work_g1) amax = maxval(work_g1, mask = work_g1 /= spval_dbl) @@ -1041,10 +1054,10 @@ end subroutine ice_write_ext subroutine ice_open_nc(filename, fid) character (char_len_long), intent(in) :: & - filename ! netCDF filename + filename ! netCDF filename integer (kind=int_kind), intent(out) :: & - fid ! unit number + fid ! unit number ! local variables @@ -1052,16 +1065,13 @@ subroutine ice_open_nc(filename, fid) #ifdef USE_NETCDF integer (kind=int_kind) :: & - status ! status variable from netCDF routine + status ! status variable from netCDF routine if (my_task == master_task) then status = nf90_open(filename, NF90_NOWRITE, fid) - if (status /= nf90_noerr) then - !write(nu_diag,*) subname,' NF90_STRERROR = ',trim(nf90_strerror(status)) - call abort_ice(subname//' ERROR: Cannot open '//trim(filename), & - file=__FILE__, line=__LINE__) - endif + call ice_check_nc(status, subname//' ERROR: Cannot open '//trim(filename), & + file=__FILE__, line=__LINE__) endif ! my_task = master_task @@ -1088,24 +1098,24 @@ subroutine ice_read_nc_xy(fid, nrec, varname, work, diag, & use ice_gather_scatter, only: scatter_global, scatter_global_ext integer (kind=int_kind), intent(in) :: & - fid , & ! file id - nrec ! record number + fid , & ! file id + nrec ! record number logical (kind=log_kind), intent(in) :: & - diag ! if true, write diagnostic output + diag ! if true, write diagnostic output character (len=*), intent(in) :: & - varname ! field name in netcdf file + varname ! field name in netcdf file real (kind=dbl_kind), dimension(nx_block,ny_block,max_blocks), intent(out) :: & - work ! output array (real, 8-byte) + work ! output array (real, 8-byte) logical (kind=log_kind), optional, intent(in) :: & - restart_ext ! if true, read extended grid + restart_ext ! if true, read extended grid integer (kind=int_kind), optional, intent(in) :: & - field_loc, & ! location of field on staggered grid - field_type ! type of field (scalar, vector, angle) + field_loc, & ! location of field on staggered grid + field_type ! type of field (scalar, vector, angle) ! local variables @@ -1114,17 +1124,17 @@ subroutine ice_read_nc_xy(fid, nrec, varname, work, diag, & #ifdef USE_NETCDF ! netCDF file diagnostics: integer (kind=int_kind) :: & - varid , & ! variable id - status , & ! status output from netcdf routines - ndims , & ! number of dimensions - dimlen ! dimension size + varid , & ! variable id + status , & ! status output from netcdf routines + ndims , & ! number of dimensions + dimlen ! dimension size integer (kind=int_kind), dimension(10) :: & - dimids ! generic size dimids + dimids ! generic size dimids real (kind=dbl_kind) :: & missingvalue, & - amin, amax, asum ! min, max values and sum of input array + amin, amax, asum ! min, max values and sum of input array real (kind=dbl_kind), dimension(:,:), allocatable :: & work_g1 @@ -1167,67 +1177,54 @@ subroutine ice_read_nc_xy(fid, nrec, varname, work, diag, & if (my_task == master_task) then - !------------------------------------------------------------- - ! Find out ID of required variable - !------------------------------------------------------------- + !------------------------------------------------------------- + ! Find out ID of required variable + !------------------------------------------------------------- status = nf90_inq_varid(fid, trim(varname), varid) - if (status /= nf90_noerr) then - call abort_ice(subname//' ERROR: Cannot find variable '//trim(varname), & - file=__FILE__, line=__LINE__) - endif + call ice_check_nc(status, subname//' ERROR: Cannot find variable '//trim(varname), & + file=__FILE__, line=__LINE__) - !------------------------------------------------------------- - ! Check nrec axis size - !------------------------------------------------------------- + !------------------------------------------------------------- + ! Check nrec axis size + !------------------------------------------------------------- status = nf90_inquire_variable(fid, varid, ndims=ndims, dimids=dimids) - if (status /= nf90_noerr) then - call abort_ice(subname//' ERROR: inquire variable dimids '//trim(varname), & - file=__FILE__, line=__LINE__) - endif + call ice_check_nc(status, subname//' ERROR: inquire variable dimids '//trim(varname), & + file=__FILE__, line=__LINE__) if (ndims > 2) then status = nf90_inquire_dimension(fid, dimids(3), len=dimlen) - if (status /= nf90_noerr) then - call abort_ice(subname//' ERROR: inquire dimension size 3 '//trim(varname), & - file=__FILE__, line=__LINE__) - endif + call ice_check_nc(status, subname//' ERROR: inquire dimension size 3 '//trim(varname), & + file=__FILE__, line=__LINE__) if (lnrec > dimlen) then - write(nu_diag,*) subname,' ERROR not enough records, ',trim(varname),lnrec,dimlen + write(nu_diag,*) subname,' ERROR: not enough records, ',trim(varname),lnrec,dimlen call abort_ice(subname//' ERROR: not enough records '//trim(varname), & - file=__FILE__, line=__LINE__) + file=__FILE__, line=__LINE__) endif endif - !-------------------------------------------------------------- - ! Read global array - !-------------------------------------------------------------- + !-------------------------------------------------------------- + ! Read global array + !-------------------------------------------------------------- if (orca_halogrid .and. .not. present(restart_ext)) then status = nf90_get_var( fid, varid, work_g2, & - start=(/1,1,lnrec/), & - count=(/nx_global+2,ny_global+1,1/)) - if (status /= nf90_noerr) then - call abort_ice(subname//' ERROR: Cannot get variable '//trim(varname), & + start=(/1,1,lnrec/), count=(/nx_global+2,ny_global+1,1/)) + call ice_check_nc(status, subname//' ERROR: Cannot get variable '//trim(varname), & file=__FILE__, line=__LINE__) - endif work_g1 = work_g2(2:nx_global+1,1:ny_global) else status = nf90_get_var( fid, varid, work_g1, & - start=(/1,1,lnrec/), & - count=(/nx,ny,1/)) - if (status /= nf90_noerr) then - call abort_ice(subname//' ERROR: Cannot get variable '//trim(varname), & - file=__FILE__, line=__LINE__) - endif + start=(/1,1,lnrec/), count=(/nx,ny,1/)) + call ice_check_nc(status, subname//' ERROR: Cannot get variable '//trim(varname), & + file=__FILE__, line=__LINE__) endif - status = nf90_get_att(fid, varid, "_FillValue", missingvalue) endif ! my_task = master_task - !------------------------------------------------------------------- - ! optional diagnostics - !------------------------------------------------------------------- + !------------------------------------------------------------------- + ! optional diagnostics + !------------------------------------------------------------------- if (my_task==master_task .and. diag) then write(nu_diag,'(2a,i8,a,i8,2a)') & @@ -1239,16 +1236,22 @@ subroutine ice_read_nc_xy(fid, nrec, varname, work, diag, & ! status = nf90_inquire_dimension(fid,id,name=dimname,len=dimlen) ! write(nu_diag,*) subname,' Dim name = ',trim(dimname),', size = ',dimlen ! enddo + ! optional + missingvalue = spval_dbl + status = nf90_get_att(fid, varid, "_FillValue", missingvalue) +! call ice_check_nc(status, subname//' ERROR: Missing _FillValue', & +! file=__FILE__, line=__LINE__) +! write(nu_diag,*) subname,' missingvalue= ',missingvalue amin = minval(work_g1) amax = maxval(work_g1, mask = work_g1 /= missingvalue) asum = sum (work_g1, mask = work_g1 /= missingvalue) write(nu_diag,*) subname,' min, max, sum =', amin, amax, asum, trim(varname) endif - !------------------------------------------------------------------- - ! Scatter data to individual processors. - ! NOTE: Ghost cells are not updated unless field_loc is present. - !------------------------------------------------------------------- + !------------------------------------------------------------------- + ! Scatter data to individual processors. + ! NOTE: Ghost cells are not updated unless field_loc is present. + !------------------------------------------------------------------- if (present(restart_ext)) then if (restart_ext) then @@ -1294,24 +1297,24 @@ subroutine ice_read_nc_xyz(fid, nrec, varname, work, diag, & use ice_gather_scatter, only: scatter_global, scatter_global_ext integer (kind=int_kind), intent(in) :: & - fid , & ! file id - nrec ! record number + fid , & ! file id + nrec ! record number character (len=*), intent(in) :: & - varname ! field name in netcdf file + varname ! field name in netcdf file logical (kind=log_kind), intent(in) :: & - diag ! if true, write diagnostic output + diag ! if true, write diagnostic output real (kind=dbl_kind), dimension(nx_block,ny_block,ncat,max_blocks), intent(out) :: & - work ! output array (real, 8-byte) + work ! output array (real, 8-byte) logical (kind=log_kind), optional, intent(in) :: & - restart_ext ! if true, read extended grid + restart_ext ! if true, read extended grid integer (kind=int_kind), optional, intent(in) :: & - field_loc, & ! location of field on staggered grid - field_type ! type of field (scalar, vector, angle) + field_loc, & ! location of field on staggered grid + field_type ! type of field (scalar, vector, angle) ! local variables @@ -1320,21 +1323,21 @@ subroutine ice_read_nc_xyz(fid, nrec, varname, work, diag, & #ifdef USE_NETCDF ! netCDF file diagnostics: integer (kind=int_kind) :: & - n, & ! ncat index - varid , & ! variable id - status , & ! status output from netcdf routines - ndims , & ! number of dimensions - dimlen ! dimension size + n, & ! ncat index + varid , & ! variable id + status , & ! status output from netcdf routines + ndims , & ! number of dimensions + dimlen ! dimension size integer (kind=int_kind), dimension(10) :: & - dimids ! generic size dimids + dimids ! generic size dimids real (kind=dbl_kind) :: & - missingvalue, & ! missing value - amin, amax, asum ! min, max values and sum of input array + missingvalue, & ! missing value + amin, amax, asum ! min, max values and sum of input array ! character (char_len) :: & -! dimname ! dimension name +! dimname ! dimension name real (kind=dbl_kind), dimension(:,:,:), allocatable :: & work_g1 @@ -1375,67 +1378,54 @@ subroutine ice_read_nc_xyz(fid, nrec, varname, work, diag, & if (my_task == master_task) then - !------------------------------------------------------------- - ! Find out ID of required variable - !------------------------------------------------------------- + !------------------------------------------------------------- + ! Find out ID of required variable + !------------------------------------------------------------- status = nf90_inq_varid(fid, trim(varname), varid) - if (status /= nf90_noerr) then - call abort_ice(subname//' ERROR: Cannot find variable '//trim(varname), & - file=__FILE__, line=__LINE__) - endif + call ice_check_nc(status, subname//' ERROR: Cannot find variable '//trim(varname), & + file=__FILE__, line=__LINE__) - !------------------------------------------------------------- - ! Check nrec axis size - !------------------------------------------------------------- + !------------------------------------------------------------- + ! Check nrec axis size + !------------------------------------------------------------- status = nf90_inquire_variable(fid, varid, ndims=ndims, dimids=dimids) - if (status /= nf90_noerr) then - call abort_ice(subname//' ERROR: inquire variable dimids '//trim(varname), & - file=__FILE__, line=__LINE__) - endif + call ice_check_nc(status, subname//' ERROR: inquire variable dimids '//trim(varname), & + file=__FILE__, line=__LINE__) if (ndims > 3) then status = nf90_inquire_dimension(fid, dimids(4), len=dimlen) - if (status /= nf90_noerr) then - call abort_ice(subname//' ERROR: inquire dimension size 4 '//trim(varname), & - file=__FILE__, line=__LINE__) - endif + call ice_check_nc(status, subname//' ERROR: inquire dimension size 4 '//trim(varname), & + file=__FILE__, line=__LINE__) if (lnrec > dimlen) then - write(nu_diag,*) subname,' ERROR not enough records, ',trim(varname),lnrec,dimlen + write(nu_diag,*) subname,' ERROR: not enough records, ',trim(varname),lnrec,dimlen call abort_ice(subname//' ERROR: not enough records '//trim(varname), & - file=__FILE__, line=__LINE__) + file=__FILE__, line=__LINE__) endif endif - !-------------------------------------------------------------- - ! Read global array - !-------------------------------------------------------------- + !-------------------------------------------------------------- + ! Read global array + !-------------------------------------------------------------- if (orca_halogrid .and. .not. present(restart_ext)) then status = nf90_get_var( fid, varid, work_g2, & - start=(/1,1,1,lnrec/), & - count=(/nx_global+2,ny_global+1,ncat,1/)) - if (status /= nf90_noerr) then - call abort_ice(subname//' ERROR: Cannot get variable '//trim(varname), & - file=__FILE__, line=__LINE__) - endif + start=(/1,1,1,lnrec/), count=(/nx_global+2,ny_global+1,ncat,1/)) + call ice_check_nc(status, subname//' ERROR: Cannot get variable '//trim(varname), & + file=__FILE__, line=__LINE__) work_g1 = work_g2(2:nx_global+1,1:ny_global,:) else status = nf90_get_var( fid, varid, work_g1, & - start=(/1,1,1,lnrec/), & - count=(/nx,ny,ncat,1/)) - if (status /= nf90_noerr) then - call abort_ice(subname//' ERROR: Cannot get variable '//trim(varname), & - file=__FILE__, line=__LINE__) - endif + start=(/1,1,1,lnrec/), count=(/nx,ny,ncat,1/)) + call ice_check_nc(status, subname//' ERROR: Cannot get variable '//trim(varname), & + file=__FILE__, line=__LINE__) endif - status = nf90_get_att(fid, varid, "_FillValue", missingvalue) endif ! my_task = master_task - !------------------------------------------------------------------- - ! optional diagnostics - !------------------------------------------------------------------- + !------------------------------------------------------------------- + ! optional diagnostics + !------------------------------------------------------------------- if (my_task==master_task .and. diag) then write(nu_diag,'(2a,i8,a,i8,2a)') & @@ -1447,6 +1437,12 @@ subroutine ice_read_nc_xyz(fid, nrec, varname, work, diag, & ! status = nf90_inquire_dimension(fid,id,name=dimname,len=dimlen) ! write(nu_diag,*) subname,' Dim name = ',trim(dimname),', size = ',dimlen ! enddo + ! optional + missingvalue = spval_dbl + status = nf90_get_att(fid, varid, "_FillValue", missingvalue) +! call ice_check_nc(status, subname//' ERROR: Missing _FillValue', & +! file=__FILE__, line=__LINE__) +! write(nu_diag,*) subname,' missingvalue= ',missingvalue do n=1,ncat amin = minval(work_g1(:,:,n)) amax = maxval(work_g1(:,:,n), mask = work_g1(:,:,n) /= missingvalue) @@ -1455,10 +1451,10 @@ subroutine ice_read_nc_xyz(fid, nrec, varname, work, diag, & enddo endif - !------------------------------------------------------------------- - ! Scatter data to individual processors. - ! NOTE: Ghost cells are not updated unless field_loc is present. - !------------------------------------------------------------------- + !------------------------------------------------------------------- + ! Scatter data to individual processors. + ! NOTE: Ghost cells are not updated unless field_loc is present. + !------------------------------------------------------------------- if (present(restart_ext)) then if (restart_ext) then @@ -1511,47 +1507,46 @@ subroutine ice_read_nc_xyf(fid, nrec, varname, work, diag, & use ice_gather_scatter, only: scatter_global, scatter_global_ext integer (kind=int_kind), intent(in) :: & - fid , & ! file id - nrec ! record number + fid , & ! file id + nrec ! record number character (len=*), intent(in) :: & - varname ! field name in netcdf file + varname ! field name in netcdf file logical (kind=log_kind), intent(in) :: & - diag ! if true, write diagnostic output + diag ! if true, write diagnostic output - real (kind=dbl_kind), dimension(nx_block,ny_block,nfreq,1,max_blocks), & - intent(out) :: & - work ! output array (real, 8-byte) + real (kind=dbl_kind), dimension(nx_block,ny_block,nfreq,1,max_blocks), intent(out) :: & + work ! output array (real, 8-byte) logical (kind=log_kind), optional, intent(in) :: & - restart_ext ! if true, read extended grid + restart_ext ! if true, read extended grid integer (kind=int_kind), optional, intent(in) :: & - field_loc, & ! location of field on staggered grid - field_type ! type of field (scalar, vector, angle) + field_loc, & ! location of field on staggered grid + field_type ! type of field (scalar, vector, angle) ! local variables ! netCDF file diagnostics: integer (kind=int_kind) :: & - varid, & ! variable id - status, & ! status output from netcdf routines - ndim, nvar, & ! sizes of netcdf file - id, & ! dimension index - n, & ! ncat index - ndims, & ! number of dimensions - dimlen ! dimension size + varid, & ! variable id + status, & ! status output from netcdf routines + ndim, nvar, & ! sizes of netcdf file + id, & ! dimension index + n, & ! ncat index + ndims, & ! number of dimensions + dimlen ! dimension size integer (kind=int_kind), dimension(10) :: & - dimids ! generic size dimids + dimids ! generic size dimids real (kind=dbl_kind) :: & - missingvalue, & ! missing value - amin, amax, asum ! min, max values and sum of input array + missingvalue, & ! missing value + amin, amax, asum ! min, max values and sum of input array character (char_len) :: & - dimname ! dimension name + dimname ! dimension name real (kind=dbl_kind), dimension(:,:,:), allocatable :: & work_g1 @@ -1595,67 +1590,54 @@ subroutine ice_read_nc_xyf(fid, nrec, varname, work, diag, & if (my_task == master_task) then - !------------------------------------------------------------- - ! Find out ID of required variable - !------------------------------------------------------------- + !------------------------------------------------------------- + ! Find out ID of required variable + !------------------------------------------------------------- status = nf90_inq_varid(fid, trim(varname), varid) - if (status /= nf90_noerr) then - call abort_ice(subname//' ERROR: Cannot find variable '//trim(varname), & - file=__FILE__, line=__LINE__) - endif + call ice_check_nc(status, subname//' ERROR: Cannot find variable '//trim(varname), & + file=__FILE__, line=__LINE__) - !------------------------------------------------------------- - ! Check nrec axis size - !------------------------------------------------------------- + !------------------------------------------------------------- + ! Check nrec axis size + !------------------------------------------------------------- status = nf90_inquire_variable(fid, varid, ndims=ndims, dimids=dimids) - if (status /= nf90_noerr) then - call abort_ice(subname//' ERROR: inquire variable dimids '//trim(varname), & - file=__FILE__, line=__LINE__) - endif + call ice_check_nc(status, subname//' ERROR: inquire variable dimids '//trim(varname), & + file=__FILE__, line=__LINE__) if (ndims > 3) then status = nf90_inquire_dimension(fid, dimids(4), len=dimlen) - if (status /= nf90_noerr) then - call abort_ice(subname//' ERROR: inquire dimension size 4 '//trim(varname), & - file=__FILE__, line=__LINE__) - endif + call ice_check_nc(status, subname//' ERROR: inquire dimension size 4 '//trim(varname), & + file=__FILE__, line=__LINE__) if (lnrec > dimlen) then - write(nu_diag,*) subname,' ERROR not enough records, ',trim(varname),lnrec,dimlen + write(nu_diag,*) subname,' ERROR: not enough records, ',trim(varname),lnrec,dimlen call abort_ice(subname//' ERROR: not enough records '//trim(varname), & - file=__FILE__, line=__LINE__) + file=__FILE__, line=__LINE__) endif endif - !-------------------------------------------------------------- - ! Read global array - !-------------------------------------------------------------- + !-------------------------------------------------------------- + ! Read global array + !-------------------------------------------------------------- if (orca_halogrid .and. .not. present(restart_ext)) then status = nf90_get_var( fid, varid, work_g2, & - start=(/1,1,1,lnrec/), & - count=(/nx_global+2,ny_global+1,nfreq,1/)) - if (status /= nf90_noerr) then - call abort_ice(subname//' ERROR: Cannot get variable '//trim(varname), & - file=__FILE__, line=__LINE__) - endif + start=(/1,1,1,lnrec/), count=(/nx_global+2,ny_global+1,nfreq,1/)) + call ice_check_nc(status, subname//' ERROR: Cannot get variable '//trim(varname), & + file=__FILE__, line=__LINE__) work_g1 = work_g2(2:nx_global+1,1:ny_global,:) else status = nf90_get_var( fid, varid, work_g1, & - start=(/1,1,1,lnrec/), & - count=(/nx,ny,nfreq,1/)) - if (status /= nf90_noerr) then - call abort_ice(subname//' ERROR: Cannot get variable '//trim(varname), & - file=__FILE__, line=__LINE__) - endif + start=(/1,1,1,lnrec/), count=(/nx,ny,nfreq,1/)) + call ice_check_nc(status, subname//' ERROR: Cannot get variable '//trim(varname), & + file=__FILE__, line=__LINE__) endif - status = nf90_get_att(fid, varid, "missing_value", missingvalue) endif ! my_task = master_task - !------------------------------------------------------------------- - ! optional diagnostics - !------------------------------------------------------------------- + !------------------------------------------------------------------- + ! optional diagnostics + !------------------------------------------------------------------- if (my_task==master_task .and. diag) then write(nu_diag,'(2a,i8,a,i8,2a)') & @@ -1667,7 +1649,12 @@ subroutine ice_read_nc_xyf(fid, nrec, varname, work, diag, & status = nf90_inquire_dimension(fid,id,name=dimname,len=dimlen) write(nu_diag,*) subname,' Dim name = ',trim(dimname),', size = ',dimlen enddo - write(nu_diag,*) subname,' missingvalue= ',missingvalue + ! optional + missingvalue = spval_dbl + status = nf90_get_att(fid, varid, "_FillValue", missingvalue) +! call ice_check_nc(status, subname//' ERROR: Missing _FillValue', & +! file=__FILE__, line=__LINE__) +! write(nu_diag,*) subname,' missingvalue= ',missingvalue do n = 1, nfreq amin = minval(work_g1(:,:,n)) amax = maxval(work_g1(:,:,n), mask = work_g1(:,:,n) /= missingvalue) @@ -1676,10 +1663,10 @@ subroutine ice_read_nc_xyf(fid, nrec, varname, work, diag, & enddo endif - !------------------------------------------------------------------- - ! Scatter data to individual processors. - ! NOTE: Ghost cells are not updated unless field_loc is present. - !------------------------------------------------------------------- + !------------------------------------------------------------------- + ! Scatter data to individual processors. + ! NOTE: Ghost cells are not updated unless field_loc is present. + !------------------------------------------------------------------- if (present(restart_ext)) then if (restart_ext) then @@ -1725,21 +1712,21 @@ subroutine ice_read_nc_point(fid, nrec, varname, work, diag, & field_loc, field_type) integer (kind=int_kind), intent(in) :: & - fid , & ! file id - nrec ! record number + fid , & ! file id + nrec ! record number logical (kind=log_kind), intent(in) :: & - diag ! if true, write diagnostic output + diag ! if true, write diagnostic output character (char_len), intent(in) :: & - varname ! field name in netcdf file + varname ! field name in netcdf file integer (kind=int_kind), optional, intent(in) :: & - field_loc, & ! location of field on staggered grid - field_type ! type of field (scalar, vector, angle) + field_loc, & ! location of field on staggered grid + field_type ! type of field (scalar, vector, angle) real (kind=dbl_kind), intent(out) :: & - work ! output variable (real, 8-byte) + work ! output variable (real, 8-byte) ! local variables @@ -1748,76 +1735,67 @@ subroutine ice_read_nc_point(fid, nrec, varname, work, diag, & #ifdef USE_NETCDF ! netCDF file diagnostics: integer (kind=int_kind) :: & - varid, & ! netcdf id for field - status, & ! status output from netcdf routines - ndim, nvar, & ! sizes of netcdf file - id, & ! dimension index - ndims, & ! number of dimensions - dimlen ! dimension size + varid, & ! netcdf id for field + status, & ! status output from netcdf routines + ndim, nvar, & ! sizes of netcdf file + id, & ! dimension index + ndims, & ! number of dimensions + dimlen ! dimension size integer (kind=int_kind), dimension(10) :: & - dimids ! generic size dimids + dimids ! generic size dimids real (kind=dbl_kind), dimension(1) :: & - workg ! temporary work variable + workg ! temporary work variable integer (kind=int_kind) :: lnrec ! local value of nrec character (char_len) :: & - dimname ! dimension name + dimname ! dimension name lnrec = nrec if (my_task == master_task) then - !------------------------------------------------------------- - ! Find out ID of required variable - !------------------------------------------------------------- + !------------------------------------------------------------- + ! Find out ID of required variable + !------------------------------------------------------------- status = nf90_inq_varid(fid, trim(varname), varid) - if (status /= nf90_noerr) then - call abort_ice(subname//' ERROR: Cannot find variable '//trim(varname), & - file=__FILE__, line=__LINE__) - endif + call ice_check_nc(status, subname//' ERROR: Cannot find variable '//trim(varname), & + file=__FILE__, line=__LINE__) - !------------------------------------------------------------- - ! Check nrec axis size - !------------------------------------------------------------- + !------------------------------------------------------------- + ! Check nrec axis size + !------------------------------------------------------------- status = nf90_inquire_variable(fid, varid, ndims=ndims, dimids=dimids) - if (status /= nf90_noerr) then - call abort_ice(subname//' ERROR: inquire variable dimids '//trim(varname), & - file=__FILE__, line=__LINE__) - endif + call ice_check_nc(status, subname//' ERROR: inquire variable dimids '//trim(varname), & + file=__FILE__, line=__LINE__) if (ndims > 0) then status = nf90_inquire_dimension(fid, dimids(1), len=dimlen) - if (status /= nf90_noerr) then - call abort_ice(subname//' ERROR: inquire dimension size 1 '//trim(varname), & - file=__FILE__, line=__LINE__) - endif + call ice_check_nc(status, subname//' ERROR: inquire dimension size 1 '//trim(varname), & + file=__FILE__, line=__LINE__) if (lnrec > dimlen) then - write(nu_diag,*) subname,' ERROR not enough records, ',trim(varname),lnrec,dimlen + write(nu_diag,*) subname,' ERROR: not enough records, ',trim(varname),lnrec,dimlen call abort_ice(subname//' ERROR: not enough records '//trim(varname), & - file=__FILE__, line=__LINE__) + file=__FILE__, line=__LINE__) endif endif - !-------------------------------------------------------------- - ! Read point variable - !-------------------------------------------------------------- + !-------------------------------------------------------------- + ! Read point variable + !-------------------------------------------------------------- status = nf90_get_var(fid, varid, workg, & - start= (/ lnrec /), & - count=(/ 1 /)) - if (status /= nf90_noerr) then - call abort_ice(subname//' ERROR: Cannot get variable '//trim(varname), & - file=__FILE__, line=__LINE__) - endif + start= (/ lnrec /), count=(/ 1 /)) + call ice_check_nc(status, subname//' ERROR: Cannot get variable '//trim(varname), & + file=__FILE__, line=__LINE__) endif ! my_task = master_task - !------------------------------------------------------------------- - ! optional diagnostics - !------------------------------------------------------------------- + !------------------------------------------------------------------- + ! optional diagnostics + !------------------------------------------------------------------- if (my_task==master_task .and. diag) then write(nu_diag,'(2a,i8,a,i8,2a)') & @@ -1850,17 +1828,17 @@ subroutine ice_read_nc_1D(fid, varname, work, diag, & use ice_fileunits, only: nu_diag integer (kind=int_kind), intent(in) :: & - fid , & ! file id - xdim ! field dimensions + fid , & ! file id + xdim ! field dimensions logical (kind=log_kind), intent(in) :: & - diag ! if true, write diagnostic output + diag ! if true, write diagnostic output character (char_len), intent(in) :: & - varname ! field name in netcdf file + varname ! field name in netcdf file real (kind=dbl_kind), dimension(:), intent(out) :: & - work ! output array + work ! output array ! local variables @@ -1869,12 +1847,12 @@ subroutine ice_read_nc_1D(fid, varname, work, diag, & #ifdef USE_NETCDF ! netCDF file diagnostics: integer (kind=int_kind) :: & - varid, & ! netcdf id for field - status, & ! status output from netcdf routines - ndim, nvar ! sizes of netcdf file + varid, & ! netcdf id for field + status, & ! status output from netcdf routines + ndim, nvar ! sizes of netcdf file real (kind=dbl_kind), dimension(xdim) :: & - workg ! output array (real, 8-byte) + workg ! output array (real, 8-byte) !-------------------------------------------------------------- @@ -1885,23 +1863,23 @@ subroutine ice_read_nc_1D(fid, varname, work, diag, & call abort_ice (subname//' ERROR: work array wrong size '//trim(varname), & file=__FILE__, line=__LINE__ ) endif + !------------------------------------------------------------- ! Find out ID of required variable !------------------------------------------------------------- status = nf90_inq_varid(fid, trim(varname), varid) - - if (status /= nf90_noerr) then - call abort_ice (subname//' ERROR: Cannot find variable '//trim(varname), & - file=__FILE__, line=__LINE__ ) - endif + call ice_check_nc(status, subname//' ERROR: Cannot find variable '//trim(varname), & + file=__FILE__, line=__LINE__ ) !-------------------------------------------------------------- ! Read array !-------------------------------------------------------------- + status = nf90_get_var( fid, varid, workg, & - start=(/1/), & - count=(/xdim/) ) + start=(/1/), count=(/xdim/) ) + call ice_check_nc(status, subname//' ERROR: Cannot get variable '//trim(varname), & + file=__FILE__, line=__LINE__ ) work(1:xdim) = workg(1:xdim) !------------------------------------------------------------------- @@ -1917,7 +1895,7 @@ subroutine ice_read_nc_1D(fid, varname, work, diag, & endif endif #else - call abort_ice(subname//'ERROR: USE_NETCDF cpp not defined', & + call abort_ice(subname//' ERROR: USE_NETCDF cpp not defined', & file=__FILE__, line=__LINE__) work = c0 ! to satisfy intent(out) attribute #endif @@ -1934,17 +1912,17 @@ subroutine ice_read_nc_2D(fid, varname, work, diag, & use ice_fileunits, only: nu_diag integer (kind=int_kind), intent(in) :: & - fid , & ! file id - xdim, ydim ! field dimensions + fid , & ! file id + xdim, ydim ! field dimensions logical (kind=log_kind), intent(in) :: & - diag ! if true, write diagnostic output + diag ! if true, write diagnostic output character (char_len), intent(in) :: & - varname ! field name in netcdf file + varname ! field name in netcdf file real (kind=dbl_kind), dimension(:,:), intent(out) :: & - work ! output array + work ! output array ! local variables @@ -1953,12 +1931,12 @@ subroutine ice_read_nc_2D(fid, varname, work, diag, & #ifdef USE_NETCDF ! netCDF file diagnostics: integer (kind=int_kind) :: & - varid, & ! netcdf id for field - status, & ! status output from netcdf routines - ndim, nvar ! sizes of netcdf file + varid, & ! netcdf id for field + status, & ! status output from netcdf routines + ndim, nvar ! sizes of netcdf file real (kind=dbl_kind), dimension(xdim,ydim) :: & - workg ! output array (real, 8-byte) + workg ! output array (real, 8-byte) !-------------------------------------------------------------- @@ -1971,23 +1949,23 @@ subroutine ice_read_nc_2D(fid, varname, work, diag, & call abort_ice (subname//' ERROR: work array wrong size '//trim(varname), & file=__FILE__, line=__LINE__ ) endif + !------------------------------------------------------------- ! Find out ID of required variable !------------------------------------------------------------- status = nf90_inq_varid(fid, trim(varname), varid) - - if (status /= nf90_noerr) then - call abort_ice (subname//' ERROR: Cannot find variable '//trim(varname), & - file=__FILE__, line=__LINE__ ) - endif + call ice_check_nc(status,subname//' ERROR: Cannot find variable '//trim(varname), & + file=__FILE__, line=__LINE__ ) !-------------------------------------------------------------- ! Read array !-------------------------------------------------------------- + status = nf90_get_var( fid, varid, workg, & - start=(/1,1/), & - count=(/xdim,ydim/) ) + start=(/1,1/), count=(/xdim,ydim/) ) + call ice_check_nc(status, subname//' ERROR: Cannot get variable '//trim(varname), & + file=__FILE__, line=__LINE__ ) work(1:xdim,1:ydim) = workg(1:xdim, 1:ydim) !------------------------------------------------------------------- @@ -2003,7 +1981,7 @@ subroutine ice_read_nc_2D(fid, varname, work, diag, & endif endif #else - call abort_ice(subname//'ERROR: USE_NETCDF cpp not defined', & + call abort_ice(subname//' ERROR: USE_NETCDF cpp not defined', & file=__FILE__, line=__LINE__) work = c0 ! to satisfy intent(out) attribute #endif @@ -2011,7 +1989,6 @@ subroutine ice_read_nc_2D(fid, varname, work, diag, & end subroutine ice_read_nc_2D !======================================================================= -!======================================================================= ! Written by T. Craig @@ -2021,17 +1998,17 @@ subroutine ice_read_nc_3D(fid, varname, work, diag, & use ice_fileunits, only: nu_diag integer (kind=int_kind), intent(in) :: & - fid , & ! file id - xdim, ydim,zdim ! field dimensions + fid , & ! file id + xdim, ydim,zdim ! field dimensions logical (kind=log_kind), intent(in) :: & - diag ! if true, write diagnostic output + diag ! if true, write diagnostic output character (char_len), intent(in) :: & - varname ! field name in netcdf file + varname ! field name in netcdf file real (kind=dbl_kind), dimension(:,:,:), intent(out) :: & - work ! output array + work ! output array ! local variables @@ -2040,12 +2017,12 @@ subroutine ice_read_nc_3D(fid, varname, work, diag, & #ifdef USE_NETCDF ! netCDF file diagnostics: integer (kind=int_kind) :: & - varid, & ! netcdf id for field - status, & ! status output from netcdf routines - ndim, nvar ! sizes of netcdf file + varid, & ! netcdf id for field + status, & ! status output from netcdf routines + ndim, nvar ! sizes of netcdf file real (kind=dbl_kind), dimension(xdim,ydim,zdim) :: & - workg ! output array (real, 8-byte) + workg ! output array (real, 8-byte) !-------------------------------------------------------------- @@ -2060,23 +2037,23 @@ subroutine ice_read_nc_3D(fid, varname, work, diag, & call abort_ice (subname//' ERROR: work array wrong size '//trim(varname), & file=__FILE__, line=__LINE__ ) endif + !------------------------------------------------------------- ! Find out ID of required variable !------------------------------------------------------------- status = nf90_inq_varid(fid, trim(varname), varid) - - if (status /= nf90_noerr) then - call abort_ice (subname//' ERROR: Cannot find variable '//trim(varname), & - file=__FILE__, line=__LINE__ ) - endif + call ice_check_nc(status, subname//' ERROR: Cannot find variable '//trim(varname), & + file=__FILE__, line=__LINE__ ) !-------------------------------------------------------------- ! Read array !-------------------------------------------------------------- + status = nf90_get_var( fid, varid, workg, & - start=(/1,1,1/), & - count=(/xdim,ydim,zdim/) ) + start=(/1,1,1/), count=(/xdim,ydim,zdim/) ) + call ice_check_nc(status, subname//' ERROR: Cannot get variable '//trim(varname), & + file=__FILE__, line=__LINE__ ) work(1:xdim,1:ydim,1:zdim) = workg(1:xdim, 1:ydim, 1:zdim) !------------------------------------------------------------------- @@ -2092,7 +2069,7 @@ subroutine ice_read_nc_3D(fid, varname, work, diag, & endif endif #else - call abort_ice(subname//'ERROR: USE_NETCDF cpp not defined', & + call abort_ice(subname//' ERROR: USE_NETCDF cpp not defined', & file=__FILE__, line=__LINE__) work = c0 ! to satisfy intent(out) attribute #endif @@ -2109,42 +2086,42 @@ subroutine ice_read_nc_z(fid, nrec, varname, work, diag, & use ice_domain_size, only: nilyr integer (kind=int_kind), intent(in) :: & - fid , & ! file id - nrec ! record number + fid , & ! file id + nrec ! record number logical (kind=log_kind), intent(in) :: & - diag ! if true, write diagnostic output + diag ! if true, write diagnostic output character (char_len), intent(in) :: & - varname ! field name in netcdf file + varname ! field name in netcdf file integer (kind=int_kind), optional, intent(in) :: & - field_loc, & ! location of field on staggered grid - field_type ! type of field (scalar, vector, angle) + field_loc, & ! location of field on staggered grid + field_type ! type of field (scalar, vector, angle) real (kind=dbl_kind), dimension(nilyr), intent(out) :: & - work ! output array (real, 8-byte) + work ! output array (real, 8-byte) ! local variables #ifdef USE_NETCDF real (kind=dbl_kind), dimension(:), allocatable :: & - work_z + work_z ! netCDF file diagnostics: integer (kind=int_kind) :: & - varid, & ! netcdf id for field - status, & ! status output from netcdf routines - ndim, nvar, & ! sizes of netcdf file - id, & ! dimension index - ndims, & ! number of dimensions - dimlen ! dimension size + varid, & ! netcdf id for field + status, & ! status output from netcdf routines + ndim, nvar, & ! sizes of netcdf file + id, & ! dimension index + ndims, & ! number of dimensions + dimlen ! dimension size integer (kind=int_kind), dimension(10) :: & - dimids ! generic size dimids + dimids ! generic size dimids character (char_len) :: & - dimname ! dimension name + dimname ! dimension name integer (kind=int_kind) :: lnrec ! local value of nrec @@ -2160,54 +2137,45 @@ subroutine ice_read_nc_z(fid, nrec, varname, work, diag, & if (my_task == master_task) then - !------------------------------------------------------------- - ! Find out ID of required variable - !------------------------------------------------------------- + !------------------------------------------------------------- + ! Find out ID of required variable + !------------------------------------------------------------- status = nf90_inq_varid(fid, trim(varname), varid) - if (status /= nf90_noerr) then - call abort_ice(subname//' ERROR: Cannot find variable '//trim(varname), & - file=__FILE__, line=__LINE__) - endif + call ice_check_nc(status, subname//' ERROR: Cannot find variable '//trim(varname), & + file=__FILE__, line=__LINE__) - !------------------------------------------------------------- - ! Check nrec axis size - !------------------------------------------------------------- + !------------------------------------------------------------- + ! Check nrec axis size + !------------------------------------------------------------- status = nf90_inquire_variable(fid, varid, ndims=ndims, dimids=dimids) - if (status /= nf90_noerr) then - call abort_ice(subname//' ERROR: inquire variable dimids '//trim(varname), & - file=__FILE__, line=__LINE__) - endif + call ice_check_nc(status, subname//' ERROR: inquire variable dimids '//trim(varname), & + file=__FILE__, line=__LINE__) if (ndims > 1) then status = nf90_inquire_dimension(fid, dimids(2), len=dimlen) - if (status /= nf90_noerr) then - call abort_ice(subname//' ERROR: inquire dimension size 2 '//trim(varname), & - file=__FILE__, line=__LINE__) - endif + call ice_check_nc(status, subname//' ERROR: inquire dimension size 2 '//trim(varname), & + file=__FILE__, line=__LINE__) if (lnrec > dimlen) then - write(nu_diag,*) subname,' ERROR not enough records, ',trim(varname),lnrec,dimlen + write(nu_diag,*) subname,' ERROR: not enough records, ',trim(varname),lnrec,dimlen call abort_ice(subname//' ERROR: not enough records '//trim(varname), & - file=__FILE__, line=__LINE__) + file=__FILE__, line=__LINE__) endif endif - !-------------------------------------------------------------- - ! Read global array - !-------------------------------------------------------------- + !-------------------------------------------------------------- + ! Read global array + !-------------------------------------------------------------- status = nf90_get_var( fid, varid, work_z, & - start=(/1,lnrec/), & - count=(/nilyr,1/)) - if (status /= nf90_noerr) then - call abort_ice(subname//' ERROR: Cannot get variable '//trim(varname), & - file=__FILE__, line=__LINE__) - endif + start=(/1,lnrec/), count=(/nilyr,1/)) + call ice_check_nc(status, subname//' ERROR: Cannot get variable '//trim(varname), & + file=__FILE__, line=__LINE__) endif ! my_task = master_task - !------------------------------------------------------------------- - ! optional diagnostics - !------------------------------------------------------------------- + !------------------------------------------------------------------- + ! optional diagnostics + !------------------------------------------------------------------- if (my_task==master_task .and. diag) then write(nu_diag,'(2a,i8,a,i8,2a)') & @@ -2243,21 +2211,21 @@ subroutine ice_write_nc_xy(fid, nrec, varid, work, diag, & use ice_gather_scatter, only: gather_global, gather_global_ext integer (kind=int_kind), intent(in) :: & - fid , & ! file id - varid , & ! variable id - nrec ! record number + fid , & ! file id + varid , & ! variable id + nrec ! record number logical (kind=log_kind), intent(in) :: & - diag ! if true, write diagnostic output + diag ! if true, write diagnostic output logical (kind=log_kind), optional, intent(in) :: & - restart_ext ! if true, write extended grid + restart_ext ! if true, write extended grid real (kind=dbl_kind), dimension(nx_block,ny_block,max_blocks), intent(in) :: & - work ! output array (real, 8-byte) + work ! output array (real, 8-byte) character (len=*), optional, intent(in) :: & - varname ! variable name + varname ! variable name ! local variables @@ -2266,17 +2234,17 @@ subroutine ice_write_nc_xy(fid, nrec, varid, work, diag, & #ifdef USE_NETCDF ! netCDF file diagnostics: integer (kind=int_kind) :: & - status ! status output from netcdf routines -! ndim, nvar, & ! sizes of netcdf file -! id, & ! dimension index -! dimlen ! size of dimension + status ! status output from netcdf routines +! ndim, nvar, & ! sizes of netcdf file +! id, & ! dimension index +! dimlen ! size of dimension real (kind=dbl_kind) :: & - amin, amax, asum ! min, max values and sum of input array + amin, amax, asum ! min, max values and sum of input array character (char_len) :: & - lvarname ! variable name -! dimname ! dimension name + lvarname ! variable name +! dimname ! dimension name real (kind=dbl_kind), dimension(:,:), allocatable :: & work_g1 @@ -2315,19 +2283,19 @@ subroutine ice_write_nc_xy(fid, nrec, varid, work, diag, & if (my_task == master_task) then - !-------------------------------------------------------------- - ! Write global array - !-------------------------------------------------------------- + !-------------------------------------------------------------- + ! Write global array + !-------------------------------------------------------------- status = nf90_put_var( fid, varid, work_g1, & - start=(/1,1,nrec/), & - count=(/nx,ny,1/)) - + start=(/1,1,nrec/), count=(/nx,ny,1/)) + call ice_check_nc(status, subname//' ERROR: Cannot put variable ', & + file=__FILE__, line=__LINE__ ) endif ! my_task = master_task - !------------------------------------------------------------------- - ! optional diagnostics - !------------------------------------------------------------------- + !------------------------------------------------------------------- + ! optional diagnostics + !------------------------------------------------------------------- if (my_task==master_task .and. diag) then ! write(nu_diag,*) & @@ -2366,21 +2334,21 @@ subroutine ice_write_nc_xyz(fid, nrec, varid, work, diag, & use ice_gather_scatter, only: gather_global, gather_global_ext integer (kind=int_kind), intent(in) :: & - fid , & ! file id - varid , & ! variable id - nrec ! record number + fid , & ! file id + varid , & ! variable id + nrec ! record number logical (kind=log_kind), intent(in) :: & - diag ! if true, write diagnostic output + diag ! if true, write diagnostic output logical (kind=log_kind), optional, intent(in) :: & - restart_ext ! if true, read extended grid + restart_ext ! if true, read extended grid real (kind=dbl_kind), dimension(nx_block,ny_block,ncat,max_blocks), intent(in) :: & - work ! output array (real, 8-byte) + work ! output array (real, 8-byte) character (len=*), optional, intent(in) :: & - varname ! variable name + varname ! variable name ! local variables @@ -2389,18 +2357,18 @@ subroutine ice_write_nc_xyz(fid, nrec, varid, work, diag, & #ifdef USE_NETCDF ! netCDF file diagnostics: integer (kind=int_kind) :: & - n, & ! ncat index - status ! status output from netcdf routines -! ndim, nvar, & ! sizes of netcdf file -! id, & ! dimension index -! dimlen ! size of dimension + n, & ! ncat index + status ! status output from netcdf routines +! ndim, nvar, & ! sizes of netcdf file +! id, & ! dimension index +! dimlen ! size of dimension real (kind=dbl_kind) :: & - amin, amax, asum ! min, max values and sum of input array + amin, amax, asum ! min, max values and sum of input array character (char_len) :: & - lvarname ! variable name -! dimname ! dimension name + lvarname ! variable name +! dimname ! dimension name real (kind=dbl_kind), dimension(:,:,:), allocatable :: & work_g1 @@ -2445,19 +2413,19 @@ subroutine ice_write_nc_xyz(fid, nrec, varid, work, diag, & if (my_task == master_task) then - !-------------------------------------------------------------- - ! Read global array - !-------------------------------------------------------------- + !-------------------------------------------------------------- + ! Write global array + !-------------------------------------------------------------- status = nf90_put_var( fid, varid, work_g1, & - start=(/1,1,1,nrec/), & - count=(/nx,ny,ncat,1/)) - + start=(/1,1,1,nrec/), count=(/nx,ny,ncat,1/)) + call ice_check_nc(status, subname//' ERROR: Cannot put variable ', & + file=__FILE__, line=__LINE__ ) endif ! my_task = master_task - !------------------------------------------------------------------- - ! optional diagnostics - !------------------------------------------------------------------- + !------------------------------------------------------------------- + ! optional diagnostics + !------------------------------------------------------------------- if (my_task==master_task .and. diag) then ! write(nu_diag,*) & @@ -2500,17 +2468,17 @@ end subroutine ice_write_nc_xyz subroutine ice_read_global_nc (fid, nrec, varname, work_g, diag) integer (kind=int_kind), intent(in) :: & - fid , & ! file id - nrec ! record number + fid , & ! file id + nrec ! record number - character (char_len), intent(in) :: & - varname ! field name in netcdf file + character (char_len), intent(in) :: & + varname ! field name in netcdf file real (kind=dbl_kind), dimension(nx_global,ny_global), intent(out) :: & - work_g ! output array (real, 8-byte) + work_g ! output array (real, 8-byte) logical (kind=log_kind) :: & - diag ! if true, write diagnostic output + diag ! if true, write diagnostic output ! local variables @@ -2519,17 +2487,17 @@ subroutine ice_read_global_nc (fid, nrec, varname, work_g, diag) #ifdef USE_NETCDF ! netCDF file diagnostics: integer (kind=int_kind) :: & - varid, & ! netcdf id for field - status ! status output from netcdf routines -! ndim, nvar, & ! sizes of netcdf file -! id, & ! dimension index -! dimlen ! size of dimension + varid, & ! netcdf id for field + status ! status output from netcdf routines +! ndim, nvar, & ! sizes of netcdf file +! id, & ! dimension index +! dimlen ! size of dimension real (kind=dbl_kind) :: & - amin, amax, asum ! min, max values and sum of input array + amin, amax, asum ! min, max values and sum of input array ! character (char_len) :: & -! dimname ! dimension name +! dimname ! dimension name ! real (kind=dbl_kind), dimension(:,:), allocatable :: & work_g3 @@ -2547,43 +2515,35 @@ subroutine ice_read_global_nc (fid, nrec, varname, work_g, diag) if (my_task == master_task) then - !------------------------------------------------------------- - ! Find out ID of required variable - !------------------------------------------------------------- + !------------------------------------------------------------- + ! Find out ID of required variable + !------------------------------------------------------------- status = nf90_inq_varid(fid, trim(varname), varid) - if (status /= nf90_noerr) then - call abort_ice(subname//' ERROR: Cannot find variable '//trim(varname), & - file=__FILE__, line=__LINE__) - endif + call ice_check_nc(status, subname//' ERROR: Cannot find variable '//trim(varname), & + file=__FILE__, line=__LINE__) - !-------------------------------------------------------------- - ! Read global array - !-------------------------------------------------------------- + !-------------------------------------------------------------- + ! Read global array + !-------------------------------------------------------------- if (orca_halogrid) then status = nf90_get_var( fid, varid, work_g3, & - start=(/1,1,nrec/), & - count=(/nx_global+2,ny_global+1,1/)) - if (status /= nf90_noerr) then - call abort_ice(subname//' ERROR: Cannot get variable '//trim(varname), & - file=__FILE__, line=__LINE__) - endif + start=(/1,1,nrec/), count=(/nx_global+2,ny_global+1,1/)) + call ice_check_nc(status, subname//' ERROR: Cannot get variable '//trim(varname), & + file=__FILE__, line=__LINE__) work_g=work_g3(2:nx_global+1,1:ny_global) else status = nf90_get_var( fid, varid, work_g, & - start=(/1,1,nrec/), & - count=(/nx_global,ny_global,1/)) - if (status /= nf90_noerr) then - call abort_ice(subname//' ERROR: Cannot get variable '//trim(varname), & - file=__FILE__, line=__LINE__) - endif + start=(/1,1,nrec/), count=(/nx_global,ny_global,1/)) + call ice_check_nc(status, subname//' ERROR: Cannot get variable '//trim(varname), & + file=__FILE__, line=__LINE__) endif endif ! my_task = master_task - !------------------------------------------------------------------- - ! optional diagnostics - !------------------------------------------------------------------- + !------------------------------------------------------------------- + ! optional diagnostics + !------------------------------------------------------------------- if (my_task == master_task .and. diag) then ! write(nu_diag,*) & @@ -2613,13 +2573,47 @@ end subroutine ice_read_global_nc !======================================================================= +! Report a netcdf error +! author: T. Craig + + subroutine ice_check_nc(status, abort_msg, file, line) + integer(kind=int_kind), intent (in) :: status + character (len=*) , intent (in) :: abort_msg + character (len=*) , intent (in), optional :: file + integer(kind=int_kind), intent (in), optional :: line + + ! local variables + + character(len=*), parameter :: subname = '(ice_check_nc)' + +#ifdef USE_NETCDF + if (status /= nf90_noerr) then + if (present(file) .and. present(line)) then + call abort_ice(subname//' '//trim(nf90_strerror(status))//', '//trim(abort_msg), & + file=file, line=line) + elseif (present(file)) then + call abort_ice(subname//' '//trim(nf90_strerror(status))//', '//trim(abort_msg), & + file=file) + else + call abort_ice(subname//' '//trim(nf90_strerror(status))//', '//trim(abort_msg)) + endif + endif +#else + call abort_ice(subname//' ERROR: USE_NETCDF cpp not defined', & + file=__FILE__, line=__LINE__) +#endif + + end subroutine ice_check_nc + +!======================================================================= + ! Closes a netCDF file ! author: Alison McLaren, Met Office subroutine ice_close_nc(fid) integer (kind=int_kind), intent(in) :: & - fid ! unit number + fid ! unit number ! local variables @@ -2631,6 +2625,8 @@ subroutine ice_close_nc(fid) if (my_task == master_task) then status = nf90_close(fid) + call ice_check_nc(status, subname//' ERROR: Cannot close file ', & + file=__FILE__, line=__LINE__ ) endif #else call abort_ice(subname//' ERROR: USE_NETCDF cpp not defined', & @@ -2655,25 +2651,25 @@ subroutine ice_read_nc_uv(fid, nrec, nzlev, varname, work, diag, & use ice_gather_scatter, only: scatter_global, scatter_global_ext integer (kind=int_kind), intent(in) :: & - fid , & ! file id - nrec , & ! record number - nzlev ! z level + fid , & ! file id + nrec , & ! record number + nzlev ! z level logical (kind=log_kind), intent(in) :: & - diag ! if true, write diagnostic output + diag ! if true, write diagnostic output character (len=*), intent(in) :: & - varname ! field name in netcdf file + varname ! field name in netcdf file real (kind=dbl_kind), dimension(nx_block,ny_block,max_blocks), intent(out) :: & - work ! output array (real, 8-byte) + work ! output array (real, 8-byte) logical (kind=log_kind), optional, intent(in) :: & - restart_ext ! if true, read extended grid + restart_ext ! if true, read extended grid integer (kind=int_kind), optional, intent(in) :: & - field_loc, & ! location of field on staggered grid - field_type ! type of field (scalar, vector, angle) + field_loc, & ! location of field on staggered grid + field_type ! type of field (scalar, vector, angle) ! local variables @@ -2682,17 +2678,17 @@ subroutine ice_read_nc_uv(fid, nrec, nzlev, varname, work, diag, & #ifdef USE_NETCDF ! netCDF file diagnostics: integer (kind=int_kind) :: & - varid , & ! variable id - status ! status output from netcdf routines -! ndim, nvar, & ! sizes of netcdf file -! id, & ! dimension index -! dimlen ! size of dimension + varid , & ! variable id + status ! status output from netcdf routines +! ndim, nvar , & ! sizes of netcdf file +! id, & ! dimension index +! dimlen ! size of dimension real (kind=dbl_kind) :: & - amin, amax, asum ! min, max values and sum of input array + amin, amax, asum ! min, max values and sum of input array ! character (char_len) :: & -! dimname ! dimension name +! dimname ! dimension name real (kind=dbl_kind), dimension(:,:), allocatable :: & work_g1 @@ -2717,33 +2713,28 @@ subroutine ice_read_nc_uv(fid, nrec, nzlev, varname, work, diag, & if (my_task == master_task) then - !------------------------------------------------------------- - ! Find out ID of required variable - !------------------------------------------------------------- + !------------------------------------------------------------- + ! Find out ID of required variable + !------------------------------------------------------------- status = nf90_inq_varid(fid, trim(varname), varid) - if (status /= nf90_noerr) then - call abort_ice(subname//' ERROR: Cannot find variable '//trim(varname), & - file=__FILE__, line=__LINE__) - endif + call ice_check_nc(status, subname//' ERROR: Cannot find variable '//trim(varname), & + file=__FILE__, line=__LINE__) - !-------------------------------------------------------------- - ! Read global array - !-------------------------------------------------------------- + !-------------------------------------------------------------- + ! Read global array + !-------------------------------------------------------------- status = nf90_get_var( fid, varid, work_g1, & - start=(/1,1,nzlev,nrec/), & - count=(/nx,ny,1,1/)) - if (status /= nf90_noerr) then - call abort_ice(subname//' ERROR: Cannot get variable '//trim(varname), & - file=__FILE__, line=__LINE__) - endif + start=(/1,1,nzlev,nrec/), count=(/nx,ny,1,1/)) + call ice_check_nc(status, subname//' ERROR: Cannot get variable '//trim(varname), & + file=__FILE__, line=__LINE__) endif ! my_task = master_task - !------------------------------------------------------------------- - ! optional diagnostics - !------------------------------------------------------------------- + !------------------------------------------------------------------- + ! optional diagnostics + !------------------------------------------------------------------- if (my_task==master_task .and. diag) then amin = minval(work_g1) @@ -2752,10 +2743,10 @@ subroutine ice_read_nc_uv(fid, nrec, nzlev, varname, work, diag, & write(nu_diag,*) subname,' min, max, sum =', amin, amax, asum, trim(varname) endif - !------------------------------------------------------------------- - ! Scatter data to individual processors. - ! NOTE: Ghost cells are not updated unless field_loc is present. - !------------------------------------------------------------------- + !------------------------------------------------------------------- + ! Scatter data to individual processors. + ! NOTE: Ghost cells are not updated unless field_loc is present. + !------------------------------------------------------------------- if (present(restart_ext)) then if (restart_ext) then @@ -2792,18 +2783,17 @@ end subroutine ice_read_nc_uv subroutine ice_read_vec_nc (fid, nrec, varname, work_g, diag) integer (kind=int_kind), intent(in) :: & - fid , & ! file id - nrec ! record number + fid , & ! file id + nrec ! record number character (char_len), intent(in) :: & - varname ! field name in netcdf file + varname ! field name in netcdf file - real (kind=dbl_kind), dimension(nrec), & - intent(out) :: & - work_g ! output array (real, 8-byte) + real (kind=dbl_kind), dimension(nrec), intent(out) :: & + work_g ! output array (real, 8-byte) logical (kind=log_kind) :: & - diag ! if true, write diagnostic output + diag ! if true, write diagnostic output ! local variables @@ -2812,37 +2802,32 @@ subroutine ice_read_vec_nc (fid, nrec, varname, work_g, diag) #ifdef USE_NETCDF ! netCDF file diagnostics: integer (kind=int_kind) :: & - varid, & ! netcdf id for field - status ! status output from netcdf routines + varid, & ! netcdf id for field + status ! status output from netcdf routines real (kind=dbl_kind) :: & - amin, amax ! min, max values of input vector + amin, amax ! min, max values of input vector work_g(:) = c0 if (my_task == master_task) then - !------------------------------------------------------------- - ! Find out ID of required variable - !------------------------------------------------------------- + !------------------------------------------------------------- + ! Find out ID of required variable + !------------------------------------------------------------- status = nf90_inq_varid(fid, trim(varname), varid) - if (status /= nf90_noerr) then - call abort_ice(subname//' ERROR: Cannot find variable '//trim(varname), & - file=__FILE__, line=__LINE__) - endif + call ice_check_nc(status, subname//' ERROR: Cannot find variable '//trim(varname), & + file=__FILE__, line=__LINE__) - !-------------------------------------------------------------- - ! Read global array - !-------------------------------------------------------------- + !-------------------------------------------------------------- + ! Read global array + !-------------------------------------------------------------- status = nf90_get_var( fid, varid, work_g, & - start=(/1/), & - count=(/nrec/)) - if (status /= nf90_noerr) then - call abort_ice(subname//' ERROR: Cannot get variable '//trim(varname), & - file=__FILE__, line=__LINE__) - endif + start=(/1/), count=(/nrec/)) + call ice_check_nc(status, subname//' ERROR: Cannot get variable '//trim(varname), & + file=__FILE__, line=__LINE__) endif ! my_task = master_task @@ -2888,26 +2873,22 @@ subroutine ice_get_ncvarsize(fid,varname,recsize) #ifdef USE_NETCDF if (my_task == master_task) then status=nf90_inquire(fid, nDimensions = nDims) - if (status /= nf90_noerr) then - call abort_ice(subname//' ERROR: inquire nDimensions', & - file=__FILE__, line=__LINE__ ) - endif + call ice_check_nc(status, subname//' ERROR: inquire nDimensions', & + file=__FILE__, line=__LINE__ ) do i=1,nDims status = nf90_inquire_dimension(fid,i,name=cvar,len=recsize) - if (status /= nf90_noerr) then - call abort_ice(subname//' ERROR: inquire len for variable '//trim(cvar), & - file=__FILE__, line=__LINE__) - endif + call ice_check_nc(status, subname//' ERROR: inquire len for variable '//trim(cvar), & + file=__FILE__, line=__LINE__) if (trim(cvar) == trim(varname)) exit enddo if (trim(cvar) .ne. trim(varname)) then call abort_ice(subname//' ERROR: Did not find variable '//trim(varname), & - file=__FILE__, line=__LINE__) + file=__FILE__, line=__LINE__) endif endif #else call abort_ice(subname//' ERROR: USE_NETCDF cpp not defined', & - file=__FILE__, line=__LINE__) + file=__FILE__, line=__LINE__) recsize = 0 ! to satisfy intent(out) attribute #endif diff --git a/cicecore/cicedyn/infrastructure/ice_restoring.F90 b/cicecore/cicedyn/infrastructure/ice_restoring.F90 index 221d066df..27328d9dd 100644 --- a/cicecore/cicedyn/infrastructure/ice_restoring.F90 +++ b/cicecore/cicedyn/infrastructure/ice_restoring.F90 @@ -88,7 +88,7 @@ subroutine ice_HaloRestore_init if ((ew_boundary_type == 'open' .or. & ns_boundary_type == 'open') .and. .not.(restart_ext)) then - if (my_task == master_task) write (nu_diag,*) 'ERROR: restart_ext=F and open boundaries' + if (my_task == master_task) write (nu_diag,*) ' ERROR: restart_ext=F and open boundaries' call abort_ice(error_message=subname//'open boundary and restart_ext=F', & file=__FILE__, line=__LINE__) endif diff --git a/cicecore/cicedyn/infrastructure/io/io_binary/ice_history_write.F90 b/cicecore/cicedyn/infrastructure/io/io_binary/ice_history_write.F90 index 526d0d96d..b16d00f07 100644 --- a/cicecore/cicedyn/infrastructure/io/io_binary/ice_history_write.F90 +++ b/cicecore/cicedyn/infrastructure/io/io_binary/ice_history_write.F90 @@ -160,6 +160,7 @@ subroutine ice_write_hist(ns) if (histfreq(ns) == '1' .or. .not. hist_avg(ns) & .or. write_ic & .or. n==n_divu(ns) .or. n==n_shear(ns) & ! snapshots + .or. n==n_vort(ns) & ! snapshots .or. n==n_sig1(ns) .or. n==n_sig2(ns) & .or. n==n_sigP(ns) .or. n==n_trsig(ns) & .or. n==n_sistreave(ns) .or. n==n_sistremax(ns) & diff --git a/cicecore/cicedyn/infrastructure/io/io_binary/ice_restart.F90 b/cicecore/cicedyn/infrastructure/io/io_binary/ice_restart.F90 index cc158fccc..606f0d46b 100644 --- a/cicecore/cicedyn/infrastructure/io/io_binary/ice_restart.F90 +++ b/cicecore/cicedyn/infrastructure/io/io_binary/ice_restart.F90 @@ -128,7 +128,7 @@ subroutine init_restart_read(ice_ic) if (kdyn == 2) then if (my_task == master_task) then n = index(filename0,trim(restart_file)) - if (n == 0) call abort_ice(subname//'ERROR: eap restart: filename discrepancy') + if (n == 0) call abort_ice(subname//' ERROR: eap restart: filename discrepancy') string1 = trim(filename0(1:n-1)) string2 = trim(filename0(n+lenstr(restart_file):lenstr(filename0))) write(filename,'(a,a,a,a)') & @@ -148,7 +148,7 @@ subroutine init_restart_read(ice_ic) if (tr_fsd) then if (my_task == master_task) then n = index(filename0,trim(restart_file)) - if (n == 0) call abort_ice(subname//'ERROR: fsd restart: filename discrepancy') + if (n == 0) call abort_ice(subname//' ERROR: fsd restart: filename discrepancy') string1 = trim(filename0(1:n-1)) string2 = trim(filename0(n+lenstr(restart_file):lenstr(filename0))) write(filename,'(a,a,a,a)') & @@ -168,7 +168,7 @@ subroutine init_restart_read(ice_ic) if (tr_iage) then if (my_task == master_task) then n = index(filename0,trim(restart_file)) - if (n == 0) call abort_ice(subname//'ERROR: iage restart: filename discrepancy') + if (n == 0) call abort_ice(subname//' ERROR: iage restart: filename discrepancy') string1 = trim(filename0(1:n-1)) string2 = trim(filename0(n+lenstr(restart_file):lenstr(filename0))) write(filename,'(a,a,a,a)') & @@ -188,7 +188,7 @@ subroutine init_restart_read(ice_ic) if (tr_FY) then if (my_task == master_task) then n = index(filename0,trim(restart_file)) - if (n == 0) call abort_ice(subname//'ERROR: FY restart: filename discrepancy') + if (n == 0) call abort_ice(subname//' ERROR: FY restart: filename discrepancy') string1 = trim(filename0(1:n-1)) string2 = trim(filename0(n+lenstr(restart_file):lenstr(filename0))) write(filename,'(a,a,a,a)') & @@ -208,7 +208,7 @@ subroutine init_restart_read(ice_ic) if (tr_lvl) then if (my_task == master_task) then n = index(filename0,trim(restart_file)) - if (n == 0) call abort_ice(subname//'ERROR: lvl restart: filename discrepancy') + if (n == 0) call abort_ice(subname//' ERROR: lvl restart: filename discrepancy') string1 = trim(filename0(1:n-1)) string2 = trim(filename0(n+lenstr(restart_file):lenstr(filename0))) write(filename,'(a,a,a,a)') & @@ -228,7 +228,7 @@ subroutine init_restart_read(ice_ic) if (tr_pond_lvl) then if (my_task == master_task) then n = index(filename0,trim(restart_file)) - if (n == 0) call abort_ice(subname//'ERROR:pond_lvl restart: filename discrepancy') + if (n == 0) call abort_ice(subname//' ERROR:pond_lvl restart: filename discrepancy') string1 = trim(filename0(1:n-1)) string2 = trim(filename0(n+lenstr(restart_file):lenstr(filename0))) write(filename,'(a,a,a,a)') & @@ -248,7 +248,7 @@ subroutine init_restart_read(ice_ic) if (tr_pond_topo) then if (my_task == master_task) then n = index(filename0,trim(restart_file)) - if (n == 0) call abort_ice(subname//'ERROR: pond_topo restart: filename discrepancy') + if (n == 0) call abort_ice(subname//' ERROR: pond_topo restart: filename discrepancy') string1 = trim(filename0(1:n-1)) string2 = trim(filename0(n+lenstr(restart_file):lenstr(filename0))) write(filename,'(a,a,a,a)') & @@ -268,7 +268,7 @@ subroutine init_restart_read(ice_ic) if (tr_snow) then if (my_task == master_task) then n = index(filename0,trim(restart_file)) - if (n == 0) call abort_ice(subname//'ERROR: snow restart: filename discrepancy') + if (n == 0) call abort_ice(subname//' ERROR: snow restart: filename discrepancy') string1 = trim(filename0(1:n-1)) string2 = trim(filename0(n+lenstr(restart_file):lenstr(filename0))) write(filename,'(a,a,a,a)') & @@ -288,7 +288,7 @@ subroutine init_restart_read(ice_ic) if (tr_brine) then if (my_task == master_task) then n = index(filename0,trim(restart_file)) - if (n == 0) call abort_ice(subname//'ERROR: brine restart: filename discrepancy') + if (n == 0) call abort_ice(subname//' ERROR: brine restart: filename discrepancy') string1 = trim(filename0(1:n-1)) string2 = trim(filename0(n+lenstr(restart_file):lenstr(filename0))) write(filename,'(a,a,a,a)') & @@ -308,7 +308,7 @@ subroutine init_restart_read(ice_ic) if (nbtrcr > 0) then if (my_task == master_task) then n = index(filename0,trim(restart_file)) - if (n == 0) call abort_ice(subname//'ERROR: bgc restart: filename discrepancy') + if (n == 0) call abort_ice(subname//' ERROR: bgc restart: filename discrepancy') string1 = trim(filename0(1:n-1)) string2 = trim(filename0(n+lenstr(restart_file):lenstr(filename0))) write(filename,'(a,a,a,a)') & @@ -328,7 +328,7 @@ subroutine init_restart_read(ice_ic) if (tr_iso) then if (my_task == master_task) then n = index(filename0,trim(restart_file)) - if (n == 0) call abort_ice(subname//'ERROR: iso restart: filename discrepancy') + if (n == 0) call abort_ice(subname//' ERROR: iso restart: filename discrepancy') string1 = trim(filename0(1:n-1)) string2 = trim(filename0(n+lenstr(restart_file):lenstr(filename0))) write(filename,'(a,a,a,a)') & @@ -348,7 +348,7 @@ subroutine init_restart_read(ice_ic) if (tr_aero) then if (my_task == master_task) then n = index(filename0,trim(restart_file)) - if (n == 0) call abort_ice(subname//'ERROR: aero restart: filename discrepancy') + if (n == 0) call abort_ice(subname//' ERROR: aero restart: filename discrepancy') string1 = trim(filename0(1:n-1)) string2 = trim(filename0(n+lenstr(restart_file):lenstr(filename0))) write(filename,'(a,a,a,a)') & diff --git a/cicecore/cicedyn/infrastructure/io/io_netcdf/ice_history_write.F90 b/cicecore/cicedyn/infrastructure/io/io_netcdf/ice_history_write.F90 index 51d76a6f4..c03bc233a 100644 --- a/cicecore/cicedyn/infrastructure/io/io_netcdf/ice_history_write.F90 +++ b/cicecore/cicedyn/infrastructure/io/io_netcdf/ice_history_write.F90 @@ -24,13 +24,32 @@ module ice_history_write use ice_constants, only: c0, c360, p5, spval, spval_dbl use ice_fileunits, only: nu_diag use ice_exit, only: abort_ice + use ice_read_write, only: ice_check_nc use icepack_intfc, only: icepack_warnings_flush, icepack_warnings_aborted use icepack_intfc, only: icepack_query_parameters + use ice_kinds_mod, only: int_kind +#ifdef USE_NETCDF + use netcdf +#endif implicit none private + + TYPE coord_attributes ! netcdf coordinate attributes + character (len=11) :: short_name + character (len=45) :: long_name + character (len=30) :: units + END TYPE coord_attributes + + TYPE req_attributes ! req'd netcdf attributes + type (coord_attributes) :: req + character (len=20) :: coordinates + END TYPE req_attributes + public :: ice_write_hist + integer (kind=int_kind) :: imtid,jmtid + !======================================================================= contains @@ -60,13 +79,9 @@ subroutine ice_write_hist (ns) lont_bounds, latt_bounds, lonu_bounds, latu_bounds, & lonn_bounds, latn_bounds, lone_bounds, late_bounds use ice_history_shared - use ice_restart_shared, only: lcdf64 #ifdef CESMCOUPLED use ice_restart_shared, only: runid #endif -#ifdef USE_NETCDF - use netcdf -#endif integer (kind=int_kind), intent(in) :: ns @@ -77,7 +92,7 @@ subroutine ice_write_hist (ns) real (kind=dbl_kind), dimension(nx_block,ny_block,max_blocks) :: work1 integer (kind=int_kind) :: i,k,ic,n,nn, & - ncid,status,imtid,jmtid,kmtidi,kmtids,kmtidb, cmtid,timid,varid, & + ncid,status,kmtidi,kmtids,kmtidb, cmtid,timid,varid, & nvertexid,ivertex,kmtida,iflag, fmtid integer (kind=int_kind), dimension(3) :: dimid integer (kind=int_kind), dimension(4) :: dimidz @@ -85,18 +100,19 @@ subroutine ice_write_hist (ns) integer (kind=int_kind), dimension(3) :: dimid_nverts integer (kind=int_kind), dimension(6) :: dimidex real (kind=dbl_kind) :: ltime2 - character (char_len) :: title + character (char_len) :: title, cal_units, cal_att character (char_len) :: time_period_freq = 'none' character (char_len_long) :: ncfile(max_nstrm) real (kind=dbl_kind) :: secday, rad_to_deg - integer (kind=int_kind) :: ind,boundid - - integer (kind=int_kind) :: lprecision + integer (kind=int_kind) :: ind,boundid, lprecision character (char_len) :: start_time,current_date,current_time character (len=8) :: cdate + ! time coord + TYPE(coord_attributes) :: time_coord + ! 8 coordinate variables: TLON, TLAT, ULON, ULAT, NLON, NLAT, ELON, ELAT INTEGER (kind=int_kind), PARAMETER :: ncoord = 8 @@ -107,17 +123,6 @@ subroutine ice_write_hist (ns) ! lont_bounds, latt_bounds, lonu_bounds, latu_bounds INTEGER (kind=int_kind), PARAMETER :: nvar_verts = 8 - TYPE coord_attributes ! netcdf coordinate attributes - character (len=11) :: short_name - character (len=45) :: long_name - character (len=20) :: units - END TYPE coord_attributes - - TYPE req_attributes ! req'd netcdf attributes - type (coord_attributes) :: req - character (len=20) :: coordinates - END TYPE req_attributes - TYPE(req_attributes), dimension(nvar_grd) :: var_grd TYPE(coord_attributes), dimension(ncoord) :: var_coord TYPE(coord_attributes), dimension(nvar_verts) :: var_nverts @@ -137,654 +142,555 @@ subroutine ice_write_hist (ns) if (my_task == master_task) then - call construct_filename(ncfile(ns),'nc',ns) - - ! add local directory path name to ncfile - if (write_ic) then - ncfile(ns) = trim(incond_dir)//ncfile(ns) - else - ncfile(ns) = trim(history_dir)//ncfile(ns) - endif - - ! create file - iflag = nf90_clobber - if (lcdf64) iflag = ior(iflag,nf90_64bit_offset) - status = nf90_create(ncfile(ns), iflag, ncid) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: creating history ncfile '//ncfile(ns)) - - !----------------------------------------------------------------- - ! define dimensions - !----------------------------------------------------------------- - - if (hist_avg(ns) .and. .not. write_ic) then - status = nf90_def_dim(ncid,'nbnd',2,boundid) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: defining dim nbnd') - endif - - status = nf90_def_dim(ncid,'ni',nx_global,imtid) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: defining dim ni') + call construct_filename(ncfile(ns),'nc',ns) - status = nf90_def_dim(ncid,'nj',ny_global,jmtid) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: defining dim nj') - - status = nf90_def_dim(ncid,'nc',ncat_hist,cmtid) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: defining dim nc') - - status = nf90_def_dim(ncid,'nkice',nzilyr,kmtidi) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: defining dim nki') - - status = nf90_def_dim(ncid,'nksnow',nzslyr,kmtids) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: defining dim nks') - - status = nf90_def_dim(ncid,'nkbio',nzblyr,kmtidb) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: defining dim nkb') - - status = nf90_def_dim(ncid,'nkaer',nzalyr,kmtida) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: defining dim nka') - - status = nf90_def_dim(ncid,'time',NF90_UNLIMITED,timid) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: defining dim time') - - status = nf90_def_dim(ncid,'nvertices',nverts,nvertexid) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: defining dim nverts') - - status = nf90_def_dim(ncid,'nf',nfsd_hist,fmtid) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: defining dim nf') - - !----------------------------------------------------------------- - ! define coordinate variables - !----------------------------------------------------------------- + ! add local directory path name to ncfile + if (write_ic) then + ncfile(ns) = trim(incond_dir)//ncfile(ns) + else + ncfile(ns) = trim(history_dir)//ncfile(ns) + endif - status = nf90_def_var(ncid,'time',nf90_double,timid,varid) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: defining var time') - - status = nf90_put_att(ncid,varid,'long_name','time') - if (status /= nf90_noerr) call abort_ice(subname// & - 'ice Error: time long_name') - - write(cdate,'(i8.8)') idate0 - write(title,'(a,a4,a1,a2,a1,a2,a1,i2.2,a1,i2.2,a1,i2.2)') 'days since ', & - cdate(1:4),'-',cdate(5:6),'-',cdate(7:8),' ', & - hh_init,':',mm_init,':',ss_init - status = nf90_put_att(ncid,varid,'units',title) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: time units') - - if (days_per_year == 360) then - status = nf90_put_att(ncid,varid,'calendar','360_day') - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: time calendar') - elseif (days_per_year == 365 .and. .not.use_leap_years ) then - status = nf90_put_att(ncid,varid,'calendar','noleap') - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: time calendar') - elseif (use_leap_years) then - status = nf90_put_att(ncid,varid,'calendar','Gregorian') - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: time calendar') - else - call abort_ice(subname//'ERROR: invalid calendar settings') - endif - - if (hist_avg(ns) .and. .not. write_ic) then - status = nf90_put_att(ncid,varid,'bounds','time_bounds') - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: time bounds') - endif + ! create file + if (history_format == 'cdf1') then + iflag = nf90_clobber + elseif (history_format == 'cdf2') then + iflag = ior(nf90_clobber,nf90_64bit_offset) + elseif (history_format == 'cdf5') then + iflag = ior(nf90_clobber,nf90_64bit_data) + elseif (history_format == 'hdf5') then + iflag = ior(nf90_clobber,nf90_netcdf4) + else + call abort_ice(subname//' ERROR: history_format not allowed for '//trim(history_format), & + file=__FILE__, line=__LINE__) + endif + status = nf90_create(ncfile(ns), iflag, ncid) + call ice_check_nc(status, subname// ' ERROR: creating history ncfile '//ncfile(ns), & + file=__FILE__, line=__LINE__) + + !----------------------------------------------------------------- + ! define dimensions + !----------------------------------------------------------------- + + if (hist_avg(ns) .and. .not. write_ic) then + status = nf90_def_dim(ncid,'nbnd',2,boundid) + call ice_check_nc(status, subname// ' ERROR: defining dim nbnd', & + file=__FILE__, line=__LINE__) + endif - !----------------------------------------------------------------- - ! Define attributes for time bounds if hist_avg is true - !----------------------------------------------------------------- + status = nf90_def_dim(ncid,'ni',nx_global,imtid) + call ice_check_nc(status, subname// ' ERROR: defining dim ni', & + file=__FILE__, line=__LINE__) + + status = nf90_def_dim(ncid,'nj',ny_global,jmtid) + call ice_check_nc(status, subname// ' ERROR: defining dim nj', & + file=__FILE__, line=__LINE__) + + status = nf90_def_dim(ncid,'nc',ncat_hist,cmtid) + call ice_check_nc(status, subname// ' ERROR: defining dim nc', & + file=__FILE__, line=__LINE__) + + status = nf90_def_dim(ncid,'nkice',nzilyr,kmtidi) + call ice_check_nc(status, subname// ' ERROR: defining dim nkice', & + file=__FILE__, line=__LINE__) + + status = nf90_def_dim(ncid,'nksnow',nzslyr,kmtids) + call ice_check_nc(status, subname// ' ERROR: defining dim nksnow', & + file=__FILE__, line=__LINE__) + + status = nf90_def_dim(ncid,'nkbio',nzblyr,kmtidb) + call ice_check_nc(status, subname// ' ERROR: defining dim nkbio', & + file=__FILE__, line=__LINE__) + + status = nf90_def_dim(ncid,'nkaer',nzalyr,kmtida) + call ice_check_nc(status, subname// ' ERROR: defining dim nkaer', & + file=__FILE__, line=__LINE__) + + status = nf90_def_dim(ncid,'time',NF90_UNLIMITED,timid) + call ice_check_nc(status, subname// ' ERROR: defining dim time', & + file=__FILE__, line=__LINE__) + + status = nf90_def_dim(ncid,'nvertices',nverts,nvertexid) + call ice_check_nc(status, subname// ' ERROR: defining dim nvertices', & + file=__FILE__, line=__LINE__) + + status = nf90_def_dim(ncid,'nf',nfsd_hist,fmtid) + call ice_check_nc(status, subname// ' ERROR: defining dim nf', & + file=__FILE__, line=__LINE__) + + !----------------------------------------------------------------- + ! define coordinate variables: time, time_bounds + !----------------------------------------------------------------- + + write(cdate,'(i8.8)') idate0 + write(cal_units,'(a,a4,a1,a2,a1,a2,a1,i2.2,a1,i2.2,a1,i2.2)') 'days since ', & + cdate(1:4),'-',cdate(5:6),'-',cdate(7:8),' ', & + hh_init,':',mm_init,':',ss_init + + if (days_per_year == 360) then + cal_att='360_day' + elseif (days_per_year == 365 .and. .not.use_leap_years ) then + cal_att='noleap' + elseif (use_leap_years) then + cal_att='Gregorian' + else + call abort_ice(subname//' ERROR: invalid calendar settings', file=__FILE__, line=__LINE__) + endif - if (hist_avg(ns) .and. .not. write_ic) then - dimid(1) = boundid - dimid(2) = timid - status = nf90_def_var(ncid,'time_bounds',lprecision,dimid(1:2),varid) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: defining var time_bounds') - status = nf90_put_att(ncid,varid,'long_name', & - 'time interval endpoints') - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: time_bounds long_name') - write(cdate,'(i8.8)') idate0 - write(title,'(a,a4,a1,a2,a1,a2,a1,i2.2,a1,i2.2,a1,i2.2)') 'days since ', & - cdate(1:4),'-',cdate(5:6),'-',cdate(7:8),' ', & - hh_init,':',mm_init,':',ss_init - status = nf90_put_att(ncid,varid,'units',title) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: time_bounds units') - if (days_per_year == 360) then - status = nf90_put_att(ncid,varid,'calendar','360_day') - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: time calendar') - elseif (days_per_year == 365 .and. .not.use_leap_years ) then - status = nf90_put_att(ncid,varid,'calendar','noleap') - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: time calendar') - elseif (use_leap_years) then - status = nf90_put_att(ncid,varid,'calendar','Gregorian') - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: time calendar') - else - call abort_ice(subname//'ERROR: invalid calendar settings') - endif - - endif + time_coord = coord_attributes('time', 'time', trim(cal_units)) + call ice_hist_coord_def(ncid, time_coord, nf90_double, (/timid/), varid) - !----------------------------------------------------------------- - ! define information for required time-invariant variables - !----------------------------------------------------------------- + status = nf90_put_att(ncid,varid,'calendar',cal_att) !extra attribute + call ice_check_nc(status, subname//' ERROR: defining att calendar: '//cal_att,file=__FILE__,line=__LINE__) + if (hist_avg(ns) .and. .not. write_ic) then + status = nf90_put_att(ncid,varid,'bounds','time_bounds') + call ice_check_nc(status, subname//' ERROR: defining att bounds time_bounds',file=__FILE__,line=__LINE__) + endif - ind = 0 - ind = ind + 1 - var_coord(ind) = coord_attributes('TLON', & - 'T grid center longitude', 'degrees_east') - coord_bounds(ind) = 'lont_bounds' - ind = ind + 1 - var_coord(ind) = coord_attributes('TLAT', & - 'T grid center latitude', 'degrees_north') - coord_bounds(ind) = 'latt_bounds' - ind = ind + 1 - var_coord(ind) = coord_attributes('ULON', & - 'U grid center longitude', 'degrees_east') - coord_bounds(ind) = 'lonu_bounds' - ind = ind + 1 - var_coord(ind) = coord_attributes('ULAT', & - 'U grid center latitude', 'degrees_north') - coord_bounds(ind) = 'latu_bounds' - ind = ind + 1 - var_coord(ind) = coord_attributes('NLON', & - 'N grid center longitude', 'degrees_east') - coord_bounds(ind) = 'lonn_bounds' - ind = ind + 1 - var_coord(ind) = coord_attributes('NLAT', & - 'N grid center latitude', 'degrees_north') - coord_bounds(ind) = 'latn_bounds' - ind = ind + 1 - var_coord(ind) = coord_attributes('ELON', & - 'E grid center longitude', 'degrees_east') - coord_bounds(ind) = 'lone_bounds' - ind = ind + 1 - var_coord(ind) = coord_attributes('ELAT', & - 'E grid center latitude', 'degrees_north') - coord_bounds(ind) = 'late_bounds' - - var_grdz(1) = coord_attributes('NCAT', 'category maximum thickness', 'm') - var_grdz(2) = coord_attributes('VGRDi', 'vertical ice levels', '1') - var_grdz(3) = coord_attributes('VGRDs', 'vertical snow levels', '1') - var_grdz(4) = coord_attributes('VGRDb', 'vertical ice-bio levels', '1') - var_grdz(5) = coord_attributes('VGRDa', 'vertical snow-ice-bio levels', '1') - var_grdz(6) = coord_attributes('NFSD', 'category floe size (center)', 'm') + ! Define coord time_bounds if hist_avg is true + if (hist_avg(ns) .and. .not. write_ic) then + time_coord = coord_attributes('time_bounds', 'time interval endpoints', trim(cal_units)) - !----------------------------------------------------------------- - ! define information for optional time-invariant variables - !----------------------------------------------------------------- + dimid(1) = boundid + dimid(2) = timid - var_grd(n_tmask)%req = coord_attributes('tmask', & - 'mask of T grid cells, 0 = land, 1 = ocean', 'unitless') - var_grd(n_tmask)%coordinates = 'TLON TLAT' - var_grd(n_umask)%req = coord_attributes('umask', & - 'mask of U grid cells, 0 = land, 1 = ocean', 'unitless') - var_grd(n_umask)%coordinates = 'ULON ULAT' - var_grd(n_nmask)%req = coord_attributes('nmask', & - 'mask of N grid cells, 0 = land, 1 = ocean', 'unitless') - var_grd(n_nmask)%coordinates = 'NLON NLAT' - var_grd(n_emask)%req = coord_attributes('emask', & - 'mask of E grid cells, 0 = land, 1 = ocean', 'unitless') - var_grd(n_emask)%coordinates = 'ELON ELAT' - - var_grd(n_tarea)%req = coord_attributes('tarea', & - 'area of T grid cells', 'm^2') - var_grd(n_tarea)%coordinates = 'TLON TLAT' - var_grd(n_uarea)%req = coord_attributes('uarea', & - 'area of U grid cells', 'm^2') - var_grd(n_uarea)%coordinates = 'ULON ULAT' - var_grd(n_narea)%req = coord_attributes('narea', & - 'area of N grid cells', 'm^2') - var_grd(n_narea)%coordinates = 'NLON NLAT' - var_grd(n_earea)%req = coord_attributes('earea', & - 'area of E grid cells', 'm^2') - var_grd(n_earea)%coordinates = 'ELON ELAT' - - var_grd(n_blkmask)%req = coord_attributes('blkmask', & - 'block id of T grid cells, mytask + iblk/100', 'unitless') - var_grd(n_blkmask)%coordinates = 'TLON TLAT' - - var_grd(n_dxt)%req = coord_attributes('dxt', & - 'T cell width through middle', 'm') - var_grd(n_dxt)%coordinates = 'TLON TLAT' - var_grd(n_dyt)%req = coord_attributes('dyt', & - 'T cell height through middle', 'm') - var_grd(n_dyt)%coordinates = 'TLON TLAT' - var_grd(n_dxu)%req = coord_attributes('dxu', & - 'U cell width through middle', 'm') - var_grd(n_dxu)%coordinates = 'ULON ULAT' - var_grd(n_dyu)%req = coord_attributes('dyu', & - 'U cell height through middle', 'm') - var_grd(n_dyu)%coordinates = 'ULON ULAT' - var_grd(n_dxn)%req = coord_attributes('dxn', & - 'N cell width through middle', 'm') - var_grd(n_dxn)%coordinates = 'NLON NLAT' - var_grd(n_dyn)%req = coord_attributes('dyn', & - 'N cell height through middle', 'm') - var_grd(n_dyn)%coordinates = 'NLON NLAT' - var_grd(n_dxe)%req = coord_attributes('dxe', & - 'E cell width through middle', 'm') - var_grd(n_dxe)%coordinates = 'ELON ELAT' - var_grd(n_dye)%req = coord_attributes('dye', & - 'E cell height through middle', 'm') - var_grd(n_dye)%coordinates = 'ELON ELAT' - - var_grd(n_HTN)%req = coord_attributes('HTN', & - 'T cell width on North side','m') - var_grd(n_HTN)%coordinates = 'TLON TLAT' - var_grd(n_HTE)%req = coord_attributes('HTE', & - 'T cell width on East side', 'm') - var_grd(n_HTE)%coordinates = 'TLON TLAT' - var_grd(n_ANGLE)%req = coord_attributes('ANGLE', & - 'angle grid makes with latitude line on U grid', & - 'radians') - var_grd(n_ANGLE)%coordinates = 'ULON ULAT' - var_grd(n_ANGLET)%req = coord_attributes('ANGLET', & - 'angle grid makes with latitude line on T grid', & - 'radians') - var_grd(n_ANGLET)%coordinates = 'TLON TLAT' - - ! These fields are required for CF compliance - ! dimensions (nx,ny,nverts) - var_nverts(n_lont_bnds) = coord_attributes('lont_bounds', & - 'longitude boundaries of T cells', 'degrees_east') - var_nverts(n_latt_bnds) = coord_attributes('latt_bounds', & - 'latitude boundaries of T cells', 'degrees_north') - var_nverts(n_lonu_bnds) = coord_attributes('lonu_bounds', & - 'longitude boundaries of U cells', 'degrees_east') - var_nverts(n_latu_bnds) = coord_attributes('latu_bounds', & - 'latitude boundaries of U cells', 'degrees_north') - var_nverts(n_lonn_bnds) = coord_attributes('lonn_bounds', & - 'longitude boundaries of N cells', 'degrees_east') - var_nverts(n_latn_bnds) = coord_attributes('latn_bounds', & - 'latitude boundaries of N cells', 'degrees_north') - var_nverts(n_lone_bnds) = coord_attributes('lone_bounds', & - 'longitude boundaries of E cells', 'degrees_east') - var_nverts(n_late_bnds) = coord_attributes('late_bounds', & - 'latitude boundaries of E cells', 'degrees_north') - - !----------------------------------------------------------------- - ! define attributes for time-invariant variables - !----------------------------------------------------------------- + call ice_hist_coord_def(ncid, time_coord, nf90_double, dimid(1:2), varid) + status = nf90_put_att(ncid,varid,'calendar',cal_att) + call ice_check_nc(status, subname//' ERROR: defining att calendar: '//cal_att,file=__FILE__,line=__LINE__) + endif - dimid(1) = imtid - dimid(2) = jmtid - dimid(3) = timid - - do i = 1, ncoord - status = nf90_def_var(ncid, var_coord(i)%short_name, lprecision, & - dimid(1:2), varid) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: defining short_name for '//var_coord(i)%short_name) - status = nf90_put_att(ncid,varid,'long_name',var_coord(i)%long_name) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: defining long_name for '//var_coord(i)%short_name) - status = nf90_put_att(ncid, varid, 'units', var_coord(i)%units) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: defining units for '//var_coord(i)%short_name) - call ice_write_hist_fill(ncid,varid,var_coord(i)%short_name,history_precision) - if (var_coord(i)%short_name == 'ULAT') then - status = nf90_put_att(ncid,varid,'comment', & - 'Latitude of NE corner of T grid cell') - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: defining comment for '//var_coord(i)%short_name) - endif - if (f_bounds) then - status = nf90_put_att(ncid, varid, 'bounds', coord_bounds(i)) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: defining bounds for '//var_coord(i)%short_name) - endif - enddo - - ! Extra dimensions (NCAT, NZILYR, NZSLYR, NZBLYR, NZALYR, NFSD) - dimidex(1)=cmtid - dimidex(2)=kmtidi - dimidex(3)=kmtids - dimidex(4)=kmtidb - dimidex(5)=kmtida - dimidex(6)=fmtid - - do i = 1, nvar_grdz - if (igrdz(i)) then - status = nf90_def_var(ncid, var_grdz(i)%short_name, & - lprecision, dimidex(i), varid) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: defining short_name for '//var_grdz(i)%short_name) - status = nf90_put_att(ncid,varid,'long_name',var_grdz(i)%long_name) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: defining long_name for '//var_grdz(i)%short_name) - status = nf90_put_att(ncid, varid, 'units', var_grdz(i)%units) - if (Status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: defining units for '//var_grdz(i)%short_name) - endif - enddo - - do i = 1, nvar_grd - if (igrd(i)) then - status = nf90_def_var(ncid, var_grd(i)%req%short_name, & - lprecision, dimid(1:2), varid) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: defining variable '//var_grd(i)%req%short_name) - status = nf90_put_att(ncid,varid, 'long_name', var_grd(i)%req%long_name) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: defining long_name for '//var_grd(i)%req%short_name) - status = nf90_put_att(ncid, varid, 'units', var_grd(i)%req%units) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: defining units for '//var_grd(i)%req%short_name) - status = nf90_put_att(ncid, varid, 'coordinates', var_grd(i)%coordinates) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: defining coordinates for '//var_grd(i)%req%short_name) - call ice_write_hist_fill(ncid,varid,var_grd(i)%req%short_name,history_precision) - endif - enddo - - ! Fields with dimensions (nverts,nx,ny) - dimid_nverts(1) = nvertexid - dimid_nverts(2) = imtid - dimid_nverts(3) = jmtid - do i = 1, nvar_verts - if (f_bounds) then - status = nf90_def_var(ncid, var_nverts(i)%short_name, & - lprecision,dimid_nverts, varid) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: defining variable '//var_nverts(i)%short_name) - status = nf90_put_att(ncid,varid, 'long_name', var_nverts(i)%long_name) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: defining long_name for '//var_nverts(i)%short_name) - status = nf90_put_att(ncid, varid, 'units', var_nverts(i)%units) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: defining units for '//var_nverts(i)%short_name) - call ice_write_hist_fill(ncid,varid,var_nverts(i)%short_name,history_precision) - endif - enddo - - do n=1,num_avail_hist_fields_2D - if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then - status = nf90_def_var(ncid, avail_hist_fields(n)%vname, & - lprecision, dimid, varid) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: defining variable '//avail_hist_fields(n)%vname) - call ice_write_hist_attrs(ncid,varid,avail_hist_fields(n),ns) - endif - enddo ! num_avail_hist_fields_2D - - dimidz(1) = imtid - dimidz(2) = jmtid - dimidz(3) = cmtid - dimidz(4) = timid - - do n = n2D + 1, n3Dccum - if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then - status = nf90_def_var(ncid, avail_hist_fields(n)%vname, & - lprecision, dimidz, varid) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: defining variable '//avail_hist_fields(n)%vname) - call ice_write_hist_attrs(ncid,varid,avail_hist_fields(n),ns) - endif - enddo ! num_avail_hist_fields_3Dc - - dimidz(1) = imtid - dimidz(2) = jmtid - dimidz(3) = kmtidi - dimidz(4) = timid - - do n = n3Dccum + 1, n3Dzcum - if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then - status = nf90_def_var(ncid, avail_hist_fields(n)%vname, & - lprecision, dimidz, varid) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: defining variable '//avail_hist_fields(n)%vname) - call ice_write_hist_attrs(ncid,varid,avail_hist_fields(n),ns) - endif - enddo ! num_avail_hist_fields_3Dz - - dimidz(1) = imtid - dimidz(2) = jmtid - dimidz(3) = kmtidb - dimidz(4) = timid - - do n = n3Dzcum + 1, n3Dbcum - if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then - status = nf90_def_var(ncid, avail_hist_fields(n)%vname, & - lprecision, dimidz, varid) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: defining variable '//avail_hist_fields(n)%vname) - call ice_write_hist_attrs(ncid,varid,avail_hist_fields(n),ns) - endif - enddo ! num_avail_hist_fields_3Db - - dimidz(1) = imtid - dimidz(2) = jmtid - dimidz(3) = kmtida - dimidz(4) = timid - - do n = n3Dbcum + 1, n3Dacum - if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then - status = nf90_def_var(ncid, avail_hist_fields(n)%vname, & - lprecision, dimidz, varid) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: defining variable '//avail_hist_fields(n)%vname) - call ice_write_hist_attrs(ncid,varid,avail_hist_fields(n),ns) - endif - enddo ! num_avail_hist_fields_3Da - - dimidz(1) = imtid - dimidz(2) = jmtid - dimidz(3) = fmtid - dimidz(4) = timid - - do n = n3Dacum + 1, n3Dfcum - if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then - status = nf90_def_var(ncid, avail_hist_fields(n)%vname, & - lprecision, dimidz, varid) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: defining variable '//avail_hist_fields(n)%vname) - call ice_write_hist_attrs(ncid,varid,avail_hist_fields(n),ns) - endif - enddo ! num_avail_hist_fields_3Df - - dimidcz(1) = imtid - dimidcz(2) = jmtid - dimidcz(3) = kmtidi - dimidcz(4) = cmtid - dimidcz(5) = timid - - do n = n3Dfcum + 1, n4Dicum - if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then - status = nf90_def_var(ncid, avail_hist_fields(n)%vname, & -! lprecision, dimidcz, varid) - lprecision, dimidcz(1:4), varid) ! ferret - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: defining variable '//avail_hist_fields(n)%vname) - call ice_write_hist_attrs(ncid,varid,avail_hist_fields(n),ns) - endif - enddo ! num_avail_hist_fields_4Di - - dimidcz(1) = imtid - dimidcz(2) = jmtid - dimidcz(3) = kmtids - dimidcz(4) = cmtid - dimidcz(5) = timid - - do n = n4Dicum + 1, n4Dscum - if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then - status = nf90_def_var(ncid, avail_hist_fields(n)%vname, & -! lprecision, dimidcz, varid) - lprecision, dimidcz(1:4), varid) ! ferret - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: defining variable '//avail_hist_fields(n)%vname) - call ice_write_hist_attrs(ncid,varid,avail_hist_fields(n),ns) - endif - enddo ! num_avail_hist_fields_4Ds - - dimidcz(1) = imtid - dimidcz(2) = jmtid - dimidcz(3) = fmtid - dimidcz(4) = cmtid - dimidcz(5) = timid - - do n = n4Dscum + 1, n4Dfcum - if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then - status = nf90_def_var(ncid, avail_hist_fields(n)%vname, & -! lprecision, dimidcz, varid) - lprecision, dimidcz(1:4), varid) ! ferret - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: defining variable '//avail_hist_fields(n)%vname) - call ice_write_hist_attrs(ncid,varid,avail_hist_fields(n),ns) - endif - enddo ! num_avail_hist_fields_4Df + !----------------------------------------------------------------- + ! define information for required time-invariant variables + !----------------------------------------------------------------- + + ind = 0 + ind = ind + 1 + var_coord(ind) = coord_attributes('TLON', & + 'T grid center longitude', 'degrees_east') + coord_bounds(ind) = 'lont_bounds' + ind = ind + 1 + var_coord(ind) = coord_attributes('TLAT', & + 'T grid center latitude', 'degrees_north') + coord_bounds(ind) = 'latt_bounds' + ind = ind + 1 + var_coord(ind) = coord_attributes('ULON', & + 'U grid center longitude', 'degrees_east') + coord_bounds(ind) = 'lonu_bounds' + ind = ind + 1 + var_coord(ind) = coord_attributes('ULAT', & + 'U grid center latitude', 'degrees_north') + coord_bounds(ind) = 'latu_bounds' + ind = ind + 1 + var_coord(ind) = coord_attributes('NLON', & + 'N grid center longitude', 'degrees_east') + coord_bounds(ind) = 'lonn_bounds' + ind = ind + 1 + var_coord(ind) = coord_attributes('NLAT', & + 'N grid center latitude', 'degrees_north') + coord_bounds(ind) = 'latn_bounds' + ind = ind + 1 + var_coord(ind) = coord_attributes('ELON', & + 'E grid center longitude', 'degrees_east') + coord_bounds(ind) = 'lone_bounds' + ind = ind + 1 + var_coord(ind) = coord_attributes('ELAT', & + 'E grid center latitude', 'degrees_north') + coord_bounds(ind) = 'late_bounds' + + var_grdz(1) = coord_attributes('NCAT', 'category maximum thickness', 'm') + var_grdz(2) = coord_attributes('VGRDi', 'vertical ice levels', '1') + var_grdz(3) = coord_attributes('VGRDs', 'vertical snow levels', '1') + var_grdz(4) = coord_attributes('VGRDb', 'vertical ice-bio levels', '1') + var_grdz(5) = coord_attributes('VGRDa', 'vertical snow-ice-bio levels', '1') + var_grdz(6) = coord_attributes('NFSD', 'category floe size (center)', 'm') + + !----------------------------------------------------------------- + ! define information for optional time-invariant variables + !----------------------------------------------------------------- + + var_grd(n_tmask)%req = coord_attributes('tmask', & + 'mask of T grid cells, 0 = land, 1 = ocean', 'unitless') + var_grd(n_tmask)%coordinates = 'TLON TLAT' + var_grd(n_umask)%req = coord_attributes('umask', & + 'mask of U grid cells, 0 = land, 1 = ocean', 'unitless') + var_grd(n_umask)%coordinates = 'ULON ULAT' + var_grd(n_nmask)%req = coord_attributes('nmask', & + 'mask of N grid cells, 0 = land, 1 = ocean', 'unitless') + var_grd(n_nmask)%coordinates = 'NLON NLAT' + var_grd(n_emask)%req = coord_attributes('emask', & + 'mask of E grid cells, 0 = land, 1 = ocean', 'unitless') + var_grd(n_emask)%coordinates = 'ELON ELAT' + + var_grd(n_tarea)%req = coord_attributes('tarea', & + 'area of T grid cells', 'm^2') + var_grd(n_tarea)%coordinates = 'TLON TLAT' + var_grd(n_uarea)%req = coord_attributes('uarea', & + 'area of U grid cells', 'm^2') + var_grd(n_uarea)%coordinates = 'ULON ULAT' + var_grd(n_narea)%req = coord_attributes('narea', & + 'area of N grid cells', 'm^2') + var_grd(n_narea)%coordinates = 'NLON NLAT' + var_grd(n_earea)%req = coord_attributes('earea', & + 'area of E grid cells', 'm^2') + var_grd(n_earea)%coordinates = 'ELON ELAT' + + var_grd(n_blkmask)%req = coord_attributes('blkmask', & + 'block id of T grid cells, mytask + iblk/100', 'unitless') + var_grd(n_blkmask)%coordinates = 'TLON TLAT' + + var_grd(n_dxt)%req = coord_attributes('dxt', & + 'T cell width through middle', 'm') + var_grd(n_dxt)%coordinates = 'TLON TLAT' + var_grd(n_dyt)%req = coord_attributes('dyt', & + 'T cell height through middle', 'm') + var_grd(n_dyt)%coordinates = 'TLON TLAT' + var_grd(n_dxu)%req = coord_attributes('dxu', & + 'U cell width through middle', 'm') + var_grd(n_dxu)%coordinates = 'ULON ULAT' + var_grd(n_dyu)%req = coord_attributes('dyu', & + 'U cell height through middle', 'm') + var_grd(n_dyu)%coordinates = 'ULON ULAT' + var_grd(n_dxn)%req = coord_attributes('dxn', & + 'N cell width through middle', 'm') + var_grd(n_dxn)%coordinates = 'NLON NLAT' + var_grd(n_dyn)%req = coord_attributes('dyn', & + 'N cell height through middle', 'm') + var_grd(n_dyn)%coordinates = 'NLON NLAT' + var_grd(n_dxe)%req = coord_attributes('dxe', & + 'E cell width through middle', 'm') + var_grd(n_dxe)%coordinates = 'ELON ELAT' + var_grd(n_dye)%req = coord_attributes('dye', & + 'E cell height through middle', 'm') + var_grd(n_dye)%coordinates = 'ELON ELAT' + + var_grd(n_HTN)%req = coord_attributes('HTN', & + 'T cell width on North side','m') + var_grd(n_HTN)%coordinates = 'TLON TLAT' + var_grd(n_HTE)%req = coord_attributes('HTE', & + 'T cell width on East side', 'm') + var_grd(n_HTE)%coordinates = 'TLON TLAT' + var_grd(n_ANGLE)%req = coord_attributes('ANGLE', & + 'angle grid makes with latitude line on U grid', & + 'radians') + var_grd(n_ANGLE)%coordinates = 'ULON ULAT' + var_grd(n_ANGLET)%req = coord_attributes('ANGLET', & + 'angle grid makes with latitude line on T grid', & + 'radians') + var_grd(n_ANGLET)%coordinates = 'TLON TLAT' + + ! These fields are required for CF compliance + ! dimensions (nx,ny,nverts) + var_nverts(n_lont_bnds) = coord_attributes('lont_bounds', & + 'longitude boundaries of T cells', 'degrees_east') + var_nverts(n_latt_bnds) = coord_attributes('latt_bounds', & + 'latitude boundaries of T cells', 'degrees_north') + var_nverts(n_lonu_bnds) = coord_attributes('lonu_bounds', & + 'longitude boundaries of U cells', 'degrees_east') + var_nverts(n_latu_bnds) = coord_attributes('latu_bounds', & + 'latitude boundaries of U cells', 'degrees_north') + var_nverts(n_lonn_bnds) = coord_attributes('lonn_bounds', & + 'longitude boundaries of N cells', 'degrees_east') + var_nverts(n_latn_bnds) = coord_attributes('latn_bounds', & + 'latitude boundaries of N cells', 'degrees_north') + var_nverts(n_lone_bnds) = coord_attributes('lone_bounds', & + 'longitude boundaries of E cells', 'degrees_east') + var_nverts(n_late_bnds) = coord_attributes('late_bounds', & + 'latitude boundaries of E cells', 'degrees_north') + + !----------------------------------------------------------------- + ! define attributes for time-invariant variables + !----------------------------------------------------------------- + + dimid(1) = imtid + dimid(2) = jmtid + dimid(3) = timid + + do i = 1, ncoord + call ice_hist_coord_def(ncid, var_coord(i), lprecision, dimid(1:2), varid) + call ice_write_hist_fill(ncid,varid,var_coord(i)%short_name,history_precision) + if (var_coord(i)%short_name == 'ULAT') then + status = nf90_put_att(ncid,varid,'comment', & + 'Latitude of NE corner of T grid cell') + call ice_check_nc(status, subname// ' ERROR: defining comment for '//var_coord(i)%short_name, & + file=__FILE__, line=__LINE__) + endif + if (f_bounds) then + status = nf90_put_att(ncid, varid, 'bounds', coord_bounds(i)) + call ice_check_nc(status, subname// ' ERROR: defining bounds for '//var_coord(i)%short_name, & + file=__FILE__, line=__LINE__) + endif + enddo + + ! Extra dimensions (NCAT, NZILYR, NZSLYR, NZBLYR, NZALYR, NFSD) + dimidex(1)=cmtid + dimidex(2)=kmtidi + dimidex(3)=kmtids + dimidex(4)=kmtidb + dimidex(5)=kmtida + dimidex(6)=fmtid + + do i = 1, nvar_grdz + if (igrdz(i)) then + call ice_hist_coord_def(ncid, var_grdz(i), lprecision, dimidex(i:i), varid) + endif + enddo + + do i = 1, nvar_grd + if (igrd(i)) then + call ice_hist_coord_def(ncid, var_grd(i)%req, lprecision, dimid(1:2), varid) + status = nf90_put_att(ncid, varid, 'coordinates', var_grd(i)%coordinates) + call ice_check_nc(status, subname// ' ERROR: defining coordinates for '//var_grd(i)%req%short_name, & + file=__FILE__, line=__LINE__) + call ice_write_hist_fill(ncid,varid,var_grd(i)%req%short_name,history_precision) + endif + enddo + + ! Fields with dimensions (nverts,nx,ny) + dimid_nverts(1) = nvertexid + dimid_nverts(2) = imtid + dimid_nverts(3) = jmtid + do i = 1, nvar_verts + if (f_bounds) then + call ice_hist_coord_def(ncid, var_nverts(i), lprecision, dimid_nverts, varid) + call ice_write_hist_fill(ncid,varid,var_nverts(i)%short_name,history_precision) + endif + enddo + + !----------------------------------------------------------------- + ! define attributes for time-variant variables + !----------------------------------------------------------------- + + do n=1,num_avail_hist_fields_2D + if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then + call ice_hist_field_def(ncid, avail_hist_fields(n),lprecision, dimid,ns) + endif + enddo ! num_avail_hist_fields_2D + + dimidz(1) = imtid + dimidz(2) = jmtid + dimidz(3) = cmtid + dimidz(4) = timid + + do n = n2D + 1, n3Dccum + if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then + call ice_hist_field_def(ncid, avail_hist_fields(n),lprecision, dimidz,ns) + endif + enddo ! num_avail_hist_fields_3Dc + + dimidz(1) = imtid + dimidz(2) = jmtid + dimidz(3) = kmtidi + dimidz(4) = timid + + do n = n3Dccum + 1, n3Dzcum + if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then + call ice_hist_field_def(ncid, avail_hist_fields(n),lprecision, dimidz,ns) + endif + enddo ! num_avail_hist_fields_3Dz + + dimidz(1) = imtid + dimidz(2) = jmtid + dimidz(3) = kmtidb + dimidz(4) = timid + + do n = n3Dzcum + 1, n3Dbcum + if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then + call ice_hist_field_def(ncid, avail_hist_fields(n),lprecision, dimidz,ns) + endif + enddo ! num_avail_hist_fields_3Db + + dimidz(1) = imtid + dimidz(2) = jmtid + dimidz(3) = kmtida + dimidz(4) = timid + + do n = n3Dbcum + 1, n3Dacum + if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then + call ice_hist_field_def(ncid, avail_hist_fields(n),lprecision, dimidz,ns) + endif + enddo ! num_avail_hist_fields_3Da + + dimidz(1) = imtid + dimidz(2) = jmtid + dimidz(3) = fmtid + dimidz(4) = timid + + do n = n3Dacum + 1, n3Dfcum + if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then + call ice_hist_field_def(ncid, avail_hist_fields(n),lprecision, dimidz,ns) + endif + enddo ! num_avail_hist_fields_3Df + + dimidcz(1) = imtid + dimidcz(2) = jmtid + dimidcz(3) = kmtidi + dimidcz(4) = cmtid + dimidcz(5) = timid + + do n = n3Dfcum + 1, n4Dicum + if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then + call ice_hist_field_def(ncid, avail_hist_fields(n),lprecision, dimidcz,ns) + endif + enddo ! num_avail_hist_fields_4Di + + dimidcz(1) = imtid + dimidcz(2) = jmtid + dimidcz(3) = kmtids + dimidcz(4) = cmtid + dimidcz(5) = timid + + do n = n4Dicum + 1, n4Dscum + if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then + call ice_hist_field_def(ncid, avail_hist_fields(n),lprecision, dimidcz,ns) + endif + enddo ! num_avail_hist_fields_4Ds + + dimidcz(1) = imtid + dimidcz(2) = jmtid + dimidcz(3) = fmtid + dimidcz(4) = cmtid + dimidcz(5) = timid + + do n = n4Dscum + 1, n4Dfcum + if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then + call ice_hist_field_def(ncid, avail_hist_fields(n),lprecision, & + ! dimidcz, ns) + dimidcz(1:4),ns) ! ferret + endif + enddo ! num_avail_hist_fields_4Df - !----------------------------------------------------------------- - ! global attributes - !----------------------------------------------------------------- - ! ... the user should change these to something useful ... - !----------------------------------------------------------------- + !----------------------------------------------------------------- + ! global attributes + !----------------------------------------------------------------- + ! ... the user should change these to something useful ... + !----------------------------------------------------------------- #ifdef CESMCOUPLED - status = nf90_put_att(ncid,nf90_global,'title',runid) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: in global attribute title') + status = nf90_put_att(ncid,nf90_global,'title',runid) + call ice_check_nc(status, subname// ' ERROR: in global attribute title', & + file=__FILE__, line=__LINE__) #else - title = 'sea ice model output for CICE' - status = nf90_put_att(ncid,nf90_global,'title',title) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: in global attribute title') + title = 'sea ice model output for CICE' + status = nf90_put_att(ncid,nf90_global,'title',title) + call ice_check_nc(status, subname// ' ERROR: in global attribute title', & + file=__FILE__, line=__LINE__) #endif - title = 'Diagnostic and Prognostic Variables' - status = nf90_put_att(ncid,nf90_global,'contents',title) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: global attribute contents') - - write(title,'(2a)') 'Los Alamos Sea Ice Model, ', trim(version_name) - status = nf90_put_att(ncid,nf90_global,'source',title) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: global attribute source') - - if (use_leap_years) then - write(title,'(a,i3,a)') 'This year has ',dayyr,' days' - else - write(title,'(a,i3,a)') 'All years have exactly ',dayyr,' days' - endif - status = nf90_put_att(ncid,nf90_global,'comment',title) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: global attribute comment') - - write(title,'(a,i8.8)') 'File written on model date ',idate - status = nf90_put_att(ncid,nf90_global,'comment2',title) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: global attribute date1') - - write(title,'(a,i6)') 'seconds elapsed into model date: ',msec - status = nf90_put_att(ncid,nf90_global,'comment3',title) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: global attribute date2') - - select case (histfreq(ns)) - case ("y", "Y") - write(time_period_freq,'(a,i0)') 'year_',histfreq_n(ns) - case ("m", "M") - write(time_period_freq,'(a,i0)') 'month_',histfreq_n(ns) - case ("d", "D") - write(time_period_freq,'(a,i0)') 'day_',histfreq_n(ns) - case ("h", "H") - write(time_period_freq,'(a,i0)') 'hour_',histfreq_n(ns) - case ("1") - write(time_period_freq,'(a,i0)') 'step_',histfreq_n(ns) - end select - - if (.not.write_ic .and. trim(time_period_freq) /= 'none') then - status = nf90_put_att(ncid,nf90_global,'time_period_freq',trim(time_period_freq)) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: global attribute time_period_freq') - endif - - if (hist_avg(ns)) then - status = nf90_put_att(ncid,nf90_global,'time_axis_position',trim(hist_time_axis)) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: global attribute time axis position') - endif - - title = 'CF-1.0' - status = & - nf90_put_att(ncid,nf90_global,'conventions',title) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: in global attribute conventions') - - call date_and_time(date=current_date, time=current_time) - write(start_time,1000) current_date(1:4), current_date(5:6), & - current_date(7:8), current_time(1:2), & - current_time(3:4), current_time(5:8) -1000 format('This dataset was created on ', & - a,'-',a,'-',a,' at ',a,':',a,':',a) - - status = nf90_put_att(ncid,nf90_global,'history',start_time) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: global attribute history') - - status = nf90_put_att(ncid,nf90_global,'io_flavor','io_netcdf') - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: global attribute io_flavor') - - !----------------------------------------------------------------- - ! end define mode - !----------------------------------------------------------------- - - status = nf90_enddef(ncid) - if (status /= nf90_noerr) call abort_ice(subname//'ERROR in nf90_enddef') - - !----------------------------------------------------------------- - ! write time variable - !----------------------------------------------------------------- - - ltime2 = timesecs/secday ! hist_time_axis = 'end' (default) - - ! Some coupled models require the time axis "stamp" to be in the middle - ! or even beginning of averaging interval. - if (hist_avg(ns)) then - if (trim(hist_time_axis) == "begin" ) ltime2 = time_beg(ns) - if (trim(hist_time_axis) == "middle") ltime2 = p5*(time_beg(ns)+time_end(ns)) - endif + title = 'Diagnostic and Prognostic Variables' + status = nf90_put_att(ncid,nf90_global,'contents',title) + call ice_check_nc(status, subname// ' ERROR: global attribute contents', & + file=__FILE__, line=__LINE__) + + write(title,'(2a)') 'Los Alamos Sea Ice Model, ', trim(version_name) + status = nf90_put_att(ncid,nf90_global,'source',title) + call ice_check_nc(status, subname// ' ERROR: global attribute source', & + file=__FILE__, line=__LINE__) + + if (use_leap_years) then + write(title,'(a,i3,a)') 'This year has ',dayyr,' days' + else + write(title,'(a,i3,a)') 'All years have exactly ',dayyr,' days' + endif + status = nf90_put_att(ncid,nf90_global,'comment',title) + call ice_check_nc(status, subname// ' ERROR: global attribute comment', & + file=__FILE__, line=__LINE__) + + write(title,'(a,i8.8)') 'File written on model date ',idate + status = nf90_put_att(ncid,nf90_global,'comment2',title) + call ice_check_nc(status, subname// ' ERROR: global attribute date1', & + file=__FILE__, line=__LINE__) + + write(title,'(a,i6)') 'seconds elapsed into model date: ',msec + status = nf90_put_att(ncid,nf90_global,'comment3',title) + call ice_check_nc(status, subname// ' ERROR: global attribute date2', & + file=__FILE__, line=__LINE__) + + select case (histfreq(ns)) + case ("y", "Y") + write(time_period_freq,'(a,i0)') 'year_',histfreq_n(ns) + case ("m", "M") + write(time_period_freq,'(a,i0)') 'month_',histfreq_n(ns) + case ("d", "D") + write(time_period_freq,'(a,i0)') 'day_',histfreq_n(ns) + case ("h", "H") + write(time_period_freq,'(a,i0)') 'hour_',histfreq_n(ns) + case ("1") + write(time_period_freq,'(a,i0)') 'step_',histfreq_n(ns) + end select + + if (.not.write_ic .and. trim(time_period_freq) /= 'none') then + status = nf90_put_att(ncid,nf90_global,'time_period_freq',trim(time_period_freq)) + call ice_check_nc(status, subname// ' ERROR: global attribute time_period_freq', & + file=__FILE__, line=__LINE__) + endif - status = nf90_inq_varid(ncid,'time',varid) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: getting time varid') - status = nf90_put_var(ncid,varid,ltime2) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: writing time variable') + if (hist_avg(ns)) then + status = nf90_put_att(ncid,nf90_global,'time_axis_position',trim(hist_time_axis)) + call ice_check_nc(status, subname// ' ERROR: global attribute time axis position', & + file=__FILE__, line=__LINE__) + endif - !----------------------------------------------------------------- - ! write time_bounds info - !----------------------------------------------------------------- + title = 'CF-1.0' + status = nf90_put_att(ncid,nf90_global,'conventions',title) + call ice_check_nc(status, subname// ' ERROR: in global attribute conventions', & + file=__FILE__, line=__LINE__) + + call date_and_time(date=current_date, time=current_time) + write(start_time,1000) current_date(1:4), current_date(5:6), & + current_date(7:8), current_time(1:2), & + current_time(3:4), current_time(5:8) +1000 format('This dataset was created on ', & + a,'-',a,'-',a,' at ',a,':',a,':',a) + + status = nf90_put_att(ncid,nf90_global,'history',start_time) + call ice_check_nc(status, subname// ' ERROR: global attribute history', & + file=__FILE__, line=__LINE__) + + status = nf90_put_att(ncid,nf90_global,'io_flavor','io_netcdf') + call ice_check_nc(status, subname// ' ERROR: global attribute io_flavor', & + file=__FILE__, line=__LINE__) + + !----------------------------------------------------------------- + ! end define mode + !----------------------------------------------------------------- + + status = nf90_enddef(ncid) + call ice_check_nc(status, subname// ' ERROR: in nf90_enddef', & + file=__FILE__, line=__LINE__) + + !----------------------------------------------------------------- + ! write time variable + !----------------------------------------------------------------- + + ltime2 = timesecs/secday ! hist_time_axis = 'end' (default) + + ! Some coupled models require the time axis "stamp" to be in the middle + ! or even beginning of averaging interval. + if (hist_avg(ns)) then + if (trim(hist_time_axis) == "begin" ) ltime2 = time_beg(ns) + if (trim(hist_time_axis) == "middle") ltime2 = p5*(time_beg(ns)+time_end(ns)) + endif - if (hist_avg(ns) .and. .not. write_ic) then - status = nf90_inq_varid(ncid,'time_bounds',varid) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: getting time_bounds id') - status = nf90_put_var(ncid,varid,time_beg(ns),start=(/1/)) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: writing time_beg') - status = nf90_put_var(ncid,varid,time_end(ns),start=(/2/)) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: writing time_end') - endif + status = nf90_inq_varid(ncid,'time',varid) + call ice_check_nc(status, subname// ' ERROR: getting time varid', & + file=__FILE__, line=__LINE__) + status = nf90_put_var(ncid,varid,ltime2) + call ice_check_nc(status, subname// ' ERROR: writing time variable', & + file=__FILE__, line=__LINE__) + + !----------------------------------------------------------------- + ! write time_bounds info + !----------------------------------------------------------------- + + if (hist_avg(ns) .and. .not. write_ic) then + status = nf90_inq_varid(ncid,'time_bounds',varid) + call ice_check_nc(status, subname// ' ERROR: getting time_bounds id', & + file=__FILE__, line=__LINE__) + status = nf90_put_var(ncid,varid,time_beg(ns),start=(/1/)) + call ice_check_nc(status, subname// ' ERROR: writing time_beg', & + file=__FILE__, line=__LINE__) + status = nf90_put_var(ncid,varid,time_end(ns),start=(/2/)) + call ice_check_nc(status, subname// ' ERROR: writing time_end', & + file=__FILE__, line=__LINE__) + endif endif ! master_task @@ -800,138 +706,138 @@ subroutine ice_write_hist (ns) ! write coordinate variables !----------------------------------------------------------------- - do i = 1,ncoord - call broadcast_scalar(var_coord(i)%short_name,master_task) - SELECT CASE (var_coord(i)%short_name) + do i = 1,ncoord + call broadcast_scalar(var_coord(i)%short_name,master_task) + SELECT CASE (var_coord(i)%short_name) CASE ('TLON') - ! Convert T grid longitude from -180 -> 180 to 0 to 360 - work1 = TLON*rad_to_deg + c360 - where (work1 > c360) work1 = work1 - c360 - where (work1 < c0 ) work1 = work1 + c360 - call gather_global(work_g1,work1,master_task,distrb_info) + ! Convert T grid longitude from -180 -> 180 to 0 to 360 + work1 = TLON*rad_to_deg + c360 + where (work1 > c360) work1 = work1 - c360 + where (work1 < c0 ) work1 = work1 + c360 + call gather_global(work_g1,work1,master_task,distrb_info) CASE ('TLAT') - work1 = TLAT*rad_to_deg - call gather_global(work_g1,work1,master_task,distrb_info) + work1 = TLAT*rad_to_deg + call gather_global(work_g1,work1,master_task,distrb_info) CASE ('ULON') - work1 = ULON*rad_to_deg - call gather_global(work_g1,work1,master_task,distrb_info) + work1 = ULON*rad_to_deg + call gather_global(work_g1,work1,master_task,distrb_info) CASE ('ULAT') - work1 = ULAT*rad_to_deg - call gather_global(work_g1,work1,master_task,distrb_info) + work1 = ULAT*rad_to_deg + call gather_global(work_g1,work1,master_task,distrb_info) CASE ('NLON') - work1 = NLON*rad_to_deg - call gather_global(work_g1,work1,master_task,distrb_info) + work1 = NLON*rad_to_deg + call gather_global(work_g1,work1,master_task,distrb_info) CASE ('NLAT') - work1 = NLAT*rad_to_deg - call gather_global(work_g1,work1,master_task,distrb_info) + work1 = NLAT*rad_to_deg + call gather_global(work_g1,work1,master_task,distrb_info) CASE ('ELON') - work1 = ELON*rad_to_deg - call gather_global(work_g1,work1,master_task,distrb_info) + work1 = ELON*rad_to_deg + call gather_global(work_g1,work1,master_task,distrb_info) CASE ('ELAT') - work1 = ELAT*rad_to_deg - call gather_global(work_g1,work1,master_task,distrb_info) - END SELECT - - if (my_task == master_task) then - status = nf90_inq_varid(ncid, var_coord(i)%short_name, varid) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: getting varid for '//var_coord(i)%short_name) - status = nf90_put_var(ncid,varid,work_g1) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: writing'//var_coord(i)%short_name) - endif - enddo - - ! Extra dimensions (NCAT, NFSD, VGRD*) - - do i = 1, nvar_grdz - if (igrdz(i)) then - call broadcast_scalar(var_grdz(i)%short_name,master_task) - if (my_task == master_task) then - status = nf90_inq_varid(ncid, var_grdz(i)%short_name, varid) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: getting varid for '//var_grdz(i)%short_name) - SELECT CASE (var_grdz(i)%short_name) - CASE ('NCAT') - status = nf90_put_var(ncid,varid,hin_max(1:ncat_hist)) - CASE ('NFSD') - status = nf90_put_var(ncid,varid,floe_rad_c(1:nfsd_hist)) - CASE ('VGRDi') ! index - needed for Met Office analysis code - status = nf90_put_var(ncid,varid,(/(k, k=1,nzilyr)/)) - CASE ('VGRDs') ! index - needed for Met Office analysis code - status = nf90_put_var(ncid,varid,(/(k, k=1,nzslyr)/)) - CASE ('VGRDb') - status = nf90_put_var(ncid,varid,(/(k, k=1,nzblyr)/)) - CASE ('VGRDa') - status = nf90_put_var(ncid,varid,(/(k, k=1,nzalyr)/)) - END SELECT - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: writing'//var_grdz(i)%short_name) - endif - endif - enddo + work1 = ELAT*rad_to_deg + call gather_global(work_g1,work1,master_task,distrb_info) + END SELECT + + if (my_task == master_task) then + status = nf90_inq_varid(ncid, var_coord(i)%short_name, varid) + call ice_check_nc(status, subname// ' ERROR: getting varid for '//var_coord(i)%short_name, & + file=__FILE__, line=__LINE__) + status = nf90_put_var(ncid,varid,work_g1) + call ice_check_nc(status, subname// ' ERROR: writing'//var_coord(i)%short_name, & + file=__FILE__, line=__LINE__) + endif + enddo + + ! Extra dimensions (NCAT, NFSD, VGRD*) + + do i = 1, nvar_grdz + if (igrdz(i)) then + call broadcast_scalar(var_grdz(i)%short_name,master_task) + if (my_task == master_task) then + status = nf90_inq_varid(ncid, var_grdz(i)%short_name, varid) + call ice_check_nc(status, subname// ' ERROR: getting varid for '//var_grdz(i)%short_name, & + file=__FILE__, line=__LINE__) + SELECT CASE (var_grdz(i)%short_name) + CASE ('NCAT') + status = nf90_put_var(ncid,varid,hin_max(1:ncat_hist)) + CASE ('NFSD') + status = nf90_put_var(ncid,varid,floe_rad_c(1:nfsd_hist)) + CASE ('VGRDi') ! index - needed for Met Office analysis code + status = nf90_put_var(ncid,varid,(/(k, k=1,nzilyr)/)) + CASE ('VGRDs') ! index - needed for Met Office analysis code + status = nf90_put_var(ncid,varid,(/(k, k=1,nzslyr)/)) + CASE ('VGRDb') + status = nf90_put_var(ncid,varid,(/(k, k=1,nzblyr)/)) + CASE ('VGRDa') + status = nf90_put_var(ncid,varid,(/(k, k=1,nzalyr)/)) + END SELECT + call ice_check_nc(status, subname// ' ERROR: put var '//var_grdz(i)%short_name, & + file=__FILE__, line=__LINE__) + endif + endif + enddo !----------------------------------------------------------------- ! write grid masks, area and rotation angle !----------------------------------------------------------------- do i = 1, nvar_grd - if (igrd(i)) then - call broadcast_scalar(var_grd(i)%req%short_name,master_task) - SELECT CASE (var_grd(i)%req%short_name) - CASE ('tmask') - call gather_global(work_g1, hm, master_task, distrb_info) - CASE ('umask') - call gather_global(work_g1, uvm, master_task, distrb_info) - CASE ('nmask') - call gather_global(work_g1, npm, master_task, distrb_info) - CASE ('emask') - call gather_global(work_g1, epm, master_task, distrb_info) - CASE ('tarea') - call gather_global(work_g1, tarea, master_task, distrb_info) - CASE ('uarea') - call gather_global(work_g1, uarea, master_task, distrb_info) - CASE ('narea') - call gather_global(work_g1, narea, master_task, distrb_info) - CASE ('earea') - call gather_global(work_g1, earea, master_task, distrb_info) - CASE ('blkmask') - call gather_global(work_g1, bm, master_task, distrb_info) - CASE ('dxu') - call gather_global(work_g1, dxU, master_task, distrb_info) - CASE ('dyu') - call gather_global(work_g1, dyU, master_task, distrb_info) - CASE ('dxt') - call gather_global(work_g1, dxT, master_task, distrb_info) - CASE ('dyt') - call gather_global(work_g1, dyT, master_task, distrb_info) - CASE ('dxn') - call gather_global(work_g1, dxN, master_task, distrb_info) - CASE ('dyn') - call gather_global(work_g1, dyN, master_task, distrb_info) - CASE ('dxe') - call gather_global(work_g1, dxE, master_task, distrb_info) - CASE ('dye') - call gather_global(work_g1, dyE, master_task, distrb_info) - CASE ('HTN') - call gather_global(work_g1, HTN, master_task, distrb_info) - CASE ('HTE') - call gather_global(work_g1, HTE, master_task, distrb_info) - CASE ('ANGLE') - call gather_global(work_g1, ANGLE, master_task, distrb_info) - CASE ('ANGLET') - call gather_global(work_g1, ANGLET,master_task, distrb_info) - END SELECT - - if (my_task == master_task) then - status = nf90_inq_varid(ncid, var_grd(i)%req%short_name, varid) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: getting varid for '//var_grd(i)%req%short_name) - status = nf90_put_var(ncid,varid,work_g1) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: writing variable '//var_grd(i)%req%short_name) - endif - endif + if (igrd(i)) then + call broadcast_scalar(var_grd(i)%req%short_name,master_task) + SELECT CASE (var_grd(i)%req%short_name) + CASE ('tmask') + call gather_global(work_g1, hm, master_task, distrb_info) + CASE ('umask') + call gather_global(work_g1, uvm, master_task, distrb_info) + CASE ('nmask') + call gather_global(work_g1, npm, master_task, distrb_info) + CASE ('emask') + call gather_global(work_g1, epm, master_task, distrb_info) + CASE ('tarea') + call gather_global(work_g1, tarea, master_task, distrb_info) + CASE ('uarea') + call gather_global(work_g1, uarea, master_task, distrb_info) + CASE ('narea') + call gather_global(work_g1, narea, master_task, distrb_info) + CASE ('earea') + call gather_global(work_g1, earea, master_task, distrb_info) + CASE ('blkmask') + call gather_global(work_g1, bm, master_task, distrb_info) + CASE ('dxu') + call gather_global(work_g1, dxU, master_task, distrb_info) + CASE ('dyu') + call gather_global(work_g1, dyU, master_task, distrb_info) + CASE ('dxt') + call gather_global(work_g1, dxT, master_task, distrb_info) + CASE ('dyt') + call gather_global(work_g1, dyT, master_task, distrb_info) + CASE ('dxn') + call gather_global(work_g1, dxN, master_task, distrb_info) + CASE ('dyn') + call gather_global(work_g1, dyN, master_task, distrb_info) + CASE ('dxe') + call gather_global(work_g1, dxE, master_task, distrb_info) + CASE ('dye') + call gather_global(work_g1, dyE, master_task, distrb_info) + CASE ('HTN') + call gather_global(work_g1, HTN, master_task, distrb_info) + CASE ('HTE') + call gather_global(work_g1, HTE, master_task, distrb_info) + CASE ('ANGLE') + call gather_global(work_g1, ANGLE, master_task, distrb_info) + CASE ('ANGLET') + call gather_global(work_g1, ANGLET,master_task, distrb_info) + END SELECT + + if (my_task == master_task) then + status = nf90_inq_varid(ncid, var_grd(i)%req%short_name, varid) + call ice_check_nc(status, subname// ' ERROR: getting varid for '//var_grd(i)%req%short_name, & + file=__FILE__, line=__LINE__) + status = nf90_put_var(ncid,varid,work_g1) + call ice_check_nc(status, subname// ' ERROR: writing variable '//var_grd(i)%req%short_name, & + file=__FILE__, line=__LINE__) + endif + endif enddo !---------------------------------------------------------------- @@ -939,78 +845,78 @@ subroutine ice_write_hist (ns) !---------------------------------------------------------------- if (f_bounds) then - if (my_task==master_task) then - allocate(work1_3(nverts,nx_global,ny_global)) - else - allocate(work1_3(1,1,1)) ! to save memory - endif + if (my_task==master_task) then + allocate(work1_3(nverts,nx_global,ny_global)) + else + allocate(work1_3(1,1,1)) ! to save memory + endif - work1_3(:,:,:) = c0 - work1 (:,:,:) = c0 - - do i = 1, nvar_verts - call broadcast_scalar(var_nverts(i)%short_name,master_task) - SELECT CASE (var_nverts(i)%short_name) - CASE ('lont_bounds') - do ivertex = 1, nverts - work1(:,:,:) = lont_bounds(ivertex,:,:,:) - call gather_global(work_g1, work1, master_task, distrb_info) - if (my_task == master_task) work1_3(ivertex,:,:) = work_g1(:,:) - enddo - CASE ('latt_bounds') - do ivertex = 1, nverts - work1(:,:,:) = latt_bounds(ivertex,:,:,:) - call gather_global(work_g1, work1, master_task, distrb_info) - if (my_task == master_task) work1_3(ivertex,:,:) = work_g1(:,:) - enddo - CASE ('lonu_bounds') - do ivertex = 1, nverts - work1(:,:,:) = lonu_bounds(ivertex,:,:,:) - call gather_global(work_g1, work1, master_task, distrb_info) - if (my_task == master_task) work1_3(ivertex,:,:) = work_g1(:,:) - enddo - CASE ('latu_bounds') - do ivertex = 1, nverts - work1(:,:,:) = latu_bounds(ivertex,:,:,:) - call gather_global(work_g1, work1, master_task, distrb_info) - if (my_task == master_task) work1_3(ivertex,:,:) = work_g1(:,:) - enddo - CASE ('lonn_bounds') - do ivertex = 1, nverts - work1(:,:,:) = lonn_bounds(ivertex,:,:,:) - call gather_global(work_g1, work1, master_task, distrb_info) - if (my_task == master_task) work1_3(ivertex,:,:) = work_g1(:,:) - enddo - CASE ('latn_bounds') - do ivertex = 1, nverts - work1(:,:,:) = latn_bounds(ivertex,:,:,:) - call gather_global(work_g1, work1, master_task, distrb_info) - if (my_task == master_task) work1_3(ivertex,:,:) = work_g1(:,:) - enddo - CASE ('lone_bounds') - do ivertex = 1, nverts - work1(:,:,:) = lone_bounds(ivertex,:,:,:) - call gather_global(work_g1, work1, master_task, distrb_info) - if (my_task == master_task) work1_3(ivertex,:,:) = work_g1(:,:) - enddo - CASE ('late_bounds') - do ivertex = 1, nverts - work1(:,:,:) = late_bounds(ivertex,:,:,:) - call gather_global(work_g1, work1, master_task, distrb_info) - if (my_task == master_task) work1_3(ivertex,:,:) = work_g1(:,:) - enddo - END SELECT - - if (my_task == master_task) then - status = nf90_inq_varid(ncid, var_nverts(i)%short_name, varid) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: getting varid for '//var_nverts(i)%short_name) - status = nf90_put_var(ncid,varid,work1_3) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: writing variable '//var_nverts(i)%short_name) - endif - enddo - deallocate(work1_3) + work1_3(:,:,:) = c0 + work1 (:,:,:) = c0 + + do i = 1, nvar_verts + call broadcast_scalar(var_nverts(i)%short_name,master_task) + SELECT CASE (var_nverts(i)%short_name) + CASE ('lont_bounds') + do ivertex = 1, nverts + work1(:,:,:) = lont_bounds(ivertex,:,:,:) + call gather_global(work_g1, work1, master_task, distrb_info) + if (my_task == master_task) work1_3(ivertex,:,:) = work_g1(:,:) + enddo + CASE ('latt_bounds') + do ivertex = 1, nverts + work1(:,:,:) = latt_bounds(ivertex,:,:,:) + call gather_global(work_g1, work1, master_task, distrb_info) + if (my_task == master_task) work1_3(ivertex,:,:) = work_g1(:,:) + enddo + CASE ('lonu_bounds') + do ivertex = 1, nverts + work1(:,:,:) = lonu_bounds(ivertex,:,:,:) + call gather_global(work_g1, work1, master_task, distrb_info) + if (my_task == master_task) work1_3(ivertex,:,:) = work_g1(:,:) + enddo + CASE ('latu_bounds') + do ivertex = 1, nverts + work1(:,:,:) = latu_bounds(ivertex,:,:,:) + call gather_global(work_g1, work1, master_task, distrb_info) + if (my_task == master_task) work1_3(ivertex,:,:) = work_g1(:,:) + enddo + CASE ('lonn_bounds') + do ivertex = 1, nverts + work1(:,:,:) = lonn_bounds(ivertex,:,:,:) + call gather_global(work_g1, work1, master_task, distrb_info) + if (my_task == master_task) work1_3(ivertex,:,:) = work_g1(:,:) + enddo + CASE ('latn_bounds') + do ivertex = 1, nverts + work1(:,:,:) = latn_bounds(ivertex,:,:,:) + call gather_global(work_g1, work1, master_task, distrb_info) + if (my_task == master_task) work1_3(ivertex,:,:) = work_g1(:,:) + enddo + CASE ('lone_bounds') + do ivertex = 1, nverts + work1(:,:,:) = lone_bounds(ivertex,:,:,:) + call gather_global(work_g1, work1, master_task, distrb_info) + if (my_task == master_task) work1_3(ivertex,:,:) = work_g1(:,:) + enddo + CASE ('late_bounds') + do ivertex = 1, nverts + work1(:,:,:) = late_bounds(ivertex,:,:,:) + call gather_global(work_g1, work1, master_task, distrb_info) + if (my_task == master_task) work1_3(ivertex,:,:) = work_g1(:,:) + enddo + END SELECT + + if (my_task == master_task) then + status = nf90_inq_varid(ncid, var_nverts(i)%short_name, varid) + call ice_check_nc(status, subname// ' ERROR: getting varid for '//var_nverts(i)%short_name, & + file=__FILE__, line=__LINE__) + status = nf90_put_var(ncid,varid,work1_3) + call ice_check_nc(status, subname// ' ERROR: writing variable '//var_nverts(i)%short_name, & + file=__FILE__, line=__LINE__) + endif + enddo + deallocate(work1_3) endif !----------------------------------------------------------------- @@ -1020,223 +926,223 @@ subroutine ice_write_hist (ns) work_g1(:,:) = c0 do n=1,num_avail_hist_fields_2D - if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then - call gather_global(work_g1, a2D(:,:,n,:), & - master_task, distrb_info) - if (my_task == master_task) then - status = nf90_inq_varid(ncid,avail_hist_fields(n)%vname,varid) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: getting varid for '//avail_hist_fields(n)%vname) - status = nf90_put_var(ncid,varid,work_g1, & - count=(/nx_global,ny_global/)) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: writing variable '//avail_hist_fields(n)%vname) - endif - - endif + if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then + call gather_global(work_g1, a2D(:,:,n,:), & + master_task, distrb_info) + if (my_task == master_task) then + status = nf90_inq_varid(ncid,avail_hist_fields(n)%vname,varid) + call ice_check_nc(status, subname// ' ERROR: getting varid for '//avail_hist_fields(n)%vname, & + file=__FILE__, line=__LINE__) + status = nf90_put_var(ncid,varid,work_g1, & + count=(/nx_global,ny_global/)) + call ice_check_nc(status, subname// ' ERROR: writing variable '//avail_hist_fields(n)%vname, & + file=__FILE__, line=__LINE__) + endif + + endif enddo ! num_avail_hist_fields_2D work_g1(:,:) = c0 do n = n2D + 1, n3Dccum - nn = n - n2D - if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then - if (my_task == master_task) then - status = nf90_inq_varid(ncid,avail_hist_fields(n)%vname,varid) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: getting varid for '//avail_hist_fields(n)%vname) - endif - do k = 1, ncat_hist - call gather_global(work_g1, a3Dc(:,:,k,nn,:), & - master_task, distrb_info) - - if (my_task == master_task) then - status = nf90_inq_varid(ncid,avail_hist_fields(n)%vname,varid) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: getting varid for '//avail_hist_fields(n)%vname) - status = nf90_put_var(ncid,varid,work_g1, & - start=(/ 1, 1,k/), & - count=(/nx_global,ny_global,1/)) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: writing variable '//avail_hist_fields(n)%vname) - endif - enddo ! k - endif + nn = n - n2D + if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then + if (my_task == master_task) then + status = nf90_inq_varid(ncid,avail_hist_fields(n)%vname,varid) + call ice_check_nc(status, subname// ' ERROR: getting varid for '//avail_hist_fields(n)%vname, & + file=__FILE__, line=__LINE__) + endif + do k = 1, ncat_hist + call gather_global(work_g1, a3Dc(:,:,k,nn,:), & + master_task, distrb_info) + + if (my_task == master_task) then + status = nf90_inq_varid(ncid,avail_hist_fields(n)%vname,varid) + call ice_check_nc(status, subname// ' ERROR: getting varid for '//avail_hist_fields(n)%vname, & + file=__FILE__, line=__LINE__) + status = nf90_put_var(ncid,varid,work_g1, & + start=(/ 1, 1,k/), & + count=(/nx_global,ny_global,1/)) + call ice_check_nc(status, subname// ' ERROR: writing variable '//avail_hist_fields(n)%vname, & + file=__FILE__, line=__LINE__) + endif + enddo ! k + endif enddo ! num_avail_hist_fields_3Dc work_g1(:,:) = c0 do n = n3Dccum+1, n3Dzcum - nn = n - n3Dccum - if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then - if (my_task == master_task) then - status = nf90_inq_varid(ncid,avail_hist_fields(n)%vname,varid) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: getting varid for '//avail_hist_fields(n)%vname) - endif - do k = 1, nzilyr - call gather_global(work_g1, a3Dz(:,:,k,nn,:), & - master_task, distrb_info) - - if (my_task == master_task) then - status = nf90_put_var(ncid,varid,work_g1, & - start=(/ 1, 1,k/), & - count=(/nx_global,ny_global,1/)) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: writing variable '//avail_hist_fields(n)%vname) - endif - enddo ! k - endif + nn = n - n3Dccum + if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then + if (my_task == master_task) then + status = nf90_inq_varid(ncid,avail_hist_fields(n)%vname,varid) + call ice_check_nc(status, subname// ' ERROR: getting varid for '//avail_hist_fields(n)%vname, & + file=__FILE__, line=__LINE__) + endif + do k = 1, nzilyr + call gather_global(work_g1, a3Dz(:,:,k,nn,:), & + master_task, distrb_info) + + if (my_task == master_task) then + status = nf90_put_var(ncid,varid,work_g1, & + start=(/ 1, 1,k/), & + count=(/nx_global,ny_global,1/)) + call ice_check_nc(status, subname// ' ERROR: writing variable '//avail_hist_fields(n)%vname, & + file=__FILE__, line=__LINE__) + endif + enddo ! k + endif enddo ! num_avail_hist_fields_3Dz work_g1(:,:) = c0 - do n = n3Dzcum+1, n3Dbcum - nn = n - n3Dzcum - if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then - if (my_task == master_task) then - status = nf90_inq_varid(ncid,avail_hist_fields(n)%vname,varid) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: getting varid for '//avail_hist_fields(n)%vname) - endif - do k = 1, nzblyr - call gather_global(work_g1, a3Db(:,:,k,nn,:), & - master_task, distrb_info) - - if (my_task == master_task) then - status = nf90_put_var(ncid,varid,work_g1, & - start=(/ 1, 1,k/), & - count=(/nx_global,ny_global,1/)) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: writing variable '//avail_hist_fields(n)%vname) - endif - enddo ! k - endif + do n = n3Dzcum+1, n3Dbcum + nn = n - n3Dzcum + if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then + if (my_task == master_task) then + status = nf90_inq_varid(ncid,avail_hist_fields(n)%vname,varid) + call ice_check_nc(status, subname// ' ERROR: getting varid for '//avail_hist_fields(n)%vname, & + file=__FILE__, line=__LINE__) + endif + do k = 1, nzblyr + call gather_global(work_g1, a3Db(:,:,k,nn,:), & + master_task, distrb_info) + + if (my_task == master_task) then + status = nf90_put_var(ncid,varid,work_g1, & + start=(/ 1, 1,k/), & + count=(/nx_global,ny_global,1/)) + call ice_check_nc(status, subname// ' ERROR: writing variable '//avail_hist_fields(n)%vname, & + file=__FILE__, line=__LINE__) + endif + enddo ! k + endif enddo ! num_avail_hist_fields_3Db work_g1(:,:) = c0 do n = n3Dbcum+1, n3Dacum - nn = n - n3Dbcum - if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then - if (my_task == master_task) then - status = nf90_inq_varid(ncid,avail_hist_fields(n)%vname,varid) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: getting varid for '//avail_hist_fields(n)%vname) - endif - do k = 1, nzalyr - call gather_global(work_g1, a3Da(:,:,k,nn,:), & - master_task, distrb_info) - - if (my_task == master_task) then - status = nf90_put_var(ncid,varid,work_g1, & - start=(/ 1, 1,k/), & - count=(/nx_global,ny_global,1/)) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: writing variable '//avail_hist_fields(n)%vname) - endif - enddo ! k - endif + nn = n - n3Dbcum + if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then + if (my_task == master_task) then + status = nf90_inq_varid(ncid,avail_hist_fields(n)%vname,varid) + call ice_check_nc(status, subname// ' ERROR: getting varid for '//avail_hist_fields(n)%vname, & + file=__FILE__, line=__LINE__) + endif + do k = 1, nzalyr + call gather_global(work_g1, a3Da(:,:,k,nn,:), & + master_task, distrb_info) + + if (my_task == master_task) then + status = nf90_put_var(ncid,varid,work_g1, & + start=(/ 1, 1,k/), & + count=(/nx_global,ny_global,1/)) + call ice_check_nc(status, subname// ' ERROR: writing variable '//avail_hist_fields(n)%vname, & + file=__FILE__, line=__LINE__) + endif + enddo ! k + endif enddo ! num_avail_hist_fields_3Da work_g1(:,:) = c0 do n = n3Dacum+1, n3Dfcum - nn = n - n3Dacum - if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then - if (my_task == master_task) then - status = nf90_inq_varid(ncid,avail_hist_fields(n)%vname,varid) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: getting varid for '//avail_hist_fields(n)%vname) - endif - do k = 1, nfsd_hist - call gather_global(work_g1, a3Df(:,:,k,nn,:), & - master_task, distrb_info) - if (my_task == master_task) then - status = nf90_put_var(ncid,varid,work_g1, & - start=(/ 1, 1,k/), & - count=(/nx_global,ny_global,1/)) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: writing variable '//avail_hist_fields(n)%vname) - endif - enddo ! k - endif + nn = n - n3Dacum + if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then + if (my_task == master_task) then + status = nf90_inq_varid(ncid,avail_hist_fields(n)%vname,varid) + call ice_check_nc(status, subname// ' ERROR: getting varid for '//avail_hist_fields(n)%vname, & + file=__FILE__, line=__LINE__) + endif + do k = 1, nfsd_hist + call gather_global(work_g1, a3Df(:,:,k,nn,:), & + master_task, distrb_info) + if (my_task == master_task) then + status = nf90_put_var(ncid,varid,work_g1, & + start=(/ 1, 1,k/), & + count=(/nx_global,ny_global,1/)) + call ice_check_nc(status, subname// ' ERROR: writing variable '//avail_hist_fields(n)%vname, & + file=__FILE__, line=__LINE__) + endif + enddo ! k + endif enddo ! num_avail_hist_fields_3Df work_g1(:,:) = c0 do n = n3Dfcum+1, n4Dicum - nn = n - n3Dfcum - if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then - if (my_task == master_task) then - status = nf90_inq_varid(ncid,avail_hist_fields(n)%vname,varid) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: getting varid for '//avail_hist_fields(n)%vname) - endif - do ic = 1, ncat_hist - do k = 1, nzilyr - call gather_global(work_g1, a4Di(:,:,k,ic,nn,:), & - master_task, distrb_info) - if (my_task == master_task) then + nn = n - n3Dfcum + if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then + if (my_task == master_task) then + status = nf90_inq_varid(ncid,avail_hist_fields(n)%vname,varid) + call ice_check_nc(status, subname// ' ERROR: getting varid for '//avail_hist_fields(n)%vname, & + file=__FILE__, line=__LINE__) + endif + do ic = 1, ncat_hist + do k = 1, nzilyr + call gather_global(work_g1, a4Di(:,:,k,ic,nn,:), & + master_task, distrb_info) + if (my_task == master_task) then status = nf90_put_var(ncid,varid,work_g1, & start=(/ 1, 1,k,ic/), & count=(/nx_global,ny_global,1, 1/)) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: writing variable '//avail_hist_fields(n)%vname) - endif - enddo ! k - enddo ! ic - endif + call ice_check_nc(status, subname// ' ERROR: writing variable '//avail_hist_fields(n)%vname, & + file=__FILE__, line=__LINE__) + endif + enddo ! k + enddo ! ic + endif enddo ! num_avail_hist_fields_4Di work_g1(:,:) = c0 do n = n4Dicum+1, n4Dscum - nn = n - n4Dicum - if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then - if (my_task == master_task) then - status = nf90_inq_varid(ncid,avail_hist_fields(n)%vname,varid) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: getting varid for '//avail_hist_fields(n)%vname) - endif - do ic = 1, ncat_hist - do k = 1, nzslyr - call gather_global(work_g1, a4Ds(:,:,k,ic,nn,:), & - master_task, distrb_info) - if (my_task == master_task) then + nn = n - n4Dicum + if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then + if (my_task == master_task) then + status = nf90_inq_varid(ncid,avail_hist_fields(n)%vname,varid) + call ice_check_nc(status, subname// ' ERROR: getting varid for '//avail_hist_fields(n)%vname, & + file=__FILE__, line=__LINE__) + endif + do ic = 1, ncat_hist + do k = 1, nzslyr + call gather_global(work_g1, a4Ds(:,:,k,ic,nn,:), & + master_task, distrb_info) + if (my_task == master_task) then status = nf90_put_var(ncid,varid,work_g1, & start=(/ 1, 1,k,ic/), & count=(/nx_global,ny_global,1, 1/)) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: writing variable '//avail_hist_fields(n)%vname) - endif - enddo ! k - enddo ! ic - endif + call ice_check_nc(status, subname// ' ERROR: writing variable '//avail_hist_fields(n)%vname, & + file=__FILE__, line=__LINE__) + endif + enddo ! k + enddo ! ic + endif enddo ! num_avail_hist_fields_4Ds do n = n4Dscum+1, n4Dfcum - nn = n - n4Dscum - if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then - if (my_task == master_task) then - status = nf90_inq_varid(ncid,avail_hist_fields(n)%vname,varid) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: getting varid for '//avail_hist_fields(n)%vname) - endif - do ic = 1, ncat_hist - do k = 1, nfsd_hist - call gather_global(work_g1, a4Df(:,:,k,ic,nn,:), & - master_task, distrb_info) - if (my_task == master_task) then + nn = n - n4Dscum + if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then + if (my_task == master_task) then + status = nf90_inq_varid(ncid,avail_hist_fields(n)%vname,varid) + call ice_check_nc(status, subname// ' ERROR: getting varid for '//avail_hist_fields(n)%vname, & + file=__FILE__, line=__LINE__) + endif + do ic = 1, ncat_hist + do k = 1, nfsd_hist + call gather_global(work_g1, a4Df(:,:,k,ic,nn,:), & + master_task, distrb_info) + if (my_task == master_task) then status = nf90_put_var(ncid,varid,work_g1, & start=(/ 1, 1,k,ic/), & count=(/nx_global,ny_global,1, 1/)) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: writing variable '//avail_hist_fields(n)%vname) - endif - enddo ! k - enddo ! ic - endif + call ice_check_nc(status, subname// ' ERROR: writing variable '//avail_hist_fields(n)%vname, & + file=__FILE__, line=__LINE__) + endif + enddo ! k + enddo ! ic + endif enddo ! num_avail_hist_fields_4Df deallocate(work_g1) @@ -1247,62 +1153,79 @@ subroutine ice_write_hist (ns) if (my_task == master_task) then status = nf90_close(ncid) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: closing netCDF history file') + call ice_check_nc(status, subname// ' ERROR: closing netCDF history file', & + file=__FILE__, line=__LINE__) write(nu_diag,*) ' ' write(nu_diag,*) 'Finished writing ',trim(ncfile(ns)) endif #else - call abort_ice(subname//'ERROR: USE_NETCDF cpp not defined', & - file=__FILE__, line=__LINE__) + call abort_ice(subname//' ERROR: USE_NETCDF cpp not defined', file=__FILE__, line=__LINE__) #endif end subroutine ice_write_hist !======================================================================= +! Defines a (time-dependent) history var in the history file +! variables have short_name, long_name and units, coordiantes and cell_measures attributes, +! and are compressed and chunked for 'hdf5' - subroutine ice_write_hist_attrs(ncid, varid, hfield, ns) + subroutine ice_hist_field_def(ncid, hfield, lprecision, dimids, ns) - use ice_kinds_mod + use ice_history_shared, only: history_deflate, history_chunksize, history_format, ice_hist_field, & + history_precision, hist_avg use ice_calendar, only: histfreq, histfreq_n, write_ic - use ice_history_shared, only: ice_hist_field, history_precision, & - hist_avg -#ifdef USE_NETCDF - use netcdf -#endif - integer (kind=int_kind), intent(in) :: ncid ! netcdf file id - integer (kind=int_kind), intent(in) :: varid ! netcdf variable id - type (ice_hist_field) , intent(in) :: hfield ! history file info - integer (kind=int_kind), intent(in) :: ns ! history stream + integer(kind=int_kind), intent(in) :: ncid, dimids(:), lprecision, ns + type(ice_hist_field), intent(in) :: hfield - ! local variables + !local vars + integer(kind=int_kind) :: chunks(size(dimids)), i, status, varid - integer (kind=int_kind) :: status - character(len=*), parameter :: subname = '(ice_write_hist_attrs)' + character(len=*), parameter :: subname = '(ice_hist_field_def)' #ifdef USE_NETCDF + status = nf90_def_var(ncid, hfield%vname, lprecision, dimids, varid) + call ice_check_nc(status, subname//' ERROR: defining var '//trim(hfield%vname),file=__FILE__,line=__LINE__) + + if (history_format=='hdf5' .and. size(dimids)>1) then + if (dimids(1)==imtid .and. dimids(2)==jmtid) then + chunks(1)=history_chunksize(1) + chunks(2)=history_chunksize(2) + do i = 3, size(dimids) + chunks(i) = 0 + enddo + status = nf90_def_var_chunking(ncid, varid, NF90_CHUNKED, chunksizes=chunks) + call ice_check_nc(status, subname//' ERROR chunking var '//trim(hfield%vname), file=__FILE__, line=__LINE__) + endif + endif + + if (history_format=='hdf5' .and. history_deflate/=0) then + status = nf90_def_var_deflate(ncid, varid, shuffle=0, deflate=1, deflate_level=history_deflate) + call ice_check_nc(status, subname//' ERROR deflating var '//trim(hfield%vname), file=__FILE__, line=__LINE__) + endif + + ! add attributes status = nf90_put_att(ncid,varid,'units', hfield%vunit) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: defining units for '//hfield%vname) + call ice_check_nc(status, subname// ' ERROR: defining units for '//hfield%vname, & + file=__FILE__, line=__LINE__) status = nf90_put_att(ncid,varid, 'long_name', hfield%vdesc) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: defining long_name for '//hfield%vname) + call ice_check_nc(status, subname// ' ERROR: defining long_name for '//hfield%vname, & + file=__FILE__, line=__LINE__) status = nf90_put_att(ncid,varid,'coordinates', hfield%vcoord) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: defining coordinates for '//hfield%vname) + call ice_check_nc(status, subname// ' ERROR: defining coordinates for '//hfield%vname, & + file=__FILE__, line=__LINE__) status = nf90_put_att(ncid,varid,'cell_measures', hfield%vcellmeas) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: defining cell measures for '//hfield%vname) + call ice_check_nc(status, subname// ' ERROR: defining cell measures for '//hfield%vname, & + file=__FILE__, line=__LINE__) - if (hfield%vcomment /= "none") then - status = nf90_put_att(ncid,varid,'comment', hfield%vcomment) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: defining comment for '//hfield%vname) + if (hfield%vcomment /= "none") then + status = nf90_put_att(ncid,varid,'comment', hfield%vcomment) + call ice_check_nc(status, subname// ' ERROR: defining comment for '//hfield%vname, & + file=__FILE__, line=__LINE__) endif call ice_write_hist_fill(ncid,varid,hfield%vname,history_precision) @@ -1314,9 +1237,9 @@ subroutine ice_write_hist_attrs(ncid, varid, hfield, ns) .and.TRIM(hfield%vname(1:9))/='sistreave' & .and.TRIM(hfield%vname(1:9))/='sistremax' & .and.TRIM(hfield%vname(1:4))/='sigP') then - status = nf90_put_att(ncid,varid,'cell_methods','time: mean') - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: defining cell methods for '//hfield%vname) + status = nf90_put_att(ncid,varid,'cell_methods','time: mean') + call ice_check_nc(status, subname// ' ERROR: defining cell methods for '//hfield%vname, & + file=__FILE__, line=__LINE__) endif endif @@ -1325,6 +1248,7 @@ subroutine ice_write_hist_attrs(ncid, varid, hfield, ns) .or. write_ic & .or.TRIM(hfield%vname(1:4))=='divu' & .or.TRIM(hfield%vname(1:5))=='shear' & + .or.TRIM(hfield%vname(1:4))=='vort' & .or.TRIM(hfield%vname(1:4))=='sig1' & .or.TRIM(hfield%vname(1:4))=='sig2' & .or.TRIM(hfield%vname(1:4))=='sigP' & @@ -1339,25 +1263,20 @@ subroutine ice_write_hist_attrs(ncid, varid, hfield, ns) else status = nf90_put_att(ncid,varid,'time_rep','averaged') endif - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: defining time rep for '//hfield%vname) + call ice_check_nc(status, subname// ' ERROR: defining time rep for '//hfield%vname, & + file=__FILE__, line=__LINE__) #else - call abort_ice(subname//'ERROR: USE_NETCDF cpp not defined', & - file=__FILE__, line=__LINE__) + call abort_ice(subname//' ERROR: USE_NETCDF cpp not defined', file=__FILE__, line=__LINE__) #endif - end subroutine ice_write_hist_attrs + end subroutine ice_hist_field_def !======================================================================= +! Defines missing_value and _FillValue attributes subroutine ice_write_hist_fill(ncid,varid,vname,precision) - use ice_kinds_mod -#ifdef USE_NETCDF - use netcdf -#endif - integer (kind=int_kind), intent(in) :: ncid ! netcdf file id integer (kind=int_kind), intent(in) :: varid ! netcdf var id character(len=*), intent(in) :: vname ! var name @@ -1374,23 +1293,75 @@ subroutine ice_write_hist_fill(ncid,varid,vname,precision) else status = nf90_put_att(ncid,varid,'missing_value',spval) endif - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: defining missing_value for '//trim(vname)) + call ice_check_nc(status, subname// ' ERROR: defining missing_value for '//trim(vname), & + file=__FILE__, line=__LINE__) if (precision == 8) then status = nf90_put_att(ncid,varid,'_FillValue',spval_dbl) else status = nf90_put_att(ncid,varid,'_FillValue',spval) endif - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: defining _FillValue for '//trim(vname)) + call ice_check_nc(status, subname// ' ERROR: defining _FillValue for '//trim(vname), & + file=__FILE__, line=__LINE__) #else - call abort_ice(subname//'ERROR: USE_NETCDF cpp not defined', & - file=__FILE__, line=__LINE__) + call abort_ice(subname//' ERROR : USE_NETCDF cpp not defined', file=__FILE__, line=__LINE__) #endif end subroutine ice_write_hist_fill +!======================================================================= +! Defines a coordinate var in the history file +! coordinates have short_name, long_name and units attributes, +! and are compressed for 'hdf5' when more than one dimensional + + subroutine ice_hist_coord_def(ncid, coord, lprecision, dimids, varid) + + use ice_history_shared, only: history_deflate, history_format, history_chunksize + + integer(kind=int_kind), intent(in) :: ncid, dimids(:), lprecision + type(coord_attributes), intent(in) :: coord + integer(kind=int_kind), intent(inout) :: varid + + !local vars + integer(kind=int_kind) ::chunks(size(dimids)), i, status + + character(len=*), parameter :: subname = '(ice_hist_coord_def)' + +#ifdef USE_NETCDF + status = nf90_def_var(ncid, coord%short_name, lprecision, dimids, varid) + call ice_check_nc(status, subname//' ERROR: defining coord '//coord%short_name,file=__FILE__,line=__LINE__) + + if (history_format=='hdf5' .and. size(dimids)>1) then + if (dimids(1)==imtid .and. dimids(2)==jmtid) then + chunks(1)=history_chunksize(1) + chunks(2)=history_chunksize(2) + do i = 3, size(dimids) + chunks(i) = 0 + enddo + status = nf90_def_var_chunking(ncid, varid, NF90_CHUNKED, chunksizes=chunks) + call ice_check_nc(status, subname//' ERROR chunking var '//trim(coord%short_name), file=__FILE__, line=__LINE__) + endif + endif + + if (history_format=='hdf5' .and. history_deflate/=0) then + status=nf90_def_var_deflate(ncid, varid, shuffle=0, deflate=1, deflate_level=history_deflate) + call ice_check_nc(status, subname//' ERROR deflating var '//trim(coord%short_name), file=__FILE__, line=__LINE__) + endif + + status = nf90_put_att(ncid,varid,'long_name',trim(coord%long_name)) + call ice_check_nc(status, subname// ' ERROR: defining long_name for '//coord%short_name, & + file=__FILE__, line=__LINE__) + status = nf90_put_att(ncid, varid, 'units', trim(coord%units)) + call ice_check_nc(status, subname// ' ERROR: defining units for '//coord%short_name, & + file=__FILE__, line=__LINE__) + +#else + call abort_ice(subname//' ERROR: USE_NETCDF cpp not defined', & + file=__FILE__, line=__LINE__) +#endif + + end subroutine ice_hist_coord_def + !======================================================================= end module ice_history_write diff --git a/cicecore/cicedyn/infrastructure/io/io_netcdf/ice_restart.F90 b/cicecore/cicedyn/infrastructure/io/io_netcdf/ice_restart.F90 index 84fcbe5b7..e9be45481 100644 --- a/cicecore/cicedyn/infrastructure/io/io_netcdf/ice_restart.F90 +++ b/cicecore/cicedyn/infrastructure/io/io_netcdf/ice_restart.F90 @@ -15,9 +15,11 @@ module ice_restart #ifdef USE_NETCDF use netcdf #endif + use ice_read_write, only: ice_check_nc use ice_restart_shared, only: & restart_ext, restart_dir, restart_file, pointer_file, & - runid, use_restart_time, lcdf64, lenstr, restart_coszen + runid, use_restart_time, lenstr, restart_coszen, restart_format, & + restart_chunksize, restart_deflate use ice_fileunits, only: nu_diag, nu_rst_pointer use ice_exit, only: abort_ice use icepack_intfc, only: icepack_query_parameters @@ -28,10 +30,12 @@ module ice_restart implicit none private public :: init_restart_write, init_restart_read, & - read_restart_field, write_restart_field, final_restart, & - query_field + read_restart_field, write_restart_field, final_restart, & + query_field - integer (kind=int_kind) :: ncid + integer (kind=int_kind) :: ncid , & + dimid_ni, & ! netCDF identifiers + dimid_nj !======================================================================= @@ -54,7 +58,7 @@ subroutine init_restart_read(ice_ic) character(len=char_len_long) :: & filename, filename0 - integer (kind=int_kind) :: status, status1 + integer (kind=int_kind) :: status character(len=*), parameter :: subname = '(init_restart_read)' @@ -76,39 +80,43 @@ subroutine init_restart_read(ice_ic) write(nu_diag,*) 'Using restart dump=', trim(filename) status = nf90_open(trim(filename), nf90_nowrite, ncid) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: reading restart ncfile '//trim(filename)) + call ice_check_nc(status, subname//' ERROR: open '//trim(filename), file=__FILE__, line=__LINE__) if (use_restart_time) then - status1 = nf90_noerr + ! for backwards compatibility, check nyr, month, and sec as well status = nf90_get_att(ncid, nf90_global, 'istep1', istep0) - if (status /= nf90_noerr) status1 = status -! status = nf90_get_att(ncid, nf90_global, 'time', time) -! status = nf90_get_att(ncid, nf90_global, 'time_forc', time_forc) + call ice_check_nc(status, subname//" ERROR: reading restart step ",file=__FILE__,line=__LINE__) + status = nf90_get_att(ncid, nf90_global, 'myear', myear) - if (status /= nf90_noerr) status = nf90_get_att(ncid, nf90_global, 'nyr', myear) - if (status /= nf90_noerr) status1 = status + if (status /= nf90_noerr) then + status = nf90_get_att(ncid, nf90_global, 'nyr', myear) + call ice_check_nc(status, subname//" ERROR: reading restart year ",file=__FILE__,line=__LINE__) + endif + status = nf90_get_att(ncid, nf90_global, 'mmonth', mmonth) - if (status /= nf90_noerr) status = nf90_get_att(ncid, nf90_global, 'month', mmonth) - if (status /= nf90_noerr) status1 = status + if (status /= nf90_noerr) then + status = nf90_get_att(ncid, nf90_global, 'month', mmonth) + call ice_check_nc(status, subname//" ERROR: reading restart month ",file=__FILE__,line=__LINE__) + endif + status = nf90_get_att(ncid, nf90_global, 'mday', mday) - if (status /= nf90_noerr) status1 = status + call ice_check_nc(status, subname//" ERROR: reading restart day ",file=__FILE__,line=__LINE__) + status = nf90_get_att(ncid, nf90_global, 'msec', msec) - if (status /= nf90_noerr) status = nf90_get_att(ncid, nf90_global, 'sec', msec) - if (status /= nf90_noerr) status1 = status - if (status1 /= nf90_noerr) call abort_ice(subname// & - 'ERROR: reading restart time '//trim(filename)) + if (status /= nf90_noerr) then + status = nf90_get_att(ncid, nf90_global, 'sec', msec) + call ice_check_nc(status, subname//" ERROR: reading restart sec ",file=__FILE__,line=__LINE__) + endif + endif ! use namelist values if use_restart_time = F endif call broadcast_scalar(istep0,master_task) -! call broadcast_scalar(time,master_task) call broadcast_scalar(myear,master_task) call broadcast_scalar(mmonth,master_task) call broadcast_scalar(mday,master_task) call broadcast_scalar(msec,master_task) -! call broadcast_scalar(time_forc,master_task) istep1 = istep0 @@ -117,7 +125,7 @@ subroutine init_restart_read(ice_ic) npt = npt - istep0 endif #else - call abort_ice(subname//'ERROR: USE_NETCDF cpp not defined for '//trim(ice_ic), & + call abort_ice(subname//' ERROR: USE_NETCDF cpp not defined for '//trim(ice_ic), & file=__FILE__, line=__LINE__) #endif @@ -164,8 +172,7 @@ subroutine init_restart_write(filename_spec) integer (kind=int_kind), allocatable :: dims(:) integer (kind=int_kind) :: & - dimid_ni, & ! netCDF identifiers - dimid_nj, & ! + dimid_ncat, & ! iflag, & ! netCDF creation flag status ! status variable from netCDF routine @@ -211,19 +218,31 @@ subroutine init_restart_write(filename_spec) write(nu_rst_pointer,'(a)') filename close(nu_rst_pointer) - iflag = 0 - if (lcdf64) iflag = nf90_64bit_offset + if (restart_format == 'cdf1') then + iflag = nf90_clobber + elseif (restart_format == 'cdf2') then + iflag = ior(nf90_clobber,nf90_64bit_offset) + elseif (restart_format == 'cdf5') then + iflag = ior(nf90_clobber,nf90_64bit_data) + elseif (restart_format == 'hdf5') then + iflag = ior(nf90_clobber,nf90_netcdf4) + else + call abort_ice(subname//' ERROR: restart_format not allowed for '//trim(restart_format), & + file=__FILE__, line=__LINE__) + endif status = nf90_create(trim(filename), iflag, ncid) - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: creating restart ncfile '//trim(filename)) + call ice_check_nc(status, subname//' ERROR: creating '//trim(filename), file=__FILE__, line=__LINE__) status = nf90_put_att(ncid,nf90_global,'istep1',istep1) -! status = nf90_put_att(ncid,nf90_global,'time',time) -! status = nf90_put_att(ncid,nf90_global,'time_forc',time_forc) + call ice_check_nc(status, subname//' ERROR: writing att istep', file=__FILE__, line=__LINE__) status = nf90_put_att(ncid,nf90_global,'myear',myear) + call ice_check_nc(status, subname//' ERROR: writing att year', file=__FILE__, line=__LINE__) status = nf90_put_att(ncid,nf90_global,'mmonth',mmonth) + call ice_check_nc(status, subname//' ERROR: writing att month', file=__FILE__, line=__LINE__) status = nf90_put_att(ncid,nf90_global,'mday',mday) + call ice_check_nc(status, subname//' ERROR: writing att day', file=__FILE__, line=__LINE__) status = nf90_put_att(ncid,nf90_global,'msec',msec) + call ice_check_nc(status, subname//' ERROR: writing att sec', file=__FILE__, line=__LINE__) nx = nx_global ny = ny_global @@ -232,13 +251,16 @@ subroutine init_restart_write(filename_spec) ny = ny_global + 2*nghost endif status = nf90_def_dim(ncid,'ni',nx,dimid_ni) + call ice_check_nc(status, subname//' ERROR: writing dim ni', file=__FILE__, line=__LINE__) status = nf90_def_dim(ncid,'nj',ny,dimid_nj) + call ice_check_nc(status, subname//' ERROR: writing dim nj', file=__FILE__, line=__LINE__) status = nf90_def_dim(ncid,'ncat',ncat,dimid_ncat) + call ice_check_nc(status, subname//' ERROR: writing dim ncat', file=__FILE__, line=__LINE__) - !----------------------------------------------------------------- - ! 2D restart fields - !----------------------------------------------------------------- + !----------------------------------------------------------------- + ! 2D restart fields + !----------------------------------------------------------------- allocate(dims(2)) @@ -378,9 +400,9 @@ subroutine init_restart_write(filename_spec) deallocate(dims) - !----------------------------------------------------------------- - ! 3D restart fields (ncat) - !----------------------------------------------------------------- + !----------------------------------------------------------------- + ! 3D restart fields (ncat) + !----------------------------------------------------------------- allocate(dims(3)) @@ -482,9 +504,9 @@ subroutine init_restart_write(filename_spec) endif endif !skl_bgc - !----------------------------------------------------------------- - ! 4D restart fields, written as layers of 3D - !----------------------------------------------------------------- + !----------------------------------------------------------------- + ! 4D restart fields, written as layers of 3D + !----------------------------------------------------------------- do k=1,nilyr write(nchar,'(i3.3)') k @@ -534,117 +556,117 @@ subroutine init_restart_write(filename_spec) if (z_tracers) then if (tr_zaero) then - do n = 1, n_zaero - write(ncharb,'(i3.3)') n - do k = 1, nblyr+3 - write(nchar,'(i3.3)') k - call define_rest_field(ncid,'zaero'//trim(ncharb)//trim(nchar),dims) - enddo !k - enddo !n + do n = 1, n_zaero + write(ncharb,'(i3.3)') n + do k = 1, nblyr+3 + write(nchar,'(i3.3)') k + call define_rest_field(ncid,'zaero'//trim(ncharb)//trim(nchar),dims) + enddo !k + enddo !n endif !tr_zaero if (tr_bgc_Nit) then - do k = 1, nblyr+3 - write(nchar,'(i3.3)') k - call define_rest_field(ncid,'bgc_Nit'//trim(nchar),dims) - enddo + do k = 1, nblyr+3 + write(nchar,'(i3.3)') k + call define_rest_field(ncid,'bgc_Nit'//trim(nchar),dims) + enddo endif if (tr_bgc_N) then - do n = 1, n_algae - write(ncharb,'(i3.3)') n - do k = 1, nblyr+3 - write(nchar,'(i3.3)') k - call define_rest_field(ncid,'bgc_N'//trim(ncharb)//trim(nchar),dims) - enddo - enddo + do n = 1, n_algae + write(ncharb,'(i3.3)') n + do k = 1, nblyr+3 + write(nchar,'(i3.3)') k + call define_rest_field(ncid,'bgc_N'//trim(ncharb)//trim(nchar),dims) + enddo + enddo endif if (tr_bgc_C) then - ! do n = 1, n_algae - ! write(ncharb,'(i3.3)') n - ! do k = 1, nblyr+3 - ! write(nchar,'(i3.3)') k - ! call define_rest_field(ncid,'bgc_C'//trim(ncharb)//trim(nchar),dims) - ! enddo - ! enddo - do n = 1, n_doc - write(ncharb,'(i3.3)') n - do k = 1, nblyr+3 - write(nchar,'(i3.3)') k - call define_rest_field(ncid,'bgc_DOC'//trim(ncharb)//trim(nchar),dims) - enddo - enddo - do n = 1, n_dic - write(ncharb,'(i3.3)') n - do k = 1, nblyr+3 - write(nchar,'(i3.3)') k - call define_rest_field(ncid,'bgc_DIC'//trim(ncharb)//trim(nchar),dims) - enddo - enddo + ! do n = 1, n_algae + ! write(ncharb,'(i3.3)') n + ! do k = 1, nblyr+3 + ! write(nchar,'(i3.3)') k + ! call define_rest_field(ncid,'bgc_C'//trim(ncharb)//trim(nchar),dims) + ! enddo + ! enddo + do n = 1, n_doc + write(ncharb,'(i3.3)') n + do k = 1, nblyr+3 + write(nchar,'(i3.3)') k + call define_rest_field(ncid,'bgc_DOC'//trim(ncharb)//trim(nchar),dims) + enddo + enddo + do n = 1, n_dic + write(ncharb,'(i3.3)') n + do k = 1, nblyr+3 + write(nchar,'(i3.3)') k + call define_rest_field(ncid,'bgc_DIC'//trim(ncharb)//trim(nchar),dims) + enddo + enddo endif if (tr_bgc_chl) then - do n = 1, n_algae - write(ncharb,'(i3.3)') n - do k = 1, nblyr+3 - write(nchar,'(i3.3)') k - call define_rest_field(ncid,'bgc_chl'//trim(ncharb)//trim(nchar),dims) - enddo - enddo + do n = 1, n_algae + write(ncharb,'(i3.3)') n + do k = 1, nblyr+3 + write(nchar,'(i3.3)') k + call define_rest_field(ncid,'bgc_chl'//trim(ncharb)//trim(nchar),dims) + enddo + enddo endif if (tr_bgc_Am) then - do k = 1, nblyr+3 - write(nchar,'(i3.3)') k - call define_rest_field(ncid,'bgc_Am'//trim(nchar),dims) - enddo + do k = 1, nblyr+3 + write(nchar,'(i3.3)') k + call define_rest_field(ncid,'bgc_Am'//trim(nchar),dims) + enddo endif if (tr_bgc_Sil) then - do k = 1, nblyr+3 - write(nchar,'(i3.3)') k - call define_rest_field(ncid,'bgc_Sil'//trim(nchar),dims) - enddo + do k = 1, nblyr+3 + write(nchar,'(i3.3)') k + call define_rest_field(ncid,'bgc_Sil'//trim(nchar),dims) + enddo endif if (tr_bgc_hum) then - do k = 1, nblyr+3 - write(nchar,'(i3.3)') k - call define_rest_field(ncid,'bgc_hum'//trim(nchar),dims) - enddo + do k = 1, nblyr+3 + write(nchar,'(i3.3)') k + call define_rest_field(ncid,'bgc_hum'//trim(nchar),dims) + enddo endif if (tr_bgc_DMS) then - do k = 1, nblyr+3 - write(nchar,'(i3.3)') k - call define_rest_field(ncid,'bgc_DMSPp'//trim(nchar),dims) - call define_rest_field(ncid,'bgc_DMSPd'//trim(nchar),dims) - call define_rest_field(ncid,'bgc_DMS'//trim(nchar),dims) - enddo + do k = 1, nblyr+3 + write(nchar,'(i3.3)') k + call define_rest_field(ncid,'bgc_DMSPp'//trim(nchar),dims) + call define_rest_field(ncid,'bgc_DMSPd'//trim(nchar),dims) + call define_rest_field(ncid,'bgc_DMS'//trim(nchar),dims) + enddo endif if (tr_bgc_PON) then - do k = 1, nblyr+3 - write(nchar,'(i3.3)') k - call define_rest_field(ncid,'bgc_PON'//trim(nchar),dims) - enddo + do k = 1, nblyr+3 + write(nchar,'(i3.3)') k + call define_rest_field(ncid,'bgc_PON'//trim(nchar),dims) + enddo endif if (tr_bgc_DON) then - do n = 1, n_don - write(ncharb,'(i3.3)') n - do k = 1, nblyr+3 - write(nchar,'(i3.3)') k - call define_rest_field(ncid,'bgc_DON'//trim(ncharb)//trim(nchar),dims) - enddo - enddo + do n = 1, n_don + write(ncharb,'(i3.3)') n + do k = 1, nblyr+3 + write(nchar,'(i3.3)') k + call define_rest_field(ncid,'bgc_DON'//trim(ncharb)//trim(nchar),dims) + enddo + enddo endif if (tr_bgc_Fe ) then - do n = 1, n_fed - write(ncharb,'(i3.3)') n - do k = 1, nblyr+3 - write(nchar,'(i3.3)') k - call define_rest_field(ncid,'bgc_Fed'//trim(ncharb)//trim(nchar),dims) - enddo - enddo - do n = 1, n_fep - write(ncharb,'(i3.3)') n - do k = 1, nblyr+3 - write(nchar,'(i3.3)') k - call define_rest_field(ncid,'bgc_Fep'//trim(ncharb)//trim(nchar),dims) - enddo - enddo + do n = 1, n_fed + write(ncharb,'(i3.3)') n + do k = 1, nblyr+3 + write(nchar,'(i3.3)') k + call define_rest_field(ncid,'bgc_Fed'//trim(ncharb)//trim(nchar),dims) + enddo + enddo + do n = 1, n_fep + write(ncharb,'(i3.3)') n + do k = 1, nblyr+3 + write(nchar,'(i3.3)') k + call define_rest_field(ncid,'bgc_Fep'//trim(ncharb)//trim(nchar),dims) + enddo + enddo endif do k = 1, nbtrcr write(nchar,'(i3.3)') k @@ -654,12 +676,13 @@ subroutine init_restart_write(filename_spec) deallocate(dims) status = nf90_enddef(ncid) + call ice_check_nc(status, subname//' ERROR: enddef', file=__FILE__, line=__LINE__) write(nu_diag,*) 'Writing ',filename(1:lenstr(filename)) endif ! master_task #else - call abort_ice(subname//'ERROR: USE_NETCDF cpp not defined for '//trim(filename_spec), & + call abort_ice(subname//' ERROR: USE_NETCDF cpp not defined for '//trim(filename_spec), & file=__FILE__, line=__LINE__) #endif @@ -678,74 +701,74 @@ subroutine read_restart_field(nu,nrec,work,atype,vname,ndim3, & use ice_read_write, only: ice_read_nc integer (kind=int_kind), intent(in) :: & - nu , & ! unit number (not used for netcdf) - ndim3 , & ! third dimension - nrec ! record number (0 for sequential access) + nu , & ! unit number (not used for netcdf) + ndim3 , & ! third dimension + nrec ! record number (0 for sequential access) real (kind=dbl_kind), dimension(nx_block,ny_block,ndim3,max_blocks), intent(inout) :: & - work ! input array (real, 8-byte) + work ! input array (real, 8-byte) character (len=4), intent(in) :: & - atype ! format for output array - ! (real/integer, 4-byte/8-byte) + atype ! format for output array + ! (real/integer, 4-byte/8-byte) logical (kind=log_kind), intent(in) :: & - diag ! if true, write diagnostic output + diag ! if true, write diagnostic output character (len=*), intent(in) :: vname integer (kind=int_kind), optional, intent(in) :: & - field_loc, & ! location of field on staggered grid - field_type ! type of field (scalar, vector, angle) + field_loc, & ! location of field on staggered grid + field_type ! type of field (scalar, vector, angle) ! local variables real (kind=dbl_kind), dimension(nx_block,ny_block,max_blocks) :: & - work2 ! input array (real, 8-byte) + work2 ! input array (real, 8-byte) character(len=*), parameter :: subname = '(read_restart_field)' #ifdef USE_NETCDF - if (present(field_loc)) then - if (ndim3 == ncat) then - if (restart_ext) then - call ice_read_nc(ncid,1,vname,work,diag, & - field_loc=field_loc,field_type=field_type,restart_ext=restart_ext) - else - call ice_read_nc(ncid,1,vname,work,diag,field_loc,field_type) - endif - elseif (ndim3 == 1) then - if (restart_ext) then - call ice_read_nc(ncid,1,vname,work2,diag, & - field_loc=field_loc,field_type=field_type,restart_ext=restart_ext) - else - call ice_read_nc(ncid,1,vname,work2,diag,field_loc,field_type) - endif - work(:,:,1,:) = work2(:,:,:) + if (present(field_loc)) then + if (ndim3 == ncat) then + if (restart_ext) then + call ice_read_nc(ncid,1,vname,work,diag, & + field_loc=field_loc,field_type=field_type,restart_ext=restart_ext) else - write(nu_diag,*) 'ndim3 not supported ',ndim3 + call ice_read_nc(ncid,1,vname,work,diag,field_loc,field_type) endif + elseif (ndim3 == 1) then + if (restart_ext) then + call ice_read_nc(ncid,1,vname,work2,diag, & + field_loc=field_loc,field_type=field_type,restart_ext=restart_ext) + else + call ice_read_nc(ncid,1,vname,work2,diag,field_loc,field_type) + endif + work(:,:,1,:) = work2(:,:,:) else - if (ndim3 == ncat) then - if (restart_ext) then - call ice_read_nc(ncid, 1, vname, work, diag, restart_ext=restart_ext) - else - call ice_read_nc(ncid, 1, vname, work, diag) - endif - elseif (ndim3 == 1) then - if (restart_ext) then - call ice_read_nc(ncid, 1, vname, work2, diag, restart_ext=restart_ext) - else - call ice_read_nc(ncid, 1, vname, work2, diag) - endif - work(:,:,1,:) = work2(:,:,:) + write(nu_diag,*) 'ndim3 not supported ',ndim3 + endif + else + if (ndim3 == ncat) then + if (restart_ext) then + call ice_read_nc(ncid, 1, vname, work, diag, restart_ext=restart_ext) + else + call ice_read_nc(ncid, 1, vname, work, diag) + endif + elseif (ndim3 == 1) then + if (restart_ext) then + call ice_read_nc(ncid, 1, vname, work2, diag, restart_ext=restart_ext) else - write(nu_diag,*) 'ndim3 not supported ',ndim3 + call ice_read_nc(ncid, 1, vname, work2, diag) endif + work(:,:,1,:) = work2(:,:,:) + else + write(nu_diag,*) 'ndim3 not supported ',ndim3 endif + endif #else - call abort_ice(subname//'ERROR: USE_NETCDF cpp not defined', & + call abort_ice(subname//' ERROR: USE_NETCDF cpp not defined', & file=__FILE__, line=__LINE__) #endif @@ -763,54 +786,59 @@ subroutine write_restart_field(nu,nrec,work,atype,vname,ndim3,diag) use ice_read_write, only: ice_write_nc integer (kind=int_kind), intent(in) :: & - nu , & ! unit number - ndim3 , & ! third dimension - nrec ! record number (0 for sequential access) + nu , & ! unit number + ndim3 , & ! third dimension + nrec ! record number (0 for sequential access) real (kind=dbl_kind), dimension(nx_block,ny_block,ndim3,max_blocks), intent(in) :: & - work ! input array (real, 8-byte) + work ! input array (real, 8-byte) character (len=4), intent(in) :: & - atype ! format for output array - ! (real/integer, 4-byte/8-byte) + atype ! format for output array + ! (real/integer, 4-byte/8-byte) logical (kind=log_kind), intent(in) :: & - diag ! if true, write diagnostic output + diag ! if true, write diagnostic output character (len=*), intent(in) :: vname ! local variables integer (kind=int_kind) :: & - varid, & ! variable id - status ! status variable from netCDF routine + varid , & ! variable id + status ! status variable from netCDF routine real (kind=dbl_kind), dimension(nx_block,ny_block,max_blocks) :: & - work2 ! input array (real, 8-byte) + work2 ! input array (real, 8-byte) character(len=*), parameter :: subname = '(write_restart_field)' #ifdef USE_NETCDF + varid = -99 + if (my_task == master_task) then + ! ncid is only valid on master status = nf90_inq_varid(ncid,trim(vname),varid) - if (ndim3 == ncat) then - if (restart_ext) then - call ice_write_nc(ncid, 1, varid, work, diag, restart_ext, varname=trim(vname)) - else - call ice_write_nc(ncid, 1, varid, work, diag, varname=trim(vname)) - endif - elseif (ndim3 == 1) then - work2(:,:,:) = work(:,:,1,:) - if (restart_ext) then - call ice_write_nc(ncid, 1, varid, work2, diag, restart_ext, varname=trim(vname)) - else - call ice_write_nc(ncid, 1, varid, work2, diag, varname=trim(vname)) - endif + call ice_check_nc(status, subname//' ERROR: inq varid '//trim(vname), file=__FILE__, line=__LINE__) + endif + if (ndim3 == ncat) then + if (restart_ext) then + call ice_write_nc(ncid, 1, varid, work, diag, restart_ext, varname=trim(vname)) + else + call ice_write_nc(ncid, 1, varid, work, diag, varname=trim(vname)) + endif + elseif (ndim3 == 1) then + work2(:,:,:) = work(:,:,1,:) + if (restart_ext) then + call ice_write_nc(ncid, 1, varid, work2, diag, restart_ext, varname=trim(vname)) else - write(nu_diag,*) 'ndim3 not supported',ndim3 + call ice_write_nc(ncid, 1, varid, work2, diag, varname=trim(vname)) endif + else + write(nu_diag,*) 'ndim3 not supported',ndim3 + endif #else - call abort_ice(subname//'ERROR: USE_NETCDF cpp not defined', & + call abort_ice(subname//' ERROR: USE_NETCDF cpp not defined', & file=__FILE__, line=__LINE__) #endif @@ -830,13 +858,15 @@ subroutine final_restart() character(len=*), parameter :: subname = '(final_restart)' #ifdef USE_NETCDF - status = nf90_close(ncid) - - if (my_task == master_task) & - write(nu_diag,'(a,i8,4x,i4.4,a,i2.2,a,i2.2,a,i5.5)') 'Restart read/written ',istep1,myear,'-',mmonth,'-',mday,'-',msec - + if (my_task == master_task) then + ! ncid is only valid on master + status = nf90_close(ncid) + call ice_check_nc(status, subname//' ERROR: closing', file=__FILE__, line=__LINE__) + write(nu_diag,'(a,i8,4x,i4.4,a,i2.2,a,i2.2,a,i5.5)') & + 'Restart read/written ',istep1,myear,'-',mmonth,'-',mday,'-',msec + endif #else - call abort_ice(subname//'ERROR: USE_NETCDF cpp not defined', & + call abort_ice(subname//' ERROR: USE_NETCDF cpp not defined', & file=__FILE__, line=__LINE__) #endif @@ -855,15 +885,34 @@ subroutine define_rest_field(ncid, vname, dims) integer (kind=int_kind) :: varid - integer (kind=int_kind) :: & - status ! status variable from netCDF routine + integer (kind=int_kind) :: chunks(size(dims)), status, i character(len=*), parameter :: subname = '(define_rest_field)' #ifdef USE_NETCDF + status = nf90_def_var(ncid,trim(vname),nf90_double,dims,varid) + call ice_check_nc(status, subname//' ERROR: def var '//trim(vname), file=__FILE__, line=__LINE__) + + if (restart_format=='hdf5' .and. size(dims)>1) then + if (dims(1)==dimid_ni .and. dims(2)==dimid_nj) then + chunks(1)=restart_chunksize(1) + chunks(2)=restart_chunksize(2) + do i = 3, size(dims) + chunks(i) = 0 + enddo + status = nf90_def_var_chunking(ncid, varid, NF90_CHUNKED, chunksizes=chunks) + call ice_check_nc(status, subname//' ERROR: chunking var '//trim(vname), file=__FILE__, line=__LINE__) + endif + endif + + if (restart_format=='hdf5' .and. restart_deflate/=0) then + status=nf90_def_var_deflate(ncid, varid, shuffle=0, deflate=1, deflate_level=restart_deflate) + call ice_check_nc(status, subname//' ERROR deflating var '//trim(vname), file=__FILE__, line=__LINE__) + endif + #else - call abort_ice(subname//'ERROR: USE_NETCDF cpp not defined', & + call abort_ice(subname//' ERROR: USE_NETCDF cpp not defined', & file=__FILE__, line=__LINE__) #endif @@ -892,7 +941,7 @@ logical function query_field(nu,vname) endif call broadcast_scalar(query_field,master_task) #else - call abort_ice(subname//'ERROR: USE_NETCDF cpp not defined for '//trim(ice_ic), & + call abort_ice(subname//' ERROR: USE_NETCDF cpp not defined', & file=__FILE__, line=__LINE__) #endif diff --git a/cicecore/cicedyn/infrastructure/io/io_pio2/ice_history_write.F90 b/cicecore/cicedyn/infrastructure/io/io_pio2/ice_history_write.F90 index cf2f40521..daebe1f2e 100644 --- a/cicecore/cicedyn/infrastructure/io/io_pio2/ice_history_write.F90 +++ b/cicecore/cicedyn/infrastructure/io/io_pio2/ice_history_write.F90 @@ -1,6 +1,6 @@ !======================================================================= ! -! Writes history in netCDF format +! Writes history in netCDF format using NCAR ParallelIO library ! ! authors Tony Craig and Bruce Briegleb, NCAR ! Elizabeth C. Hunke and William H. Lipscomb, LANL @@ -23,11 +23,27 @@ module ice_history_write use ice_exit, only: abort_ice use icepack_intfc, only: icepack_warnings_flush, icepack_warnings_aborted use icepack_intfc, only: icepack_query_parameters + use ice_calendar, only: write_ic, histfreq + use ice_pio implicit none private + + TYPE coord_attributes ! netcdf coordinate attributes + character (len=11) :: short_name + character (len=45) :: long_name + character (len=30) :: units + END TYPE coord_attributes + + TYPE req_attributes ! req'd netcdf attributes + type (coord_attributes) :: req + character (len=20) :: coordinates + END TYPE req_attributes + public :: ice_write_hist + integer (kind=int_kind) :: imtid,jmtid + !======================================================================= contains @@ -42,8 +58,8 @@ subroutine ice_write_hist (ns) use ice_blocks, only: nx_block, ny_block use ice_broadcast, only: broadcast_scalar - use ice_calendar, only: msec, timesecs, idate, idate0, write_ic, & - histfreq, histfreq_n, days_per_year, use_leap_years, dayyr, & + use ice_calendar, only: msec, timesecs, idate, idate0, & + histfreq_n, days_per_year, use_leap_years, dayyr, & hh_init, mm_init, ss_init use ice_communicate, only: my_task, master_task use ice_domain, only: distrb_info, nblocks @@ -57,8 +73,7 @@ subroutine ice_write_hist (ns) lonn_bounds, latn_bounds, lone_bounds, late_bounds use ice_history_shared use ice_arrays_column, only: hin_max, floe_rad_c - use ice_restart_shared, only: runid, lcdf64 - use ice_pio + use ice_restart_shared, only: runid use pio integer (kind=int_kind), intent(in) :: ns @@ -66,7 +81,7 @@ subroutine ice_write_hist (ns) ! local variables integer (kind=int_kind) :: i,j,k,ic,n,nn, & - ncid,status,imtid,jmtid,kmtidi,kmtids,kmtidb, cmtid,timid, & + ncid,status,kmtidi,kmtids,kmtidb, cmtid,timid, & length,nvertexid,ivertex,kmtida,fmtid integer (kind=int_kind), dimension(2) :: dimid2 integer (kind=int_kind), dimension(3) :: dimid3 @@ -75,16 +90,15 @@ subroutine ice_write_hist (ns) integer (kind=int_kind), dimension(3) :: dimid_nverts integer (kind=int_kind), dimension(6) :: dimidex real (kind= dbl_kind) :: ltime2 - character (char_len) :: title - character (char_len) :: time_period_freq = 'none' - character (char_len_long) :: ncfile(max_nstrm) - integer (kind=int_kind) :: iotype + character (len=8) :: cdate + character (len=char_len_long) :: title, cal_units, cal_att + character (len=char_len) :: time_period_freq = 'none' + character (len=char_len_long) :: ncfile(max_nstrm) - integer (kind=int_kind) :: icategory,ind,i_aice,boundid + integer (kind=int_kind) :: icategory,ind,i_aice,boundid, lprecision - character (char_len) :: start_time,current_date,current_time + character (len=char_len) :: start_time,current_date,current_time character (len=16) :: c_aice - character (len=8) :: cdate type(file_desc_t) :: File type(io_desc_t) :: iodesc2d, & @@ -93,6 +107,9 @@ subroutine ice_write_hist (ns) iodesc4di, iodesc4ds, iodesc4df type(var_desc_t) :: varid + ! time coord + TYPE(coord_attributes) :: time_coord + ! 8 coordinate variables: TLON, TLAT, ULON, ULAT, NLON, NLAT, ELON, ELAT INTEGER (kind=int_kind), PARAMETER :: ncoord = 8 @@ -104,17 +121,6 @@ subroutine ice_write_hist (ns) ! lonn_bounds, latn_bounds, lone_bounds, late_bounds INTEGER (kind=int_kind), PARAMETER :: nvar_verts = 8 - TYPE coord_attributes ! netcdf coordinate attributes - character (len=11) :: short_name - character (len=45) :: long_name - character (len=20) :: units - END TYPE coord_attributes - - TYPE req_attributes ! req'd netcdf attributes - type (coord_attributes) :: req - character (len=20) :: coordinates - END TYPE req_attributes - TYPE(req_attributes), dimension(nvar_grd) :: var_grd TYPE(coord_attributes), dimension(ncoord) :: var_coord TYPE(coord_attributes), dimension(nvar_verts) :: var_nverts @@ -131,8 +137,7 @@ subroutine ice_write_hist (ns) real (kind=real_kind), allocatable :: workr4(:,:,:,:,:) real (kind=real_kind), allocatable :: workr3v(:,:,:,:) - character(len=char_len_long) :: & - filename + character(len=char_len_long) :: filename integer (kind=int_kind), dimension(1) :: & tim_start,tim_length ! dimension quantities for netCDF @@ -143,7 +148,7 @@ subroutine ice_write_hist (ns) real (kind=dbl_kind) :: secday real (kind=dbl_kind) :: rad_to_deg - integer (kind=int_kind) :: lprecision + logical (kind=log_kind), save :: first_call = .true. character(len=*), parameter :: subname = '(ice_write_hist)' @@ -167,12 +172,10 @@ subroutine ice_write_hist (ns) call broadcast_scalar(filename, master_task) ! create file - - iotype = PIO_IOTYPE_NETCDF - if (history_format == 'pio_pnetcdf') iotype = PIO_IOTYPE_PNETCDF File%fh=-1 call ice_pio_init(mode='write', filename=trim(filename), File=File, & - clobber=.true., cdf64=lcdf64, iotype=iotype) + clobber=.true., fformat=trim(history_format), rearr=trim(history_rearranger), & + iotasks=history_iotasks, root=history_root, stride=history_stride, debug=first_call) call ice_pio_initdecomp(iodesc=iodesc2d, precision=history_precision) call ice_pio_initdecomp(ndim3=ncat_hist, iodesc=iodesc3dc, precision=history_precision) @@ -192,73 +195,82 @@ subroutine ice_write_hist (ns) !----------------------------------------------------------------- ! define dimensions !----------------------------------------------------------------- + call pio_seterrorhandling(File, PIO_RETURN_ERROR) - if (hist_avg(ns) .and. .not. write_ic) then - status = pio_def_dim(File,'nbnd',2,boundid) - endif + if (hist_avg(ns) .and. .not. write_ic) then + call ice_pio_check(pio_def_dim(File,'nbnd',2,boundid), & + subname//' ERROR: defining dim nbnd with len 2',file=__FILE__,line=__LINE__) + endif + + call ice_pio_check(pio_def_dim(File,'ni',nx_global,imtid), & + subname//' ERROR: defining dim ni',file=__FILE__,line=__LINE__) - status = pio_def_dim(File,'ni',nx_global,imtid) - status = pio_def_dim(File,'nj',ny_global,jmtid) - status = pio_def_dim(File,'nc',ncat_hist,cmtid) - status = pio_def_dim(File,'nkice',nzilyr,kmtidi) - status = pio_def_dim(File,'nksnow',nzslyr,kmtids) - status = pio_def_dim(File,'nkbio',nzblyr,kmtidb) - status = pio_def_dim(File,'nkaer',nzalyr,kmtida) - status = pio_def_dim(File,'time',PIO_UNLIMITED,timid) - status = pio_def_dim(File,'nvertices',nverts,nvertexid) - status = pio_def_dim(File,'nf',nfsd_hist,fmtid) + call ice_pio_check(pio_def_dim(File,'nj',ny_global,jmtid), & + subname//' ERROR: defining dim nj',file=__FILE__,line=__LINE__) + + call ice_pio_check(pio_def_dim(File,'nc',ncat_hist,cmtid), & + subname//' ERROR: defining dim nc',file=__FILE__,line=__LINE__) + + call ice_pio_check(pio_def_dim(File,'nkice',nzilyr,kmtidi), & + subname//' ERROR: defining dim nkice',file=__FILE__,line=__LINE__) + + call ice_pio_check(pio_def_dim(File,'nksnow',nzslyr,kmtids), & + subname//' ERROR: defining dim nksnow',file=__FILE__,line=__LINE__) + + call ice_pio_check(pio_def_dim(File,'nkbio',nzblyr,kmtidb), & + subname//' ERROR: defining dim nkbio',file=__FILE__,line=__LINE__) + + call ice_pio_check(pio_def_dim(File,'nkaer',nzalyr,kmtida), & + subname//' ERROR: defining dim nkaer',file=__FILE__,line=__LINE__) + + call ice_pio_check(pio_def_dim(File,'time',PIO_UNLIMITED,timid), & + subname//' ERROR: defining dim time',file=__FILE__,line=__LINE__) + + call ice_pio_check(pio_def_dim(File,'nvertices',nverts,nvertexid), & + subname//' ERROR: defining dim nvertices',file=__FILE__,line=__LINE__) + + call ice_pio_check(pio_def_dim(File,'nf',nfsd_hist,fmtid), & + subname//' ERROR: defining dim nf',file=__FILE__,line=__LINE__) !----------------------------------------------------------------- ! define coordinate variables: time, time_bounds !----------------------------------------------------------------- - status = pio_def_var(File,'time',pio_double,(/timid/),varid) - status = pio_put_att(File,varid,'long_name','time') - - write(cdate,'(i8.8)') idate0 - write(title,'(a,a4,a1,a2,a1,a2,a1,i2.2,a1,i2.2,a1,i2.2)') 'days since ', & - cdate(1:4),'-',cdate(5:6),'-',cdate(7:8),' ', & - hh_init,':',mm_init,':',ss_init - status = pio_put_att(File,varid,'units',trim(title)) - - if (days_per_year == 360) then - status = pio_put_att(File,varid,'calendar','360_day') - elseif (days_per_year == 365 .and. .not.use_leap_years ) then - status = pio_put_att(File,varid,'calendar','noleap') - elseif (use_leap_years) then - status = pio_put_att(File,varid,'calendar','Gregorian') - else - call abort_ice(subname//'ERROR: invalid calendar settings') - endif + write(cdate,'(i8.8)') idate0 + write(cal_units,'(a,a4,a1,a2,a1,a2,a1,i2.2,a1,i2.2,a1,i2.2)') 'days since ', & + cdate(1:4),'-',cdate(5:6),'-',cdate(7:8),' ', & + hh_init,':',mm_init,':',ss_init + + if (days_per_year == 360) then + cal_att='360_day' + elseif (days_per_year == 365 .and. .not.use_leap_years ) then + cal_att='noleap' + elseif (use_leap_years) then + cal_att='Gregorian' + else + call abort_ice(subname//' ERROR: invalid calendar settings') + endif - if (hist_avg(ns) .and. .not. write_ic) then - status = pio_put_att(File,varid,'bounds','time_bounds') - endif + time_coord = coord_attributes('time', 'time', trim(cal_units)) + call ice_hist_coord_def(File, time_coord, pio_double, (/timid/), varid) + call ice_pio_check(pio_put_att(File,varid,'calendar',cal_att), & + subname//' ERROR: defining att calendar: '//cal_att,file=__FILE__,line=__LINE__) + if (hist_avg(ns) .and. .not. write_ic) then + call ice_pio_check(pio_put_att(File,varid,'bounds','time_bounds'), & + subname//' ERROR: defining att bounds time_bounds',file=__FILE__,line=__LINE__) + endif - ! Define attributes for time_bounds if hist_avg is true - if (hist_avg(ns) .and. .not. write_ic) then - dimid2(1) = boundid - dimid2(2) = timid - status = pio_def_var(File,'time_bounds',pio_double,dimid2,varid) - status = pio_put_att(File,varid,'long_name', & - 'time interval endpoints') - - if (days_per_year == 360) then - status = pio_put_att(File,varid,'calendar','360_day') - elseif (days_per_year == 365 .and. .not.use_leap_years ) then - status = pio_put_att(File,varid,'calendar','noleap') - elseif (use_leap_years) then - status = pio_put_att(File,varid,'calendar','Gregorian') - else - call abort_ice(subname//'ERROR: invalid calendar settings') - endif - - write(cdate,'(i8.8)') idate0 - write(title,'(a,a4,a1,a2,a1,a2,a1,i2.2,a1,i2.2,a1,i2.2)') 'days since ', & - cdate(1:4),'-',cdate(5:6),'-',cdate(7:8),' ', & - hh_init,':',mm_init,':',ss_init - status = pio_put_att(File,varid,'units',trim(title)) - endif + ! Define coord time_bounds if hist_avg is true + if (hist_avg(ns) .and. .not. write_ic) then + time_coord = coord_attributes('time_bounds', 'time interval endpoints', trim(cal_units)) + + dimid2(1) = boundid + dimid2(2) = timid + + call ice_hist_coord_def(File, time_coord, pio_double, dimid2, varid) + call ice_pio_check(pio_put_att(File,varid,'calendar',cal_att), & + subname//' ERROR: defining att calendar: '//cal_att,file=__FILE__,line=__LINE__) + endif !----------------------------------------------------------------- ! define information for required time-invariant variables @@ -402,232 +414,170 @@ subroutine ice_write_hist (ns) ! define attributes for time-invariant variables !----------------------------------------------------------------- - dimid2(1) = imtid - dimid2(2) = jmtid - - do i = 1, ncoord - status = pio_def_var(File, trim(var_coord(i)%short_name), lprecision, & - dimid2, varid) - status = pio_put_att(File,varid,'long_name',trim(var_coord(i)%long_name)) - status = pio_put_att(File, varid, 'units', trim(var_coord(i)%units)) - call ice_write_hist_fill(File,varid,var_coord(i)%short_name,history_precision) - if (var_coord(i)%short_name == 'ULAT') then - status = pio_put_att(File,varid,'comment', & - trim('Latitude of NE corner of T grid cell')) - endif - if (f_bounds) then - status = pio_put_att(File, varid, 'bounds', trim(coord_bounds(i))) - endif - enddo - - ! Extra dimensions (NCAT, NZILYR, NZSLYR, NZBLYR, NZALYR, NFSD) - dimidex(1)=cmtid - dimidex(2)=kmtidi - dimidex(3)=kmtids - dimidex(4)=kmtidb - dimidex(5)=kmtida - dimidex(6)=fmtid - - do i = 1, nvar_grdz - if (igrdz(i)) then - status = pio_def_var(File, trim(var_grdz(i)%short_name), lprecision, & - (/dimidex(i)/), varid) - status = pio_put_att(File, varid, 'long_name', var_grdz(i)%long_name) - status = pio_put_att(File, varid, 'units' , var_grdz(i)%units) - endif - enddo - - do i = 1, nvar_grd - if (igrd(i)) then - status = pio_def_var(File, trim(var_grd(i)%req%short_name), & - lprecision, dimid2, varid) - status = pio_put_att(File,varid, 'long_name', trim(var_grd(i)%req%long_name)) - status = pio_put_att(File, varid, 'units', trim(var_grd(i)%req%units)) - status = pio_put_att(File, varid, 'coordinates', trim(var_grd(i)%coordinates)) - call ice_write_hist_fill(File,varid,var_grd(i)%req%short_name,history_precision) - endif - enddo - - ! Fields with dimensions (nverts,nx,ny) - dimid_nverts(1) = nvertexid - dimid_nverts(2) = imtid - dimid_nverts(3) = jmtid - do i = 1, nvar_verts - if (f_bounds) then - status = pio_def_var(File, trim(var_nverts(i)%short_name), & - lprecision,dimid_nverts, varid) - status = & - pio_put_att(File,varid, 'long_name', trim(var_nverts(i)%long_name)) - status = & - pio_put_att(File, varid, 'units', trim(var_nverts(i)%units)) - call ice_write_hist_fill(File,varid,var_nverts(i)%short_name,history_precision) - endif - enddo + dimid2(1) = imtid + dimid2(2) = jmtid + + do i = 1, ncoord + call ice_hist_coord_def(File, var_coord(i), lprecision, dimid2, varid) + call ice_write_hist_fill(File,varid,var_coord(i)%short_name,history_precision) + if (var_coord(i)%short_name == 'ULAT') then + call ice_pio_check(pio_put_att(File,varid,'comment', & + trim('Latitude of NE corner of T grid cell')), & + subname//' ERROR: defining att comment',file=__FILE__,line=__LINE__) + endif + if (f_bounds) then + call ice_pio_check(pio_put_att(File, varid, 'bounds', trim(coord_bounds(i))), & + subname//' ERROR: defining att bounds '//trim(coord_bounds(i)),file=__FILE__,line=__LINE__) + endif + enddo + + ! Extra dimensions (NCAT, NZILYR, NZSLYR, NZBLYR, NZALYR, NFSD) + dimidex(1)=cmtid + dimidex(2)=kmtidi + dimidex(3)=kmtids + dimidex(4)=kmtidb + dimidex(5)=kmtida + dimidex(6)=fmtid + + do i = 1, nvar_grdz + if (igrdz(i)) then + call ice_hist_coord_def(File, var_grdz(i), lprecision, dimidex(i:i), varid) + endif + enddo + + do i = 1, nvar_grd + if (igrd(i)) then + call ice_hist_coord_def(File, var_grd(i)%req, lprecision, dimid2, varid) + call ice_pio_check(pio_put_att(File, varid, 'coordinates', trim(var_grd(i)%coordinates)), & + subname//' ERROR: defining att coordinates '//trim(var_grd(i)%coordinates),file=__FILE__,line=__LINE__) + call ice_write_hist_fill(File,varid,var_grd(i)%req%short_name,history_precision) + endif + enddo + + ! Fields with dimensions (nverts,nx,ny) + dimid_nverts(1) = nvertexid + dimid_nverts(2) = imtid + dimid_nverts(3) = jmtid + do i = 1, nvar_verts + if (f_bounds) then + call ice_hist_coord_def(File, var_nverts(i), lprecision, dimid_nverts, varid) + call ice_write_hist_fill(File,varid,var_nverts(i)%short_name,history_precision) + endif + enddo !----------------------------------------------------------------- ! define attributes for time-variant variables !----------------------------------------------------------------- - !----------------------------------------------------------------- ! 2D - !----------------------------------------------------------------- + dimid3(1) = imtid + dimid3(2) = jmtid + dimid3(3) = timid - dimid3(1) = imtid - dimid3(2) = jmtid - dimid3(3) = timid - - do n=1,num_avail_hist_fields_2D - if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then - status = pio_def_var(File, trim(avail_hist_fields(n)%vname), & - lprecision, dimid3, varid) - call ice_write_hist_attrs(File,varid,avail_hist_fields(n),ns) - endif - enddo ! num_avail_hist_fields_2D + do n=1,num_avail_hist_fields_2D + if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then + call ice_hist_field_def(File, avail_hist_fields(n),lprecision, dimid3, ns) + endif + enddo - !----------------------------------------------------------------- ! 3D (category) - !----------------------------------------------------------------- - - dimidz(1) = imtid - dimidz(2) = jmtid - dimidz(3) = cmtid - dimidz(4) = timid + dimidz(1) = imtid + dimidz(2) = jmtid + dimidz(3) = cmtid + dimidz(4) = timid - do n = n2D + 1, n3Dccum - if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then - status = pio_def_var(File, trim(avail_hist_fields(n)%vname), & - lprecision, dimidz, varid) - call ice_write_hist_attrs(File,varid,avail_hist_fields(n),ns) - endif - enddo ! num_avail_hist_fields_3Dc + do n = n2D + 1, n3Dccum + if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then + call ice_hist_field_def(File, avail_hist_fields(n),lprecision, dimidz,ns) + endif + enddo ! num_avail_hist_fields_3Dc - !----------------------------------------------------------------- ! 3D (ice layers) - !----------------------------------------------------------------- - - dimidz(1) = imtid - dimidz(2) = jmtid - dimidz(3) = kmtidi - dimidz(4) = timid + dimidz(1) = imtid + dimidz(2) = jmtid + dimidz(3) = kmtidi + dimidz(4) = timid - do n = n3Dccum + 1, n3Dzcum - if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then - status = pio_def_var(File, trim(avail_hist_fields(n)%vname), & - lprecision, dimidz, varid) - call ice_write_hist_attrs(File,varid,avail_hist_fields(n),ns) - endif - enddo ! num_avail_hist_fields_3Dz + do n = n3Dccum + 1, n3Dzcum + if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then + call ice_hist_field_def(File, avail_hist_fields(n),lprecision, dimidz,ns) + endif + enddo ! num_avail_hist_fields_3Dz - !----------------------------------------------------------------- ! 3D (biology ice layers) - !----------------------------------------------------------------- - - dimidz(1) = imtid - dimidz(2) = jmtid - dimidz(3) = kmtidb - dimidz(4) = timid + dimidz(1) = imtid + dimidz(2) = jmtid + dimidz(3) = kmtidb + dimidz(4) = timid - do n = n3Dzcum + 1, n3Dbcum - if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then - status = pio_def_var(File, trim(avail_hist_fields(n)%vname), & - lprecision, dimidz, varid) - call ice_write_hist_attrs(File,varid,avail_hist_fields(n),ns) - endif - enddo ! num_avail_hist_fields_3Db + do n = n3Dzcum + 1, n3Dbcum + if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then + call ice_hist_field_def(File, avail_hist_fields(n),lprecision, dimidz,ns) + endif + enddo ! num_avail_hist_fields_3Db - !----------------------------------------------------------------- ! 3D (biology snow layers) - !----------------------------------------------------------------- + dimidz(1) = imtid + dimidz(2) = jmtid + dimidz(3) = kmtida + dimidz(4) = timid - dimidz(1) = imtid - dimidz(2) = jmtid - dimidz(3) = kmtida - dimidz(4) = timid - - do n = n3Dbcum + 1, n3Dacum - if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then - status = pio_def_var(File, trim(avail_hist_fields(n)%vname), & - lprecision, dimidz, varid) - call ice_write_hist_attrs(File,varid,avail_hist_fields(n),ns) - endif - enddo ! num_avail_hist_fields_3Da + do n = n3Dbcum + 1, n3Dacum + if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then + call ice_hist_field_def(File, avail_hist_fields(n),lprecision, dimidz,ns) + endif + enddo ! num_avail_hist_fields_3Da - !----------------------------------------------------------------- ! 3D (fsd) - !----------------------------------------------------------------- - - dimidz(1) = imtid - dimidz(2) = jmtid - dimidz(3) = fmtid - dimidz(4) = timid + dimidz(1) = imtid + dimidz(2) = jmtid + dimidz(3) = fmtid + dimidz(4) = timid - do n = n3Dacum + 1, n3Dfcum - if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then - status = pio_def_var(File, trim(avail_hist_fields(n)%vname), & - lprecision, dimidz, varid) - call ice_write_hist_attrs(File,varid,avail_hist_fields(n),ns) - endif - enddo ! num_avail_hist_fields_3Df - - !----------------------------------------------------------------- - ! define attributes for 4D variables - ! time coordinate is dropped - !----------------------------------------------------------------- + do n = n3Dacum + 1, n3Dfcum + if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then + call ice_hist_field_def(File, avail_hist_fields(n),lprecision, dimidz,ns) + endif + enddo ! num_avail_hist_fields_3Df - !----------------------------------------------------------------- ! 4D (ice categories) - !----------------------------------------------------------------- - - dimidcz(1) = imtid - dimidcz(2) = jmtid - dimidcz(3) = kmtidi - dimidcz(4) = cmtid - dimidcz(5) = timid + dimidcz(1) = imtid + dimidcz(2) = jmtid + dimidcz(3) = kmtidi + dimidcz(4) = cmtid + dimidcz(5) = timid - do n = n3Dfcum + 1, n4Dicum - if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then - status = pio_def_var(File, trim(avail_hist_fields(n)%vname), & - lprecision, dimidcz, varid) - call ice_write_hist_attrs(File,varid,avail_hist_fields(n),ns) - endif - enddo ! num_avail_hist_fields_4Di + do n = n3Dfcum + 1, n4Dicum + if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then + call ice_hist_field_def(File, avail_hist_fields(n),lprecision, dimidcz,ns) + endif + enddo ! num_avail_hist_fields_4Di - !----------------------------------------------------------------- ! 4D (snow layers) - !----------------------------------------------------------------- - - dimidcz(1) = imtid - dimidcz(2) = jmtid - dimidcz(3) = kmtids - dimidcz(4) = cmtid - dimidcz(5) = timid - - do n = n4Dicum + 1, n4Dscum - if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then - status = pio_def_var(File, trim(avail_hist_fields(n)%vname), & - lprecision, dimidcz, varid) - call ice_write_hist_attrs(File,varid,avail_hist_fields(n),ns) - endif - enddo ! num_avail_hist_fields_4Ds + dimidcz(1) = imtid + dimidcz(2) = jmtid + dimidcz(3) = kmtids + dimidcz(4) = cmtid + dimidcz(5) = timid + do n = n4Dicum + 1, n4Dscum + if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then + call ice_hist_field_def(File, avail_hist_fields(n),lprecision, dimidcz,ns) + endif + enddo ! num_avail_hist_fields_4Ds - !----------------------------------------------------------------- ! 4D (fsd layers) - !----------------------------------------------------------------- - - dimidcz(1) = imtid - dimidcz(2) = jmtid - dimidcz(3) = fmtid - dimidcz(4) = cmtid - dimidcz(5) = timid + dimidcz(1) = imtid + dimidcz(2) = jmtid + dimidcz(3) = fmtid + dimidcz(4) = cmtid + dimidcz(5) = timid - do n = n4Dscum + 1, n4Dfcum - if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then - status = pio_def_var(File, trim(avail_hist_fields(n)%vname), & - lprecision, dimidcz, varid) - call ice_write_hist_attrs(File,varid,avail_hist_fields(n),ns) - endif - enddo ! num_avail_hist_fields_4Df + do n = n4Dscum + 1, n4Dfcum + if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then + call ice_hist_field_def(File, avail_hist_fields(n),lprecision, dimidcz,ns) + endif + enddo ! num_avail_hist_fields_4Df !----------------------------------------------------------------- ! global attributes @@ -635,31 +585,38 @@ subroutine ice_write_hist (ns) ! ... the user should change these to something useful ... !----------------------------------------------------------------- #ifdef CESMCOUPLED - status = pio_put_att(File,pio_global,'title',runid) + call ice_pio_check(pio_put_att(File,pio_global,'title',runid), & + subname//' ERROR: defining att title '//runid,file=__FILE__,line=__LINE__) #else - title = 'sea ice model output for CICE' - status = pio_put_att(File,pio_global,'title',trim(title)) + title = 'sea ice model output for CICE' + call ice_pio_check(pio_put_att(File,pio_global,'title',trim(title)), & + subname//' ERROR: defining att title '//trim(title),file=__FILE__,line=__LINE__) #endif - title = 'Diagnostic and Prognostic Variables' - status = pio_put_att(File,pio_global,'contents',trim(title)) + title = 'Diagnostic and Prognostic Variables' + call ice_pio_check(pio_put_att(File,pio_global,'contents',trim(title)), & + subname//' ERROR: defining att contents '//trim(title),file=__FILE__,line=__LINE__) - write(title,'(2a)') 'Los Alamos Sea Ice Model, ', trim(version_name) - status = pio_put_att(File,pio_global,'source',trim(title)) + write(title,'(2a)') 'CICE Sea Ice Model, ', trim(version_name) + call ice_pio_check(pio_put_att(File,pio_global,'source',trim(title)), & + subname//' ERROR: defining att source '//trim(title),file=__FILE__,line=__LINE__) - if (use_leap_years) then - write(title,'(a,i3,a)') 'This year has ',dayyr,' days' - else - write(title,'(a,i3,a)') 'All years have exactly ',dayyr,' days' - endif - status = pio_put_att(File,pio_global,'comment',trim(title)) + if (use_leap_years) then + write(title,'(a,i3,a)') 'This year has ',dayyr,' days' + else + write(title,'(a,i3,a)') 'All years have exactly ',dayyr,' days' + endif + call ice_pio_check(pio_put_att(File,pio_global,'comment',trim(title)), & + subname//' ERROR: defining att comment '//trim(title),file=__FILE__,line=__LINE__) - write(title,'(a,i8.8)') 'File written on model date ',idate - status = pio_put_att(File,pio_global,'comment2',trim(title)) + write(title,'(a,i8.8)') 'File written on model date ',idate + call ice_pio_check(pio_put_att(File,pio_global,'comment2',trim(title)), & + subname//' ERROR: defining att comment2 '//trim(title),file=__FILE__,line=__LINE__) - write(title,'(a,i6)') 'seconds elapsed into model date: ',msec - status = pio_put_att(File,pio_global,'comment3',trim(title)) + write(title,'(a,i6)') 'seconds elapsed into model date: ',msec + call ice_pio_check(pio_put_att(File,pio_global,'comment3',trim(title)), & + subname//' ERROR: defining att comment3 '//trim(title),file=__FILE__,line=__LINE__) - select case (histfreq(ns)) + select case (histfreq(ns)) case ("y", "Y") write(time_period_freq,'(a,i0)') 'year_',histfreq_n(ns) case ("m", "M") @@ -670,78 +627,88 @@ subroutine ice_write_hist (ns) write(time_period_freq,'(a,i0)') 'hour_',histfreq_n(ns) case ("1") write(time_period_freq,'(a,i0)') 'step_',histfreq_n(ns) - end select + end select - if (.not.write_ic .and. trim(time_period_freq) /= 'none') then - status = pio_put_att(File,pio_global,'time_period_freq',trim(time_period_freq)) - endif - - if (hist_avg(ns)) & - status = pio_put_att(File,pio_global,'time_axis_position',trim(hist_time_axis)) - - title = 'CF-1.0' - status = & - pio_put_att(File,pio_global,'conventions',trim(title)) - - call date_and_time(date=current_date, time=current_time) - write(start_time,1000) current_date(1:4), current_date(5:6), & - current_date(7:8), current_time(1:2), & - current_time(3:4) -1000 format('This dataset was created on ', & - a,'-',a,'-',a,' at ',a,':',a) - status = pio_put_att(File,pio_global,'history',trim(start_time)) + if (.not.write_ic .and. trim(time_period_freq) /= 'none') then + call ice_pio_check(pio_put_att(File,pio_global,'time_period_freq',trim(time_period_freq)), & + subname//' ERROR: defining att time_period_freq '//trim(time_period_freq),file=__FILE__,line=__LINE__) + endif - if (history_format == 'pio_pnetcdf') then - status = pio_put_att(File,pio_global,'io_flavor','io_pio pnetcdf') - else - status = pio_put_att(File,pio_global,'io_flavor','io_pio netcdf') - endif + if (hist_avg(ns)) & + call ice_pio_check(pio_put_att(File,pio_global,'time_axis_position',trim(hist_time_axis)), & + subname//' ERROR: defining att time_axis_position '//trim(hist_time_axis),file=__FILE__,line=__LINE__) + + title = 'CF-1.0' + call ice_pio_check(pio_put_att(File,pio_global,'conventions',trim(title)), & + subname//' ERROR: defining att conventions '//trim(title),file=__FILE__,line=__LINE__) + + call date_and_time(date=current_date, time=current_time) + write(start_time,1000) current_date(1:4), current_date(5:6), & + current_date(7:8), current_time(1:2), & + current_time(3:4) +1000 format('This dataset was created on ', & + a,'-',a,'-',a,' at ',a,':',a) + call ice_pio_check(pio_put_att(File,pio_global,'history',trim(start_time)), & + subname//' ERROR: defining att history '//trim(start_time),file=__FILE__,line=__LINE__) + +#ifdef USE_PIO1 + call ice_pio_check(pio_put_att(File,pio_global,'io_flavor','io_pio1 '//trim(history_format)), & + subname//' ERROR: defining att io_flavor',file=__FILE__,line=__LINE__) +#else + call ice_pio_check(pio_put_att(File,pio_global,'io_flavor','io_pio2 '//trim(history_format)), & + subname//' ERROR: defining att io_flavor',file=__FILE__,line=__LINE__) +#endif !----------------------------------------------------------------- ! end define mode !----------------------------------------------------------------- - status = pio_enddef(File) + call ice_pio_check(pio_enddef(File), & + subname//' ERROR: ending pio definitions',file=__FILE__,line=__LINE__) !----------------------------------------------------------------- ! write time variable !----------------------------------------------------------------- - ltime2 = timesecs/secday ! hist_time_axis = 'end' (default) + ltime2 = timesecs/secday ! hist_time_axis = 'end' (default) - ! Some coupled models require the time axis "stamp" to be in the middle - ! or even beginning of averaging interval. - if (hist_avg(ns)) then - if (trim(hist_time_axis) == "begin" ) ltime2 = time_beg(ns) - if (trim(hist_time_axis) == "middle") ltime2 = p5*(time_beg(ns)+time_end(ns)) - endif + ! Some coupled models require the time axis "stamp" to be in the middle + ! or even beginning of averaging interval. + if (hist_avg(ns)) then + if (trim(hist_time_axis) == "begin" ) ltime2 = time_beg(ns) + if (trim(hist_time_axis) == "middle") ltime2 = p5*(time_beg(ns)+time_end(ns)) + endif - status = pio_inq_varid(File,'time',varid) - status = pio_put_var(File,varid,(/1/),ltime2) + call ice_pio_check(pio_inq_varid(File,'time',varid), & + subname//' ERROR: getting var time',file=__FILE__,line=__LINE__) + call ice_pio_check(pio_put_var(File,varid,(/1/),ltime2), & + subname//' ERROR: setting var time',file=__FILE__,line=__LINE__) !----------------------------------------------------------------- ! write time_bounds info !----------------------------------------------------------------- - if (hist_avg(ns) .and. .not. write_ic) then - status = pio_inq_varid(File,'time_bounds',varid) - time_bounds=(/time_beg(ns),time_end(ns)/) - bnd_start = (/1,1/) - bnd_length = (/2,1/) - status = pio_put_var(File,varid,ival=time_bounds, & - start=bnd_start(:),count=bnd_length(:)) - endif + if (hist_avg(ns) .and. .not. write_ic) then + call ice_pio_check(pio_inq_varid(File,'time_bounds',varid), & + subname//' ERROR: getting time_bounds' ,file=__FILE__,line=__LINE__) + time_bounds=(/time_beg(ns),time_end(ns)/) + bnd_start = (/1,1/) + bnd_length = (/2,1/) + call ice_pio_check(pio_put_var(File,varid,ival=time_bounds,start=bnd_start(:),count=bnd_length(:)), & + subname//' ERROR: setting time_bounds' ,file=__FILE__,line=__LINE__) + endif !----------------------------------------------------------------- ! write coordinate variables !----------------------------------------------------------------- - allocate(workd2(nx_block,ny_block,nblocks)) - allocate(workr2(nx_block,ny_block,nblocks)) + allocate(workd2(nx_block,ny_block,nblocks)) + allocate(workr2(nx_block,ny_block,nblocks)) - do i = 1,ncoord - status = pio_inq_varid(File, var_coord(i)%short_name, varid) - SELECT CASE (var_coord(i)%short_name) + do i = 1,ncoord + call ice_pio_check(pio_inq_varid(File, var_coord(i)%short_name, varid), & + subname//' ERROR: getting '//var_coord(i)%short_name ,file=__FILE__,line=__LINE__) + SELECT CASE (var_coord(i)%short_name) CASE ('TLON') ! Convert T grid longitude from -180 -> 180 to 0 to 360 workd2(:,:,:) = mod(tlon(:,:,1:nblocks)*rad_to_deg + c360, c360) @@ -759,38 +726,48 @@ subroutine ice_write_hist (ns) workd2(:,:,:) = elon(:,:,1:nblocks)*rad_to_deg CASE ('ELAT') workd2(:,:,:) = elat(:,:,1:nblocks)*rad_to_deg - END SELECT - if (history_precision == 8) then - call pio_write_darray(File, varid, iodesc2d, & - workd2, status, fillval=spval_dbl) - else - workr2 = workd2 - call pio_write_darray(File, varid, iodesc2d, & - workr2, status, fillval=spval) - endif - enddo - - ! Extra dimensions (NCAT, NFSD, VGRD*) - - do i = 1, nvar_grdz - if (igrdz(i)) then - status = pio_inq_varid(File, var_grdz(i)%short_name, varid) + END SELECT + if (history_precision == 8) then + call pio_write_darray(File, varid, iodesc2d, & + workd2, status, fillval=spval_dbl) + else + workr2 = workd2 + call pio_write_darray(File, varid, iodesc2d, & + workr2, status, fillval=spval) + endif + + call ice_pio_check(status,subname//' ERROR: writing '//avail_hist_fields(n)%vname, & + file=__FILE__,line=__LINE__) + enddo + + ! Extra dimensions (NCAT, NFSD, VGRD*) + + do i = 1, nvar_grdz + if (igrdz(i)) then + call ice_pio_check(pio_inq_varid(File, var_grdz(i)%short_name, varid), & + subname//' ERROR: getting '//var_grdz(i)%short_name,file=__FILE__,line=__LINE__) SELECT CASE (var_grdz(i)%short_name) - CASE ('NCAT') - status = pio_put_var(File, varid, hin_max(1:ncat_hist)) - CASE ('NFSD') - status = pio_put_var(File, varid, floe_rad_c(1:nfsd_hist)) - CASE ('VGRDi') - status = pio_put_var(File, varid, (/(k, k=1,nzilyr)/)) - CASE ('VGRDs') - status = pio_put_var(File, varid, (/(k, k=1,nzslyr)/)) - CASE ('VGRDb') - status = pio_put_var(File, varid, (/(k, k=1,nzblyr)/)) - CASE ('VGRDa') - status = pio_put_var(File, varid, (/(k, k=1,nzalyr)/)) - END SELECT - endif - enddo + CASE ('NCAT') + call ice_pio_check(pio_put_var(File, varid, hin_max(1:ncat_hist)), & + subname//' ERROR: setting '//var_grdz(i)%short_name,file=__FILE__,line=__LINE__) + CASE ('NFSD') + call ice_pio_check(pio_put_var(File, varid, floe_rad_c(1:nfsd_hist)), & + subname//' ERROR: setting '//var_grdz(i)%short_name,file=__FILE__,line=__LINE__) + CASE ('VGRDi') + call ice_pio_check(pio_put_var(File, varid, (/(k, k=1,nzilyr)/)), & + subname//' ERROR: setting '//var_grdz(i)%short_name,file=__FILE__,line=__LINE__) + CASE ('VGRDs') + call ice_pio_check(pio_put_var(File, varid, (/(k, k=1,nzslyr)/)), & + subname//' ERROR: setting '//var_grdz(i)%short_name,file=__FILE__,line=__LINE__) + CASE ('VGRDb') + call ice_pio_check(pio_put_var(File, varid, (/(k, k=1,nzblyr)/)), & + subname//' ERROR: setting '//var_grdz(i)%short_name,file=__FILE__,line=__LINE__) + CASE ('VGRDa') + call ice_pio_check(pio_put_var(File, varid, (/(k, k=1,nzalyr)/)), & + subname//' ERROR: setting '//var_grdz(i)%short_name,file=__FILE__,line=__LINE__) + END SELECT + endif + enddo !----------------------------------------------------------------- ! write grid masks, area and rotation angle @@ -799,50 +776,51 @@ subroutine ice_write_hist (ns) do i = 1, nvar_grd if (igrd(i)) then SELECT CASE (var_grd(i)%req%short_name) - CASE ('tmask') - workd2 = hm(:,:,1:nblocks) - CASE ('umask') - workd2 = uvm(:,:,1:nblocks) - CASE ('nmask') - workd2 = npm(:,:,1:nblocks) - CASE ('emask') - workd2 = epm(:,:,1:nblocks) - CASE ('blkmask') - workd2 = bm(:,:,1:nblocks) - CASE ('tarea') - workd2 = tarea(:,:,1:nblocks) - CASE ('uarea') - workd2 = uarea(:,:,1:nblocks) - CASE ('narea') - workd2 = narea(:,:,1:nblocks) - CASE ('earea') - workd2 = earea(:,:,1:nblocks) - CASE ('dxt') - workd2 = dxT(:,:,1:nblocks) - CASE ('dyt') - workd2 = dyT(:,:,1:nblocks) - CASE ('dxu') - workd2 = dxU(:,:,1:nblocks) - CASE ('dyu') - workd2 = dyU(:,:,1:nblocks) - CASE ('dxn') - workd2 = dxN(:,:,1:nblocks) - CASE ('dyn') - workd2 = dyN(:,:,1:nblocks) - CASE ('dxe') - workd2 = dxE(:,:,1:nblocks) - CASE ('dye') - workd2 = dyE(:,:,1:nblocks) - CASE ('HTN') - workd2 = HTN(:,:,1:nblocks) - CASE ('HTE') - workd2 = HTE(:,:,1:nblocks) - CASE ('ANGLE') - workd2 = ANGLE(:,:,1:nblocks) - CASE ('ANGLET') - workd2 = ANGLET(:,:,1:nblocks) + CASE ('tmask') + workd2 = hm(:,:,1:nblocks) + CASE ('umask') + workd2 = uvm(:,:,1:nblocks) + CASE ('nmask') + workd2 = npm(:,:,1:nblocks) + CASE ('emask') + workd2 = epm(:,:,1:nblocks) + CASE ('blkmask') + workd2 = bm(:,:,1:nblocks) + CASE ('tarea') + workd2 = tarea(:,:,1:nblocks) + CASE ('uarea') + workd2 = uarea(:,:,1:nblocks) + CASE ('narea') + workd2 = narea(:,:,1:nblocks) + CASE ('earea') + workd2 = earea(:,:,1:nblocks) + CASE ('dxt') + workd2 = dxT(:,:,1:nblocks) + CASE ('dyt') + workd2 = dyT(:,:,1:nblocks) + CASE ('dxu') + workd2 = dxU(:,:,1:nblocks) + CASE ('dyu') + workd2 = dyU(:,:,1:nblocks) + CASE ('dxn') + workd2 = dxN(:,:,1:nblocks) + CASE ('dyn') + workd2 = dyN(:,:,1:nblocks) + CASE ('dxe') + workd2 = dxE(:,:,1:nblocks) + CASE ('dye') + workd2 = dyE(:,:,1:nblocks) + CASE ('HTN') + workd2 = HTN(:,:,1:nblocks) + CASE ('HTE') + workd2 = HTE(:,:,1:nblocks) + CASE ('ANGLE') + workd2 = ANGLE(:,:,1:nblocks) + CASE ('ANGLET') + workd2 = ANGLET(:,:,1:nblocks) END SELECT - status = pio_inq_varid(File, var_grd(i)%req%short_name, varid) + call ice_pio_check(pio_inq_varid(File, var_grd(i)%req%short_name, varid), & + subname//' ERROR: getting '//var_grd(i)%req%short_name,file=__FILE__,line=__LINE__) if (history_precision == 8) then call pio_write_darray(File, varid, iodesc2d, & workd2, status, fillval=spval_dbl) @@ -851,6 +829,9 @@ subroutine ice_write_hist (ns) call pio_write_darray(File, varid, iodesc2d, & workr2, status, fillval=spval) endif + + call ice_pio_check(status,subname//' ERROR: writing '//avail_hist_fields(n)%vname, & + file=__FILE__,line=__LINE__) endif enddo @@ -859,59 +840,62 @@ subroutine ice_write_hist (ns) !---------------------------------------------------------------- if (f_bounds) then - allocate(workd3v(nverts,nx_block,ny_block,nblocks)) - allocate(workr3v(nverts,nx_block,ny_block,nblocks)) - workd3v (:,:,:,:) = c0 - do i = 1, nvar_verts - SELECT CASE (var_nverts(i)%short_name) - CASE ('lont_bounds') - do ivertex = 1, nverts - workd3v(ivertex,:,:,:) = lont_bounds(ivertex,:,:,1:nblocks) - enddo - CASE ('latt_bounds') - do ivertex = 1, nverts - workd3v(ivertex,:,:,:) = latt_bounds(ivertex,:,:,1:nblocks) - enddo - CASE ('lonu_bounds') - do ivertex = 1, nverts - workd3v(ivertex,:,:,:) = lonu_bounds(ivertex,:,:,1:nblocks) - enddo - CASE ('latu_bounds') - do ivertex = 1, nverts - workd3v(ivertex,:,:,:) = latu_bounds(ivertex,:,:,1:nblocks) - enddo - CASE ('lonn_bounds') - do ivertex = 1, nverts - workd3v(ivertex,:,:,:) = lonn_bounds(ivertex,:,:,1:nblocks) - enddo - CASE ('latn_bounds') - do ivertex = 1, nverts - workd3v(ivertex,:,:,:) = latn_bounds(ivertex,:,:,1:nblocks) - enddo - CASE ('lone_bounds') - do ivertex = 1, nverts - workd3v(ivertex,:,:,:) = lone_bounds(ivertex,:,:,1:nblocks) - enddo - CASE ('late_bounds') - do ivertex = 1, nverts - workd3v(ivertex,:,:,:) = late_bounds(ivertex,:,:,1:nblocks) - enddo - END SELECT - - status = pio_inq_varid(File, var_nverts(i)%short_name, varid) - if (history_precision == 8) then - call pio_write_darray(File, varid, iodesc3dv, & + allocate(workd3v(nverts,nx_block,ny_block,nblocks)) + allocate(workr3v(nverts,nx_block,ny_block,nblocks)) + workd3v (:,:,:,:) = c0 + do i = 1, nvar_verts + SELECT CASE (var_nverts(i)%short_name) + CASE ('lont_bounds') + do ivertex = 1, nverts + workd3v(ivertex,:,:,:) = lont_bounds(ivertex,:,:,1:nblocks) + enddo + CASE ('latt_bounds') + do ivertex = 1, nverts + workd3v(ivertex,:,:,:) = latt_bounds(ivertex,:,:,1:nblocks) + enddo + CASE ('lonu_bounds') + do ivertex = 1, nverts + workd3v(ivertex,:,:,:) = lonu_bounds(ivertex,:,:,1:nblocks) + enddo + CASE ('latu_bounds') + do ivertex = 1, nverts + workd3v(ivertex,:,:,:) = latu_bounds(ivertex,:,:,1:nblocks) + enddo + CASE ('lonn_bounds') + do ivertex = 1, nverts + workd3v(ivertex,:,:,:) = lonn_bounds(ivertex,:,:,1:nblocks) + enddo + CASE ('latn_bounds') + do ivertex = 1, nverts + workd3v(ivertex,:,:,:) = latn_bounds(ivertex,:,:,1:nblocks) + enddo + CASE ('lone_bounds') + do ivertex = 1, nverts + workd3v(ivertex,:,:,:) = lone_bounds(ivertex,:,:,1:nblocks) + enddo + CASE ('late_bounds') + do ivertex = 1, nverts + workd3v(ivertex,:,:,:) = late_bounds(ivertex,:,:,1:nblocks) + enddo + END SELECT + + call ice_pio_check(pio_inq_varid(File, var_nverts(i)%short_name, varid), & + subname//' ERROR: getting '//var_nverts(i)%short_name,file=__FILE__,line=__LINE__) + if (history_precision == 8) then + call pio_write_darray(File, varid, iodesc3dv, & workd3v, status, fillval=spval_dbl) - else - workr3v = workd3v - call pio_write_darray(File, varid, iodesc3dv, & - workr3v, status, fillval=spval) - endif - enddo - deallocate(workd3v) - deallocate(workr3v) - endif ! f_bounds + else + workr3v = workd3v + call pio_write_darray(File, varid, iodesc3dv, & + workr3v, status, fillval=spval) + endif + call ice_pio_check(status,subname//' ERROR: writing '//avail_hist_fields(n)%vname, & + file=__FILE__,line=__LINE__) + enddo + deallocate(workd3v) + deallocate(workr3v) + endif ! f_bounds !----------------------------------------------------------------- ! write variable data @@ -920,15 +904,16 @@ subroutine ice_write_hist (ns) ! 2D do n=1,num_avail_hist_fields_2D if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then - status = pio_inq_varid(File,avail_hist_fields(n)%vname,varid) - if (status /= pio_noerr) call abort_ice(subname// & - 'ERROR getting varid for '//avail_hist_fields(n)%vname) + call ice_pio_check(pio_inq_varid(File,avail_hist_fields(n)%vname,varid), & + subname//' ERROR: getting varid for '//avail_hist_fields(n)%vname,file=__FILE__,line=__LINE__) workd2(:,:,:) = a2D(:,:,n,1:nblocks) + call pio_seterrorhandling(File, PIO_INTERNAL_ERROR) #ifdef CESM1_PIO call pio_setframe(varid, int(1,kind=PIO_OFFSET)) #else call pio_setframe(File, varid, int(1,kind=PIO_OFFSET_KIND)) #endif + call pio_seterrorhandling(File, PIO_RETURN_ERROR) if (history_precision == 8) then call pio_write_darray(File, varid, iodesc2d,& workd2, status, fillval=spval_dbl) @@ -937,6 +922,9 @@ subroutine ice_write_hist (ns) call pio_write_darray(File, varid, iodesc2d,& workr2, status, fillval=spval) endif + + call ice_pio_check(status,subname//' ERROR: writing '//avail_hist_fields(n)%vname, & + file=__FILE__,line=__LINE__) endif enddo ! num_avail_hist_fields_2D @@ -949,19 +937,20 @@ subroutine ice_write_hist (ns) do n = n2D + 1, n3Dccum nn = n - n2D if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then - status = pio_inq_varid(File,avail_hist_fields(n)%vname,varid) - if (status /= pio_noerr) call abort_ice(subname// & - 'ERROR: getting varid for '//avail_hist_fields(n)%vname) + call ice_pio_check(pio_inq_varid(File,avail_hist_fields(n)%vname,varid), & + subname//' ERROR: getting varid for '//avail_hist_fields(n)%vname,file=__FILE__,line=__LINE__) do j = 1, nblocks do i = 1, ncat_hist workd3(:,:,j,i) = a3Dc(:,:,i,nn,j) enddo enddo + call pio_seterrorhandling(File, PIO_INTERNAL_ERROR) #ifdef CESM1_PIO call pio_setframe(varid, int(1,kind=PIO_OFFSET)) #else call pio_setframe(File, varid, int(1,kind=PIO_OFFSET_KIND)) #endif + call pio_seterrorhandling(File, PIO_RETURN_ERROR) if (history_precision == 8) then call pio_write_darray(File, varid, iodesc3dc,& workd3, status, fillval=spval_dbl) @@ -970,6 +959,9 @@ subroutine ice_write_hist (ns) call pio_write_darray(File, varid, iodesc3dc,& workr3, status, fillval=spval) endif + + call ice_pio_check(status,subname//' ERROR: writing '//avail_hist_fields(n)%vname, & + file=__FILE__,line=__LINE__) endif enddo ! num_avail_hist_fields_3Dc deallocate(workd3) @@ -981,19 +973,20 @@ subroutine ice_write_hist (ns) do n = n3Dccum+1, n3Dzcum nn = n - n3Dccum if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then - status = pio_inq_varid(File,avail_hist_fields(n)%vname,varid) - if (status /= pio_noerr) call abort_ice(subname// & - 'ERROR: getting varid for '//avail_hist_fields(n)%vname) + call ice_pio_check(pio_inq_varid(File,avail_hist_fields(n)%vname,varid), & + subname//' ERROR: getting varid for '//avail_hist_fields(n)%vname,file=__FILE__,line=__LINE__) do j = 1, nblocks do i = 1, nzilyr workd3(:,:,j,i) = a3Dz(:,:,i,nn,j) enddo enddo + call pio_seterrorhandling(File, PIO_INTERNAL_ERROR) #ifdef CESM1_PIO call pio_setframe(varid, int(1,kind=PIO_OFFSET)) #else call pio_setframe(File, varid, int(1,kind=PIO_OFFSET_KIND)) #endif + call pio_seterrorhandling(File, PIO_RETURN_ERROR) if (history_precision == 8) then call pio_write_darray(File, varid, iodesc3di,& workd3, status, fillval=spval_dbl) @@ -1002,6 +995,9 @@ subroutine ice_write_hist (ns) call pio_write_darray(File, varid, iodesc3di,& workr3, status, fillval=spval) endif + + call ice_pio_check(status,subname//' ERROR: writing '//avail_hist_fields(n)%vname, & + file=__FILE__,line=__LINE__) endif enddo ! num_avail_hist_fields_3Dz deallocate(workd3) @@ -1013,19 +1009,20 @@ subroutine ice_write_hist (ns) do n = n3Dzcum+1, n3Dbcum nn = n - n3Dzcum if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then - status = pio_inq_varid(File,avail_hist_fields(n)%vname,varid) - if (status /= pio_noerr) call abort_ice(subname// & - 'ERROR: getting varid for '//avail_hist_fields(n)%vname) + call ice_pio_check(pio_inq_varid(File,avail_hist_fields(n)%vname,varid), & + subname//' ERROR: getting varid for '//avail_hist_fields(n)%vname,file=__FILE__,line=__LINE__) do j = 1, nblocks do i = 1, nzblyr workd3(:,:,j,i) = a3Db(:,:,i,nn,j) enddo enddo + call pio_seterrorhandling(File, PIO_INTERNAL_ERROR) #ifdef CESM1_PIO call pio_setframe(varid, int(1,kind=PIO_OFFSET)) #else call pio_setframe(File, varid, int(1,kind=PIO_OFFSET_KIND)) #endif + call pio_seterrorhandling(File, PIO_RETURN_ERROR) if (history_precision == 8) then call pio_write_darray(File, varid, iodesc3db,& workd3, status, fillval=spval_dbl) @@ -1034,6 +1031,9 @@ subroutine ice_write_hist (ns) call pio_write_darray(File, varid, iodesc3db,& workr3, status, fillval=spval) endif + + call ice_pio_check(status,subname//' ERROR: writing '//avail_hist_fields(n)%vname, & + file=__FILE__,line=__LINE__) endif enddo ! num_avail_hist_fields_3Db deallocate(workd3) @@ -1045,19 +1045,20 @@ subroutine ice_write_hist (ns) do n = n3Dbcum+1, n3Dacum nn = n - n3Dbcum if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then - status = pio_inq_varid(File,avail_hist_fields(n)%vname,varid) - if (status /= pio_noerr) call abort_ice(subname// & - 'ERROR: getting varid for '//avail_hist_fields(n)%vname) + call ice_pio_check(pio_inq_varid(File,avail_hist_fields(n)%vname,varid), & + subname//' ERROR: getting varid for '//avail_hist_fields(n)%vname,file=__FILE__,line=__LINE__) do j = 1, nblocks do i = 1, nzalyr workd3(:,:,j,i) = a3Da(:,:,i,nn,j) enddo enddo + call pio_seterrorhandling(File, PIO_INTERNAL_ERROR) #ifdef CESM1_PIO call pio_setframe(varid, int(1,kind=PIO_OFFSET)) #else call pio_setframe(File, varid, int(1,kind=PIO_OFFSET_KIND)) #endif + call pio_seterrorhandling(File, PIO_RETURN_ERROR) if (history_precision == 8) then call pio_write_darray(File, varid, iodesc3da,& workd3, status, fillval=spval_dbl) @@ -1066,6 +1067,9 @@ subroutine ice_write_hist (ns) call pio_write_darray(File, varid, iodesc3da,& workr3, status, fillval=spval) endif + + call ice_pio_check(status,subname//' ERROR: writing '//avail_hist_fields(n)%vname, & + file=__FILE__,line=__LINE__) endif enddo ! num_avail_hist_fields_3Db deallocate(workd3) @@ -1077,19 +1081,20 @@ subroutine ice_write_hist (ns) do n = n3Dacum+1, n3Dfcum nn = n - n3Dacum if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then - status = pio_inq_varid(File,avail_hist_fields(n)%vname,varid) - if (status /= pio_noerr) call abort_ice(subname// & - 'ERROR: getting varid for '//avail_hist_fields(n)%vname) + call ice_pio_check(pio_inq_varid(File,avail_hist_fields(n)%vname,varid), & + subname//' ERROR: getting varid for '//avail_hist_fields(n)%vname,file=__FILE__,line=__LINE__) do j = 1, nblocks do i = 1, nfsd_hist workd3(:,:,j,i) = a3Df(:,:,i,nn,j) enddo enddo + call pio_seterrorhandling(File, PIO_INTERNAL_ERROR) #ifdef CESM1_PIO call pio_setframe(varid, int(1,kind=PIO_OFFSET)) #else call pio_setframe(File, varid, int(1,kind=PIO_OFFSET_KIND)) #endif + call pio_seterrorhandling(File, PIO_RETURN_ERROR) if (history_precision == 8) then call pio_write_darray(File, varid, iodesc3df,& workd3, status, fillval=spval_dbl) @@ -1098,6 +1103,9 @@ subroutine ice_write_hist (ns) call pio_write_darray(File, varid, iodesc3df,& workr3, status, fillval=spval) endif + + call ice_pio_check(status,subname//' ERROR: writing '//avail_hist_fields(n)%vname, & + file=__FILE__,line=__LINE__) endif enddo ! num_avail_hist_fields_3Df deallocate(workd3) @@ -1109,9 +1117,8 @@ subroutine ice_write_hist (ns) do n = n3Dfcum+1, n4Dicum nn = n - n3Dfcum if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then - status = pio_inq_varid(File,avail_hist_fields(n)%vname,varid) - if (status /= pio_noerr) call abort_ice(subname// & - 'ERROR: getting varid for '//avail_hist_fields(n)%vname) + call ice_pio_check(pio_inq_varid(File,avail_hist_fields(n)%vname,varid), & + subname//' ERROR: getting varid for '//avail_hist_fields(n)%vname,file=__FILE__,line=__LINE__) do j = 1, nblocks do i = 1, ncat_hist do k = 1, nzilyr @@ -1119,11 +1126,13 @@ subroutine ice_write_hist (ns) enddo ! k enddo ! i enddo ! j + call pio_seterrorhandling(File, PIO_INTERNAL_ERROR) #ifdef CESM1_PIO call pio_setframe(varid, int(1,kind=PIO_OFFSET)) #else call pio_setframe(File, varid, int(1,kind=PIO_OFFSET_KIND)) #endif + call pio_seterrorhandling(File, PIO_RETURN_ERROR) if (history_precision == 8) then call pio_write_darray(File, varid, iodesc4di,& workd4, status, fillval=spval_dbl) @@ -1132,6 +1141,8 @@ subroutine ice_write_hist (ns) call pio_write_darray(File, varid, iodesc4di,& workr4, status, fillval=spval) endif + call ice_pio_check(status,subname//' ERROR: writing '//avail_hist_fields(n)%vname, & + file=__FILE__,line=__LINE__) endif enddo ! num_avail_hist_fields_4Di deallocate(workd4) @@ -1143,9 +1154,8 @@ subroutine ice_write_hist (ns) do n = n4Dicum+1, n4Dscum nn = n - n4Dicum if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then - status = pio_inq_varid(File,avail_hist_fields(n)%vname,varid) - if (status /= pio_noerr) call abort_ice(subname// & - 'ERROR: getting varid for '//avail_hist_fields(n)%vname) + call ice_pio_check(pio_inq_varid(File,avail_hist_fields(n)%vname,varid), & + subname//' ERROR: getting varid for '//avail_hist_fields(n)%vname,file=__FILE__,line=__LINE__) do j = 1, nblocks do i = 1, ncat_hist do k = 1, nzslyr @@ -1153,11 +1163,13 @@ subroutine ice_write_hist (ns) enddo ! k enddo ! i enddo ! j + call pio_seterrorhandling(File, PIO_INTERNAL_ERROR) #ifdef CESM1_PIO call pio_setframe(varid, int(1,kind=PIO_OFFSET)) #else call pio_setframe(File, varid, int(1,kind=PIO_OFFSET_KIND)) #endif + call pio_seterrorhandling(File, PIO_RETURN_ERROR) if (history_precision == 8) then call pio_write_darray(File, varid, iodesc4ds,& workd4, status, fillval=spval_dbl) @@ -1166,6 +1178,9 @@ subroutine ice_write_hist (ns) call pio_write_darray(File, varid, iodesc4ds,& workr4, status, fillval=spval) endif + + call ice_pio_check(status,subname//' ERROR: writing '//avail_hist_fields(n)%vname, & + file=__FILE__,line=__LINE__) endif enddo ! num_avail_hist_fields_4Ds deallocate(workd4) @@ -1177,9 +1192,8 @@ subroutine ice_write_hist (ns) do n = n4Dscum+1, n4Dfcum nn = n - n4Dscum if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then - status = pio_inq_varid(File,avail_hist_fields(n)%vname,varid) - if (status /= pio_noerr) call abort_ice(subname// & - 'ERROR: getting varid for '//avail_hist_fields(n)%vname) + call ice_pio_check(pio_inq_varid(File,avail_hist_fields(n)%vname,varid), & + subname//' ERROR: getting varid for '//avail_hist_fields(n)%vname,file=__FILE__,line=__LINE__) do j = 1, nblocks do i = 1, ncat_hist do k = 1, nfsd_hist @@ -1187,11 +1201,13 @@ subroutine ice_write_hist (ns) enddo ! k enddo ! i enddo ! j + call pio_seterrorhandling(File, PIO_INTERNAL_ERROR) #ifdef CESM1_PIO call pio_setframe(varid, int(1,kind=PIO_OFFSET)) #else call pio_setframe(File, varid, int(1,kind=PIO_OFFSET_KIND)) #endif + call pio_seterrorhandling(File, PIO_RETURN_ERROR) if (history_precision == 8) then call pio_write_darray(File, varid, iodesc4df,& workd4, status, fillval=spval_dbl) @@ -1200,6 +1216,8 @@ subroutine ice_write_hist (ns) call pio_write_darray(File, varid, iodesc4df,& workr4, status, fillval=spval) endif + call ice_pio_check(status,subname//' ERROR: writing '//avail_hist_fields(n)%vname, & + file=__FILE__,line=__LINE__) endif enddo ! num_avail_hist_fields_4Df deallocate(workd4) @@ -1207,10 +1225,10 @@ subroutine ice_write_hist (ns) ! similarly for num_avail_hist_fields_4Db (define workd4b, iodesc4db) - !----------------------------------------------------------------- ! clean-up PIO descriptors !----------------------------------------------------------------- + call pio_seterrorhandling(File, PIO_INTERNAL_ERROR) call pio_freedecomp(File,iodesc2d) call pio_freedecomp(File,iodesc3dv) @@ -1233,39 +1251,135 @@ subroutine ice_write_hist (ns) write(nu_diag,*) 'Finished writing ',trim(ncfile(ns)) endif + first_call = .false. + end subroutine ice_write_hist + !======================================================================= +! Defines a coordinate var in the history file +! coordinates have short_name, long_name and units attributes, +! and are compressed for 'hdf5' when more than one dimensional + + subroutine ice_hist_coord_def(File, coord,lprecision, dimids,varid) + + use pio, only: file_desc_t, var_desc_t, pio_def_var, pio_put_att +#ifndef USE_PIO1 + use pio, only: pio_def_var_deflate + use pio_nf, only: pio_def_var_chunking !This is missing from pio module <2.6.0 + use netcdf, only: NF90_CHUNKED + use ice_history_shared, only: history_deflate, history_chunksize, history_format +#endif - subroutine ice_write_hist_attrs(File, varid, hfield, ns) + type(file_desc_t), intent(inout) :: File + type(coord_attributes), intent(in) :: coord + integer(kind=int_kind), intent(in) :: dimids(:), lprecision + type(var_desc_t), intent(inout) :: varid + + ! local vars + integer(kind=int_kind) :: chunks(size(dimids)), i, status + + character(len=*), parameter :: subname = '(ice_hist_coord_def)' + + !define var, set deflate, long_name and units + status = pio_def_var(File, coord%short_name, lprecision, dimids, varid) + call ice_pio_check(status, & + subname//' ERROR: defining coord '//coord%short_name,file=__FILE__,line=__LINE__) +#ifndef USE_PIO1 + if (history_deflate/=0 .and. history_format=='hdf5') then + status = pio_def_var_deflate(File, varid, shuffle=0, deflate=1, deflate_level=history_deflate) + call ice_pio_check(status, & + subname//' ERROR: deflating coord '//coord%short_name,file=__FILE__,line=__LINE__) + endif - use ice_kinds_mod + if (history_format=='hdf5' .and. size(dimids)>1) then + if (dimids(1)==imtid .and. dimids(2)==jmtid) then + chunks(1)=history_chunksize(1) + chunks(2)=history_chunksize(2) + do i = 3, size(dimids) + chunks(i) = 0 + enddo + status = pio_def_var_chunking(File, varid, NF90_CHUNKED, chunks) + call ice_pio_check(status, & + subname//' ERROR: chunking coord '//coord%short_name,file=__FILE__,line=__LINE__) + endif + endif +#endif + call ice_pio_check(pio_put_att(File,varid,'long_name',trim(coord%long_name)), & + subname//' ERROR: defining att long_name '//coord%long_name,file=__FILE__,line=__LINE__) + call ice_pio_check(pio_put_att(File, varid, 'units', trim(coord%units)), & + subname//' ERROR: defining att units '//coord%units,file=__FILE__,line=__LINE__) + + end subroutine ice_hist_coord_def + +!======================================================================= +! Defines a (time-dependent) history var in the history file +! variables have short_name, long_name and units, coordiantes and cell_measures attributes, +! and are compressed and chunked for 'hdf5' + + subroutine ice_hist_field_def(File, hfield,lprecision, dimids, ns) + + use pio, only: file_desc_t , var_desc_t, pio_def_var, pio_put_att +#ifndef USE_PIO1 + use pio, only: pio_def_var_deflate + use pio_nf, only: pio_def_var_chunking !This is missing from pio module <2.6.0 + use netcdf, only: NF90_CHUNKED + use ice_history_shared, only: history_deflate, history_chunksize, history_format +#endif + use ice_history_shared, only: ice_hist_field, history_precision, hist_avg use ice_calendar, only: histfreq, histfreq_n, write_ic - use ice_history_shared, only: ice_hist_field, history_precision, & - hist_avg - use ice_pio - use pio - type(file_desc_t) :: File ! file id - type(var_desc_t) :: varid ! variable id - type (ice_hist_field), intent(in) :: hfield ! history file info - integer (kind=int_kind), intent(in) :: ns + type(file_desc_t), intent(inout) :: File + type(ice_hist_field) , intent(in) :: hfield + integer(kind=int_kind), intent(in) :: dimids(:), lprecision, ns - ! local variables + ! local vars + type(var_desc_t) :: varid + integer(kind=int_kind) :: chunks(size(dimids)), i, status - integer (kind=int_kind) :: status - character(len=*), parameter :: subname = '(ice_write_hist_attrs)' + character(len=*), parameter :: subname = '(ice_hist_field_def)' - status = pio_put_att(File,varid,'units', trim(hfield%vunit)) + status = pio_def_var(File, hfield%vname, lprecision, dimids, varid) + call ice_pio_check(status, & + subname//' ERROR: defining var '//hfield%vname,file=__FILE__,line=__LINE__) - status = pio_put_att(File,varid, 'long_name', trim(hfield%vdesc)) +#ifndef USE_PIO1 + if (history_deflate/=0 .and. history_format=='hdf5') then + status = pio_def_var_deflate(File, varid, shuffle=0, deflate=1, deflate_level=history_deflate) + call ice_pio_check(status, & + subname//' ERROR: deflating var '//hfield%vname,file=__FILE__,line=__LINE__) + endif - status = pio_put_att(File,varid,'coordinates', trim(hfield%vcoord)) + if (history_format=='hdf5' .and. size(dimids)>1) then + if (dimids(1)==imtid .and. dimids(2)==jmtid) then + chunks(1)=history_chunksize(1) + chunks(2)=history_chunksize(2) + do i = 3, size(dimids) + chunks(i) = 0 + enddo + status = pio_def_var_chunking(File, varid, NF90_CHUNKED, chunks) + call ice_pio_check(status, subname//' ERROR: chunking var '//hfield%vname,file=__FILE__,line=__LINE__) + endif + endif +#endif + + !var attributes + + call ice_pio_check(pio_put_att(File,varid,'units', trim(hfield%vunit)), & + subname//' ERROR: defining att units '//trim(hfield%vunit),file=__FILE__,line=__LINE__) - status = pio_put_att(File,varid,'cell_measures', trim(hfield%vcellmeas)) + call ice_pio_check(pio_put_att(File,varid, 'long_name', trim(hfield%vdesc)), & + subname//' ERROR: defining att long_name '//trim(hfield%vdesc),file=__FILE__,line=__LINE__) + + call ice_pio_check(pio_put_att(File,varid,'coordinates', trim(hfield%vcoord)), & + subname//' ERROR: defining att coordinates '//trim(hfield%vdesc),file=__FILE__,line=__LINE__) + + call ice_pio_check(pio_put_att(File,varid,'cell_measures',trim(hfield%vcellmeas)), & + subname//' ERROR: defining att cell_measures '//trim(hfield%vcoord),file=__FILE__,line=__LINE__) if (hfield%vcomment /= "none") then - status = pio_put_att(File,varid,'comment', trim(hfield%vcomment)) + call ice_pio_check(pio_put_att(File,varid,'comment', trim(hfield%vcomment)), & + subname//' ERROR: defining att comment '//trim(hfield%vcomment),file=__FILE__,line=__LINE__) endif call ice_write_hist_fill(File,varid,hfield%vname,history_precision) @@ -1277,7 +1391,8 @@ subroutine ice_write_hist_attrs(File, varid, hfield, ns) .and.TRIM(hfield%vname(1:9))/='sistreave' & .and.TRIM(hfield%vname(1:9))/='sistremax' & .and.TRIM(hfield%vname(1:4))/='sigP') then - status = pio_put_att(File,varid,'cell_methods','time: mean') + call ice_pio_check(pio_put_att(File,varid,'cell_methods','time: mean'), & + subname//' ERROR: defining att cell_methods',file=__FILE__,line=__LINE__) endif endif @@ -1286,6 +1401,7 @@ subroutine ice_write_hist_attrs(File, varid, hfield, ns) .or. write_ic & .or.TRIM(hfield%vname(1:4))=='divu' & .or.TRIM(hfield%vname(1:5))=='shear' & + .or.TRIM(hfield%vname(1:4))=='vort' & .or.TRIM(hfield%vname(1:4))=='sig1' & .or.TRIM(hfield%vname(1:4))=='sig2' & .or.TRIM(hfield%vname(1:4))=='sigP' & @@ -1296,25 +1412,26 @@ subroutine ice_write_hist_attrs(File, varid, hfield, ns) .or.TRIM(hfield%vname(1:9))=='frz_onset' & .or.TRIM(hfield%vname(1:6))=='hisnap' & .or.TRIM(hfield%vname(1:6))=='aisnap') then - status = pio_put_att(File,varid,'time_rep','instantaneous') + call ice_pio_check(pio_put_att(File,varid,'time_rep','instantaneous'), & + subname//' ERROR: defining att time_rep i',file=__FILE__,line=__LINE__) else - status = pio_put_att(File,varid,'time_rep','averaged') + call ice_pio_check(pio_put_att(File,varid,'time_rep','averaged'), & + subname//' ERROR: defining att time_rep a',file=__FILE__,line=__LINE__) endif - end subroutine ice_write_hist_attrs + end subroutine ice_hist_field_def !======================================================================= +! Defines missing_value and _FillValue attributes subroutine ice_write_hist_fill(File,varid,vname,precision) - use ice_kinds_mod - use ice_pio - use pio + use pio, only: pio_put_att, file_desc_t, var_desc_t - type(file_desc_t) , intent(inout) :: File - type(var_desc_t) , intent(in) :: varid - character(len=*), intent(in) :: vname ! var name - integer (kind=int_kind), intent(in) :: precision ! precision + type(file_desc_t), intent(inout) :: File + type(var_desc_t), intent(in) :: varid + character(len=*), intent(in) :: vname + integer (kind=int_kind), intent(in) :: precision ! local variables @@ -1322,11 +1439,15 @@ subroutine ice_write_hist_fill(File,varid,vname,precision) character(len=*), parameter :: subname = '(ice_write_hist_fill)' if (precision == 8) then - status = pio_put_att(File, varid, 'missing_value', spval_dbl) - status = pio_put_att(File, varid,'_FillValue',spval_dbl) + call ice_pio_check(pio_put_att(File, varid, 'missing_value', spval_dbl), & + subname//' ERROR: defining att missing_value',file=__FILE__,line=__LINE__) + call ice_pio_check(pio_put_att(File, varid,'_FillValue',spval_dbl), & + subname//' ERROR: defining att _FillValue',file=__FILE__,line=__LINE__) else - status = pio_put_att(File, varid, 'missing_value', spval) - status = pio_put_att(File, varid,'_FillValue',spval) + call ice_pio_check(pio_put_att(File, varid, 'missing_value', spval), & + subname//' ERROR: defining att missing_value',file=__FILE__,line=__LINE__) + call ice_pio_check(pio_put_att(File, varid,'_FillValue',spval), & + subname//' ERROR: defining att _FillValue',file=__FILE__,line=__LINE__) endif end subroutine ice_write_hist_fill diff --git a/cicecore/cicedyn/infrastructure/io/io_pio2/ice_pio.F90 b/cicecore/cicedyn/infrastructure/io/io_pio2/ice_pio.F90 index b242f542b..565e7adbb 100644 --- a/cicecore/cicedyn/infrastructure/io/io_pio2/ice_pio.F90 +++ b/cicecore/cicedyn/infrastructure/io/io_pio2/ice_pio.F90 @@ -27,6 +27,7 @@ module ice_pio public ice_pio_init public ice_pio_initdecomp + public ice_pio_check #ifdef CESMCOUPLED type(iosystem_desc_t), pointer :: ice_pio_subsystem @@ -43,10 +44,11 @@ module ice_pio ! Initialize the io subsystem ! 2009-Feb-17 - J. Edwards - initial version - subroutine ice_pio_init(mode, filename, File, clobber, cdf64, iotype) + subroutine ice_pio_init(mode, filename, File, clobber, fformat, & + rearr, iotasks, root, stride, debug) #ifdef CESMCOUPLED - use shr_pio_mod, only: shr_pio_getiosys, shr_pio_getiotype + use shr_pio_mod, only: shr_pio_getiosys, shr_pio_getiotype, shr_pio_getioformat #else #ifdef GPTL use perf_mod, only : t_initf @@ -58,31 +60,33 @@ subroutine ice_pio_init(mode, filename, File, clobber, cdf64, iotype) character(len=*) , intent(in), optional :: filename type(file_desc_t) , intent(inout), optional :: File logical , intent(in), optional :: clobber - logical , intent(in), optional :: cdf64 - integer , intent(in), optional :: iotype + character(len=*) , intent(in), optional :: fformat + character(len=*) , intent(in), optional :: rearr + integer , intent(in), optional :: iotasks + integer , intent(in), optional :: root + integer , intent(in), optional :: stride + logical , intent(in), optional :: debug ! local variables integer (int_kind) :: & nml_error ! namelist read error flag - integer :: nprocs - integer :: istride - integer :: basetask - integer :: numiotasks - integer :: rearranger - integer :: pio_iotype - logical :: exists - logical :: lclobber - logical :: lcdf64 - integer :: status - integer :: nmode + integer :: nprocs , lstride, lroot, liotasks, rearranger + integer :: pio_iotype, status, nmode0, nmode + logical :: lclobber, exists, ldebug character(len=*), parameter :: subname = '(ice_pio_init)' - logical, save :: first_call = .true. #ifdef CESMCOUPLED ice_pio_subsystem => shr_pio_getiosys(inst_name) pio_iotype = shr_pio_getiotype(inst_name) + if ((pio_iotype==PIO_IOTYPE_NETCDF).or.(pio_iotype==PIO_IOTYPE_PNETCDF)) then + nmode0 = shr_pio_getioformat(inst_name) + else + nmode=0 + endif + + call pio_seterrorhandling(ice_pio_subsystem, PIO_RETURN_ERROR) #else #ifdef GPTL @@ -92,107 +96,160 @@ subroutine ice_pio_init(mode, filename, File, clobber, cdf64, iotype) #endif !--- initialize type of io - !pio_iotype = PIO_IOTYPE_PNETCDF - !pio_iotype = PIO_IOTYPE_NETCDF4C - !pio_iotype = PIO_IOTYPE_NETCDF4P - pio_iotype = PIO_IOTYPE_NETCDF - if (present(iotype)) then - pio_iotype = iotype + ldebug = .false. + if (present(debug)) then + ldebug = debug + endif + + if (present(fformat)) then + if (fformat(1:3) == 'cdf') then + pio_iotype = PIO_IOTYPE_NETCDF + elseif (fformat(1:3) == 'hdf') then + pio_iotype = PIO_IOTYPE_NETCDF4P + elseif (fformat(1:7) == 'pnetcdf') then + pio_iotype = PIO_IOTYPE_PNETCDF + else + call abort_ice(subname//' ERROR: format not allowed for '//trim(fformat), & + file=__FILE__, line=__LINE__) + endif + + if (fformat == 'cdf2' .or. fformat == 'pnetcdf2') then + nmode0 = PIO_64BIT_OFFSET + elseif (fformat == 'cdf5' .or. fformat == 'pnetcdf5') then + nmode0 = PIO_64BIT_DATA + else + nmode0 = 0 + endif + else + pio_iotype = PIO_IOTYPE_NETCDF + nmode0 = 0 + endif + + if (present(rearr)) then + if (rearr == 'box' .or. rearr == 'default') then + rearranger = PIO_REARR_BOX + elseif (rearr == 'subset') then + rearranger = PIO_REARR_SUBSET + else + call abort_ice(subname//' ERROR: rearr not allowed for '//trim(rearr), & + file=__FILE__, line=__LINE__) + endif + else + rearranger = PIO_REARR_BOX endif - !--- initialize ice_pio_subsystem nprocs = get_num_procs() - istride = 4 - basetask = min(1,nprocs-1) - numiotasks = max((nprocs-basetask)/istride,1) -!--tcraig this should work better but it causes pio2.4.4 to fail for reasons unknown -! numiotasks = 1 + (nprocs-basetask-1)/istride - rearranger = PIO_REARR_BOX - if (my_task == master_task) then + lstride = 4 + lroot = min(1,nprocs-1) +! Adjustments for PIO2 iotask issue, https://github.com/NCAR/ParallelIO/issues/1986 +! liotasks = max(1,(nprocs-lroot)/lstride) ! very conservative + liotasks = max(1,nprocs/lstride - lroot/lstride) ! less conservative (note integer math) +! liotasks = 1 + (nprocs-lroot-1)/lstride ! optimal + + if (present(iotasks)) then + if (iotasks /= -99) liotasks=iotasks + endif + if (present(root)) then + if (root /= -99) lroot=root + endif + if (present(stride)) then + if (stride /= -99) lstride=stride + endif + + if (liotasks < 1 .or. lroot < 0 .or. lstride < 1) then + call abort_ice(subname//' ERROR: iotasks, root, stride incorrect ', & + file=__FILE__, line=__LINE__) + endif + + ! adjust to fit in nprocs, preserve root and stride as much as possible + lroot = min(lroot,nprocs-1) ! lroot <= nprocs-1 +! Adjustments for PIO2 iotask issue, https://github.com/NCAR/ParallelIO/issues/1986 +! liotasks = max(1,min(liotasks, (nprocs-lroot)/lstride)) ! very conservative + liotasks = max(1,min(liotasks,nprocs/lstride - lroot/lstride)) ! less conservative (note integer math) +! liotasks = max(1,min(liotasks, 1 + (nprocs-lroot-1)/lstride)) ! optimal + + !--- initialize ice_pio_subsystem + + if (ldebug .and. my_task == master_task) then write(nu_diag,*) subname,' nprocs = ',nprocs - write(nu_diag,*) subname,' istride = ',istride - write(nu_diag,*) subname,' basetask = ',basetask - write(nu_diag,*) subname,' numiotasks = ',numiotasks write(nu_diag,*) subname,' pio_iotype = ',pio_iotype + write(nu_diag,*) subname,' iotasks = ',liotasks + write(nu_diag,*) subname,' baseroot = ',lroot + write(nu_diag,*) subname,' stride = ',lstride + write(nu_diag,*) subname,' nmode = ',nmode0 end if - call pio_init(my_task, MPI_COMM_ICE, numiotasks, master_task, istride, & - rearranger, ice_pio_subsystem, base=basetask) - !--- initialize rearranger options - !pio_rearr_opt_comm_type = integer (PIO_REARR_COMM_[P2P,COLL]) - !pio_rearr_opt_fcd = integer, flow control (PIO_REARR_COMM_FC_[2D_ENABLE,1D_COMP2IO,1D_IO2COMP,2D_DISABLE]) - !pio_rearr_opt_c2i_enable_hs = logical - !pio_rearr_opt_c2i_enable_isend = logical - !pio_rearr_opt_c2i_max_pend_req = integer - !pio_rearr_opt_i2c_enable_hs = logical - !pio_rearr_opt_i2c_enable_isend = logical - !pio_rearr_opt_c2i_max_pend_req = integer - !ret = pio_set_rearr_opts(ice_pio_subsystem, pio_rearr_opt_comm_type,& - ! pio_rearr_opt_fcd,& - ! pio_rearr_opt_c2i_enable_hs, pio_rearr_opt_c2i_enable_isend,& - ! pio_rearr_opt_c2i_max_pend_req,& - ! pio_rearr_opt_i2c_enable_hs, pio_rearr_opt_i2c_enable_isend,& - ! pio_rearr_opt_i2c_max_pend_req) - !if(ret /= PIO_NOERR) then - ! call abort_ice(subname//'ERROR: aborting in pio_set_rearr_opts') - !end if + call pio_init(my_task, MPI_COMM_ICE, liotasks, master_task, lstride, & + rearranger, ice_pio_subsystem, base=lroot) + + call pio_seterrorhandling(ice_pio_subsystem, PIO_RETURN_ERROR) #endif if (present(mode) .and. present(filename) .and. present(File)) then if (trim(mode) == 'write') then - lclobber = .false. - if (present(clobber)) lclobber=clobber - lcdf64 = .false. - if (present(cdf64)) lcdf64=cdf64 + lclobber = .false. + if (present(clobber)) then + lclobber=clobber + endif if (File%fh<0) then ! filename not open inquire(file=trim(filename),exist=exists) if (exists) then if (lclobber) then - nmode = pio_clobber - if (lcdf64) nmode = ior(nmode,PIO_64BIT_OFFSET) + nmode = ior(PIO_CLOBBER,nmode0) status = pio_createfile(ice_pio_subsystem, File, pio_iotype, trim(filename), nmode) + call ice_pio_check(status, subname//' ERROR: Failed to overwrite file '//trim(filename), & + file=__FILE__,line=__LINE__) if (my_task == master_task) then write(nu_diag,*) subname,' create file ',trim(filename) end if else nmode = pio_write status = pio_openfile(ice_pio_subsystem, File, pio_iotype, trim(filename), nmode) + call ice_pio_check( status, subname//' ERROR: Failed to open file '//trim(filename), & + file=__FILE__,line=__LINE__) if (my_task == master_task) then write(nu_diag,*) subname,' open file ',trim(filename) end if endif else - nmode = pio_noclobber - if (lcdf64) nmode = ior(nmode,PIO_64BIT_OFFSET) + nmode = ior(PIO_NOCLOBBER,nmode0) status = pio_createfile(ice_pio_subsystem, File, pio_iotype, trim(filename), nmode) + call ice_pio_check( status, subname//' ERROR: Failed to create file '//trim(filename), & + file=__FILE__,line=__LINE__) if (my_task == master_task) then write(nu_diag,*) subname,' create file ',trim(filename) end if endif - else - ! filename is already open, just return + ! else: filename is already open, just return endif end if if (trim(mode) == 'read') then inquire(file=trim(filename),exist=exists) if (exists) then + if (my_task == master_task) then + write(nu_diag,*) subname//' opening file for reading '//trim(filename) + endif status = pio_openfile(ice_pio_subsystem, File, pio_iotype, trim(filename), pio_nowrite) + call ice_pio_check( status, subname//' ERROR: Failed to open file '//trim(filename), & + file=__FILE__,line=__LINE__) else if(my_task==master_task) then - write(nu_diag,*) 'ice_pio_ropen ERROR: file invalid ',trim(filename) + write(nu_diag,*) subname//' ERROR: file not found '//trim(filename) end if - call abort_ice(subname//'ERROR: aborting with invalid file') + call abort_ice(subname//' ERROR: aborting with invalid file '//trim(filename)) endif end if end if + call pio_seterrorhandling(ice_pio_subsystem, PIO_INTERNAL_ERROR) + end subroutine ice_pio_init !================================================================================ @@ -465,6 +522,40 @@ subroutine ice_pio_initdecomp_4d (ndim3, ndim4, iodesc, precision) end subroutine ice_pio_initdecomp_4d + +!================================================================================ + + ! PIO Error handling + ! Author: Anton Steketee, ACCESS-NRI + + subroutine ice_pio_check(status, abort_msg, file, line) + integer(kind=int_kind), intent (in) :: status + character (len=*) , intent (in) :: abort_msg + character (len=*) , intent (in), optional :: file + integer(kind=int_kind), intent (in), optional :: line + + ! local variables + + character(len=pio_max_name) :: err_msg + integer(kind=int_kind) :: strerror_status + character(len=*), parameter :: subname = '(ice_pio_check)' + + if (status /= PIO_NOERR) then +#ifdef USE_PIO1 + err_msg = '' +#else + strerror_status = pio_strerror(status, err_msg) +#endif + if (present(file) .and. present(line)) then + call abort_ice(subname//trim(err_msg)//', '//trim(abort_msg), file=file, line=line) + elseif (present(file)) then + call abort_ice(subname//trim(err_msg)//', '//trim(abort_msg), file=file) + else + call abort_ice(subname//trim(err_msg)//', '//trim(abort_msg)) + endif + endif + end subroutine ice_pio_check + !================================================================================ end module ice_pio diff --git a/cicecore/cicedyn/infrastructure/io/io_pio2/ice_restart.F90 b/cicecore/cicedyn/infrastructure/io/io_pio2/ice_restart.F90 index aefcf61f9..fdb9330d2 100644 --- a/cicecore/cicedyn/infrastructure/io/io_pio2/ice_restart.F90 +++ b/cicecore/cicedyn/infrastructure/io/io_pio2/ice_restart.F90 @@ -10,10 +10,7 @@ module ice_restart use ice_exit, only: abort_ice use ice_fileunits, only: nu_diag, nu_restart, nu_rst_pointer use ice_kinds_mod - use ice_restart_shared, only: & - restart, restart_ext, restart_dir, restart_file, pointer_file, & - runid, runtype, use_restart_time, restart_format, lcdf64, lenstr, & - restart_coszen + use ice_restart_shared use ice_pio use pio use icepack_intfc, only: icepack_warnings_flush, icepack_warnings_aborted @@ -32,6 +29,8 @@ module ice_restart type(io_desc_t) :: iodesc2d type(io_desc_t) :: iodesc3d_ncat + integer (kind=int_kind) :: dimid_ni, dimid_nj + !======================================================================= contains @@ -55,9 +54,9 @@ subroutine init_restart_read(ice_ic) character(len=char_len_long) :: & filename, filename0 - integer (kind=int_kind) :: status, status1 + integer (kind=int_kind) :: status - integer (kind=int_kind) :: iotype + logical (kind=log_kind), save :: first_call = .true. character(len=*), parameter :: subname = '(init_restart_read)' @@ -78,40 +77,54 @@ subroutine init_restart_read(ice_ic) write(nu_diag,*) 'Using restart dump=', trim(filename) end if -! if (restart_format(1:3) == 'pio') then - iotype = PIO_IOTYPE_NETCDF - if (restart_format == 'pio_pnetcdf') iotype = PIO_IOTYPE_PNETCDF - File%fh=-1 - call ice_pio_init(mode='read', filename=trim(filename), File=File, iotype=iotype) - - call ice_pio_initdecomp(iodesc=iodesc2d, precision=8) - call ice_pio_initdecomp(ndim3=ncat , iodesc=iodesc3d_ncat,remap=.true., precision=8) - - if (use_restart_time) then - status1 = PIO_noerr - status = pio_get_att(File, pio_global, 'istep1', istep0) -! status = pio_get_att(File, pio_global, 'time', time) -! status = pio_get_att(File, pio_global, 'time_forc', time_forc) - call pio_seterrorhandling(File, PIO_BCAST_ERROR) - status = pio_get_att(File, pio_global, 'myear', myear) - if (status /= PIO_noerr) status = pio_get_att(File, pio_global, 'nyr', myear) - if (status /= PIO_noerr) status1 = status - status = pio_get_att(File, pio_global, 'mmonth', mmonth) - if (status /= PIO_noerr) status = pio_get_att(File, pio_global, 'month', mmonth) - if (status /= PIO_noerr) status1 = status - status = pio_get_att(File, pio_global, 'mday', mday) - if (status /= PIO_noerr) status1 = status - status = pio_get_att(File, pio_global, 'msec', msec) - if (status /= PIO_noerr) status = pio_get_att(File, pio_global, 'sec', msec) - if (status /= PIO_noerr) status1 = status - if (status1 /= PIO_noerr) & - call abort_ice(subname//"ERROR: reading restart time ") - call pio_seterrorhandling(File, PIO_INTERNAL_ERROR) - endif ! use namelist values if use_restart_time = F -! endif + File%fh=-1 +! tcraig, including fformat here causes some problems when restart_format=hdf5 +! and reading non hdf5 files with spack built PIO. Excluding the fformat +! argument here defaults the PIO format to cdf1 which then reads +! any netcdf format file fine. + call ice_pio_init(mode='read', filename=trim(filename), File=File, & +! fformat=trim(restart_format), rearr=trim(restart_rearranger), & + rearr=trim(restart_rearranger), & + iotasks=restart_iotasks, root=restart_root, stride=restart_stride, & + debug=first_call) + + call pio_seterrorhandling(File, PIO_RETURN_ERROR) + + call ice_pio_initdecomp(iodesc=iodesc2d, precision=8) + call ice_pio_initdecomp(ndim3=ncat, iodesc=iodesc3d_ncat, remap=.true., precision=8) + + if (use_restart_time) then + ! for backwards compatibility, check nyr, month, and sec as well + call ice_pio_check(pio_get_att(File, pio_global, 'istep1', istep0), & + subname//" ERROR: reading restart step ",file=__FILE__,line=__LINE__) + + status = pio_get_att(File, pio_global, 'myear', myear) + if (status /= PIO_NOERR) then + call ice_pio_check(pio_get_att(File, pio_global, 'nyr', myear), & + subname//" ERROR: reading restart year ",file=__FILE__,line=__LINE__) + endif + + status = pio_get_att(File, pio_global, 'mmonth', mmonth) + if (status /= PIO_NOERR) then + call ice_pio_check(pio_get_att(File, pio_global, 'month', mmonth), & + subname//" ERROR: reading restart month ",file=__FILE__,line=__LINE__) + endif + + call ice_pio_check(pio_get_att(File, pio_global, 'mday', mday), & + subname//" ERROR: reading restart day ",file=__FILE__,line=__LINE__) + + status = pio_get_att(File, pio_global, 'msec', msec) + if (status /= PIO_NOERR) then + call ice_pio_check(pio_get_att(File, pio_global, 'sec', msec), & + subname//" ERROR: reading restart sec ",file=__FILE__,line=__LINE__) + endif + endif ! use namelist values if use_restart_time = F + + call pio_seterrorhandling(File, PIO_INTERNAL_ERROR) if (my_task == master_task) then - write(nu_diag,'(a,i8,4x,i4.4,a,i2.2,a,i2.2,a,i5.5)') 'Restart read at istep=',istep0,myear,'-',mmonth,'-',mday,'-',msec + write(nu_diag,'(a,i8,4x,i4.4,a,i2.2,a,i2.2,a,i5.5)') & + 'Restart read at istep=',istep0,myear,'-',mmonth,'-',mday,'-',msec endif call broadcast_scalar(istep0,master_task) @@ -119,9 +132,6 @@ subroutine init_restart_read(ice_ic) call broadcast_scalar(mmonth,master_task) call broadcast_scalar(mday,master_task) call broadcast_scalar(msec,master_task) -! call broadcast_scalar(time,master_task) -! call broadcast_scalar(time_forc,master_task) - call broadcast_scalar(myear,master_task) istep1 = istep0 @@ -130,6 +140,8 @@ subroutine init_restart_read(ice_ic) npt = npt - istep0 endif + first_call = .false. + end subroutine init_restart_read !======================================================================= @@ -147,69 +159,66 @@ subroutine init_restart_write(filename_spec) use ice_arrays_column, only: oceanmixed_ice use ice_grid, only: grid_ice - logical (kind=log_kind) :: & - skl_bgc, z_tracers + character(len=char_len_long), intent(in), optional :: filename_spec - logical (kind=log_kind) :: & - tr_iage, tr_FY, tr_lvl, tr_iso, tr_aero, & - tr_pond_topo, tr_pond_lvl, tr_brine, tr_snow, & - tr_bgc_N, tr_bgc_C, tr_bgc_Nit, & - tr_bgc_Sil, tr_bgc_DMS, & - tr_bgc_chl, tr_bgc_Am, & - tr_bgc_PON, tr_bgc_DON, & - tr_zaero, tr_bgc_Fe, & - tr_bgc_hum, tr_fsd + ! local variables - integer (kind=int_kind) :: & - nbtrcr + logical (kind=log_kind) :: & + skl_bgc, z_tracers - character(len=char_len_long), intent(in), optional :: filename_spec + logical (kind=log_kind) :: & + tr_iage, tr_FY, tr_lvl, tr_iso, tr_aero, & + tr_pond_topo, tr_pond_lvl, tr_brine, tr_snow, & + tr_bgc_N, tr_bgc_C, tr_bgc_Nit, & + tr_bgc_Sil, tr_bgc_DMS, & + tr_bgc_chl, tr_bgc_Am, & + tr_bgc_PON, tr_bgc_DON, & + tr_zaero, tr_bgc_Fe, & + tr_bgc_hum, tr_fsd - ! local variables + integer (kind=int_kind) :: nbtrcr character(len=char_len_long) :: filename - integer (kind=int_kind) :: dimid_ni, dimid_nj, dimid_ncat, & - dimid_nilyr, dimid_nslyr, dimid_naero + integer (kind=int_kind) :: & + dimid_ncat, dimid_nilyr, dimid_nslyr, dimid_naero integer (kind=int_kind), allocatable :: dims(:) - integer (kind=int_kind) :: iotype - - integer (kind=int_kind) :: & - k, n, & ! loop index - status ! status variable from netCDF routine + integer (kind=int_kind) :: k, n ! loop index character (len=3) :: nchar, ncharb + logical (kind=log_kind), save :: first_call = .true. + character(len=*), parameter :: subname = '(init_restart_write)' call icepack_query_tracer_sizes(nbtrcr_out=nbtrcr) call icepack_query_tracer_flags( & - tr_iage_out=tr_iage, tr_FY_out=tr_FY, tr_lvl_out=tr_lvl, & - tr_iso_out=tr_iso, tr_aero_out=tr_aero, & - tr_pond_topo_out=tr_pond_topo, tr_pond_lvl_out=tr_pond_lvl, & - tr_snow_out=tr_snow, tr_brine_out=tr_brine, & - tr_bgc_N_out=tr_bgc_N, tr_bgc_C_out=tr_bgc_C, tr_bgc_Nit_out=tr_bgc_Nit, & - tr_bgc_Sil_out=tr_bgc_Sil, tr_bgc_DMS_out=tr_bgc_DMS, & - tr_bgc_chl_out=tr_bgc_chl, tr_bgc_Am_out=tr_bgc_Am, & - tr_bgc_PON_out=tr_bgc_PON, tr_bgc_DON_out=tr_bgc_DON, & - tr_zaero_out=tr_zaero, tr_bgc_Fe_out=tr_bgc_Fe, & - tr_bgc_hum_out=tr_bgc_hum, tr_fsd_out=tr_fsd) + tr_iage_out=tr_iage, tr_FY_out=tr_FY, tr_lvl_out=tr_lvl, & + tr_iso_out=tr_iso, tr_aero_out=tr_aero, & + tr_pond_topo_out=tr_pond_topo, tr_pond_lvl_out=tr_pond_lvl, & + tr_snow_out=tr_snow, tr_brine_out=tr_brine, & + tr_bgc_N_out=tr_bgc_N, tr_bgc_C_out=tr_bgc_C, tr_bgc_Nit_out=tr_bgc_Nit, & + tr_bgc_Sil_out=tr_bgc_Sil, tr_bgc_DMS_out=tr_bgc_DMS, & + tr_bgc_chl_out=tr_bgc_chl, tr_bgc_Am_out=tr_bgc_Am, & + tr_bgc_PON_out=tr_bgc_PON, tr_bgc_DON_out=tr_bgc_DON, & + tr_zaero_out=tr_zaero, tr_bgc_Fe_out=tr_bgc_Fe, & + tr_bgc_hum_out=tr_bgc_hum, tr_fsd_out=tr_fsd) call icepack_query_parameters(skl_bgc_out=skl_bgc, & - z_tracers_out=z_tracers) + z_tracers_out=z_tracers) call icepack_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & - file=__FILE__, line=__LINE__) + file=__FILE__, line=__LINE__) ! construct path/file if (present(filename_spec)) then filename = trim(filename_spec) else write(filename,'(a,a,a,i4.4,a,i2.2,a,i2.2,a,i5.5)') & - restart_dir(1:lenstr(restart_dir)), & - restart_file(1:lenstr(restart_file)),'.', & - myear,'-',mmonth,'-',mday,'-',msec + restart_dir(1:lenstr(restart_dir)), & + restart_file(1:lenstr(restart_file)),'.', & + myear,'-',mmonth,'-',mday,'-',msec end if if (restart_format(1:3) /= 'bin') filename = trim(filename) // '.nc' @@ -221,121 +230,126 @@ subroutine init_restart_write(filename_spec) close(nu_rst_pointer) endif -! if (restart_format(1:3) == 'pio') then - - iotype = PIO_IOTYPE_NETCDF - if (restart_format == 'pio_pnetcdf') iotype = PIO_IOTYPE_PNETCDF - File%fh=-1 - call ice_pio_init(mode='write',filename=trim(filename), File=File, & - clobber=.true., cdf64=lcdf64, iotype=iotype) - - status = pio_put_att(File,pio_global,'istep1',istep1) -! status = pio_put_att(File,pio_global,'time',time) -! status = pio_put_att(File,pio_global,'time_forc',time_forc) - status = pio_put_att(File,pio_global,'myear',myear) - status = pio_put_att(File,pio_global,'mmonth',mmonth) - status = pio_put_att(File,pio_global,'mday',mday) - status = pio_put_att(File,pio_global,'msec',msec) - - status = pio_def_dim(File,'ni',nx_global,dimid_ni) - status = pio_def_dim(File,'nj',ny_global,dimid_nj) - status = pio_def_dim(File,'ncat',ncat,dimid_ncat) + File%fh=-1 + call ice_pio_init(mode='write',filename=trim(filename), File=File, & + clobber=.true., fformat=trim(restart_format), rearr=trim(restart_rearranger), & + iotasks=restart_iotasks, root=restart_root, stride=restart_stride, & + debug=first_call) + + call pio_seterrorhandling(File, PIO_RETURN_ERROR) + + call ice_pio_check(pio_put_att(File,pio_global,'istep1',istep1), & + subname//' ERROR: writing restart step',file=__FILE__,line=__LINE__) + call ice_pio_check(pio_put_att(File,pio_global,'myear',myear), & + subname//' ERROR: writing restart year',file=__FILE__,line=__LINE__) + call ice_pio_check(pio_put_att(File,pio_global,'mmonth',mmonth), & + subname//' ERROR: writing restart month',file=__FILE__,line=__LINE__) + call ice_pio_check(pio_put_att(File,pio_global,'mday',mday), & + subname//' ERROR: writing restart day',file=__FILE__,line=__LINE__) + call ice_pio_check(pio_put_att(File,pio_global,'msec',msec), & + subname//' ERROR: writing restart sec',file=__FILE__,line=__LINE__) + + call ice_pio_check(pio_def_dim(File,'ni',nx_global,dimid_ni), & + subname//' ERROR: defining restart dim ni',file=__FILE__,line=__LINE__) + call ice_pio_check(pio_def_dim(File,'nj',ny_global,dimid_nj), & + subname//' ERROR: defining restart dim nj',file=__FILE__,line=__LINE__) + call ice_pio_check(pio_def_dim(File,'ncat',ncat,dimid_ncat), & + subname//' ERROR: defining restart dim ncat',file=__FILE__,line=__LINE__) !----------------------------------------------------------------- ! 2D restart fields !----------------------------------------------------------------- - allocate(dims(2)) + allocate(dims(2)) - dims(1) = dimid_ni - dims(2) = dimid_nj + dims(1) = dimid_ni + dims(2) = dimid_nj - call define_rest_field(File,'uvel',dims) - call define_rest_field(File,'vvel',dims) + call define_rest_field(File,'uvel',dims) + call define_rest_field(File,'vvel',dims) - if (grid_ice == 'CD') then - call define_rest_field(File,'uvelE',dims) - call define_rest_field(File,'vvelE',dims) - call define_rest_field(File,'uvelN',dims) - call define_rest_field(File,'vvelN',dims) - endif + if (grid_ice == 'CD') then + call define_rest_field(File,'uvelE',dims) + call define_rest_field(File,'vvelE',dims) + call define_rest_field(File,'uvelN',dims) + call define_rest_field(File,'vvelN',dims) + endif - if (grid_ice == 'C') then - call define_rest_field(File,'uvelE',dims) - call define_rest_field(File,'vvelN',dims) - endif + if (grid_ice == 'C') then + call define_rest_field(File,'uvelE',dims) + call define_rest_field(File,'vvelN',dims) + endif + if (restart_coszen) call define_rest_field(File,'coszen',dims) + call define_rest_field(File,'scale_factor',dims) + call define_rest_field(File,'swvdr',dims) + call define_rest_field(File,'swvdf',dims) + call define_rest_field(File,'swidr',dims) + call define_rest_field(File,'swidf',dims) + + call define_rest_field(File,'strocnxT',dims) + call define_rest_field(File,'strocnyT',dims) + + call define_rest_field(File,'stressp_1',dims) + call define_rest_field(File,'stressp_2',dims) + call define_rest_field(File,'stressp_3',dims) + call define_rest_field(File,'stressp_4',dims) + + call define_rest_field(File,'stressm_1',dims) + call define_rest_field(File,'stressm_2',dims) + call define_rest_field(File,'stressm_3',dims) + call define_rest_field(File,'stressm_4',dims) + + call define_rest_field(File,'stress12_1',dims) + call define_rest_field(File,'stress12_2',dims) + call define_rest_field(File,'stress12_3',dims) + call define_rest_field(File,'stress12_4',dims) + + call define_rest_field(File,'iceumask',dims) + + if (grid_ice == 'CD' .or. grid_ice == 'C') then + call define_rest_field(File,'stresspT' ,dims) + call define_rest_field(File,'stressmT' ,dims) + call define_rest_field(File,'stress12T',dims) + call define_rest_field(File,'stresspU' ,dims) + call define_rest_field(File,'stressmU' ,dims) + call define_rest_field(File,'stress12U',dims) + call define_rest_field(File,'icenmask',dims) + call define_rest_field(File,'iceemask',dims) + endif - if (restart_coszen) call define_rest_field(File,'coszen',dims) - call define_rest_field(File,'scale_factor',dims) - call define_rest_field(File,'swvdr',dims) - call define_rest_field(File,'swvdf',dims) - call define_rest_field(File,'swidr',dims) - call define_rest_field(File,'swidf',dims) - - call define_rest_field(File,'strocnxT',dims) - call define_rest_field(File,'strocnyT',dims) - - call define_rest_field(File,'stressp_1',dims) - call define_rest_field(File,'stressp_2',dims) - call define_rest_field(File,'stressp_3',dims) - call define_rest_field(File,'stressp_4',dims) - - call define_rest_field(File,'stressm_1',dims) - call define_rest_field(File,'stressm_2',dims) - call define_rest_field(File,'stressm_3',dims) - call define_rest_field(File,'stressm_4',dims) - - call define_rest_field(File,'stress12_1',dims) - call define_rest_field(File,'stress12_2',dims) - call define_rest_field(File,'stress12_3',dims) - call define_rest_field(File,'stress12_4',dims) - - call define_rest_field(File,'iceumask',dims) - - if (grid_ice == 'CD' .or. grid_ice == 'C') then - call define_rest_field(File,'stresspT' ,dims) - call define_rest_field(File,'stressmT' ,dims) - call define_rest_field(File,'stress12T',dims) - call define_rest_field(File,'stresspU' ,dims) - call define_rest_field(File,'stressmU' ,dims) - call define_rest_field(File,'stress12U',dims) - call define_rest_field(File,'icenmask',dims) - call define_rest_field(File,'iceemask',dims) - endif + if (oceanmixed_ice) then + call define_rest_field(File,'sst',dims) + call define_rest_field(File,'frzmlt',dims) + endif - if (oceanmixed_ice) then - call define_rest_field(File,'sst',dims) - call define_rest_field(File,'frzmlt',dims) - endif + if (tr_FY) then + call define_rest_field(File,'frz_onset',dims) + end if - if (tr_FY) then - call define_rest_field(File,'frz_onset',dims) - end if - - if (kdyn == 2) then - call define_rest_field(File,'a11_1',dims) - call define_rest_field(File,'a11_2',dims) - call define_rest_field(File,'a11_3',dims) - call define_rest_field(File,'a11_4',dims) - call define_rest_field(File,'a12_1',dims) - call define_rest_field(File,'a12_2',dims) - call define_rest_field(File,'a12_3',dims) - call define_rest_field(File,'a12_4',dims) - endif + if (kdyn == 2) then + call define_rest_field(File,'a11_1',dims) + call define_rest_field(File,'a11_2',dims) + call define_rest_field(File,'a11_3',dims) + call define_rest_field(File,'a11_4',dims) + call define_rest_field(File,'a12_1',dims) + call define_rest_field(File,'a12_2',dims) + call define_rest_field(File,'a12_3',dims) + call define_rest_field(File,'a12_4',dims) + endif - if (tr_pond_lvl) then - call define_rest_field(File,'fsnow',dims) - endif + if (tr_pond_lvl) then + call define_rest_field(File,'fsnow',dims) + endif - if (nbtrcr > 0) then - if (tr_bgc_N) then + if (nbtrcr > 0) then + if (tr_bgc_N) then do k=1,n_algae write(nchar,'(i3.3)') k call define_rest_field(File,'algalN'//trim(nchar),dims) enddo - endif - if (tr_bgc_C) then + endif + if (tr_bgc_C) then do k=1,n_doc write(nchar,'(i3.3)') k call define_rest_field(File,'doc'//trim(nchar),dims) @@ -344,25 +358,25 @@ subroutine init_restart_write(filename_spec) write(nchar,'(i3.3)') k call define_rest_field(File,'dic'//trim(nchar),dims) enddo - endif - call define_rest_field(File,'nit' ,dims) - if (tr_bgc_Am) & + endif + call define_rest_field(File,'nit' ,dims) + if (tr_bgc_Am) & call define_rest_field(File,'amm' ,dims) - if (tr_bgc_Sil) & + if (tr_bgc_Sil) & call define_rest_field(File,'sil' ,dims) - if (tr_bgc_hum) & + if (tr_bgc_hum) & call define_rest_field(File,'hum' ,dims) - if (tr_bgc_DMS) then - call define_rest_field(File,'dmsp' ,dims) - call define_rest_field(File,'dms' ,dims) - endif - if (tr_bgc_DON) then + if (tr_bgc_DMS) then + call define_rest_field(File,'dmsp' ,dims) + call define_rest_field(File,'dms' ,dims) + endif + if (tr_bgc_DON) then do k=1,n_don write(nchar,'(i3.3)') k call define_rest_field(File,'don'//trim(nchar),dims) enddo - endif - if (tr_bgc_Fe ) then + endif + if (tr_bgc_Fe ) then do k=1,n_fed write(nchar,'(i3.3)') k call define_rest_field(File,'fed'//trim(nchar),dims) @@ -371,304 +385,305 @@ subroutine init_restart_write(filename_spec) write(nchar,'(i3.3)') k call define_rest_field(File,'fep'//trim(nchar),dims) enddo - endif - if (tr_zaero) then + endif + if (tr_zaero) then do k=1,n_zaero write(nchar,'(i3.3)') k call define_rest_field(File,'zaeros'//trim(nchar),dims) enddo - endif - endif !nbtrcr + endif + endif !nbtrcr - deallocate(dims) + deallocate(dims) !----------------------------------------------------------------- ! 3D restart fields (ncat) !----------------------------------------------------------------- - allocate(dims(3)) - - dims(1) = dimid_ni - dims(2) = dimid_nj - dims(3) = dimid_ncat - - call define_rest_field(File,'aicen',dims) - call define_rest_field(File,'vicen',dims) - call define_rest_field(File,'vsnon',dims) - call define_rest_field(File,'Tsfcn',dims) - - if (tr_iage) then - call define_rest_field(File,'iage',dims) - end if - - if (tr_FY) then - call define_rest_field(File,'FY',dims) - end if - - if (tr_lvl) then - call define_rest_field(File,'alvl',dims) - call define_rest_field(File,'vlvl',dims) - end if - - if (tr_pond_topo) then - call define_rest_field(File,'apnd',dims) - call define_rest_field(File,'hpnd',dims) - call define_rest_field(File,'ipnd',dims) - end if - - if (tr_pond_lvl) then - call define_rest_field(File,'apnd',dims) - call define_rest_field(File,'hpnd',dims) - call define_rest_field(File,'ipnd',dims) - call define_rest_field(File,'dhs',dims) - call define_rest_field(File,'ffrac',dims) - end if - - if (tr_brine) then - call define_rest_field(File,'fbrn',dims) - call define_rest_field(File,'first_ice',dims) - endif + allocate(dims(3)) + + dims(1) = dimid_ni + dims(2) = dimid_nj + dims(3) = dimid_ncat + + call define_rest_field(File,'aicen',dims) + call define_rest_field(File,'vicen',dims) + call define_rest_field(File,'vsnon',dims) + call define_rest_field(File,'Tsfcn',dims) + + if (tr_iage) then + call define_rest_field(File,'iage',dims) + end if + + if (tr_FY) then + call define_rest_field(File,'FY',dims) + end if + + if (tr_lvl) then + call define_rest_field(File,'alvl',dims) + call define_rest_field(File,'vlvl',dims) + end if + + if (tr_pond_topo) then + call define_rest_field(File,'apnd',dims) + call define_rest_field(File,'hpnd',dims) + call define_rest_field(File,'ipnd',dims) + end if + + if (tr_pond_lvl) then + call define_rest_field(File,'apnd',dims) + call define_rest_field(File,'hpnd',dims) + call define_rest_field(File,'ipnd',dims) + call define_rest_field(File,'dhs',dims) + call define_rest_field(File,'ffrac',dims) + end if + + if (tr_brine) then + call define_rest_field(File,'fbrn',dims) + call define_rest_field(File,'first_ice',dims) + endif - if (skl_bgc) then + if (skl_bgc) then + do k = 1, n_algae + write(nchar,'(i3.3)') k + call define_rest_field(File,'bgc_N'//trim(nchar) ,dims) + enddo + if (tr_bgc_C) then + ! do k = 1, n_algae + ! write(nchar,'(i3.3)') k + ! call define_rest_field(File,'bgc_C'//trim(nchar) ,dims) + ! enddo + do k = 1, n_doc + write(nchar,'(i3.3)') k + call define_rest_field(File,'bgc_DOC'//trim(nchar) ,dims) + enddo + do k = 1, n_dic + write(nchar,'(i3.3)') k + call define_rest_field(File,'bgc_DIC'//trim(nchar) ,dims) + enddo + endif + if (tr_bgc_chl) then do k = 1, n_algae write(nchar,'(i3.3)') k - call define_rest_field(File,'bgc_N'//trim(nchar) ,dims) + call define_rest_field(File,'bgc_chl'//trim(nchar) ,dims) enddo - if (tr_bgc_C) then - ! do k = 1, n_algae - ! write(nchar,'(i3.3)') k - ! call define_rest_field(File,'bgc_C'//trim(nchar) ,dims) - ! enddo - do k = 1, n_doc - write(nchar,'(i3.3)') k - call define_rest_field(File,'bgc_DOC'//trim(nchar) ,dims) - enddo - do k = 1, n_dic - write(nchar,'(i3.3)') k - call define_rest_field(File,'bgc_DIC'//trim(nchar) ,dims) - enddo - endif - if (tr_bgc_chl) then - do k = 1, n_algae - write(nchar,'(i3.3)') k - call define_rest_field(File,'bgc_chl'//trim(nchar) ,dims) - enddo - endif - call define_rest_field(File,'bgc_Nit' ,dims) - if (tr_bgc_Am) & + endif + call define_rest_field(File,'bgc_Nit' ,dims) + if (tr_bgc_Am) & call define_rest_field(File,'bgc_Am' ,dims) - if (tr_bgc_Sil) & + if (tr_bgc_Sil) & call define_rest_field(File,'bgc_Sil' ,dims) - if (tr_bgc_hum) & + if (tr_bgc_hum) & call define_rest_field(File,'bgc_hum' ,dims) - if (tr_bgc_DMS) then - call define_rest_field(File,'bgc_DMSPp',dims) - call define_rest_field(File,'bgc_DMSPd',dims) - call define_rest_field(File,'bgc_DMS' ,dims) - endif - if (tr_bgc_PON) & + if (tr_bgc_DMS) then + call define_rest_field(File,'bgc_DMSPp',dims) + call define_rest_field(File,'bgc_DMSPd',dims) + call define_rest_field(File,'bgc_DMS' ,dims) + endif + if (tr_bgc_PON) & call define_rest_field(File,'bgc_PON' ,dims) - if (tr_bgc_DON) then - do k = 1, n_don - write(nchar,'(i3.3)') k - call define_rest_field(File,'bgc_DON'//trim(nchar) ,dims) - enddo - endif - if (tr_bgc_Fe ) then - do k = 1, n_fed - write(nchar,'(i3.3)') k - call define_rest_field(File,'bgc_Fed'//trim(nchar) ,dims) - enddo - do k = 1, n_fep - write(nchar,'(i3.3)') k - call define_rest_field(File,'bgc_Fep'//trim(nchar) ,dims) - enddo - endif - endif !skl_bgc + if (tr_bgc_DON) then + do k = 1, n_don + write(nchar,'(i3.3)') k + call define_rest_field(File,'bgc_DON'//trim(nchar) ,dims) + enddo + endif + if (tr_bgc_Fe ) then + do k = 1, n_fed + write(nchar,'(i3.3)') k + call define_rest_field(File,'bgc_Fed'//trim(nchar) ,dims) + enddo + do k = 1, n_fep + write(nchar,'(i3.3)') k + call define_rest_field(File,'bgc_Fep'//trim(nchar) ,dims) + enddo + endif + endif !skl_bgc !----------------------------------------------------------------- ! 4D restart fields, written as layers of 3D !----------------------------------------------------------------- - do k=1,nilyr + do k=1,nilyr + write(nchar,'(i3.3)') k + call define_rest_field(File,'sice'//trim(nchar),dims) + call define_rest_field(File,'qice'//trim(nchar),dims) + enddo + + do k=1,nslyr + write(nchar,'(i3.3)') k + call define_rest_field(File,'qsno'//trim(nchar),dims) + enddo + + if (tr_snow) then + do k=1,nslyr write(nchar,'(i3.3)') k - call define_rest_field(File,'sice'//trim(nchar),dims) - call define_rest_field(File,'qice'//trim(nchar),dims) + call define_rest_field(File,'smice'//trim(nchar),dims) + call define_rest_field(File,'smliq'//trim(nchar),dims) + call define_rest_field(File, 'rhos'//trim(nchar),dims) + call define_rest_field(File, 'rsnw'//trim(nchar),dims) enddo + endif - do k=1,nslyr + if (tr_fsd) then + do k=1,nfsd write(nchar,'(i3.3)') k - call define_rest_field(File,'qsno'//trim(nchar),dims) + call define_rest_field(File,'fsd'//trim(nchar),dims) enddo + endif + + if (tr_iso) then + do k=1,n_iso + write(nchar,'(i3.3)') k + call define_rest_field(File,'isosno'//nchar, dims) + call define_rest_field(File,'isoice'//nchar, dims) + enddo + endif + + if (tr_aero) then + do k=1,n_aero + write(nchar,'(i3.3)') k + call define_rest_field(File,'aerosnossl'//nchar, dims) + call define_rest_field(File,'aerosnoint'//nchar, dims) + call define_rest_field(File,'aeroicessl'//nchar, dims) + call define_rest_field(File,'aeroiceint'//nchar, dims) + enddo + endif - if (tr_snow) then - do k=1,nslyr + if (z_tracers) then + if (tr_zaero) then + do n = 1, n_zaero + write(ncharb,'(i3.3)') n + do k = 1, nblyr+3 + write(nchar,'(i3.3)') k + call define_rest_field(File,'zaero'//trim(ncharb)//trim(nchar),dims) + enddo !k + enddo !n + endif !tr_zaero + if (tr_bgc_Nit) then + do k = 1, nblyr+3 write(nchar,'(i3.3)') k - call define_rest_field(File,'smice'//trim(nchar),dims) - call define_rest_field(File,'smliq'//trim(nchar),dims) - call define_rest_field(File, 'rhos'//trim(nchar),dims) - call define_rest_field(File, 'rsnw'//trim(nchar),dims) + call define_rest_field(File,'bgc_Nit'//trim(nchar),dims) enddo endif - - if (tr_fsd) then - do k=1,nfsd - write(nchar,'(i3.3)') k - call define_rest_field(File,'fsd'//trim(nchar),dims) + if (tr_bgc_N) then + do n = 1, n_algae + write(ncharb,'(i3.3)') n + do k = 1, nblyr+3 + write(nchar,'(i3.3)') k + call define_rest_field(File,'bgc_N'//trim(ncharb)//trim(nchar),dims) + enddo enddo endif - - if (tr_iso) then - do k=1,n_iso - write(nchar,'(i3.3)') k - call define_rest_field(File,'isosno'//nchar, dims) - call define_rest_field(File,'isoice'//nchar, dims) + if (tr_bgc_C) then + ! do n = 1, n_algae + ! write(ncharb,'(i3.3)') n + ! do k = 1, nblyr+3 + ! write(nchar,'(i3.3)') k + ! call define_rest_field(File,'bgc_C'//trim(ncharb)//trim(nchar),dims) + ! enddo + ! enddo + do n = 1, n_doc + write(ncharb,'(i3.3)') n + do k = 1, nblyr+3 + write(nchar,'(i3.3)') k + call define_rest_field(File,'bgc_DOC'//trim(ncharb)//trim(nchar),dims) + enddo + enddo + do n = 1, n_dic + write(ncharb,'(i3.3)') n + do k = 1, nblyr+3 + write(nchar,'(i3.3)') k + call define_rest_field(File,'bgc_DIC'//trim(ncharb)//trim(nchar),dims) + enddo enddo endif - - if (tr_aero) then - do k=1,n_aero + if (tr_bgc_chl) then + do n = 1, n_algae + write(ncharb,'(i3.3)') n + do k = 1, nblyr+3 + write(nchar,'(i3.3)') k + call define_rest_field(File,'bgc_chl'//trim(ncharb)//trim(nchar),dims) + enddo + enddo + endif + if (tr_bgc_Am) then + do k = 1, nblyr+3 write(nchar,'(i3.3)') k - call define_rest_field(File,'aerosnossl'//nchar, dims) - call define_rest_field(File,'aerosnoint'//nchar, dims) - call define_rest_field(File,'aeroicessl'//nchar, dims) - call define_rest_field(File,'aeroiceint'//nchar, dims) + call define_rest_field(File,'bgc_Am'//trim(nchar),dims) enddo endif - - if (z_tracers) then - if (tr_zaero) then - do n = 1, n_zaero - write(ncharb,'(i3.3)') n - do k = 1, nblyr+3 + if (tr_bgc_Sil) then + do k = 1, nblyr+3 write(nchar,'(i3.3)') k - call define_rest_field(File,'zaero'//trim(ncharb)//trim(nchar),dims) - enddo !k - enddo !n - endif !tr_zaero - if (tr_bgc_Nit) then - do k = 1, nblyr+3 + call define_rest_field(File,'bgc_Sil'//trim(nchar),dims) + enddo + endif + if (tr_bgc_hum) then + do k = 1, nblyr+3 write(nchar,'(i3.3)') k - call define_rest_field(File,'bgc_Nit'//trim(nchar),dims) - enddo - endif - if (tr_bgc_N) then - do n = 1, n_algae - write(ncharb,'(i3.3)') n - do k = 1, nblyr+3 + call define_rest_field(File,'bgc_hum'//trim(nchar),dims) + enddo + endif + if (tr_bgc_DMS) then + do k = 1, nblyr+3 write(nchar,'(i3.3)') k - call define_rest_field(File,'bgc_N'//trim(ncharb)//trim(nchar),dims) - enddo - enddo - endif - if (tr_bgc_C) then - ! do n = 1, n_algae - ! write(ncharb,'(i3.3)') n - ! do k = 1, nblyr+3 - ! write(nchar,'(i3.3)') k - ! call - ! define_rest_field(File,'bgc_C'//trim(ncharb)//trim(nchar),dims) - ! enddo - ! enddo - do n = 1, n_doc - write(ncharb,'(i3.3)') n - do k = 1, nblyr+3 - write(nchar,'(i3.3)') k - call define_rest_field(File,'bgc_DOC'//trim(ncharb)//trim(nchar),dims) - enddo - enddo - do n = 1, n_dic - write(ncharb,'(i3.3)') n - do k = 1, nblyr+3 - write(nchar,'(i3.3)') k - call define_rest_field(File,'bgc_DIC'//trim(ncharb)//trim(nchar),dims) - enddo - enddo - endif - if (tr_bgc_chl) then - do n = 1, n_algae - write(ncharb,'(i3.3)') n - do k = 1, nblyr+3 - write(nchar,'(i3.3)') k - call define_rest_field(File,'bgc_chl'//trim(ncharb)//trim(nchar),dims) - enddo - enddo - endif - if (tr_bgc_Am) then - do k = 1, nblyr+3 - write(nchar,'(i3.3)') k - call define_rest_field(File,'bgc_Am'//trim(nchar),dims) - enddo - endif - if (tr_bgc_Sil) then - do k = 1, nblyr+3 - write(nchar,'(i3.3)') k - call define_rest_field(File,'bgc_Sil'//trim(nchar),dims) - enddo - endif - if (tr_bgc_hum) then - do k = 1, nblyr+3 - write(nchar,'(i3.3)') k - call define_rest_field(File,'bgc_hum'//trim(nchar),dims) - enddo - endif - if (tr_bgc_DMS) then - do k = 1, nblyr+3 - write(nchar,'(i3.3)') k - call define_rest_field(File,'bgc_DMSPp'//trim(nchar),dims) - call define_rest_field(File,'bgc_DMSPd'//trim(nchar),dims) - call define_rest_field(File,'bgc_DMS'//trim(nchar),dims) - enddo - endif - if (tr_bgc_PON) then - do k = 1, nblyr+3 - write(nchar,'(i3.3)') k - call define_rest_field(File,'bgc_PON'//trim(nchar),dims) - enddo - endif - if (tr_bgc_DON) then - do n = 1, n_don - write(ncharb,'(i3.3)') n - do k = 1, nblyr+3 - write(nchar,'(i3.3)') k - call define_rest_field(File,'bgc_DON'//trim(ncharb)//trim(nchar),dims) - enddo - enddo - endif - if (tr_bgc_Fe ) then - do n = 1, n_fed - write(ncharb,'(i3.3)') n - do k = 1, nblyr+3 - write(nchar,'(i3.3)') k - call define_rest_field(File,'bgc_Fed'//trim(ncharb)//trim(nchar),dims) - enddo - enddo - do n = 1, n_fep - write(ncharb,'(i3.3)') n - do k = 1, nblyr+3 - write(nchar,'(i3.3)') k - call define_rest_field(File,'bgc_Fep'//trim(ncharb)//trim(nchar),dims) - enddo - enddo - endif - do k = 1, nbtrcr + call define_rest_field(File,'bgc_DMSPp'//trim(nchar),dims) + call define_rest_field(File,'bgc_DMSPd'//trim(nchar),dims) + call define_rest_field(File,'bgc_DMS'//trim(nchar),dims) + enddo + endif + if (tr_bgc_PON) then + do k = 1, nblyr+3 write(nchar,'(i3.3)') k - call define_rest_field(File,'zbgc_frac'//trim(nchar),dims) + call define_rest_field(File,'bgc_PON'//trim(nchar),dims) + enddo + endif + if (tr_bgc_DON) then + do n = 1, n_don + write(ncharb,'(i3.3)') n + do k = 1, nblyr+3 + write(nchar,'(i3.3)') k + call define_rest_field(File,'bgc_DON'//trim(ncharb)//trim(nchar),dims) + enddo enddo - endif !z_tracers + endif + if (tr_bgc_Fe ) then + do n = 1, n_fed + write(ncharb,'(i3.3)') n + do k = 1, nblyr+3 + write(nchar,'(i3.3)') k + call define_rest_field(File,'bgc_Fed'//trim(ncharb)//trim(nchar),dims) + enddo + enddo + do n = 1, n_fep + write(ncharb,'(i3.3)') n + do k = 1, nblyr+3 + write(nchar,'(i3.3)') k + call define_rest_field(File,'bgc_Fep'//trim(ncharb)//trim(nchar),dims) + enddo + enddo + endif + do k = 1, nbtrcr + write(nchar,'(i3.3)') k + call define_rest_field(File,'zbgc_frac'//trim(nchar),dims) + enddo + endif !z_tracers - deallocate(dims) - status = pio_enddef(File) + deallocate(dims) + call ice_pio_check(pio_enddef(File), subname//' ERROR: enddef',file=__FILE__,line=__LINE__) - call ice_pio_initdecomp(iodesc=iodesc2d, precision=8) - call ice_pio_initdecomp(ndim3=ncat , iodesc=iodesc3d_ncat, remap=.true., precision=8) + call pio_seterrorhandling(File, PIO_INTERNAL_ERROR) -! endif ! restart_format + call ice_pio_initdecomp(iodesc=iodesc2d, precision=8) + call ice_pio_initdecomp(ndim3=ncat , iodesc=iodesc3d_ncat, remap=.true., precision=8) if (my_task == master_task) then write(nu_diag,*) 'Writing ',filename(1:lenstr(filename)) endif + first_call = .false. + end subroutine init_restart_write !======================================================================= @@ -687,104 +702,98 @@ subroutine read_restart_field(nu,nrec,work,atype,vname,ndim3,diag, & use ice_global_reductions, only: global_minval, global_maxval, global_sum integer (kind=int_kind), intent(in) :: & - nu , & ! unit number - ndim3 , & ! third dimension - nrec ! record number (0 for sequential access) + nu , & ! unit number + ndim3 , & ! third dimension + nrec ! record number (0 for sequential access) real (kind=dbl_kind), dimension(nx_block,ny_block,ndim3,max_blocks), intent(inout) :: & - work ! input array (real, 8-byte) + work ! input array (real, 8-byte) character (len=4), intent(in) :: & - atype ! format for output array - ! (real/integer, 4-byte/8-byte) + atype ! format for output array + ! (real/integer, 4-byte/8-byte) logical (kind=log_kind), intent(in) :: & - diag ! if true, write diagnostic output + diag ! if true, write diagnostic output character (len=*), intent(in) :: vname integer (kind=int_kind), optional, intent(in) :: & - field_loc, & ! location of field on staggered grid - field_type ! type of field (scalar, vector, angle) + field_loc , & ! location of field on staggered grid + field_type ! type of field (scalar, vector, angle) ! local variables integer (kind=int_kind) :: & - j, & ! dimension counter - n, & ! number of dimensions for variable - ndims, & ! number of variable dimensions - status ! status variable from netCDF routine + j , & ! dimension counter + n , & ! number of dimensions for variable + ndims , & ! number of variable dimensions + status ! status variable from netCDF routine real (kind=dbl_kind) :: amin,amax,asum character(len=*), parameter :: subname = '(read_restart_field)' -! if (restart_format(1:3) == "pio") then - if (my_task == master_task) & - write(nu_diag,*)'Parallel restart file read: ',vname - - call pio_seterrorhandling(File, PIO_BCAST_ERROR) - - status = pio_inq_varid(File,trim(vname),vardesc) + call pio_seterrorhandling(File, PIO_RETURN_ERROR) - if (status /= PIO_noerr) then - call abort_ice(subname// & - "ERROR: CICE restart? Missing variable: "//trim(vname)) - endif + if (my_task == master_task) then + write(nu_diag,*)'Parallel restart file read: ',vname + endif - status = pio_inq_varndims(File, vardesc, ndims) + call ice_pio_check(pio_inq_varid(File,trim(vname),vardesc), & + subname// " ERROR: missing varid "//trim(vname),file=__FILE__,line=__LINE__) - call pio_seterrorhandling(File, PIO_INTERNAL_ERROR) + call ice_pio_check(pio_inq_varndims(File, vardesc, ndims), & + subname// " ERROR: missing varndims "//trim(vname),file=__FILE__,line=__LINE__) -! if (ndim3 == ncat .and. ncat>1) then - if (ndim3 == ncat .and. ndims == 3) then - call pio_read_darray(File, vardesc, iodesc3d_ncat, work, status) + if (ndim3 == ncat .and. ndims == 3) then + call pio_read_darray(File, vardesc, iodesc3d_ncat, work, status) #ifdef CESMCOUPLED - where (work == PIO_FILL_DOUBLE) work = c0 + where (work == PIO_FILL_DOUBLE) work = c0 #endif - if (present(field_loc)) then - do n=1,ndim3 - call ice_HaloUpdate (work(:,:,n,:), halo_info, & - field_loc, field_type) - enddo - endif -! elseif (ndim3 == 1) then - elseif (ndim3 == 1 .and. ndims == 2) then - call pio_read_darray(File, vardesc, iodesc2d, work, status) + if (present(field_loc)) then + do n=1,ndim3 + call ice_HaloUpdate (work(:,:,n,:), halo_info, & + field_loc, field_type) + enddo + endif + elseif (ndim3 == 1 .and. ndims == 2) then + call pio_read_darray(File, vardesc, iodesc2d, work, status) #ifdef CESMCOUPLED - where (work == PIO_FILL_DOUBLE) work = c0 + where (work == PIO_FILL_DOUBLE) work = c0 #endif - if (present(field_loc)) then - call ice_HaloUpdate (work(:,:,1,:), halo_info, & - field_loc, field_type) - endif - else - write(nu_diag,*) "ndim3 not supported ",ndim3 + if (present(field_loc)) then + call ice_HaloUpdate (work(:,:,1,:), halo_info, & + field_loc, field_type) endif + else + write(nu_diag,*) "ndim3 not supported ",ndim3 + endif - if (diag) then - if (ndim3 > 1) then - do n=1,ndim3 - amin = global_minval(work(:,:,n,:),distrb_info) - amax = global_maxval(work(:,:,n,:),distrb_info) - asum = global_sum(work(:,:,n,:), distrb_info, field_loc_center) - if (my_task == master_task) then - write(nu_diag,*) ' min, max, sum =', amin, amax, asum, trim(vname) - endif - enddo - else - amin = global_minval(work(:,:,1,:),distrb_info) - amax = global_maxval(work(:,:,1,:),distrb_info) - asum = global_sum(work(:,:,1,:), distrb_info, field_loc_center) + call ice_pio_check(status, & + subname//" ERROR: reading var "//trim(vname),file=__FILE__,line=__LINE__) + + call pio_seterrorhandling(File, PIO_INTERNAL_ERROR) + + if (diag) then + if (ndim3 > 1) then + do n=1,ndim3 + amin = global_minval(work(:,:,n,:),distrb_info) + amax = global_maxval(work(:,:,n,:),distrb_info) + asum = global_sum(work(:,:,n,:), distrb_info, field_loc_center) if (my_task == master_task) then write(nu_diag,*) ' min, max, sum =', amin, amax, asum, trim(vname) endif + enddo + else + amin = global_minval(work(:,:,1,:),distrb_info) + amax = global_maxval(work(:,:,1,:),distrb_info) + asum = global_sum(work(:,:,1,:), distrb_info, field_loc_center) + if (my_task == master_task) then + write(nu_diag,*) ' min, max, sum =', amin, amax, asum, trim(vname) endif - endif -! else -! call abort_ice(subname//"ERROR: Invalid restart_format: "//trim(restart_format)) -! endif ! restart_format + endif end subroutine read_restart_field @@ -802,74 +811,80 @@ subroutine write_restart_field(nu,nrec,work,atype,vname,ndim3,diag) use ice_global_reductions, only: global_minval, global_maxval, global_sum integer (kind=int_kind), intent(in) :: & - nu , & ! unit number - ndim3 , & ! third dimension - nrec ! record number (0 for sequential access) + nu , & ! unit number + ndim3 , & ! third dimension + nrec ! record number (0 for sequential access) real (kind=dbl_kind), dimension(nx_block,ny_block,ndim3,max_blocks), intent(in) :: & - work ! input array (real, 8-byte) + work ! input array (real, 8-byte) character (len=4), intent(in) :: & - atype ! format for output array - ! (real/integer, 4-byte/8-byte) + atype ! format for output array + ! (real/integer, 4-byte/8-byte) logical (kind=log_kind), intent(in) :: & - diag ! if true, write diagnostic output + diag ! if true, write diagnostic output character (len=*), intent(in) :: vname ! local variables integer (kind=int_kind) :: & - j, & ! dimension counter - n, & ! dimension counter - ndims, & ! number of variable dimensions - status ! status variable from netCDF routine + j , & ! dimension counter + n , & ! dimension counter + ndims , & ! number of variable dimensions + status ! status variable from netCDF routine real (kind=dbl_kind) :: amin,amax,asum character(len=*), parameter :: subname = '(write_restart_field)' -! if (restart_format(1:3) == "pio") then - if (my_task == master_task) & - write(nu_diag,*)'Parallel restart file write: ',vname + call pio_seterrorhandling(File, PIO_RETURN_ERROR) - status = pio_inq_varid(File,trim(vname),vardesc) + if (my_task == master_task) then + write(nu_diag,*)'Parallel restart file write: ',vname + endif - status = pio_inq_varndims(File, vardesc, ndims) + call ice_pio_check(pio_inq_varid(File,trim(vname),vardesc), & + subname// " ERROR: missing varid "//trim(vname),file=__FILE__,line=__LINE__) - if (ndims==3) then - call pio_write_darray(File, vardesc, iodesc3d_ncat,work(:,:,:,1:nblocks), & - status, fillval=c0) - elseif (ndims == 2) then - call pio_write_darray(File, vardesc, iodesc2d, work(:,:,1,1:nblocks), & - status, fillval=c0) - else - write(nu_diag,*) "ndims not supported",ndims,ndim3 - endif + call ice_pio_check(pio_inq_varndims(File, vardesc, ndims), & + subname// " ERROR: missing varndims "//trim(vname),file=__FILE__,line=__LINE__) - if (diag) then - if (ndim3 > 1) then - do n=1,ndim3 - amin = global_minval(work(:,:,n,:),distrb_info) - amax = global_maxval(work(:,:,n,:),distrb_info) - asum = global_sum(work(:,:,n,:), distrb_info, field_loc_center) - if (my_task == master_task) then - write(nu_diag,*) ' min, max, sum =', amin, amax, asum, trim(vname) - endif - enddo - else - amin = global_minval(work(:,:,1,:),distrb_info) - amax = global_maxval(work(:,:,1,:),distrb_info) - asum = global_sum(work(:,:,1,:), distrb_info, field_loc_center) + if (ndims==3) then + call pio_write_darray(File, vardesc, iodesc3d_ncat,work(:,:,:,1:nblocks), & + status, fillval=c0) + elseif (ndims == 2) then + call pio_write_darray(File, vardesc, iodesc2d, work(:,:,1,1:nblocks), & + status, fillval=c0) + else + write(nu_diag,*) "ndims not supported",ndims,ndim3 + endif + + call ice_pio_check(status, & + subname//" ERROR: writing "//trim(vname),file=__FILE__,line=__LINE__) + + call pio_seterrorhandling(File, PIO_INTERNAL_ERROR) + + if (diag) then + if (ndim3 > 1) then + do n=1,ndim3 + amin = global_minval(work(:,:,n,:),distrb_info) + amax = global_maxval(work(:,:,n,:),distrb_info) + asum = global_sum(work(:,:,n,:), distrb_info, field_loc_center) if (my_task == master_task) then write(nu_diag,*) ' min, max, sum =', amin, amax, asum, trim(vname) endif + enddo + else + amin = global_minval(work(:,:,1,:),distrb_info) + amax = global_maxval(work(:,:,1,:),distrb_info) + asum = global_sum(work(:,:,1,:), distrb_info, field_loc_center) + if (my_task == master_task) then + write(nu_diag,*) ' min, max, sum =', amin, amax, asum, trim(vname) endif endif -! else -! call abort_ice(subname//"ERROR: Invalid restart_format: "//trim(restart_format)) -! endif + endif end subroutine write_restart_field @@ -889,7 +904,8 @@ subroutine final_restart() call pio_closefile(File) if (my_task == master_task) then - write(nu_diag,'(a,i8,4x,i4.4,a,i2.2,a,i2.2,a,i5.5)') 'Restart read/written ',istep1,myear,'-',mmonth,'-',mday,'-',msec + write(nu_diag,'(a,i8,4x,i4.4,a,i2.2,a,i2.2,a,i5.5)') & + 'Restart read/written ',istep1,myear,'-',mmonth,'-',mday,'-',msec endif end subroutine final_restart @@ -901,16 +917,44 @@ end subroutine final_restart subroutine define_rest_field(File, vname, dims) +#ifndef USE_PIO1 + use netcdf, only: NF90_CHUNKED + use pio_nf, only: pio_def_var_chunking !PIO <2.6.0 was missing this in the pio module +#endif type(file_desc_t) , intent(in) :: File character (len=*) , intent(in) :: vname integer (kind=int_kind), intent(in) :: dims(:) - integer (kind=int_kind) :: & - status ! status variable from netCDF routine + integer (kind=int_kind) :: chunks(size(dims)), i, status character(len=*), parameter :: subname = '(define_rest_field)' + status = pio_def_var(File,trim(vname),pio_double,dims,vardesc) + call ice_pio_check(status, & + subname//' ERROR defining restart field '//trim(vname)) + +#ifndef USE_PIO1 + if (restart_format=='hdf5' .and. restart_deflate/=0) then + status = pio_def_var_deflate(File, vardesc, shuffle=0, deflate=1, deflate_level=restart_deflate) + call ice_pio_check(status, & + subname//' ERROR: deflating restart field '//trim(vname),file=__FILE__,line=__LINE__) + endif + + if (restart_format=='hdf5' .and. size(dims)>1) then + if (dims(1)==dimid_ni .and. dims(2)==dimid_nj) then + chunks(1)=restart_chunksize(1) + chunks(2)=restart_chunksize(2) + do i = 3, size(dims) + chunks(i) = 0 + enddo + + status = pio_def_var_chunking(File, vardesc, NF90_CHUNKED, chunks) + call ice_pio_check(status, subname//' ERROR: chunking restart field '//trim(vname),& + file=__FILE__,line=__LINE__) + endif + endif +#endif end subroutine define_rest_field @@ -931,9 +975,13 @@ logical function query_field(nu,vname) query_field = .false. + call pio_seterrorhandling(File, PIO_RETURN_ERROR) + status = pio_inq_varid(File,trim(vname),vardesc) if (status == PIO_noerr) query_field = .true. + call pio_seterrorhandling(File, PIO_INTERNAL_ERROR) + end function query_field !======================================================================= diff --git a/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 b/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 index 5dec8a942..efadabbda 100644 --- a/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 +++ b/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 @@ -30,8 +30,9 @@ module ice_comp_nuopc use ice_kinds_mod , only : dbl_kind, int_kind, char_len, char_len_long use ice_fileunits , only : nu_diag, nu_diag_set, inst_index, inst_name use ice_fileunits , only : inst_suffix, release_all_fileunits, flush_fileunit - use ice_restart_shared , only : runid, runtype, restart, use_restart_time, restart_dir, restart_file + use ice_restart_shared , only : runid, runtype, restart, use_restart_time, restart_dir, restart_file, restart_format, restart_chunksize use ice_history , only : accum_hist + use ice_history_shared , only : history_format, history_chunksize use ice_exit , only : abort_ice use icepack_intfc , only : icepack_warnings_flush, icepack_warnings_aborted use icepack_intfc , only : icepack_init_orbit, icepack_init_parameters, icepack_query_orbit @@ -645,6 +646,36 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call abort_ice(trim(errmsg)) endif + ! Netcdf output created by PIO + call NUOPC_CompAttributeGet(gcomp, name="pio_typename", value=cvalue, & + isPresent=isPresent, isSet=isSet, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + if (trim(history_format)/='cdf1' .and. mastertask) then + write(nu_diag,*) trim(subname)//history_format//'WARNING: history_format from cice_namelist ignored' + write(nu_diag,*) trim(subname)//'WARNING: using '//trim(cvalue)//' from ICE_modelio' + endif + if (trim(restart_format)/='cdf1' .and. mastertask) then + write(nu_diag,*) trim(subname)//restart_format//'WARNING: restart_format from cice_namelist ignored' + write(nu_diag,*) trim(subname)//'WARNING: using '//trim(cvalue)//' from ICE_modelio' + endif + + ! The only reason to set these is to detect in ice_history_write if the chunk/deflate settings are ok. + select case (trim(cvalue)) + case ('netcdf4p') + history_format='hdf5' + restart_format='hdf5' + case ('netcdf4c') + if (mastertask) write(nu_diag,*) trim(subname)//'WARNING: pio_typename = netcdf4c is superseded, use netcdf4p' + history_format='hdf5' + restart_format='hdf5' + case default !pio_typename=netcdf or pnetcdf + ! do nothing + end select + else + if(mastertask) write(nu_diag,*) trim(subname)//'WARNING: pio_typename from driver needs to be set for netcdf output to work' + end if + #else ! Read the cice namelist as part of the call to cice_init1 diff --git a/cicecore/drivers/nuopc/cmeps/ice_import_export.F90 b/cicecore/drivers/nuopc/cmeps/ice_import_export.F90 index 14a7b5155..47abb0373 100644 --- a/cicecore/drivers/nuopc/cmeps/ice_import_export.F90 +++ b/cicecore/drivers/nuopc/cmeps/ice_import_export.F90 @@ -363,45 +363,55 @@ subroutine ice_realize_fields(gcomp, mesh, flds_scalar_name, flds_scalar_num, rc mesh=mesh, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return #ifdef CESMCOUPLED - ! Get mesh areas from second field - using second field since the - ! first field is the scalar field - if (single_column) return + ! allocate area correction factors call ESMF_MeshGet(mesh, numOwnedElements=numOwnedElements, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_StateGet(exportState, itemName=trim(fldsFrIce(2)%stdname), field=lfield, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldRegridGetArea(lfield, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(lfield, farrayPtr=dataptr, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - allocate(mesh_areas(numOwnedElements)) - mesh_areas(:) = dataptr(:) - - ! Determine flux correction factors (module variables) - allocate(model_areas(numOwnedElements)) - allocate(mod2med_areacor(numOwnedElements)) - allocate(med2mod_areacor(numOwnedElements)) - mod2med_areacor(:) = 1._dbl_kind - med2mod_areacor(:) = 1._dbl_kind - n = 0 - do iblk = 1, nblocks - this_block = get_block(blocks_ice(iblk),iblk) - ilo = this_block%ilo - ihi = this_block%ihi - jlo = this_block%jlo - jhi = this_block%jhi - do j = jlo, jhi - do i = ilo, ihi - n = n+1 - model_areas(n) = tarea(i,j,iblk)/(radius*radius) - mod2med_areacor(n) = model_areas(n) / mesh_areas(n) - med2mod_areacor(n) = mesh_areas(n) / model_areas(n) + allocate (mod2med_areacor(numOwnedElements)) + allocate (med2mod_areacor(numOwnedElements)) + + if (single_column) then + + mod2med_areacor(:) = 1._dbl_kind + med2mod_areacor(:) = 1._dbl_kind + + else + + ! Get mesh areas from second field - using second field since the + ! first field is the scalar field + + call ESMF_StateGet(exportState, itemName=trim(fldsFrIce(2)%stdname), field=lfield, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldRegridGetArea(lfield, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(lfield, farrayPtr=dataptr, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + allocate(mesh_areas(numOwnedElements)) + mesh_areas(:) = dataptr(:) + + ! Determine flux correction factors (module variables) + allocate(model_areas(numOwnedElements)) + mod2med_areacor(:) = 1._dbl_kind + med2mod_areacor(:) = 1._dbl_kind + n = 0 + do iblk = 1, nblocks + this_block = get_block(blocks_ice(iblk),iblk) + ilo = this_block%ilo + ihi = this_block%ihi + jlo = this_block%jlo + jhi = this_block%jhi + do j = jlo, jhi + do i = ilo, ihi + n = n+1 + model_areas(n) = tarea(i,j,iblk)/(radius*radius) + mod2med_areacor(n) = model_areas(n) / mesh_areas(n) + med2mod_areacor(n) = mesh_areas(n) / model_areas(n) + enddo enddo enddo - enddo - deallocate(model_areas) - deallocate(mesh_areas) + deallocate(model_areas) + deallocate(mesh_areas) + end if min_mod2med_areacor = minval(mod2med_areacor) max_mod2med_areacor = maxval(mod2med_areacor) diff --git a/cicecore/drivers/nuopc/cmeps/ice_mesh_mod.F90 b/cicecore/drivers/nuopc/cmeps/ice_mesh_mod.F90 index 9493add51..ae0a2d070 100644 --- a/cicecore/drivers/nuopc/cmeps/ice_mesh_mod.F90 +++ b/cicecore/drivers/nuopc/cmeps/ice_mesh_mod.F90 @@ -437,7 +437,7 @@ subroutine ice_mesh_init_tlon_tlat_area_hm() use ice_grid , only : tlon, tlat, hm, tarea, ULON, ULAT, HTN, HTE, ANGLE, ANGLET use ice_grid , only : uarea, uarear, tarear!, tinyarea - use ice_grid , only : dxT, dyT, dxU, dyU, dyhx, dxhy, cyp, cxp, cym, cxm + use ice_grid , only : dxT, dyT, dxU, dyU use ice_grid , only : makemask use ice_boundary , only : ice_HaloUpdate use ice_domain , only : blocks_ice, nblocks, halo_info, distrb_info @@ -535,12 +535,6 @@ subroutine ice_mesh_init_tlon_tlat_area_hm() dyT (i,j,iblk) = 1.e36_dbl_kind dxU (i,j,iblk) = 1.e36_dbl_kind dyU (i,j,iblk) = 1.e36_dbl_kind - dxhy (i,j,iblk) = 1.e36_dbl_kind - dyhx (i,j,iblk) = 1.e36_dbl_kind - cyp (i,j,iblk) = 1.e36_dbl_kind - cxp (i,j,iblk) = 1.e36_dbl_kind - cym (i,j,iblk) = 1.e36_dbl_kind - cxm (i,j,iblk) = 1.e36_dbl_kind enddo enddo enddo diff --git a/cicecore/drivers/standalone/cice/CICE_InitMod.F90 b/cicecore/drivers/standalone/cice/CICE_InitMod.F90 index a48bdda30..194293118 100644 --- a/cicecore/drivers/standalone/cice/CICE_InitMod.F90 +++ b/cicecore/drivers/standalone/cice/CICE_InitMod.F90 @@ -66,7 +66,7 @@ subroutine cice_init floe_binwidth, c_fsd_range use ice_state, only: alloc_state use ice_flux_bgc, only: alloc_flux_bgc - use ice_calendar, only: dt, dt_dyn, write_ic, & + use ice_calendar, only: dt, write_ic, & init_calendar, advance_timestep, calc_timesteps use ice_communicate, only: init_communicate, my_task, master_task use ice_diagnostics, only: init_diags diff --git a/cicecore/shared/ice_restart_shared.F90 b/cicecore/shared/ice_restart_shared.F90 index 7c178fec0..c022d77ba 100644 --- a/cicecore/shared/ice_restart_shared.F90 +++ b/cicecore/shared/ice_restart_shared.F90 @@ -26,9 +26,16 @@ module ice_restart_shared pointer_file ! input pointer file for restarts character (len=char_len), public :: & - restart_format ! format of restart files 'nc' + restart_format , & ! format of restart files 'nc' + restart_rearranger ! restart file rearranger, box or subset for pio + + integer (kind=int_kind), public :: & + restart_iotasks , & ! iotasks, root, stride defines io pes for pio + restart_root , & ! iotasks, root, stride defines io pes for pio + restart_stride , & ! iotasks, root, stride defines io pes for pio + restart_deflate , & ! compression level for hdf5/netcdf4 + restart_chunksize(2) ! chunksize for hdf5/netcdf4 - logical (kind=log_kind), public :: lcdf64 !======================================================================= diff --git a/configuration/scripts/ice_in b/configuration/scripts/ice_in index 85f502683..103c56d2a 100644 --- a/configuration/scripts/ice_in +++ b/configuration/scripts/ice_in @@ -15,6 +15,12 @@ restart_ext = .false. use_restart_time = .false. restart_format = 'default' + restart_rearranger = 'default' + restart_iotasks = -99 + restart_root = -99 + restart_stride = -99 + restart_deflate = 0 + restart_chunksize = 0, 0 lcdf64 = .false. numin = 21 numax = 89 @@ -54,6 +60,12 @@ history_file = 'iceh' history_precision = 4 history_format = 'default' + history_rearranger = 'default' + history_iotasks = -99 + history_root = -99 + history_stride = -99 + history_deflate = 0 + history_chunksize = 0, 0 hist_time_axis = 'end' write_ic = .true. incond_dir = './history/' @@ -571,6 +583,7 @@ f_strength = 'm' f_divu = 'm' f_shear = 'm' + f_vort = 'x' f_sig1 = 'm' f_sig2 = 'm' f_sigP = 'm' diff --git a/configuration/scripts/machines/Macros.conda_macos b/configuration/scripts/machines/Macros.conda_macos index fad87507c..6f26da0fc 100644 --- a/configuration/scripts/machines/Macros.conda_macos +++ b/configuration/scripts/machines/Macros.conda_macos @@ -14,7 +14,8 @@ FFLAGS := -fconvert=big-endian -fbacktrace -ffree-line-length-none # Additional flags for the Fortran compiler when compiling in debug mode ifeq ($(ICE_BLDDEBUG), true) - FFLAGS += -O0 -g -fcheck=bounds -finit-real=nan -fimplicit-none -ffpe-trap=invalid,zero,overflow +# FFLAGS += -O0 -g -fcheck=bounds -finit-real=nan -fimplicit-none -ffpe-trap=invalid,zero,overflow + FFLAGS += -O0 -g -fcheck=bounds -finit-real=nan -fimplicit-none -ffpe-trap=zero,overflow else FFLAGS += -O2 endif @@ -60,3 +61,7 @@ ifeq ($(ICE_THREADED), true) FFLAGS += -fopenmp endif +ifeq ($(ICE_IOTYPE), pio2) + SLIBS := $(SLIBS) -lpiof -lpioc +endif + diff --git a/configuration/scripts/machines/env.derecho_cray b/configuration/scripts/machines/env.derecho_cray index 5294fbe95..47cebd5cb 100644 --- a/configuration/scripts/machines/env.derecho_cray +++ b/configuration/scripts/machines/env.derecho_cray @@ -23,6 +23,8 @@ module load cray-libsci/23.02.1.1 if ($?ICE_IOTYPE) then if ($ICE_IOTYPE =~ pio*) then + module unload netcdf + module load netcdf-mpi/4.9.2 module load parallel-netcdf/1.12.3 if ($ICE_IOTYPE == "pio1") then module load parallelio/1.10.1 diff --git a/configuration/scripts/machines/env.derecho_gnu b/configuration/scripts/machines/env.derecho_gnu index 0f2d2ec87..5c4ca46f0 100644 --- a/configuration/scripts/machines/env.derecho_gnu +++ b/configuration/scripts/machines/env.derecho_gnu @@ -23,6 +23,8 @@ module load cray-libsci/23.02.1.1 if ($?ICE_IOTYPE) then if ($ICE_IOTYPE =~ pio*) then + module unload netcdf + module load netcdf-mpi/4.9.2 module load parallel-netcdf/1.12.3 if ($ICE_IOTYPE == "pio1") then module load parallelio/1.10.1 diff --git a/configuration/scripts/machines/env.derecho_intel b/configuration/scripts/machines/env.derecho_intel index 7c822c923..63626dc33 100644 --- a/configuration/scripts/machines/env.derecho_intel +++ b/configuration/scripts/machines/env.derecho_intel @@ -23,6 +23,8 @@ module load cray-libsci/23.02.1.1 if ($?ICE_IOTYPE) then if ($ICE_IOTYPE =~ pio*) then + module unload netcdf + module load netcdf-mpi/4.9.2 module load parallel-netcdf/1.12.3 if ($ICE_IOTYPE == "pio1") then module load parallelio/1.10.1 diff --git a/configuration/scripts/machines/env.derecho_intelclassic b/configuration/scripts/machines/env.derecho_intelclassic index 964f5e8bb..8d3639a5e 100644 --- a/configuration/scripts/machines/env.derecho_intelclassic +++ b/configuration/scripts/machines/env.derecho_intelclassic @@ -23,6 +23,8 @@ module load netcdf/4.9.2 if ($?ICE_IOTYPE) then if ($ICE_IOTYPE =~ pio*) then + module unload netcdf + module load netcdf-mpi/4.9.2 module load parallel-netcdf/1.12.3 if ($ICE_IOTYPE == "pio1") then module load parallelio/1.10.1 diff --git a/configuration/scripts/machines/env.derecho_inteloneapi b/configuration/scripts/machines/env.derecho_inteloneapi index 700830525..8f3911036 100644 --- a/configuration/scripts/machines/env.derecho_inteloneapi +++ b/configuration/scripts/machines/env.derecho_inteloneapi @@ -23,6 +23,8 @@ module load cray-libsci/23.02.1.1 if ($?ICE_IOTYPE) then if ($ICE_IOTYPE =~ pio*) then + module unload netcdf + module load netcdf-mpi/4.9.2 module load parallel-netcdf/1.12.3 if ($ICE_IOTYPE == "pio1") then module load parallelio/1.10.1 diff --git a/configuration/scripts/machines/env.derecho_nvhpc b/configuration/scripts/machines/env.derecho_nvhpc index f6bdf1138..34342769c 100644 --- a/configuration/scripts/machines/env.derecho_nvhpc +++ b/configuration/scripts/machines/env.derecho_nvhpc @@ -23,6 +23,8 @@ module load cray-libsci/23.02.1.1 if ($?ICE_IOTYPE) then if ($ICE_IOTYPE =~ pio*) then + module unload netcdf + module load netcdf-mpi/4.9.2 module load parallel-netcdf/1.12.3 if ($ICE_IOTYPE == "pio1") then module load parallelio/1.10.1 diff --git a/configuration/scripts/machines/environment.yml b/configuration/scripts/machines/environment.yml index e76ff692f..30ed1e148 100644 --- a/configuration/scripts/machines/environment.yml +++ b/configuration/scripts/machines/environment.yml @@ -6,6 +6,7 @@ dependencies: # Build dependencies - compilers - netcdf-fortran + - parallelio - openmpi - make - liblapack diff --git a/configuration/scripts/options/set_env.iopio1 b/configuration/scripts/options/set_env.iopio1 index 8357b4aac..1a92353ce 100644 --- a/configuration/scripts/options/set_env.iopio1 +++ b/configuration/scripts/options/set_env.iopio1 @@ -1 +1,2 @@ setenv ICE_IOTYPE pio1 +setenv ICE_CPPDEFS -DUSE_PIO1 diff --git a/configuration/scripts/options/set_env.iopio1p b/configuration/scripts/options/set_env.iopio1p deleted file mode 100644 index 8357b4aac..000000000 --- a/configuration/scripts/options/set_env.iopio1p +++ /dev/null @@ -1 +0,0 @@ -setenv ICE_IOTYPE pio1 diff --git a/configuration/scripts/options/set_env.iopio2p b/configuration/scripts/options/set_env.iopio2p deleted file mode 100644 index 415005ac4..000000000 --- a/configuration/scripts/options/set_env.iopio2p +++ /dev/null @@ -1 +0,0 @@ -setenv ICE_IOTYPE pio2 diff --git a/configuration/scripts/options/set_nml.histall b/configuration/scripts/options/set_nml.histall index 78932cba8..83421aca0 100644 --- a/configuration/scripts/options/set_nml.histall +++ b/configuration/scripts/options/set_nml.histall @@ -106,6 +106,7 @@ f_strength = 'md' f_divu = 'md' f_shear = 'md' + f_vort = 'md' f_sig1 = 'md' f_sig2 = 'md' f_sigP = 'md' diff --git a/configuration/scripts/options/set_nml.histdbg b/configuration/scripts/options/set_nml.histdbg index 43ae8e566..a70e734e5 100644 --- a/configuration/scripts/options/set_nml.histdbg +++ b/configuration/scripts/options/set_nml.histdbg @@ -106,6 +106,7 @@ f_strength = 'md1' f_divu = 'md1' f_shear = 'md1' + f_vort = 'md1' f_sig1 = 'md1' f_sig2 = 'md1' f_sigP = 'md1' diff --git a/configuration/scripts/options/set_nml.iobinary b/configuration/scripts/options/set_nml.iobinary index 7019acf0b..80ea92d61 100644 --- a/configuration/scripts/options/set_nml.iobinary +++ b/configuration/scripts/options/set_nml.iobinary @@ -1 +1,3 @@ ice_ic = 'internal' +history_format = 'binary' +restart_format = 'binary' diff --git a/configuration/scripts/options/set_nml.iocdf1 b/configuration/scripts/options/set_nml.iocdf1 new file mode 100644 index 000000000..ed9f65b68 --- /dev/null +++ b/configuration/scripts/options/set_nml.iocdf1 @@ -0,0 +1,2 @@ +restart_format = 'cdf1' +history_format = 'cdf1' diff --git a/configuration/scripts/options/set_nml.iocdf2 b/configuration/scripts/options/set_nml.iocdf2 new file mode 100644 index 000000000..ce10ae984 --- /dev/null +++ b/configuration/scripts/options/set_nml.iocdf2 @@ -0,0 +1,2 @@ +restart_format = 'cdf2' +history_format = 'cdf2' diff --git a/configuration/scripts/options/set_nml.iocdf5 b/configuration/scripts/options/set_nml.iocdf5 new file mode 100644 index 000000000..5081a8ac4 --- /dev/null +++ b/configuration/scripts/options/set_nml.iocdf5 @@ -0,0 +1,2 @@ +restart_format = 'cdf5' +history_format = 'cdf5' diff --git a/configuration/scripts/options/set_nml.iohdf5 b/configuration/scripts/options/set_nml.iohdf5 new file mode 100644 index 000000000..605a27938 --- /dev/null +++ b/configuration/scripts/options/set_nml.iohdf5 @@ -0,0 +1,2 @@ +restart_format = 'hdf5' +history_format = 'hdf5' diff --git a/configuration/scripts/options/set_nml.iohdf5opts b/configuration/scripts/options/set_nml.iohdf5opts new file mode 100644 index 000000000..6c780c169 --- /dev/null +++ b/configuration/scripts/options/set_nml.iohdf5opts @@ -0,0 +1,4 @@ +history_deflate = 6 +history_chunksize = 50,58 +restart_deflate = 8 +restart_chunksize = 50,58 diff --git a/configuration/scripts/options/set_nml.iopio1 b/configuration/scripts/options/set_nml.iopio1 deleted file mode 100644 index 655f2c96b..000000000 --- a/configuration/scripts/options/set_nml.iopio1 +++ /dev/null @@ -1,2 +0,0 @@ -restart_format = 'pio_netcdf' -history_format = 'pio_netcdf' diff --git a/configuration/scripts/options/set_nml.iopio1p b/configuration/scripts/options/set_nml.iopio1p deleted file mode 100644 index 83c422403..000000000 --- a/configuration/scripts/options/set_nml.iopio1p +++ /dev/null @@ -1,2 +0,0 @@ -restart_format = 'pio_pnetcdf' -history_format = 'pio_pnetcdf' diff --git a/configuration/scripts/options/set_nml.iopio2 b/configuration/scripts/options/set_nml.iopio2 deleted file mode 100644 index 655f2c96b..000000000 --- a/configuration/scripts/options/set_nml.iopio2 +++ /dev/null @@ -1,2 +0,0 @@ -restart_format = 'pio_netcdf' -history_format = 'pio_netcdf' diff --git a/configuration/scripts/options/set_nml.iopio2p b/configuration/scripts/options/set_nml.iopio2p deleted file mode 100644 index e4cce54af..000000000 --- a/configuration/scripts/options/set_nml.iopio2p +++ /dev/null @@ -1,2 +0,0 @@ -restart_format = 'pio_pnetcdf' -history_format = 'pio_netcdf' diff --git a/configuration/scripts/options/set_nml.iopioopts b/configuration/scripts/options/set_nml.iopioopts new file mode 100644 index 000000000..63aaeefcf --- /dev/null +++ b/configuration/scripts/options/set_nml.iopioopts @@ -0,0 +1,10 @@ +history_format = 'cdf2' +history_rearranger = 'subset' +history_iotasks = 1024 +history_root = 0 +history_stride = 2 +restart_format = 'pnetcdf5' +restart_rearranger = 'subset' +restart_iotasks = 1024 +restart_root = 1024 +restart_stride = 8 diff --git a/configuration/scripts/options/set_nml.iopnetcdf1 b/configuration/scripts/options/set_nml.iopnetcdf1 new file mode 100644 index 000000000..9346ed637 --- /dev/null +++ b/configuration/scripts/options/set_nml.iopnetcdf1 @@ -0,0 +1,2 @@ +restart_format = 'pnetcdf1' +history_format = 'pnetcdf1' diff --git a/configuration/scripts/options/set_nml.iopnetcdf2 b/configuration/scripts/options/set_nml.iopnetcdf2 new file mode 100644 index 000000000..27dd6f51c --- /dev/null +++ b/configuration/scripts/options/set_nml.iopnetcdf2 @@ -0,0 +1,2 @@ +restart_format = 'pnetcdf2' +history_format = 'pnetcdf2' diff --git a/configuration/scripts/options/set_nml.iopnetcdf5 b/configuration/scripts/options/set_nml.iopnetcdf5 new file mode 100644 index 000000000..3c95890d9 --- /dev/null +++ b/configuration/scripts/options/set_nml.iopnetcdf5 @@ -0,0 +1,2 @@ +restart_format = 'pnetcdf5' +history_format = 'pnetcdf5' diff --git a/configuration/scripts/tests/gridsys_suite.ts b/configuration/scripts/tests/gridsys_suite.ts index c10465f4b..e2731dd39 100644 --- a/configuration/scripts/tests/gridsys_suite.ts +++ b/configuration/scripts/tests/gridsys_suite.ts @@ -12,7 +12,7 @@ restart gx3 4x2 debug,diag1 restart2 gx1 16x2 debug,diag1 restart tx1 40x2 diag1 smoke gbox12 1x1x12x12x1 boxchan -smoke gbox80 4x2 boxchan1e +smoke gbox80 4x2 boxchan1e,debug smoke gbox80 8x1 boxchan1n smoke gbox80 1x1 box2001 smoke gbox80 2x2 boxwallblock @@ -35,7 +35,7 @@ restart gx3 4x2 debug,diag1,gridcd restart2 gx1 16x2 debug,diag1,gridcd restart tx1 40x2 diag1,gridcd smoke gbox12 1x1x12x12x1 boxchan,gridcd -smoke gbox80 4x2 boxchan1e,gridcd +smoke gbox80 4x2 boxchan1e,debug,gridcd smoke gbox80 8x1 boxchan1n,gridcd smoke gbox80 1x1 box2001,gridcd smoke gbox80 2x2 boxwallblock,gridcd @@ -58,7 +58,7 @@ restart gx3 4x2 debug,diag1,gridc restart2 gx1 16x2 debug,diag1,gridc restart tx1 40x2 diag1,gridc smoke gbox12 1x1x12x12x1 boxchan,gridc -smoke gbox80 4x2 boxchan1e,gridc +smoke gbox80 4x2 boxchan1e,debug,gridc smoke gbox80 8x1 boxchan1n,gridc smoke gbox80 1x1 box2001,gridc smoke gbox80 2x2 boxwallblock,gridc diff --git a/configuration/scripts/tests/io_suite.ts b/configuration/scripts/tests/io_suite.ts index 84d064f32..e5e7feee6 100644 --- a/configuration/scripts/tests/io_suite.ts +++ b/configuration/scripts/tests/io_suite.ts @@ -15,73 +15,47 @@ restart gx3 14x2 gx3ncarbulk,isotope,histall,iobinary,precision restart gx3 16x2 gx3ncarbulk,fsd12,histall,iobinary restart gx3 8x4 gx3ncarbulk,debug,histall,iobinary,precision8,histinst -restart gx3 32x1 debug,histall,ionetcdf -restart gx3 15x2 alt01,histall,ionetcdf,precision8,cdf64 -restart gx3 15x2 alt02,histall,ionetcdf -restart gx3 24x1 alt03,histall,ionetcdf,precision8 -restart gx3 8x4 alt04,histall,ionetcdf,cdf64 -restart gx3 8x4 alt05,histall,ionetcdf,precision8,cdf64 -restart gx3 16x2 alt06,histall,ionetcdf -restart gx3 16x2 alt07,histall,ionetcdf -restart gx3 30x1 bgczm,histall,ionetcdf -restart gx3 15x2 bgcskl,histall,ionetcdf,precision8 -restart gx3 31x1 isotope,histall,ionetcdf,cdf64 -restart gx3 14x2 fsd12,histall,ionetcdf,precision8 -restart gx3 32x1 debug,histall,ionetcdf,histinst +restart gx3 32x1 debug,histall,ionetcdf,iocdf1,precision8 +restart gx3 15x2 alt01,histall,ionetcdf,iocdf2,precision8 +restart gx3 15x2 alt02,histall,ionetcdf,iocdf5 +restart gx3 24x1 alt03,histall,ionetcdf,iohdf5,iohdf5opts +restart gx3 8x4 alt04,histall,ionetcdf,iocdf1 +restart gx3 8x4 alt05,histall,ionetcdf,iocdf2 +restart gx3 16x2 alt06,histall,ionetcdf,iocdf5,precision8 +restart gx3 16x2 alt07,histall,ionetcdf,iohdf5,precision8 +restart gx3 30x1 bgczm,histall,ionetcdf,iocdf1 +restart gx3 15x2 bgcskl,histall,ionetcdf,iocdf2,precision8 +restart gx3 31x1 isotope,histall,ionetcdf,iocdf5,precision8 +restart gx3 14x2 fsd12,histall,ionetcdf,iohdf5 +restart gx3 32x1 debug,histall,ionetcdf,iohdf5,histinst -restart gx3 16x2 debug,histall,iopio1,precision8,cdf64 -restart gx3 14x2 alt01,histall,iopio1,cdf64 -restart gx3 32x1 alt02,histall,iopio1,precision8 -restart gx3 24x1 alt03,histall,iopio1 -restart gx3 8x4 alt04,histall,iopio1,precision8,cdf64 -restart gx3 8x4 alt05,histall,iopio1,cdf64 -restart gx3 32x1 alt06,histall,iopio1,precision8 -restart gx3 32x1 alt07,histall,iopio1,precision8 -restart gx3 16x2 bgczm,histall,iopio1,precision8 -restart gx3 30x1 bgcskl,histall,iopio1 -restart gx3 8x4 isotope,histall,iopio1,precision8,cdf64 -restart gx3 12x2 fsd12,histall,iopio1,cdf64 -restart gx3 16x2 debug,histall,iopio1,precision8,cdf64,histinst +restart gx3 16x2x100x2x4 histall,iopio1,iopioopts +restart gx3 16x2 debug,histall,iopio1,iocdf2 +restart gx3 14x2 alt01,histall,iopio1,iocdf5 +restart gx3 32x1 alt02,histall,iopio1,iohdf5 +restart gx3 24x1 alt03,histall,iopio1,iopnetcdf1,precision8 +restart gx3 8x4 alt04,histall,iopio1,iopnetcdf2,precision8 +restart gx3 8x4 alt05,histall,iopio1,iopnetcdf5,precision8 +restart gx3 32x1 alt06,histall,iopio1,iocdf1 +restart gx3 32x1 alt07,histall,iopio1,iocdf2,precision8 +restart gx3 16x2 bgczm,histall,iopio1,iocdf5,precision8 +restart gx3 30x1 bgcskl,histall,iopio1,iohdf5,precision8 +restart gx3 8x4 isotope,histall,iopio1,iopnetcdf1 +restart gx3 12x2 fsd12,histall,iopio1,iopnetcdf2 +restart gx3 16x2 debug,histall,iopio1,iopnetcdf5,histinst -restart gx3 16x2 debug,histall,iopio2 -restart gx3 14x2 alt01,histall,iopio2,precision8,cdf64 -restart gx3 32x1 alt02,histall,iopio2,cdf64 -restart gx3 24x1 alt03,histall,iopio2,precision8 -restart gx3 8x4 alt04,histall,iopio2 -restart gx3 8x4 alt05,histall,iopio2,precision8,cdf64 -restart gx3 16x2 alt06,histall,iopio2,cdf64 -restart gx3 16x2 alt07,histall,iopio2,cdf64 -restart gx3 16x2 bgczm,histall,iopio2,cdf64 -restart gx3 30x1 bgcskl,histall,iopio2,precision8 -restart gx3 8x4 isotope,histall,iopio2 -restart gx3 12x2 fsd12,histall,iopio2,precision8,cdf64 -restart gx3 16x2 debug,histall,iopio2,histinst - -restart gx3 16x2 debug,histall,iopio1p,precision8 -restart gx3 14x2 alt01,histall,iopio1p -restart gx3 32x1 alt02,histall,iopio1p,precision8,cdf64 -restart gx3 24x1 alt03,histall,iopio1p,cdf64 -restart gx3 8x4 alt04,histall,iopio1p,precision8 -restart gx3 8x4 alt05,histall,iopio1p -restart gx3 6x4 alt06,histall,iopio1p,precision8,cdf64 -restart gx3 6x4 alt07,histall,iopio1p,precision8,cdf64 -restart gx3 16x2 bgczm,histall,iopio1p,precision8,cdf64 -restart gx3 30x1 bgcskl,histall,iopio1p,cdf64 -restart gx3 8x4 isotope,histall,iopio1p,precision8 -restart gx3 12x2 fsd12,histall,iopio1p -restart gx3 16x2 debug,histall,iopio1p,precision8,histinst - -restart gx3 16x2 debug,histall,iopio2p,cdf64 -restart gx3 14x2 alt01,histall,iopio2p,precision8 -restart gx3 32x1 alt02,histall,iopio2p -restart gx3 24x1 alt03,histall,iopio2p,precision8,cdf64 -restart gx3 8x4 alt04,histall,iopio2p,cdf64 -restart gx3 8x4 alt05,histall,iopio2p,precision8 -restart gx3 24x1 alt06,histall,iopio2p -restart gx3 24x1 alt07,histall,iopio2p -restart gx3 16x2 bgczm,histall,iopio2p -restart gx3 30x1 bgcskl,histall,iopio2p,precision8,cdf64 -restart gx3 8x4 isotope,histall,iopio2p,cdf64 -restart gx3 12x2 fsd12,histall,iopio2p,precision8 -restart gx3 16x2 debug,histall,iopio2p,cdf64,histinst +restart gx3 16x2x100x2x4 debug,histall,iopio2,iopioopts,run5day +restart gx3 16x2 debug,histall,iopio2,iopnetcdf1,precision8 +restart gx3 14x2 alt01,histall,iopio2,iopnetcdf2,precision8 +restart gx3 32x1 alt02,histall,iopio2,iopnetcdf5,precision8 +restart gx3 24x1 alt03,histall,iopio2,iocdf1 +restart gx3 8x4 alt04,histall,iopio2,iocdf2 +restart gx3 8x4 alt05,histall,iopio2,iocdf5 +restart gx3 16x2 alt06,histall,iopio2,iohdf5,iohdf5opts +restart gx3 16x2 alt07,histall,iopio2,iopnetcdf1 +restart gx3 16x2 bgczm,histall,iopio2,iopnetcdf2 +restart gx3 30x1 bgcskl,histall,iopio2,iopnetcdf5 +restart gx3 8x4 isotope,histall,iopio2,iohdf5,precision8 +restart gx3 12x2 fsd12,histall,iopio2,iocdf1,precision8 +restart gx3 16x2 debug,histall,iopio2,iocdf2,histinst,precision8 diff --git a/doc/source/cice_index.rst b/doc/source/cice_index.rst index dae10eda4..6b97d2b8f 100644 --- a/doc/source/cice_index.rst +++ b/doc/source/cice_index.rst @@ -320,10 +320,16 @@ section :ref:`tabnamelist`. "histfreq", "units of history output frequency: y, m, w, d or 1", "m,x,x,x,x" "histfreq_base", "reference date for history output, zero or init", "" "histfreq_n", "integer output frequency in histfreq units", "1,1,1,1,1" + "history_chunksize", "history chunksizes in x,y directions (_format='hdf5' only)", "0,0" + "history_deflate", "compression level for history (_format='hdf5' only)", "0" "history_dir", "path to history output files", "" "history_file", "history output file prefix", "" "history_format", "history file format", "" + "history_iotasks", "history output total number of tasks used", "" "history_precision", "history output precision: 4 or 8 byte", "4" + "history_rearranger", "history output io rearranger method", "" + "history_root", "history output io root task id", "" + "history_stride", "history output io task stride", "" "hist_time_axis", "history file time axis interval location: begin, middle, end", "end" "hist_suffix", "suffix to `history_file` in filename. x means no suffix", "x,x,x,x,x" "hm", "land/boundary mask, thickness (T-cell)", "" @@ -577,9 +583,15 @@ section :ref:`tabnamelist`. "restart", "if true, initialize ice state from file", "T" "restart_age", "if true, read age restart file", "" "restart_bgc", "if true, read bgc restart file", "" + "restart_chunksize", "restart chunksizes in x,y directions (_format='hdf5' only)", "0,0" + "restart_deflate", "compression level for restart (_format='hdf5' only)", "0" "restart_dir", "path to restart/dump files", "" "restart_file", "restart file prefix", "" "restart_format", "restart file format", "" + "restart_iotasks", "restart output total number of tasks used", "" + "restart_rearranger", "restart output io rearranger method", "" + "restart_root", "restart output io root task id", "" + "restart_stride", "restart output io task stride", "" "restart_[tracer]", "if true, read tracer restart file", "" "restart_ext", "if true, read/write halo cells in restart file", "" "restart_coszen", "if true, read/write coszen in restart file", "" @@ -745,6 +757,7 @@ section :ref:`tabnamelist`. "visc_method", "method for calculating viscosities (‘avg_strength’ or ‘avg_zeta’)", "avg_zeta" "vocn", "ocean current in the y-direction", "m/s" "vonkar", "von Karman constant", "0.4" + "vort", "vorticity", "1/s" "vraftn", "volume of rafted ice", "m" "vrdgn", "volume of ridged ice", "m" "vredistrn", "redistribution function: fraction of new ridge volume", "" diff --git a/doc/source/developer_guide/dg_about.rst b/doc/source/developer_guide/dg_about.rst index 95645d45d..642d08b93 100644 --- a/doc/source/developer_guide/dg_about.rst +++ b/doc/source/developer_guide/dg_about.rst @@ -53,13 +53,13 @@ Overall, CICE code should be implemented as follows, Any public module interfaces or data should be explicitly specified - * All subroutines and functions should define the subname character parameter statement to match the interface name like + * All subroutines and functions should define the ``subname`` character parameter statement to match the interface name like .. code-block:: fortran character(len=*),parameter :: subname='(advance_timestep)' - * Public Icepack interfaces should be accessed thru the icepack_intfc module like + * Public Icepack interfaces should be accessed thru the ``icepack_intfc`` module like .. code-block:: fortran @@ -73,5 +73,11 @@ Overall, CICE code should be implemented as follows, call icepack_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call abort_ice(error_message=subname, file=__FILE__, line=__LINE__) + * Use ``ice_check_nc`` or ``ice_pio_check`` after netcdf or pio calls to check for return errors. + + * Use subroutine ``abort_ice`` to abort the model run. Do not use stop or MPI_ABORT. Use optional arguments (file=__FILE__, line=__LINE__) in calls to ``abort_ice`` to improve debugging + + * Write output to stdout from the master task only unless the output is associated with an abort call. Write to unit ``nu_diag`` following the current standard. Do not use units 5 or 6. Do not use the print statement. + * Use of new Fortran features or external libraries need to be balanced against usability and the desire to compile on as many machines and compilers as possible. Developers are encouraged to contact the Consortium as early as possible to discuss requirements and implementation in this case. diff --git a/doc/source/developer_guide/dg_infra.rst b/doc/source/developer_guide/dg_infra.rst index c38e2c16d..7b7fb907a 100644 --- a/doc/source/developer_guide/dg_infra.rst +++ b/doc/source/developer_guide/dg_infra.rst @@ -40,7 +40,7 @@ Time manager data is module data in **cicecore/shared/ice_calendar.F90**. Much data is public and operated on during the model timestepping. The model timestepping actually takes place in the **CICE_RunMod.F90** file which is part of the driver code. -The time manager was updated in early 2021. Additional information about the time manager can be found here, :ref:`timemanagerplus` +The time manager was updated in early 2021. Additional information about the time manager can be found here, :ref:`timemanagerplus`. @@ -82,3 +82,5 @@ is a parallel io library (https://github.com/NCAR/ParallelIO) that supports read binary and netcdf file through various interfaces including netcdf and pnetcdf. pio is generally more parallel in memory even when using serial netcdf than the standard gather/scatter methods, and it provides parallel read/write capabilities by optionally linking and using pnetcdf. + +There is additional IO information in :ref:`modelio`. diff --git a/doc/source/user_guide/ug_case_settings.rst b/doc/source/user_guide/ug_case_settings.rst index fd808fd8f..b8bde525d 100644 --- a/doc/source/user_guide/ug_case_settings.rst +++ b/doc/source/user_guide/ug_case_settings.rst @@ -37,7 +37,8 @@ can be found in :ref:`cicecpps`. The following CPPs are available. "NO_I8", "Converts integer*8 to integer*4. This could have adverse affects for certain algorithms including the ddpdd implementation associated with the ``bfbflag``" "NO_R16", "Converts real*16 to real*8. This could have adverse affects for certain algorithms including the lsum16 implementation associated with the ``bfbflag``" "NO_SNICARHC", "Does not compile hardcoded (HC) 5 band snicar tables tables needed by ``shortwave=dEdd_snicar_ad``. May reduce compile time." - "USE_NETCDF", "Turns on netcdf code. This is normally on and is needed for released configurations. An older value, ncdf, is still supported" + "USE_NETCDF", "Turns on netCDF code. This is normally on and is needed for released configurations. An older value, ncdf, is still supported." + "USE_PIO1", "Modifies CICE PIO implementation to be compatible with PIO1. By default, code is compatible with PIO2" "","" "**Application Macros**", "" "CESMCOUPLED", "Turns on code changes for the CESM coupled application " @@ -80,14 +81,16 @@ can be modified as needed. "ICE_LOGDIR", "string", "log directory", "${ICE_CASEDIR}/logs" "ICE_DRVOPT", "string", "unused", "standalone/cice" "ICE_TARGET", "string", "build target", "set by cice.setup" - "ICE_IOTYPE", "string", "I/O format", "set by cice.setup" - " ", "netcdf", "serial netCDF" - " ", "none", "netCDF library is not available" - " ", "pio", "parallel netCDF" + "ICE_IOTYPE", "string", "I/O source code", "set by cice.setup" + " ", "binary", "uses io_binary directory, no support for netCDF files" + " ", "netcdf", "uses io_netCDF directory, supports netCDF files" + " ", "pio1", "uses io_pio directory with PIO1 library, supports netCDF and parallel netCDF thru PIO interfaces" + " ", "pio2", "uses io_pio directory with PIO2 library, supports netCDF and parallel netCDF thru PIO interfaces" "ICE_CLEANBUILD", "true, false", "automatically clean before building", "true" "ICE_CPPDEFS", "user defined preprocessor macros for build", "null" "ICE_QUIETMODE", "true, false", "reduce build output to the screen", "false" "ICE_GRID", "string (see below)", "grid", "set by cice.setup" + " ", "gbox12", "12x12 box", " " " ", "gbox80", "80x80 box", " " " ", "gbox128", "128x128 box", " " " ", "gbox180", "180x180 box", " " @@ -193,11 +196,28 @@ setup_nml "``histfreq_base``", "init", "history output frequency relative to year_init, month_init, day_init", "'zero','zero','zero','zero','zero'" "", "zero", "history output frequency relative to year-month-day of 0000-01-01", "" "``histfreq_n``", "integer array", "frequency history output is written with ``histfreq``", "1,1,1,1,1" + "``history_chunksize``", "integer array", "chunksizes (x,y) for history output (hdf5 only)", "0,0" + "``history_deflate``", "integer", "compression level (0 to 9) for history output (hdf5 only)", "0" "``history_dir``", "string", "path to history output directory", "'./'" "``history_file``", "string", "output file for history", "'iceh'" - "``history_format``", "``default``", "read/write history files in default format", "``default``" - "", "``pio_pnetcdf``", "read/write restart files with pnetcdf in pio", "" + "``history_format``", "``binary``", "write history files with binary format", "``cdf1``" + "", "``cdf1``", "write history files with netcdf cdf1 (netcdf3-classic) format", "" + "", "``cdf2``", "write history files with netcdf cdf2 (netcdf3-64bit-offset) format", "" + "", "``cdf5``", "write history files with netcdf cdf5 (netcdf3-64bit-data) format", "" + "", "``default``", "write history files in default format", "" + "", "``hdf5``", "write history files with netcdf hdf5 (netcdf4) format", "" + "", "``pio_pnetcdf``", "write history files with pnetcdf in PIO, deprecated", "" + "", "``pio_netcdf``", "write history files with netcdf in PIO, deprecated", "" + "", "``pnetcdf1``", "write history files with pnetcdf cdf1 (netcdf3-classic) format", "" + "", "``pnetcdf2``", "write history files with pnetcdf cdf2 (netcdf3-64bit-offset) format", "" + "", "``pnetcdf5``", "write history files with pnetcdf cdf5 (netcdf3-64bit-data) format", "" + "``history_iotasks``", "integer", "pe io tasks for history output with history_root and history_stride (PIO only), -99=internal default", "-99" "``history_precision``", "integer", "history file precision: 4 or 8 byte", "4" + "``history_rearranger``", "box", "box io rearranger option for history output (PIO only)", "default" + "", "default", "internal default io rearranger option for history output", "" + "", "subset", "subset io rearranger option for history output", "" + "``history_root``", "integer", "pe root task for history output with history_iotasks and history_stride (PIO only), -99=internal default", "-99" + "``history_stride``", "integer", "pe stride for history output with history_iotasks and history_root (PIO only), -99=internal default", "-99" "``hist_suffix``", "character array", "appended to history_file when not x", "``x,x,x,x,x``" "``hist_time_axis``","character","history file time axis interval location: begin, middle, end","end" "``ice_ic``", "``default``", "equal to internal", "``default``" @@ -208,7 +228,7 @@ setup_nml "``incond_file``", "string", "output file prefix for initial condition", "‘iceh_ic’" "``istep0``", "integer", "initial time step number", "0" "``latpnt``", "real", "latitude of (2) diagnostic points", "90.0,-65.0" - "``lcdf64``", "logical", "use 64-bit netcdf format", "``.false.``" + "``lcdf64``", "logical", "use 64-bit netCDF format, deprecated, see history_format, restart_format", "``.false.``" "``lonpnt``", "real", "longitude of (2) diagnostic points", "0.0,-45.0" "``memory_stats``", "logical", "turns on memory use diagnostics", "``.false.``" "``month_init``", "integer", "the initial month if not using restart", "1" @@ -226,11 +246,28 @@ setup_nml "``print_global``", "logical", "print global sums diagnostic data", "``.true.``" "``print_points``", "logical", "print diagnostic data for two grid points", "``.false.``" "``restart``", "logical", "exists but deprecated, now set internally based on other inputs", "" + "``restart_chunksize``", "integer array", "chunksizes (x,y) for restart output (hdf5 only)", "0,0" + "``restart_deflate``", "integer", "compression level (0 to 9) for restart output (hdf5 only)", "0" "``restart_dir``", "string", "path to restart directory", "'./'" "``restart_ext``", "logical", "read/write halo cells in restart files", "``.false.``" "``restart_file``", "string", "output file prefix for restart dump", "'iced'" - "``restart_format``", "``default``", "read/write restart file with default format", "``default``" - "", "``pio_pnetcdf``", "read/write restart files with pnetcdf in pio", "" + "``restart_format``", "``binary``", "write restart files with binary format", "``cdf1``" + "", "``cdf1``", "write restart files with netcdf cdf1 (netcdf3-classic) format", "" + "", "``cdf2``", "write restart files with netcdf cdf2 (netcdf3-64bit-offset) format", "" + "", "``cdf5``", "write restart files with netcdf cdf5 (netcdf3-64bit-data) format", "" + "", "``default``", "write restart files in default format", "" + "", "``hdf5``", "write restart files with netcdf hdf5 (netcdf4) format", "" + "", "``pio_pnetcdf``", "write restart files with pnetcdf in PIO, deprecated", "" + "", "``pio_netcdf``", "write restart files with netcdf in PIO, deprecated", "" + "", "``pnetcdf1``", "write restart files with pnetcdf cdf1 (netcdf3-classic) format", "" + "", "``pnetcdf2``", "write restart files with pnetcdf cdf2 (netcdf3-64bit-offset) format", "" + "", "``pnetcdf5``", "write restart files with pnetcdf cdf5 (netcdf3-64bit-data) format", "" + "``restart_iotasks``", "integer", "pe io tasks for restart output with restart_root and restart_stride (PIO only), -99=internal default", "-99" + "``restart_rearranger``", "box", "box io rearranger option for restart output (PIO only)", "default" + "", "default", "internal default io rearranger option for restart output", "" + "", "subset", "subset io rearranger option for restart output", "" + "``restart_root``", "integer", "pe root task for restart output with restart_iotasks and restart_stride (PIO only), -99=internal default", "-99" + "``restart_stride``", "integer", "pe stride for restart output with restart_iotasks and restart_root (PIO only), -99=internal default", "-99" "``runid``", "string", "label for run (currently CESM only)", "'unknown'" "``runtype``", "``continue``", "restart using ``pointer_file``", "``initial``" "", "``initial``", "start from ``ice_ic``", "" @@ -616,7 +653,7 @@ forcing_nml "", "``nc``", "read netcdf atmo forcing files", "" "``atm_data_type``", "``box2001``", "forcing data for :cite:`Hunke01` box problem", "``default``" "", "``default``", "constant values defined in the code", "" - "", "``hycom``", "HYCOM atm forcing data in netcdf format", "" + "", "``hycom``", "HYCOM atm forcing data in netCDF format", "" "", "``JRA55``", "JRA55 forcing data :cite:`Tsujino18`", "" "", "``JRA55do``", "JRA55do forcing data :cite:`Tsujino18`", "" "", "``monthly``", "monthly forcing data", "" @@ -626,7 +663,7 @@ forcing_nml "``bgc_data_dir``", "string", "path to oceanic forcing data directory", "'unknown_bgc_data_dir'" "``bgc_data_type``", "``clim``", "bgc climatological data", "``default``" "", "``default``", "constant values defined in the code", "" - "", "``hycom``", "HYCOM ocean forcing data in netcdf format", "" + "", "``hycom``", "HYCOM ocean forcing data in netCDF format", "" "", "``ncar``", "POP ocean forcing data", "" "``calc_strair``", "``.false.``", "read wind stress and speed from files", "``.true.``" "", "``.true.``", "calculate wind stress and speed", "" @@ -673,10 +710,10 @@ forcing_nml "``oceanmixed_ice``", "logical", "active ocean mixed layer calculation", "``.false.``" "``ocn_data_dir``", "string", "path to oceanic forcing data directory", "'unknown_ocn_data_dir'" "``ocn_data_format``", "``bin``", "read direct access binary ocean forcing files", "``bin``" - "", "``nc``", "read netcdf ocean forcing files", "" + "", "``nc``", "read netCDF ocean forcing files", "" "``ocn_data_type``", "``clim``", "ocean climatological data formulation", "``default``" "", "``default``", "constant values defined in the code", "" - "", "``hycom``", "HYCOM ocean forcing data in netcdf format", "" + "", "``hycom``", "HYCOM ocean forcing data in netCDF format", "" "", "``ncar``", "POP ocean forcing data", "" "``precip_units``", "``mks``", "liquid precipitation data units", "``mks``" "", "``mm_per_month``", "", "" diff --git a/doc/source/user_guide/ug_implementation.rst b/doc/source/user_guide/ug_implementation.rst index a67fc3a58..c243616d2 100644 --- a/doc/source/user_guide/ug_implementation.rst +++ b/doc/source/user_guide/ug_implementation.rst @@ -747,7 +747,7 @@ characteristics. In the ‘sectcart’ case, the domain is divided into four (east-west,north-south) quarters and the loops are done over each, sequentially. The ``wghtfile`` decomposition drives the decomposition based on -weights provided in a weight file. That file should be a netcdf +weights provided in a weight file. That file should be a netCDF file with a double real field called ``wght`` containing the relative weight of each gridcell. :ref:`fig-distrbB` (b) and (c) show an example. The weights associated with each gridcell will be @@ -1136,11 +1136,89 @@ relaxation parameter ``arlx1i`` effectively sets the damping timescale in the problem, and ``brlx`` represents the effective subcycling :cite:`Bouillon13` (see Section :ref:`revp`). -~~~~~~~~~~~~ -Model output -~~~~~~~~~~~~ +.. _modelio: -There are a number of model output streams and formats. +~~~~~~~~~~~~~~~~~~~~~~~~ +Model Input and Output +~~~~~~~~~~~~~~~~~~~~~~~~ + +.. _iooverview: + +************* +IO Overview +************* + +CICE provides the ability to read and write binary unformatted or netCDF +data via a number of different methods. The IO implementation is specified +both at build-time (via selection of specific source code) and run-time (via namelist). +Three different IO packages are available in CICE under the directory +**cicecore/cicedyn/infrastructure/io**. Those are io_binary, io_netcdf, and +io_pio2, and those support IO thru binary, netCDF (https://www.unidata.ucar.edu/software/netcdf), +and PIO (https://github.com/NCAR/ParallelIO) interfaces respectively. +The io_pio2 directory supports both PIO1 and PIO2 and can write data thru the +netCDF or parallel netCDF (pnetCDF) interface. The netCDF history files are CF-compliant, and +header information for data contained in the netCDF files is displayed with +the command ``ncdump -h filename.nc``. To select the io source code, set ``ICE_IOTYPE`` +in **cice.settings** to ``binary``, ``netcdf``, ``pio1``, or ``pio2``. + +At run-time, more detailed IO settings are available. ``restart_format`` and +``history_format`` namelist options specify the method and format further. Valid options +are listed in :ref:`formats`. These options specify the format of new files created +by CICE. Existing files can be read in any format as long as it's consistent +with ``ICE_IOTYPE`` defined. Note that with ``ICE_IOTYPE = binary``, the format name +is actually ignored. The CICE netCDF output contains a global metadata attribute, ``io_flavor``, +that indicates the format chosen for the file. ``ncdump -k filename.nc`` also +provides information about the specific netCDF file format. +In general, the detailed format is not enforced for input files, so any netCDF format +can be read in CICE regardless of CICE namelist settings. + +.. _formats: + +.. table:: CICE IO formats + + +--------------+----------------------+-------------+---------------------+ + | **Namelist** | **Format** | **Written** | **Valid With** | + | **Option** | | **Thru** | **ICE_IOTYPE** | + +--------------+----------------------+-------------+---------------------+ + | binary | Fortran binary | fortran | binary | + +--------------+----------------------+-------------+---------------------+ + | cdf1 | netCDF3-classic | netCDF | netcdf, pio1, pio2 | + +--------------+----------------------+-------------+---------------------+ + | cdf2 | netCDF3-64bit-offset | netCDF | netcdf, pio1, pio2 | + +--------------+----------------------+-------------+---------------------+ + | cdf5 | netCDF3-64bit-data | netCDF | netcdf, pio1, pio2 | + +--------------+----------------------+-------------+---------------------+ + | default | binary or cdf1, | varies | binary, netcdf, | + | | depends on ICE_IOTYPE| | pio1, pio2 | + +--------------+----------------------+-------------+---------------------+ + | hdf5 | netCDF4 hdf5 | netCDF | netcdf, pio1, pio2 | + +--------------+----------------------+-------------+---------------------+ + | pnetcdf1 | netCDF3-classic | pnetCDF | pio1, pio2 | + +--------------+----------------------+-------------+---------------------+ + | pnetcdf2 | netCDF3-64bit-offset | pnetCDF | pio1, pio2 | + +--------------+----------------------+-------------+---------------------+ + | pnetcdf5 | netCDF3-64bit-data | pnetCDF | pio1, pio2 | + +--------------+----------------------+-------------+---------------------+ + +There are additional namelist options that affect PIO performance for both +restart and history output. [``history_,restart_``] +[``iotasks,root,stride``] +namelist options control the PIO processor/task usage and specify the total number of +IO tasks, the root IO task, and the IO task stride respectively. +``history_rearranger`` and ``restart_rearranger`` +define the PIO rearranger strategy. Finally, [``history_,restart_``] +[``deflate,chunksize``] provide +controls for hdf5 compression and chunking for the ``hdf5`` options +in both netCDF and PIO output. ``hdf5`` is written serially thru the +netCDF library and in parallel thru the PIO library in CICE. Additional +details about the netCDF and PIO settings and implementations can +found in (https://www.unidata.ucar.edu/software/netcdf) +and (https://github.com/NCAR/ParallelIO). + +netCDF requires CICE compilation with a netCDF library built externally. +PIO requires CICE compilation with a PIO and netCDF library built externally. +Both netCDF and PIO can be built with many options which may require additional libraries +such as MPI, hdf5, or pnetCDF. .. _history: @@ -1148,16 +1226,13 @@ There are a number of model output streams and formats. History files ************* -CICE provides history data in binary unformatted or netCDF formats via -separate implementations of binary, netcdf, and pio source code under the -directory **infrastructure/io**. ``ICE_IOTYPE`` defined in cice.settings -specifies the IO type and defines which source code directory is compiled. -At the present time, binary, netcdf, and PIO are exclusive formats -for history and restart files, and history and restart file must use the same -io package. The namelist variable ``history_format`` further refines the -format approach or style for some io packages. +CICE provides history data output in binary unformatted or netCDF formats via +separate implementations of binary, netCDF, and PIO interfaces as described +above. In addition, ``history_format`` as well as other history namelist +options control the specific file format as well as features related to +IO performance, see :ref:`iooverview`. -Model output data can be written as instantaneous or average data as specified +CICE Model history output data can be written as instantaneous or average data as specified by the ``hist_avg`` namelist array and is customizable by stream. Characters can be added to the ``history_filename`` to distinguish the streams. This can be changed by modifying ``hist_suffix`` to something other than "x". @@ -1169,12 +1244,7 @@ in **ice_in**. These settings for history files are set in the **setup_nml** section of **ice_in** (see :ref:`tabnamelist`). If ``history_file`` = ‘iceh’ then the filenames will have the form **iceh.[timeID].nc** or **iceh.[timeID].da**, -depending on the output file format chosen in **cice.settings** (set -``ICE_IOTYPE``). The netCDF history files are CF-compliant; header information for -data contained in the netCDF files is displayed with the command ``ncdump -h -filename.nc``. Parallel netCDF output is available using the PIO library; the -output file attribute ``io_flavor`` distinguishes output files written with PIO from -those written with standard netCDF. With binary files, a separate header +depending on the output file format chosen. With binary files, a separate header file is written with equivalent information. Standard fields are output according to settings in the **icefields\_nml** section of **ice\_in** (see :ref:`tabnamelist`). @@ -1404,18 +1474,16 @@ The timers use *MPI\_WTIME* for parallel runs and the F90 intrinsic Restart files ************* -CICE provides restart data in binary unformatted or netCDF formats via -separate implementations of binary, netcdf, and pio source code under the -directory **infrastructure/io**. ``ICE_IOTYPE`` defined in cice.settings -specifies the IO type and defines which source code directory is compiled. -At the present time, binary, netcdf, and PIO are exclusive formats -for history and restart files, and history and restart file must use the same -io package. The namelist variable ``restart_format`` further refines the -format approach or style for some io packages. +CICE reads and writes restart data in binary unformatted or netCDF formats via +separate implementations of binary, netCDF, and PIO interfaces as described +above. In addition, ``restart_format`` as well as other restart namelist +options control the specific file format as well as features related to +IO performance, see :ref:`iooverview`. The restart files created by CICE contain all of the variables needed for a full, exact restart. The filename begins with the character string -‘iced.’, and the restart dump frequency is given by the namelist +defined by the ``restart_file`` namelist input, and the restart dump frequency +is given by the namelist variables ``dumpfreq`` and ``dumpfreq_n`` relative to a reference date specified by ``dumpfreq_base``. Multiple restart frequencies are supported in the code with a similar mechanism to history streams. The pointer to the filename from diff --git a/doc/source/user_guide/ug_running.rst b/doc/source/user_guide/ug_running.rst index 3f3cd3495..9337b3c47 100644 --- a/doc/source/user_guide/ug_running.rst +++ b/doc/source/user_guide/ug_running.rst @@ -16,59 +16,88 @@ To run stand-alone, CICE requires - bash and csh - gmake (GNU Make) -- Fortran and C compilers (Intel, PGI, GNU, Cray, and NAG have been tested) -- NetCDF (this is actually optional but required to test out of the box configurations) -- MPI (this is actually optional but without it you can only run on 1 processor) +- Fortran and C compilers (Intel, PGI, GNU, Cray, NVHPC, AOCC, and NAG have been tested) +- NetCDF (optional, but required to test standard configurations that have netCDF grid, input, and forcing files) +- MPI (optional, but required for running on more than 1 processor) +- PIO (optional, but required for running with PIO I/O interfaces) Below are lists of software versions that the Consortium has tested at some point. There is no guarantee that all compiler versions work with all CICE model versions. At any given point, the Consortium is regularly testing on several different compilers, but not -necessarily on all possible versions or combinations. A CICE goal is to be relatively portable +necessarily on all possible versions or combinations. CICE supports both PIO1 and PIO2. To +use PIO1, the ``USE_PIO1`` macro should also be set. A CICE goal is to be relatively portable across different hardware, compilers, and other software. As a result, the coding implementation tends to be on the conservative side at times. If there are problems porting to a particular system, please let the Consortium know. The Consortium has tested the following compilers at some point, -- Intel 15.0.3.187 -- Intel 16.0.1.150 -- Intel 17.0.1.132 -- Intel 17.0.2.174 -- Intel 17.0.5.239 -- Intel 18.0.1.163 -- Intel 18.0.5 -- Intel 19.0.2 -- Intel 19.0.3.199 -- Intel 19.1.0.166 -- Intel 19.1.1.217 +- AOCC 3.0.0 +- Intel ifort 15.0.3.187 +- Intel ifort 16.0.1.150 +- Intel ifort 17.0.1.132 +- Intel ifort 17.0.2.174 +- Intel ifort 17.0.5.239 +- Intel ifort 18.0.1.163 +- Intel ifort 18.0.5 +- Intel ifort 19.0.2 +- Intel ifort 19.0.3.199 +- Intel ifort 19.1.0.166 +- Intel ifort 19.1.1.217 +- Intel ifort 19.1.2.254 +- Intel ifort 2021.4.0 +- Intel ifort 2021.6.0 +- Intel ifort 2021.8.0 +- Intel ifort 2021.9.0 +- Intel ifort 2022.2.1 - PGI 16.10.0 - PGI 19.9-0 - PGI 20.1-0 +- PGI 20.4-0 - GNU 6.3.0 - GNU 7.2.0 - GNU 7.3.0 +- GNU 7.7.0 - GNU 8.3.0 - GNU 9.3.0 -- Cray 8.5.8 -- Cray 8.6.4 +- GNU 10.1.0 +- GNU 11.2.0 +- GNU 12.1.0 +- GNU 12.2.0 +- Cray CCE 8.5.8 +- Cray CCE 8.6.4 +- Cray CCE 13.0.2 +- Cray CCE 14.0.3 +- Cray CCE 15.0.1 - NAG 6.2 +- NVC 23.5-0 -The Consortium has tested the following mpi versions, +The Consortium has tested the following MPI implementations and versions, - MPICH 7.3.2 - MPICH 7.5.3 - MPICH 7.6.2 - MPICH 7.6.3 +- MPICH 7.7.0 - MPICH 7.7.6 +- MPICH 7.7.7 +- MPICH 7.7.19 +- MPICH 7.7.20 +- MPICH 8.1.14 +- MPICH 8.1.21 +- MPICH 8.1.25 - Intel MPI 18.0.1 - Intel MPI 18.0.4 - Intel MPI 2019 Update 6 +- Intel MPI 2019 Update 8 - MPT 2.14 - MPT 2.17 - MPT 2.18 - MPT 2.19 - MPT 2.20 - MPT 2.21 +- MPT 2.22 +- MPT 2.25 - mvapich2-2.3.3 - OpenMPI 1.6.5 - OpenMPI 4.0.2 @@ -79,6 +108,7 @@ The NetCDF implementation is relatively general and should work with any version - NetCDF 4.3.2 - NetCDF 4.4.0 - NetCDF 4.4.1.1.3 +- NetCDF 4.4.1.1.6 - NetCDF 4.4.1.1 - NetCDF 4.4.2 - NetCDF 4.5.0 @@ -88,6 +118,23 @@ The NetCDF implementation is relatively general and should work with any version - NetCDF 4.6.3.2 - NetCDF 4.7.2 - NetCDF 4.7.4 +- NetCDF 4.8.1 +- NetCDF 4.8.1.1 +- NetCDF 4.8.1.3 +- NetCDF 4.9.0.1 +- NetCDF 4.9.0.3 +- NetCDF 4.9.2 + +CICE has been tested with + +- PIO 1.10.1 +- PIO 2.5.4 +- PIO 2.5.9 +- PIO 2.6.0 +- PIO 2.6.1 +- PnetCDF 1.12.2 +- PnetCDF 1.12.3 +- PnetCDF 2.6.2 Please email the Consortium if this list can be extended. diff --git a/doc/source/user_guide/ug_testing.rst b/doc/source/user_guide/ug_testing.rst index e382eba17..6867214b5 100644 --- a/doc/source/user_guide/ug_testing.rst +++ b/doc/source/user_guide/ug_testing.rst @@ -1153,6 +1153,11 @@ Below is an example of a step-by-step procedure for testing a code change that m ./cice.setup -m onyx -e intel --suite base_suite --testid base0 --bgen cice.my.baseline + # Check the results + + cd testsuite.base0 + ./results.csh + # Run the test suite with the new code # git clone the new code