diff --git a/.readthedocs.yaml b/.readthedocs.yaml new file mode 100644 index 000000000..f83760cce --- /dev/null +++ b/.readthedocs.yaml @@ -0,0 +1,29 @@ +# .readthedocs.yaml +# Read the Docs configuration file +# See https://docs.readthedocs.io/en/stable/config-file/v2.html for details + +# Required +version: 2 + +# Set the version of Python and other tools you might need +build: + os: ubuntu-22.04 + tools: + python: "3.7" + # You can also specify other tool versions: + # nodejs: "19" + # rust: "1.64" + # golang: "1.19" + +# Build documentation in the docs/ directory with Sphinx +sphinx: + configuration: doc/source/conf.py + +# If using Sphinx, optionally build your docs in additional formats such as PDF +# formats: +# - pdf + +# Optionally declare the Python requirements required to build your docs +python: + install: + - requirements: doc/requirements.txt diff --git a/cicecore/cicedyn/analysis/ice_diagnostics.F90 b/cicecore/cicedyn/analysis/ice_diagnostics.F90 index 53631b2d4..b14dff4e3 100644 --- a/cicecore/cicedyn/analysis/ice_diagnostics.F90 +++ b/cicecore/cicedyn/analysis/ice_diagnostics.F90 @@ -261,10 +261,8 @@ subroutine runtime_diags (dt) !$OMP END PARALLEL DO extentn = c0 extents = c0 - extentn = global_sum(work1, distrb_info, field_loc_center, & - tarean) - extents = global_sum(work1, distrb_info, field_loc_center, & - tareas) + extentn = global_sum(work1, distrb_info, field_loc_center, tarean) + extents = global_sum(work1, distrb_info, field_loc_center, tareas) extentn = extentn * m2_to_km2 extents = extents * m2_to_km2 diff --git a/cicecore/cicedyn/analysis/ice_history.F90 b/cicecore/cicedyn/analysis/ice_history.F90 index 54b6ce934..3eda456ec 100644 --- a/cicecore/cicedyn/analysis/ice_history.F90 +++ b/cicecore/cicedyn/analysis/ice_history.F90 @@ -263,7 +263,7 @@ subroutine init_hist (dt) trim(tmpstr2), file=__FILE__, line=__LINE__) endif end do - + close(nu_nml) call release_fileunit(nu_nml) endif @@ -2225,7 +2225,7 @@ subroutine accum_hist (dt) n4Dfcum = n4Dscum + num_avail_hist_fields_4Df ! should equal num_avail_hist_fields_tot do ns = 1,nstreams - if (.not. hist_avg) then ! write snapshots + if (.not. hist_avg(ns)) then ! write snapshots do n = 1,n2D if (avail_hist_fields(n)%vhistfreq == histfreq(ns)) & a2D(:,:,n,:) = c0 diff --git a/cicecore/cicedyn/analysis/ice_history_pond.F90 b/cicecore/cicedyn/analysis/ice_history_pond.F90 index d209e6db6..976a87d40 100644 --- a/cicecore/cicedyn/analysis/ice_history_pond.F90 +++ b/cicecore/cicedyn/analysis/ice_history_pond.F90 @@ -100,14 +100,14 @@ subroutine init_hist_pond_2D trim(nml_filename), & file=__FILE__, line=__LINE__) endif - + ! goto this namelist in file 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), & file=__FILE__, line=__LINE__) endif - + ! read namelist nml_error = 1 do while (nml_error > 0) @@ -121,7 +121,7 @@ subroutine init_hist_pond_2D trim(tmpstr2), file=__FILE__, line=__LINE__) endif end do - + close(nu_nml) call release_fileunit(nu_nml) endif diff --git a/cicecore/cicedyn/analysis/ice_history_shared.F90 b/cicecore/cicedyn/analysis/ice_history_shared.F90 index 70aa5e14c..f4e1f3ebf 100644 --- a/cicecore/cicedyn/analysis/ice_history_shared.F90 +++ b/cicecore/cicedyn/analysis/ice_history_shared.F90 @@ -38,7 +38,7 @@ module ice_history_shared integer (kind=int_kind), public :: history_precision logical (kind=log_kind), public :: & - hist_avg ! if true, write averaged data instead of snapshots + hist_avg(max_nstrm) ! if true, write averaged data instead of snapshots character (len=char_len_long), public :: & history_file , & ! output file for history @@ -743,7 +743,7 @@ subroutine construct_filename(ncfile,suffix,ns) imonth,'-',iday,'-',isec,'.',trim(suffix) else - if (hist_avg) then + if (hist_avg(ns)) then if (histfreq(ns) == '1' .or. histfreq(ns) == 'h'.or.histfreq(ns) == 'H') then ! do nothing elseif (new_year) then @@ -763,7 +763,7 @@ subroutine construct_filename(ncfile,suffix,ns) !echmod ! of other groups (including RASM which uses CESMCOUPLED) !echmod if (ns > 1) write(cstream,'(i1.1)') ns-1 - if (hist_avg) then ! write averaged data + if (hist_avg(ns)) then ! write averaged data if (histfreq(ns) == '1' .and. histfreq_n(ns) == 1) then ! timestep write(ncfile,'(a,a,i4.4,a,i2.2,a,i2.2,a,i5.5,a,a)') & history_file(1:lenstr(history_file))//trim(cstream),'_inst.', & diff --git a/cicecore/cicedyn/analysis/ice_history_snow.F90 b/cicecore/cicedyn/analysis/ice_history_snow.F90 index 62e65b5a3..19722b014 100644 --- a/cicecore/cicedyn/analysis/ice_history_snow.F90 +++ b/cicecore/cicedyn/analysis/ice_history_snow.F90 @@ -77,7 +77,7 @@ subroutine init_hist_snow_2D (dt) integer (kind=int_kind) :: ns integer (kind=int_kind) :: nml_error ! namelist i/o error flag real (kind=dbl_kind) :: rhofresh, secday - logical (kind=log_kind) :: tr_snow + logical (kind=log_kind) :: tr_snow character(len=char_len_long) :: tmpstr2 ! for namelist check character(len=char_len) :: nml_name ! for namelist check diff --git a/cicecore/cicedyn/dynamics/ice_dyn_vp.F90 b/cicecore/cicedyn/dynamics/ice_dyn_vp.F90 index 3915004b4..32971c5b6 100644 --- a/cicecore/cicedyn/dynamics/ice_dyn_vp.F90 +++ b/cicecore/cicedyn/dynamics/ice_dyn_vp.F90 @@ -2502,7 +2502,7 @@ function global_dot_product (nx_block , ny_block , & vector2_x , vector2_y) & result(dot_product) - use ice_domain, only: distrb_info + use ice_domain, only: distrb_info, ns_boundary_type use ice_domain_size, only: max_blocks use ice_fileunits, only: bfbflag @@ -2552,8 +2552,14 @@ function global_dot_product (nx_block , ny_block , & enddo !$OMP END PARALLEL DO - ! Use local summation result unless bfbflag is active - if (bfbflag == 'off') then + ! Use faster local summation result for several bfbflag settings. + ! The local implementation sums over each block, sums over local + ! blocks, and calls global_sum on a scalar and should be just as accurate as + ! bfbflag = 'off', 'lsum8', and 'lsum4' without the extra copies and overhead + ! in the more general array global_sum. But use the array global_sum + ! if bfbflag is more strict or for tripole grids (requires special masking) + if (ns_boundary_type /= 'tripole' .and. ns_boundary_type /= 'tripoleT' .and. & + (bfbflag == 'off' .or. bfbflag == 'lsum8' .or. bfbflag == 'lsum4')) then dot_product = global_sum(sum(dot), distrb_info) else dot_product = global_sum(prod, distrb_info, field_loc_NEcorner) @@ -3120,7 +3126,7 @@ subroutine fgmres (zetax2 , etax2 , & j = indxUj(ij, iblk) workspace_x(i, j, iblk) = workspace_x(i, j, iblk) + rhs_hess(it) * arnoldi_basis_x(i, j, iblk, it) - workspace_y(i, j, iblk) = workspace_x(i, j, iblk) + rhs_hess(it) * arnoldi_basis_y(i, j, iblk, it) + workspace_y(i, j, iblk) = workspace_y(i, j, iblk) + rhs_hess(it) * arnoldi_basis_y(i, j, iblk, it) enddo ! ij enddo !$OMP END PARALLEL DO @@ -3151,7 +3157,6 @@ subroutine pgmres (zetax2 , etax2 , & use ice_boundary, only: ice_HaloUpdate use ice_domain, only: maskhalo_dyn, halo_info - use ice_fileunits, only: bfbflag use ice_timers, only: ice_timer_start, ice_timer_stop, timer_bound real (kind=dbl_kind), dimension(nx_block,ny_block,max_blocks,4), intent(in) :: & @@ -3343,21 +3348,17 @@ subroutine pgmres (zetax2 , etax2 , & workspace_x , workspace_y) ! Update workspace with boundary values - ! NOTE: skipped for efficiency since this is just a preconditioner - ! unless bfbflag is active - if (bfbflag /= 'off') then - call stack_fields(workspace_x, workspace_y, fld2) - call ice_timer_start(timer_bound) - if (maskhalo_dyn) then - call ice_HaloUpdate (fld2, halo_info_mask, & - field_loc_NEcorner, field_type_vector) - else - call ice_HaloUpdate (fld2, halo_info, & - field_loc_NEcorner, field_type_vector) - endif - call ice_timer_stop(timer_bound) - call unstack_fields(fld2, workspace_x, workspace_y) + call stack_fields(workspace_x, workspace_y, fld2) + call ice_timer_start(timer_bound) + if (maskhalo_dyn) then + call ice_HaloUpdate (fld2, halo_info_mask, & + field_loc_NEcorner, field_type_vector) + else + call ice_HaloUpdate (fld2, halo_info, & + field_loc_NEcorner, field_type_vector) endif + call ice_timer_stop(timer_bound) + call unstack_fields(fld2, workspace_x, workspace_y) !$OMP PARALLEL DO PRIVATE(iblk) do iblk = 1, nblocks @@ -3528,7 +3529,7 @@ subroutine pgmres (zetax2 , etax2 , & j = indxUj(ij, iblk) workspace_x(i, j, iblk) = workspace_x(i, j, iblk) + rhs_hess(it) * arnoldi_basis_x(i, j, iblk, it) - workspace_y(i, j, iblk) = workspace_x(i, j, iblk) + rhs_hess(it) * arnoldi_basis_y(i, j, iblk, it) + workspace_y(i, j, iblk) = workspace_y(i, j, iblk) + rhs_hess(it) * arnoldi_basis_y(i, j, iblk, it) enddo ! ij enddo !$OMP END PARALLEL DO diff --git a/cicecore/cicedyn/general/ice_init.F90 b/cicecore/cicedyn/general/ice_init.F90 index 94bfa9311..cc83fe9b3 100644 --- a/cicecore/cicedyn/general/ice_init.F90 +++ b/cicecore/cicedyn/general/ice_init.F90 @@ -125,7 +125,7 @@ subroutine input_data use ice_timers, only: timer_stats use ice_memusage, only: memory_stats use ice_fileunits, only: goto_nml - + #ifdef CESMCOUPLED use shr_file_mod, only: shr_file_setIO #endif @@ -169,7 +169,7 @@ subroutine input_data character (len=char_len) :: abort_list character (len=char_len) :: nml_name ! namelist name - character (len=char_len_long) :: tmpstr2 + character (len=char_len_long) :: tmpstr2 character(len=*), parameter :: subname='(input_data)' @@ -322,7 +322,7 @@ subroutine input_data histfreq(5) = 'y' ! output frequency option for different streams histfreq_n(:) = 1 ! output frequency histfreq_base = 'zero' ! output frequency reference date - hist_avg = .true. ! if true, write time-averages (not snapshots) + hist_avg(:) = .true. ! if true, write time-averages (not snapshots) history_format = 'default' ! history file format history_dir = './' ! write to executable dir for default history_file = 'iceh' ! history file name prefix @@ -612,7 +612,7 @@ subroutine input_data call abort_ice(subname//'ERROR: searching for '// trim(nml_name), & file=__FILE__, line=__LINE__) endif - + ! read namelist nml_error = 1 do while (nml_error > 0) @@ -660,7 +660,7 @@ subroutine input_data call abort_ice(subname//'ERROR: searching for '// trim(nml_name), & file=__FILE__, line=__LINE__) endif - + ! read namelist nml_error = 1 do while (nml_error > 0) @@ -684,7 +684,7 @@ subroutine input_data call abort_ice(subname//'ERROR: searching for '// trim(nml_name), & file=__FILE__, line=__LINE__) endif - + ! read namelist nml_error = 1 do while (nml_error > 0) @@ -702,7 +702,7 @@ subroutine input_data ! read dynamics_nml nml_name = 'dynamics_nml' write(nu_diag,*) subname,' Reading ', trim(nml_name) - + ! goto namelist in file call goto_nml(nu_nml,trim(nml_name),nml_error) if (nml_error /= 0) then @@ -727,7 +727,7 @@ subroutine input_data ! read shortwave_nml nml_name = 'shortwave_nml' write(nu_diag,*) subname,' Reading ', trim(nml_name) - + ! goto namelist in file call goto_nml(nu_nml,trim(nml_name),nml_error) if (nml_error /= 0) then @@ -752,14 +752,14 @@ subroutine input_data ! read ponds_nml nml_name = 'ponds_nml' write(nu_diag,*) subname,' Reading ', trim(nml_name) - + ! goto namelist in file 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), & file=__FILE__, line=__LINE__) endif - + ! read namelist nml_error = 1 do while (nml_error > 0) @@ -777,14 +777,14 @@ subroutine input_data ! read snow_nml nml_name = 'snow_nml' write(nu_diag,*) subname,' Reading ', trim(nml_name) - + ! goto namelist in file 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), & file=__FILE__, line=__LINE__) endif - + ! read namelist nml_error = 1 do while (nml_error > 0) @@ -824,7 +824,7 @@ subroutine input_data endif end do - ! done reading namelist. + ! done reading namelist. close(nu_nml) call release_fileunit(nu_nml) endif @@ -904,7 +904,7 @@ subroutine input_data enddo call broadcast_array(histfreq_n, master_task) call broadcast_scalar(histfreq_base, master_task) - call broadcast_scalar(hist_avg, master_task) + call broadcast_array(hist_avg, master_task) call broadcast_scalar(history_dir, master_task) call broadcast_scalar(history_file, master_task) call broadcast_scalar(history_precision, master_task) @@ -2330,8 +2330,7 @@ subroutine input_data write(nu_diag,1033) ' histfreq = ', histfreq(:) write(nu_diag,1023) ' histfreq_n = ', histfreq_n(:) write(nu_diag,1031) ' histfreq_base = ', trim(histfreq_base) - write(nu_diag,1011) ' hist_avg = ', hist_avg - if (.not. hist_avg) write(nu_diag,1039) ' History data will be snapshots' + write(nu_diag,*) ' hist_avg = ', hist_avg(:) 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 diff --git a/cicecore/cicedyn/infrastructure/comm/mpi/ice_exit.F90 b/cicecore/cicedyn/infrastructure/comm/mpi/ice_exit.F90 index eafb3228f..5351a5336 100644 --- a/cicecore/cicedyn/infrastructure/comm/mpi/ice_exit.F90 +++ b/cicecore/cicedyn/infrastructure/comm/mpi/ice_exit.F90 @@ -1,3 +1,4 @@ + !======================================================================= ! ! Exit the model. @@ -8,7 +9,15 @@ module ice_exit use ice_kinds_mod + use ice_fileunits, only: nu_diag, ice_stderr, flush_fileunit use icepack_intfc, only: icepack_warnings_flush, icepack_warnings_aborted +#if (defined CESMCOUPLED) + use shr_sys_mod +#else +#ifndef SERIAL_REMOVE_MPI + use mpi ! MPI Fortran module +#endif +#endif implicit none public @@ -23,14 +32,6 @@ subroutine abort_ice(error_message, file, line, doabort) ! This routine aborts the ice model and prints an error message. -#if (defined CESMCOUPLED) - use ice_fileunits, only: nu_diag, flush_fileunit - use shr_sys_mod -#else - use ice_fileunits, only: nu_diag, ice_stderr, flush_fileunit - use mpi ! MPI Fortran module -#endif - character (len=*), intent(in),optional :: error_message ! error message character (len=*), intent(in),optional :: file ! file integer (kind=int_kind), intent(in), optional :: line ! line number @@ -38,11 +39,10 @@ subroutine abort_ice(error_message, file, line, doabort) ! local variables -#ifndef CESMCOUPLED integer (int_kind) :: & ierr, & ! MPI error flag + outunit, & ! output unit error_code ! return code -#endif logical (log_kind) :: ldoabort ! local doabort flag character(len=*), parameter :: subname='(abort_ice)' @@ -50,30 +50,31 @@ subroutine abort_ice(error_message, file, line, doabort) if (present(doabort)) ldoabort = doabort #if (defined CESMCOUPLED) - call flush_fileunit(nu_diag) - call icepack_warnings_flush(nu_diag) - write(nu_diag,*) ' ' - write(nu_diag,*) subname, 'ABORTED: ' - if (present(file)) write (nu_diag,*) subname,' called from ',trim(file) - if (present(line)) write (nu_diag,*) subname,' line number ',line - if (present(error_message)) write (nu_diag,*) subname,' error = ',trim(error_message) - call flush_fileunit(nu_diag) - if (ldoabort) call shr_sys_abort(subname//trim(error_message)) + outunit = nu_diag #else + outunit = ice_stderr +#endif + call flush_fileunit(nu_diag) call icepack_warnings_flush(nu_diag) - write(ice_stderr,*) ' ' - write(ice_stderr,*) subname, 'ABORTED: ' - if (present(file)) write (ice_stderr,*) subname,' called from ',trim(file) - if (present(line)) write (ice_stderr,*) subname,' line number ',line - if (present(error_message)) write (ice_stderr,*) subname,' error = ',trim(error_message) - call flush_fileunit(ice_stderr) - error_code = 128 + write(outunit,*) ' ' + write(outunit,*) subname, 'ABORTED: ' + if (present(file)) write (outunit,*) subname,' called from ',trim(file) + if (present(line)) write (outunit,*) subname,' line number ',line + if (present(error_message)) write (outunit,*) subname,' error = ',trim(error_message) + call flush_fileunit(outunit) + if (ldoabort) then +#if (defined CESMCOUPLED) + call shr_sys_abort(subname//trim(error_message)) +#else +#ifndef SERIAL_REMOVE_MPI + error_code = 128 call MPI_ABORT(MPI_COMM_WORLD, error_code, ierr) +#endif stop - endif #endif + endif end subroutine abort_ice @@ -81,12 +82,15 @@ end subroutine abort_ice subroutine end_run -! Ends run by calling MPI_FINALIZE. +! Ends run by calling MPI_FINALIZE +! Does nothing in serial runs integer (int_kind) :: ierr ! MPI error flag character(len=*), parameter :: subname = '(end_run)' +#ifndef SERIAL_REMOVE_MPI call MPI_FINALIZE(ierr) +#endif end subroutine end_run diff --git a/cicecore/cicedyn/infrastructure/comm/mpi/ice_global_reductions.F90 b/cicecore/cicedyn/infrastructure/comm/mpi/ice_global_reductions.F90 index 4b94389f7..91daf53a8 100644 --- a/cicecore/cicedyn/infrastructure/comm/mpi/ice_global_reductions.F90 +++ b/cicecore/cicedyn/infrastructure/comm/mpi/ice_global_reductions.F90 @@ -181,7 +181,7 @@ function global_sum_dbl(array, dist, field_loc, mMask, lMask) & if (Nrow .and. this_block%tripoleTFlag) then maxiglob = 0 ! entire u-row on T-fold grid elseif (Nrow .or. this_block%tripoleTFlag) then - maxiglob = nx_global/2 ! half T-row on T-fold and u-row on u-fold + maxiglob = nx_global/2 ! half T-row on T-fold or half u-row on u-fold else maxiglob = -1 ! nothing to do for T-row on u-fold endif @@ -189,25 +189,45 @@ function global_sum_dbl(array, dist, field_loc, mMask, lMask) & n = (iblock-1)*nx_block*ny_block - do j=jb,je - do i=ib,ie - n = n + 1 - ! eliminate redundant points - if (maxiglob > 0 .and. j == je .and. this_block%i_glob(i) > maxiglob) then - work(n,1) = 0._dbl_kind - else - if (present(mMask)) then - work(n,1) = array(i,j,iblock)*mMask(i,j,iblock) - else if (present(lMask)) then - if (lMask(i,j,iblock)) then - work(n,1) = array(i,j,iblock) - endif - else + if (present(mMask)) then + do j=jb,je + do i=ib,ie + n = n + 1 + work(n,1) = array(i,j,iblock)*mMask(i,j,iblock) + end do + end do + elseif (present(lMask)) then + do j=jb,je + do i=ib,ie + n = n + 1 + if (lMask(i,j,iblock)) then work(n,1) = array(i,j,iblock) endif - endif - end do - end do + end do + end do + else + do j=jb,je + do i=ib,ie + n = n + 1 + work(n,1) = array(i,j,iblock) + enddo + enddo + endif + + if (maxiglob >= 0) then + ! eliminate redundant points at je + ! set n to (ib,je) index + n = (iblock-1)*nx_block*ny_block + n = n + (je-1-jb+1)*(ie-ib+1) + j=je + do i=ib,ie + n = n + 1 + if (this_block%i_glob(i) > maxiglob) then + work(n,1) = 0._dbl_kind + endif + end do + endif + end do call compute_sums_dbl(work,sums,communicator,numProcs) @@ -317,7 +337,7 @@ function global_sum_real(array, dist, field_loc, mMask, lMask) & if (Nrow .and. this_block%tripoleTFlag) then maxiglob = 0 ! entire u-row on T-fold grid elseif (Nrow .or. this_block%tripoleTFlag) then - maxiglob = nx_global/2 ! half T-row on T-fold and u-row on u-fold + maxiglob = nx_global/2 ! half T-row on T-fold or half u-row on u-fold else maxiglob = -1 ! nothing to do for T-row on u-fold endif @@ -325,25 +345,45 @@ function global_sum_real(array, dist, field_loc, mMask, lMask) & n = (iblock-1)*nx_block*ny_block - do j=jb,je - do i=ib,ie - n = n + 1 - ! eliminate redundant points - if (maxiglob > 0 .and. j == je .and. this_block%i_glob(i) > maxiglob) then - work(n,1) = 0._dbl_kind - else - if (present(mMask)) then - work(n,1) = real(array(i,j,iblock)*mMask(i,j,iblock),dbl_kind) - else if (present(lMask)) then - if (lMask(i,j,iblock)) then - work(n,1) = real(array(i,j,iblock),dbl_kind) - endif - else + if (present(mMask)) then + do j=jb,je + do i=ib,ie + n = n + 1 + work(n,1) = real(array(i,j,iblock)*mMask(i,j,iblock),dbl_kind) + end do + end do + elseif (present(lMask)) then + do j=jb,je + do i=ib,ie + n = n + 1 + if (lMask(i,j,iblock)) then work(n,1) = real(array(i,j,iblock),dbl_kind) endif - endif - end do - end do + end do + end do + else + do j=jb,je + do i=ib,ie + n = n + 1 + work(n,1) = real(array(i,j,iblock),dbl_kind) + enddo + enddo + endif + + if (maxiglob >= 0) then + ! eliminate redundant points at je + ! set n to (ib,je) index + n = (iblock-1)*nx_block*ny_block + n = n + (je-1-jb+1)*(ie-ib+1) + j=je + do i=ib,ie + n = n + 1 + if (this_block%i_glob(i) > maxiglob) then + work(n,1) = 0._dbl_kind + endif + end do + endif + end do call compute_sums_dbl(work,sums,communicator,numProcs) @@ -445,7 +485,7 @@ function global_sum_int(array, dist, field_loc, mMask, lMask) & if (Nrow .and. this_block%tripoleTFlag) then maxiglob = 0 ! entire u-row on T-fold grid elseif (Nrow .or. this_block%tripoleTFlag) then - maxiglob = nx_global/2 ! half T-row on T-fold and u-row on u-fold + maxiglob = nx_global/2 ! half T-row on T-fold or half u-row on u-fold else maxiglob = -1 ! nothing to do for T-row on u-fold endif @@ -456,7 +496,7 @@ function global_sum_int(array, dist, field_loc, mMask, lMask) & do j=jb,je do i=ib,ie ! eliminate redundant points - if (maxiglob > 0 .and. j == je .and. this_block%i_glob(i) > maxiglob) then + if (maxiglob >= 0 .and. j == je .and. this_block%i_glob(i) > maxiglob) then ! blockSum = blockSum + 0_int_kind else if (present(mMask)) then @@ -798,7 +838,7 @@ function global_sum_prod_dbl (array1, array2, dist, field_loc, & if (Nrow .and. this_block%tripoleTFlag) then maxiglob = 0 ! entire u-row on T-fold grid elseif (Nrow .or. this_block%tripoleTFlag) then - maxiglob = nx_global/2 ! half T-row on T-fold and u-row on u-fold + maxiglob = nx_global/2 ! half T-row on T-fold or half u-row on u-fold else maxiglob = -1 ! nothing to do for T-row on u-fold endif @@ -806,25 +846,45 @@ function global_sum_prod_dbl (array1, array2, dist, field_loc, & n = (iblock-1)*nx_block*ny_block - do j=jb,je - do i=ib,ie - n = n + 1 - ! eliminate redundant points - if (maxiglob > 0 .and. j == je .and. this_block%i_glob(i) > maxiglob) then - work(n,1) = 0._dbl_kind - else - if (present(mMask)) then - work(n,1) = array1(i,j,iblock)*array2(i,j,iblock)*mMask(i,j,iblock) - else if (present(lMask)) then - if (lMask(i,j,iblock)) then - work(n,1) = array1(i,j,iblock)*array2(i,j,iblock) - endif - else + if (present(mMask)) then + do j=jb,je + do i=ib,ie + n = n + 1 + work(n,1) = array1(i,j,iblock)*array2(i,j,iblock)*mMask(i,j,iblock) + end do + end do + elseif (present(lMask)) then + do j=jb,je + do i=ib,ie + n = n + 1 + if (lMask(i,j,iblock)) then work(n,1) = array1(i,j,iblock)*array2(i,j,iblock) endif - endif - end do - end do + end do + end do + else + do j=jb,je + do i=ib,ie + n = n + 1 + work(n,1) = array1(i,j,iblock)*array2(i,j,iblock) + enddo + enddo + endif + + if (maxiglob >= 0) then + ! eliminate redundant points at je + ! set n to (ib,je) index + n = (iblock-1)*nx_block*ny_block + n = n + (je-1-jb+1)*(ie-ib+1) + j=je + do i=ib,ie + n = n + 1 + if (this_block%i_glob(i) > maxiglob) then + work(n,1) = 0._dbl_kind + endif + end do + endif + end do call compute_sums_dbl(work,sums,communicator,numProcs) @@ -936,7 +996,7 @@ function global_sum_prod_real (array1, array2, dist, field_loc, & if (Nrow .and. this_block%tripoleTFlag) then maxiglob = 0 ! entire u-row on T-fold grid elseif (Nrow .or. this_block%tripoleTFlag) then - maxiglob = nx_global/2 ! half T-row on T-fold and u-row on u-fold + maxiglob = nx_global/2 ! half T-row on T-fold or half u-row on u-fold else maxiglob = -1 ! nothing to do for T-row on u-fold endif @@ -944,25 +1004,45 @@ function global_sum_prod_real (array1, array2, dist, field_loc, & n = (iblock-1)*nx_block*ny_block - do j=jb,je - do i=ib,ie - n = n + 1 - ! eliminate redundant points - if (maxiglob > 0 .and. j == je .and. this_block%i_glob(i) > maxiglob) then - work(n,1) = 0._dbl_kind - else - if (present(mMask)) then - work(n,1) = real(array1(i,j,iblock)*array2(i,j,iblock)*mMask(i,j,iblock),dbl_kind) - else if (present(lMask)) then - if (lMask(i,j,iblock)) then - work(n,1) = real(array1(i,j,iblock)*array2(i,j,iblock),dbl_kind) - endif - else + if (present(mMask)) then + do j=jb,je + do i=ib,ie + n = n + 1 + work(n,1) = real(array1(i,j,iblock)*array2(i,j,iblock)*mMask(i,j,iblock),dbl_kind) + end do + end do + elseif (present(lMask)) then + do j=jb,je + do i=ib,ie + n = n + 1 + if (lMask(i,j,iblock)) then work(n,1) = real(array1(i,j,iblock)*array2(i,j,iblock),dbl_kind) endif - endif - end do - end do + end do + end do + else + do j=jb,je + do i=ib,ie + n = n + 1 + work(n,1) = real(array1(i,j,iblock)*array2(i,j,iblock),dbl_kind) + enddo + enddo + endif + + if (maxiglob >= 0) then + ! eliminate redundant points at je + ! set n to (ib,je) index + n = (iblock-1)*nx_block*ny_block + n = n + (je-1-jb+1)*(ie-ib+1) + j=je + do i=ib,ie + n = n + 1 + if (this_block%i_glob(i) > maxiglob) then + work(n,1) = 0._dbl_kind + endif + end do + endif + end do call compute_sums_dbl(work,sums,communicator,numProcs) @@ -1066,7 +1146,7 @@ function global_sum_prod_int (array1, array2, dist, field_loc, & if (Nrow .and. this_block%tripoleTFlag) then maxiglob = 0 ! entire u-row on T-fold grid elseif (Nrow .or. this_block%tripoleTFlag) then - maxiglob = nx_global/2 ! half T-row on T-fold and u-row on u-fold + maxiglob = nx_global/2 ! half T-row on T-fold or half u-row on u-fold else maxiglob = -1 ! nothing to do for T-row on u-fold endif @@ -1077,7 +1157,7 @@ function global_sum_prod_int (array1, array2, dist, field_loc, & do j=jb,je do i=ib,ie ! eliminate redundant points - if (maxiglob > 0 .and. j == je .and. this_block%i_glob(i) > maxiglob) then + if (maxiglob >= 0 .and. j == je .and. this_block%i_glob(i) > maxiglob) then ! blockSum = blockSum + 0_int_kind else if (present(mMask)) then diff --git a/cicecore/cicedyn/infrastructure/comm/mpi/ice_reprosum.F90 b/cicecore/cicedyn/infrastructure/comm/mpi/ice_reprosum.F90 index 8c6f90363..7c6c0eb77 100644 --- a/cicecore/cicedyn/infrastructure/comm/mpi/ice_reprosum.F90 +++ b/cicecore/cicedyn/infrastructure/comm/mpi/ice_reprosum.F90 @@ -87,7 +87,7 @@ MODULE ice_reprosum !----------------------------------------------------------------------- logical :: repro_sum_use_ddpdd = .false. -! logical :: detailed_timing = .false. + logical :: detailed_timing = .false. character(len=char_len_long) :: tmpstr CONTAINS @@ -100,10 +100,10 @@ MODULE ice_reprosum !----------------------------------------------------------------------- subroutine ice_reprosum_setopts(repro_sum_use_ddpdd_in, & - repro_sum_rel_diff_max_in, & - repro_sum_recompute_in, & - repro_sum_master, & - repro_sum_logunit ) + repro_sum_rel_diff_max_in, & + repro_sum_recompute_in, & + repro_sum_master, & + repro_sum_logunit ) !------------------------------Arguments-------------------------------- logical, intent(in), optional :: repro_sum_use_ddpdd_in @@ -260,12 +260,12 @@ end subroutine ice_reprosum_setopts !---------------------------------------------------------------------- subroutine ice_reprosum_calc (arr, arr_gsum, nsummands, dsummands, & - nflds, ddpdd_sum, & - arr_gbl_max, arr_gbl_max_out, & - arr_max_levels, arr_max_levels_out, & - gbl_max_nsummands, gbl_max_nsummands_out,& - gbl_count, repro_sum_validate, & - repro_sum_stats, rel_diff, commid ) + nflds, ddpdd_sum, & + arr_gbl_max, arr_gbl_max_out, & + arr_max_levels, arr_max_levels_out, & + gbl_max_nsummands, gbl_max_nsummands_out,& + gbl_count, repro_sum_validate, & + repro_sum_stats, rel_diff, commid ) !---------------------------------------------------------------------- ! Arguments @@ -434,7 +434,7 @@ subroutine ice_reprosum_calc (arr, arr_gsum, nsummands, dsummands, & ! if (detailed_timing) call xicex_timer_start('ice_reprosum_ddpdd') call ice_reprosum_ddpdd(arr, arr_gsum, nsummands, dsummands, & - nflds, mpi_comm) + nflds, mpi_comm) repro_sum_fast = 1 ! if (detailed_timing) call xicex_timer_stop('ice_reprosum_ddpdd') @@ -774,9 +774,9 @@ end subroutine ice_reprosum_calc !---------------------------------------------------------------------- subroutine ice_reprosum_int (arr, arr_gsum, nsummands, dsummands, nflds, & - arr_max_shift, arr_gmax_exp, max_levels, & - max_level, validate, recompute, & - omp_nthreads, mpi_comm ) + arr_max_shift, arr_gmax_exp, max_levels, & + max_level, validate, recompute, & + omp_nthreads, mpi_comm ) !---------------------------------------------------------------------- @@ -1224,7 +1224,7 @@ end subroutine ice_reprosum_int !---------------------------------------------------------------------- logical function ice_reprosum_tolExceeded (name, nflds, master, & - logunit, rel_diff ) + logunit, rel_diff ) !---------------------------------------------------------------------- ! Arguments @@ -1310,7 +1310,7 @@ end function ice_reprosum_tolExceeded !---------------------------------------------------------------------- subroutine ice_reprosum_ddpdd (arr, arr_gsum, nsummands, dsummands, & - nflds, mpi_comm ) + nflds, mpi_comm ) !---------------------------------------------------------------------- ! Arguments diff --git a/cicecore/cicedyn/infrastructure/comm/serial/ice_boundary.F90 b/cicecore/cicedyn/infrastructure/comm/serial/ice_boundary.F90 index aaebcfaad..faeaf3227 100644 --- a/cicecore/cicedyn/infrastructure/comm/serial/ice_boundary.F90 +++ b/cicecore/cicedyn/infrastructure/comm/serial/ice_boundary.F90 @@ -3749,7 +3749,7 @@ end subroutine ice_HaloUpdate4DI4 !*********************************************************************** ! This routine updates ghost cells for an input array using ! a second array as needed by the stress fields. -! This is just like 2DR8 except no averaging and only on tripole +! This is just like 2DR8 except no averaging and only on tripole subroutine ice_HaloUpdate_stress(array1, array2, halo, & fieldLoc, fieldKind, & diff --git a/cicecore/cicedyn/infrastructure/comm/serial/ice_exit.F90 b/cicecore/cicedyn/infrastructure/comm/serial/ice_exit.F90 index 2daadc0e6..39f2b6702 100644 --- a/cicecore/cicedyn/infrastructure/comm/serial/ice_exit.F90 +++ b/cicecore/cicedyn/infrastructure/comm/serial/ice_exit.F90 @@ -1,7 +1,9 @@ + +#define SERIAL_REMOVE_MPI + !======================================================================= ! ! Exit the model. -! ! authors William H. Lipscomb (LANL) ! Elizabeth C. Hunke (LANL) ! 2006 ECH: separated serial and mpi functionality @@ -9,10 +11,14 @@ module ice_exit use ice_kinds_mod - use ice_fileunits, only: nu_diag, flush_fileunit + use ice_fileunits, only: nu_diag, ice_stderr, flush_fileunit use icepack_intfc, only: icepack_warnings_flush, icepack_warnings_aborted -#ifdef CESMCOUPLED +#if (defined CESMCOUPLED) use shr_sys_mod +#else +#ifndef SERIAL_REMOVE_MPI + use mpi ! MPI Fortran module +#endif #endif implicit none @@ -24,7 +30,7 @@ module ice_exit !======================================================================= - subroutine abort_ice(error_message,file,line,doabort) + subroutine abort_ice(error_message, file, line, doabort) ! This routine aborts the ice model and prints an error message. @@ -33,30 +39,44 @@ subroutine abort_ice(error_message,file,line,doabort) integer (kind=int_kind), intent(in), optional :: line ! line number logical (kind=log_kind), intent(in), optional :: doabort ! abort flag - logical (kind=log_kind) :: ldoabort ! local doabort + ! local variables + + integer (int_kind) :: & + ierr, & ! MPI error flag + outunit, & ! output unit + error_code ! return code + logical (log_kind) :: ldoabort ! local doabort flag character(len=*), parameter :: subname='(abort_ice)' ldoabort = .true. if (present(doabort)) ldoabort = doabort -#ifdef CESMCOUPLED - call icepack_warnings_flush(nu_diag) - write(nu_diag,*) ' ' - write(nu_diag,*) subname, 'ABORTED: ' - if (present(file)) write (nu_diag,*) subname,' called from ',trim(file) - if (present(line)) write (nu_diag,*) subname,' line number ',line - if (present(error_message)) write (nu_diag,*) subname,' error = ',trim(error_message) - if (ldoabort) call shr_sys_abort(subname//trim(error_message)) +#if (defined CESMCOUPLED) + outunit = nu_diag #else - call icepack_warnings_flush(nu_diag) - write(nu_diag,*) ' ' - write(nu_diag,*) subname, 'ABORTED: ' - if (present(file)) write (nu_diag,*) subname,' called from ',trim(file) - if (present(line)) write (nu_diag,*) subname,' line number ',line - if (present(error_message)) write (nu_diag,*) subname,' error = ',trim(error_message) + outunit = ice_stderr +#endif + call flush_fileunit(nu_diag) - if (ldoabort) stop + call icepack_warnings_flush(nu_diag) + write(outunit,*) ' ' + write(outunit,*) subname, 'ABORTED: ' + if (present(file)) write (outunit,*) subname,' called from ',trim(file) + if (present(line)) write (outunit,*) subname,' line number ',line + if (present(error_message)) write (outunit,*) subname,' error = ',trim(error_message) + call flush_fileunit(outunit) + + if (ldoabort) then +#if (defined CESMCOUPLED) + call shr_sys_abort(subname//trim(error_message)) +#else +#ifndef SERIAL_REMOVE_MPI + error_code = 128 + call MPI_ABORT(MPI_COMM_WORLD, error_code, ierr) #endif + stop +#endif + endif end subroutine abort_ice @@ -64,10 +84,15 @@ end subroutine abort_ice subroutine end_run +! Ends run by calling MPI_FINALIZE +! Does nothing in serial runs + + integer (int_kind) :: ierr ! MPI error flag character(len=*), parameter :: subname = '(end_run)' -! Ends parallel run by calling MPI_FINALIZE. -! Does nothing in serial runs. +#ifndef SERIAL_REMOVE_MPI + call MPI_FINALIZE(ierr) +#endif end subroutine end_run diff --git a/cicecore/cicedyn/infrastructure/comm/serial/ice_global_reductions.F90 b/cicecore/cicedyn/infrastructure/comm/serial/ice_global_reductions.F90 index 5fcd45876..ed36cc6c0 100644 --- a/cicecore/cicedyn/infrastructure/comm/serial/ice_global_reductions.F90 +++ b/cicecore/cicedyn/infrastructure/comm/serial/ice_global_reductions.F90 @@ -182,7 +182,7 @@ function global_sum_dbl(array, dist, field_loc, mMask, lMask) & if (Nrow .and. this_block%tripoleTFlag) then maxiglob = 0 ! entire u-row on T-fold grid elseif (Nrow .or. this_block%tripoleTFlag) then - maxiglob = nx_global/2 ! half T-row on T-fold and u-row on u-fold + maxiglob = nx_global/2 ! half T-row on T-fold or half u-row on u-fold else maxiglob = -1 ! nothing to do for T-row on u-fold endif @@ -190,25 +190,45 @@ function global_sum_dbl(array, dist, field_loc, mMask, lMask) & n = (iblock-1)*nx_block*ny_block - do j=jb,je - do i=ib,ie - n = n + 1 - ! eliminate redundant points - if (maxiglob > 0 .and. j == je .and. this_block%i_glob(i) > maxiglob) then - work(n,1) = 0._dbl_kind - else - if (present(mMask)) then - work(n,1) = array(i,j,iblock)*mMask(i,j,iblock) - else if (present(lMask)) then - if (lMask(i,j,iblock)) then - work(n,1) = array(i,j,iblock) - endif - else + if (present(mMask)) then + do j=jb,je + do i=ib,ie + n = n + 1 + work(n,1) = array(i,j,iblock)*mMask(i,j,iblock) + end do + end do + elseif (present(lMask)) then + do j=jb,je + do i=ib,ie + n = n + 1 + if (lMask(i,j,iblock)) then work(n,1) = array(i,j,iblock) endif - endif - end do - end do + end do + end do + else + do j=jb,je + do i=ib,ie + n = n + 1 + work(n,1) = array(i,j,iblock) + enddo + enddo + endif + + if (maxiglob >= 0) then + ! eliminate redundant points at je + ! set n to (ib,je) index + n = (iblock-1)*nx_block*ny_block + n = n + (je-1-jb+1)*(ie-ib+1) + j=je + do i=ib,ie + n = n + 1 + if (this_block%i_glob(i) > maxiglob) then + work(n,1) = 0._dbl_kind + endif + end do + endif + end do call compute_sums_dbl(work,sums,communicator,numProcs) @@ -318,7 +338,7 @@ function global_sum_real(array, dist, field_loc, mMask, lMask) & if (Nrow .and. this_block%tripoleTFlag) then maxiglob = 0 ! entire u-row on T-fold grid elseif (Nrow .or. this_block%tripoleTFlag) then - maxiglob = nx_global/2 ! half T-row on T-fold and u-row on u-fold + maxiglob = nx_global/2 ! half T-row on T-fold or half u-row on u-fold else maxiglob = -1 ! nothing to do for T-row on u-fold endif @@ -326,25 +346,45 @@ function global_sum_real(array, dist, field_loc, mMask, lMask) & n = (iblock-1)*nx_block*ny_block - do j=jb,je - do i=ib,ie - n = n + 1 - ! eliminate redundant points - if (maxiglob > 0 .and. j == je .and. this_block%i_glob(i) > maxiglob) then - work(n,1) = 0._dbl_kind - else - if (present(mMask)) then - work(n,1) = real(array(i,j,iblock)*mMask(i,j,iblock),dbl_kind) - else if (present(lMask)) then - if (lMask(i,j,iblock)) then - work(n,1) = real(array(i,j,iblock),dbl_kind) - endif - else + if (present(mMask)) then + do j=jb,je + do i=ib,ie + n = n + 1 + work(n,1) = real(array(i,j,iblock)*mMask(i,j,iblock),dbl_kind) + end do + end do + elseif (present(lMask)) then + do j=jb,je + do i=ib,ie + n = n + 1 + if (lMask(i,j,iblock)) then work(n,1) = real(array(i,j,iblock),dbl_kind) endif - endif - end do - end do + end do + end do + else + do j=jb,je + do i=ib,ie + n = n + 1 + work(n,1) = real(array(i,j,iblock),dbl_kind) + enddo + enddo + endif + + if (maxiglob >= 0) then + ! eliminate redundant points at je + ! set n to (ib,je) index + n = (iblock-1)*nx_block*ny_block + n = n + (je-1-jb+1)*(ie-ib+1) + j=je + do i=ib,ie + n = n + 1 + if (this_block%i_glob(i) > maxiglob) then + work(n,1) = 0._dbl_kind + endif + end do + endif + end do call compute_sums_dbl(work,sums,communicator,numProcs) @@ -446,7 +486,7 @@ function global_sum_int(array, dist, field_loc, mMask, lMask) & if (Nrow .and. this_block%tripoleTFlag) then maxiglob = 0 ! entire u-row on T-fold grid elseif (Nrow .or. this_block%tripoleTFlag) then - maxiglob = nx_global/2 ! half T-row on T-fold and u-row on u-fold + maxiglob = nx_global/2 ! half T-row on T-fold or half u-row on u-fold else maxiglob = -1 ! nothing to do for T-row on u-fold endif @@ -457,7 +497,7 @@ function global_sum_int(array, dist, field_loc, mMask, lMask) & do j=jb,je do i=ib,ie ! eliminate redundant points - if (maxiglob > 0 .and. j == je .and. this_block%i_glob(i) > maxiglob) then + if (maxiglob >= 0 .and. j == je .and. this_block%i_glob(i) > maxiglob) then ! blockSum = blockSum + 0_int_kind else if (present(mMask)) then @@ -799,7 +839,7 @@ function global_sum_prod_dbl (array1, array2, dist, field_loc, & if (Nrow .and. this_block%tripoleTFlag) then maxiglob = 0 ! entire u-row on T-fold grid elseif (Nrow .or. this_block%tripoleTFlag) then - maxiglob = nx_global/2 ! half T-row on T-fold and u-row on u-fold + maxiglob = nx_global/2 ! half T-row on T-fold or half u-row on u-fold else maxiglob = -1 ! nothing to do for T-row on u-fold endif @@ -807,25 +847,45 @@ function global_sum_prod_dbl (array1, array2, dist, field_loc, & n = (iblock-1)*nx_block*ny_block - do j=jb,je - do i=ib,ie - n = n + 1 - ! eliminate redundant points - if (maxiglob > 0 .and. j == je .and. this_block%i_glob(i) > maxiglob) then - work(n,1) = 0._dbl_kind - else - if (present(mMask)) then - work(n,1) = array1(i,j,iblock)*array2(i,j,iblock)*mMask(i,j,iblock) - else if (present(lMask)) then - if (lMask(i,j,iblock)) then - work(n,1) = array1(i,j,iblock)*array2(i,j,iblock) - endif - else + if (present(mMask)) then + do j=jb,je + do i=ib,ie + n = n + 1 + work(n,1) = array1(i,j,iblock)*array2(i,j,iblock)*mMask(i,j,iblock) + end do + end do + elseif (present(lMask)) then + do j=jb,je + do i=ib,ie + n = n + 1 + if (lMask(i,j,iblock)) then work(n,1) = array1(i,j,iblock)*array2(i,j,iblock) endif - endif - end do - end do + end do + end do + else + do j=jb,je + do i=ib,ie + n = n + 1 + work(n,1) = array1(i,j,iblock)*array2(i,j,iblock) + enddo + enddo + endif + + if (maxiglob >= 0) then + ! eliminate redundant points at je + ! set n to (ib,je) index + n = (iblock-1)*nx_block*ny_block + n = n + (je-1-jb+1)*(ie-ib+1) + j=je + do i=ib,ie + n = n + 1 + if (this_block%i_glob(i) > maxiglob) then + work(n,1) = 0._dbl_kind + endif + end do + endif + end do call compute_sums_dbl(work,sums,communicator,numProcs) @@ -937,7 +997,7 @@ function global_sum_prod_real (array1, array2, dist, field_loc, & if (Nrow .and. this_block%tripoleTFlag) then maxiglob = 0 ! entire u-row on T-fold grid elseif (Nrow .or. this_block%tripoleTFlag) then - maxiglob = nx_global/2 ! half T-row on T-fold and u-row on u-fold + maxiglob = nx_global/2 ! half T-row on T-fold or half u-row on u-fold else maxiglob = -1 ! nothing to do for T-row on u-fold endif @@ -945,25 +1005,45 @@ function global_sum_prod_real (array1, array2, dist, field_loc, & n = (iblock-1)*nx_block*ny_block - do j=jb,je - do i=ib,ie - n = n + 1 - ! eliminate redundant points - if (maxiglob > 0 .and. j == je .and. this_block%i_glob(i) > maxiglob) then - work(n,1) = 0._dbl_kind - else - if (present(mMask)) then - work(n,1) = real(array1(i,j,iblock)*array2(i,j,iblock)*mMask(i,j,iblock),dbl_kind) - else if (present(lMask)) then - if (lMask(i,j,iblock)) then - work(n,1) = real(array1(i,j,iblock)*array2(i,j,iblock),dbl_kind) - endif - else + if (present(mMask)) then + do j=jb,je + do i=ib,ie + n = n + 1 + work(n,1) = real(array1(i,j,iblock)*array2(i,j,iblock)*mMask(i,j,iblock),dbl_kind) + end do + end do + elseif (present(lMask)) then + do j=jb,je + do i=ib,ie + n = n + 1 + if (lMask(i,j,iblock)) then work(n,1) = real(array1(i,j,iblock)*array2(i,j,iblock),dbl_kind) endif - endif - end do - end do + end do + end do + else + do j=jb,je + do i=ib,ie + n = n + 1 + work(n,1) = real(array1(i,j,iblock)*array2(i,j,iblock),dbl_kind) + enddo + enddo + endif + + if (maxiglob >= 0) then + ! eliminate redundant points at je + ! set n to (ib,je) index + n = (iblock-1)*nx_block*ny_block + n = n + (je-1-jb+1)*(ie-ib+1) + j=je + do i=ib,ie + n = n + 1 + if (this_block%i_glob(i) > maxiglob) then + work(n,1) = 0._dbl_kind + endif + end do + endif + end do call compute_sums_dbl(work,sums,communicator,numProcs) @@ -1067,7 +1147,7 @@ function global_sum_prod_int (array1, array2, dist, field_loc, & if (Nrow .and. this_block%tripoleTFlag) then maxiglob = 0 ! entire u-row on T-fold grid elseif (Nrow .or. this_block%tripoleTFlag) then - maxiglob = nx_global/2 ! half T-row on T-fold and u-row on u-fold + maxiglob = nx_global/2 ! half T-row on T-fold or half u-row on u-fold else maxiglob = -1 ! nothing to do for T-row on u-fold endif @@ -1078,7 +1158,7 @@ function global_sum_prod_int (array1, array2, dist, field_loc, & do j=jb,je do i=ib,ie ! eliminate redundant points - if (maxiglob > 0 .and. j == je .and. this_block%i_glob(i) > maxiglob) then + if (maxiglob >= 0 .and. j == je .and. this_block%i_glob(i) > maxiglob) then ! blockSum = blockSum + 0_int_kind else if (present(mMask)) then diff --git a/cicecore/cicedyn/infrastructure/ice_domain.F90 b/cicecore/cicedyn/infrastructure/ice_domain.F90 index ff1fac723..06d0d8ae1 100644 --- a/cicecore/cicedyn/infrastructure/ice_domain.F90 +++ b/cicecore/cicedyn/infrastructure/ice_domain.F90 @@ -172,7 +172,7 @@ subroutine init_domain_blocks if (my_task == master_task) then nml_name = 'domain_nml' write(nu_diag,*) subname,' Reading ', trim(nml_name) - + call get_fileunit(nu_nml) open (nu_nml, file=trim(nml_filename), status='old',iostat=nml_error) if (nml_error /= 0) then @@ -186,7 +186,7 @@ subroutine init_domain_blocks call abort_ice(subname//'ERROR: searching for '// trim(nml_name), & file=__FILE__, line=__LINE__) endif - + nml_error = 1 do while (nml_error > 0) read(nu_nml, nml=domain_nml,iostat=nml_error) 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 9df51635d..526d0d96d 100644 --- a/cicecore/cicedyn/infrastructure/io/io_binary/ice_history_write.F90 +++ b/cicecore/cicedyn/infrastructure/io/io_binary/ice_history_write.F90 @@ -157,7 +157,7 @@ subroutine ice_write_hist(ns) write (nu_hdr, 995) nrec,trim(avail_hist_fields(n)%vname), & trim(avail_hist_fields(n)%vcomment) - if (histfreq(ns) == '1' .or. .not. hist_avg & + 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_sig1(ns) .or. n==n_sig2(ns) & @@ -187,7 +187,7 @@ subroutine ice_write_hist(ns) write (nu_hdr, 994) nrec,trim(avail_hist_fields(n)%vname), & trim(avail_hist_fields(n)%vdesc),trim(avail_hist_fields(n)%vunit),nn - if (histfreq(ns) == '1' .or. .not. hist_avg .or. write_ic) then + if (histfreq(ns) == '1' .or. .not. hist_avg(ns) .or. write_ic) then write (nu_hdr, 996) nrec,trim(avail_hist_fields(n)%vname), & 'time_rep','instantaneous' else @@ -211,7 +211,7 @@ subroutine ice_write_hist(ns) write (nu_hdr, 993) nrec,trim(avail_hist_fields(n)%vname), & trim(avail_hist_fields(n)%vdesc),trim(avail_hist_fields(n)%vunit),k - if (histfreq(ns) == '1' .or. .not. hist_avg .or. write_ic) then + if (histfreq(ns) == '1' .or. .not. hist_avg(ns) .or. write_ic) then write (nu_hdr, 996) nrec,trim(avail_hist_fields(n)%vname), & 'time_rep','instantaneous' else @@ -235,7 +235,7 @@ subroutine ice_write_hist(ns) write (nu_hdr, 993) nrec,trim(avail_hist_fields(n)%vname), & trim(avail_hist_fields(n)%vdesc),trim(avail_hist_fields(n)%vunit),nn,k - if (histfreq(ns) == '1' .or. .not. hist_avg .or. write_ic) then + if (histfreq(ns) == '1' .or. .not. hist_avg(ns) .or. write_ic) then write (nu_hdr, 996) nrec,trim(avail_hist_fields(n)%vname), & 'time_rep','instantaneous' else @@ -259,7 +259,7 @@ subroutine ice_write_hist(ns) write (nu_hdr, 993) nrec,trim(avail_hist_fields(n)%vname), & trim(avail_hist_fields(n)%vdesc),trim(avail_hist_fields(n)%vunit),nn,k - if (histfreq(ns) == '1' .or. .not. hist_avg .or. write_ic) then + if (histfreq(ns) == '1' .or. .not. hist_avg(ns) .or. write_ic) then write (nu_hdr, 996) nrec,trim(avail_hist_fields(n)%vname), & 'time_rep','instantaneous' else @@ -283,7 +283,7 @@ subroutine ice_write_hist(ns) write (nu_hdr, 993) nrec,trim(avail_hist_fields(n)%vname), & trim(avail_hist_fields(n)%vdesc),trim(avail_hist_fields(n)%vunit),nn,k - if (histfreq(ns) == '1' .or. .not. hist_avg .or. write_ic) then + if (histfreq(ns) == '1' .or. .not. hist_avg(ns) .or. write_ic) then write (nu_hdr, 996) nrec,trim(avail_hist_fields(n)%vname), & 'time_rep','instantaneous' else @@ -308,7 +308,7 @@ subroutine ice_write_hist(ns) write (nu_hdr, 993) nrec,trim(avail_hist_fields(n)%vname), & trim(avail_hist_fields(n)%vdesc),trim(avail_hist_fields(n)%vunit),nn,k - if (histfreq(ns) == '1' .or. .not. hist_avg .or. write_ic) then + if (histfreq(ns) == '1' .or. .not. hist_avg(ns) .or. write_ic) then write (nu_hdr, 996) nrec,trim(avail_hist_fields(n)%vname), & 'time_rep','instantaneous' else @@ -334,7 +334,7 @@ subroutine ice_write_hist(ns) write (nu_hdr, 993) nrec,trim(avail_hist_fields(n)%vname), & trim(avail_hist_fields(n)%vdesc),trim(avail_hist_fields(n)%vunit),nn,k - if (histfreq(ns) == '1' .or. .not. hist_avg .or. write_ic) then + if (histfreq(ns) == '1' .or. .not. hist_avg(ns) .or. write_ic) then write (nu_hdr, 996) nrec,trim(avail_hist_fields(n)%vname), & 'time_rep','instantaneous' else @@ -360,7 +360,7 @@ subroutine ice_write_hist(ns) write (nu_hdr, 993) nrec,trim(avail_hist_fields(n)%vname), & trim(avail_hist_fields(n)%vdesc),trim(avail_hist_fields(n)%vunit),nn,k - if (histfreq(ns) == '1' .or. .not. hist_avg .or. write_ic) then + if (histfreq(ns) == '1' .or. .not. hist_avg(ns) .or. write_ic) then write (nu_hdr, 996) nrec,trim(avail_hist_fields(n)%vname), & 'time_rep','instantaneous' else 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 10d750300..25178ed6e 100644 --- a/cicecore/cicedyn/infrastructure/io/io_netcdf/ice_history_write.F90 +++ b/cicecore/cicedyn/infrastructure/io/io_netcdf/ice_history_write.F90 @@ -159,10 +159,10 @@ subroutine ice_write_hist (ns) ! define dimensions !----------------------------------------------------------------- - if (hist_avg .and. .not. write_ic) then - status = nf90_def_dim(ncid,'d2',2,boundid) + 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 d2') + 'ERROR: defining dim nbnd') endif status = nf90_def_dim(ncid,'ni',nx_global,imtid) @@ -213,7 +213,7 @@ subroutine ice_write_hist (ns) if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: defining var time') - status = nf90_put_att(ncid,varid,'long_name','model time') + status = nf90_put_att(ncid,varid,'long_name','time') if (status /= nf90_noerr) call abort_ice(subname// & 'ice Error: time long_name') @@ -230,7 +230,7 @@ subroutine ice_write_hist (ns) 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') + status = nf90_put_att(ncid,varid,'calendar','noleap') if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: time calendar') elseif (use_leap_years) then @@ -241,7 +241,7 @@ subroutine ice_write_hist (ns) call abort_ice(subname//'ERROR: invalid calendar settings') endif - if (hist_avg .and. .not. write_ic) then + 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') @@ -251,14 +251,14 @@ subroutine ice_write_hist (ns) ! Define attributes for time bounds if hist_avg is true !----------------------------------------------------------------- - if (hist_avg .and. .not. write_ic) then + 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', & - 'boundaries for time-averaging interval') + 'time interval endpoints') if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: time_bounds long_name') write(cdate,'(i8.8)') idate0 @@ -268,6 +268,22 @@ subroutine ice_write_hist (ns) 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 !----------------------------------------------------------------- @@ -745,7 +761,7 @@ subroutine ice_write_hist (ns) ! write time_bounds info !----------------------------------------------------------------- - if (hist_avg .and. .not. write_ic) then + 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') @@ -1279,7 +1295,7 @@ subroutine ice_write_hist_attrs(ncid, varid, hfield, ns) call ice_write_hist_fill(ncid,varid,hfield%vname,history_precision) ! Add cell_methods attribute to variables if averaged - if (hist_avg .and. .not. write_ic) then + if (hist_avg(ns) .and. .not. write_ic) then if (TRIM(hfield%vname(1:4))/='sig1' & .and.TRIM(hfield%vname(1:4))/='sig2' & .and.TRIM(hfield%vname(1:9))/='sistreave' & @@ -1292,7 +1308,7 @@ subroutine ice_write_hist_attrs(ncid, varid, hfield, ns) endif if ((histfreq(ns) == '1' .and. histfreq_n(ns) == 1) & - .or..not. hist_avg & + .or..not. hist_avg(ns) & .or. write_ic & .or.TRIM(hfield%vname(1:4))=='divu' & .or.TRIM(hfield%vname(1:5))=='shear' & 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 25f9850ce..35ec7bed2 100644 --- a/cicecore/cicedyn/infrastructure/io/io_pio2/ice_history_write.F90 +++ b/cicecore/cicedyn/infrastructure/io/io_pio2/ice_history_write.F90 @@ -195,8 +195,8 @@ subroutine ice_write_hist (ns) ! define dimensions !----------------------------------------------------------------- - if (hist_avg .and. .not. write_ic) then - status = pio_def_dim(File,'d2',2,boundid) + if (hist_avg(ns) .and. .not. write_ic) then + status = pio_def_dim(File,'nbnd',2,boundid) endif status = pio_def_dim(File,'ni',nx_global,imtid) @@ -215,7 +215,7 @@ subroutine ice_write_hist (ns) !----------------------------------------------------------------- status = pio_def_var(File,'time',pio_double,(/timid/),varid) - status = pio_put_att(File,varid,'long_name','model time') + 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 ', & @@ -226,24 +226,35 @@ subroutine ice_write_hist (ns) 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') + 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 - if (hist_avg .and. .not. write_ic) then + if (hist_avg(ns) .and. .not. write_ic) then status = pio_put_att(File,varid,'bounds','time_bounds') endif ! Define attributes for time_bounds if hist_avg is true - if (hist_avg .and. .not. write_ic) then + 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', & - 'boundaries for time-averaging interval') + '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),' ', & @@ -702,7 +713,7 @@ subroutine ice_write_hist (ns) ! write time_bounds info !----------------------------------------------------------------- - if (hist_avg .and. .not. write_ic) then + 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/) @@ -1250,7 +1261,7 @@ subroutine ice_write_hist_attrs(File, varid, hfield, ns) call ice_write_hist_fill(File,varid,hfield%vname,history_precision) ! Add cell_methods attribute to variables if averaged - if (hist_avg .and. .not. write_ic) then + if (hist_avg(ns) .and. .not. write_ic) then if (TRIM(hfield%vname(1:4))/='sig1' & .and.TRIM(hfield%vname(1:4))/='sig2' & .and.TRIM(hfield%vname(1:9))/='sistreave' & @@ -1261,7 +1272,7 @@ subroutine ice_write_hist_attrs(File, varid, hfield, ns) endif if ((histfreq(ns) == '1' .and. histfreq_n(ns) == 1) & - .or..not. hist_avg & + .or..not. hist_avg(ns) & .or. write_ic & .or.TRIM(hfield%vname(1:4))=='divu' & .or.TRIM(hfield%vname(1:5))=='shear' & diff --git a/cicecore/drivers/unittest/sumchk/sumchk.F90 b/cicecore/drivers/unittest/sumchk/sumchk.F90 index d9ea72d8c..1a2745aea 100644 --- a/cicecore/drivers/unittest/sumchk/sumchk.F90 +++ b/cicecore/drivers/unittest/sumchk/sumchk.F90 @@ -16,10 +16,10 @@ program sumchk use ice_communicate, only: my_task, master_task, get_num_procs use ice_domain_size, only: nx_global, ny_global use ice_domain_size, only: block_size_x, block_size_y, max_blocks - use ice_domain, only: distrb_info + use ice_domain, only: distrb_info, ns_boundary_type use ice_blocks, only: block, get_block, nx_block, ny_block, nblocks_tot use ice_distribution, only: ice_distributionGetBlockID, ice_distributionGet - use ice_constants, only: field_loc_center, field_loc_Nface + use ice_constants, only: field_loc_center, field_loc_Nface, field_loc_Eface, field_loc_NEcorner use ice_fileunits, only: bfbflag use ice_global_reductions use ice_exit, only: abort_ice, end_run @@ -113,6 +113,13 @@ program sumchk write(6,*) ' block_size_y = ',block_size_y write(6,*) ' nblocks_tot = ',nblocks_tot write(6,*) ' ' + write(6,*) ' Values are generally O(1.), lscale is the relative size of' + write(6,*) ' values set in the array to test precision. A pair of equal' + write(6,*) ' and opposite values of O(lscale) are placed in the array.' + write(6,*) ' "easy" sets the lscaled values at the start of the array so' + write(6,*) ' are added to the sum first. Otherwise, the lscaled values' + write(6,*) ' are set near the end of the array and to create precision' + write(6,*) ' challenges in the global sums' endif ! --------------------------- @@ -165,7 +172,7 @@ program sumchk reldigchk(4,4) = 0. reldigchk(5,4) = 15. if (nx_global == 360 .and. ny_global == 240) then - reldigchk(1:3,1) = 13. + reldigchk(1:3,1) = 12.5 reldigchk(5,4) = 14. endif #else @@ -181,7 +188,7 @@ program sumchk reldigchk(4,4) = 0. reldigchk(5,4) = 15. if (nx_global == 360 .and. ny_global == 240) then - reldigchk(1:2,1) = 13. + reldigchk(1:2,1) = 12.5 reldigchk(5,4) = 14. endif #endif @@ -212,20 +219,22 @@ program sumchk ! set corval to something a little interesting (not 1.0 for instance which gives atypical results) corval = 4.0_dbl_kind/3.0_dbl_kind iocval = 8 - ! tuned for gx3 and tx1 only - if ((nx_global == 100 .and. ny_global == 116) .or. & - (nx_global == 360 .and. ny_global == 240)) then - if (field_loc(m) == field_loc_Nface .and. nx_global == 360 .and. ny_global == 240) then - ! tx1 tripole face, need to adjust local value to remove half of row at ny_global - ! or modify corval to account for different sum - locval = corval / real((nblocks_tot*(block_size_x*block_size_y-2)-nx_global/2),dbl_kind) - corvali = (nblocks_tot*(block_size_x*block_size_y-2)-nx_global/2)*iocval - else - locval = corval / real(nblocks_tot*(block_size_x*block_size_y-2),dbl_kind) - corvali = nblocks_tot*(block_size_x*block_size_y-2)*iocval - endif + if ((ns_boundary_type == 'tripoleT' .and. field_loc(m) == field_loc_Nface ) .or. & + (ns_boundary_type == 'tripoleT' .and. field_loc(m) == field_loc_NEcorner)) then + ! remove full row at ny_global + locval = corval / real((nblocks_tot*(block_size_x*block_size_y-2)-nx_global),dbl_kind) + corvali = (nblocks_tot*(block_size_x*block_size_y-2)-nx_global)*iocval + elseif ((ns_boundary_type == 'tripoleT' .and. field_loc(m) == field_loc_center ) .or. & + (ns_boundary_type == 'tripoleT' .and. field_loc(m) == field_loc_Eface ) .or. & + (ns_boundary_type == 'tripole' .and. field_loc(m) == field_loc_NEcorner) .or. & + (ns_boundary_type == 'tripole' .and. field_loc(m) == field_loc_Nface )) then + ! remove half of row at ny_global + locval = corval / real((nblocks_tot*(block_size_x*block_size_y-2)-nx_global/2),dbl_kind) + corvali = (nblocks_tot*(block_size_x*block_size_y-2)-nx_global/2)*iocval else - call abort_ice(subname//' ERROR not set for this grid ') + ! all gridcells + locval = corval / real(nblocks_tot*(block_size_x*block_size_y-2),dbl_kind) + corvali = nblocks_tot*(block_size_x*block_size_y-2)*iocval endif do l = 1, nscale @@ -253,18 +262,18 @@ program sumchk jb = this_block%jlo je = this_block%jhi - lmask(ie,je-1,iblock) = .false. - lmask(ie,je-2,iblock) = .false. - arrayA(ie,je-1,iblock) = locval * lscale(l) + lmask(ie,je-1,iblock) = .false. + lmask(ie,je-2,iblock) = .false. + arrayA(ie,je-1,iblock) = locval * lscale(l) arrayA(ie,je-2,iblock) = -arrayA(ie,je-1,iblock) - arrayB(ie,je-1,iblock) = locval * lscale(l) + arrayB(ie,je-1,iblock) = locval * lscale(l) arrayB(ie,je-2,iblock) = arrayB(ie,je-1,iblock) arrayC(ib,jb,iblock) = locval * lscale(l) arrayC(ib+1,jb,iblock) = -arrayC(ib,jb,iblock) - arrayiA(:,:,iblock) = iocval - arrayiB(:,:,iblock) = iocval - arrayiA(ie,je-1,iblock) = 13 * iocval - arrayiA(ie,je-2,iblock) = -arrayiA(ie,je-1,iblock) + arrayiA(:,:,iblock) = iocval + arrayiB(:,:,iblock) = iocval + arrayiA(ie,je-1,iblock)= 13 * iocval + arrayiA(ie,je-2,iblock)= -arrayiA(ie,je-1,iblock) enddo do k = 1,ntests1 diff --git a/cicecore/shared/ice_fileunits.F90 b/cicecore/shared/ice_fileunits.F90 index 72a40f513..d4823d175 100644 --- a/cicecore/shared/ice_fileunits.F90 +++ b/cicecore/shared/ice_fileunits.F90 @@ -328,32 +328,32 @@ end subroutine flush_fileunit subroutine goto_nml(iunit, nml, status) ! Search to namelist group within ice_in file. ! for compilers that do not allow optional namelists - + ! passed variables integer(kind=int_kind), intent(in) :: & iunit ! namelist file unit - + character(len=*), intent(in) :: & nml ! namelist to search for - + integer(kind=int_kind), intent(out) :: & status ! status of subrouine - + ! local variables character(len=char_len) :: & file_str, & ! string in file nml_str ! namelist string to test - + integer(kind=int_kind) :: & i, n ! dummy integers - - + + ! rewind file rewind(iunit) - + ! define test string with ampersand nml_str = '&' // trim(adjustl(nml)) - + ! search for the record containing the namelist group we're looking for do read(iunit, '(a)', iostat=status) file_str @@ -365,10 +365,10 @@ subroutine goto_nml(iunit, nml, status) end if end if end do - + ! backspace to namelist name in file backspace(iunit) - + end subroutine goto_nml !======================================================================= diff --git a/configuration/scripts/ice_in b/configuration/scripts/ice_in index d51f114e0..d8273bf0e 100644 --- a/configuration/scripts/ice_in +++ b/configuration/scripts/ice_in @@ -48,7 +48,7 @@ histfreq = 'm','x','x','x','x' histfreq_n = 1 , 1 , 1 , 1 , 1 histfreq_base = 'zero' - hist_avg = .true. + hist_avg = .true.,.true.,.true.,.true.,.true. history_dir = './history/' history_file = 'iceh' history_precision = 4 diff --git a/configuration/scripts/options/set_nml.histinst b/configuration/scripts/options/set_nml.histinst index f2f0995c8..31d566d76 100644 --- a/configuration/scripts/options/set_nml.histinst +++ b/configuration/scripts/options/set_nml.histinst @@ -1 +1 @@ -hist_avg = .false. +hist_avg = .false.,.false.,.false.,.false.,.false. diff --git a/configuration/scripts/options/set_nml.qc b/configuration/scripts/options/set_nml.qc index feefb376d..5de4dd28e 100644 --- a/configuration/scripts/options/set_nml.qc +++ b/configuration/scripts/options/set_nml.qc @@ -12,5 +12,5 @@ dumpfreq_n = 12 diagfreq = 24 histfreq = 'd','x','x','x','x' f_hi = 'd' -hist_avg = .false. +hist_avg = .false.,.false.,.false.,.false.,.false. distribution_wght = 'blockall' diff --git a/configuration/scripts/options/set_nml.run3dt b/configuration/scripts/options/set_nml.run3dt index 4ff27ce22..11a8c0f85 100644 --- a/configuration/scripts/options/set_nml.run3dt +++ b/configuration/scripts/options/set_nml.run3dt @@ -2,6 +2,6 @@ npt_unit = '1' npt = 3 dump_last = .true. histfreq = '1','x','x','x','x' -hist_avg = .false. +hist_avg = .false.,.false.,.false.,.false.,.false. f_uvel = '1' f_vvel = '1' diff --git a/configuration/scripts/tests/unittest_suite.ts b/configuration/scripts/tests/unittest_suite.ts index 7486e87aa..e64bea2f7 100644 --- a/configuration/scripts/tests/unittest_suite.ts +++ b/configuration/scripts/tests/unittest_suite.ts @@ -5,6 +5,7 @@ unittest gx3 1x1 calchk,short unittest gx3 4x1x25x29x4 sumchk unittest gx3 1x1x25x29x16 sumchk unittest tx1 8x1 sumchk +unittest tx1 8x1 sumchk,tripolet unittest gx3 4x1 bcstchk unittest gx3 1x1 bcstchk unittest gx3 8x2 gridavgchk,dwblockall diff --git a/doc/source/cice_index.rst b/doc/source/cice_index.rst index b338dc72d..cc02bd7c4 100644 --- a/doc/source/cice_index.rst +++ b/doc/source/cice_index.rst @@ -314,10 +314,10 @@ either Celsius or Kelvin units). Deprecated parameters are listed at the end. "highfreq", "high-frequency atmo coupling", "F" "hin_old", "ice thickness prior to growth/melt", "m" "hin_max", "category thickness limits", "m" - "hist_avg", "if true, write averaged data instead of snapshots", "T" - "histfreq", "units of history output frequency: y, m, w, d or 1", "" + "hist_avg", "if true, write averaged data instead of snapshots", "T,T,T,T,T" + "histfreq", "units of history output frequency: y, m, w, d or 1", "m,x,x,x,x" "histfreq_base", "reference date for history output", "" - "histfreq_n", "integer output frequency in histfreq units", "" + "histfreq_n", "integer output frequency in histfreq units", "1,1,1,1,1" "history_dir", "path to history output files", "" "history_file", "history output file prefix", "" "history_format", "history file format", "" diff --git a/doc/source/user_guide/ug_case_settings.rst b/doc/source/user_guide/ug_case_settings.rst index 3b99c9238..80df4d36c 100644 --- a/doc/source/user_guide/ug_case_settings.rst +++ b/doc/source/user_guide/ug_case_settings.rst @@ -178,7 +178,7 @@ setup_nml "", "zero", "restart output frequency relative to year-month-day of 0000-01-01", "" "``dumpfreq_n``", "integer", "write restart frequency with ``dumpfreq``", "1" "``dump_last``", "logical", "write restart on last time step of simulation", "``.false.``" - "``hist_avg``", "logical", "write time-averaged data", "``.true.``" + "``hist_avg``", "logical", "write time-averaged data", "``.true.,.true.,.true.,.true.,.true.``" "``histfreq``", "``d``", "write history every ``histfreq_n`` days", "'1','h','d','m','y'" "", "``h``", "write history every ``histfreq_n`` hours", "" "", "``m``", "write history every ``histfreq_n`` months", "" diff --git a/doc/source/user_guide/ug_implementation.rst b/doc/source/user_guide/ug_implementation.rst index d9ea07a02..acc75b3d8 100644 --- a/doc/source/user_guide/ug_implementation.rst +++ b/doc/source/user_guide/ug_implementation.rst @@ -1154,7 +1154,8 @@ io package. The namelist variable ``history_format`` further refines the format approach or style for some io packages. Model output data can be written as instantaneous or average data as specified -by the ``hist_avg`` namelist flag. The data is written at the period(s) given by ``histfreq`` and +by the ``hist_avg`` namelist array and is customizable by stream. The data is +written at the period(s) given by ``histfreq`` and ``histfreq_n`` relative to a reference date specified by ``histfreq_base``. The files are written to binary or netCDF files prepended by ``history_file`` in **ice_in**. These settings for history files are set in the @@ -1206,7 +1207,7 @@ For example, in the namelist: histfreq = ’1’, ’h’, ’d’, ’m’, ’y’ histfreq_n = 1, 6, 0, 1, 1 histfreq_base = 'zero' - hist_avg = .true. + hist_avg = .true.,.true.,.true.,.true.,.true. f_hi = ’1’ f_hs = ’h’ f_Tsfc = ’d’ diff --git a/icepack b/icepack index 5f4cd195b..2fc81b415 160000 --- a/icepack +++ b/icepack @@ -1 +1 @@ -Subproject commit 5f4cd195b731b6af35e46efad4f2e6c19d17feee +Subproject commit 2fc81b415874017221ca3561c28ca14c6ce643da