From b75b8a99c232c337aa779118124cb57813780658 Mon Sep 17 00:00:00 2001 From: Denise Worthen Date: Sun, 7 Apr 2024 10:31:26 -0400 Subject: [PATCH] Squashed commit of the following: MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit commit f36559256eb08272cdfe0706c45e0824e00fb37b Author: Denise Worthen Date: Sun Apr 7 09:50:39 2024 -0400 fix bad merge * this fixes a block of code w/in a CESMCOUPLED ifdef block commit cbac04dad1f79eb51900dab8bf6aaa7cddbe82a1 Merge: 5a56c38 7d4e5de Author: Denise Worthen Date: Wed Apr 3 16:05:31 2024 -0400 Merge branch 'emc/develop' into feature/pio_options commit 5a56c38a0d73bf16ddf2024a23f3f3fe4432007a Author: Denise Worthen Date: Wed Apr 3 15:44:33 2024 -0400 update with last emc/develop change commit aca835755aa82ead50040ea7e43ec63619667054 Author: Tony Craig Date: Thu Feb 22 08:55:44 2024 -0800 Update IO formats and add new IO namelist controls (#928) This provides new features for CICE IO both thru netCDF and PIO. New namelist are added to control history and restart format, hdf5 compression and chunking, the PIO rearranger, and PIO IO task control. Separate controls are provided for history and restart files. The namelist changes are for _history_format, restart_format history_rearranger, restart_rearranger history_iotasks, history_root, history_stride, restart_iotasks, restart_root, and restart_stride history_chunksize, history_deflate, restart_chunksize, restart_deflate._ In particular, - Update restart_format and history_format options to 'cdf1', 'cdf2', 'cdf5', 'hdf5', 'pnetcdf1', 'pnetcdf2', 'pnetcdf5', 'default'. The old options, 'default', 'pio_netcdf', and 'pio_pnetcdf' are still supported and backwards compatible with lcdf64, but are deprecated and no longer documented. The old options and old namelist lcdf64 are covered by the new options. Support of the old options should be removed in the future. Note that some problems were discovered when opening files with hdf5 format but reading non-hdf5 files with a spack built PIO/netCDF. As a result, the format specified for the restart read is always 'cdf1' which provides flexibility and robustness across software installs, although it may result in serial reads of hdf5 files when a parallel read could be done. - Deprecate lcdf64 namelist. This namelist is no longer needed and is covered by the new restart_format and history_format options. The namelist still exists and is backwards compatible with the old 'default', 'pio_netcdf', and 'pio_pnetcdf' format options, but is no longer documented. This should be removed in the future. - Add new namelist to control PIO pe/task setup (iotasks, root, stride) for history and restart. These settings control the PIO IO tasks. The root, stride, and iotasks are consistent with the MPI communicator. root=0 is the first MPI task. These control PIO IO performance and are usually a function of things like the IO and node hardware. See PIO for more information. CICE computes PIO iotask, root, and stride defaults for cases where -99 is passed in for some or all of these namelist. Those defaults are somewhat constrained by a bug in PIO, https://github.com/NCAR/ParallelIO/issues/1986. The current implementation avoids the bug by limiting the iotasks for some MPI task counts. This is noted in ice_pio.F90. - Add new namelist to control PIO rearranger (rearranger) for history and restart. Supports 'box', 'subset', and 'default'. These control how PIO rearrangment is carried out. default is equivalent to box and the box generally performs better. See PIO for more information. - Add new namelist to support hdf5 compression and chunking (deflate, chunksize) for history and restart. The deflate controls file compression and is an integer between 0 and 9 where 0 means no compression and 9 is maximum compression. Generally, the higher the number, the slower the IO and the smaller the file, but the optimal setting depends on the contents of the file. Chunksize provides a performance control for the hdf5 parallel writes. It is a 2d array and is associated with the size of the piece of the array written by hdf5. hdf5 can be read and written in parallel, but that depends on how netCDF and PIO are built. Note that prior version of PIO, including PIO1, do not support the hdf5 compression and chunking thru the PIO interface. - Add new namelist settings (set_nml files) and update the io_suite to cover the new IO options. Remove old namelist settings associated with the deprecated format options and the lcdf64 namelist. These deprecated feature are no longer tested. - Update documentation to add new namelist and IO features. - Update the nuopc/cmeps driver code to support the new features. - Update the default ice_in to add the new namelist. - Update the derecho netcdf module to a version that supports hdf5. - Clean up some code formatting (indentation) --------- Co-authored-by: Anton Steketee commit 9e9e5b3fabd88c429c4632baa8235187129e2dd7 Author: Philippe Blain Date: Mon Feb 19 14:08:37 2024 -0500 ug_testing.rst: also mention checking the base suite results (#934) In the "End-To-End Testing Procedure" section of the user guide, we instruct users to run a base suite and a test suite, but only mention checking the results of the test suite. Also mention checking the results of the base suite first, to make sure everything passes before checking the test suite. Suggested-by: Jean-Francois Lemieux commit 095e62a9342df74261b90fcb7a20d2ecdae2c5bc Author: Tony Craig Date: Mon Feb 12 14:49:02 2024 -0800 Update PULL_REQUEST_TEMPLATE to request detailed information (#931) Update PULL_REQUEST_TEMPLATE to request detailed information about changes associated with the PR. This will be useful for the commit log when squash merging the PR. --------- Co-authored-by: Philippe Blain commit 1a00e5e4e967c8429a7753ac3597f9c1476cf6b7 Author: David A. Bailey Date: Mon Feb 5 16:22:11 2024 -0700 Fix for ice_mesh_mod with grid variables removed (#929) commit 7a4b95e6deec0ec72c1da35a23ae1eb3ffe3d077 Author: Tony Craig Date: Mon Jan 22 11:12:13 2024 -0800 Update pio and netcdf error checks (#927) Update pio and netcdf error checks --------- Co-authored-by: anton-climate Co-authored-by: Anton Steketee <79179784+anton-seaice@users.noreply.github.com> commit 6449f40c41aa1a5c00096696202d7bd7ebd2a69a Author: JFLemieux73 <31927797+JFLemieux73@users.noreply.github.com> Date: Thu Jan 11 19:17:20 2024 +0000 Add vorticity as a diagnostic output (#924) * Added new variable vort for vorticity output * Added calc of diag vorticity for evp, vp and eap for B, C and CD grids * updated doc and ice_in file for new vorticity variable * Changed output frequency of vorticity from m to x * Added f_vort to set_nml.histall and set_nml.histdbg * Specified location of divu, shear and vort in ice_history.F90 --------- Co-authored-by: Tony Craig commit a20bfddf7a1260dbb61241e0838c678d2eecf972 Author: David A. Bailey Date: Thu Jan 11 11:07:36 2024 -0700 scamn bugfix for nuopc driver (#926) Co-authored-by: John Truesdale commit 1314e17b4213c6ce9424eab80763edf4b2ae867f Author: TRasmussen <33480590+TillRasmussen@users.noreply.github.com> Date: Thu Jan 11 18:25:52 2024 +0100 First round of housekeeping on ice_grid (#921) * removal of unused variables. * moved xav to transport. Could remove commented code. Could remove xav and yav as they are zero * Move derived parameters and only allocate if needed * bugfixes for cxp, cyp... * fix index and remove commented code in ice_grid * new version of transport_remap. xav, yav array where needed. xxav, yyav parameter * Removed comments rom ice_transport_remap and arrays for nonuniform grids commit 37f9a98b1b6529bc957fb888bd00348ab61c8b32 Author: Tony Craig Date: Thu Dec 21 07:15:02 2023 -0800 Fix single channel debug failure, Update github actions testing (#922) * update ghactions testing * refactor min/max global reductions, code away from huge which was giving MPI some problems. commit b14cedfaed8b81500fc5422cfc44b6d80e5893ef Author: David A. Bailey Date: Tue Nov 28 15:10:16 2023 -0700 ice_history: allow per-stream suffix for history filenames (#912) * Add capability for h extension * Update documentation for hist_str * Change hist_str to hist_suffix * Change in default namelist * Update doc/source/cice_index.rst Co-authored-by: Philippe Blain * One more hist_str --------- Co-authored-by: Philippe Blain commit 21fab166fd2b8e903df366dbc1c518dabd08c23f Author: Tony Craig Date: Tue Nov 28 10:04:36 2023 -0800 Update Icepack to #f6ff8f7c4d4cb6f (#913) * Update Icepack to #f6ff8f7c4d4cb6f Split the developer guide infrastructure section from the dynamics documentation Add a coding standard section to the documentation Add a couple sentences about the state of the parameter nghost to the documentation Update opticep to use the latest main code for the unit test * update documentation commit 509e2c33e95e3a2370dc406fb2fe4d06192420a6 Author: Philippe Blain Date: Thu Nov 23 13:09:04 2023 -0500 ice_history: refactor CMIP history variables (#906) * ice_flux: zero-initialize divu and shear in init_history_dyn 'divu' and 'shear' are accessed in 'accum_hist' when writing the initial condition before they are initialized at the start of {eap, evp, implicit_solver}. This leads to runtime error when compiling with NaN initialization. Zero-initialize 'divu' and 'shear' in init_history_dyn, where the related variable 'strength' is already zero-initialized. * ice_history_shared: disallow 'x' in history frequency variables f_*' In the current code, nothing prevents users from leaving 'x' along with active frequencies in the individual namelist history frequency variables, for example: f_aice = 'xmd' This configuration does not work correctly, however. The corresponding history fields are correctly defined in ice_history_shared::define_hist_field, but since the calls to ice_history_shared::accum_hist_field in ice_history::accum_hist are only done after checking that the first element of each frequency variable is not 'x', the corresponding variables in the history files are all zero. Prevent that behaviour by actually disallowing 'x' in history frequency variables if any other frequencies are active. To implement that, add a check in the loop in define_hist_field, which loops through vhistfreq, (corresponding to f_aice, etc. in ice_history). Since this subroutine initializes 'id(:)' to zero and then writes a (non-zero) index in 'id' for any active frequency, it suffices to check that all previous indices are non-zero. * ice_history: remove uneeded conditions around CMIP history variables In ice_history::accum_hist, after the calls to accum_hist, we loop on the different output streams, and on the history variables in the avail_hist_fields array, to mask out land points and convert units for each output variable. Since 3c99e106 (Update CICE with CMIP changes. (#191), 2018-09-27), we also use this loop to do a special treatment for some CMIP variables (namely, averaging them only for time steps where ice is present, and masking points where ice is absent). This adjustment is done if the corresponding output frequency variable (f_sithick, etc.) does not have 'x' as its first element, and if the corresponding index in avail_hist_field for that variable/frequency (n_sithick(ns)) is not zero. Both conditions are in fact uneeded since they are always true. The first condition is always true because if the variable is found in the avail_hist_field array, which is ensured by the condition on line 3645, then necessarily its corresponding namelist output frequency won't have 'x' as its first character (since this is enforced in ice_history_shared::define_hist_field). The second condition is always true because if the variable is found in the avail_hist_field array, then necessarily its index in that array, n_(ns), is non-zero (see ice_history_shared::define_hist_field). Remove these uneeded conditions. This commit is best viewed with git show --color-moved --color-moved-ws=allow-indentation-change * ice_history: use loop index directly for CMIP variables In ice_history::accum_hist, there is a special treatment for some CMIP variables where they are averaged only for time steps where ice is present, and points where there is no ice are masked. This is done on the loop on output streams (with loop index n). This special averaging is done by accessing a2D and a3Dc using the variable n_(ns), which corresponds to the index in the avail_hist_field array where this history variable/frequency is defined. By construction, this index correponds to the loop index 'n', for both the 2D and the 3D loops. Simplify the code by using 'n' directly. * ice_history_shared: add two logical components to ice_hist_field At the end of ice_history::accum_hist, we do a special processing for some CMIP variables: we average them only for time steps where ice is present, and also mask ice-free points. The code to do that is repeated for each variable to which it applies. In order to reduce code duplication, let's introduce two new logical components to our 'ice_hist_field' type, defaulting them to .false., and make them optional arguments in ice_history_shared::define_hist_field. This allows us to avoid defining them for each output variable. We'll set them for CMIP variables in a following commit. * ice_history: set avg_ice_present, mask_ice_free_points for relevant CMIP variables In the previous commit, we added two components to type ice_hist_field (avg_ice_present and mask_ice_free_points), relating to some special treatment for CMIP variables (whether to average only for time steps where the ice is present and to mask ice-free points). Set these to .true. in the call to 'define_hist_field' for the relevant 2D variables [1], and set only 'avg_ice_present' to .true. for the 3D variables siitdthick and siitdsnthick, corresponding to the code under the "Mask out land points and convert units" loop in ice_history::accum_hist. [1] sithick siage sisnthick sitemptop sitempsnic sitempbot siu siv sidmasstranx sistrxdtop sistrydtop sistrxubot sistryubot sicompstren sispeed sidir sialb sihc siflswdtop siflswutop siflswdbot sifllwdtop sifllwutop siflsenstop siflsensupbot sifllatstop siflcondtop siflcondbot sipr sifb siflsaltbot siflfwbot siflfwdrain sidragtop sirdgthick siforcetiltx siforcetilty siforcecoriolx siforcecorioly siforceintstrx siforceintstry * ice_history: use avg_ice_present, mask_ice_free_points to reduce duplication Some CMIP variables are processed differently in ice_history::accum_hist: they are averaged only for time steps when ice is present, and points where ice is absent are masked. This processing is repeated for each of these variables in the 2D and 3Dc loops. To reduce code duplication, use the new components avg_ice_present and mask_ice_free_points of ice_hist_field to perform this processing only for variables that were defined accordingly. The relevant variables already have those components defined as of the previous commit. Note that we still need a separate loop for the variable 'sialb' (sea ice albedo) to mask points below the horizon. commit 1cf109b7c350f119e8e3cd8bd918fa31e61d829c Author: David A. Bailey Date: Mon Nov 20 14:03:59 2023 -0700 Change to dealloc_grid in CICE_InitMod.F90 (#911) commit d14bb694f2f8df4e74361a9df999e82eaa44fc8b Author: Mads Hvid Ribergaard <38077893+mhrib@users.noreply.github.com> Date: Fri Nov 17 16:39:01 2023 +0100 Add missing logical "timer_stats" (#910) Co-authored-by: Mads Hvid Ribergaard commit 8573ba8ab196c1e357a101462b16bd92128461b1 Author: TRasmussen <33480590+TillRasmussen@users.noreply.github.com> Date: Thu Nov 16 22:12:07 2023 +0100 New 1d evp solver (#895) * New 1d evp solver * Small changes incl timer names and inclued private/publice in ice_dyn_core1d * fixed bug on gnu debug * moved halo update to evp1d, added deallocation, fixed bug * fixed deallocation dyn_evp1d * bugfix deallocate * Remove gather strintx and strinty * removed 4 test with evp1d and c/cd grid * Update of evp1d implementation - Rename halo_HTE_HTN to global_ext_halo and move into ice_grid.F90 - Generalize global_ext_halo to work with any nghost size (was hardcoded for nghost=1) - Remove argument from dyn_evp1d_init, change to "use" of global grid variables - rename pgl_global_ext to save_ghte_ghtn - Update allocation of G_HTE, G_HTN - Add dealloc_grid to deallocate G_HTE and G_HTN at end of initialization - Add calls to dealloc_grid to all CICE_InitMod.F90 subroutines - Make dimension of evp1d arguments implicit size more consistently - Clean up indentation and formatting a bit * Clean up trailing blanks * resolved name conflicts * 1d grid var name change --------- Co-authored-by: apcraig commit 5d09123865b5e8b47ba9d3c389b23743d84908c1 Author: Mads Hvid Ribergaard <38077893+mhrib@users.noreply.github.com> Date: Fri Nov 10 01:17:24 2023 +0100 Rename sum to asum, as "sum" is also a generic fortran function (#905) Co-authored-by: Mads Hvid Ribergaard commit 4450a3e8c64bc07d1173eb3e341cd8dea91d5068 Author: Tony Craig Date: Fri Oct 27 22:22:43 2023 -0700 Update Icepack to latest version, does not affect CICE (#903) commit ea241fa81a53b614f54cf5c2dad93bda20b72a78 Author: Tony Craig Date: Fri Oct 27 16:27:15 2023 -0700 Update version, remove trailing blanks (#901) commit 32f233d9728b4e453c0f02fb79a188517a8d5ed4 Author: Tony Craig Date: Fri Oct 27 16:27:01 2023 -0700 Update Icepack, add snicar and snicartest tests (#902) commit 0484dcd1410920f26375b7c280500a5bd16173e9 Author: Tony Craig Date: Fri Oct 27 09:24:52 2023 -0700 Split N/E grid computation out of Tlonlat, create NElonlat subroutine. (#899) * Split N/E grid computation out of Tlonlat, create NElonlat subroutine. See https://github.com/CICE-Consortium/CICE/issues/897 When TLON, TLAT, ANGLET are on the CICE grid, Tlonlat is NOT called. This meant N and E grid info was never computed. This would fail during history writing with invalid values in N and E grid arrays. And it would also cause problem if the C-grid were run with this type of CICE grid. There are no test grids that have TLON, TLAT, ANGLET on them, so this error was not found in standard test suites. This was detected by users. * Add gx3 grid/kmt files with TLON, TLAT, ANGLET netcdf grid test. The grid and kmt files were produced from a gx3 history file. Results are not bit-for-bit with the standard gx3 runs, but seem to be roundoff different initially (as expected). commit 0b5ca0911edaf6081ba891f4287af14ceb201c9f Author: Tony Craig Date: Thu Oct 26 19:33:19 2023 -0700 Revert "Add 5-band dEdd shortwave tests (#896)" (#900) This reverts commit b4abca479cd548c3e600a6c645447d5ba9464422. commit 2e13606558f7ce71633274bc38630caa23de3392 Author: Philippe Blain Date: Thu Oct 26 13:24:37 2023 -0400 doc: update histfreq_base and hist_avg descriptions (#898) * doc: ug_implementation.rst: do not use curly quotes The namelist excerpt in section 'History' of the Implementation part of the user guide uses curly quotes (’) instead of regular straight quotes ('). This is probably a remnant of the LaTeX version of the doc. These quotes can't be used in Fortran and so copy pasting from the doc to the namelist causes runtime failures. Use straigth quotes instead. * doc: ug_implementation.rst: align histfreq_n with histfreq Align frequencies with their respective streams, which makes the example clearer. * doc: ug_implementation.rst: avoid "now" and "still" The documentation talks about the current version of the code, so it is unnecessary to use words like "now" and "still" to talk about the model features. Remove them. * doc: ug_implementation.rst: mention histfreq_base and hist_avg are per-stream In 35ec167d (Add functionality to change hist_avg for each stream (#827), 2023-05-17), hist_avg was made into an array, allowing each stream to individually be set to instantaneous or averaged mode. The first paragraph of the "History" section of the user guide was updated, but another paragraph a little below was not. In 933b148c (Extend restart output controls, provide multiple frequency options (#850), 2023-08-24), histfreq_base was also made into an array, but the "History" section of the user guide was not updated. Adjust the wording of the doc to reflect the fact that both hist_avg and histfreq_base are per-stream. Also adjust the namelist excerpt to make histfreq_base an array, and align hist_avg with it. * doc: ug_implementation.rst: refer to 'timemanager' after mentioning histfreq_base In 34dc6670 (Namelist option for time axis position. (#839), 2023-07-06), the namelist option hist_time_axis was added, and the "History" section of the user guide updated to mention it. The added sentence, however, separates the mention of 'histfreq_base' and the reference to the "Time manager" section, which explains the different allowed values for that variable. Move the reference up so both are next to each other. commit b4abca479cd548c3e600a6c645447d5ba9464422 Author: Tony Craig Date: Thu Oct 26 08:54:40 2023 -0700 Add 5-band dEdd shortwave tests (#896) commit 624c28b19b443c031ea862e3e5d2c16387777ddc Author: Philippe Blain Date: Thu Oct 26 11:52:26 2023 -0400 ice_dyn_evp: pass 'grid_location' for LKD seabed stress on C grid (#893) When the C grid support was added in 078aab48 (Merge cgridDEV branch including C grid implementation and other fixes (#715), 2022-05-10), subroutine ice_dyn_shared::seabed_stress_factor_LKD gained a 'grid_location' optional argument to indicate where to compute intermediate quantities and the seabed stress itself (originally added in 0f9f48b9 (ice_dyn_shared: add optional 'grid_location' argument to seabed_stress_factor_LKD, 2021-11-17)). This argument was however forgotten in ice_dyn_evp::evp when this subroutine was adapted for the C grid in 48c07c66 (ice_dyn_evp: compute seabed stress factor at CD-grid locations, 2021-11-17), such that currently the seabed stress is not computed at the correct grid location for the C and CD grids. Fix that by correctly passing the 'grid_location' argument. Note that the dummy argument is incorrectly declared as 'intent(inout)' in the subroutine, so change that to 'intent(in)' so we can pass in character constants. Closes: https://github.com/CICE-Consortium/CICE/issues/891 commit d3698fb46fc23a81b1df8dba676a5a74d7e96a39 Author: daveh150 Date: Wed Oct 25 16:34:35 2023 -0500 Add atm_data_version to allow JRA55 forcing filenames to have a unique version string (#876) * Add jra55date to allow JRA55 forcing to have creation date in file name * Changed jra55_date to atm_data_date. Added atm_data_date to docs. * Change jra55_date to atm_data_date. Update JRA55_files to include atm_data_date in file. Update case scripts/namelist. * change atm_data_date to atm_data_version. Update set_nml.tx1 default to corrected forcing version * Update doc to have atm_data_version in proper alphabetical order * Re-add set_nml.jra55. Deleted accitentally * Fix type-o in atm_data_dir documentation * Add atm_data_version to set_nml.jra55 * fix spacing after changing atm_data_date to atm_data_version * Change atm_data_date to atm_data_version * Comment out JRA55 file debugging * Update dg_forcing docs to describe atm_data_version string * Uncomment JRA55 filename check. Added check for debug_forcing before writing output * Correct doc format/links in dg_forcing.rst commit 8916b9ff2c58a3a095235bb5b4ce7e8a68f76e87 Author: Tony Craig Date: Wed Oct 18 14:08:21 2023 -0700 Update update_ocn_f implementation, Add cpl_frazil namelist (#889) * Update update_ocn_f implementation Add cpl_frazil namelist Add update_ocn_f and cpl_frazil to icepack_init_parameters call, set these values inside Icepack at initialization. Remove update_ocn_f argument from icepack_step_therm2 call Update runtime_diags and accum_hist to account for new Icepack and cpl_frazil implementation. These may need an addition update later. * Update documentation commit 6ba070f7e7027f9fd2cc32f2dbe10c9854511d93 Author: Tony Craig Date: Wed Oct 18 12:35:08 2023 -0700 Update Documentation to clarify Namelist Inputs (#888) * Update Documentation to clarify Namelist Inputs * Update documentation commit a9d6dc75f47a2898f1800ad4ddd96c4992e3bed0 Author: Tony Craig Date: Wed Oct 18 10:47:01 2023 -0700 Update input data area for Derecho, switch to campaign (#890) commit 5ddb74dfb8724ff90aa7e806d5bfcfb4a0990762 Author: Tony Craig Date: Wed Oct 18 10:46:40 2023 -0700 Remove cicedynB link (#887) Update documentation commit 96b43fb458fe00696d9532e547a3c5bff113f9f9 Author: Tony Craig Date: Wed Oct 18 10:46:25 2023 -0700 Update Icepack CPP USE_SNICARHC to NO_SNICARHC and update logic (#886) Update Icepack to version #0c548120ce44382 Oct 16, 2023 includes NO_SNICARHC commit 48a92ef6dd6bf7884ec8a16b2c082345accae385 Author: Tony Craig Date: Fri Oct 13 14:22:03 2023 -0700 Remove use of the deprecated "_old" tfrz_options in set_nml files. This (#883) changes answers for some test cases, as expected. Update tfrz_option implementation to not allow _old options. commit 276563041ea6a2b6b4c70cbfa5173fb85db7b47f Author: Tony Craig Date: Thu Oct 12 12:41:17 2023 -0700 Add perlmutter gnu, intel, cray port (#882) commit deb247bcec381615d01006bfa15dddf3a4f068fd Author: Tony Craig Date: Thu Oct 5 12:50:32 2023 -0700 Update CICE for E3SM Icepack modifications (#879) * Update CICE to run with eclare108213/Icepack branch snicar (#100) * Update CICE to run with eclare108213/Icepack branch snicar - including https://github.com/eclare108213/Icepack/pull/13, Sept 11, 2022 - Passes full CICE test suite on cheyenne with 3 compilers except alt04 changes answers for all compilers and all tests. CICE #fea412a55f was baseline. - Icepack submodule still points to standard version on main, need to be swapped manually to appropriate development version. * Remove faero_optics * update ciceexe string to account for USE_SNICARHC CPP * Update documentation * Update test suite to add modal testing * Point Icepack submodule to cice-consortium/E3SM-icepack-initial-integration Update to snicar branch merge, #8aef3f785ce * Add E3SM namelists for CICE. (#101) * New e3sm and e3smbgc namelist options * Update E3SM test options * Add a simple e3sm test suite * atmbndy is not actually different * Additional changes * add Tliquidus_max namelist parameter to CICE * Add Tf argument to icepack interfaces * Add constant option for tfrz_option * Fix some diagnostic prints and add to additional drivers * Update messages and change option in alt01 * Update implementation for latest version of Icepack - Update tfrz_option, add _old options for backwards bit-for-bit - Fix unittests - Add hi_min to namelist and tests * Update Icepack * Update to E3SM-Project/Icepack/cice-consortium/E3SM-icepack-initial-integration including Icepack1.3.3 release, Dec 15, 2022. * Update Icepack to E3SM-Project/Icepack #87db73ba6d93747a9, current head of cice-consortium/E3SM-icepack-initial-integration Feb 3, 2023 * Update boxchan1e and boxchan1n tests to tfrz_option = 'mushy_old' to recover Consortium main results Update Icepack to the latest hash on E3SM-Project Icepack cice-consortium/E3SM-icepack-initial-integration, #96f2fc707fc743d7 Prior commit was a merge from CICE Consortium Main, #d466031001cf447bcd64220c842dcd2707f61e9, Sept 29, 2023 * remove icepack * update icepack --------- Co-authored-by: David A. Bailey Co-authored-by: Elizabeth Hunke commit d466031001cf447bcd64220c842dcd2707f61e90 Author: Tony Craig Date: Fri Sep 29 12:08:53 2023 -0700 Add single grid channel capability and test for C-grid (#875) * Added code for transport in one grid cell wide channels * Update remap advection to support transport in single gridcell channels Add single grid east and north channel configurations and tests * Update documentation * Remove temporary code comments --------- Co-authored-by: Jean-Francois Lemieux commit 55342ca7cb4a1be511ade6249e349cb8a8095881 Author: Dougie Squire <42455466+dougiesquire@users.noreply.github.com> Date: Tue Sep 26 03:49:09 2023 +1000 Fix mesh mask check in nuopc/cmeps cap (#873) commit a5bb4f9a0c180e325e2a5480832f588dbfdd25ec Author: Denise Worthen Date: Fri Sep 15 16:01:00 2023 -0400 switch to cesm-style field names (#869) commit 01ed4db7c4e5857768a37e8b1fd7472ab5121827 Author: JFLemieux73 <31927797+JFLemieux73@users.noreply.github.com> Date: Fri Sep 15 19:59:55 2023 +0000 More accurate calculation of areafact in remapping (#849) * Modified doc to specify that l_fixed_area is T for C-grid * Initial modifs to calc areafact based on linear interpolation of left and rigth values * put back l_fixed_area = .true. for C-grid * added temporary comments for PR review * Modified areafac calc for case 1 and case 2 * Corrected minor compilation issues * Corrected conditions for case 1 to make sure areas add up * Small modif in l_fixed_area section to ensure only one condition is true * Modified conditions in locate triangle to be consistent with previous changes for case 1 * Use other edge areafac_c for TL, BL, TR and BR triangles * Some comments removed * Fixed out of bounds areafac_ce and now use earea and narea * Replaced ib,ie,jb,je in locate_triangle using ilo,ihi,jlo,jhi * Modified areafac for TL1, BL2, TR1 and BR2 for area flux consistency * Cosmetic changes * Added comment to explain latest change * Modification of bugcheck condition for l_fixed_area=T * update areafac_c, areafac_ce in halo in dynamics --------- Co-authored-by: apcraig commit 06282a538e03599aed27bc3c5506ccc31a590069 Author: Tony Craig Date: Fri Sep 8 11:26:45 2023 -0700 Update version to 6.4.2 (#864) Update License and Copyright Update Icepack for version/copyright commit 714bab97540e5b75c0f2b6c11cd061277cdb322d Author: Tony Craig Date: Thu Sep 7 14:20:29 2023 -0700 Update Cheyenne and Derecho ports (#863) * Update cheyenne and derecho ports cheyenne_intel updated to intel/19/1/1, mpt/2.25 cheyenne_gnu updated to gnu/8.3.0, mpt/2.25 cheyenne_pgi updated to pgi/19.9, mpt/2.22 derecho_intel minor updates derecho_intelclassic added derecho_inteloneapi added (not working) derecho_gnu added derecho_cray added derecho_nvhpc added cheyenne_pgi changed answers derecho_inteloneapi is not working, compiler issues fixes automated qc testing on cheyenne * Update permissions on env.chicoma_intel commit cbbac74cd9073dce8eb44fa23cabb573913aa44f Author: David A. Bailey Date: Tue Sep 5 14:22:59 2023 -0600 Only print messages in CAP on master task (#861) commit 32dc48eae101749b437bd777c18830e3c397b17a Author: Tony Craig Date: Thu Aug 31 13:05:54 2023 -0700 Update Icepack to #23b6c1272b50d42ca, Aug 30, 2023 (#857) Includes thin ice enthalpy fix, not bit-for-bit. commit e8a69abde90b99fc6528d469b8698506a99f6e2a Author: Denise Worthen Date: Mon Aug 28 16:00:41 2023 -0400 Add logging features to nuopc/cmeps cap; deprecates zsalinity in cap (#856) * merge latest master (#4) * Isotopes for CICE (#423) Co-authored-by: apcraig Co-authored-by: David Bailey Co-authored-by: Elizabeth Hunke * updated orbital calculations needed for cesm * fixed problems in updated orbital calculations needed for cesm * update CICE6 to support coupling with UFS * put in changes so that both ufsatm and cesm requirements for potential temperature and density are satisfied * Convergence on ustar for CICE. (#452) (#5) * Add atmiter_conv to CICE * Add documentation * trigger build the docs Co-authored-by: David A. Bailey * update icepack submodule * Revert "update icepack submodule" This reverts commit e70d1abcbeb4351195a2b81c6ce3f623c936426c. * update comp_ice.backend with temporary ice_timers fix * Fix threading problem in init_bgc * Fix additional OMP problems * changes for coldstart running * Move the forapps directory * remove cesmcoupled ifdefs * Fix logging issues for NUOPC * removal of many cpp-ifdefs * fix compile errors * fixes to get cesm working * fixed white space issue * Add restart_coszen namelist option * update icepack submodule * change Orion to orion in backend remove duplicate print lines from ice_transport_driver * add -link_mpi=dbg to debug flags (#8) * cice6 compile (#6) * enable debug build. fix to remove errors * fix an error in comp_ice.backend.libcice * change Orion to orion for machine identification * changes for consistency w/ current emc-cice5 (#13) Update to emc/develop fork to current CICE consortium Co-authored-by: David A. Bailey Co-authored-by: Tony Craig Co-authored-by: Elizabeth Hunke Co-authored-by: Mariana Vertenstein Co-authored-by: apcraig Co-authored-by: Philippe Blain * Fixcommit (#14) Align commit history between emc/develop and cice-consortium/master * Update CICE6 for integration to S2S * add wcoss_dell_p3 compiler macro * update to icepack w/ debug fix * replace SITE with MACHINE_ID * update compile scripts * Support TACC stampede (#19) * update icepack * add ice_dyn_vp module to CICE_InitMod * update gitmodules, update icepack * Update CICE to consortium master (#23) updates include: * deprecate upwind advection (CICE-Consortium#508) * add implicit VP solver (CICE-Consortium#491) * update icepack * switch icepack branches * update to icepack master but set abort flag in ITD routine to false * update icepack * Update CICE to latest Consortium master (#26) update CICE and Icepack * changes the criteria for aborting ice for thermo-conservation errors * updates the time manager * fixes two bugs in ice_therm_mushy * updates Icepack to Consortium master w/ flip of abort flag for troublesome IC cases * add cice changes for zlvs (#29) * update icepack and pointer * update icepack and revert gitmodules * Fix history features - Fix bug in history time axis when sec_init is not zero. - Fix issue with time_beg and time_end uninitialized values. - Add support for averaging with histfreq='1' by allowing histfreq_n to be any value in that case. Extend and clean up construct_filename for history files. More could be done, but wanted to preserve backwards compatibility. - Add new calendar_sec2hms to converts daily seconds to hh:mm:ss. Update the calchk calendar unit tester to check this method - Remove abort test in bcstchk, this was just causing problems in regression testing - Remove known problems documentation about problems writing when istep=1. This issue does not exist anymore with the updated time manager. - Add new tests with hist_avg = false. Add set_nml.histinst. * revert set_nml.histall * fix implementation error * update model log output in ice_init * Fix QC issues - Add netcdf ststus checks and aborts in ice_read_write.F90 - Check for end of file when reading records in ice_read_write.F90 for ice_read_nc methods - Update set_nml.qc to better specify the test, turn off leap years since we're cycling 2005 data - Add check in c ice.t-test.py to make sure there is at least 1825 files, 5 years of data - Add QC run to base_suite.ts to verify qc runs to completion and possibility to use those results directly for QC validation - Clean up error messages and some indentation in ice_read_write.F90 * Update testing - Add prod suite including 10 year gx1prod and qc test - Update unit test compare scripts * update documentation * reset calchk to 100000 years * update evp1d test * update icepack * update icepack * add memory profiling (#36) * add profile_memory calls to CICE cap * update icepack * fix rhoa when lowest_temp is 0.0 * provide default value for rhoa when imported temp_height_lowest (Tair) is 0.0 * resolves seg fault when frac_grid=false and do_ca=true * update icepack submodule * Update CICE for latest Consortium master (#38) * Implement advanced snow physics in icepack and CICE * Fix time-stamping of CICE history files * Fix CICE history file precision * Use CICE-Consortium/Icepack master (#40) * switch to icepack master at consortium * recreate cap update branch (#42) * add debug_model feature * add required variables and calls for tr_snow * remove 2 extraneous lines * remove two log print lines that were removed prior to merge of driver updates to consortium * duplicate gitmodule style for icepack * Update CICE to latest Consortium/main (#45) * Update CICE to Consortium/main (#48) Update OpenMP directives as needed including validation via new omp_suite. Fixed OpenMP in dynamics. Refactored eap puny/pi lookups to improve scalar performance Update Tsfc implementation to make sure land blocks don't set Tsfc to freezing temp Update for sea bed stress calculations * fix comment, fix env for orion and hera * replace save_init with step_prep in CICE_RunMod * fixes for cgrid repro * remove added haloupdates * baselines pass with these extra halo updates removed * change F->S for ocean velocities and tilts * fix debug failure when grid_ice=C * compiling in debug mode using -init=snan,arrays requires initialization of variables * respond to review comments * remove inserted whitespace for uvelE,N and vvelE,N * Add wave-cice coupling; update to Consortium main (#51) * add wave-ice fields * initialize aicen_init, which turns up as NaN in calc of floediam export * add call to icepack_init_wave to initialize wavefreq and dwavefreq * update to latest consortium main (PR 752) * add initializationsin ice_state * initialize vsnon/vsnon_init and vicen/vicen_init * Update CICE (#54) * update to include recent PRs to Consortium/main * fix for nudiag_set allow nudiag_set to be available outside of cesm; may prefer to fix in coupling interface * Update CICE for latest Consortium/main (#56) * add run time info * change real(8) to real(dbl)kind) * fix syntax * fix write unit * use cice_wrapper for ufs timer functionality * add elapsed model time for logtime * tidy up the wrapper * fix case for 'time since' at the first advance * add timer and forecast log * write timer values to timer log, not nu_diag * write log.ice.fXXX * only one time is needed * modify message written for log.ice.fXXX * change info in fXXX log file * Update CICE from Consortium/main (#62) * Fix CESMCOUPLED compile issue in icepack. (#823) * Update global reduction implementation to improve performance, fix VP bug (#824) * Update VP global sum to exclude local implementation with tripole grids * Add functionality to change hist_avg for each stream (#827) * Update Icepack to #6703bc533c968 May 22, 2023 (#829) * Fix for mesh check in CESM driver (#830) * Namelist option for time axis position. (#839) * reset timer after Advance to retrieve "wait time" * add logical control for enabling runtime info * remove zsal items from cap * fix typo --------- Co-authored-by: apcraig Co-authored-by: David Bailey Co-authored-by: Elizabeth Hunke Co-authored-by: Mariana Vertenstein Co-authored-by: Minsuk Ji <57227195+MinsukJi-NOAA@users.noreply.github.com> Co-authored-by: Tony Craig Co-authored-by: Philippe Blain Co-authored-by: Jun.Wang commit 933b148cb141a16d74615092af62c3e8d36777a2 Author: Tony Craig Date: Thu Aug 24 10:23:56 2023 -0700 Extend restart output controls, provide multiple frequency options (#850) * Extend restart output controls, provide multiple streams for possible output frequencies. Convert dumpfreq, dumpfreq_n, dumpfreq_base to arrays. Modify histfreq_base to make it an array as well. Now each history stream can have it's own base time (init or zero). Update documentation. * Clean up implementation and documentation * Update PR to check github actions commit 357103a2df0428089d54bdacf9eab621a5e1f710 Author: Tony Craig Date: Tue Aug 22 11:27:28 2023 -0700 Deprecate zsalinity (#851) * Deprecate zsalinity, mostly with ifdef and comments first for testing * Deprecate zsalinity, remove code * Add warning message for deprecated zsalinity * Update Icepack to #f5e093f5148554674 (deprecate zsalinity) commit 8322416793ae2b76c2bafa9c7b9b108c289ede9d Author: Elizabeth Hunke Date: Fri Aug 18 17:34:24 2023 -0600 Updates to advanced snow physics implementation (#852) * Replace tr_snow flag with snwredist, snwgrain in some places (tr_snow is still used more generally). Fix intent(out) compile issue in ice_read_write.F90. Replace badger with chicoma machine files. * update icepack to 86cae16d1b7c4c4f8 --------- Co-authored-by: apcraig commit 7e8dc5b2aeffe98a6a7fd91dbb8e93ced1e3369c Author: Tony Craig Date: Thu Aug 10 13:06:41 2023 -0700 Update conda_macos to fix problems with Github Actions testing (#853) * test ghactions * update master to main in github actions commit 4cb296c4003014fe57d6d00f86868a78a532fc95 Author: JFLemieux73 <31927797+JFLemieux73@users.noreply.github.com> Date: Tue Jul 25 16:11:33 2023 +0000 Modification of edge mask computation when l_fixed_area=T in horizontal remapping (#833) * Use same method whether l_fixed_area=T or F to compute masks for edge fluxes * Corrected typo in comment * Cosmetic (indentation) change in ice_transport_remap.F90 * Set l_fixed_area value depending of grid type * Modifs to the doc for l_fixed_area * Use umask for uvel,vvel initialization for boxslotcyl and change grid avg type from S to A in init_state * Temporary changes before next PR: l_fixed_area=F for B and C grid * Temporary changes before next PR: remove paragraph in the doc * Small modifs: l_fixed_area and grid_ice are defined in module ice_transport_remap commit 9f42a620e9e642c637d8f04441bacb5835ebf0b7 Author: Tony Craig Date: Thu Jul 20 14:59:42 2023 -0700 Update Icepack to Consortium main #4728746, July 18 2023 (#846) - fix optional arguments issues - fix hsn_new(1) bug Update optargs unit test, add new test cases Add opticep unit test, to test CICE calls to Icepack without optional arguments. Add new comparison option to comparelog.csh to compare a unit test with a standard CICE test. Update unittest_suite Update documentation about optional arguments and unit tests commit f9d3002c86e11ca18b06382fc2d0676c9a945223 Author: Tony Craig Date: Thu Jul 13 16:01:26 2023 -0700 Add support for JRA55do (#843) * updating paths for local nrlssc builds * Add jra55do forcing option * Updated env.nrlssc_gnu for new local directory structure * Added JRA55do to file names. Added comments for each variable name at top of JRA55do_???_files subroutine * Make JRA55 forcing to use common subroutines. Search atm_data_type for specific cases * remove extraneous 'i' variable in JRA55_files * Changed JRA55 filename JRA55_grid instead of grid at end of filename * Add jra55do tests to base_suite and quick_suite. This is done via set_nml options. * Update forcing implementation to provide a little more flexibility for JRA55, JRA55do, and ncar bulk atm forcing files. * Update documentation * update Onyx port * Update forcing documentation Initial port to derecho_intel * clean up blank spaces --------- Co-authored-by: daveh150 commit 766ff8d9606ae08bdd34ac2b36b6b068464c7e71 Author: Tony Craig Date: Tue Jul 11 07:53:22 2023 -0700 Update Icepack to #d024340f19676b July 6, 2023 (#841) Remove deprecated COREII LYq forcing Remove deprecated print_points_state Update links in rst documentation to point to main, not master commit 34dc66707f6b691b1689bf36689591af3e8df270 Author: David A. Bailey Date: Thu Jul 6 21:46:58 2023 -0600 Namelist option for time axis position. (#839) * Add option to change location in interval of time axis * Only use hist_time_axis when hist_avg is true * Add more comments and information in the documentation * Add a check on hist_time_axis as well as a global attribute * Abort if hist_time_axis is not set correctly. commit 7eb4dd7e7e2796c5718061d06b86ff602b9d29cc Author: Tony Craig Date: Tue Jun 20 09:40:55 2023 -0700 Update .readthedocs.yaml, add pdf (#837) * update readthedocs.yaml, turn on pdf * update readthedocs.yaml, turn on pdf * update readthedocs.yaml, turn on pdf * update readthedocs.yaml, turn on pdf commit 8e2aab217ece5fae933a1f2ad6e0d6ab81ecad8a Author: David A. Bailey Date: Tue Jun 20 08:54:25 2023 -0600 Fix for mesh check in CESM driver (#830) * Fix for mesh check in CESM driver * Slightly different way to evaluate longitude difference * Slightly different way to evaluate longitude difference * Put the abs inside the mod * Add abort calls back in commit b98b8ae899fb2a1af816105e05470b829f8b3294 Author: Tony Craig Date: Wed May 24 09:56:10 2023 -0700 Update Icepack to #6703bc533c968 May 22, 2023 (#829) Remove trailing blanks via automated tool in some Fortran files commit 35ec167dc6beee685a6e9485b8a1db3604d566bd Author: David A. Bailey Date: Wed May 17 14:56:26 2023 -0600 Add functionality to change hist_avg for each stream (#827) * Add functionality to change hist_avg for each stream * Fix some documentation * Try to fix sphinx problem * Fix hist_avg documentation * Add some metadata changes to time and time_bounds commit 5b0418a9f6d181d668ddebdc2c540566529e4125 Author: Tony Craig Date: Wed Apr 5 13:29:21 2023 -0700 Update global reduction implementation to improve performance, fix VP bug (#824) * Update global reduction implementation to improve performance, fix VP bug This was mainly done for situations like VP that need a fast global sum. The VP global sum is still slightly faster than the one computed in the infrastructure, so kept that implementation. Found a bug in the workspace_y calculation in VP that was fixed. Also found that the haloupdate call as part of the precondition step generally improves VP performance, so removed option to NOT call the haloupdate there. Separately, fixed a bug in the tripoleT global sum implementation, added a tripoleT global sum unit test, and resynced ice_exit.F90, ice_reprosum.F90, and ice_global_reductions.F90 between serial and mpi versions. - Refactor global sums to improve performance, move if checks outside do loops - Fix bug in tripoleT global sums, tripole seam masking - Update VP solver, use local global sum more often - Update VP solver, fix bug in workspace_y calculation - Update VP solver, always call haloupdate during precondition - Refactor ice_exit.F90 and sync serial and mpi versions - Sync ice_reprosum.F90 between serial and mpi versions - Update sumchk unit test to handle grids better - Add tripoleT sumchk test * Update VP global sum to exclude local implementation with tripole grids commit 942449751275ebd884abb5752d03d7ea64b72664 Author: David A. Bailey Date: Thu Mar 23 16:46:05 2023 -0600 Fix CESMCOUPLED compile issue in icepack. (#823) * Fix CESMCOUPLED compile problem in icepack --- .github/PULL_REQUEST_TEMPLATE.md | 2 +- .github/workflows/test-cice.yml | 6 +- cicecore/cicedyn/analysis/ice_history.F90 | 20 +- .../cicedyn/analysis/ice_history_shared.F90 | 22 +- cicecore/cicedyn/dynamics/ice_dyn_eap.F90 | 22 +- cicecore/cicedyn/dynamics/ice_dyn_evp.F90 | 63 +- cicecore/cicedyn/dynamics/ice_dyn_shared.F90 | 114 +- cicecore/cicedyn/dynamics/ice_dyn_vp.F90 | 31 +- .../cicedyn/dynamics/ice_transport_remap.F90 | 141 +- cicecore/cicedyn/general/ice_flux.F90 | 3 +- cicecore/cicedyn/general/ice_forcing.F90 | 10 +- cicecore/cicedyn/general/ice_init.F90 | 303 ++- cicecore/cicedyn/general/ice_state.F90 | 2 + .../comm/mpi/ice_global_reductions.F90 | 45 +- .../comm/serial/ice_global_reductions.F90 | 45 +- .../cicedyn/infrastructure/ice_blocks.F90 | 54 +- .../cicedyn/infrastructure/ice_domain.F90 | 79 +- cicecore/cicedyn/infrastructure/ice_grid.F90 | 191 +- .../cicedyn/infrastructure/ice_memusage.F90 | 3 +- .../cicedyn/infrastructure/ice_read_write.F90 | 1291 +++++----- .../cicedyn/infrastructure/ice_restoring.F90 | 2 +- .../io/io_binary/ice_history_write.F90 | 1 + .../io/io_binary/ice_restart.F90 | 24 +- .../io/io_netcdf/ice_history_write.F90 | 2093 ++++++++--------- .../io/io_netcdf/ice_restart.F90 | 463 ++-- .../io/io_pio2/ice_history_write.F90 | 1191 +++++----- .../infrastructure/io/io_pio2/ice_pio.F90 | 221 +- .../infrastructure/io/io_pio2/ice_restart.F90 | 1130 ++++----- .../drivers/nuopc/cmeps/ice_comp_nuopc.F90 | 33 +- .../drivers/nuopc/cmeps/ice_import_export.F90 | 78 +- cicecore/drivers/nuopc/cmeps/ice_mesh_mod.F90 | 8 +- .../drivers/standalone/cice/CICE_InitMod.F90 | 2 +- cicecore/shared/ice_restart_shared.F90 | 11 +- configuration/scripts/ice_in | 13 + .../scripts/machines/Macros.conda_macos | 7 +- .../scripts/machines/env.derecho_cray | 2 + .../scripts/machines/env.derecho_gnu | 2 + .../scripts/machines/env.derecho_intel | 2 + .../scripts/machines/env.derecho_intelclassic | 2 + .../scripts/machines/env.derecho_inteloneapi | 2 + .../scripts/machines/env.derecho_nvhpc | 2 + .../scripts/machines/environment.yml | 1 + configuration/scripts/options/set_env.iopio1 | 1 + configuration/scripts/options/set_env.iopio1p | 1 - configuration/scripts/options/set_env.iopio2p | 1 - configuration/scripts/options/set_nml.histall | 1 + configuration/scripts/options/set_nml.histdbg | 1 + .../scripts/options/set_nml.iobinary | 2 + configuration/scripts/options/set_nml.iocdf1 | 2 + configuration/scripts/options/set_nml.iocdf2 | 2 + configuration/scripts/options/set_nml.iocdf5 | 2 + configuration/scripts/options/set_nml.iohdf5 | 2 + .../scripts/options/set_nml.iohdf5opts | 4 + configuration/scripts/options/set_nml.iopio1 | 2 - configuration/scripts/options/set_nml.iopio1p | 2 - configuration/scripts/options/set_nml.iopio2 | 2 - configuration/scripts/options/set_nml.iopio2p | 2 - .../scripts/options/set_nml.iopioopts | 10 + .../scripts/options/set_nml.iopnetcdf1 | 2 + .../scripts/options/set_nml.iopnetcdf2 | 2 + .../scripts/options/set_nml.iopnetcdf5 | 2 + configuration/scripts/tests/gridsys_suite.ts | 6 +- configuration/scripts/tests/io_suite.ts | 108 +- doc/source/cice_index.rst | 13 + doc/source/developer_guide/dg_about.rst | 10 +- doc/source/developer_guide/dg_infra.rst | 4 +- doc/source/user_guide/ug_case_settings.rst | 65 +- doc/source/user_guide/ug_implementation.rst | 126 +- doc/source/user_guide/ug_running.rst | 83 +- doc/source/user_guide/ug_testing.rst | 5 + 70 files changed, 4466 insertions(+), 3734 deletions(-) delete mode 100644 configuration/scripts/options/set_env.iopio1p delete mode 100644 configuration/scripts/options/set_env.iopio2p create mode 100644 configuration/scripts/options/set_nml.iocdf1 create mode 100644 configuration/scripts/options/set_nml.iocdf2 create mode 100644 configuration/scripts/options/set_nml.iocdf5 create mode 100644 configuration/scripts/options/set_nml.iohdf5 create mode 100644 configuration/scripts/options/set_nml.iohdf5opts delete mode 100644 configuration/scripts/options/set_nml.iopio1 delete mode 100644 configuration/scripts/options/set_nml.iopio1p delete mode 100644 configuration/scripts/options/set_nml.iopio2 delete mode 100644 configuration/scripts/options/set_nml.iopio2p create mode 100644 configuration/scripts/options/set_nml.iopioopts create mode 100644 configuration/scripts/options/set_nml.iopnetcdf1 create mode 100644 configuration/scripts/options/set_nml.iopnetcdf2 create mode 100644 configuration/scripts/options/set_nml.iopnetcdf5 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