From 942449751275ebd884abb5752d03d7ea64b72664 Mon Sep 17 00:00:00 2001 From: "David A. Bailey" Date: Thu, 23 Mar 2023 16:46:05 -0600 Subject: [PATCH 01/76] Fix CESMCOUPLED compile issue in icepack. (#823) * Fix CESMCOUPLED compile problem in icepack --- icepack | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/icepack b/icepack index a4779cc71..008f5f697 160000 --- a/icepack +++ b/icepack @@ -1 +1 @@ -Subproject commit a4779cc71125b40a7db3a4da8512247cbf2b0955 +Subproject commit 008f5f697b7aac319251845420d51b08c2c54d03 From 5b0418a9f6d181d668ddebdc2c540566529e4125 Mon Sep 17 00:00:00 2001 From: Tony Craig Date: Wed, 5 Apr 2023 13:29:21 -0700 Subject: [PATCH 02/76] 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 --- cicecore/cicedyn/analysis/ice_diagnostics.F90 | 6 +- cicecore/cicedyn/dynamics/ice_dyn_vp.F90 | 41 ++-- .../infrastructure/comm/mpi/ice_exit.F90 | 60 ++--- .../comm/mpi/ice_global_reductions.F90 | 232 ++++++++++++------ .../infrastructure/comm/mpi/ice_reprosum.F90 | 34 +-- .../infrastructure/comm/serial/ice_exit.F90 | 69 ++++-- .../comm/serial/ice_global_reductions.F90 | 232 ++++++++++++------ cicecore/drivers/unittest/sumchk/sumchk.F90 | 59 +++-- configuration/scripts/tests/unittest_suite.ts | 1 + 9 files changed, 466 insertions(+), 268 deletions(-) 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/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/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_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/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/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 From 35ec167dc6beee685a6e9485b8a1db3604d566bd Mon Sep 17 00:00:00 2001 From: "David A. Bailey" Date: Wed, 17 May 2023 14:56:26 -0600 Subject: [PATCH 03/76] 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 --- .readthedocs.yaml | 29 ++++++++++++++ cicecore/cicedyn/analysis/ice_history.F90 | 2 +- .../cicedyn/analysis/ice_history_shared.F90 | 6 +-- cicecore/cicedyn/general/ice_init.F90 | 7 ++-- .../io/io_binary/ice_history_write.F90 | 18 ++++----- .../io/io_netcdf/ice_history_write.F90 | 38 +++++++++++++------ .../io/io_pio2/ice_history_write.F90 | 31 ++++++++++----- configuration/scripts/ice_in | 2 +- .../scripts/options/set_nml.histinst | 2 +- configuration/scripts/options/set_nml.qc | 2 +- configuration/scripts/options/set_nml.run3dt | 2 +- doc/source/cice_index.rst | 6 +-- doc/source/user_guide/ug_case_settings.rst | 2 +- doc/source/user_guide/ug_implementation.rst | 5 ++- 14 files changed, 104 insertions(+), 48 deletions(-) create mode 100644 .readthedocs.yaml 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_history.F90 b/cicecore/cicedyn/analysis/ice_history.F90 index 54b6ce934..598f05a61 100644 --- a/cicecore/cicedyn/analysis/ice_history.F90 +++ b/cicecore/cicedyn/analysis/ice_history.F90 @@ -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_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/general/ice_init.F90 b/cicecore/cicedyn/general/ice_init.F90 index 4c8fb1fee..2f2e5802b 100644 --- a/cicecore/cicedyn/general/ice_init.F90 +++ b/cicecore/cicedyn/general/ice_init.F90 @@ -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 @@ -901,7 +901,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) @@ -2311,8 +2311,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/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/configuration/scripts/ice_in b/configuration/scripts/ice_in index 32db0270b..8dc046da5 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/doc/source/cice_index.rst b/doc/source/cice_index.rst index 000004bb9..0c0ab6971 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 9906fba87..2a7240c78 100644 --- a/doc/source/user_guide/ug_case_settings.rst +++ b/doc/source/user_guide/ug_case_settings.rst @@ -176,7 +176,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’ From b98b8ae899fb2a1af816105e05470b829f8b3294 Mon Sep 17 00:00:00 2001 From: Tony Craig Date: Wed, 24 May 2023 09:56:10 -0700 Subject: [PATCH 04/76] Update Icepack to #6703bc533c968 May 22, 2023 (#829) Remove trailing blanks via automated tool in some Fortran files --- cicecore/cicedyn/analysis/ice_history.F90 | 2 +- .../cicedyn/analysis/ice_history_pond.F90 | 6 ++--- .../cicedyn/analysis/ice_history_snow.F90 | 2 +- cicecore/cicedyn/general/ice_init.F90 | 24 +++++++++---------- .../comm/serial/ice_boundary.F90 | 2 +- .../cicedyn/infrastructure/ice_domain.F90 | 4 ++-- cicecore/shared/ice_fileunits.F90 | 22 ++++++++--------- icepack | 2 +- 8 files changed, 32 insertions(+), 32 deletions(-) diff --git a/cicecore/cicedyn/analysis/ice_history.F90 b/cicecore/cicedyn/analysis/ice_history.F90 index 598f05a61..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 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_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/general/ice_init.F90 b/cicecore/cicedyn/general/ice_init.F90 index 2f2e5802b..1baaa95b3 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)' @@ -609,7 +609,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) @@ -657,7 +657,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) @@ -681,7 +681,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) @@ -699,7 +699,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 @@ -724,7 +724,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 @@ -749,14 +749,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) @@ -774,14 +774,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) @@ -821,7 +821,7 @@ subroutine input_data endif end do - ! done reading namelist. + ! done reading namelist. close(nu_nml) call release_fileunit(nu_nml) endif 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/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/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/icepack b/icepack index 008f5f697..6703bc533 160000 --- a/icepack +++ b/icepack @@ -1 +1 @@ -Subproject commit 008f5f697b7aac319251845420d51b08c2c54d03 +Subproject commit 6703bc533c96802235e2f20de5fffc0bc6cc4c97 From 8e2aab217ece5fae933a1f2ad6e0d6ab81ecad8a Mon Sep 17 00:00:00 2001 From: "David A. Bailey" Date: Tue, 20 Jun 2023 08:54:25 -0600 Subject: [PATCH 05/76] 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 --- cicecore/drivers/nuopc/cmeps/ice_mesh_mod.F90 | 20 +++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/cicecore/drivers/nuopc/cmeps/ice_mesh_mod.F90 b/cicecore/drivers/nuopc/cmeps/ice_mesh_mod.F90 index a9b19df6b..601e59c7c 100644 --- a/cicecore/drivers/nuopc/cmeps/ice_mesh_mod.F90 +++ b/cicecore/drivers/nuopc/cmeps/ice_mesh_mod.F90 @@ -559,7 +559,7 @@ subroutine ice_mesh_check(gcomp, ice_mesh, rc) ! Check CICE mesh - use ice_constants, only : c1,c0,c360 + use ice_constants, only : c1,c0,c180,c360 use ice_grid , only : tlon, tlat, hm ! input/output parameters @@ -583,7 +583,7 @@ subroutine ice_mesh_check(gcomp, ice_mesh, rc) real(dbl_kind) :: diff_lon real(dbl_kind) :: diff_lat real(dbl_kind) :: rad_to_deg - real(dbl_kind) :: tmplon, eps_imesh + real(dbl_kind) :: eps_imesh logical :: isPresent, isSet logical :: mask_error integer :: mask_internal @@ -637,19 +637,19 @@ subroutine ice_mesh_check(gcomp, ice_mesh, rc) lon(n) = tlon(i,j,iblk)*rad_to_deg lat(n) = tlat(i,j,iblk)*rad_to_deg - tmplon = lon(n) - if(tmplon < c0)tmplon = tmplon + c360 - ! error check differences between internally generated lons and those read in - diff_lon = abs(mod(lonMesh(n) - tmplon,360.0)) - if (diff_lon > eps_imesh ) then - write(6,100)n,lonMesh(n),tmplon, diff_lon - !call abort_ice(error_message=subname, file=__FILE__, line=__LINE__) + diff_lon = mod(abs(lonMesh(n) - lon(n)),360.0) + if (diff_lon > c180) then + diff_lon = diff_lon - c360 + endif + if (abs(diff_lon) > eps_imesh ) then + write(6,100)n,lonMesh(n),lon(n), diff_lon + call abort_ice(error_message=subname, file=__FILE__, line=__LINE__) end if diff_lat = abs(latMesh(n) - lat(n)) if (diff_lat > eps_imesh) then write(6,101)n,latMesh(n),lat(n), diff_lat - !call abort_ice(error_message=subname, file=__FILE__, line=__LINE__) + call abort_ice(error_message=subname, file=__FILE__, line=__LINE__) end if enddo enddo From 7eb4dd7e7e2796c5718061d06b86ff602b9d29cc Mon Sep 17 00:00:00 2001 From: Tony Craig Date: Tue, 20 Jun 2023 09:40:55 -0700 Subject: [PATCH 06/76] 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 --- .readthedocs.yaml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/.readthedocs.yaml b/.readthedocs.yaml index f83760cce..cc2b2817b 100644 --- a/.readthedocs.yaml +++ b/.readthedocs.yaml @@ -20,8 +20,8 @@ sphinx: configuration: doc/source/conf.py # If using Sphinx, optionally build your docs in additional formats such as PDF -# formats: -# - pdf +formats: + - pdf # Optionally declare the Python requirements required to build your docs python: From 34dc66707f6b691b1689bf36689591af3e8df270 Mon Sep 17 00:00:00 2001 From: "David A. Bailey" Date: Thu, 6 Jul 2023 21:46:58 -0600 Subject: [PATCH 07/76] 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. --- .../cicedyn/analysis/ice_history_shared.F90 | 2 ++ cicecore/cicedyn/general/ice_init.F90 | 12 ++++++++++- .../io/io_netcdf/ice_history_write.F90 | 21 +++++++++++++++---- .../io/io_pio2/ice_history_write.F90 | 16 +++++++++++--- configuration/scripts/ice_in | 1 + doc/source/cice_index.rst | 1 + doc/source/user_guide/ug_case_settings.rst | 1 + doc/source/user_guide/ug_implementation.rst | 7 +++++-- 8 files changed, 51 insertions(+), 10 deletions(-) diff --git a/cicecore/cicedyn/analysis/ice_history_shared.F90 b/cicecore/cicedyn/analysis/ice_history_shared.F90 index f4e1f3ebf..3c31f23ca 100644 --- a/cicecore/cicedyn/analysis/ice_history_shared.F90 +++ b/cicecore/cicedyn/analysis/ice_history_shared.F90 @@ -132,6 +132,8 @@ module ice_history_shared time_end(max_nstrm), & time_bounds(2) + character (len=char_len), public :: hist_time_axis + real (kind=dbl_kind), allocatable, public :: & a2D (:,:,:,:) , & ! field accumulations/averages, 2D a3Dz(:,:,:,:,:) , & ! field accumulations/averages, 3D vertical diff --git a/cicecore/cicedyn/general/ice_init.F90 b/cicecore/cicedyn/general/ice_init.F90 index 1baaa95b3..2c8b1db3b 100644 --- a/cicecore/cicedyn/general/ice_init.F90 +++ b/cicecore/cicedyn/general/ice_init.F90 @@ -81,7 +81,7 @@ subroutine input_data runid, runtype, use_restart_time, restart_format, lcdf64 use ice_history_shared, only: hist_avg, history_dir, history_file, & incond_dir, incond_file, version_name, & - history_precision, history_format + history_precision, history_format, hist_time_axis use ice_flux, only: update_ocn_f, l_mpond_fresh use ice_flux, only: default_season use ice_flux_bgc, only: cpl_bgc @@ -185,6 +185,7 @@ subroutine input_data restart_ext, use_restart_time, restart_format, lcdf64, & pointer_file, dumpfreq, dumpfreq_n, dump_last, & diagfreq, diag_type, diag_file, history_format,& + hist_time_axis, & print_global, print_points, latpnt, lonpnt, & debug_forcing, histfreq, histfreq_n, hist_avg, & history_dir, history_file, history_precision, cpl_bgc, & @@ -324,6 +325,8 @@ subroutine input_data histfreq_base = 'zero' ! output frequency reference date hist_avg(:) = .true. ! if true, write time-averages (not snapshots) history_format = 'default' ! history file format + 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 @@ -906,6 +909,7 @@ 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(hist_time_axis, master_task) call broadcast_scalar(write_ic, master_task) call broadcast_scalar(cpl_bgc, master_task) call broadcast_scalar(incond_dir, master_task) @@ -1570,6 +1574,11 @@ subroutine input_data abort_list = trim(abort_list)//":24" endif + 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 + if(dumpfreq_base /= 'init' .and. dumpfreq_base /= 'zero') then write (nu_diag,*) subname//' ERROR: bad value for dumpfreq_base, allowed values: init, zero' abort_list = trim(abort_list)//":25" @@ -2316,6 +2325,7 @@ subroutine input_data 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) ' hist_time_axis = ', trim(hist_time_axis) if (write_ic) then write(nu_diag,1039) ' Initial condition will be written in ', & trim(incond_dir) 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 25178ed6e..bfbe31707 100644 --- a/cicecore/cicedyn/infrastructure/io/io_netcdf/ice_history_write.F90 +++ b/cicecore/cicedyn/infrastructure/io/io_netcdf/ice_history_write.F90 @@ -21,7 +21,7 @@ module ice_history_write - use ice_constants, only: c0, c360, spval, spval_dbl + use ice_constants, only: c0, c360, p5, spval, spval_dbl use ice_fileunits, only: nu_diag use ice_exit, only: abort_ice use icepack_intfc, only: icepack_warnings_flush, icepack_warnings_aborted @@ -137,8 +137,6 @@ subroutine ice_write_hist (ns) if (my_task == master_task) then - ltime2 = timesecs/secday - call construct_filename(ncfile(ns),'nc',ns) ! add local directory path name to ncfile @@ -718,6 +716,12 @@ subroutine ice_write_hist (ns) '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) @@ -749,7 +753,16 @@ subroutine ice_write_hist (ns) !----------------------------------------------------------------- ! 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 + status = nf90_inq_varid(ncid,'time',varid) if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: getting time varid') 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 35ec7bed2..877071a11 100644 --- a/cicecore/cicedyn/infrastructure/io/io_pio2/ice_history_write.F90 +++ b/cicecore/cicedyn/infrastructure/io/io_pio2/ice_history_write.F90 @@ -18,7 +18,7 @@ module ice_history_write use ice_kinds_mod - use ice_constants, only: c0, c360, spval, spval_dbl + use ice_constants, only: c0, c360, p5, spval, spval_dbl use ice_fileunits, only: nu_diag use ice_exit, only: abort_ice use icepack_intfc, only: icepack_warnings_flush, icepack_warnings_aborted @@ -185,8 +185,6 @@ subroutine ice_write_hist (ns) call ice_pio_initdecomp(ndim3=nzslyr, ndim4=ncat_hist, iodesc=iodesc4ds, precision=history_precision) call ice_pio_initdecomp(ndim3=nfsd_hist, ndim4=ncat_hist, iodesc=iodesc4df, precision=history_precision) - ltime2 = timesecs/secday - ! option of turning on double precision history files lprecision = pio_real if (history_precision == 8) lprecision = pio_double @@ -678,6 +676,9 @@ subroutine ice_write_hist (ns) 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)) @@ -706,6 +707,15 @@ subroutine ice_write_hist (ns) ! 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 + status = pio_inq_varid(File,'time',varid) status = pio_put_var(File,varid,(/1/),ltime2) diff --git a/configuration/scripts/ice_in b/configuration/scripts/ice_in index 8dc046da5..e0e317e40 100644 --- a/configuration/scripts/ice_in +++ b/configuration/scripts/ice_in @@ -53,6 +53,7 @@ history_file = 'iceh' history_precision = 4 history_format = 'default' + hist_time_axis = 'end' write_ic = .true. incond_dir = './history/' incond_file = 'iceh_ic' diff --git a/doc/source/cice_index.rst b/doc/source/cice_index.rst index 0c0ab6971..36c772eff 100644 --- a/doc/source/cice_index.rst +++ b/doc/source/cice_index.rst @@ -322,6 +322,7 @@ either Celsius or Kelvin units). Deprecated parameters are listed at the end. "history_file", "history output file prefix", "" "history_format", "history file format", "" "history_precision", "history output precision: 4 or 8 byte", "4" + "hist_time_axis", "history file time axis interval location: begin, middle, end", "end" "hm", "land/boundary mask, thickness (T-cell)", "" "hmix", "ocean mixed layer depth", "20. m" "hour", "hour of the year", "" diff --git a/doc/source/user_guide/ug_case_settings.rst b/doc/source/user_guide/ug_case_settings.rst index 2a7240c78..d5ec89df1 100644 --- a/doc/source/user_guide/ug_case_settings.rst +++ b/doc/source/user_guide/ug_case_settings.rst @@ -191,6 +191,7 @@ setup_nml "``history_format``", "``default``", "read/write history files in default format", "``default``" "", "``pio_pnetcdf``", "read/write restart files with pnetcdf in pio", "" "``history_precision``", "integer", "history file precision: 4 or 8 byte", "4" + "``hist_time_axis``","character","history file time axis interval location: begin, middle, end","end" "``ice_ic``", "``default``", "equal to internal", "``default``" "", "``internal``", "initial conditions set based on ice\_data\_type,conc,dist inputs", "" "", "``none``", "no ice", "" diff --git a/doc/source/user_guide/ug_implementation.rst b/doc/source/user_guide/ug_implementation.rst index acc75b3d8..f6327333c 100644 --- a/doc/source/user_guide/ug_implementation.rst +++ b/doc/source/user_guide/ug_implementation.rst @@ -1197,8 +1197,11 @@ with a given ``histfreq`` value, or if an element of ``histfreq_n`` is 0, then no file will be written at that frequency. The output period can be discerned from the filenames. All history streams will be either instantaneous or averaged as specified by the ``hist_avg`` namelist setting and the frequency -will be relative to a reference date specified by ``histfreq_base``. More -information about how the frequency is computed is found in :ref:`timemanager`. +will be relative to a reference date specified by ``histfreq_base``. Also, some +Earth Sytem Models require the history file time axis to be centered in the averaging +interval. The flag ``hist_time_axis`` will allow the user to chose ``begin``, ``middle``, +or ``end`` for the time stamp. More information about how the frequency is +computed is found in :ref:`timemanager`. For example, in the namelist: From 766ff8d9606ae08bdd34ac2b36b6b068464c7e71 Mon Sep 17 00:00:00 2001 From: Tony Craig Date: Tue, 11 Jul 2023 07:53:22 -0700 Subject: [PATCH 08/76] 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 --- cicecore/cicedyn/analysis/ice_diagnostics.F90 | 156 --------- cicecore/cicedyn/general/ice_forcing.F90 | 308 ------------------ doc/source/developer_guide/dg_other.rst | 6 +- doc/source/intro/about.rst | 2 +- doc/source/intro/citing.rst | 2 +- doc/source/master_list.bib | 10 +- doc/source/science_guide/sg_coupling.rst | 4 +- doc/source/science_guide/sg_dynamics.rst | 4 +- doc/source/science_guide/sg_fundvars.rst | 4 +- doc/source/science_guide/sg_horiztrans.rst | 4 +- doc/source/science_guide/sg_tracers.rst | 2 +- doc/source/user_guide/ug_implementation.rst | 2 +- doc/source/user_guide/ug_testing.rst | 12 +- doc/source/user_guide/ug_troubleshooting.rst | 4 +- icepack | 2 +- 15 files changed, 29 insertions(+), 493 deletions(-) diff --git a/cicecore/cicedyn/analysis/ice_diagnostics.F90 b/cicecore/cicedyn/analysis/ice_diagnostics.F90 index b14dff4e3..395cca98d 100644 --- a/cicecore/cicedyn/analysis/ice_diagnostics.F90 +++ b/cicecore/cicedyn/analysis/ice_diagnostics.F90 @@ -1943,162 +1943,6 @@ subroutine print_state(plabel,i,j,iblk) end subroutine print_state !======================================================================= -#ifdef UNDEPRECATE_print_points_state - -! This routine is useful for debugging. - - subroutine print_points_state(plabel,ilabel) - - use ice_grid, only: grid_ice - use ice_blocks, only: block, get_block - use ice_domain, only: blocks_ice - use ice_domain_size, only: ncat, nilyr, nslyr - use ice_state, only: aice0, aicen, vicen, vsnon, uvel, vvel, & - uvelE, vvelE, uvelE, vvelE, trcrn - use ice_flux, only: uatm, vatm, potT, Tair, Qa, flw, frain, fsnow, & - fsens, flat, evap, flwout, swvdr, swvdf, swidr, swidf, rhoa, & - frzmlt, sst, sss, Tf, Tref, Qref, Uref, uocn, vocn, strtltxU, strtltyU - - character (len=*), intent(in),optional :: plabel - integer , intent(in),optional :: ilabel - - ! local variables - - real (kind=dbl_kind) :: & - eidebug, esdebug, & - qi, qs, & - puny - - integer (kind=int_kind) :: m, n, k, i, j, iblk, nt_Tsfc, nt_qice, nt_qsno - character(len=256) :: llabel - - type (block) :: & - this_block ! block information for current block - - character(len=*), parameter :: subname = '(print_points_state)' - ! ---------------------- - - call icepack_query_tracer_indices(nt_Tsfc_out=nt_Tsfc, nt_qice_out=nt_qice, & - nt_qsno_out=nt_qsno) - call icepack_query_parameters(puny_out=puny) - call icepack_warnings_flush(nu_diag) - if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & - file=__FILE__, line=__LINE__) - - do m = 1, npnt - if (my_task == pmloc(m)) then - i = piloc(m) - j = pjloc(m) - iblk = pbloc(m) - this_block = get_block(blocks_ice(iblk),iblk) - - if (present(ilabel)) then - write(llabel,'(i6,a1,i3,a1)') ilabel,':',m,':' - else - write(llabel,'(i3,a1)') m,':' - endif - if (present(plabel)) then - write(llabel,'(a)') 'pps:'//trim(plabel)//':'//trim(llabel) - else - write(llabel,'(a)') 'pps:'//trim(llabel) - endif - - write(nu_diag,*) subname - write(nu_diag,*) trim(llabel),'istep1, my_task, i, j, iblk=', & - istep1, my_task, i, j, iblk - write(nu_diag,*) trim(llabel),'Global i and j=', & - this_block%i_glob(i), & - this_block%j_glob(j) - write(nu_diag,*) trim(llabel),'aice0=', aice0(i,j,iblk) - - do n = 1, ncat - write(nu_diag,*) trim(llabel),'aicen=', n,aicen(i,j,n,iblk) - write(nu_diag,*) trim(llabel),'vicen=', n,vicen(i,j,n,iblk) - write(nu_diag,*) trim(llabel),'vsnon=', n,vsnon(i,j,n,iblk) - if (aicen(i,j,n,iblk) > puny) then - write(nu_diag,*) trim(llabel),'hin=', n,vicen(i,j,n,iblk)/aicen(i,j,n,iblk) - write(nu_diag,*) trim(llabel),'hsn=', n,vsnon(i,j,n,iblk)/aicen(i,j,n,iblk) - endif - write(nu_diag,*) trim(llabel),'Tsfcn=',n,trcrn(i,j,nt_Tsfc,n,iblk) - enddo - - eidebug = c0 - do n = 1,ncat - do k = 1,nilyr - qi = trcrn(i,j,nt_qice+k-1,n,iblk) - write(nu_diag,*) trim(llabel),'qice= ',n,k, qi - eidebug = eidebug + qi - enddo - enddo - write(nu_diag,*) trim(llabel),'qice=',eidebug - - esdebug = c0 - do n = 1,ncat - if (vsnon(i,j,n,iblk) > puny) then - do k = 1,nslyr - qs = trcrn(i,j,nt_qsno+k-1,n,iblk) - write(nu_diag,*) trim(llabel),'qsnow=',n,k, qs - esdebug = esdebug + qs - enddo - endif - enddo - write(nu_diag,*) trim(llabel),'qsnow=',esdebug - - write(nu_diag,*) trim(llabel),'uvel=',uvel(i,j,iblk) - write(nu_diag,*) trim(llabel),'vvel=',vvel(i,j,iblk) - if (grid_ice == 'C') then - write(nu_diag,*) trim(llabel),'uvelE=',uvelE(i,j,iblk) - write(nu_diag,*) trim(llabel),'vvelN=',vvelN(i,j,iblk) - elseif (grid_ice == 'CD') then - write(nu_diag,*) trim(llabel),'uvelE=',uvelE(i,j,iblk) - write(nu_diag,*) trim(llabel),'vvelE=',vvelE(i,j,iblk) - write(nu_diag,*) trim(llabel),'uvelN=',uvelN(i,j,iblk) - write(nu_diag,*) trim(llabel),'vvelN=',vvelN(i,j,iblk) - endif - - write(nu_diag,*) ' ' - write(nu_diag,*) 'atm states and fluxes' - write(nu_diag,*) ' uatm = ',uatm (i,j,iblk) - write(nu_diag,*) ' vatm = ',vatm (i,j,iblk) - write(nu_diag,*) ' potT = ',potT (i,j,iblk) - write(nu_diag,*) ' Tair = ',Tair (i,j,iblk) - write(nu_diag,*) ' Qa = ',Qa (i,j,iblk) - write(nu_diag,*) ' rhoa = ',rhoa (i,j,iblk) - write(nu_diag,*) ' swvdr = ',swvdr(i,j,iblk) - write(nu_diag,*) ' swvdf = ',swvdf(i,j,iblk) - write(nu_diag,*) ' swidr = ',swidr(i,j,iblk) - write(nu_diag,*) ' swidf = ',swidf(i,j,iblk) - write(nu_diag,*) ' flw = ',flw (i,j,iblk) - write(nu_diag,*) ' frain = ',frain(i,j,iblk) - write(nu_diag,*) ' fsnow = ',fsnow(i,j,iblk) - write(nu_diag,*) ' ' - write(nu_diag,*) 'ocn states and fluxes' - write(nu_diag,*) ' frzmlt = ',frzmlt (i,j,iblk) - write(nu_diag,*) ' sst = ',sst (i,j,iblk) - write(nu_diag,*) ' sss = ',sss (i,j,iblk) - write(nu_diag,*) ' Tf = ',Tf (i,j,iblk) - write(nu_diag,*) ' uocn = ',uocn (i,j,iblk) - write(nu_diag,*) ' vocn = ',vocn (i,j,iblk) - write(nu_diag,*) ' strtltxU= ',strtltxU(i,j,iblk) - write(nu_diag,*) ' strtltyU= ',strtltyU(i,j,iblk) - write(nu_diag,*) ' ' - write(nu_diag,*) 'srf states and fluxes' - write(nu_diag,*) ' Tref = ',Tref (i,j,iblk) - write(nu_diag,*) ' Qref = ',Qref (i,j,iblk) - write(nu_diag,*) ' Uref = ',Uref (i,j,iblk) - write(nu_diag,*) ' fsens = ',fsens (i,j,iblk) - write(nu_diag,*) ' flat = ',flat (i,j,iblk) - write(nu_diag,*) ' evap = ',evap (i,j,iblk) - write(nu_diag,*) ' flwout = ',flwout(i,j,iblk) - write(nu_diag,*) ' ' - call flush_fileunit(nu_diag) - - endif ! my_task - enddo ! ncnt - - end subroutine print_points_state -#endif -!======================================================================= ! prints error information prior to aborting diff --git a/cicecore/cicedyn/general/ice_forcing.F90 b/cicecore/cicedyn/general/ice_forcing.F90 index 541efb282..db8084dd1 100755 --- a/cicecore/cicedyn/general/ice_forcing.F90 +++ b/cicecore/cicedyn/general/ice_forcing.F90 @@ -298,10 +298,6 @@ subroutine init_forcing_atmo ! default forcing values from init_flux_atm if (trim(atm_data_type) == 'ncar') then call NCAR_files(fyear) -#ifdef UNDEPRECATE_LYq - elseif (trim(atm_data_type) == 'LYq') then - call LY_files(fyear) -#endif elseif (trim(atm_data_type) == 'JRA55_gx1') then call JRA55_gx1_files(fyear) elseif (trim(atm_data_type) == 'JRA55_gx3') then @@ -644,10 +640,6 @@ subroutine get_forcing_atmo if (trim(atm_data_type) == 'ncar') then call ncar_data -#ifdef UNDEPRECATE_LYq - elseif (trim(atm_data_type) == 'LYq') then - call LY_data -#endif elseif (trim(atm_data_type) == 'JRA55_gx1') then call JRA55_data elseif (trim(atm_data_type) == 'JRA55_gx3') then @@ -1726,23 +1718,6 @@ subroutine prepare_forcing (nx_block, ny_block, & enddo enddo -#ifdef UNDEPRECATE_LYq - elseif (trim(atm_data_type) == 'LYq') then - - ! precip is in mm/s - - zlvl0 = c10 - - do j = jlo, jhi - do i = ilo, ihi - ! longwave based on Rosati and Miyakoda, JPO 18, p. 1607 (1988) - call longwave_rosati_miyakoda(cldf(i,j), Tsfc(i,j), & - aice(i,j), sst(i,j), & - Qa(i,j), Tair(i,j), & - hm(i,j), flw(i,j)) - enddo - enddo -#endif elseif (trim(atm_data_type) == 'oned') then ! rectangular grid ! precip is in kg/m^2/s @@ -2195,64 +2170,6 @@ subroutine ncar_data end subroutine ncar_data -#ifdef UNDEPRECATE_LYq -!======================================================================= -! Large and Yeager forcing (AOMIP style) -!======================================================================= - - subroutine LY_files (yr) - -! Construct filenames based on the LANL naming conventions for CORE -! (Large and Yeager) data. -! Edit for other directory structures or filenames. -! Note: The year number in these filenames does not matter, because -! subroutine file_year will insert the correct year. - -! author: Elizabeth C. Hunke, LANL - - integer (kind=int_kind), intent(in) :: & - yr ! current forcing year - - character(len=*), parameter :: subname = '(LY_files)' - - if (local_debug .and. my_task == master_task) write(nu_diag,*) subname,'fdbg start' - - flw_file = & - trim(atm_data_dir)//'/MONTHLY/cldf.omip.dat' - - rain_file = & - trim(atm_data_dir)//'/MONTHLY/prec.nmyr.dat' - - uwind_file = & - trim(atm_data_dir)//'/4XDAILY/u_10.1996.dat' - call file_year(uwind_file,yr) - - vwind_file = & - trim(atm_data_dir)//'/4XDAILY/v_10.1996.dat' - call file_year(vwind_file,yr) - - tair_file = & - trim(atm_data_dir)//'/4XDAILY/t_10.1996.dat' - call file_year(tair_file,yr) - - humid_file = & - trim(atm_data_dir)//'/4XDAILY/q_10.1996.dat' - call file_year(humid_file,yr) - - if (my_task == master_task) then - write (nu_diag,*) ' ' - write (nu_diag,*) 'Forcing data year = ', fyear - write (nu_diag,*) 'Atmospheric data files:' - write (nu_diag,*) trim(flw_file) - write (nu_diag,*) trim(rain_file) - write (nu_diag,*) trim(uwind_file) - write (nu_diag,*) trim(vwind_file) - write (nu_diag,*) trim(tair_file) - write (nu_diag,*) trim(humid_file) - endif ! master_task - - end subroutine LY_files -#endif !======================================================================= subroutine JRA55_gx1_files(yr) @@ -2316,231 +2233,6 @@ subroutine JRA55_gx3_files(yr) endif end subroutine JRA55_gx3_files -#ifdef UNDEPRECATE_LYq -!======================================================================= -! -! read Large and Yeager atmospheric data -! note: also uses AOMIP protocol, in part - - subroutine LY_data - - use ice_blocks, only: block, get_block - use ice_global_reductions, only: global_minval, global_maxval - use ice_domain, only: nblocks, distrb_info, blocks_ice - use ice_flux, only: fsnow, Tair, uatm, vatm, Qa, fsw - use ice_grid, only: hm, tlon, tlat, tmask, umask - use ice_state, only: aice - - integer (kind=int_kind) :: & - i, j , & - ixm,ixx,ixp , & ! record numbers for neighboring months - recnum , & ! record number - maxrec , & ! maximum record number - recslot , & ! spline slot for current record - midmonth , & ! middle day of month - dataloc , & ! = 1 for data located in middle of time interval - ! = 2 for date located at end of time interval - iblk , & ! block index - ilo,ihi,jlo,jhi ! beginning and end of physical domain - - real (kind=dbl_kind) :: & - sec6hr , & ! number of seconds in 6 hours - secday , & ! number of seconds in day - Tffresh , & - vmin, vmax - - logical (kind=log_kind) :: readm, read6 - - type (block) :: & - this_block ! block information for current block - - character(len=*), parameter :: subname = '(LY_data)' - - if (local_debug .and. my_task == master_task) write(nu_diag,*) subname,'fdbg start' - - call icepack_query_parameters(Tffresh_out=Tffresh) - call icepack_query_parameters(secday_out=secday) - call icepack_warnings_flush(nu_diag) - if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & - file=__FILE__, line=__LINE__) - - !------------------------------------------------------------------- - ! monthly data - ! - ! Assume that monthly data values are located in the middle of the - ! month. - !------------------------------------------------------------------- - - midmonth = 15 ! data is given on 15th of every month -! midmonth = fix(p5 * real(daymo(mmonth))) ! exact middle - - ! Compute record numbers for surrounding months - maxrec = 12 - ixm = mod(mmonth+maxrec-2,maxrec) + 1 - ixp = mod(mmonth, maxrec) + 1 - if (mday >= midmonth) ixm = -99 ! other two points will be used - if (mday < midmonth) ixp = -99 - - ! Determine whether interpolation will use values 1:2 or 2:3 - ! recslot = 2 means we use values 1:2, with the current value (2) - ! in the second slot - ! recslot = 1 means we use values 2:3, with the current value (2) - ! in the first slot - recslot = 1 ! latter half of month - if (mday < midmonth) recslot = 2 ! first half of month - - ! Find interpolation coefficients - call interp_coeff_monthly (recslot) - - ! Read 2 monthly values - readm = .false. - if (istep==1 .or. (mday==midmonth .and. msec==0)) readm = .true. - - call read_clim_data (readm, 0, ixm, mmonth, ixp, & - flw_file, cldf_data, field_loc_center, field_type_scalar) - call read_clim_data (readm, 0, ixm, mmonth, ixp, & - rain_file, fsnow_data, field_loc_center, field_type_scalar) - - call interpolate_data (cldf_data, cldf) - call interpolate_data (fsnow_data, fsnow) ! units mm/s = kg/m^2/s - - !------------------------------------------------------------------- - ! 6-hourly data - ! - ! Assume that the 6-hourly value is located at the end of the - ! 6-hour period. This is the convention for NCEP reanalysis data. - ! E.g. record 1 gives conditions at 6 am GMT on 1 January. - !------------------------------------------------------------------- - - dataloc = 2 ! data located at end of interval - sec6hr = secday/c4 ! seconds in 6 hours - maxrec = 1460 ! 365*4 - - ! current record number - recnum = 4*int(yday) - 3 + int(real(msec,kind=dbl_kind)/sec6hr) - - ! Compute record numbers for surrounding data (2 on each side) - - ixm = mod(recnum+maxrec-2,maxrec) + 1 - ixx = mod(recnum-1, maxrec) + 1 -! ixp = mod(recnum, maxrec) + 1 - - ! Compute interpolation coefficients - ! If data is located at the end of the time interval, then the - ! data value for the current record goes in slot 2 - - recslot = 2 - ixp = -99 - call interp_coeff (recnum, recslot, sec6hr, dataloc) - - ! Read - read6 = .false. - if (istep==1 .or. oldrecnum .ne. recnum) read6 = .true. - - if (trim(atm_data_format) == 'bin') then - call read_data (read6, 0, fyear, ixm, ixx, ixp, maxrec, & - tair_file, Tair_data, & - field_loc_center, field_type_scalar) - call read_data (read6, 0, fyear, ixm, ixx, ixp, maxrec, & - uwind_file, uatm_data, & - field_loc_center, field_type_vector) - call read_data (read6, 0, fyear, ixm, ixx, ixp, maxrec, & - vwind_file, vatm_data, & - field_loc_center, field_type_vector) - call read_data (read6, 0, fyear, ixm, ixx, ixp, maxrec, & - humid_file, Qa_data, & - field_loc_center, field_type_scalar) - else - call abort_ice (error_message=subname//'nonbinary atm_data_format unavailable', & - file=__FILE__, line=__LINE__) - endif - - ! Interpolate - call interpolate_data (Tair_data, Tair) - call interpolate_data (uatm_data, uatm) - call interpolate_data (vatm_data, vatm) - call interpolate_data (Qa_data, Qa) - - !$OMP PARALLEL DO PRIVATE(iblk,i,j,ilo,ihi,jlo,jhi,this_block) - do iblk = 1, nblocks - ! limit summer Tair values where ice is present - do j = 1, ny_block - do i = 1, nx_block - if (aice(i,j,iblk) > p1) Tair(i,j,iblk) = min(Tair(i,j,iblk), Tffresh+p1) - enddo - enddo - - call Qa_fixLY(nx_block, ny_block, & - Tair (:,:,iblk), & - Qa (:,:,iblk)) - - do j = 1, ny_block - do i = 1, nx_block - Qa (i,j,iblk) = Qa (i,j,iblk) * hm(i,j,iblk) - Tair(i,j,iblk) = Tair(i,j,iblk) * hm(i,j,iblk) - uatm(i,j,iblk) = uatm(i,j,iblk) * hm(i,j,iblk) - vatm(i,j,iblk) = vatm(i,j,iblk) * hm(i,j,iblk) - enddo - enddo - - ! AOMIP - this_block = get_block(blocks_ice(iblk),iblk) - ilo = this_block%ilo - ihi = this_block%ihi - jlo = this_block%jlo - jhi = this_block%jhi - - call compute_shortwave(nx_block, ny_block, & - ilo, ihi, jlo, jhi, & - TLON (:,:,iblk), & - TLAT (:,:,iblk), & - hm (:,:,iblk), & - Qa (:,:,iblk), & - cldf (:,:,iblk), & - fsw (:,:,iblk)) - - enddo ! iblk - !$OMP END PARALLEL DO - - ! Save record number - oldrecnum = recnum - - if (debug_forcing) then - if (my_task == master_task) write (nu_diag,*) 'LY_bulk_data' - vmin = global_minval(fsw,distrb_info,tmask) - - vmax = global_maxval(fsw,distrb_info,tmask) - if (my_task.eq.master_task) & - write (nu_diag,*) 'fsw',vmin,vmax - vmin = global_minval(cldf,distrb_info,tmask) - vmax = global_maxval(cldf,distrb_info,tmask) - if (my_task.eq.master_task) & - write (nu_diag,*) 'cldf',vmin,vmax - vmin =global_minval(fsnow,distrb_info,tmask) - vmax =global_maxval(fsnow,distrb_info,tmask) - if (my_task.eq.master_task) & - write (nu_diag,*) 'fsnow',vmin,vmax - vmin = global_minval(Tair,distrb_info,tmask) - vmax = global_maxval(Tair,distrb_info,tmask) - if (my_task.eq.master_task) & - write (nu_diag,*) 'Tair',vmin,vmax - vmin = global_minval(uatm,distrb_info,umask) - vmax = global_maxval(uatm,distrb_info,umask) - if (my_task.eq.master_task) & - write (nu_diag,*) 'uatm',vmin,vmax - vmin = global_minval(vatm,distrb_info,umask) - vmax = global_maxval(vatm,distrb_info,umask) - if (my_task.eq.master_task) & - write (nu_diag,*) 'vatm',vmin,vmax - vmin = global_minval(Qa,distrb_info,tmask) - vmax = global_maxval(Qa,distrb_info,tmask) - if (my_task.eq.master_task) & - write (nu_diag,*) 'Qa',vmin,vmax - - endif ! debug_forcing - - end subroutine LY_data -#endif !======================================================================= subroutine JRA55_data diff --git a/doc/source/developer_guide/dg_other.rst b/doc/source/developer_guide/dg_other.rst index 308c2629c..a8f6e8b15 100644 --- a/doc/source/developer_guide/dg_other.rst +++ b/doc/source/developer_guide/dg_other.rst @@ -177,14 +177,14 @@ the tracer dependencies (weights), which are tracked using the arrays ``trcr_base`` (a dependency mask), ``n_trcr_strata`` (the number of underlying tracer layers), and ``nt_strata`` (indices of underlying layers). Additional information about tracers can be found in the -`Icepack documentation `__. +`Icepack documentation `__. To add a tracer, follow these steps using one of the existing tracers as a pattern. 1) **icepack\_tracers.F90** and **icepack\_[tracer].F90**: declare tracers, add flags and indices, and create physics routines as described in the - `Icepack documentation `__ + `Icepack documentation `__ 2) **ice_arrays_column.F90**: declare arrays @@ -233,6 +233,6 @@ a pattern. configuration in **configuration/scripts/options**. 12) If strict conservation is necessary, add diagnostics as noted for - topo ponds in the `Icepack documentation `__. + topo ponds in the `Icepack documentation `__. 13) Update documentation, including **cice_index.rst** and **ug_case_settings.rst** diff --git a/doc/source/intro/about.rst b/doc/source/intro/about.rst index b249a8dfb..3845cfbc0 100644 --- a/doc/source/intro/about.rst +++ b/doc/source/intro/about.rst @@ -23,7 +23,7 @@ coupled with other earth system model components, routines external to the CICE model prepare and execute data exchanges with an external “flux coupler”. Icepack is implemented in CICE as a git submodule, and it is documented at -https://cice-consortium-icepack.readthedocs.io/en/master/index.html. +https://cice-consortium-icepack.readthedocs.io/en/main/index.html. Development and testing of CICE and Icepack may be done together, but the repositories are independent. This document describes the remainder of the CICE model. The CICE code is diff --git a/doc/source/intro/citing.rst b/doc/source/intro/citing.rst index c128bc4e6..593041b21 100644 --- a/doc/source/intro/citing.rst +++ b/doc/source/intro/citing.rst @@ -15,7 +15,7 @@ More information can be found by following the DOI link to zenodo. If you use CICE, please cite the version number of the code you are using or modifying. -If using code from the CICE-Consortium repository ``master`` branch +If using code from the CICE-Consortium repository ``main`` branch that includes modifications that have not yet been released with a version number, then in addition to the most recent version number, the hash at time of diff --git a/doc/source/master_list.bib b/doc/source/master_list.bib index 9e387efb9..a7c3a1174 100644 --- a/doc/source/master_list.bib +++ b/doc/source/master_list.bib @@ -331,7 +331,7 @@ @Manual{Smith95 title = "{Curvilinear coordinates for global ocean models}", organization = "Technical Report LA-UR-95-1146, Los Alamos National Laboratory", year = {1995}, - url = {https://github.com/CICE-Consortium/CICE/blob/master/doc/PDF/LAUR-95-1146.pdf} + url = {https://github.com/CICE-Consortium/CICE/blob/main/doc/PDF/LAUR-95-1146.pdf} } @Article{Zwiers95, author = "F.W. Zwiers and H. von Storch", @@ -523,14 +523,14 @@ @Manual{Kauffman02 title = "{The CCSM coupler, version 5.0.1}", journal = NTN, year = {2002}, - url = {https://github.com/CICE-Consortium/CICE/blob/master/doc/PDF/KL_NCAR2002.pdf} + url = {https://github.com/CICE-Consortium/CICE/blob/main/doc/PDF/KL_NCAR2002.pdf} } @Manual{Hunke03, author = "E.C. Hunke and J.K. Dukowicz", title = "{The sea ice momentum equation in the free drift regime}", organization = "Technical Report LA-UR-03-2219, Los Alamos National Laboratory", year = {2003}, - url = {https://github.com/CICE-Consortium/CICE/blob/master/doc/PDF/LAUR-03-2219.pdf} + url = {https://github.com/CICE-Consortium/CICE/blob/main/doc/PDF/LAUR-03-2219.pdf} } @Article{Amundrud04, author = "T.L. Amundrud and H. Malling and R.G. Ingram", @@ -636,7 +636,7 @@ @Article{Jin06 year = {2006}, volume = {44}, pages = {63-72}, - url = {https://github.com/CICE-Consortium/CICE/blob/master/doc/PDF/JDWSTWLG06.pdf} + url = {https://github.com/CICE-Consortium/CICE/blob/main/doc/PDF/JDWSTWLG06.pdf} } @Article{Wilchinsky06, author = "A.V. Wilchinsky and D.L. Feltham", @@ -660,7 +660,7 @@ @Manual{Briegleb07 title = "{A Delta-Eddington multiple scattering parameterization for solar radiation in the sea ice component of the Community Climate System Model}", organization = "NCAR Technical Note NCAR/TN-472+STR, National Center for Atmospheric Research", year = {2007}, - url = {https://github.com/CICE-Consortium/CICE/blob/master/doc/PDF/BL_NCAR2007.pdf} + url = {https://github.com/CICE-Consortium/CICE/blob/main/doc/PDF/BL_NCAR2007.pdf} } @Article{Flocco07, author = "D. Flocco and D.L. Feltham", diff --git a/doc/source/science_guide/sg_coupling.rst b/doc/source/science_guide/sg_coupling.rst index c01e2bea5..666c13ed4 100644 --- a/doc/source/science_guide/sg_coupling.rst +++ b/doc/source/science_guide/sg_coupling.rst @@ -27,7 +27,7 @@ variables for each cell. These considerations are explained in more detail below. The fluxes and state variables passed between the sea ice model and the -CESM flux coupler are listed in the `Icepack documentation `_. +CESM flux coupler are listed in the `Icepack documentation `_. By convention, directional fluxes are positive downward. In CESM, the sea ice model may exchange coupling fluxes using a different grid than the computational @@ -135,6 +135,6 @@ thin compared to the typical depth of the Ekman spiral, then :math:`\theta=0` is a good approximation. Here we assume that the top layer is thin enough. -Please see the `Icepack documentation `_ for additional information about +Please see the `Icepack documentation `_ for additional information about atmospheric and oceanic forcing and other data exchanged between the flux coupler and the sea ice model. diff --git a/doc/source/science_guide/sg_dynamics.rst b/doc/source/science_guide/sg_dynamics.rst index 585c18616..1ddf94472 100644 --- a/doc/source/science_guide/sg_dynamics.rst +++ b/doc/source/science_guide/sg_dynamics.rst @@ -284,7 +284,7 @@ Parameters for the FGMRES linear solver and the preconditioner can be controlled Surface stress terms ******************** -The formulation for the wind stress is described in `Icepack Documentation `_. Below, some details about the ice-ocean stress and the seabed stress are given. +The formulation for the wind stress is described in `Icepack Documentation `_. Below, some details about the ice-ocean stress and the seabed stress are given. Ice-Ocean stress ~~~~~~~~~~~~~~~~ @@ -515,7 +515,7 @@ where When the deformation :math:`\Delta` tends toward zero, the viscosities tend toward infinity. To avoid this issue, :math:`\Delta` needs to be limited and is replaced by :math:`\Delta^*` in equation :eq:`zeta`. Two methods for limiting :math:`\Delta` (or for capping the viscosities) are available in the code. If the namelist parameter ``capping_method`` is set to ``max``, :math:`\Delta^*=max(\Delta, \Delta_{min})` :cite:`Hibler79` while with ``capping_method`` set to ``sum``, the smoother formulation :math:`\Delta^*=(\Delta + \Delta_{min})` of :cite:`Kreyscher00` is used. The ice strength :math:`P` is a function of the ice thickness distribution as -described in the `Icepack Documentation `_. +described in the `Icepack Documentation `_. Two other modifications to the standard VP rheology of :cite:`Hibler79` are available. First, following the approach of :cite:`Konig10` (see also :cite:`Lemieux16`), the diff --git a/doc/source/science_guide/sg_fundvars.rst b/doc/source/science_guide/sg_fundvars.rst index 5b5703266..2d6f50328 100644 --- a/doc/source/science_guide/sg_fundvars.rst +++ b/doc/source/science_guide/sg_fundvars.rst @@ -17,7 +17,7 @@ In addition to an ice thickness distribution, CICE includes an optional capabili Ice floe horizontal size may change through vertical and lateral growth and melting of existing floes, freezing of new ice, wave breaking, and welding of floes in freezing conditions. The floe size distribution (FSD) is a probability function that characterizes this variability. The scheme is based on the theoretical framework described in :cite:`Horvat15` for a joint floe size and thickness distribution (FSTD), and was implemented by :cite:`Roach18` and :cite:`Roach19`. The joint floe size distribution is carried as an area-weighted tracer, defined as the fraction of ice belonging to a given thickness category with lateral floe size belong to a given floe size class. This development includes interactions between sea ice and ocean surface waves. Input data on ocean surface wave spectra at a single time is provided for testing, but as with the other CICE datasets, it should not be used for production runs or publications. It is not recommended to use the FSD without ocean surface waves. Additional information about the ITD and joint FSTD for CICE can be found in the -`Icepack documentation `_. +`Icepack documentation `_. The fundamental equation solved by CICE is :cite:`Thorndike75`: @@ -87,7 +87,7 @@ Section :ref:`horiz-trans`. Ice is transported in thickness space using the remapping scheme of :cite:`Lipscomb01`. The mechanical redistribution scheme, based on :cite:`Thorndike75`, :cite:`Rothrock75`, :cite:`Hibler80`, :cite:`Flato95`, and :cite:`Lipscomb07` is outlined -in the `Icepack Documentation `_. +in the `Icepack Documentation `_. To solve the horizontal transport and ridging equations, we need the ice velocity :math:`{\bf u}`, and to compute transport in thickness space, we must know the the ice growth diff --git a/doc/source/science_guide/sg_horiztrans.rst b/doc/source/science_guide/sg_horiztrans.rst index d66046465..7862b5689 100644 --- a/doc/source/science_guide/sg_horiztrans.rst +++ b/doc/source/science_guide/sg_horiztrans.rst @@ -11,7 +11,7 @@ thickness category :math:`n`. Equation :eq:`transport-ai` describes the conservation of ice area under horizontal transport. It is obtained from Equation :eq:`transport-g` by discretizing :math:`g` and neglecting the second and third terms on the right-hand side, which are treated -separately (As described in the `Icepack Documentation `_). +separately (As described in the `Icepack Documentation `_). There are similar conservation equations for ice volume (Equation :eq:`transport-vi`), snow volume (Equation :eq:`transport-vs`), ice @@ -98,7 +98,7 @@ below. After the transport calculation, the sum of ice and open water areas within a grid cell may not add up to 1. The mechanical deformation parameterization in -`Icepack `_ +`Icepack `_ corrects this issue by ridging the ice and creating open water such that the ice and open water areas again add up to 1. diff --git a/doc/source/science_guide/sg_tracers.rst b/doc/source/science_guide/sg_tracers.rst index cbecb9310..5935fe67e 100644 --- a/doc/source/science_guide/sg_tracers.rst +++ b/doc/source/science_guide/sg_tracers.rst @@ -119,4 +119,4 @@ Users may add any number of additional tracers that are transported conservative provided that the dependency ``trcr_depend`` is defined appropriately. See Section :ref:`addtrcr` for guidance on adding tracers. -Please see the `Icepack documentation `_ for additional information about tracers that depend on other tracers, the floe size distribution, advanced snow physics, age of the ice, aerosols, water isotopes, brine height, and the sea ice ecosystem. +Please see the `Icepack documentation `_ for additional information about tracers that depend on other tracers, the floe size distribution, advanced snow physics, age of the ice, aerosols, water isotopes, brine height, and the sea ice ecosystem. diff --git a/doc/source/user_guide/ug_implementation.rst b/doc/source/user_guide/ug_implementation.rst index f6327333c..9bcf205b4 100644 --- a/doc/source/user_guide/ug_implementation.rst +++ b/doc/source/user_guide/ug_implementation.rst @@ -1037,7 +1037,7 @@ used in coupled models. MPI is initialized in *init\_communicate* for both coupled and stand-alone MPI runs. The ice component communicates with a flux coupler or other climate components via external routines that handle the -variables listed in the `Icepack documentation `_. +variables listed in the `Icepack documentation `_. For stand-alone runs, routines in **ice\_forcing.F90** read and interpolate data from files, and are intended merely to provide guidance for the user to write his or diff --git a/doc/source/user_guide/ug_testing.rst b/doc/source/user_guide/ug_testing.rst index 606ae1397..f04bdf19a 100644 --- a/doc/source/user_guide/ug_testing.rst +++ b/doc/source/user_guide/ug_testing.rst @@ -8,7 +8,7 @@ Testing CICE This section documents primarily how to use the CICE scripts to carry out CICE testing. Exactly what to test is a separate question and depends on the kinds of code changes being made. Prior to merging -changes to the CICE Consortium master, changes will be reviewed and +changes to the CICE Consortium main, changes will be reviewed and developers will need to provide a summary of the tests carried out. There is a base suite of tests provided by default with CICE and this @@ -455,7 +455,7 @@ validation process. However, a full test suite should be run on the final devel version of the code. To report the test results, as is required for Pull Requests to be accepted into -the master the CICE Consortium code see :ref:`testreporting`. +the main the CICE Consortium code see :ref:`testreporting`. If using the ``--tdir`` option, that directory must not exist before the script is run. The tdir directory will be created by the script and it will be populated by all tests as well as scripts that support the @@ -578,7 +578,7 @@ Test Suite Examples the subdirectory cice.v01a. With the ``--bcmp`` option, the results will be tested against prior baselines to verify bit-for-bit, which is an important step prior to approval of many (not all, see :ref:`validation`) Pull Requests to incorporate code into - the CICE Consortium master code. You can use other regression options as well. + the CICE Consortium main branch. You can use other regression options as well. (``--bdir`` and ``--bgen``) 10) **Basic test suite, use of default string in regression testing** @@ -603,7 +603,7 @@ Test Suite Examples set mydate = `date -u "+%Y%m%d"` git clone https://github.com/myfork/cice cice.$mydate --recursive cd cice.$mydate - ./cice.setup --suite base_suite --mach conrad --env cray,gnu,intel,pgi --testid $mydate --bcmp default --bgen default --bdir /tmp/work/user/CICE_BASELINES_MASTER + ./cice.setup --suite base_suite --mach conrad --env cray,gnu,intel,pgi --testid $mydate --bcmp default --bgen default --bdir /tmp/work/user/CICE_BASELINES_MAIN When this is invoked, a new set of baselines will be generated and compared to the prior results each time without having to change the arguments. @@ -757,7 +757,7 @@ to the official CICE Consortium Test-Results `wiki page `_. You may need write permission on the wiki. If you are interested in using the wiki, please contact the Consortium. Note that in order for code to be -accepted to the CICE master through a Pull Request it is necessary +accepted to the CICE main branch through a Pull Request it is necessary for the developer to provide proof that their code passes relevant tests. This can be accomplished by posting the full results to the wiki, or by copying the testing summary to the Pull Request comments. @@ -824,7 +824,7 @@ assess test coverage. ..Because codecov.io does not support git submodule analysis right now, a customized ..repository has to be created to test CICE with Icepack integrated directly. The repository ..https://github.com/apcraig/Test_CICE_Icepack serves as the current default test repository. -..In general, to setup the code coverage test in CICE, the current CICE master has +..In general, to setup the code coverage test in CICE, the current CICE main has ..to be copied into the Test_CICE_Icepack repository, then the full test suite ..can be run with the gnu compiler with the ``--coverage`` argument. diff --git a/doc/source/user_guide/ug_troubleshooting.rst b/doc/source/user_guide/ug_troubleshooting.rst index 315b2f869..9d8c49a72 100644 --- a/doc/source/user_guide/ug_troubleshooting.rst +++ b/doc/source/user_guide/ug_troubleshooting.rst @@ -106,7 +106,7 @@ parameterizations are used, the code should be able to execute from these files. However if different physics is used (for instance, mushy thermo instead of BL99), the code may still fail. To convert a v4.1 restart file, consult section 5.2 in the `CICE v5 documentation -`_. +`_. If restart files are taking a long time to be written serially (i.e., not using PIO), see the next section. @@ -228,7 +228,7 @@ Interpretation of albedos More information about interpretation of albedos can be found in the -`Icepack documentation `_. +`Icepack documentation `_. VP dynamics results diff --git a/icepack b/icepack index 6703bc533..d024340f1 160000 --- a/icepack +++ b/icepack @@ -1 +1 @@ -Subproject commit 6703bc533c96802235e2f20de5fffc0bc6cc4c97 +Subproject commit d024340f19676bc5f6c0effe0c5dbfb763a5882a From f9d3002c86e11ca18b06382fc2d0676c9a945223 Mon Sep 17 00:00:00 2001 From: Tony Craig Date: Thu, 13 Jul 2023 16:01:26 -0700 Subject: [PATCH 09/76] 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 --- cicecore/cicedyn/general/ice_forcing.F90 | 245 ++++++++++-------- .../io/io_netcdf/ice_history_write.F90 | 4 +- .../io/io_pio2/ice_history_write.F90 | 2 +- configuration/scripts/cice.batch.csh | 15 ++ configuration/scripts/cice.launch.csh | 12 + .../scripts/machines/Macros.derecho_intel | 69 +++++ .../scripts/machines/Macros.onyx_intel | 4 +- .../scripts/machines/env.derecho_intel | 70 +++++ configuration/scripts/machines/env.nrlssc_gnu | 10 +- configuration/scripts/machines/env.onyx_cray | 12 +- configuration/scripts/machines/env.onyx_gnu | 12 +- configuration/scripts/machines/env.onyx_intel | 12 +- configuration/scripts/options/set_nml.gx1 | 4 +- configuration/scripts/options/set_nml.gx3 | 4 +- .../scripts/options/set_nml.gx3ncarbulk | 2 +- configuration/scripts/options/set_nml.jra55 | 2 + configuration/scripts/options/set_nml.jra55do | 2 + configuration/scripts/options/set_nml.tx1 | 4 +- configuration/scripts/tests/base_suite.ts | 3 + doc/source/developer_guide/dg_forcing.rst | 17 +- doc/source/developer_guide/dg_tools.rst | 4 +- doc/source/user_guide/ug_case_settings.rst | 7 +- 22 files changed, 368 insertions(+), 148 deletions(-) create mode 100644 configuration/scripts/machines/Macros.derecho_intel create mode 100644 configuration/scripts/machines/env.derecho_intel create mode 100644 configuration/scripts/options/set_nml.jra55 create mode 100644 configuration/scripts/options/set_nml.jra55do diff --git a/cicecore/cicedyn/general/ice_forcing.F90 b/cicecore/cicedyn/general/ice_forcing.F90 index db8084dd1..9002d0448 100755 --- a/cicecore/cicedyn/general/ice_forcing.F90 +++ b/cicecore/cicedyn/general/ice_forcing.F90 @@ -62,7 +62,7 @@ module ice_forcing fyear_final ! last year in cycle, computed at init character (char_len_long) :: & ! input data file names - uwind_file, & + uwind_file, & ! this is also used a generic file containing all fields for JRA55 vwind_file, & wind_file, & strax_file, & @@ -124,7 +124,7 @@ module ice_forcing ocn_data_format, & ! 'bin'=binary or 'nc'=netcdf atm_data_type, & ! 'default', 'monthly', 'ncar', 'box2001' ! 'hadgem', 'oned', 'calm', 'uniform' - ! 'JRA55_gx1' or 'JRA55_gx3' or 'JRA55_tx1' + ! 'JRA55' or 'JRA55do' bgc_data_type, & ! 'default', 'clim' ocn_data_type, & ! 'default', 'clim', 'ncar', 'oned', 'calm', 'box2001' ! 'hadgem_sst' or 'hadgem_sst_uvocn', 'uniform' @@ -281,13 +281,11 @@ subroutine init_forcing_atmo file=__FILE__, line=__LINE__) endif - if (use_leap_years .and. (trim(atm_data_type) /= 'JRA55_gx1' .and. & - trim(atm_data_type) /= 'JRA55_gx3' .and. & - trim(atm_data_type) /= 'JRA55_tx1' .and. & - trim(atm_data_type) /= 'hycom' .and. & - trim(atm_data_type) /= 'box2001')) then + if (use_leap_years .and. (index(trim(atm_data_type),'JRA55') == 0 .and. & + trim(atm_data_type) /= 'hycom' .and. & + trim(atm_data_type) /= 'box2001')) then write(nu_diag,*) 'use_leap_years option is currently only supported for' - write(nu_diag,*) 'JRA55, default , and box2001 atmospheric data' + write(nu_diag,*) 'JRA55, JRA55do, default , and box2001 atmospheric data' call abort_ice(error_message=subname, file=__FILE__, line=__LINE__) endif @@ -298,12 +296,8 @@ subroutine init_forcing_atmo ! default forcing values from init_flux_atm if (trim(atm_data_type) == 'ncar') then call NCAR_files(fyear) - elseif (trim(atm_data_type) == 'JRA55_gx1') then - call JRA55_gx1_files(fyear) - elseif (trim(atm_data_type) == 'JRA55_gx3') then - call JRA55_gx3_files(fyear) - elseif (trim(atm_data_type) == 'JRA55_tx1') then - call JRA55_tx1_files(fyear) + elseif (index(trim(atm_data_type),'JRA55') > 0) then + call JRA55_files(fyear) elseif (trim(atm_data_type) == 'hadgem') then call hadgem_files(fyear) elseif (trim(atm_data_type) == 'monthly') then @@ -640,11 +634,7 @@ subroutine get_forcing_atmo if (trim(atm_data_type) == 'ncar') then call ncar_data - elseif (trim(atm_data_type) == 'JRA55_gx1') then - call JRA55_data - elseif (trim(atm_data_type) == 'JRA55_gx3') then - call JRA55_data - elseif (trim(atm_data_type) == 'JRA55_tx1') then + elseif (index(trim(atm_data_type),'JRA55') > 0) then call JRA55_data elseif (trim(atm_data_type) == 'hadgem') then call hadgem_data @@ -1585,15 +1575,7 @@ subroutine file_year (data_file, yr) i = index(data_file,'.nc') - 5 tmpname = data_file write(data_file,'(a,i4.4,a)') tmpname(1:i), yr, '.nc' - elseif (trim(atm_data_type) == 'JRA55_gx1') then ! netcdf - i = index(data_file,'.nc') - 5 - tmpname = data_file - write(data_file,'(a,i4.4,a)') tmpname(1:i), yr, '.nc' - elseif (trim(atm_data_type) == 'JRA55_gx3') then ! netcdf - i = index(data_file,'.nc') - 5 - tmpname = data_file - write(data_file,'(a,i4.4,a)') tmpname(1:i), yr, '.nc' - elseif (trim(atm_data_type) == 'JRA55_tx1') then ! netcdf + elseif (index(trim(atm_data_type),'JRA55') > 0) then ! netcdf i = index(data_file,'.nc') - 5 tmpname = data_file write(data_file,'(a,i4.4,a)') tmpname(1:i), yr, '.nc' @@ -1952,62 +1934,75 @@ end subroutine longwave_rosati_miyakoda subroutine ncar_files (yr) -! Construct filenames based on the LANL naming conventions for NCAR data. -! Edit for other directory structures or filenames. -! Note: The year number in these filenames does not matter, because -! subroutine file_year will insert the correct year. + ! Construct filenames based on the LANL naming conventions for NCAR data. + ! Edit for other directory structures or filenames. + ! Note: The year number in these filenames does not matter, because + ! subroutine file_year will insert the correct year. + ! Note: atm_data_dir may have NCAR_bulk or not + ! + ! atm_data_type should be 'ncar' + ! atm_dat_dir should be ${CICE_DATA_root}/forcing/$grid/[NCAR_bulk,''] + ! atm_data_dir should be set to ${CICE_DATA_root}/forcing/$grid/[JRA55,JRA55do,''] + ! NCAR_bulk at the end of the atm_data_dir is optional to provide backwards + ! compatibility and if not included, will be appended automaticaly. + ! The grid is typically gx1, gx3, tx1, or similar. integer (kind=int_kind), intent(in) :: & yr ! current forcing year + character (char_len_long) :: & + atm_data_dir_extra ! atm_dat_dir extra if needed + + integer (kind=int_kind) :: & + strind ! string index + character(len=*), parameter :: subname = '(ncar_files)' if (local_debug .and. my_task == master_task) write(nu_diag,*) subname,'fdbg start' - fsw_file = & - trim(atm_data_dir)//'/MONTHLY/swdn.1996.dat' + ! decide whether NCAR_bulk is part of atm_data_dir and set atm_data_dir_extra + atm_data_dir_extra = '/NCAR_bulk' + strind = index(trim(atm_data_dir),'NCAR_bulk') + if (strind > 0) then + atm_data_dir_extra = '' + endif + + fsw_file = trim(atm_data_dir)//trim(atm_data_dir_extra)//'/MONTHLY/swdn.1996.dat' call file_year(fsw_file,yr) - flw_file = & - trim(atm_data_dir)//'/MONTHLY/cldf.1996.dat' + flw_file = trim(atm_data_dir)//trim(atm_data_dir_extra)//'/MONTHLY/cldf.1996.dat' call file_year(flw_file,yr) - rain_file = & - trim(atm_data_dir)//'/MONTHLY/prec.1996.dat' + rain_file = trim(atm_data_dir)//trim(atm_data_dir_extra)//'/MONTHLY/prec.1996.dat' call file_year(rain_file,yr) - uwind_file = & - trim(atm_data_dir)//'/4XDAILY/u_10.1996.dat' + uwind_file = trim(atm_data_dir)//trim(atm_data_dir_extra)//'/4XDAILY/u_10.1996.dat' call file_year(uwind_file,yr) - vwind_file = & - trim(atm_data_dir)//'/4XDAILY/v_10.1996.dat' + vwind_file = trim(atm_data_dir)//trim(atm_data_dir_extra)//'/4XDAILY/v_10.1996.dat' call file_year(vwind_file,yr) - tair_file = & - trim(atm_data_dir)//'/4XDAILY/t_10.1996.dat' + tair_file = trim(atm_data_dir)//trim(atm_data_dir_extra)//'/4XDAILY/t_10.1996.dat' call file_year(tair_file,yr) - humid_file = & - trim(atm_data_dir)//'/4XDAILY/q_10.1996.dat' + humid_file = trim(atm_data_dir)//trim(atm_data_dir_extra)//'/4XDAILY/q_10.1996.dat' call file_year(humid_file,yr) - rhoa_file = & - trim(atm_data_dir)//'/4XDAILY/dn10.1996.dat' + rhoa_file = trim(atm_data_dir)//trim(atm_data_dir_extra)//'/4XDAILY/dn10.1996.dat' call file_year(rhoa_file,yr) if (my_task == master_task) then write (nu_diag,*) ' ' write (nu_diag,*) 'Forcing data year =', fyear write (nu_diag,*) 'Atmospheric data files:' - write (nu_diag,*) trim(fsw_file) - write (nu_diag,*) trim(flw_file) - write (nu_diag,*) trim(rain_file) - write (nu_diag,*) trim(uwind_file) - write (nu_diag,*) trim(vwind_file) - write (nu_diag,*) trim(tair_file) - write (nu_diag,*) trim(humid_file) - write (nu_diag,*) trim(rhoa_file) + write (nu_diag,'(3a)') trim(fsw_file) + write (nu_diag,'(3a)') trim(flw_file) + write (nu_diag,'(3a)') trim(rain_file) + write (nu_diag,'(3a)') trim(uwind_file) + write (nu_diag,'(3a)') trim(vwind_file) + write (nu_diag,'(3a)') trim(tair_file) + write (nu_diag,'(3a)') trim(humid_file) + write (nu_diag,'(3a)') trim(rhoa_file) endif ! master_task end subroutine ncar_files @@ -2172,66 +2167,114 @@ end subroutine ncar_data !======================================================================= - subroutine JRA55_gx1_files(yr) -! + subroutine JRA55_files(yr) + + ! find the JRA55 files: + ! This subroutine finds the JRA55 atm forcing files based on settings + ! in atm_data_type and atm_data_dir. Because the filenames are not + ! entirely consistent, we need a flexible method. + ! + ! atm_data_type could be JRA55 or JRA55do with/without _grid appended + ! atm_data_dir could contain JRA55 or JRA55do or not + ! actual files could have grid in name in two location or not at all + ! + ! The files will generally be of the format + ! $atm_data_type/[JRA55,JRA55do,'']/8XDAILY/[JRA55,JRA55do][_$grid,'']_03hr_forcing[_$grid,'']_$year.nc + ! The options defined by cnt try several versions of paths/filenames + ! As a user, + ! atm_data_type should be set to JRA55, JRA55do, JRA55_xxx, or JRA55do_xxx + ! where xxx can be any set of characters. The _xxx if included will be ignored. + ! Historically, these were set to JRA55_gx1 and so forth but the _gx1 is no longer needed + ! but this is still allowed for backwards compatibility. atm_data_type_prefix + ! is atm_data_type with _ and everything after _ removed. + ! atm_data_dir should be set to ${CICE_DATA_root}/forcing/$grid/[JRA55,JRA55do,''] + ! The [JRA55,JRA55do] at the end of the atm_data_dir is optional to provide backwards + ! compatibility and if not included, will be appended automaticaly using + ! the atm_data_type_prefix value. The grid is typically gx1, gx3, tx1, or similar. + ! In general, we recommend using the following format + ! atm_data_type = [JRA55,JRA55do] + ! atm_data_dir = ${CICE_DATA_root}/forcing/$grid + integer (kind=int_kind), intent(in) :: & - yr ! current forcing year + yr ! current forcing year - character(len=*), parameter :: subname = '(JRA55_gx1_files)' + ! local variables + character(len=16) :: & + grd ! gx3, gx1, tx1 + + character(len=64) :: & + atm_data_type_prefix ! atm_data_type prefix + + integer (kind=int_kind) :: & + cnt , & ! search for files + strind ! string index + + logical :: & + exists ! file existance + + character(len=*), parameter :: subname = '(JRA55_files)' if (local_debug .and. my_task == master_task) write(nu_diag,*) subname,'fdbg start' - uwind_file = & - trim(atm_data_dir)//'/8XDAILY/JRA55_03hr_forcing_2005.nc' - call file_year(uwind_file,yr) - if (my_task == master_task) then - write (nu_diag,*) ' ' - write (nu_diag,*) 'Atmospheric data files:' - write (nu_diag,*) trim(uwind_file) + ! this could be JRA55[do] or JRA55[do]_grid, drop the _grid if set + atm_data_type_prefix = trim(atm_data_type) + strind = index(trim(atm_data_type),'_') + if (strind > 0) then + atm_data_type_prefix = atm_data_type(1:strind-1) endif - end subroutine JRA55_gx1_files -!======================================================================= + ! check for grid version using fortran INDEX intrinsic + if (index(trim(atm_data_dir),'gx1') > 0) then + grd = 'gx1' + else if (index(trim(atm_data_dir),'gx3') > 0) then + grd = 'gx3' + else if (index(trim(atm_data_dir),'tx1') > 0) then + grd = 'tx1' + else + call abort_ice(error_message=subname//' unknown grid type') + endif - subroutine JRA55_tx1_files(yr) -! - integer (kind=int_kind), intent(in) :: & - yr ! current forcing year + ! cnt represents the possible file format options and steps thru them until one is found + exists = .false. + cnt = 1 + do while (.not.exists .and. cnt <= 6) + if (cnt == 1) uwind_file = trim(atm_data_dir)//'/'//trim(atm_data_type_prefix)// & + '/8XDAILY/'//trim(atm_data_type_prefix)//'_'//trim(grd)//'_03hr_forcing_2005.nc' - character(len=*), parameter :: subname = '(JRA55_tx1_files)' + if (cnt == 2) uwind_file = trim(atm_data_dir)//'/'//trim(atm_data_type_prefix)// & + '/8XDAILY/'//trim(atm_data_type_prefix)//'_03hr_forcing_'//trim(grd)//'_2005.nc' - if (local_debug .and. my_task == master_task) write(nu_diag,*) subname,'fdbg start' + if (cnt == 3) uwind_file = trim(atm_data_dir)//'/'//trim(atm_data_type_prefix)// & + '/8XDAILY/'//trim(atm_data_type_prefix)// '_03hr_forcing_2005.nc' - uwind_file = & - trim(atm_data_dir)//'/8XDAILY/JRA55_03hr_forcing_tx1_2005.nc' - call file_year(uwind_file,yr) - if (my_task == master_task) then - write (nu_diag,*) ' ' - write (nu_diag,*) 'Atmospheric data files:' - write (nu_diag,*) trim(uwind_file) - endif - end subroutine JRA55_tx1_files + if (cnt == 4) uwind_file = trim(atm_data_dir)// & + '/8XDAILY/'//trim(atm_data_type_prefix)//'_'//trim(grd)//'_03hr_forcing_2005.nc' -!======================================================================= + if (cnt == 5) uwind_file = trim(atm_data_dir)// & + '/8XDAILY/'//trim(atm_data_type_prefix)//'_03hr_forcing_'//trim(grd)//'_2005.nc' - subroutine JRA55_gx3_files(yr) -! - integer (kind=int_kind), intent(in) :: & - yr ! current forcing year + if (cnt == 6) uwind_file = trim(atm_data_dir)// & + '/8XDAILY/'//trim(atm_data_type_prefix)// '_03hr_forcing_2005.nc' - character(len=*), parameter :: subname = '(JRA55_gx3_files)' + call file_year(uwind_file,yr) + INQUIRE(FILE=uwind_file,EXIST=exists) +! if (my_task == master_task) then +! write(nu_diag,*) subname,cnt,exists,trim(uwind_file) +! endif + cnt = cnt + 1 + enddo - if (local_debug .and. my_task == master_task) write(nu_diag,*) subname,'fdbg start' + if (.not.exists) then + call abort_ice(error_message=subname//' could not find forcing file') + endif - uwind_file = & - trim(atm_data_dir)//'/8XDAILY/JRA55_gx3_03hr_forcing_2005.nc' - call file_year(uwind_file,yr) if (my_task == master_task) then - write (nu_diag,*) ' ' - write (nu_diag,*) 'Atmospheric data files:' - write (nu_diag,*) trim(uwind_file) + write (nu_diag,'(2a)') ' ' + write (nu_diag,'(2a)') subname,'Atmospheric data files:' + write (nu_diag,'(2a)') subname,trim(uwind_file) endif - end subroutine JRA55_gx3_files + + end subroutine JRA55_files !======================================================================= @@ -2303,7 +2346,7 @@ subroutine JRA55_data uwind_file_old = uwind_file if (uwind_file /= uwind_file_old .and. my_task == master_task) then - write(nu_diag,*) subname,' reading forcing file = ',trim(uwind_file) + write(nu_diag,'(2a)') subname,' reading forcing file = ',trim(uwind_file) endif call ice_open_nc(uwind_file,ncid) @@ -2315,7 +2358,7 @@ subroutine JRA55_data if (n1 == 1) then recnum = 8*int(yday) - 7 + int(real(msec,kind=dbl_kind)/sec3hr) if (my_task == master_task .and. (recnum <= 2 .or. recnum >= maxrec-1)) then - write(nu_diag,*) subname,' reading forcing file 1st ts = ',trim(uwind_file) + write(nu_diag,'(3a)') subname,' reading forcing file 1st ts = ',trim(uwind_file) endif elseif (n1 == 2) then recnum = 8*int(yday) - 7 + int(real(msec,kind=dbl_kind)/sec3hr) + 1 @@ -2325,7 +2368,7 @@ subroutine JRA55_data recnum = 1 call file_year(uwind_file,lfyear) if (my_task == master_task) then - write(nu_diag,*) subname,' reading forcing file 2nd ts = ',trim(uwind_file) + write(nu_diag,'(3a)') subname,' reading forcing file 2nd ts = ',trim(uwind_file) endif call ice_close_nc(ncid) call ice_open_nc(uwind_file,ncid) 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 bfbe31707..51d76a6f4 100644 --- a/cicecore/cicedyn/infrastructure/io/io_netcdf/ice_history_write.F90 +++ b/cicecore/cicedyn/infrastructure/io/io_netcdf/ice_history_write.F90 @@ -753,7 +753,7 @@ subroutine ice_write_hist (ns) !----------------------------------------------------------------- ! write time variable !----------------------------------------------------------------- - + ltime2 = timesecs/secday ! hist_time_axis = 'end' (default) ! Some coupled models require the time axis "stamp" to be in the middle @@ -762,7 +762,7 @@ subroutine ice_write_hist (ns) 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 = nf90_inq_varid(ncid,'time',varid) if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: getting time varid') 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 877071a11..cf2f40521 100644 --- a/cicecore/cicedyn/infrastructure/io/io_pio2/ice_history_write.F90 +++ b/cicecore/cicedyn/infrastructure/io/io_pio2/ice_history_write.F90 @@ -715,7 +715,7 @@ subroutine ice_write_hist (ns) 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) diff --git a/configuration/scripts/cice.batch.csh b/configuration/scripts/cice.batch.csh index 1cf23da45..5a47decf1 100755 --- a/configuration/scripts/cice.batch.csh +++ b/configuration/scripts/cice.batch.csh @@ -33,6 +33,21 @@ cat >> ${jobfile} << EOFB #PBS -l walltime=${batchtime} EOFB +else if (${ICE_MACHINE} =~ derecho*) then +cat >> ${jobfile} << EOFB +#PBS -q ${queue} +#PBS -l job_priority=regular +#PBS -N ${ICE_CASENAME} +#PBS -A ${acct} +#PBS -l select=${nnodes}:ncpus=${corespernode}:mpiprocs=${taskpernodelimit}:ompthreads=${nthrds} +#PBS -l walltime=${batchtime} +#PBS -j oe +#PBS -W umask=022 +#PBS -o ${ICE_CASEDIR} +###PBS -M username@domain.com +###PBS -m be +EOFB + else if (${ICE_MACHINE} =~ gust*) then cat >> ${jobfile} << EOFB #PBS -q ${queue} diff --git a/configuration/scripts/cice.launch.csh b/configuration/scripts/cice.launch.csh index b13da1813..971bc0075 100755 --- a/configuration/scripts/cice.launch.csh +++ b/configuration/scripts/cice.launch.csh @@ -22,6 +22,18 @@ mpiexec_mpt -np ${ntasks} omplace ./cice >&! \$ICE_RUNLOG_FILE EOFR endif +#======= +else if (${ICE_MACHCOMP} =~ derecho*) then +if (${ICE_COMMDIR} =~ serial*) then +cat >> ${jobfile} << EOFR +./cice >&! \$ICE_RUNLOG_FILE +EOFR +else +cat >> ${jobfile} << EOFR +mpiexec --cpu-bind depth -n ${ntasks} -ppn ${taskpernodelimit} -d ${nthrds} ./cice >&! \$ICE_RUNLOG_FILE +EOFR +endif + #======= else if (${ICE_MACHCOMP} =~ gust*) then if (${ICE_COMMDIR} =~ serial*) then diff --git a/configuration/scripts/machines/Macros.derecho_intel b/configuration/scripts/machines/Macros.derecho_intel new file mode 100644 index 000000000..df0d2320e --- /dev/null +++ b/configuration/scripts/machines/Macros.derecho_intel @@ -0,0 +1,69 @@ +#============================================================================== +# Makefile macros for NCAR cheyenne, intel compiler +#============================================================================== + +CPP := fpp +CPPDEFS := -DFORTRANUNDERSCORE ${ICE_CPPDEFS} +CFLAGS := -c -O2 -fp-model precise -march=core-avx2 + +FIXEDFLAGS := -fixed -132 +FREEFLAGS := -free +FFLAGS := -fp-model precise -convert big_endian -assume byterecl -ftz -traceback -march=core-avx2 +FFLAGS_NOOPT:= -O0 + +ifeq ($(ICE_BLDDEBUG), true) + FFLAGS += -O0 -g -check uninit -check bounds -check pointers -fpe0 -check noarg_temp_created -link_mpi=dbg +# FFLAGS += -O0 -g -check all -fpe0 -ftrapuv -fp-model except -check noarg_temp_created -link_mpi=dbg -stand f08 +# FFLAGS += -O0 -g -check all -fpe0 -ftrapuv -fp-model except -check noarg_temp_created -init=snan,arrays -link_mpi=dbg +else + FFLAGS += -O2 +endif + +SCC := icx +SFC := ifort +MPICC := mpicc +MPIFC := mpif90 + +ifeq ($(ICE_COMMDIR), mpi) + FC := $(MPIFC) + CC := $(MPICC) +else + FC := $(SFC) + CC := $(SCC) +endif +LD:= $(FC) + +NETCDF_PATH := $(NETCDF) + +#PIO_CONFIG_OPTS:= --enable-filesystem-hints=gpfs + +PNETCDF_PATH := $(PNETCDF) +#PNETCDF_PATH := /glade/u/apps/ch/opt/pio/2.2/mpt/2.15f/intel/17.0.1/lib + +INCLDIR := $(INCLDIR) + +LIB_NETCDF := $(NETCDF)/lib +#LIB_PNETCDF := $(PNETCDF_PATH)/lib +#LIB_MPI := $(IMPILIBDIR) + +#SLIBS := -L$(LIB_NETCDF) -lnetcdf -lnetcdff -L$(LIB_PNETCDF) -lpnetcdf -lgptl +SLIBS := -L$(LIB_NETCDF) -lnetcdf -lnetcdff + +ifeq ($(ICE_THREADED), true) + LDFLAGS += -qopenmp + CFLAGS += -qopenmp + FFLAGS += -qopenmp +endif + +#ifeq ($(ICE_IOTYPE), pio1) +# LIB_PIO := $(PIO_LIBDIR) +# SLIBS := $(SLIBS) -L$(LIB_PIO) -lpio +#endif + +ifeq ($(ICE_IOTYPE), pio2) +# CPPDEFS := $(CPPDEFS) -DGPTL +# LIB_PIO := $(PIO_LIBDIR) +# SLIBS := $(SLIBS) -L$(LIB_PIO) -lpiof -lpioc -lgptl + SLIBS := $(SLIBS) -lpiof -lpioc +endif + diff --git a/configuration/scripts/machines/Macros.onyx_intel b/configuration/scripts/machines/Macros.onyx_intel index 92879ee82..17cec8c74 100644 --- a/configuration/scripts/machines/Macros.onyx_intel +++ b/configuration/scripts/machines/Macros.onyx_intel @@ -4,11 +4,11 @@ CPP := fpp CPPDEFS := -DFORTRANUNDERSCORE ${ICE_CPPDEFS} -CFLAGS := -c -O2 -fp-model precise -xHost +CFLAGS := -c -O2 -fp-model precise FIXEDFLAGS := -132 FREEFLAGS := -FR -FFLAGS := -fp-model precise -convert big_endian -assume byterecl -ftz -traceback -xHost +FFLAGS := -fp-model precise -convert big_endian -assume byterecl -ftz -traceback FFLAGS_NOOPT:= -O0 ifeq ($(ICE_BLDDEBUG), true) diff --git a/configuration/scripts/machines/env.derecho_intel b/configuration/scripts/machines/env.derecho_intel new file mode 100644 index 000000000..baa053e75 --- /dev/null +++ b/configuration/scripts/machines/env.derecho_intel @@ -0,0 +1,70 @@ +#!/bin/csh -f + +set inp = "undefined" +if ($#argv == 1) then + set inp = $1 +endif + +if ("$inp" != "-nomodules") then + +source ${MODULESHOME}/init/csh + +module --force purge +module load ncarenv/23.06 +module load craype +module load intel/2023.0.0 +module load ncarcompilers +module load cray-mpich/8.1.25 +#module load hdf5/1.12.2 +module load netcdf-mpi/4.9.2 +module load cray-libsci/23.02.1.1 + +if ($?ICE_IOTYPE) then +if ($ICE_IOTYPE =~ pio*) then + module load parallel-netcdf/1.12.3 + if ($ICE_IOTYPE == "pio1") then + module load parallelio/1.10.1 + else + module load parallelio/2.6.0 + endif +endif +endif + +if ($?ICE_BFBTYPE) then +if ($ICE_BFBTYPE =~ qcchk*) then + module load conda +# conda env create -f ../../configuration/scripts/tests/qctest.yml + conda activate qctest +endif +endif + +# For perftools with mpiexec +# module load perftools-base +# module load perftools +#setenv PALS_TRANSFER FALSE + +endif + +limit coredumpsize unlimited +limit stacksize unlimited +setenv PALS_QUIET TRUE + +# May be needed for OpenMP memory +setenv OMP_STACKSIZE 64M +# OMP runtime diagnostics +#setenv OMP_DISPLAY_ENV TRUE + +setenv ICE_MACHINE_MACHNAME derecho +setenv ICE_MACHINE_MACHINFO "HPE Cray EX Milan Slingshot 11" +setenv ICE_MACHINE_ENVNAME intel +setenv ICE_MACHINE_ENVINFO "ifort 2021.8.0 20221119, cray-mpich 2.25, netcdf-mpi4.9.2, pnetcdf1.12.3, pio2.6.0" +setenv ICE_MACHINE_MAKE gmake +setenv ICE_MACHINE_WKDIR /glade/derecho/scratch/$user/CICE_RUNS +setenv ICE_MACHINE_INPUTDATA /glade/p/cesm/pcwg_dev +setenv ICE_MACHINE_BASELINE /glade/derecho/scratch/$user/CICE_BASELINE +setenv ICE_MACHINE_SUBMIT "qsub" +setenv ICE_MACHINE_ACCT P00000000 +setenv ICE_MACHINE_QUEUE "main" +setenv ICE_MACHINE_TPNODE 128 +setenv ICE_MACHINE_BLDTHRDS 8 +setenv ICE_MACHINE_QSTAT "qstat " diff --git a/configuration/scripts/machines/env.nrlssc_gnu b/configuration/scripts/machines/env.nrlssc_gnu index 1f8dd4441..94025ddf9 100644 --- a/configuration/scripts/machines/env.nrlssc_gnu +++ b/configuration/scripts/machines/env.nrlssc_gnu @@ -5,12 +5,12 @@ setenv ICE_MACHINE_MACHINFO "nrlssc" setenv ICE_MACHINE_ENVNAME gnu setenv ICE_MACHINE_ENVINFO "gnu" setenv ICE_MACHINE_MAKE gmake -setenv ICE_MACHINE_WKDIR /u/data/hebert/CICE_RUNS -setenv ICE_MACHINE_INPUTDATA /u/data/hebert/CICE_RUNS -setenv ICE_MACHINE_BASELINE /u/data/hebert/CICE_BASELINE +setenv ICE_MACHINE_WKDIR /u/hebert/data/CICE_RUNS +setenv ICE_MACHINE_INPUTDATA /u/hebert/data/ +setenv ICE_MACHINE_BASELINE /u/hebert/data/CICE_BASELINE setenv ICE_MACHINE_SUBMIT "qsub " setenv ICE_MACHINE_ACCT P00000000 setenv ICE_MACHINE_QUEUE "standard" -setenv ICE_MACHINE_TPNODE 20 # tasks per node -setenv ICE_MACHINE_BLDTHRDS 1 +setenv ICE_MACHINE_TPNODE 28 # tasks per node +setenv ICE_MACHINE_BLDTHRDS 8 setenv ICE_MACHINE_QSTAT "qstat " diff --git a/configuration/scripts/machines/env.onyx_cray b/configuration/scripts/machines/env.onyx_cray index e696d1b98..e879cdf03 100644 --- a/configuration/scripts/machines/env.onyx_cray +++ b/configuration/scripts/machines/env.onyx_cray @@ -13,14 +13,14 @@ module unload PrgEnv-cray module unload PrgEnv-gnu module unload PrgEnv-intel module unload PrgEnv-pgi -module load PrgEnv-cray/6.0.9 +module load PrgEnv-cray/6.0.10 module unload cce -module load cce/11.0.2 +module load cce/14.0.3 module unload cray-mpich module unload cray-mpich2 -module load cray-mpich/7.7.16 +module load cray-mpich/7.7.20 module unload netcdf module unload cray-netcdf @@ -28,8 +28,8 @@ module unload cray-hdf5 module unload cray-hdf5-parallel module unload cray-netcdf-hdf5parallel module unload cray-parallel-netcdf -module load cray-netcdf/4.7.4.0 -module load cray-hdf5/1.12.0.0 +module load cray-netcdf/4.8.1.3 +module load cray-hdf5/1.12.1.3 module unload cray-libsci module unload craype-hugepages2M @@ -46,7 +46,7 @@ endif setenv ICE_MACHINE_MACHNAME onyx setenv ICE_MACHINE_MACHINFO "Cray XC40/50 Xeon E5-2699v4 Broadwell" setenv ICE_MACHINE_ENVNAME cray -setenv ICE_MACHINE_ENVINFO "Cray cce/11.0.2, cray-mpich/7.7.16, netcdf/4.7.4.0" +setenv ICE_MACHINE_ENVINFO "Cray cce/14.0.3, cray-mpich/7.7.20, netcdf/4.8.1.3" setenv ICE_MACHINE_MAKE gmake setenv ICE_MACHINE_WKDIR $WORKDIR/CICE_RUNS setenv ICE_MACHINE_INPUTDATA /p/app/unsupported/RASM/cice_consortium diff --git a/configuration/scripts/machines/env.onyx_gnu b/configuration/scripts/machines/env.onyx_gnu index 80ebb8e43..19a4eb701 100644 --- a/configuration/scripts/machines/env.onyx_gnu +++ b/configuration/scripts/machines/env.onyx_gnu @@ -13,14 +13,14 @@ module unload PrgEnv-cray module unload PrgEnv-gnu module unload PrgEnv-intel module unload PrgEnv-pgi -module load PrgEnv-gnu/6.0.9 +module load PrgEnv-gnu/6.0.10 module unload gcc -module load gcc/10.2.0 +module load gcc/12.1.0 module unload cray-mpich module unload cray-mpich2 -module load cray-mpich/7.7.16 +module load cray-mpich/7.7.20 module unload netcdf module unload cray-netcdf @@ -28,8 +28,8 @@ module unload cray-hdf5 module unload cray-hdf5-parallel module unload cray-netcdf-hdf5parallel module unload cray-parallel-netcdf -module load cray-netcdf/4.7.4.0 -module load cray-hdf5/1.12.0.0 +module load cray-netcdf/4.8.1.3 +module load cray-hdf5/1.12.1.3 module unload cray-libsci module unload craype-hugepages2M @@ -46,7 +46,7 @@ endif setenv ICE_MACHINE_MACHNAME onyx setenv ICE_MACHINE_MACHINFO "Cray XC40/50 Xeon E5-2699v4 Broadwell" setenv ICE_MACHINE_ENVNAME gnu -setenv ICE_MACHINE_ENVINFO "GNU Fortran (GCC) 10.2.0, cray-mpich/7.7.16, netcdf/4.7.4.0" +setenv ICE_MACHINE_ENVINFO "GNU Fortran (GCC) 12.1.0, cray-mpich/7.7.20, netcdf/4.8.1.3" setenv ICE_MACHINE_MAKE gmake setenv ICE_MACHINE_WKDIR $WORKDIR/CICE_RUNS setenv ICE_MACHINE_INPUTDATA /p/app/unsupported/RASM/cice_consortium diff --git a/configuration/scripts/machines/env.onyx_intel b/configuration/scripts/machines/env.onyx_intel index 362454dd4..999d5a2bd 100644 --- a/configuration/scripts/machines/env.onyx_intel +++ b/configuration/scripts/machines/env.onyx_intel @@ -13,14 +13,14 @@ module unload PrgEnv-cray module unload PrgEnv-gnu module unload PrgEnv-intel module unload PrgEnv-pgi -module load PrgEnv-intel/6.0.9 +module load PrgEnv-intel/6.0.10 module unload intel -module load intel/19.1.3.304 +module load intel/2021.4.0 module unload cray-mpich module unload cray-mpich2 -module load cray-mpich/7.7.16 +module load cray-mpich/7.7.20 module unload netcdf module unload cray-netcdf @@ -28,8 +28,8 @@ module unload cray-hdf5 module unload cray-hdf5-parallel module unload cray-netcdf-hdf5parallel module unload cray-parallel-netcdf -module load cray-netcdf/4.7.4.0 -module load cray-hdf5/1.12.0.0 +module load cray-netcdf/4.8.1.3 +module load cray-hdf5/1.12.1.3 module unload cray-libsci module unload craype-hugepages2M @@ -46,7 +46,7 @@ endif setenv ICE_MACHINE_MACHNAME onyx setenv ICE_MACHINE_MACHINFO "Cray XC40/50 Xeon E5-2699v4 Broadwell" setenv ICE_MACHINE_ENVNAME intel -setenv ICE_MACHINE_ENVINFO "ifort 19.1.3.304, cray-mpich/7.7.16, netcdf/4.7.4.0" +setenv ICE_MACHINE_ENVINFO "ifort 2021.4.0, cray-mpich/7.7.20, netcdf/4.8.1.3" setenv ICE_MACHINE_MAKE gmake setenv ICE_MACHINE_WKDIR $WORKDIR/CICE_RUNS setenv ICE_MACHINE_INPUTDATA /p/app/unsupported/RASM/cice_consortium diff --git a/configuration/scripts/options/set_nml.gx1 b/configuration/scripts/options/set_nml.gx1 index 50615e81e..781da3389 100644 --- a/configuration/scripts/options/set_nml.gx1 +++ b/configuration/scripts/options/set_nml.gx1 @@ -14,8 +14,8 @@ maskhalo_remap = .true. maskhalo_bound = .true. fyear_init = 2005 atm_data_format = 'nc' -atm_data_type = 'JRA55_gx1' -atm_data_dir = 'ICE_MACHINE_INPUTDATA/CICE_data/forcing/gx1/JRA55' +atm_data_type = 'JRA55' +atm_data_dir = 'ICE_MACHINE_INPUTDATA/CICE_data/forcing/gx1' precip_units = 'mks' ocn_data_dir = 'ICE_MACHINE_INPUTDATA/CICE_data/forcing/gx1/CESM/MONTHLY' bgc_data_dir = 'ICE_MACHINE_INPUTDATA/CICE_data/forcing/gx1/WOA/MONTHLY' diff --git a/configuration/scripts/options/set_nml.gx3 b/configuration/scripts/options/set_nml.gx3 index 1a2fe62a5..3492509c6 100644 --- a/configuration/scripts/options/set_nml.gx3 +++ b/configuration/scripts/options/set_nml.gx3 @@ -11,8 +11,8 @@ kmt_file = 'ICE_MACHINE_INPUTDATA/CICE_data/grid/gx3/kmt_gx3.bin' bathymetry_file = 'ICE_MACHINE_INPUTDATA/CICE_data/grid/gx3/global_gx3.bathy.nc' fyear_init = 2005 atm_data_format = 'nc' -atm_data_type = 'JRA55_gx3' -atm_data_dir = 'ICE_MACHINE_INPUTDATA/CICE_data/forcing/gx3/JRA55' +atm_data_type = 'JRA55' +atm_data_dir = 'ICE_MACHINE_INPUTDATA/CICE_data/forcing/gx3' precip_units = 'mks' ocn_data_format = 'bin' ocn_data_dir = 'ICE_MACHINE_INPUTDATA/CICE_data/forcing/gx3/' diff --git a/configuration/scripts/options/set_nml.gx3ncarbulk b/configuration/scripts/options/set_nml.gx3ncarbulk index fbe0f7ae7..044c77a54 100644 --- a/configuration/scripts/options/set_nml.gx3ncarbulk +++ b/configuration/scripts/options/set_nml.gx3ncarbulk @@ -4,6 +4,6 @@ use_restart_time = .true. fyear_init = 1997 atm_data_format = 'bin' atm_data_type = 'ncar' -atm_data_dir = 'ICE_MACHINE_INPUTDATA/CICE_data/forcing/gx3/NCAR_bulk' +atm_data_dir = 'ICE_MACHINE_INPUTDATA/CICE_data/forcing/gx3' precip_units = 'mm_per_month' diff --git a/configuration/scripts/options/set_nml.jra55 b/configuration/scripts/options/set_nml.jra55 new file mode 100644 index 000000000..465152498 --- /dev/null +++ b/configuration/scripts/options/set_nml.jra55 @@ -0,0 +1,2 @@ +atm_data_format = 'nc' +atm_data_type = 'JRA55' diff --git a/configuration/scripts/options/set_nml.jra55do b/configuration/scripts/options/set_nml.jra55do new file mode 100644 index 000000000..5ca4cb397 --- /dev/null +++ b/configuration/scripts/options/set_nml.jra55do @@ -0,0 +1,2 @@ +atm_data_format = 'nc' +atm_data_type = 'JRA55do' diff --git a/configuration/scripts/options/set_nml.tx1 b/configuration/scripts/options/set_nml.tx1 index 5e66db871..c21231a0f 100644 --- a/configuration/scripts/options/set_nml.tx1 +++ b/configuration/scripts/options/set_nml.tx1 @@ -6,8 +6,8 @@ grid_type = 'tripole' ns_boundary_type = 'tripole' grid_file = 'ICE_MACHINE_INPUTDATA/CICE_data/grid/tx1/grid_tx1.bin' kmt_file = 'ICE_MACHINE_INPUTDATA/CICE_data/grid/tx1/kmt_tx1.bin' -atm_data_dir = 'ICE_MACHINE_INPUTDATA/CICE_data/forcing/tx1/JRA55' +atm_data_dir = 'ICE_MACHINE_INPUTDATA/CICE_data/forcing/tx1' atm_data_format = 'nc' -atm_data_type = 'JRA55_tx1' +atm_data_type = 'JRA55' year_init = 2005 fyear_init = 2005 diff --git a/configuration/scripts/tests/base_suite.ts b/configuration/scripts/tests/base_suite.ts index 8685ab9a8..906aae08d 100644 --- a/configuration/scripts/tests/base_suite.ts +++ b/configuration/scripts/tests/base_suite.ts @@ -12,6 +12,7 @@ smoke gx3 4x1 diag1,run5day,thread smoke_gx3_8x2_diag1_ smoke gx3 1x8 diag1,run5day,evp1d restart gx1 40x4 droundrobin,medium restart tx1 40x4 dsectrobin,medium +restart tx1 40x4 dsectrobin,medium,jra55do restart gx3 4x4 none restart gx3 10x4 maskhalo restart gx3 6x2 alt01 @@ -46,12 +47,14 @@ smoke gbox80 1x1 boxslotcyl smoke gbox12 1x1x12x12x1 boxchan,diag1,debug restart gx3 8x2 modal smoke gx3 8x2 bgcz +smoke gx3 8x2 jra55do smoke gx3 8x2 bgczm,debug smoke gx3 8x1 bgcskl,debug #smoke gx3 4x1 bgcz,thread smoke_gx3_8x2_bgcz restart gx1 4x2 bgcsklclim,medium restart gx1 8x1 bgczclim,medium smoke gx1 24x1 medium,run90day,yi2008 +smoke gx1 24x1 medium,run90day,yi2008,jra55do smoke gx3 8x1 medium,run90day,yi2008 restart gx1 24x1 short restart gx1 16x2 seabedLKD,gx1apr,short,debug diff --git a/doc/source/developer_guide/dg_forcing.rst b/doc/source/developer_guide/dg_forcing.rst index 0b90a9b2e..8cf293843 100644 --- a/doc/source/developer_guide/dg_forcing.rst +++ b/doc/source/developer_guide/dg_forcing.rst @@ -21,12 +21,12 @@ primitive, in part due to historical reasons and in part because standalone runs are discouraged for evaluating complex science. In general, most implementations use aspects of the following approach, -- Input files are organized by year. +- Input files are organized by year. The underlying implementation provides for some flexibility and extensibility in filenames. For instance, JRA55 and JRA55do filenames can have syntax like ``[JRA55,JRA55do][_$grid,'']_03hr_forcing[_$grid,'']_$year.nc`` where $grid is optional or may be present at one of two locations within the filename. This implementation exists to support the current naming conventions within the gx1, gx3, and tx1 JRA55 and JRA55do CICE_DATA directory structure automatically. See **JRA55_files** in **ice_forcing.F90** for more details. - Namelist inputs ``fyear`` and ``ycycle`` specify the forcing year dataset. - The forcing year is computed on the fly and is assumed to be cyclical over the forcing dataset length defined by ``ycycle``. -- The namelist ``atm_dat_dir`` specifies the directory of the atmosphere input data files and the namelist ``atm_data_type`` defines the atmospheric forcing mode. -- The namelist ``ocn_dat_dir`` specifies the directory of the ocean input data files and the namelist ``ocn_data_type`` defines the ocean forcing mode. -- The filenames follow a particular naming convention that is defined in the source code (ie. subroutine **JRA55_gx1_files**). The forcing year is typically found just before the **.nc** part of the filename and there are tools (subroutine **file_year**) to update the filename based on the model year and appropriate forcing year. +- The namelist ``atm_data_dir`` specifies the path or partial path for the atmosphere input data files and the namelist ``atm_data_type`` defines the atmospheric forcing mode. ``atm_data_type`` values of ``JRA55``, ``JRA55do``, or ``ncar`` provide some flexibility for directory paths and filenames. Many details can be gleaned from the CICE_data directory structure and file names as well as from the implementation in **ice_forcing.F90**. But the main point is that atm_data_dir should be set to ${CICE_DATA_root}/forcing/$grid/[JRA55,JRA55do,NCAR_bulk,''] where [JRA55,JRA55do,NCAR_bulk] are optional but provided for backwards compatibility. grid is typically gx1, gx3, tx1, or similar. +- The namelist ``ocn_data_dir`` specifies the directory of the ocean input data files and the namelist ``ocn_data_type`` defines the ocean forcing mode. +- The filenames follow a particular naming convention that is defined in the source code (ie. subroutine **JRA55_files**). The forcing year is typically found just before the **.nc** part of the filename and there are tools (subroutine **file_year**) to update the filename based on the model year and appropriate forcing year. - The input data time axis is generally NOT read by the forcing subroutine. The forcing frequency is hardwired into the model and the file record number is computed based on the forcing frequency and model time. Mixing leap year input data and noleap model calendars (and vice versa) is not handled particularly gracefully. The CICE model does not read or check against the input data time axis. - Data is read on the model grid, no spatial interpolation exists. - Data is often time interpolated linearly between two input timestamps to the model time each model timestep. @@ -79,8 +79,8 @@ input data fields to model forcing fields. .. _JRA55forcing: -JRA55 Atmosphere Forcing -------------------------- +JRA55 and JRA55do Atmosphere Forcing +------------------------------------ The current default atmosphere forcing for gx3, gx1, and tx1 standalone grids for Consortium testing is the JRA55 forcing @@ -136,6 +136,11 @@ March 1, and all data after March 1 will be shifted one day. December 31 in leap years will be skipped when running with a CICE calendar with no leap days. +JRA55do forcing is also provided by the Consortium in the same format and scheme. The JRA55do +dataset is more focused on forcing for ocean and ice models, but provides a very similar climate +as the JRA55 forcing. To switch to JRA55do, set the namelist ``atm_data_type`` to ``JRA55do`` +and populate the input data directory with the JRA55do dataset provided by the Consortium. + .. _NCARforcing: diff --git a/doc/source/developer_guide/dg_tools.rst b/doc/source/developer_guide/dg_tools.rst index ba29e0184..74df2343b 100644 --- a/doc/source/developer_guide/dg_tools.rst +++ b/doc/source/developer_guide/dg_tools.rst @@ -27,10 +27,10 @@ JRA55 forcing datasets ------------------------ This section describes how to generate JRA55 forcing data for the CICE model. -Raw JRA55 files have to be interpolated and processed into input files specifically +Raw JRA55 or JRA55do files have to be interpolated and processed into input files specifically for the CICE model. A tool exists in **configuration/tools/jra55_datasets** to support that process. -The raw JRA55 data is obtained from the NCAR/UCAR Research Data Archive and +The raw JRA55 or JRA55do data is obtained from the NCAR/UCAR Research Data Archive and the conversion tools are written in python. Requirements diff --git a/doc/source/user_guide/ug_case_settings.rst b/doc/source/user_guide/ug_case_settings.rst index d5ec89df1..516f3238d 100644 --- a/doc/source/user_guide/ug_case_settings.rst +++ b/doc/source/user_guide/ug_case_settings.rst @@ -596,15 +596,14 @@ forcing_nml "", "``constant``", "constant-based boundary layer", "" "", "``mixed``", "stability-based boundary layer for wind stress, constant-based for sensible+latent heat fluxes", "" "``atmiter_conv``", "real", "convergence criteria for ustar", "0.0" - "``atm_data_dir``", "string", "path to atmospheric forcing data directory", "" + "``atm_data_dir``", "string", "path or partial path to atmospheric forcing data directory", "" "``atm_data_format``", "``bin``", "read direct access binary atmo forcing file format", "``bin``" "", "``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", "" - "", "``JRA55_gx1``", "JRA55 forcing data for gx1 grid :cite:`Tsujino18`", "" - "", "``JRA55_gx3``", "JRA55 forcing data for gx3 grid :cite:`Tsujino18`", "" - "", "``JRA55_tx1``", "JRA55 forcing data for tx1 grid :cite:`Tsujino18`", "" + "", "``JRA55``", "JRA55 forcing data :cite:`Tsujino18`", "" + "", "``JRA55do``", "JRA55do forcing data :cite:`Tsujino18`", "" "", "``monthly``", "monthly forcing data", "" "", "``ncar``", "NCAR bulk forcing data", "" "", "``oned``", "column forcing data", "" From 9f42a620e9e642c637d8f04441bacb5835ebf0b7 Mon Sep 17 00:00:00 2001 From: Tony Craig Date: Thu, 20 Jul 2023 14:59:42 -0700 Subject: [PATCH 10/76] 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 --- cicecore/drivers/unittest/optargs/optargs.F90 | 160 +- .../drivers/unittest/optargs/optargs_subs.F90 | 116 +- cicecore/drivers/unittest/opticep/CICE.F90 | 59 + .../unittest/opticep/CICE_FinalMod.F90 | 71 + .../drivers/unittest/opticep/CICE_InitMod.F90 | 517 +++ .../drivers/unittest/opticep/CICE_RunMod.F90 | 741 ++++ cicecore/drivers/unittest/opticep/README | 30 + .../unittest/opticep/ice_init_column.F90 | 3135 +++++++++++++++++ .../drivers/unittest/opticep/ice_step_mod.F90 | 1784 ++++++++++ configuration/scripts/Makefile | 6 +- configuration/scripts/options/set_env.opticep | 2 + configuration/scripts/tests/baseline.script | 27 +- configuration/scripts/tests/comparelog.csh | 12 +- configuration/scripts/tests/unittest_suite.ts | 7 +- doc/source/user_guide/ug_testing.rst | 2 + icepack | 2 +- 16 files changed, 6582 insertions(+), 89 deletions(-) create mode 100644 cicecore/drivers/unittest/opticep/CICE.F90 create mode 100644 cicecore/drivers/unittest/opticep/CICE_FinalMod.F90 create mode 100644 cicecore/drivers/unittest/opticep/CICE_InitMod.F90 create mode 100644 cicecore/drivers/unittest/opticep/CICE_RunMod.F90 create mode 100644 cicecore/drivers/unittest/opticep/README create mode 100644 cicecore/drivers/unittest/opticep/ice_init_column.F90 create mode 100644 cicecore/drivers/unittest/opticep/ice_step_mod.F90 create mode 100644 configuration/scripts/options/set_env.opticep diff --git a/cicecore/drivers/unittest/optargs/optargs.F90 b/cicecore/drivers/unittest/optargs/optargs.F90 index 4acf7ac9f..5d66539b9 100644 --- a/cicecore/drivers/unittest/optargs/optargs.F90 +++ b/cicecore/drivers/unittest/optargs/optargs.F90 @@ -1,45 +1,52 @@ program optargs - use optargs_subs, only: computeA, computeB, computeC, computeD - use optargs_subs, only: oa_error, oa_OK, oa_A, oa_B, oa_C, oa_D + use optargs_subs, only: dp + use optargs_subs, only: computeA, computeB, computeC, computeD, computeE + use optargs_subs, only: oa_error, oa_OK, oa_A, oa_B, oa_C, oa_D, oa_E use optargs_subs, only: oa_layer1, oa_count1 implicit none - real*8 :: Ai1, Ao - real*8 :: B - real*8 :: Ci1, Co - real*8 :: Di1, Di2, Do + real(dp):: Ai1, Ao + real(dp):: B + real(dp):: Ci1, Co + real(dp):: Di1, Di2, Do + real(dp), allocatable :: Ei(:),Eo(:) integer :: ierr, ierrV integer :: n integer, parameter :: ntests = 100 integer :: iresult - real*8 :: result, resultV - real*8, parameter :: errtol = 1.0e-12 + real(dp):: result, resultV + real(dp), parameter :: dpic = -99._dp + real(dp), parameter :: errtol = 1.0e-12 !---------------------- write(6,*) 'RunningUnitTest optargs' write(6,*) ' ' + allocate(Ei(3),Eo(3)) + iresult = 0 do n = 1,ntests - Ai1 = -99.; Ao = -99. - B = -99. - Ci1 = -99.; Co = -99. - Di1 = -99.; Di2 = -99.; Do = -99. + Ai1 = dpic; Ao = dpic + B = dpic + Ci1 = dpic; Co = dpic + Di1 = dpic; Di2 = dpic; Do = dpic + Ei = dpic; Eo = dpic ierr = oa_error - result = -888. - resultV = -999. + result = -888._dp + resultV = -999._dp computeA = .false. computeB = .false. computeC = .false. computeD = .false. + computeE = .false. select case (n) @@ -56,8 +63,8 @@ program optargs call oa_count1(Ai1=Ai1,Ao=Ao,B=B,Ci1=Ci1,Co=Co,Di1=Di1,Di2=Di2,Do=Do,ierr=ierr) case(2) result = -777.; resultV = -777. - ierrV = 9 - call oa_count1(Ai1,Ao,B,Ci1,Co,Di1,Di2,Do,ierr) + ierrV = 11 + call oa_count1(Ai1,Ao,B,Ci1,Co,Di1,Di2,Do,Ei,Eo,ierr) case(3) result = -777.; resultV = -777. ierrV = 3 @@ -66,6 +73,10 @@ program optargs result = -777.; resultV = -777. ierrV = 5 call oa_count1(Ci1=Ci1,Co=Co,ierr=ierr,Ao=Ao,Di1=Di1) + case(5) + result = -777.; resultV = -777. + ierrV = 8 + call oa_count1(Ai1,Ao,B,Ci1,Co,Di1,Di2,ierr=ierr) ! test optional order case(11) @@ -80,6 +91,10 @@ program optargs result = -777.; resultV = -777. ierrV = oa_OK call oa_layer1(Ci1=Ci1,Co=Co,ierr=ierr,Ao=Ao,Di1=Di1) + case(14) + result = -777.; resultV = -777. + ierrV = oa_OK + call oa_layer1(Eo=Eo,Ei=Ei,Ci1=Ci1,Co=Co,ierr=ierr,Ao=Ao,Di1=Di1) ! test optional argument checking case(21) @@ -87,15 +102,17 @@ program optargs computeB = .true. computeC = .true. computeD = .true. + computeE = .true. result = -777.; resultV = -777. ierrV = oa_error ! B missing - call oa_layer1(Ai1=Ai1,Ao=Ao,Ci1=Ci1,Co=Co,Di1=Di1,Di2=Di2,Do=Do,ierr=ierr) + call oa_layer1(Ai1=Ai1,Ao=Ao,Ci1=Ci1,Co=Co,Di1=Di1,Di2=Di2,Do=Do,Ei=Ei,Eo=Eo,ierr=ierr) case(22) computeA = .true. computeB = .true. computeC = .true. computeD = .true. + computeE = .true. result = -777.; resultV = -777. ierrV = oa_error ! all optional missing @@ -105,61 +122,117 @@ program optargs computeB = .true. computeC = .true. computeD = .true. + computeE = .true. result = -777.; resultV = -777. ierrV = oa_error ! some optional missing - call oa_layer1(Ci1=Ci1,Co=Co,ierr=ierr,B=B,Ao=Ao,Di1=Di1) + call oa_layer1(Ci1=Ci1,Co=Co,Eo=Eo,ierr=ierr,B=B,Ao=Ao,Di1=Di1) case(24) computeA = .true. computeB = .true. computeC = .true. computeD = .true. + computeE = .true. result = -777.; resultV = -777. ierrV = oa_error ! one optional missing - call oa_layer1(Ai1=Ai1,Ao=Ao,B=B,Ci1=Ci1,Co=Co,Di1=Di1,Do=Do,ierr=ierr) + call oa_layer1(Ai1=Ai1,Ao=Ao,B=B,Ci1=Ci1,Co=Co,Di1=Di1,Do=Do,Ei=Ei,Eo=Eo,ierr=ierr) + case(25) + computeA = .true. + computeB = .true. + computeC = .true. + computeD = .true. + computeE = .true. + result = -777.; resultV = -777. + ierrV = oa_error + ! Ei missing + call oa_layer1(Ai1=Ai1,Ao=Ao,B=B,Ci1=Ci1,Co=Co,Di1=Di1,Di2=Di2,Do=Do,Eo=Eo,ierr=ierr) - ! test computations individually + ! test computations individually, all args case(31) computeA = .true. ierrV = oa_A Ai1 = 5. resultV = 4. - call oa_layer1(Ai1=Ai1,Ao=Ao,B=B,Ci1=Ci1,Co=Co,Di1=Di1,Di2=Di2,Do=Do,ierr=ierr) + call oa_layer1(Ai1=Ai1,Ao=Ao,B=B,Ci1=Ci1,Co=Co,Di1=Di1,Di2=Di2,Do=Do,Ei=Ei,Eo=Eo,ierr=ierr) result = Ao case(32) computeB = .true. ierrV = oa_B B = 15. resultV = 20. - call oa_layer1(ierr=ierr,Ai1=Ai1,Ao=Ao,B=B,Ci1=Ci1,Co=Co,Di1=Di1,Di2=Di2,Do=Do) + call oa_layer1(ierr=ierr,Ai1=Ai1,Ao=Ao,B=B,Ci1=Ci1,Co=Co,Di1=Di1,Di2=Di2,Do=Do,Ei=Ei,Eo=Eo) result = B case(33) computeC = .true. ierrV = oa_C Ci1 = 7. resultV = 14. - call oa_layer1(B=B,Ci1=Ci1,Co=Co,Di1=Di1,Ai1=Ai1,Ao=Ao,Di2=Di2,Do=Do,ierr=ierr) + call oa_layer1(B=B,Ci1=Ci1,Co=Co,Di1=Di1,Ai1=Ai1,Ao=Ao,Di2=Di2,Do=Do,ierr=ierr,Ei=Ei,Eo=Eo) result = Co case(34) computeD = .true. ierrV = oa_D Di1 = 19; Di2=11. resultV = 30. - call oa_layer1(Ai1=Ai1,Ao=Ao,Ci1=Ci1,Co=Co,Di1=Di1,Di2=Di2,Do=Do,B=B,ierr=ierr) + call oa_layer1(Ai1=Ai1,Ao=Ao,Ci1=Ci1,Co=Co,Di1=Di1,Ei=Ei,Eo=Eo,Di2=Di2,Do=Do,B=B,ierr=ierr) result = Do + case(35) + computeE = .true. + ierrV = oa_E + Ei = 25. + resultV = 81. + call oa_layer1(Ai1=Ai1,Ao=Ao,Ci1=Ci1,Co=Co,Ei=Ei,Eo=Eo,Di1=Di1,Di2=Di2,Do=Do,B=B,ierr=ierr) + result = sum(Eo) - ! test computations individually + ! test computations individually, min args case(41) + computeA = .true. + ierrV = oa_A + Ai1 = 5. + resultV = 4. + call oa_layer1(Ao=Ao,Co=Co,Ai1=Ai1,Ci1=Ci1,ierr=ierr) + result = Ao + case(42) + computeB = .true. + ierrV = oa_B + B = 15. + resultV = 20. + call oa_layer1(ierr=ierr,Ci1=Ci1,Co=Co,B=B) + result = B + case(43) + computeC = .true. + ierrV = oa_C + Ci1 = 7. + resultV = 14. + call oa_layer1(Ci1=Ci1,Co=Co,ierr=ierr) + result = Co + case(44) + computeD = .true. + ierrV = oa_D + Di1 = 19; Di2=11. + resultV = 30. + call oa_layer1(Ci1=Ci1,Di1=Di1,Di2=Di2,Co=Co,Do=Do,ierr=ierr) + result = Do + case(45) + computeE = .true. + ierrV = oa_E + Ei = 25. + resultV = 81. + call oa_layer1(Ci1=Ci1,Co=Co,Ei=Ei,Eo=Eo,ierr=ierr) + result = sum(Eo) + + ! test computations in groups, mix of passed arguments + case(51) computeA = .true. computeC = .true. ierrV = oa_A + oa_C Ai1 = 6. Ci1 = 8. resultV = 21. - call oa_layer1(Ai1=Ai1,Ao=Ao,B=B,Ci1=Ci1,Co=Co,Di1=Di1,Di2=Di2,Do=Do,ierr=ierr) + call oa_layer1(Ai1=Ai1,Ao=Ao,B=B,Ci1=Ci1,Co=Co,Eo=Eo,ierr=ierr) result = Ao + Co - case(42) + case(52) computeB = .true. computeC = .true. ierrV = oa_B + oa_C @@ -168,7 +241,7 @@ program optargs resultV = -11. call oa_layer1(ierr=ierr,Ai1=Ai1,Ao=Ao,B=B,Ci1=Ci1,Co=Co,Di1=Di1,Di2=Di2,Do=Do) result = B + Co - case(43) + case(53) computeB = .true. computeD = .true. ierrV = oa_B + oa_D @@ -177,7 +250,7 @@ program optargs resultV = 31. call oa_layer1(B=B,Ci1=Ci1,Co=Co,Di1=Di1,Ai1=Ai1,Ao=Ao,Di2=Di2,Do=Do,ierr=ierr) result = B + Do - case(44) + case(54) computeC = .true. computeD = .true. ierrV = oa_C + oa_D @@ -186,20 +259,22 @@ program optargs resultV = 27. call oa_layer1(Ai1=Ai1,Ao=Ao,Ci1=Ci1,Co=Co,Di1=Di1,Di2=Di2,Do=Do,B=B,ierr=ierr) result = Co + Do - case(45) + case(55) computeA = .true. computeB = .true. computeC = .true. computeD = .true. - ierrV = oa_A + oa_B + oa_C + oa_D + computeE = .true. + ierrV = oa_A + oa_B + oa_C + oa_D + oa_E Ai1 = 7. B = 9. Ci1 = 7. Di1 = 12; Di2=3. - resultV = 49. - call oa_layer1(Ao=Ao,B=B,Co=Co,Do=Do,Ai1=Ai1,Ci1=Ci1,Di1=Di1,Di2=Di2,ierr=ierr) - result = Ao + B + Co + Do - case(46) + Ei = 5 + resultV = 70. + call oa_layer1(Ao=Ao,B=B,Co=Co,Do=Do,Ai1=Ai1,Ci1=Ci1,Di1=Di1,Di2=Di2,Ei=Ei,Eo=Eo,ierr=ierr) + result = Ao + B + Co + Do + sum(Eo) + case(56) computeA = .true. computeB = .true. computeD = .true. @@ -210,6 +285,15 @@ program optargs resultV = 40. call oa_layer1(Ao=Ao,B=B,Co=Co,Do=Do,Ai1=Ai1,Ci1=Ci1,Di1=Di1,Di2=Di2,ierr=ierr) result = Ao + B + Do + case(57) + computeB = .true. + computeE = .true. + ierrV = oa_B + oa_E + B = 4. + Ei = 8. + resultV = 39. + call oa_layer1(B=B,Ci1=Ci1,Co=Co,Di1=Di1,Ai1=Ai1,Ao=Ao,Di2=Di2,Do=Do,Ei=Ei,Eo=Eo,ierr=ierr) + result = B + sum(Eo) case DEFAULT ierr = -1234 @@ -219,10 +303,10 @@ program optargs ! skip -1234 if (ierr /= -1234) then if (ierr == ierrV .and. abs(result-resultV) < errtol ) then - write(6,101) 'PASS','optarg test',n,ierr,ierrV,result,resultV,Ao,B,Co,Do + write(6,101) 'PASS','optarg test',n,ierr,ierrV,result,resultV,Ao,B,Co,Do,sum(Eo) ! write(6,101) 'PASS','optarg test',n,ierr,ierrV,result,resultV else - write(6,101) 'FAIL','optarg test',n,ierr,ierrV,result,resultV,Ao,B,Co,Do + write(6,101) 'FAIL','optarg test',n,ierr,ierrV,result,resultV,Ao,B,Co,Do,sum(Eo) ! write(6,101) 'FAIL','optarg test',n,ierr,ierrV,result,resultV iresult = 1 endif @@ -230,7 +314,7 @@ program optargs enddo - 101 format(1x,a,1x,a,1x,i2.2,2i6,3x,6g11.4) + 101 format(1x,a,1x,a,1x,i2.2,2i6,3x,8g11.4) write(6,*) ' ' write(6,*) 'optargs COMPLETED SUCCESSFULLY' diff --git a/cicecore/drivers/unittest/optargs/optargs_subs.F90 b/cicecore/drivers/unittest/optargs/optargs_subs.F90 index 7469d6800..4269ed23b 100644 --- a/cicecore/drivers/unittest/optargs/optargs_subs.F90 +++ b/cicecore/drivers/unittest/optargs/optargs_subs.F90 @@ -4,17 +4,21 @@ module optargs_subs implicit none private + integer, public, parameter :: dp = kind(1.d0) + logical, public :: computeA = .false., & computeB = .false., & computeC = .false., & - computeD = .false. + computeD = .false., & + computeE = .false. integer, public :: oa_error = -99, & oa_OK = 0, & oa_A = 1, & oa_B = 2, & oa_C = 4, & - oa_D = 8 + oa_D = 8, & + oa_E = 16 public :: oa_layer1, oa_count1 @@ -22,16 +26,18 @@ module optargs_subs CONTAINS !----------------------------------- - subroutine oa_count1(Ai1,Ao,B,Ci1,Co,Di1,Di2,Do,ierr) + subroutine oa_count1(Ai1,Ao,B,Ci1,Co,Di1,Di2,Do,Ei,Eo,ierr) - real*8 , intent(in) , optional :: Ai1, Di1, Di2 - real*8 , intent(out) , optional :: Ao, Do - real*8 , intent(inout), optional :: B - real*8 , intent(in) :: Ci1 - real*8 , intent(out) :: Co - integer, intent(inout) :: ierr + real(dp), intent(in) , optional :: Ai1, Di1, Di2 + real(dp), intent(out) , optional :: Ao, Do + real(dp), intent(inout), optional :: B + real(dp), intent(in) :: Ci1 + real(dp), intent(out) :: Co + real(dp), intent(in) , optional, dimension(:) :: Ei + real(dp), intent(out) , optional, dimension(:) :: Eo + integer , intent(inout) :: ierr - call oa_count2(Ai1,Ao,B,Ci1,Co,Di1,Di2,Do,ierr) + call oa_count2(Ai1,Ao,B,Ci1,Co,Di1,Di2,Do,Ei,Eo,ierr) ! write(6,*) 'debug oa_count1 ',ierr @@ -39,14 +45,16 @@ end subroutine oa_count1 !----------------------------------- - subroutine oa_count2(Ai1,Ao,B,Ci1,Co,Di1,Di2,Do,ierr) + subroutine oa_count2(Ai1,Ao,B,Ci1,Co,Di1,Di2,Do,Ei,Eo,ierr) - real*8 , intent(in) , optional :: Ai1, Di1, Di2 - real*8 , intent(out) , optional :: Ao, Do - real*8 , intent(inout), optional :: B - real*8 , intent(in) :: Ci1 - real*8 , intent(out) :: Co - integer, intent(inout) :: ierr + real(dp), intent(in) , optional :: Ai1, Di1, Di2 + real(dp), intent(out) , optional :: Ao, Do + real(dp), intent(inout), optional :: B + real(dp), intent(in) :: Ci1 + real(dp), intent(out) :: Co + real(dp), intent(in) , optional, dimension(:) :: Ei + real(dp), intent(out) , optional, dimension(:) :: Eo + integer , intent(inout) :: ierr ierr = 3 ! Ci1, Co, ierr have to be passed if (present(Ai1)) ierr = ierr + 1 @@ -55,6 +63,8 @@ subroutine oa_count2(Ai1,Ao,B,Ci1,Co,Di1,Di2,Do,ierr) if (present(Di1)) ierr = ierr + 1 if (present(Di2)) ierr = ierr + 1 if (present(Do) ) ierr = ierr + 1 + if (present(Ei) ) ierr = ierr + 1 + if (present(Eo) ) ierr = ierr + 1 ! write(6,*) 'debug oa_count2 ',ierr @@ -62,14 +72,16 @@ end subroutine oa_count2 !----------------------------------- - subroutine oa_layer1(Ai1,Ao,B,Ci1,Co,Di1,Di2,Do,ierr) + subroutine oa_layer1(Ai1,Ao,B,Ci1,Co,Di1,Di2,Do,Ei,Eo,ierr) - real*8 , intent(in) , optional :: Ai1, Di1, Di2 - real*8 , intent(out) , optional :: Ao, Do - real*8 , intent(inout), optional :: B - real*8 , intent(in) :: Ci1 - real*8 , intent(out) :: Co - integer, intent(inout) :: ierr + real(dp), intent(in) , optional :: Ai1, Di1, Di2 + real(dp), intent(out) , optional :: Ao, Do + real(dp), intent(inout), optional :: B + real(dp), intent(in) :: Ci1 + real(dp), intent(out) :: Co + real(dp), intent(in) , optional, dimension(:) :: Ei + real(dp), intent(out) , optional, dimension(:) :: Eo + integer , intent(inout) :: ierr ierr = oa_OK if (computeA) then @@ -87,38 +99,55 @@ subroutine oa_layer1(Ai1,Ao,B,Ci1,Co,Di1,Di2,Do,ierr) ierr = oa_error endif endif + if (computeE) then + if (.not.(present(Ei).and.present(Eo))) then + ierr = oa_error + endif + endif if (ierr == oa_OK) then - call oa_layer2(Ai1,Ao,B,Ci1,Co,Di1,Di2,Do,ierr) + call oa_layer2(Ai1,Ao,B,Ci1,Co,Di1,Di2,Do,Ei,Eo,ierr) endif end subroutine oa_layer1 !----------------------------------- - subroutine oa_layer2(Ai1,Ao,B,Ci1,Co,Di1,Di2,Do,ierr) + subroutine oa_layer2(Ai1,Ao,B,Ci1,Co,Di1,Di2,Do,Ei,Eo,ierr) + +! Note: optional arrays must have an optional attribute, otherwise they seg fault +! Scalars do not seem to have this problem - real*8 , intent(in) , optional :: Ai1, Di1, Di2 - real*8 , intent(out) , optional :: Ao, Do - real*8 , intent(inout), optional :: B - real*8 , intent(in) :: Ci1 - real*8 , intent(out) :: Co - integer, intent(inout) :: ierr + real(dp), intent(in) :: Ai1, Di1, Di2 + real(dp), intent(out) :: Ao, Do + real(dp), intent(inout) :: B + real(dp), intent(in) :: Ci1 + real(dp), intent(out) :: Co + real(dp), intent(in) , optional, dimension(:) :: Ei + real(dp), intent(out) , optional, dimension(:) :: Eo + integer , intent(inout) :: ierr - call oa_compute(Ai1,Ao,B,Ci1,Co,Di1,Di2,Do,ierr) + call oa_compute(Ai1,Ao,B,Ci1,Co,Di1,Di2,Do,Ei,Eo,ierr) end subroutine oa_layer2 !----------------------------------- - subroutine oa_compute(Ai1,Ao,B,Ci1,Co,Di1,Di2,Do,ierr) + subroutine oa_compute(Ai1,Ao,B,Ci1,Co,Di1,Di2,Do,Ei,Eo,ierr) - real*8 , intent(in) , optional :: Ai1, Di1, Di2 - real*8 , intent(out) , optional :: Ao, Do - real*8 , intent(inout), optional :: B - real*8 , intent(in) :: Ci1 - real*8 , intent(out) :: Co - integer, intent(inout) :: ierr +! Note: optional arrays must have an optional attribute, otherwise they seg fault +! Scalars do not seem to have this problem + + real(dp), intent(in) :: Ai1, Di1, Di2 + real(dp), intent(out) :: Ao, Do + real(dp), intent(inout) :: B + real(dp), intent(in) :: Ci1 + real(dp), intent(out) :: Co + real(dp), intent(in) , optional, dimension(:) :: Ei + real(dp), intent(out) , optional, dimension(:) :: Eo + integer , intent(inout) :: ierr + + integer :: n if (computeA) then Ao = Ai1 - 1. @@ -140,6 +169,13 @@ subroutine oa_compute(Ai1,Ao,B,Ci1,Co,Di1,Di2,Do,ierr) ierr = ierr + oa_D endif + if (computeE) then + ierr = ierr + oa_E + do n = 1,size(Eo) + Eo(n) = Ei(n) + n + enddo + endif + return end subroutine oa_compute diff --git a/cicecore/drivers/unittest/opticep/CICE.F90 b/cicecore/drivers/unittest/opticep/CICE.F90 new file mode 100644 index 000000000..79dd06fca --- /dev/null +++ b/cicecore/drivers/unittest/opticep/CICE.F90 @@ -0,0 +1,59 @@ +!======================================================================= +! Copyright (c) 2022, Triad National Security, LLC +! All rights reserved. +! +! Copyright 2022. Triad National Security, LLC. This software was +! produced under U.S. Government contract DE-AC52-06NA25396 for Los +! Alamos National Laboratory (LANL), which is operated by Triad +! National Security, LLC for the U.S. Department of Energy. The U.S. +! Government has rights to use, reproduce, and distribute this software. +! NEITHER THE GOVERNMENT NOR TRIAD NATIONAL SECURITY, LLC MAKES ANY +! WARRANTY, EXPRESS OR IMPLIED, OR ASSUMES ANY LIABILITY FOR THE USE OF +! THIS SOFTWARE. If software is modified to produce derivative works, +! such modified software should be clearly marked, so as not to confuse +! it with the version available from LANL. +! +! The full license and distribution policy are available from +! https://github.com/CICE-Consortium +! +!======================================================================= +! +! Main driver routine for CICE. Initializes and steps through the model. +! This program should be compiled if CICE is run as a separate executable, +! but not if CICE subroutines are called from another program (e.g., CAM). +! +! authors Elizabeth C. Hunke and William H. Lipscomb, LANL +! +! 2006: Converted to free form source (F90) by Elizabeth Hunke +! 2008: E. Hunke moved ESMF code to its own driver +! + program icemodel + + use CICE_InitMod + use CICE_RunMod + use CICE_FinalMod + + implicit none + character(len=*), parameter :: subname='(icemodel)' + + !----------------------------------------------------------------- + ! Initialize CICE + !----------------------------------------------------------------- + + call CICE_Initialize + + !----------------------------------------------------------------- + ! Run CICE + !----------------------------------------------------------------- + + call CICE_Run + + !----------------------------------------------------------------- + ! Finalize CICE + !----------------------------------------------------------------- + + call CICE_Finalize + + end program icemodel + +!======================================================================= diff --git a/cicecore/drivers/unittest/opticep/CICE_FinalMod.F90 b/cicecore/drivers/unittest/opticep/CICE_FinalMod.F90 new file mode 100644 index 000000000..02494bd9c --- /dev/null +++ b/cicecore/drivers/unittest/opticep/CICE_FinalMod.F90 @@ -0,0 +1,71 @@ +!======================================================================= +! +! This module contains routines for the final exit of the CICE model, +! including final output and clean exit from any message passing +! environments and frameworks. +! +! authors: Philip W. Jones, LANL +! 2006: Converted to free source form (F90) by Elizabeth Hunke +! 2008: E. Hunke moved ESMF code to its own driver + + module CICE_FinalMod + + use ice_kinds_mod + use ice_communicate, only: my_task, master_task + use ice_exit, only: end_run, abort_ice + use ice_fileunits, only: nu_diag, release_all_fileunits + use icepack_intfc, only: icepack_warnings_flush, icepack_warnings_aborted + + implicit none + private + public :: CICE_Finalize + +!======================================================================= + + contains + +!======================================================================= +! +! This routine shuts down CICE by exiting all relevent environments. + + subroutine CICE_Finalize + + use ice_timers, only: ice_timer_stop, ice_timer_print_all, timer_total, & + timer_stats + + character(len=*), parameter :: subname = '(CICE_Finalize)' + + !------------------------------------------------------------------- + ! stop timers and print timer info + !------------------------------------------------------------------- + + call ice_timer_stop(timer_total) ! stop timing entire run + call ice_timer_print_all(stats=timer_stats) ! print timing information + + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__,line= __LINE__) + + if (my_task == master_task) then + write(nu_diag, *) " " + write(nu_diag, *) "CICE COMPLETED SUCCESSFULLY " + write(nu_diag, *) "OPTICEP TEST COMPLETED SUCCESSFULLY " + write(nu_diag, *) " " + endif + +!echmod if (nu_diag /= 6) close (nu_diag) ! diagnostic output + call release_all_fileunits + + !------------------------------------------------------------------- + ! quit MPI + !------------------------------------------------------------------- + + call end_run ! quit MPI + + end subroutine CICE_Finalize + +!======================================================================= + + end module CICE_FinalMod + +!======================================================================= diff --git a/cicecore/drivers/unittest/opticep/CICE_InitMod.F90 b/cicecore/drivers/unittest/opticep/CICE_InitMod.F90 new file mode 100644 index 000000000..0371c7f38 --- /dev/null +++ b/cicecore/drivers/unittest/opticep/CICE_InitMod.F90 @@ -0,0 +1,517 @@ +!======================================================================= +! +! This module contains the CICE initialization routine that sets model +! parameters and initializes the grid and CICE state variables. +! +! authors Elizabeth C. Hunke, LANL +! William H. Lipscomb, LANL +! Philip W. Jones, LANL +! +! 2006: Converted to free form source (F90) by Elizabeth Hunke +! 2008: E. Hunke moved ESMF code to its own driver + + module CICE_InitMod + + use ice_kinds_mod + use ice_exit, only: abort_ice + use ice_fileunits, only: init_fileunits, nu_diag + use ice_memusage, only: ice_memusage_init, ice_memusage_print + use icepack_intfc, only: icepack_aggregate + use icepack_intfc, only: icepack_init_itd, icepack_init_itd_hist + use icepack_intfc, only: icepack_init_fsd_bounds, icepack_init_wave + use icepack_intfc, only: icepack_init_snow + use icepack_intfc, only: icepack_configure + use icepack_intfc, only: icepack_warnings_flush, icepack_warnings_aborted + use icepack_intfc, only: icepack_query_parameters, icepack_query_tracer_flags, & + icepack_query_tracer_indices, icepack_query_tracer_sizes + + implicit none + private + public :: CICE_Initialize, cice_init + +!======================================================================= + + contains + +!======================================================================= + +! Initialize the basic state, grid and all necessary parameters for +! running the CICE model. Return the initial state in routine +! export state. +! Note: This initialization driver is designed for standalone and +! CESM-coupled applications. For other +! applications (e.g., standalone CAM), this driver would be +! replaced by a different driver that calls subroutine cice_init, +! where most of the work is done. + + subroutine CICE_Initialize + + character(len=*), parameter :: subname='(CICE_Initialize)' + !-------------------------------------------------------------------- + ! model initialization + !-------------------------------------------------------------------- + + call cice_init + + end subroutine CICE_Initialize + +!======================================================================= +! +! Initialize CICE model. + + subroutine cice_init + + use ice_arrays_column, only: hin_max, c_hi_range, alloc_arrays_column + use ice_arrays_column, only: floe_rad_l, floe_rad_c, & + 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, & + init_calendar, advance_timestep, calc_timesteps + use ice_communicate, only: init_communicate, my_task, master_task + use ice_diagnostics, only: init_diags + use ice_domain, only: init_domain_blocks + use ice_domain_size, only: ncat, nfsd + use ice_dyn_eap, only: init_eap + use ice_dyn_evp, only: init_evp + use ice_dyn_vp, only: init_vp + use ice_dyn_shared, only: kdyn + use ice_flux, only: init_coupler_flux, init_history_therm, & + init_history_dyn, init_flux_atm, init_flux_ocn, alloc_flux + use ice_forcing, only: init_forcing_ocn, init_forcing_atmo, & + get_forcing_atmo, get_forcing_ocn, get_wave_spec, init_snowtable + use ice_forcing_bgc, only: get_forcing_bgc, get_atm_bgc, & + faero_default, faero_optics, alloc_forcing_bgc, fiso_default + use ice_grid, only: init_grid1, init_grid2, alloc_grid + use ice_history, only: init_hist, accum_hist + use ice_restart_shared, only: restart, runtype + use ice_init, only: input_data, init_state + use ice_init_column, only: init_thermo_vertical, init_shortwave, init_zbgc, input_zbgc, count_tracers + use ice_kinds_mod + use ice_restoring, only: ice_HaloRestore_init + use ice_timers, only: timer_total, init_ice_timers, ice_timer_start + use ice_transport_driver, only: init_transport + + logical(kind=log_kind) :: tr_aero, tr_zaero, skl_bgc, z_tracers, & + tr_iso, tr_fsd, wave_spec, tr_snow + character(len=char_len) :: snw_aging_table + character(len=*), parameter :: subname = '(cice_init)' + + call init_communicate ! initial setup for message passing + call init_fileunits ! unit numbers + + ! tcx debug, this will create a different logfile for each pe + ! if (my_task /= master_task) nu_diag = 100+my_task + + call icepack_configure() ! initialize icepack + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(trim(subname), & + file=__FILE__,line= __LINE__) + + call input_data ! namelist variables + call input_zbgc ! vertical biogeochemistry namelist + call count_tracers ! count tracers + + ! Call this as early as possible, must be after memory_stats is read + if (my_task == master_task) then + call ice_memusage_init(nu_diag) + call ice_memusage_print(nu_diag,subname//':start') + endif + + call init_domain_blocks ! set up block decomposition + call init_grid1 ! domain distribution + call alloc_grid ! allocate grid arrays + call alloc_arrays_column ! allocate column arrays + call alloc_state ! allocate state arrays + call alloc_flux_bgc ! allocate flux_bgc arrays + call alloc_flux ! allocate flux arrays + call init_ice_timers ! initialize all timers + call ice_timer_start(timer_total) ! start timing entire run + call init_grid2 ! grid variables + call init_zbgc ! vertical biogeochemistry initialization + call init_calendar ! initialize some calendar stuff + call init_hist (dt) ! initialize output history file + + if (kdyn == 1) then + call init_evp + else if (kdyn == 2) then + call init_eap ! define eap dynamics parameters, variables + else if (kdyn == 3) then + call init_vp ! define vp dynamics parameters, variables + endif + + call init_coupler_flux ! initialize fluxes exchanged with coupler + + call init_thermo_vertical ! initialize vertical thermodynamics + + call icepack_init_itd(ncat=ncat, hin_max=hin_max) ! ice thickness distribution + if (my_task == master_task) then + call icepack_init_itd_hist(ncat=ncat, hin_max=hin_max, c_hi_range=c_hi_range) ! output + endif + + call icepack_query_tracer_flags(tr_fsd_out=tr_fsd) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(trim(subname), & + file=__FILE__,line= __LINE__) + + if (tr_fsd) call icepack_init_fsd_bounds (nfsd, & ! floe size distribution + floe_rad_l, & ! fsd size lower bound in m (radius) + floe_rad_c, & ! fsd size bin centre in m (radius) + floe_binwidth, & ! fsd size bin width in m (radius) + c_fsd_range, & ! string for history output + write_diags=(my_task == master_task)) ! write diag on master only + + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + + call init_forcing_ocn(dt) ! initialize sss and sst from data + call init_state ! initialize the ice state + call init_transport ! initialize horizontal transport + call ice_HaloRestore_init ! restored boundary conditions + + call icepack_query_parameters(skl_bgc_out=skl_bgc, z_tracers_out=z_tracers, & + wave_spec_out=wave_spec, snw_aging_table_out=snw_aging_table) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(trim(subname), & + file=__FILE__,line= __LINE__) + + if (skl_bgc .or. z_tracers) call alloc_forcing_bgc ! allocate biogeochemistry arrays + + call init_restart ! initialize restart variables + call init_diags ! initialize diagnostic output points + call init_history_therm ! initialize thermo history variables + call init_history_dyn ! initialize dynamic history variables + call calc_timesteps ! update timestep counter if not using npt_unit="1" + + call icepack_query_tracer_flags(tr_aero_out=tr_aero, tr_zaero_out=tr_zaero) + call icepack_query_tracer_flags(tr_iso_out=tr_iso, tr_snow_out=tr_snow) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(trim(subname), & + file=__FILE__,line= __LINE__) + + if (tr_aero .or. tr_zaero) call faero_optics !initialize aerosol optical + !property tables + + ! Initialize shortwave components using swdn from previous timestep + ! if restarting. These components will be scaled to current forcing + ! in prep_radiation. + if (trim(runtype) == 'continue' .or. restart) & + call init_shortwave ! initialize radiative transfer + + if (write_ic) call accum_hist(dt) ! write initial conditions + +! tcraig, use advance_timestep here +! istep = istep + 1 ! update time step counters +! istep1 = istep1 + 1 +! time = time + dt ! determine the time and date +! call calendar(time) ! at the end of the first timestep + call advance_timestep() + + !-------------------------------------------------------------------- + ! coupler communication or forcing data initialization + !-------------------------------------------------------------------- + + call init_forcing_atmo ! initialize atmospheric forcing (standalone) + + if (tr_fsd .and. wave_spec) call get_wave_spec ! wave spectrum in ice + call get_forcing_atmo ! atmospheric forcing from data + call get_forcing_ocn(dt) ! ocean forcing from data + + ! snow aging lookup table initialization + if (tr_snow) then ! advanced snow physics + call icepack_init_snow() + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + if (snw_aging_table(1:4) /= 'test') then + call init_snowtable() + endif + endif + + ! isotopes + if (tr_iso) call fiso_default ! default values + + ! aerosols + ! if (tr_aero) call faero_data ! data file + ! if (tr_zaero) call fzaero_data ! data file (gx1) + if (tr_aero .or. tr_zaero) call faero_default ! default values + if (skl_bgc .or. z_tracers) call get_forcing_bgc ! biogeochemistry + if (z_tracers) call get_atm_bgc ! biogeochemistry + + if (runtype == 'initial' .and. .not. restart) & + call init_shortwave ! initialize radiative transfer using current swdn + + call init_flux_atm ! initialize atmosphere fluxes sent to coupler + call init_flux_ocn ! initialize ocean fluxes sent to coupler + + if (my_task == master_task) then + call ice_memusage_print(nu_diag,subname//':end') + endif + + end subroutine cice_init + +!======================================================================= + + subroutine init_restart + + use ice_arrays_column, only: dhsn + use ice_blocks, only: nx_block, ny_block + use ice_calendar, only: calendar + use ice_constants, only: c0 + use ice_domain, only: nblocks + use ice_domain_size, only: ncat, n_iso, n_aero, nfsd, nslyr + use ice_dyn_eap, only: read_restart_eap + use ice_dyn_shared, only: kdyn + use ice_grid, only: tmask + use ice_init, only: ice_ic + use ice_init_column, only: init_age, init_FY, init_lvl, init_snowtracers, & + init_meltponds_lvl, init_meltponds_topo, & + init_isotope, init_aerosol, init_hbrine, init_bgc, init_fsd + use ice_restart_column, only: restart_age, read_restart_age, & + restart_FY, read_restart_FY, restart_lvl, read_restart_lvl, & + restart_pond_lvl, read_restart_pond_lvl, & + restart_pond_topo, read_restart_pond_topo, & + restart_snow, read_restart_snow, & + restart_fsd, read_restart_fsd, & + restart_iso, read_restart_iso, & + restart_aero, read_restart_aero, & + restart_hbrine, read_restart_hbrine, & + restart_zsal, restart_bgc + use ice_restart_driver, only: restartfile + use ice_restart_shared, only: runtype, restart + use ice_state ! almost everything + + integer(kind=int_kind) :: & + i, j , & ! horizontal indices + iblk ! block index + logical(kind=log_kind) :: & + tr_iage, tr_FY, tr_lvl, tr_pond_lvl, & + tr_pond_topo, tr_snow, tr_fsd, tr_iso, tr_aero, tr_brine, & + skl_bgc, z_tracers, solve_zsal + integer(kind=int_kind) :: & + ntrcr + integer(kind=int_kind) :: & + nt_alvl, nt_vlvl, nt_apnd, nt_hpnd, nt_ipnd, & + nt_smice, nt_smliq, nt_rhos, nt_rsnw, & + nt_iage, nt_FY, nt_aero, nt_fsd, nt_isosno, nt_isoice + + character(len=*), parameter :: subname = '(init_restart)' + + call icepack_query_tracer_sizes(ntrcr_out=ntrcr) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + + call icepack_query_parameters(skl_bgc_out=skl_bgc, & + z_tracers_out=z_tracers, solve_zsal_out=solve_zsal) + call icepack_query_tracer_flags(tr_iage_out=tr_iage, tr_FY_out=tr_FY, & + tr_lvl_out=tr_lvl, tr_pond_lvl_out=tr_pond_lvl, & + tr_pond_topo_out=tr_pond_topo, tr_aero_out=tr_aero, tr_brine_out=tr_brine, & + tr_snow_out=tr_snow, tr_fsd_out=tr_fsd, tr_iso_out=tr_iso) + call icepack_query_tracer_indices(nt_alvl_out=nt_alvl, nt_vlvl_out=nt_vlvl, & + nt_apnd_out=nt_apnd, nt_hpnd_out=nt_hpnd, nt_ipnd_out=nt_ipnd, & + nt_iage_out=nt_iage, nt_FY_out=nt_FY, nt_aero_out=nt_aero, nt_fsd_out=nt_fsd, & + nt_smice_out=nt_smice, nt_smliq_out=nt_smliq, & + nt_rhos_out=nt_rhos, nt_rsnw_out=nt_rsnw, & + nt_isosno_out=nt_isosno, nt_isoice_out=nt_isoice) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + + if (trim(runtype) == 'continue') then + ! start from core restart file + call restartfile() ! given by pointer in ice_in + call calendar() ! update time parameters + if (kdyn == 2) call read_restart_eap ! EAP + else if (restart) then ! ice_ic = core restart file + call restartfile (ice_ic) ! or 'default' or 'none' + !!! uncomment to create netcdf + ! call restartfile_v4 (ice_ic) ! CICE v4.1 binary restart file + !!! uncomment if EAP restart data exists + ! if (kdyn == 2) call read_restart_eap + endif + + ! tracers + ! ice age tracer + if (tr_iage) then + if (trim(runtype) == 'continue') & + restart_age = .true. + if (restart_age) then + call read_restart_age + else + do iblk = 1, nblocks + call init_age(trcrn(:,:,nt_iage,:,iblk)) + enddo ! iblk + endif + endif + ! first-year area tracer + if (tr_FY) then + if (trim(runtype) == 'continue') restart_FY = .true. + if (restart_FY) then + call read_restart_FY + else + do iblk = 1, nblocks + call init_FY(trcrn(:,:,nt_FY,:,iblk)) + enddo ! iblk + endif + endif + ! level ice tracer + if (tr_lvl) then + if (trim(runtype) == 'continue') restart_lvl = .true. + if (restart_lvl) then + call read_restart_lvl + else + do iblk = 1, nblocks + call init_lvl(iblk,trcrn(:,:,nt_alvl,:,iblk), & + trcrn(:,:,nt_vlvl,:,iblk)) + enddo ! iblk + endif + endif + ! level-ice melt ponds + if (tr_pond_lvl) then + if (trim(runtype) == 'continue') & + restart_pond_lvl = .true. + if (restart_pond_lvl) then + call read_restart_pond_lvl + else + do iblk = 1, nblocks + call init_meltponds_lvl(trcrn(:,:,nt_apnd,:,iblk), & + trcrn(:,:,nt_hpnd,:,iblk), & + trcrn(:,:,nt_ipnd,:,iblk), & + dhsn(:,:,:,iblk)) + enddo ! iblk + endif + endif + ! topographic melt ponds + if (tr_pond_topo) then + if (trim(runtype) == 'continue') & + restart_pond_topo = .true. + if (restart_pond_topo) then + call read_restart_pond_topo + else + do iblk = 1, nblocks + call init_meltponds_topo(trcrn(:,:,nt_apnd,:,iblk), & + trcrn(:,:,nt_hpnd,:,iblk), & + trcrn(:,:,nt_ipnd,:,iblk)) + enddo ! iblk + endif ! .not. restart_pond + endif + + ! snow redistribution/metamorphism + if (tr_snow) then + if (trim(runtype) == 'continue') restart_snow = .true. + if (restart_snow) then + call read_restart_snow + else + do iblk = 1, nblocks + call init_snowtracers(trcrn(:,:,nt_smice:nt_smice+nslyr-1,:,iblk), & + trcrn(:,:,nt_smliq:nt_smliq+nslyr-1,:,iblk), & + trcrn(:,:,nt_rhos :nt_rhos +nslyr-1,:,iblk), & + trcrn(:,:,nt_rsnw :nt_rsnw +nslyr-1,:,iblk)) + enddo ! iblk + endif + endif + + ! floe size distribution + if (tr_fsd) then + if (trim(runtype) == 'continue') restart_fsd = .true. + if (restart_fsd) then + call read_restart_fsd + else + call init_fsd(trcrn(:,:,nt_fsd:nt_fsd+nfsd-1,:,:)) + endif + endif + + ! isotopes + if (tr_iso) then + if (trim(runtype) == 'continue') restart_iso = .true. + if (restart_iso) then + call read_restart_iso + else + do iblk = 1, nblocks + call init_isotope(trcrn(:,:,nt_isosno:nt_isosno+n_iso-1,:,iblk), & + trcrn(:,:,nt_isoice:nt_isoice+n_iso-1,:,iblk)) + enddo ! iblk + endif + endif + + if (tr_aero) then ! ice aerosol + if (trim(runtype) == 'continue') restart_aero = .true. + if (restart_aero) then + call read_restart_aero + else + do iblk = 1, nblocks + call init_aerosol(trcrn(:,:,nt_aero:nt_aero+4*n_aero-1,:,iblk)) + enddo ! iblk + endif ! .not. restart_aero + endif + + if (trim(runtype) == 'continue') then + if (tr_brine) & + restart_hbrine = .true. + if (solve_zsal) & + restart_zsal = .true. + if (skl_bgc .or. z_tracers) & + restart_bgc = .true. + endif + + if (tr_brine .or. skl_bgc) then ! brine height tracer + call init_hbrine + if (tr_brine .and. restart_hbrine) call read_restart_hbrine + endif + + if (solve_zsal .or. skl_bgc .or. z_tracers) then ! biogeochemistry + if (tr_fsd) then + write (nu_diag,*) 'FSD implementation incomplete for use with BGC' + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + endif + call init_bgc + endif + + !----------------------------------------------------------------- + ! aggregate tracers + !----------------------------------------------------------------- + + !$OMP PARALLEL DO PRIVATE(iblk) + do iblk = 1, nblocks + do j = 1, ny_block + do i = 1, nx_block + if (tmask(i,j,iblk)) then + call icepack_aggregate(ncat = ncat, & + aicen = aicen(i,j,:,iblk), & + trcrn = trcrn(i,j,:,:,iblk), & + vicen = vicen(i,j,:,iblk), & + vsnon = vsnon(i,j,:,iblk), & + aice = aice (i,j, iblk), & + trcr = trcr (i,j,:,iblk), & + vice = vice (i,j, iblk), & + vsno = vsno (i,j, iblk), & + aice0 = aice0(i,j, iblk), & + ntrcr = ntrcr, & + trcr_depend = trcr_depend, & + trcr_base = trcr_base, & + n_trcr_strata = n_trcr_strata, & + nt_strata = nt_strata) + else + ! tcraig, reset all tracer values on land to zero + trcrn(i,j,:,:,iblk) = c0 + endif + enddo + enddo + enddo + !$OMP END PARALLEL DO + + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + + end subroutine init_restart + +!======================================================================= + + end module CICE_InitMod + +!======================================================================= diff --git a/cicecore/drivers/unittest/opticep/CICE_RunMod.F90 b/cicecore/drivers/unittest/opticep/CICE_RunMod.F90 new file mode 100644 index 000000000..ae7f7ab1f --- /dev/null +++ b/cicecore/drivers/unittest/opticep/CICE_RunMod.F90 @@ -0,0 +1,741 @@ +!======================================================================= +! +! Main driver for time stepping of CICE. +! +! authors Elizabeth C. Hunke, LANL +! Philip W. Jones, LANL +! William H. Lipscomb, LANL +! +! 2006 ECH: moved exit timeLoop to prevent execution of unnecessary timestep +! 2006 ECH: Streamlined for efficiency +! 2006 ECH: Converted to free source form (F90) +! 2007 BPB: Modified Delta-Eddington shortwave interface +! 2008 ECH: moved ESMF code to its own driver + + module CICE_RunMod + + use ice_kinds_mod + use ice_communicate, only: my_task, master_task + use ice_fileunits, only: nu_diag + use ice_arrays_column, only: oceanmixed_ice + use ice_constants, only: c0, c1 + use ice_constants, only: field_loc_center, field_type_scalar + use ice_exit, only: abort_ice + use ice_memusage, only: ice_memusage_print + use icepack_intfc, only: icepack_warnings_flush, icepack_warnings_aborted + use icepack_intfc, only: icepack_max_iso, icepack_max_aero + use icepack_intfc, only: icepack_query_parameters + use icepack_intfc, only: icepack_query_tracer_flags, icepack_query_tracer_sizes + + implicit none + private + public :: CICE_Run, ice_step + +!======================================================================= + + contains + +!======================================================================= +! +! This is the main driver routine for advancing CICE forward in time. +! +! author Elizabeth C. Hunke, LANL +! Philip W. Jones, LANL +! William H. Lipscomb, LANL + + subroutine CICE_Run + + use ice_calendar, only: dt, stop_now, advance_timestep + use ice_forcing, only: get_forcing_atmo, get_forcing_ocn, & + get_wave_spec + use ice_forcing_bgc, only: get_forcing_bgc, get_atm_bgc, & + fiso_default, faero_default + use ice_flux, only: init_flux_atm, init_flux_ocn + use ice_timers, only: ice_timer_start, ice_timer_stop, & + timer_couple, timer_step + logical (kind=log_kind) :: & + tr_iso, tr_aero, tr_zaero, skl_bgc, z_tracers, wave_spec, tr_fsd + character(len=*), parameter :: subname = '(CICE_Run)' + + !-------------------------------------------------------------------- + ! initialize error code and step timer + !-------------------------------------------------------------------- + + call ice_timer_start(timer_step) ! start timing entire run + + call icepack_query_parameters(skl_bgc_out=skl_bgc, & + z_tracers_out=z_tracers, & + wave_spec_out=wave_spec) + call icepack_query_tracer_flags(tr_iso_out=tr_iso, & + tr_aero_out=tr_aero, & + tr_zaero_out=tr_zaero, & + tr_fsd_out=tr_fsd) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + +#ifndef CICE_IN_NEMO + !-------------------------------------------------------------------- + ! timestep loop + !-------------------------------------------------------------------- + + timeLoop: do +#endif + + call ice_step + +! tcraig, use advance_timestep now +! istep = istep + 1 ! update time step counters +! istep1 = istep1 + 1 +! time = time + dt ! determine the time and date +! call calendar(time) ! at the end of the timestep + call advance_timestep() ! advance time + +#ifndef CICE_IN_NEMO + if (stop_now >= 1) exit timeLoop +#endif + + call ice_timer_start(timer_couple) ! atm/ocn coupling + +! for now, wave_spectrum is constant in time +! if (tr_fsd .and. wave_spec) call get_wave_spec ! wave spectrum in ice + call get_forcing_atmo ! atmospheric forcing from data + call get_forcing_ocn(dt) ! ocean forcing from data + + ! isotopes + if (tr_iso) call fiso_default ! default values + ! aerosols + ! if (tr_aero) call faero_data ! data file + ! if (tr_zaero) call fzaero_data ! data file (gx1) + if (tr_aero .or. tr_zaero) call faero_default ! default values + + if (skl_bgc .or. z_tracers) call get_forcing_bgc ! biogeochemistry + if (z_tracers) call get_atm_bgc ! biogeochemistry + + call init_flux_atm ! Initialize atmosphere fluxes sent to coupler + call init_flux_ocn ! initialize ocean fluxes sent to coupler + + call ice_timer_stop(timer_couple) ! atm/ocn coupling + +#ifndef CICE_IN_NEMO + enddo timeLoop +#endif + + !-------------------------------------------------------------------- + ! end of timestep loop + !-------------------------------------------------------------------- + + call ice_timer_stop(timer_step) ! end timestepping loop timer + + end subroutine CICE_Run + +!======================================================================= +! +! Calls drivers for physics components, some initialization, and output +! +! author Elizabeth C. Hunke, LANL +! William H. Lipscomb, LANL + + subroutine ice_step + + use ice_boundary, only: ice_HaloUpdate + use ice_calendar, only: dt, dt_dyn, ndtd, diagfreq, write_restart, istep + use ice_diagnostics, only: init_mass_diags, runtime_diags, debug_model, debug_ice + use ice_diagnostics_bgc, only: hbrine_diags, zsal_diags, bgc_diags + use ice_domain, only: halo_info, nblocks + use ice_dyn_eap, only: write_restart_eap + use ice_dyn_shared, only: kdyn, kridge + use ice_flux, only: scale_factor, init_history_therm, & + daidtt, daidtd, dvidtt, dvidtd, dagedtt, dagedtd + use ice_history, only: accum_hist + use ice_history_bgc, only: init_history_bgc + use ice_restart, only: final_restart + use ice_restart_column, only: write_restart_age, write_restart_FY, & + write_restart_lvl, write_restart_pond_lvl, & + write_restart_pond_topo, write_restart_aero, write_restart_fsd, & + write_restart_iso, write_restart_bgc, write_restart_hbrine, & + write_restart_snow + use ice_restart_driver, only: dumpfile + use ice_restoring, only: restore_ice, ice_HaloRestore + use ice_step_mod, only: prep_radiation, step_therm1, step_therm2, & + update_state, step_dyn_horiz, step_dyn_ridge, step_radiation, & + biogeochemistry, step_prep, step_dyn_wave, step_snow + use ice_timers, only: ice_timer_start, ice_timer_stop, & + timer_diags, timer_column, timer_thermo, timer_bound, & + timer_hist, timer_readwrite + + integer (kind=int_kind) :: & + iblk , & ! block index + k , & ! dynamics supercycling index + ktherm ! thermodynamics is off when ktherm = -1 + + real (kind=dbl_kind) :: & + offset ! d(age)/dt time offset + + logical (kind=log_kind) :: & + tr_iage, tr_FY, tr_lvl, tr_fsd, tr_snow, & + tr_pond_lvl, tr_pond_topo, tr_brine, tr_iso, tr_aero, & + calc_Tsfc, skl_bgc, solve_zsal, z_tracers, wave_spec + + character(len=*), parameter :: subname = '(ice_step)' + + character (len=char_len) :: plabeld + + if (debug_model) then + plabeld = 'beginning time step' + do iblk = 1, nblocks + call debug_ice (iblk, plabeld) + enddo + endif + + call icepack_query_parameters(calc_Tsfc_out=calc_Tsfc, skl_bgc_out=skl_bgc, & + solve_zsal_out=solve_zsal, z_tracers_out=z_tracers, ktherm_out=ktherm, & + wave_spec_out=wave_spec) + call icepack_query_tracer_flags(tr_iage_out=tr_iage, tr_FY_out=tr_FY, & + tr_lvl_out=tr_lvl, tr_pond_lvl_out=tr_pond_lvl, & + tr_pond_topo_out=tr_pond_topo, tr_brine_out=tr_brine, tr_aero_out=tr_aero, & + tr_iso_out=tr_iso, tr_fsd_out=tr_fsd, tr_snow_out=tr_snow) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + + !----------------------------------------------------------------- + ! restoring on grid boundaries + !----------------------------------------------------------------- + + if (restore_ice) call ice_HaloRestore + + !----------------------------------------------------------------- + ! initialize diagnostics and save initial state values + !----------------------------------------------------------------- + + call ice_timer_start(timer_diags) ! diagnostics/history + call init_mass_diags ! diagnostics per timestep + call init_history_therm + call init_history_bgc + call ice_timer_stop(timer_diags) ! diagnostics/history + + call ice_timer_start(timer_column) ! column physics + call ice_timer_start(timer_thermo) ! thermodynamics + + call step_prep + + if (ktherm >= 0) then + !$OMP PARALLEL DO PRIVATE(iblk) SCHEDULE(runtime) + do iblk = 1, nblocks + + !----------------------------------------------------------------- + ! scale radiation fields + !----------------------------------------------------------------- + + if (calc_Tsfc) call prep_radiation (iblk) + + if (debug_model) then + plabeld = 'post prep_radiation' + call debug_ice (iblk, plabeld) + endif + + !----------------------------------------------------------------- + ! thermodynamics and biogeochemistry + !----------------------------------------------------------------- + + call step_therm1 (dt, iblk) ! vertical thermodynamics + + if (debug_model) then + plabeld = 'post step_therm1' + call debug_ice (iblk, plabeld) + endif + + call biogeochemistry (dt, iblk) ! biogeochemistry + + if (debug_model) then + plabeld = 'post biogeochemistry' + call debug_ice (iblk, plabeld) + endif + + call step_therm2 (dt, iblk) ! ice thickness distribution thermo + + if (debug_model) then + plabeld = 'post step_therm2' + call debug_ice (iblk, plabeld) + endif + + enddo + !$OMP END PARALLEL DO + endif ! ktherm > 0 + + ! clean up, update tendency diagnostics + offset = dt + call update_state (dt, daidtt, dvidtt, dagedtt, offset) + + call ice_timer_stop(timer_thermo) ! thermodynamics + call ice_timer_stop(timer_column) ! column physics + + !----------------------------------------------------------------- + ! dynamics, transport, ridging + !----------------------------------------------------------------- + + ! wave fracture of the floe size distribution + ! note this is called outside of the dynamics subcycling loop + if (tr_fsd .and. wave_spec) call step_dyn_wave(dt) + + do k = 1, ndtd + + ! momentum, stress, transport + call step_dyn_horiz (dt_dyn) + + if (debug_model) then + plabeld = 'post step_dyn_horiz' + do iblk = 1, nblocks + call debug_ice (iblk, plabeld) + enddo ! iblk + endif + + ! ridging + !$OMP PARALLEL DO PRIVATE(iblk) SCHEDULE(runtime) + do iblk = 1, nblocks + if (kridge > 0) call step_dyn_ridge (dt_dyn, ndtd, iblk) + enddo + !$OMP END PARALLEL DO + + if (debug_model) then + plabeld = 'post step_dyn_ridge' + do iblk = 1, nblocks + call debug_ice (iblk, plabeld) + enddo ! iblk + endif + + ! clean up, update tendency diagnostics + offset = c0 + call update_state (dt_dyn, daidtd, dvidtd, dagedtd, offset) + + enddo + + if (debug_model) then + plabeld = 'post dynamics' + do iblk = 1, nblocks + call debug_ice (iblk, plabeld) + enddo + endif + + call ice_timer_start(timer_column) ! column physics + call ice_timer_start(timer_thermo) ! thermodynamics + + !----------------------------------------------------------------- + ! snow redistribution and metamorphosis + !----------------------------------------------------------------- + + if (tr_snow) then ! advanced snow physics + !$OMP PARALLEL DO PRIVATE(iblk) SCHEDULE(runtime) + do iblk = 1, nblocks + call step_snow (dt, iblk) + enddo + !$OMP END PARALLEL DO + call update_state (dt) ! clean up + endif + + !$OMP PARALLEL DO PRIVATE(iblk) SCHEDULE(runtime) + do iblk = 1, nblocks + + !----------------------------------------------------------------- + ! albedo, shortwave radiation + !----------------------------------------------------------------- + + if (ktherm >= 0) call step_radiation (dt, iblk) + + if (debug_model) then + plabeld = 'post step_radiation' + call debug_ice (iblk, plabeld) + endif + + !----------------------------------------------------------------- + ! get ready for coupling and the next time step + !----------------------------------------------------------------- + + call coupling_prep (iblk) + + if (debug_model) then + plabeld = 'post coupling_prep' + call debug_ice (iblk, plabeld) + endif + + enddo ! iblk + !$OMP END PARALLEL DO + + call ice_timer_start(timer_bound) + call ice_HaloUpdate (scale_factor, halo_info, & + field_loc_center, field_type_scalar) + call ice_timer_stop(timer_bound) + + call ice_timer_stop(timer_thermo) ! thermodynamics + call ice_timer_stop(timer_column) ! column physics + + !----------------------------------------------------------------- + ! write data + !----------------------------------------------------------------- + + call ice_timer_start(timer_diags) ! diagnostics + if (mod(istep,diagfreq) == 0) then + call runtime_diags(dt) ! log file + if (solve_zsal) call zsal_diags + if (skl_bgc .or. z_tracers) call bgc_diags + if (tr_brine) call hbrine_diags + if (my_task == master_task) then + call ice_memusage_print(nu_diag,subname) + endif + endif + call ice_timer_stop(timer_diags) ! diagnostics + + call ice_timer_start(timer_hist) ! history + call accum_hist (dt) ! history file + call ice_timer_stop(timer_hist) ! history + + call ice_timer_start(timer_readwrite) ! reading/writing + if (write_restart == 1) then + call dumpfile ! core variables for restarting + if (tr_iage) call write_restart_age + if (tr_FY) call write_restart_FY + if (tr_lvl) call write_restart_lvl + if (tr_pond_lvl) call write_restart_pond_lvl + if (tr_pond_topo) call write_restart_pond_topo + if (tr_snow) call write_restart_snow + if (tr_fsd) call write_restart_fsd + if (tr_iso) call write_restart_iso + if (tr_aero) call write_restart_aero + if (solve_zsal .or. skl_bgc .or. z_tracers) & + call write_restart_bgc + if (tr_brine) call write_restart_hbrine + if (kdyn == 2) call write_restart_eap + call final_restart + endif + call ice_timer_stop(timer_readwrite) ! reading/writing + + end subroutine ice_step + +!======================================================================= +! +! Prepare for coupling +! +! authors: Elizabeth C. Hunke, LANL + + subroutine coupling_prep (iblk) + + use ice_arrays_column, only: alvdfn, alidfn, alvdrn, alidrn, & + albicen, albsnon, albpndn, apeffn, fzsal_g, fzsal, snowfracn + use ice_blocks, only: nx_block, ny_block, get_block, block + use ice_domain, only: blocks_ice + use ice_calendar, only: dt, nstreams + use ice_domain_size, only: ncat + use ice_flux, only: alvdf, alidf, alvdr, alidr, albice, albsno, & + albpnd, albcnt, apeff_ai, fpond, fresh, l_mpond_fresh, & + alvdf_ai, alidf_ai, alvdr_ai, alidr_ai, fhocn_ai, & + fresh_ai, fsalt_ai, fsalt, & + fswthru_ai, fhocn, scale_factor, snowfrac, & + fswthru, fswthru_vdr, fswthru_vdf, fswthru_idr, fswthru_idf, & + swvdr, swidr, swvdf, swidf, Tf, Tair, Qa, strairxT, strairyT, & + fsens, flat, fswabs, flwout, evap, Tref, Qref, & + scale_fluxes, frzmlt_init, frzmlt + use ice_flux_bgc, only: faero_ocn, fiso_ocn, Qref_iso, fiso_evap, & + fzsal_ai, fzsal_g_ai, flux_bio, flux_bio_ai + use ice_grid, only: tmask + use ice_state, only: aicen, aice +#ifdef CICE_IN_NEMO + use ice_state, only: aice_init + use ice_flux, only: flatn_f, fsurfn_f +#endif + use ice_step_mod, only: ocean_mixed_layer + use ice_timers, only: timer_couple, ice_timer_start, ice_timer_stop + + integer (kind=int_kind), intent(in) :: & + iblk ! block index + + ! local variables + + integer (kind=int_kind) :: & + ilo,ihi,jlo,jhi, & ! beginning and end of physical domain + n , & ! thickness category index + i,j , & ! horizontal indices + k , & ! tracer index + nbtrcr ! + + type (block) :: & + this_block ! block information for current block + + logical (kind=log_kind) :: & + calc_Tsfc ! + + real (kind=dbl_kind) :: & + cszn , & ! counter for history averaging + puny , & ! + rhofresh , & ! + netsw ! flag for shortwave radiation presence + + character(len=*), parameter :: subname = '(coupling_prep)' + + call icepack_query_parameters(puny_out=puny, rhofresh_out=rhofresh) + call icepack_query_tracer_sizes(nbtrcr_out=nbtrcr) + call icepack_query_parameters(calc_Tsfc_out=calc_Tsfc) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + + !----------------------------------------------------------------- + ! Save current value of frzmlt for diagnostics. + ! Update mixed layer with heat and radiation from ice. + !----------------------------------------------------------------- + + do j = 1, ny_block + do i = 1, nx_block + frzmlt_init (i,j,iblk) = frzmlt(i,j,iblk) + enddo + enddo + + call ice_timer_start(timer_couple,iblk) ! atm/ocn coupling + + if (oceanmixed_ice) & + call ocean_mixed_layer (dt,iblk) ! ocean surface fluxes and sst + + !----------------------------------------------------------------- + ! Aggregate albedos + !----------------------------------------------------------------- + + do j = 1, ny_block + do i = 1, nx_block + alvdf(i,j,iblk) = c0 + alidf(i,j,iblk) = c0 + alvdr(i,j,iblk) = c0 + alidr(i,j,iblk) = c0 + + albice(i,j,iblk) = c0 + albsno(i,j,iblk) = c0 + albpnd(i,j,iblk) = c0 + apeff_ai(i,j,iblk) = c0 + snowfrac(i,j,iblk) = c0 + + ! for history averaging + cszn = c0 + netsw = swvdr(i,j,iblk)+swidr(i,j,iblk)+swvdf(i,j,iblk)+swidf(i,j,iblk) + if (netsw > puny) cszn = c1 + do n = 1, nstreams + albcnt(i,j,iblk,n) = albcnt(i,j,iblk,n) + cszn + enddo + enddo + enddo + + 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 n = 1, ncat + do j = jlo, jhi + do i = ilo, ihi + if (aicen(i,j,n,iblk) > puny) then + + alvdf(i,j,iblk) = alvdf(i,j,iblk) & + + alvdfn(i,j,n,iblk)*aicen(i,j,n,iblk) + alidf(i,j,iblk) = alidf(i,j,iblk) & + + alidfn(i,j,n,iblk)*aicen(i,j,n,iblk) + alvdr(i,j,iblk) = alvdr(i,j,iblk) & + + alvdrn(i,j,n,iblk)*aicen(i,j,n,iblk) + alidr(i,j,iblk) = alidr(i,j,iblk) & + + alidrn(i,j,n,iblk)*aicen(i,j,n,iblk) + + netsw = swvdr(i,j,iblk) + swidr(i,j,iblk) & + + swvdf(i,j,iblk) + swidf(i,j,iblk) + if (netsw > puny) then ! sun above horizon + albice(i,j,iblk) = albice(i,j,iblk) & + + albicen(i,j,n,iblk)*aicen(i,j,n,iblk) + albsno(i,j,iblk) = albsno(i,j,iblk) & + + albsnon(i,j,n,iblk)*aicen(i,j,n,iblk) + albpnd(i,j,iblk) = albpnd(i,j,iblk) & + + albpndn(i,j,n,iblk)*aicen(i,j,n,iblk) + endif + + apeff_ai(i,j,iblk) = apeff_ai(i,j,iblk) & ! for history + + apeffn(i,j,n,iblk)*aicen(i,j,n,iblk) + snowfrac(i,j,iblk) = snowfrac(i,j,iblk) & ! for history + + snowfracn(i,j,n,iblk)*aicen(i,j,n,iblk) + + endif ! aicen > puny + enddo + enddo + enddo + + do j = 1, ny_block + do i = 1, nx_block + + !----------------------------------------------------------------- + ! reduce fresh by fpond for coupling + !----------------------------------------------------------------- + + if (l_mpond_fresh) then + fpond(i,j,iblk) = fpond(i,j,iblk) * rhofresh/dt + fresh(i,j,iblk) = fresh(i,j,iblk) - fpond(i,j,iblk) + endif + + !---------------------------------------------------------------- + ! Store grid box mean albedos and fluxes before scaling by aice + !---------------------------------------------------------------- + + alvdf_ai (i,j,iblk) = alvdf (i,j,iblk) + alidf_ai (i,j,iblk) = alidf (i,j,iblk) + alvdr_ai (i,j,iblk) = alvdr (i,j,iblk) + alidr_ai (i,j,iblk) = alidr (i,j,iblk) + fresh_ai (i,j,iblk) = fresh (i,j,iblk) + fsalt_ai (i,j,iblk) = fsalt (i,j,iblk) + fhocn_ai (i,j,iblk) = fhocn (i,j,iblk) + fswthru_ai(i,j,iblk) = fswthru(i,j,iblk) + fzsal_ai (i,j,iblk) = fzsal (i,j,iblk) + fzsal_g_ai(i,j,iblk) = fzsal_g(i,j,iblk) + + if (nbtrcr > 0) then + do k = 1, nbtrcr + flux_bio_ai (i,j,k,iblk) = flux_bio (i,j,k,iblk) + enddo + endif + + !----------------------------------------------------------------- + ! Save net shortwave for scaling factor in scale_factor + !----------------------------------------------------------------- + scale_factor(i,j,iblk) = & + swvdr(i,j,iblk)*(c1 - alvdr_ai(i,j,iblk)) & + + swvdf(i,j,iblk)*(c1 - alvdf_ai(i,j,iblk)) & + + swidr(i,j,iblk)*(c1 - alidr_ai(i,j,iblk)) & + + swidf(i,j,iblk)*(c1 - alidf_ai(i,j,iblk)) + + enddo + enddo + + !----------------------------------------------------------------- + ! Divide fluxes by ice area + ! - the CESM coupler assumes fluxes are per unit ice area + ! - also needed for global budget in diagnostics + !----------------------------------------------------------------- + + call scale_fluxes (nx_block, ny_block, & + tmask (:,:,iblk), nbtrcr, & + icepack_max_aero, & + aice (:,:,iblk), Tf (:,:,iblk), & + Tair (:,:,iblk), Qa (:,:,iblk), & + strairxT (:,:,iblk), strairyT(:,:,iblk), & + fsens (:,:,iblk), flat (:,:,iblk), & + fswabs (:,:,iblk), flwout (:,:,iblk), & + evap (:,:,iblk), & + Tref (:,:,iblk), Qref (:,:,iblk), & + fresh (:,:,iblk), fsalt (:,:,iblk), & + fhocn (:,:,iblk), & + fswthru (:,:,iblk), & + fswthru_vdr (:,:,iblk), & + fswthru_vdf (:,:,iblk), & + fswthru_idr (:,:,iblk), & + fswthru_idf (:,:,iblk), & + faero_ocn(:,:,:,iblk), & + alvdr (:,:,iblk), alidr (:,:,iblk), & + alvdf (:,:,iblk), alidf (:,:,iblk), & + fzsal (:,:,iblk), fzsal_g (:,:,iblk), & + flux_bio (:,:,1:nbtrcr,iblk), & + Qref_iso =Qref_iso (:,:,:,iblk), & + fiso_evap=fiso_evap(:,:,:,iblk), & + fiso_ocn =fiso_ocn (:,:,:,iblk)) + +#ifdef CICE_IN_NEMO +!echmod - comment this out for efficiency, if .not. calc_Tsfc + if (.not. calc_Tsfc) then + + !--------------------------------------------------------------- + ! If surface fluxes were provided, conserve these fluxes at ice + ! free points by passing to ocean. + !--------------------------------------------------------------- + + call sfcflux_to_ocn & + (nx_block, ny_block, & + tmask (:,:,iblk), aice_init(:,:,iblk), & + fsurfn_f (:,:,:,iblk), flatn_f(:,:,:,iblk), & + fresh (:,:,iblk), fhocn (:,:,iblk)) + endif +!echmod +#endif + call ice_timer_stop(timer_couple,iblk) ! atm/ocn coupling + + end subroutine coupling_prep + +#ifdef CICE_IN_NEMO + +!======================================================================= +! +! If surface heat fluxes are provided to CICE instead of CICE calculating +! them internally (i.e. .not. calc_Tsfc), then these heat fluxes can +! be provided at points which do not have ice. (This is could be due to +! the heat fluxes being calculated on a lower resolution grid or the +! heat fluxes not recalculated at every CICE timestep.) At ice free points, +! conserve energy and water by passing these fluxes to the ocean. +! +! author: A. McLaren, Met Office + + subroutine sfcflux_to_ocn(nx_block, ny_block, & + tmask, aice, & + fsurfn_f, flatn_f, & + fresh, fhocn) + + use ice_domain_size, only: ncat + + integer (kind=int_kind), intent(in) :: & + nx_block, ny_block ! block dimensions + + logical (kind=log_kind), dimension (nx_block,ny_block), intent(in) :: & + tmask ! land/boundary mask, thickness (T-cell) + + real (kind=dbl_kind), dimension(nx_block,ny_block), intent(in):: & + aice ! initial ice concentration + + real (kind=dbl_kind), dimension(nx_block,ny_block,ncat), intent(in) :: & + fsurfn_f, & ! net surface heat flux (provided as forcing) + flatn_f ! latent heat flux (provided as forcing) + + real (kind=dbl_kind), dimension(nx_block,ny_block), intent(inout):: & + fresh , & ! fresh water flux to ocean (kg/m2/s) + fhocn ! actual ocn/ice heat flx (W/m**2) + + + ! local variables + integer (kind=int_kind) :: & + i, j, n ! horizontal indices + + real (kind=dbl_kind) :: & + puny, & ! + Lsub, & ! + rLsub ! 1/Lsub + + character(len=*), parameter :: subname = '(sfcflux_to_ocn)' + + call icepack_query_parameters(puny_out=puny, Lsub_out=Lsub) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + rLsub = c1 / Lsub + + do n = 1, ncat + do j = 1, ny_block + do i = 1, nx_block + if (tmask(i,j) .and. aice(i,j) <= puny) then + fhocn(i,j) = fhocn(i,j) & + + fsurfn_f(i,j,n) + flatn_f(i,j,n) + fresh(i,j) = fresh(i,j) & + + flatn_f(i,j,n) * rLsub + endif + enddo ! i + enddo ! j + enddo ! n + + + end subroutine sfcflux_to_ocn + +#endif + +!======================================================================= + + end module CICE_RunMod + +!======================================================================= diff --git a/cicecore/drivers/unittest/opticep/README b/cicecore/drivers/unittest/opticep/README new file mode 100644 index 000000000..b5f1bdf9c --- /dev/null +++ b/cicecore/drivers/unittest/opticep/README @@ -0,0 +1,30 @@ + +This unittest tests Icepack optional arguments. The idea is to have source code that is +identical to the standard CICE source code except the significant optional arguments passed +into Icepack are removed from the CICE calls. Then to run a standard CICE case with optional +features (fsd, bgc, isotopes, etc) off in namelist. That results should be bit-for-bit identical +with an equivalent run from the standard source code. + +This unittest will need to be maintained manually. As CICE code changes, the modified files +in the unittest also need to be update manually. Again, it should be as easy as copying the +standard files into this directory and then commenting out the optional arguments. + +NOTES: + +All files from cicecore/drivers/standalone/cice need to be copied to this directory. As of +today, that includes + CICE.F90 + CICE_FinalMod.F90 + CICE_InitMod.F90 + CICE_RunMod.F90 + +Add + write(nu_diag, *) "OPTICEP TEST COMPLETED SUCCESSFULLY " +to CICE_FinalMod.F90 + +Do not worry about the parameter/tracer query/init/write methods + +Interfaces to modify include + ice_init_column.F90 (icepack_step_radiation, icepack_init_zbgc) + ice_step_mod.F90 (icepack_step_therm1, icepack_step_therm2, icepack_prep_radiation, + icepack_step_radiation, icepack_step_ridge) diff --git a/cicecore/drivers/unittest/opticep/ice_init_column.F90 b/cicecore/drivers/unittest/opticep/ice_init_column.F90 new file mode 100644 index 000000000..82f3f4a1e --- /dev/null +++ b/cicecore/drivers/unittest/opticep/ice_init_column.F90 @@ -0,0 +1,3135 @@ +!========================================================================= +! +! Initialization routines for the column package. +! +! author: Elizabeth C. Hunke, LANL +! + module ice_init_column + + use ice_kinds_mod + use ice_blocks, only: nx_block, ny_block + use ice_constants + use ice_communicate, only: my_task, master_task, ice_barrier + use ice_domain_size, only: ncat, max_blocks + use ice_domain_size, only: nblyr, nilyr, nslyr + use ice_domain_size, only: n_aero, n_zaero, n_algae + use ice_domain_size, only: n_doc, n_dic, n_don + use ice_domain_size, only: n_fed, n_fep + use ice_fileunits, only: nu_diag + use ice_fileunits, only: nu_nml, nml_filename, get_fileunit, & + release_fileunit, flush_fileunit + use ice_exit, only: abort_ice + use icepack_intfc, only: icepack_max_don, icepack_max_doc, icepack_max_dic + use icepack_intfc, only: icepack_max_algae, icepack_max_aero, icepack_max_fe + use icepack_intfc, only: icepack_max_nbtrcr + use icepack_intfc, only: icepack_warnings_flush, icepack_warnings_aborted + use icepack_intfc, only: icepack_init_tracer_sizes, icepack_init_tracer_flags + use icepack_intfc, only: icepack_init_tracer_indices + use icepack_intfc, only: icepack_init_parameters + use icepack_intfc, only: icepack_query_tracer_sizes, icepack_query_tracer_flags + use icepack_intfc, only: icepack_query_tracer_indices, icepack_query_tracer_sizes + use icepack_intfc, only: icepack_query_parameters + use icepack_intfc, only: icepack_write_tracer_sizes, icepack_write_tracer_flags + use icepack_intfc, only: icepack_write_tracer_indices, icepack_write_tracer_sizes + use icepack_intfc, only: icepack_init_fsd, icepack_cleanup_fsd + use icepack_intfc, only: icepack_init_zbgc + use icepack_intfc, only: icepack_init_thermo + use icepack_intfc, only: icepack_step_radiation, icepack_init_orbit + use icepack_intfc, only: icepack_init_bgc, icepack_init_zsalinity + use icepack_intfc, only: icepack_init_ocean_bio, icepack_load_ocean_bio_array + use icepack_intfc, only: icepack_init_hbrine + + implicit none + + private + public :: init_thermo_vertical, init_shortwave, & + init_age, init_FY, init_lvl, init_fsd, & + init_meltponds_lvl, init_meltponds_topo, & + init_aerosol, init_bgc, init_hbrine, init_zbgc, input_zbgc, & + count_tracers, init_isotope, init_snowtracers + + ! namelist parameters needed locally + + real (kind=dbl_kind) :: & + tau_min , tau_max , & + nitratetype , ammoniumtype , silicatetype, & + dmspptype , dmspdtype , humtype + + real (kind=dbl_kind), dimension(icepack_max_dic) :: & + dictype + + real (kind=dbl_kind), dimension(icepack_max_algae) :: & + algaltype ! tau_min for both retention and release + + real (kind=dbl_kind), dimension(icepack_max_doc) :: & + doctype + + real (kind=dbl_kind), dimension(icepack_max_don) :: & + dontype + + real (kind=dbl_kind), dimension(icepack_max_fe) :: & + fedtype + + real (kind=dbl_kind), dimension(icepack_max_fe) :: & + feptype + + real (kind=dbl_kind), dimension(icepack_max_aero) :: & + zaerotype + + real (kind=dbl_kind) :: & + grid_o, l_sk, grid_o_t, initbio_frac, & + frazil_scav, grid_oS, l_skS, & + phi_snow, & + ratio_Si2N_diatoms , ratio_Si2N_sp , ratio_Si2N_phaeo , & + ratio_S2N_diatoms , ratio_S2N_sp , ratio_S2N_phaeo , & + ratio_Fe2C_diatoms , ratio_Fe2C_sp , ratio_Fe2C_phaeo , & + ratio_Fe2N_diatoms , ratio_Fe2N_sp , ratio_Fe2N_phaeo , & + ratio_Fe2DON , ratio_Fe2DOC_s , ratio_Fe2DOC_l , & + fr_resp , & + algal_vel , R_dFe2dust , dustFe_sol , & + chlabs_diatoms , chlabs_sp , chlabs_phaeo , & + alpha2max_low_diatoms,alpha2max_low_sp , alpha2max_low_phaeo, & + beta2max_diatoms , beta2max_sp , beta2max_phaeo , & + mu_max_diatoms , mu_max_sp , mu_max_phaeo , & + grow_Tdep_diatoms , grow_Tdep_sp , grow_Tdep_phaeo , & + fr_graze_diatoms , fr_graze_sp , fr_graze_phaeo , & + mort_pre_diatoms , mort_pre_sp , mort_pre_phaeo , & + mort_Tdep_diatoms , mort_Tdep_sp , mort_Tdep_phaeo , & + k_exude_diatoms , k_exude_sp , k_exude_phaeo , & + K_Nit_diatoms , K_Nit_sp , K_Nit_phaeo , & + K_Am_diatoms , K_Am_sp , K_Am_phaeo , & + K_Sil_diatoms , K_Sil_sp , K_Sil_phaeo , & + K_Fe_diatoms , K_Fe_sp , K_Fe_phaeo , & + f_don_protein , kn_bac_protein , f_don_Am_protein , & + f_doc_s , f_doc_l , f_exude_s , & + f_exude_l , k_bac_s , k_bac_l , & + T_max , fsal , op_dep_min , & + fr_graze_s , fr_graze_e , fr_mort2min , & + fr_dFe , k_nitrif , t_iron_conv , & + max_loss , max_dfe_doc1 , fr_resp_s , & + y_sk_DMS , t_sk_conv , t_sk_ox , & + algaltype_diatoms , algaltype_sp , algaltype_phaeo , & + doctype_s , doctype_l , dontype_protein , & + fedtype_1 , feptype_1 , zaerotype_bc1 , & + zaerotype_bc2 , zaerotype_dust1 , zaerotype_dust2 , & + zaerotype_dust3 , zaerotype_dust4 , ratio_C2N_diatoms , & + ratio_C2N_sp , ratio_C2N_phaeo , ratio_chl2N_diatoms, & + ratio_chl2N_sp , ratio_chl2N_phaeo , F_abs_chl_diatoms , & + F_abs_chl_sp , F_abs_chl_phaeo , ratio_C2N_proteins + +!======================================================================= + + contains + +!======================================================================= +! +! Initialize the vertical profile of ice salinity and melting temperature. +! +! authors: C. M. Bitz, UW +! William H. Lipscomb, LANL + + subroutine init_thermo_vertical + + use ice_flux, only: salinz, Tmltz + + integer (kind=int_kind) :: & + i, j, iblk, & ! horizontal indices + k ! ice layer index + + real (kind=dbl_kind), dimension(nilyr+1) :: & + sprofile ! vertical salinity profile + + real (kind=dbl_kind) :: & + depressT + + character(len=*), parameter :: subname='(init_thermo_vertical)' + + !----------------------------------------------------------------- + ! initialize + !----------------------------------------------------------------- + + call icepack_query_parameters(depressT_out=depressT) + call icepack_init_thermo(nilyr=nilyr, sprofile=sprofile) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + + !----------------------------------------------------------------- + ! Prescibe vertical profile of salinity and melting temperature. + ! Note this profile is only used for BL99 thermodynamics. + !----------------------------------------------------------------- + + !$OMP PARALLEL DO PRIVATE(iblk,i,j,k) + do iblk = 1,max_blocks + do j = 1, ny_block + do i = 1, nx_block + do k = 1, nilyr+1 + salinz(i,j,k,iblk) = sprofile(k) + Tmltz (i,j,k,iblk) = -salinz(i,j,k,iblk)*depressT + enddo ! k + enddo ! i + enddo ! j + enddo ! iblk + !$OMP END PARALLEL DO + + end subroutine init_thermo_vertical + +!======================================================================= +! +! Initialize shortwave + + subroutine init_shortwave + + use ice_arrays_column, only: fswpenln, Iswabsn, Sswabsn, albicen, & + albsnon, alvdrn, alidrn, alvdfn, alidfn, fswsfcn, & + fswthrun, fswthrun_vdr, fswthrun_vdf, fswthrun_idr, fswthrun_idf, & + fswintn, albpndn, apeffn, trcrn_sw, dhsn, ffracn, snowfracn, & + kaer_tab, waer_tab, gaer_tab, kaer_bc_tab, waer_bc_tab, gaer_bc_tab, bcenh, & + swgrid, igrid + use ice_blocks, only: block, get_block + use ice_calendar, only: dt, calendar_type, & + days_per_year, nextsw_cday, yday, msec + use ice_diagnostics, only: npnt, print_points, pmloc, piloc, pjloc + use ice_domain, only: nblocks, blocks_ice + use ice_flux, only: alvdf, alidf, alvdr, alidr, & + alvdr_ai, alidr_ai, alvdf_ai, alidf_ai, & + swvdr, swvdf, swidr, swidf, scale_factor, snowfrac, & + albice, albsno, albpnd, apeff_ai, coszen, fsnow + use ice_grid, only: tlat, tlon, tmask + use ice_restart_shared, only: restart, runtype + use ice_state, only: aicen, vicen, vsnon, trcrn + + integer (kind=int_kind) :: & + i, j , k , & ! horizontal indices + iblk , & ! block index + ilo,ihi,jlo,jhi, & ! beginning and end of physical domain + n ! thickness category index + + real (kind=dbl_kind) :: & + netsw ! flag for shortwave radiation presence + + type (block) :: & + this_block ! block information for current block + + logical (kind=log_kind) :: & + l_print_point, & ! flag to print designated grid point diagnostics + debug, & ! if true, print diagnostics + dEdd_algae, & ! use prognostic chla in dEdd radiation + modal_aero, & ! use modal aerosol optical treatment + snwgrain ! use variable snow radius + + character (char_len) :: shortwave + + integer (kind=int_kind) :: & + ipoint + + real (kind=dbl_kind), dimension(ncat) :: & + fbri ! brine height to ice thickness + + real(kind= dbl_kind), dimension(:,:), allocatable :: & + ztrcr_sw, & ! zaerosols (kg/m^3) and chla (mg/m^3) + rsnow ! snow grain radius tracer (10^-6 m) + + logical (kind=log_kind) :: tr_brine, tr_zaero, tr_bgc_n + integer (kind=int_kind) :: nt_alvl, nt_apnd, nt_hpnd, nt_ipnd, nt_aero, & + nt_fbri, nt_tsfc, ntrcr, nbtrcr, nbtrcr_sw, nt_rsnw + integer (kind=int_kind), dimension(icepack_max_algae) :: & + nt_bgc_N + integer (kind=int_kind), dimension(icepack_max_aero) :: & + nt_zaero + real (kind=dbl_kind) :: puny + + character(len=*), parameter :: subname='(init_shortwave)' + + call icepack_query_parameters(puny_out=puny) + call icepack_query_parameters(shortwave_out=shortwave) + call icepack_query_parameters(dEdd_algae_out=dEdd_algae) + call icepack_query_parameters(modal_aero_out=modal_aero) + call icepack_query_parameters(snwgrain_out=snwgrain) + call icepack_query_tracer_sizes(ntrcr_out=ntrcr, nbtrcr_out=nbtrcr, nbtrcr_sw_out=nbtrcr_sw) + call icepack_query_tracer_flags(tr_brine_out=tr_brine, tr_zaero_out=tr_zaero, & + tr_bgc_n_out=tr_bgc_n) + call icepack_query_tracer_indices(nt_alvl_out=nt_alvl, nt_apnd_out=nt_apnd, nt_hpnd_out=nt_hpnd, & + nt_ipnd_out=nt_ipnd, nt_aero_out=nt_aero, nt_fbri_out=nt_fbri, nt_tsfc_out=nt_tsfc, & + nt_bgc_N_out=nt_bgc_N, nt_zaero_out=nt_zaero, nt_rsnw_out=nt_rsnw) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__,line= __LINE__) + + allocate(ztrcr_sw(nbtrcr_sw, ncat)) + allocate(rsnow(nslyr,ncat)) + + do iblk=1,nblocks + + ! Initialize + fswpenln(:,:,:,:,iblk) = c0 + Iswabsn(:,:,:,:,iblk) = c0 + Sswabsn(:,:,:,:,iblk) = c0 + + 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 = 1, ny_block ! can be jlo, jhi + do i = 1, nx_block ! can be ilo, ihi + + l_print_point = .false. + debug = .false. + if (debug .and. print_points) then + do ipoint = 1, npnt + if (my_task == pmloc(ipoint) .and. & + i == piloc(ipoint) .and. & + j == pjloc(ipoint)) & + l_print_point = .true. + write (nu_diag, *) 'my_task = ',my_task + enddo ! n + endif + + alvdf(i,j,iblk) = c0 + alidf(i,j,iblk) = c0 + alvdr(i,j,iblk) = c0 + alidr(i,j,iblk) = c0 + alvdr_ai(i,j,iblk) = c0 + alidr_ai(i,j,iblk) = c0 + alvdf_ai(i,j,iblk) = c0 + alidf_ai(i,j,iblk) = c0 + albice(i,j,iblk) = c0 + albsno(i,j,iblk) = c0 + albpnd(i,j,iblk) = c0 + snowfrac(i,j,iblk) = c0 + apeff_ai(i,j,iblk) = c0 + + do n = 1, ncat + alvdrn(i,j,n,iblk) = c0 + alidrn(i,j,n,iblk) = c0 + alvdfn(i,j,n,iblk) = c0 + alidfn(i,j,n,iblk) = c0 + fswsfcn(i,j,n,iblk) = c0 + fswintn(i,j,n,iblk) = c0 + fswthrun(i,j,n,iblk) = c0 + fswthrun_vdr(i,j,n,iblk) = c0 + fswthrun_vdf(i,j,n,iblk) = c0 + fswthrun_idr(i,j,n,iblk) = c0 + fswthrun_idf(i,j,n,iblk) = c0 + enddo ! ncat + + enddo + enddo + do j = jlo, jhi + do i = ilo, ihi + + if (trim(shortwave) == 'dEdd') then ! delta Eddington + +#ifndef CESMCOUPLED + ! initialize orbital parameters + ! These come from the driver in the coupled model. + call icepack_init_orbit() + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(subname//' init_orbit', & + file=__FILE__, line=__LINE__) +#endif + endif + + fbri(:) = c0 + ztrcr_sw(:,:) = c0 + rsnow (:,:) = c0 + do n = 1, ncat + if (tr_brine) fbri(n) = trcrn(i,j,nt_fbri,n,iblk) + if (snwgrain) then + do k = 1, nslyr + rsnow(k,n) = trcrn(i,j,nt_rsnw+k-1,n,iblk) + enddo + endif + enddo + + if (tmask(i,j,iblk)) then + call icepack_step_radiation (dt=dt, ncat=ncat, & + nblyr=nblyr, nilyr=nilyr, nslyr=nslyr, & + dEdd_algae=dEdd_algae, & + swgrid=swgrid(:), igrid=igrid(:), & + fbri=fbri(:), & + aicen=aicen(i,j,:,iblk), & + vicen=vicen(i,j,:,iblk), & + vsnon=vsnon(i,j,:,iblk), & + Tsfcn=trcrn(i,j,nt_Tsfc,:,iblk), & + alvln=trcrn(i,j,nt_alvl,:,iblk), & + apndn=trcrn(i,j,nt_apnd,:,iblk), & + hpndn=trcrn(i,j,nt_hpnd,:,iblk), & + ipndn=trcrn(i,j,nt_ipnd,:,iblk), & + aeron=trcrn(i,j,nt_aero:nt_aero+4*n_aero-1,:,iblk), & + bgcNn=trcrn(i,j,nt_bgc_N(1):nt_bgc_N(1)+n_algae*(nblyr+3)-1,:,iblk), & + zaeron=trcrn(i,j,nt_zaero(1):nt_zaero(1)+n_zaero*(nblyr+3)-1,:,iblk), & + trcrn_bgcsw=ztrcr_sw, & + TLAT=TLAT(i,j,iblk), TLON=TLON(i,j,iblk), & + calendar_type=calendar_type, & + days_per_year=days_per_year, & + nextsw_cday=nextsw_cday, yday=yday, & + sec=msec, & + kaer_tab=kaer_tab, kaer_bc_tab=kaer_bc_tab(:,:), & + waer_tab=waer_tab, waer_bc_tab=waer_bc_tab(:,:), & + gaer_tab=gaer_tab, gaer_bc_tab=gaer_bc_tab(:,:), & + bcenh=bcenh(:,:,:), & + modal_aero=modal_aero, & + swvdr=swvdr(i,j,iblk), swvdf=swvdf(i,j,iblk),& + swidr=swidr(i,j,iblk), swidf=swidf(i,j,iblk),& + coszen=coszen(i,j,iblk), fsnow=fsnow(i,j,iblk),& + alvdrn=alvdrn(i,j,:,iblk), alvdfn=alvdfn(i,j,:,iblk), & + alidrn=alidrn(i,j,:,iblk), alidfn=alidfn(i,j,:,iblk), & + fswsfcn=fswsfcn(i,j,:,iblk), fswintn=fswintn(i,j,:,iblk), & + fswthrun=fswthrun(i,j,:,iblk), & +!opt fswthrun_vdr=fswthrun_vdr(i,j,:,iblk), & +!opt fswthrun_vdf=fswthrun_vdf(i,j,:,iblk), & +!opt fswthrun_idr=fswthrun_idr(i,j,:,iblk), & +!opt fswthrun_idf=fswthrun_idf(i,j,:,iblk), & + fswpenln=fswpenln(i,j,:,:,iblk), & + Sswabsn=Sswabsn(i,j,:,:,iblk), Iswabsn=Iswabsn(i,j,:,:,iblk), & + albicen=albicen(i,j,:,iblk), albsnon=albsnon(i,j,:,iblk), & + albpndn=albpndn(i,j,:,iblk), apeffn=apeffn(i,j,:,iblk), & + snowfracn=snowfracn(i,j,:,iblk), & + dhsn=dhsn(i,j,:,iblk), ffracn=ffracn(i,j,:,iblk), & +!opt rsnow=rsnow(:,:), & + l_print_point=l_print_point, & + initonly = .true.) + endif + + !----------------------------------------------------------------- + ! Define aerosol tracer on shortwave grid + !----------------------------------------------------------------- + + if (dEdd_algae .and. (tr_zaero .or. tr_bgc_N)) then + do n = 1, ncat + do k = 1, nbtrcr_sw + trcrn_sw(i,j,k,n,iblk) = ztrcr_sw(k,n) + enddo + enddo + endif + + enddo ! i + enddo ! j + + !----------------------------------------------------------------- + ! Aggregate albedos + ! Match loop order in coupling_prep for same order of operations + !----------------------------------------------------------------- + + do n = 1, ncat + do j = jlo, jhi + do i = ilo, ihi + + if (aicen(i,j,n,iblk) > puny) then + + alvdf(i,j,iblk) = alvdf(i,j,iblk) & + + alvdfn(i,j,n,iblk)*aicen(i,j,n,iblk) + alidf(i,j,iblk) = alidf(i,j,iblk) & + + alidfn(i,j,n,iblk)*aicen(i,j,n,iblk) + alvdr(i,j,iblk) = alvdr(i,j,iblk) & + + alvdrn(i,j,n,iblk)*aicen(i,j,n,iblk) + alidr(i,j,iblk) = alidr(i,j,iblk) & + + alidrn(i,j,n,iblk)*aicen(i,j,n,iblk) + + netsw = swvdr(i,j,iblk) + swidr(i,j,iblk) & + + swvdf(i,j,iblk) + swidf(i,j,iblk) + if (netsw > puny) then ! sun above horizon + albice(i,j,iblk) = albice(i,j,iblk) & + + albicen(i,j,n,iblk)*aicen(i,j,n,iblk) + albsno(i,j,iblk) = albsno(i,j,iblk) & + + albsnon(i,j,n,iblk)*aicen(i,j,n,iblk) + albpnd(i,j,iblk) = albpnd(i,j,iblk) & + + albpndn(i,j,n,iblk)*aicen(i,j,n,iblk) + endif + + apeff_ai(i,j,iblk) = apeff_ai(i,j,iblk) & + + apeffn(i,j,n,iblk)*aicen(i,j,n,iblk) + snowfrac(i,j,iblk) = snowfrac(i,j,iblk) & + + snowfracn(i,j,n,iblk)*aicen(i,j,n,iblk) + + endif ! aicen > puny + + enddo ! i + enddo ! j + enddo ! ncat + + do j = 1, ny_block + do i = 1, nx_block + + !---------------------------------------------------------------- + ! Store grid box mean albedos and fluxes before scaling by aice + !---------------------------------------------------------------- + + alvdf_ai (i,j,iblk) = alvdf (i,j,iblk) + alidf_ai (i,j,iblk) = alidf (i,j,iblk) + alvdr_ai (i,j,iblk) = alvdr (i,j,iblk) + alidr_ai (i,j,iblk) = alidr (i,j,iblk) + + ! for history averaging +!echmod? cszn = c0 +!echmod if (coszen(i,j,iblk) > puny) cszn = c1 +!echmod do n = 1, nstreams +!echmod albcnt(i,j,iblk,n) = albcnt(i,j,iblk,n) + cszn +!echmod enddo + + !---------------------------------------------------------------- + ! Save net shortwave for scaling factor in scale_factor + !---------------------------------------------------------------- + if (runtype == 'initial' .and. .not. restart) then + scale_factor(i,j,iblk) = & + swvdr(i,j,iblk)*(c1 - alvdr_ai(i,j,iblk)) & + + swvdf(i,j,iblk)*(c1 - alvdf_ai(i,j,iblk)) & + + swidr(i,j,iblk)*(c1 - alidr_ai(i,j,iblk)) & + + swidf(i,j,iblk)*(c1 - alidf_ai(i,j,iblk)) + endif + + enddo ! i + enddo ! j + enddo ! iblk + + deallocate(ztrcr_sw) + deallocate(rsnow) + + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + + end subroutine init_shortwave + +!======================================================================= + +! Initialize ice age tracer (call prior to reading restart data) + + subroutine init_age(iage) + + real(kind=dbl_kind), dimension(:,:,:), intent(out) :: iage + character(len=*),parameter :: subname='(init_age)' + + iage(:,:,:) = c0 + + end subroutine init_age + +!======================================================================= + +! Initialize ice FY tracer (call prior to reading restart data) + + subroutine init_FY(firstyear) + + real(kind=dbl_kind), dimension(:,:,:), intent(out) :: firstyear + character(len=*),parameter :: subname='(init_FY)' + + firstyear(:,:,:) = c0 + + end subroutine init_FY + +!======================================================================= + +! Initialize ice lvl tracers (call prior to reading restart data) + + subroutine init_lvl(iblk, alvl, vlvl) + + use ice_constants, only: c0, c1 + use ice_arrays_column, only: ffracn, dhsn + + integer (kind=int_kind), intent(in) :: iblk + + real (kind=dbl_kind), dimension(:,:,:), intent(out) :: & + alvl , & ! level ice area fraction + vlvl ! level ice volume + character(len=*),parameter :: subname='(init_lvl)' + + alvl(:,:,:) = c1 ! level ice area fraction + vlvl(:,:,:) = c1 ! level ice volume + ffracn(:,:,:,iblk) = c0 + dhsn(:,:,:,iblk) = c0 + + end subroutine init_lvl + +!======================================================================= + +! Initialize melt ponds. + + subroutine init_meltponds_lvl(apnd, hpnd, ipnd, dhsn) + + real(kind=dbl_kind), dimension(:,:,:), intent(out) :: & + apnd , & ! melt pond area fraction + hpnd , & ! melt pond depth + ipnd , & ! melt pond refrozen lid thickness + dhsn ! depth difference for snow on sea ice and pond ice + character(len=*),parameter :: subname='(init_meltponds_lvl)' + + apnd(:,:,:) = c0 + hpnd(:,:,:) = c0 + ipnd(:,:,:) = c0 + dhsn(:,:,:) = c0 + + end subroutine init_meltponds_lvl + +!======================================================================= + +! Initialize melt ponds. + + subroutine init_meltponds_topo(apnd, hpnd, ipnd) + + real(kind=dbl_kind), dimension(:,:,:), intent(out) :: & + apnd , & ! melt pond area fraction + hpnd , & ! melt pond depth + ipnd ! melt pond refrozen lid thickness + character(len=*),parameter :: subname='(init_meltponds_topo)' + + apnd(:,:,:) = c0 + hpnd(:,:,:) = c0 + ipnd(:,:,:) = c0 + + end subroutine init_meltponds_topo + +!======================================================================= + +! Initialize snow redistribution/metamorphosis tracers (call prior to reading restart data) + + subroutine init_snowtracers(smice, smliq, rhos_cmp, rsnw) + + real(kind=dbl_kind), dimension(:,:,:,:), intent(out) :: & + smice, smliq, rhos_cmp, rsnw + character(len=*),parameter :: subname='(init_snowtracers)' + + real (kind=dbl_kind) :: & + rsnw_fall, & ! snow grain radius of new fallen snow (10^-6 m) + rhos ! snow density (kg/m^3) + + call icepack_query_parameters(rsnw_fall_out=rsnw_fall, rhos_out=rhos) + + rsnw (:,:,:,:) = rsnw_fall + rhos_cmp(:,:,:,:) = rhos + smice (:,:,:,:) = rhos + smliq (:,:,:,:) = c0 + + end subroutine init_snowtracers + +!======================================================================= + +! Initialize floe size distribution tracer (call prior to reading restart data) + + subroutine init_fsd(floesize) + + use ice_arrays_column, only: floe_rad_c, floe_binwidth, & + wavefreq, dwavefreq, wave_sig_ht, wave_spectrum, & + d_afsd_newi, d_afsd_latg, d_afsd_latm, d_afsd_wave, d_afsd_weld + use ice_domain_size, only: ncat, max_blocks, nfsd + use ice_init, only: ice_ic + use ice_state, only: aicen + + real(kind=dbl_kind), dimension(:,:,:,:,:), intent(out) :: & + floesize ! floe size distribution tracer + + ! local variables + + real (kind=dbl_kind), dimension(nfsd) :: & + afsd ! floe size distribution "profile" + + real (kind=dbl_kind), dimension(nfsd,ncat) :: & + afsdn ! floe size distribution "profile" + + real (kind=dbl_kind) :: puny + + integer (kind=int_kind) :: & + i, j, iblk , & ! horizontal indices + n, k ! category index + + logical (kind=log_kind) :: tr_fsd + + character(len=*), parameter :: subname='(init_fsd)' + + call icepack_query_parameters(puny_out=puny) + + wavefreq (:) = c0 + dwavefreq (:) = c0 + wave_sig_ht (:,:,:) = c0 + wave_spectrum (:,:,:,:) = c0 + d_afsd_newi (:,:,:,:) = c0 + d_afsd_latg (:,:,:,:) = c0 + d_afsd_latm (:,:,:,:) = c0 + d_afsd_wave (:,:,:,:) = c0 + d_afsd_weld (:,:,:,:) = c0 + + ! default: floes occupy the smallest size category in all thickness categories + afsdn(:,:) = c0 + afsdn(1,:) = c1 + floesize(:,:,:,:,:) = c0 + floesize(:,:,1,:,:) = c1 + + call icepack_query_tracer_flags(tr_fsd_out=tr_fsd) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__,line= __LINE__) + + if (tr_fsd) then + + ! initialize floe size distribution the same in every column and category + call icepack_init_fsd(nfsd, ice_ic, & + floe_rad_c, & ! fsd size bin centre in m (radius) + floe_binwidth, & ! fsd size bin width in m (radius) + afsd) ! floe size distribution + + do iblk = 1, max_blocks + do j = 1, ny_block + do i = 1, nx_block + do n = 1, ncat + do k = 1, nfsd + if (aicen(i,j,n,iblk) > puny) afsdn(k,n) = afsd(k) + enddo ! k + enddo ! n + + call icepack_cleanup_fsd (ncat, nfsd, afsdn) ! renormalize + + do n = 1, ncat + do k = 1, nfsd + floesize(i,j,k,n,iblk) = afsdn(k,n) + enddo ! k + enddo ! n + enddo ! i + enddo ! j + enddo ! iblk + + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + + endif ! tr_fsd + + end subroutine init_fsd + +!======================================================================= + +! Initialize isotope tracers (call prior to reading restart data) + + subroutine init_isotope(isosno, isoice) + + real(kind=dbl_kind), dimension(:,:,:,:), intent(out) :: & + isosno, isoice + character(len=*),parameter :: subname='(init_isotope)' + + isosno(:,:,:,:) = c0 + isoice(:,:,:,:) = c0 + + end subroutine init_isotope + +!======================================================================= + +! Initialize ice aerosol tracer (call prior to reading restart data) + + subroutine init_aerosol(aero) + + real(kind=dbl_kind), dimension(:,:,:,:), intent(out) :: & + aero ! aerosol tracers + character(len=*),parameter :: subname='(init_aerosol)' + + aero(:,:,:,:) = c0 + + end subroutine init_aerosol + +!======================================================================= + +! Initialize vertical profile for biogeochemistry + + subroutine init_bgc() + + use ice_arrays_column, only: zfswin, trcrn_sw, & + ocean_bio_all, ice_bio_net, snow_bio_net, & + cgrid, igrid, bphi, iDi, bTiz, iki, & + Rayleigh_criteria, Rayleigh_real + use ice_blocks, only: block, get_block + use ice_domain, only: nblocks, blocks_ice + use ice_flux, only: sss + use ice_flux_bgc, only: nit, amm, sil, dmsp, dms, algalN, & + doc, don, dic, fed, fep, zaeros, hum + use ice_forcing_bgc, only: init_bgc_data, get_forcing_bgc + use ice_restart_column, only: restart_zsal, & + read_restart_bgc, restart_bgc + use ice_state, only: trcrn + + ! local variables + + integer (kind=int_kind) :: & + i, j, iblk , & ! horizontal indices + ilo,ihi,jlo,jhi , & ! beginning and end of physical domain + k , & ! vertical index + n ! category index + + integer (kind=int_kind) :: & + max_nbtrcr, max_algae, max_don, max_doc, max_dic, max_aero, max_fe + + logical (kind=log_kind) :: & + RayleighC , & + solve_zsal + + type (block) :: & + this_block ! block information for current block + + real(kind=dbl_kind), allocatable :: & + trcrn_bgc(:,:) + + real(kind=dbl_kind), dimension(nilyr,ncat) :: & + sicen + + real(kind=dbl_kind) :: & + RayleighR + + integer (kind=int_kind) :: & + nbtrcr, ntrcr, ntrcr_o, & + nt_sice, nt_bgc_S + + character(len=*), parameter :: subname='(init_bgc)' + + ! Initialize + + call icepack_query_parameters(solve_zsal_out=solve_zsal) + call icepack_query_tracer_sizes(nbtrcr_out=nbtrcr, ntrcr_out=ntrcr, ntrcr_o_out=ntrcr_o) + call icepack_query_tracer_indices(nt_sice_out=nt_sice, nt_bgc_S_out=nt_bgc_S) + call icepack_query_tracer_sizes(max_nbtrcr_out=max_nbtrcr, & + max_algae_out=max_algae, max_don_out=max_don, max_doc_out=max_doc, & + max_dic_out=max_dic, max_aero_out=max_aero, max_fe_out=max_fe) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__,line= __LINE__) + + allocate(trcrn_bgc(ntrcr,ncat)) + + bphi(:,:,:,:,:) = c0 ! initial porosity for no ice + iDi (:,:,:,:,:) = c0 ! interface diffusivity + bTiz(:,:,:,:,:) = c0 ! initial bio grid ice temperature + iki (:,:,:,:,:) = c0 ! permeability + + ocean_bio_all(:,:,:,:) = c0 + ice_bio_net (:,:,:,:) = c0 ! integrated ice tracer conc (mmol/m^2 or mg/m^2) + snow_bio_net (:,:,:,:) = c0 ! integrated snow tracer conc (mmol/m^2 or mg/m^2) + zfswin (:,:,:,:,:) = c0 ! shortwave flux on bio grid + trcrn_sw (:,:,:,:,:) = c0 ! tracers active in the shortwave calculation + trcrn_bgc (:,:) = c0 + RayleighR = c0 + RayleighC = .false. + + !----------------------------------------------------------------- + ! zsalinity initialization + !----------------------------------------------------------------- + + if (solve_zsal) then ! default values + + !$OMP PARALLEL DO PRIVATE(iblk,i,j,k,n,ilo,ihi,jlo,jhi,this_block,trcrn_bgc) + 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 + call icepack_init_zsalinity(nblyr=nblyr, ntrcr_o=ntrcr_o, & + Rayleigh_criteria = RayleighC, & + Rayleigh_real = RayleighR, & + trcrn_bgc = trcrn_bgc, & + nt_bgc_S = nt_bgc_S, & + ncat = ncat, & + sss = sss(i,j,iblk)) + if (.not. restart_zsal) then + Rayleigh_real (i,j,iblk) = RayleighR + Rayleigh_criteria(i,j,iblk) = RayleighC + do n = 1,ncat + do k = 1, nblyr + trcrn (i,j,nt_bgc_S+k-1, n,iblk) = & + trcrn_bgc( nt_bgc_S+k-1-ntrcr_o,n) + enddo + enddo + endif + enddo ! i + enddo ! j + enddo ! iblk + !$OMP END PARALLEL DO + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + endif ! solve_zsal + + if (.not. solve_zsal) restart_zsal = .false. + + !----------------------------------------------------------------- + ! biogeochemistry initialization + !----------------------------------------------------------------- + + if (.not. restart_bgc) then + + !----------------------------------------------------------------- + ! Initial Ocean Values if not coupled to the ocean bgc + !----------------------------------------------------------------- + !$OMP PARALLEL DO PRIVATE(iblk,i,j,n,ilo,ihi,jlo,jhi,this_block) + 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 + call icepack_init_ocean_bio ( & + amm=amm (i,j, iblk), dmsp=dmsp(i,j, iblk), dms=dms(i,j, iblk), & + algalN=algalN(i,j,:,iblk), doc=doc (i,j,:,iblk), dic=dic(i,j,:,iblk), & + don=don (i,j,:,iblk), fed=fed (i,j,:,iblk), fep=fep(i,j,:,iblk), & + hum=hum (i,j, iblk), nit=nit (i,j, iblk), sil=sil(i,j, iblk), & + zaeros=zaeros(i,j,:,iblk), & + max_dic = icepack_max_dic, max_don = icepack_max_don, & + max_fe = icepack_max_fe, max_aero = icepack_max_aero) + enddo ! i + enddo ! j + + enddo ! iblk + !$OMP END PARALLEL DO + + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + + call init_bgc_data(fed(:,:,1,:),fep(:,:,1,:)) ! input dFe from file + call get_forcing_bgc ! defines nit and sil + + endif ! .not. restart + + !$OMP PARALLEL DO PRIVATE(iblk,i,j,n,ilo,ihi,jlo,jhi,this_block) + 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 + + call icepack_load_ocean_bio_array(max_nbtrcr=icepack_max_nbtrcr, & + max_algae=icepack_max_algae, max_don=icepack_max_don, & + max_doc=icepack_max_doc, max_fe=icepack_max_fe, & + max_dic=icepack_max_dic, max_aero=icepack_max_aero, & + nit =nit (i,j, iblk), amm=amm(i,j, iblk), sil =sil (i,j, iblk), & + dmsp=dmsp(i,j, iblk), dms=dms(i,j, iblk), algalN=algalN(i,j,:,iblk), & + doc =doc (i,j,:,iblk), don=don(i,j,:,iblk), dic =dic (i,j,:,iblk), & + fed =fed (i,j,:,iblk), fep=fep(i,j,:,iblk), zaeros=zaeros(i,j,:,iblk), & + hum=hum (i,j, iblk), ocean_bio_all=ocean_bio_all(i,j,:,iblk)) + + enddo ! i + enddo ! j + + enddo ! iblk + !$OMP END PARALLEL DO + + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + + if (.not. restart_bgc) then + !$OMP PARALLEL DO PRIVATE(iblk,i,j,k,n,ilo,ihi,jlo,jhi,this_block,sicen,trcrn_bgc) + 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 + do n = 1, ncat + do k = 1, nilyr + sicen(k,n) = trcrn(i,j,nt_sice+k-1,n,iblk) + enddo + do k = ntrcr_o+1, ntrcr + trcrn_bgc(k-ntrcr_o,n) = trcrn(i,j,k,n,iblk) + enddo + enddo + call icepack_init_bgc(ncat=ncat, nblyr=nblyr, nilyr=nilyr, ntrcr_o=ntrcr_o, & + cgrid=cgrid, igrid=igrid, ntrcr=ntrcr, nbtrcr=nbtrcr, & + sicen=sicen(:,:), trcrn=trcrn_bgc(:,:), sss=sss(i,j, iblk), & + ocean_bio_all=ocean_bio_all(i,j,:,iblk)) + enddo ! i + enddo ! j + enddo ! iblk + !$OMP END PARALLEL DO + + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + + endif ! .not. restart + + !----------------------------------------------------------------- + ! read restart to complete BGC initialization + !----------------------------------------------------------------- + + if (restart_zsal .or. restart_bgc) call read_restart_bgc + + deallocate(trcrn_bgc) + + end subroutine init_bgc + +!======================================================================= + +! Initialize brine height tracer + + subroutine init_hbrine() + + use ice_arrays_column, only: first_ice, bgrid, igrid, cgrid, & + icgrid, swgrid + use ice_state, only: trcrn + + real (kind=dbl_kind) :: phi_snow + integer (kind=int_kind) :: nt_fbri + logical (kind=log_kind) :: tr_brine + character(len=*), parameter :: subname='(init_hbrine)' + + call icepack_query_parameters(phi_snow_out=phi_snow) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__,line= __LINE__) + + call icepack_init_hbrine(bgrid=bgrid, igrid=igrid, cgrid=cgrid, icgrid=icgrid, & + swgrid=swgrid, nblyr=nblyr, nilyr=nilyr, phi_snow=phi_snow) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + + call icepack_init_parameters(phi_snow_in=phi_snow) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__,line= __LINE__) + + call icepack_query_tracer_flags(tr_brine_out=tr_brine) + call icepack_query_tracer_indices(nt_fbri_out=nt_fbri) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__,line= __LINE__) + + first_ice(:,:,:,:) = .true. + if (tr_brine) trcrn(:,:,nt_fbri,:,:) = c1 + + end subroutine init_hbrine + +!======================================================================= + +! Namelist variables, set to default values; may be altered at run time +! +! author Elizabeth C. Hunke, LANL +! Nicole Jeffery, LANL + + subroutine input_zbgc + + use ice_arrays_column, only: restore_bgc, optics_file, optics_file_fieldname + use ice_broadcast, only: broadcast_scalar + use ice_restart_column, only: restart_bgc, restart_zsal, & + restart_hbrine + use ice_restart_shared, only: restart + + character (len=char_len) :: & + shortwave ! from icepack + + logical (kind=log_kind) :: & + tr_brine, & + tr_bgc_Nit, tr_bgc_Am, tr_bgc_Sil, & + tr_bgc_DMS, tr_bgc_PON, & + tr_bgc_N, tr_bgc_C, tr_bgc_chl, & + tr_bgc_DON, tr_bgc_Fe, tr_zaero, & + tr_bgc_hum, tr_aero + + integer (kind=int_kind) :: & + ktherm + + logical (kind=log_kind) :: & + solve_zsal, skl_bgc, z_tracers, scale_bgc, solve_zbgc, dEdd_algae, & + modal_aero + + character (char_len) :: & + bgc_flux_type + + integer (kind=int_kind) :: & + nml_error, & ! namelist i/o error flag + abort_flag + + character(len=*), parameter :: subname='(input_zbgc)' + + !----------------------------------------------------------------- + ! namelist variables + !----------------------------------------------------------------- + + namelist /zbgc_nml/ & + tr_brine, restart_hbrine, tr_zaero, modal_aero, skl_bgc, & + z_tracers, dEdd_algae, solve_zbgc, bgc_flux_type, & + restore_bgc, restart_bgc, scale_bgc, solve_zsal, restart_zsal, & + tr_bgc_Nit, tr_bgc_C, tr_bgc_chl, tr_bgc_Am, tr_bgc_Sil, & + tr_bgc_DMS, tr_bgc_PON, tr_bgc_hum, tr_bgc_DON, tr_bgc_Fe, & + grid_o, grid_o_t, l_sk, grid_oS, optics_file, optics_file_fieldname, & + l_skS, phi_snow, initbio_frac, frazil_scav, & + ratio_Si2N_diatoms , ratio_Si2N_sp , ratio_Si2N_phaeo , & + ratio_S2N_diatoms , ratio_S2N_sp , ratio_S2N_phaeo , & + ratio_Fe2C_diatoms , ratio_Fe2C_sp , ratio_Fe2C_phaeo , & + ratio_Fe2N_diatoms , ratio_Fe2N_sp , ratio_Fe2N_phaeo , & + ratio_Fe2DON , ratio_Fe2DOC_s , ratio_Fe2DOC_l , & + fr_resp , tau_min , tau_max , & + algal_vel , R_dFe2dust , dustFe_sol , & + chlabs_diatoms , chlabs_sp , chlabs_phaeo , & + alpha2max_low_diatoms,alpha2max_low_sp , alpha2max_low_phaeo, & + beta2max_diatoms , beta2max_sp , beta2max_phaeo , & + mu_max_diatoms , mu_max_sp , mu_max_phaeo , & + grow_Tdep_diatoms , grow_Tdep_sp , grow_Tdep_phaeo , & + fr_graze_diatoms , fr_graze_sp , fr_graze_phaeo , & + mort_pre_diatoms , mort_pre_sp , mort_pre_phaeo , & + mort_Tdep_diatoms , mort_Tdep_sp , mort_Tdep_phaeo , & + k_exude_diatoms , k_exude_sp , k_exude_phaeo , & + K_Nit_diatoms , K_Nit_sp , K_Nit_phaeo , & + K_Am_diatoms , K_Am_sp , K_Am_phaeo , & + K_Sil_diatoms , K_Sil_sp , K_Sil_phaeo , & + K_Fe_diatoms , K_Fe_sp , K_Fe_phaeo , & + f_don_protein , kn_bac_protein , f_don_Am_protein , & + f_doc_s , f_doc_l , f_exude_s , & + f_exude_l , k_bac_s , k_bac_l , & + T_max , fsal , op_dep_min , & + fr_graze_s , fr_graze_e , fr_mort2min , & + fr_dFe , k_nitrif , t_iron_conv , & + max_loss , max_dfe_doc1 , fr_resp_s , & + y_sk_DMS , t_sk_conv , t_sk_ox , & + algaltype_diatoms , algaltype_sp , algaltype_phaeo , & + nitratetype , ammoniumtype , silicatetype , & + dmspptype , dmspdtype , humtype , & + doctype_s , doctype_l , dontype_protein , & + fedtype_1 , feptype_1 , zaerotype_bc1 , & + zaerotype_bc2 , zaerotype_dust1 , zaerotype_dust2 , & + zaerotype_dust3 , zaerotype_dust4 , ratio_C2N_diatoms , & + ratio_C2N_sp , ratio_C2N_phaeo , ratio_chl2N_diatoms, & + ratio_chl2N_sp , ratio_chl2N_phaeo , F_abs_chl_diatoms , & + F_abs_chl_sp , F_abs_chl_phaeo , ratio_C2N_proteins + + !----------------------------------------------------------------- + + abort_flag = 0 + + call icepack_query_tracer_flags(tr_aero_out=tr_aero) + call icepack_query_parameters(ktherm_out=ktherm, shortwave_out=shortwave) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + + !----------------------------------------------------------------- + ! default values + !----------------------------------------------------------------- + tr_brine = .false. ! brine height differs from ice height + tr_zaero = .false. ! z aerosol tracers + modal_aero = .false. ! use modal aerosol treatment of aerosols + optics_file = 'unknown_optics_file' ! modal aerosol optics file + optics_file_fieldname = 'unknown_optics_fieldname' ! modal aerosol optics file fieldname + restore_bgc = .false. ! restore bgc if true + solve_zsal = .false. ! update salinity tracer profile from solve_S_dt + restart_bgc = .false. ! biogeochemistry restart + restart_zsal = .false. ! salinity restart + restart_hbrine = .false. ! hbrine restart + scale_bgc = .false. ! initial bgc tracers proportional to S + skl_bgc = .false. ! solve skeletal biochemistry + z_tracers = .false. ! solve vertically resolved tracers + dEdd_algae = .false. ! dynamic algae contributes to shortwave absorption + ! in delta-Eddington calculation + solve_zbgc = .false. ! turn on z layer biochemistry + tr_bgc_PON = .false. !--------------------------------------------- + tr_bgc_Nit = .false. ! biogeochemistry (skl or zbgc) + tr_bgc_C = .false. ! if skl_bgc = .true. then skl + tr_bgc_chl = .false. ! if z_tracers = .true. then vertically resolved + tr_bgc_Sil = .false. ! if z_tracers + solve_zbgc = .true. then + tr_bgc_Am = .false. ! vertically resolved with reactions + tr_bgc_DMS = .false. !------------------------------------------------ + tr_bgc_DON = .false. ! + tr_bgc_hum = .false. ! + tr_bgc_Fe = .false. ! + tr_bgc_N = .true. ! + + ! brine height parameter + phi_snow = p5 ! snow porosity + + ! skl biology parameters + bgc_flux_type = 'Jin2006'! type of ocean-ice poston velocity ('constant') + + ! z biology parameters + grid_o = c5 ! for bottom flux + grid_o_t = c5 ! for top flux + l_sk = 7.0_dbl_kind ! characteristic diffusive scale (m) + initbio_frac = c1 ! fraction of ocean trcr concentration in bio trcrs + frazil_scav = c1 ! increase in initial bio tracer from ocean scavenging + ratio_Si2N_diatoms = 1.8_dbl_kind ! algal Si to N (mol/mol) + ratio_Si2N_sp = c0 ! diatoms, small plankton, phaeocystis + ratio_Si2N_phaeo = c0 + ratio_S2N_diatoms = 0.03_dbl_kind ! algal S to N (mol/mol) + ratio_S2N_sp = 0.03_dbl_kind + ratio_S2N_phaeo = 0.03_dbl_kind + ratio_Fe2C_diatoms = 0.0033_dbl_kind ! algal Fe to C (umol/mol) + ratio_Fe2C_sp = 0.0033_dbl_kind + ratio_Fe2C_phaeo = p1 + ratio_Fe2N_diatoms = 0.023_dbl_kind ! algal Fe to N (umol/mol) + ratio_Fe2N_sp = 0.023_dbl_kind + ratio_Fe2N_phaeo = 0.7_dbl_kind + ratio_Fe2DON = 0.023_dbl_kind ! Fe to N of DON (nmol/umol) + ratio_Fe2DOC_s = p1 ! Fe to C of DOC (nmol/umol) saccharids + ratio_Fe2DOC_l = 0.033_dbl_kind ! Fe to C of DOC (nmol/umol) lipids + fr_resp = 0.05_dbl_kind ! frac of algal growth lost due to respiration + tau_min = 5200.0_dbl_kind ! rapid mobile to stationary exchanges (s) + tau_max = 1.73e5_dbl_kind ! long time mobile to stationary exchanges (s) + algal_vel = 1.11e-8_dbl_kind! 0.5 cm/d(m/s) Lavoie 2005 1.5 cm/day + R_dFe2dust = 0.035_dbl_kind ! g/g (3.5% content) Tagliabue 2009 + dustFe_sol = 0.005_dbl_kind ! solubility fraction + chlabs_diatoms = 0.03_dbl_kind ! chl absorption (1/m/(mg/m^3)) + chlabs_sp = 0.01_dbl_kind + chlabs_phaeo = 0.05_dbl_kind + alpha2max_low_diatoms = 0.8_dbl_kind ! light limitation (1/(W/m^2)) + alpha2max_low_sp = 0.67_dbl_kind + alpha2max_low_phaeo = 0.67_dbl_kind + beta2max_diatoms = 0.018_dbl_kind ! light inhibition (1/(W/m^2)) + beta2max_sp = 0.0025_dbl_kind + beta2max_phaeo = 0.01_dbl_kind + mu_max_diatoms = 1.2_dbl_kind ! maximum growth rate (1/day) + mu_max_sp = 0.851_dbl_kind + mu_max_phaeo = 0.851_dbl_kind + grow_Tdep_diatoms = 0.06_dbl_kind ! Temperature dependence of growth (1/C) + grow_Tdep_sp = 0.06_dbl_kind + grow_Tdep_phaeo = 0.06_dbl_kind + fr_graze_diatoms = 0.01_dbl_kind ! Fraction grazed + fr_graze_sp = p1 + fr_graze_phaeo = p1 + mort_pre_diatoms = 0.007_dbl_kind! Mortality (1/day) + mort_pre_sp = 0.007_dbl_kind + mort_pre_phaeo = 0.007_dbl_kind + mort_Tdep_diatoms = 0.03_dbl_kind ! T dependence of mortality (1/C) + mort_Tdep_sp = 0.03_dbl_kind + mort_Tdep_phaeo = 0.03_dbl_kind + k_exude_diatoms = c0 ! algal exudation (1/d) + k_exude_sp = c0 + k_exude_phaeo = c0 + K_Nit_diatoms = c1 ! nitrate half saturation (mmol/m^3) + K_Nit_sp = c1 + K_Nit_phaeo = c1 + K_Am_diatoms = 0.3_dbl_kind ! ammonium half saturation (mmol/m^3) + K_Am_sp = 0.3_dbl_kind + K_Am_phaeo = 0.3_dbl_kind + K_Sil_diatoms = 4.0_dbl_kind ! silicate half saturation (mmol/m^3) + K_Sil_sp = c0 + K_Sil_phaeo = c0 + K_Fe_diatoms = c1 ! iron half saturation (nM) + K_Fe_sp = 0.2_dbl_kind + K_Fe_phaeo = p1 + f_don_protein = 0.6_dbl_kind ! fraction of spilled grazing to proteins + kn_bac_protein = 0.03_dbl_kind ! Bacterial degredation of DON (1/d) + f_don_Am_protein = 0.25_dbl_kind ! fraction of remineralized DON to ammonium + f_doc_s = 0.4_dbl_kind ! fraction of mortality to DOC + f_doc_l = 0.4_dbl_kind + f_exude_s = c1 ! fraction of exudation to DOC + f_exude_l = c1 + k_bac_s = 0.03_dbl_kind ! Bacterial degredation of DOC (1/d) + k_bac_l = 0.03_dbl_kind + T_max = c0 ! maximum temperature (C) + fsal = c1 ! Salinity limitation (ppt) + op_dep_min = p1 ! Light attenuates for optical depths exceeding min + fr_graze_s = p5 ! fraction of grazing spilled or slopped + fr_graze_e = p5 ! fraction of assimilation excreted + fr_mort2min = p5 ! fractionation of mortality to Am + fr_dFe = 0.3_dbl_kind ! fraction of remineralized nitrogen + ! (in units of algal iron) + k_nitrif = c0 ! nitrification rate (1/day) + t_iron_conv = 3065.0_dbl_kind ! desorption loss pFe to dFe (day) + max_loss = 0.9_dbl_kind ! restrict uptake to % of remaining value + max_dfe_doc1 = 0.2_dbl_kind ! max ratio of dFe to saccharides in the ice + !(nM Fe/muM C) + fr_resp_s = 0.75_dbl_kind ! DMSPd fraction of respiration loss as DMSPd + y_sk_DMS = p5 ! fraction conversion given high yield + t_sk_conv = 3.0_dbl_kind ! Stefels conversion time (d) + t_sk_ox = 10.0_dbl_kind ! DMS oxidation time (d) + algaltype_diatoms = c0 ! ------------------ + algaltype_sp = p5 ! + algaltype_phaeo = p5 ! + nitratetype = -c1 ! mobility type between + ammoniumtype = c1 ! stationary <--> mobile + silicatetype = -c1 ! + dmspptype = p5 ! + dmspdtype = -c1 ! + humtype = c1 ! + doctype_s = p5 ! + doctype_l = p5 ! + dontype_protein = p5 ! + fedtype_1 = p5 ! + feptype_1 = p5 ! + zaerotype_bc1 = c1 ! + zaerotype_bc2 = c1 ! + zaerotype_dust1 = c1 ! + zaerotype_dust2 = c1 ! + zaerotype_dust3 = c1 ! + zaerotype_dust4 = c1 !-------------------- + ratio_C2N_diatoms = 7.0_dbl_kind ! algal C to N ratio (mol/mol) + ratio_C2N_sp = 7.0_dbl_kind + ratio_C2N_phaeo = 7.0_dbl_kind + ratio_chl2N_diatoms= 2.1_dbl_kind ! algal chlorophyll to N ratio (mg/mmol) + ratio_chl2N_sp = 1.1_dbl_kind + ratio_chl2N_phaeo = 0.84_dbl_kind + F_abs_chl_diatoms = 2.0_dbl_kind ! scales absorbed radiation for dEdd + F_abs_chl_sp = 4.0_dbl_kind + F_abs_chl_phaeo = 5.0 + ratio_C2N_proteins = 7.0_dbl_kind ! ratio of C to N in proteins (mol/mol) + + ! z salinity parameters + grid_oS = c5 ! for bottom flux + l_skS = 7.0_dbl_kind ! characteristic diffusive scale (m) + + !----------------------------------------------------------------- + ! read from input file + !----------------------------------------------------------------- + + if (my_task == master_task) then + write(nu_diag,*) subname,' Reading zbgc_nml' + + 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: zbgc_nml open file '// & + trim(nml_filename), & + file=__FILE__, line=__LINE__) + endif + + nml_error = 1 + do while (nml_error > 0) + read(nu_nml, nml=zbgc_nml,iostat=nml_error) + end do + if (nml_error /= 0) then + call abort_ice(subname//'ERROR: zbgc_nml reading ', & + file=__FILE__, line=__LINE__) + endif + close(nu_nml) + call release_fileunit(nu_nml) + endif + + !----------------------------------------------------------------- + ! broadcast + !----------------------------------------------------------------- + + call broadcast_scalar(solve_zsal, master_task) + call broadcast_scalar(restart_zsal, master_task) + call broadcast_scalar(tr_brine, master_task) + call broadcast_scalar(restart_hbrine, master_task) + + call broadcast_scalar(phi_snow, master_task) + call broadcast_scalar(grid_oS, master_task) + call broadcast_scalar(l_skS, master_task) + + call broadcast_scalar(solve_zbgc, master_task) + call broadcast_scalar(skl_bgc, master_task) + call broadcast_scalar(restart_bgc, master_task) + call broadcast_scalar(bgc_flux_type, master_task) + call broadcast_scalar(restore_bgc, master_task) + call broadcast_scalar(tr_bgc_N, master_task) + call broadcast_scalar(tr_bgc_C, master_task) + call broadcast_scalar(tr_bgc_chl, master_task) + call broadcast_scalar(tr_bgc_Nit, master_task) + call broadcast_scalar(tr_bgc_Am, master_task) + call broadcast_scalar(tr_bgc_Sil, master_task) + call broadcast_scalar(tr_bgc_hum, master_task) + call broadcast_scalar(tr_bgc_DMS, master_task) + call broadcast_scalar(tr_bgc_PON, master_task) + call broadcast_scalar(tr_bgc_DON, master_task) + call broadcast_scalar(tr_bgc_Fe, master_task) + + call broadcast_scalar(z_tracers, master_task) + call broadcast_scalar(tr_zaero, master_task) + call broadcast_scalar(dEdd_algae, master_task) + call broadcast_scalar(modal_aero, master_task) + call broadcast_scalar(optics_file, master_task) + call broadcast_scalar(optics_file_fieldname, master_task) + call broadcast_scalar(grid_o, master_task) + call broadcast_scalar(grid_o_t, master_task) + call broadcast_scalar(l_sk, master_task) + call broadcast_scalar(scale_bgc, master_task) + call broadcast_scalar(initbio_frac, master_task) + call broadcast_scalar(frazil_scav, master_task) + call broadcast_scalar(ratio_Si2N_diatoms, master_task) + call broadcast_scalar(ratio_Si2N_sp, master_task) + call broadcast_scalar(ratio_Si2N_phaeo, master_task) + call broadcast_scalar(ratio_S2N_diatoms, master_task) + call broadcast_scalar(ratio_S2N_sp, master_task) + call broadcast_scalar(ratio_S2N_phaeo, master_task) + call broadcast_scalar(ratio_Fe2C_diatoms, master_task) + call broadcast_scalar(ratio_Fe2C_sp, master_task) + call broadcast_scalar(ratio_Fe2C_phaeo, master_task) + call broadcast_scalar(ratio_Fe2N_diatoms, master_task) + call broadcast_scalar(ratio_Fe2N_sp, master_task) + call broadcast_scalar(ratio_Fe2N_phaeo, master_task) + call broadcast_scalar(ratio_Fe2DON , master_task) + call broadcast_scalar(ratio_Fe2DOC_s , master_task) + call broadcast_scalar(ratio_Fe2DOC_l , master_task) + call broadcast_scalar(fr_resp , master_task) + call broadcast_scalar(tau_min , master_task) + call broadcast_scalar(tau_max , master_task) + call broadcast_scalar(algal_vel , master_task) + call broadcast_scalar(R_dFe2dust , master_task) + call broadcast_scalar(dustFe_sol , master_task) + call broadcast_scalar(chlabs_diatoms , master_task) + call broadcast_scalar(chlabs_sp , master_task) + call broadcast_scalar(chlabs_phaeo , master_task) + call broadcast_scalar(alpha2max_low_diatoms , master_task) + call broadcast_scalar(alpha2max_low_sp , master_task) + call broadcast_scalar(alpha2max_low_phaeo , master_task) + call broadcast_scalar(beta2max_diatoms , master_task) + call broadcast_scalar(beta2max_sp , master_task) + call broadcast_scalar(beta2max_phaeo , master_task) + call broadcast_scalar(mu_max_diatoms , master_task) + call broadcast_scalar(mu_max_sp , master_task) + call broadcast_scalar(mu_max_phaeo , master_task) + call broadcast_scalar(grow_Tdep_diatoms, master_task) + call broadcast_scalar(grow_Tdep_sp , master_task) + call broadcast_scalar(grow_Tdep_phaeo , master_task) + call broadcast_scalar(fr_graze_diatoms , master_task) + call broadcast_scalar(fr_graze_sp , master_task) + call broadcast_scalar(fr_graze_phaeo , master_task) + call broadcast_scalar(mort_pre_diatoms , master_task) + call broadcast_scalar(mort_pre_sp , master_task) + call broadcast_scalar(mort_pre_phaeo , master_task) + call broadcast_scalar(mort_Tdep_diatoms, master_task) + call broadcast_scalar(mort_Tdep_sp , master_task) + call broadcast_scalar(mort_Tdep_phaeo , master_task) + call broadcast_scalar(k_exude_diatoms , master_task) + call broadcast_scalar(k_exude_sp , master_task) + call broadcast_scalar(k_exude_phaeo , master_task) + call broadcast_scalar(K_Nit_diatoms , master_task) + call broadcast_scalar(K_Nit_sp , master_task) + call broadcast_scalar(K_Nit_phaeo , master_task) + call broadcast_scalar(K_Am_diatoms , master_task) + call broadcast_scalar(K_Am_sp , master_task) + call broadcast_scalar(K_Am_phaeo , master_task) + call broadcast_scalar(K_Sil_diatoms , master_task) + call broadcast_scalar(K_Sil_sp , master_task) + call broadcast_scalar(K_Sil_phaeo , master_task) + call broadcast_scalar(K_Fe_diatoms , master_task) + call broadcast_scalar(K_Fe_sp , master_task) + call broadcast_scalar(K_Fe_phaeo , master_task) + call broadcast_scalar(f_don_protein , master_task) + call broadcast_scalar(kn_bac_protein , master_task) + call broadcast_scalar(f_don_Am_protein , master_task) + call broadcast_scalar(f_doc_s , master_task) + call broadcast_scalar(f_doc_l , master_task) + call broadcast_scalar(f_exude_s , master_task) + call broadcast_scalar(f_exude_l , master_task) + call broadcast_scalar(k_bac_s , master_task) + call broadcast_scalar(k_bac_l , master_task) + call broadcast_scalar(T_max , master_task) + call broadcast_scalar(fsal , master_task) + call broadcast_scalar(op_dep_min , master_task) + call broadcast_scalar(fr_graze_s , master_task) + call broadcast_scalar(fr_graze_e , master_task) + call broadcast_scalar(fr_mort2min , master_task) + call broadcast_scalar(fr_dFe , master_task) + call broadcast_scalar(k_nitrif , master_task) + call broadcast_scalar(t_iron_conv , master_task) + call broadcast_scalar(max_loss , master_task) + call broadcast_scalar(max_dfe_doc1 , master_task) + call broadcast_scalar(fr_resp_s , master_task) + call broadcast_scalar(y_sk_DMS , master_task) + call broadcast_scalar(t_sk_conv , master_task) + call broadcast_scalar(t_sk_ox , master_task) + call broadcast_scalar(algaltype_diatoms, master_task) + call broadcast_scalar(algaltype_sp , master_task) + call broadcast_scalar(algaltype_phaeo , master_task) + call broadcast_scalar(nitratetype , master_task) + call broadcast_scalar(ammoniumtype , master_task) + call broadcast_scalar(silicatetype , master_task) + call broadcast_scalar(dmspptype , master_task) + call broadcast_scalar(dmspdtype , master_task) + call broadcast_scalar(humtype , master_task) + call broadcast_scalar(doctype_s , master_task) + call broadcast_scalar(doctype_l , master_task) + call broadcast_scalar(dontype_protein , master_task) + call broadcast_scalar(fedtype_1 , master_task) + call broadcast_scalar(feptype_1 , master_task) + call broadcast_scalar(zaerotype_bc1 , master_task) + call broadcast_scalar(zaerotype_bc2 , master_task) + call broadcast_scalar(zaerotype_dust1 , master_task) + call broadcast_scalar(zaerotype_dust2 , master_task) + call broadcast_scalar(zaerotype_dust3 , master_task) + call broadcast_scalar(zaerotype_dust4 , master_task) + call broadcast_scalar(ratio_C2N_diatoms , master_task) + call broadcast_scalar(ratio_C2N_sp , master_task) + call broadcast_scalar(ratio_C2N_phaeo , master_task) + call broadcast_scalar(ratio_chl2N_diatoms, master_task) + call broadcast_scalar(ratio_chl2N_sp , master_task) + call broadcast_scalar(ratio_chl2N_phaeo , master_task) + call broadcast_scalar(F_abs_chl_diatoms , master_task) + call broadcast_scalar(F_abs_chl_sp , master_task) + call broadcast_scalar(F_abs_chl_phaeo , master_task) + call broadcast_scalar(ratio_C2N_proteins , master_task) + + !----------------------------------------------------------------- + ! zsalinity and brine + !----------------------------------------------------------------- + + if (.not.restart) then + if (my_task == master_task) & + write(nu_diag,*) subname//' WARNING: restart = false, setting bgc restart flags to false' + restart_bgc = .false. + restart_hbrine = .false. + restart_zsal = .false. + endif + + if (solve_zsal) then + if (my_task == master_task) then + write(nu_diag,*) subname,' ERROR: solve_zsal=T deprecated' + endif + abort_flag = 101 + endif + +#ifdef UNDEPRECATE_ZSAL + if (solve_zsal .and. nblyr < 1) then + if (my_task == master_task) then + write(nu_diag,*) subname,' ERROR: solve_zsal=T but 0 zsalinity tracers' + endif + abort_flag = 101 + endif + + if (solve_zsal .and. ((.not. tr_brine) .or. (ktherm /= 1))) then + if (my_task == master_task) then + write(nu_diag,*) subname,' ERROR: solve_zsal needs tr_brine=T and ktherm=1' + endif + abort_flag = 102 + endif +#endif + + if (tr_brine .and. nblyr < 1 ) then + if (my_task == master_task) then + write(nu_diag,*) subname,' ERROR: tr_brine=T but no biology layers compiled' + endif + abort_flag = 103 + endif + + !----------------------------------------------------------------- + ! biogeochemistry + !----------------------------------------------------------------- + + if (.not. tr_brine) then + if (solve_zbgc) then + if (my_task == master_task) then + write(nu_diag,*) subname,' ERROR: tr_brine = F and solve_zbgc = T' + endif + abort_flag = 104 + endif + if (tr_zaero) then + if (my_task == master_task) then + write(nu_diag,*) subname,' ERROR: tr_brine = F and tr_zaero = T' + endif + abort_flag = 105 + endif + endif + + if ((skl_bgc .AND. solve_zbgc) .or. (skl_bgc .AND. z_tracers)) then + if (my_task == master_task) then + write(nu_diag,*) subname,' ERROR: skl_bgc and solve_zbgc or z_tracers are both true' + endif + abort_flag = 106 + endif + + if (skl_bgc .AND. tr_zaero) then + if (my_task == master_task) then + write(nu_diag,*) subname,' ERROR: skl_bgc does not use vertical tracers' + endif + abort_flag = 107 + endif + + if (dEdd_algae .AND. trim(shortwave) /= 'dEdd') then + if (my_task == master_task) then + write(nu_diag,*) subname,' ERROR: dEdd_algae = T but shortwave /= dEdd' + endif + abort_flag = 108 + endif + + if (dEdd_algae .AND. (.NOT. tr_bgc_N) .AND. (.NOT. tr_zaero)) then + if (my_task == master_task) then + write(nu_diag,*) subname,' ERROR: need tr_bgc_N or tr_zaero for dEdd_algae' + endif + abort_flag = 109 + endif + + if (modal_aero .AND. (.NOT. tr_zaero) .AND. (.NOT. tr_aero)) then + if (my_task == master_task) then + write(nu_diag,*) subname,' ERROR: modal_aero T with tr_zaero and tr_aero' + endif + abort_flag = 110 + endif + + if (modal_aero .AND. trim(shortwave) /= 'dEdd') then + if (my_task == master_task) then + write(nu_diag,*) subname,' ERROR: modal_aero = T but shortwave /= dEdd' + endif + abort_flag = 111 + endif + if (n_algae > icepack_max_algae) then + if (my_task == master_task) then + write(nu_diag,*) subname//'ERROR: number of algal types exceeds icepack_max_algae' + endif + abort_flag = 112 + endif + if (n_doc > icepack_max_doc) then + if (my_task == master_task) then + write(nu_diag,*) subname//'ERROR: number of doc types exceeds icepack_max_doc' + endif + abort_flag = 113 + endif + if (n_dic > icepack_max_doc) then + if (my_task == master_task) then + write(nu_diag,*) subname//'ERROR: number of dic types exceeds icepack_max_dic' + endif + abort_flag = 114 + endif + if (n_don > icepack_max_don) then + if (my_task == master_task) then + write(nu_diag,*) subname//'ERROR: number of don types exceeds icepack_max_don' + endif + abort_flag = 115 + endif + if (n_fed > icepack_max_fe ) then + if (my_task == master_task) then + write(nu_diag,*) subname//'ERROR: number of dissolved fe types exceeds icepack_max_fe ' + endif + abort_flag = 116 + endif + if (n_fep > icepack_max_fe ) then + if (my_task == master_task) then + write(nu_diag,*) subname//'ERROR: number of particulate fe types exceeds icepack_max_fe ' + endif + abort_flag = 117 + endif + + if (n_algae == 0 .and. skl_bgc) then + if (my_task == master_task) then + write(nu_diag,*) subname//'ERROR: skl_bgc=T but 0 bgc or algal tracers compiled' + endif + abort_flag = 118 + endif + + if (n_algae == 0 .and. solve_zbgc) then + if (my_task == master_task) then + write(nu_diag,*) subname//'ERROR: solve_zbgc=T but 0 zbgc or algal tracers compiled' + endif + abort_flag = 119 + endif + + if (solve_zbgc .and. .not. z_tracers) then + if (my_task == master_task) then + write(nu_diag,*) subname//'ERROR: solve_zbgc=T but not z_tracers' + endif + abort_flag = 120 + endif + + if (skl_bgc .or. solve_zbgc) then + if (.not. tr_bgc_N) then + if (my_task == master_task) then + write(nu_diag,*) subname//'ERROR: tr_bgc_N must be on for bgc' + endif + abort_flag = 121 + endif + if (.not. tr_bgc_Nit) then + if (my_task == master_task) then + write(nu_diag,*) subname//'ERROR: tr_bgc_Nit must be on for bgc' + endif + abort_flag = 122 + endif + else + ! tcraig, allow bgc to be turned off in this case? + tr_bgc_N = .false. + tr_bgc_C = .false. + tr_bgc_chl = .false. + tr_bgc_Nit = .false. + tr_bgc_Am = .false. + tr_bgc_Sil = .false. + tr_bgc_hum = .false. + tr_bgc_DMS = .false. + tr_bgc_PON = .false. + tr_bgc_DON = .false. + tr_bgc_Fe = .false. + endif + + !----------------------------------------------------------------- + ! z layer aerosols + !----------------------------------------------------------------- + if (tr_zaero .and. .not. z_tracers) then + if (my_task == master_task) then + write(nu_diag,*) subname//'ERROR: tr_zaero and not z_tracers' + endif + abort_flag = 123 + endif + + if (n_zaero > icepack_max_aero) then + if (my_task == master_task) then + write(nu_diag,*) subname//'ERROR: number of z aerosols exceeds icepack_max_aero' + endif + abort_flag = 124 + endif + + !----------------------------------------------------------------- + ! output + !----------------------------------------------------------------- + + if (my_task == master_task) then + write(nu_diag,1010) ' tr_brine = ', tr_brine + if (tr_brine) then + write(nu_diag,1010) ' restart_hbrine = ', restart_hbrine + write(nu_diag,1005) ' phi_snow = ', phi_snow + endif + write(nu_diag,1010) ' solve_zsal = ', solve_zsal + if (solve_zsal) then + write(nu_diag,1010) ' restart_zsal = ', restart_zsal + write(nu_diag,1000) ' grid_oS = ', grid_oS + write(nu_diag,1005) ' l_skS = ', l_skS + endif + + write(nu_diag,1010) ' skl_bgc = ', skl_bgc + write(nu_diag,1010) ' restart_bgc = ', restart_bgc + write(nu_diag,1010) ' tr_bgc_N = ', tr_bgc_N + write(nu_diag,1010) ' tr_bgc_C = ', tr_bgc_C + write(nu_diag,1010) ' tr_bgc_chl = ', tr_bgc_chl + write(nu_diag,1010) ' tr_bgc_Nit = ', tr_bgc_Nit + write(nu_diag,1010) ' tr_bgc_Am = ', tr_bgc_Am + write(nu_diag,1010) ' tr_bgc_Sil = ', tr_bgc_Sil + write(nu_diag,1010) ' tr_bgc_hum = ', tr_bgc_hum + write(nu_diag,1010) ' tr_bgc_DMS = ', tr_bgc_DMS + write(nu_diag,1010) ' tr_bgc_PON = ', tr_bgc_PON + write(nu_diag,1010) ' tr_bgc_DON = ', tr_bgc_DON + write(nu_diag,1010) ' tr_bgc_Fe = ', tr_bgc_Fe + write(nu_diag,1020) ' n_aero = ', n_aero + write(nu_diag,1020) ' n_zaero = ', n_zaero + write(nu_diag,1020) ' n_algae = ', n_algae + write(nu_diag,1020) ' n_doc = ', n_doc + write(nu_diag,1020) ' n_dic = ', n_dic + write(nu_diag,1020) ' n_don = ', n_don + write(nu_diag,1020) ' n_fed = ', n_fed + write(nu_diag,1020) ' n_fep = ', n_fep + + if (skl_bgc) then + + write(nu_diag,1030) ' bgc_flux_type = ', bgc_flux_type + write(nu_diag,1010) ' restore_bgc = ', restore_bgc + + elseif (z_tracers) then + + write(nu_diag,1010) ' dEdd_algae = ', dEdd_algae + write(nu_diag,1010) ' modal_aero = ', modal_aero + write(nu_diag,1010) ' scale_bgc = ', scale_bgc + write(nu_diag,1010) ' solve_zbgc = ', solve_zbgc + write(nu_diag,1010) ' tr_zaero = ', tr_zaero + write(nu_diag,1020) ' number of aerosols = ', n_zaero + write(nu_diag,1031) ' optics_file = ', trim(optics_file) + write(nu_diag,1031) ' optics_file_fieldname = ', trim(optics_file_fieldname) + ! bio parameters + write(nu_diag,1000) ' grid_o = ', grid_o + write(nu_diag,1000) ' grid_o_t = ', grid_o_t + write(nu_diag,1005) ' l_sk = ', l_sk + write(nu_diag,1000) ' initbio_frac = ', initbio_frac + write(nu_diag,1000) ' frazil_scav = ', frazil_scav + + endif ! skl_bgc or solve_bgc + endif + + !----------------------------------------------------------------- + ! abort if abort flag is set + !----------------------------------------------------------------- + + if (abort_flag /= 0) then + call flush_fileunit(nu_diag) + endif + call ice_barrier() + if (abort_flag /= 0) then + write(nu_diag,*) subname,' ERROR: abort_flag=',abort_flag + call abort_ice (subname//' ABORTING on input ERRORS', & + file=__FILE__, line=__LINE__) + endif + + !----------------------------------------------------------------- + ! set values in icepack + !----------------------------------------------------------------- + + call icepack_init_parameters( & + ktherm_in=ktherm, shortwave_in=shortwave, solve_zsal_in=solve_zsal, & + skl_bgc_in=skl_bgc, z_tracers_in=z_tracers, scale_bgc_in=scale_bgc, & + dEdd_algae_in=dEdd_algae, & + solve_zbgc_in=solve_zbgc, & + bgc_flux_type_in=bgc_flux_type, grid_o_in=grid_o, l_sk_in=l_sk, & + initbio_frac_in=initbio_frac, & + grid_oS_in=grid_oS, l_skS_in=l_skS, & + phi_snow_in=phi_snow, frazil_scav_in = frazil_scav, & + modal_aero_in=modal_aero) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + + call icepack_init_tracer_flags(tr_brine_in=tr_brine, & + tr_bgc_Nit_in=tr_bgc_Nit, tr_bgc_Am_in =tr_bgc_Am, tr_bgc_Sil_in=tr_bgc_Sil, & + tr_bgc_DMS_in=tr_bgc_DMS, tr_bgc_PON_in=tr_bgc_PON, & + tr_bgc_N_in =tr_bgc_N, tr_bgc_C_in =tr_bgc_C, tr_bgc_chl_in=tr_bgc_chl, & + tr_bgc_DON_in=tr_bgc_DON, tr_bgc_Fe_in =tr_bgc_Fe, tr_zaero_in =tr_zaero, & + tr_bgc_hum_in=tr_bgc_hum) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + + 1000 format (a30,2x,f9.2) ! a30 to align formatted, unformatted statements + 1005 format (a30,2x,f9.6) ! float + 1010 format (a30,2x,l6) ! logical + 1020 format (a30,2x,i6) ! integer + 1030 format (a30, a8) ! character + 1031 format (a30, a ) ! character + + end subroutine input_zbgc + +!======================================================================= + +! Count and index tracers +! +! author Elizabeth C. Hunke, LANL + + subroutine count_tracers + + use ice_domain_size, only: nilyr, nslyr, nblyr, nfsd, n_iso, & + n_aero, n_zaero, n_algae, n_doc, n_dic, n_don, n_fed, n_fep + + ! local variables + + integer (kind=int_kind) :: & + k, mm , & ! loop index + nk , & ! layer index + nk_bgc ! layer index + + integer (kind=int_kind) :: ntrcr + logical (kind=log_kind) :: tr_iage, tr_FY, tr_lvl, tr_pond, tr_aero, tr_fsd + logical (kind=log_kind) :: tr_snow + logical (kind=log_kind) :: tr_iso, tr_pond_lvl, tr_pond_topo + integer (kind=int_kind) :: nt_Tsfc, nt_sice, nt_qice, nt_qsno, nt_iage, nt_FY + integer (kind=int_kind) :: nt_alvl, nt_vlvl, nt_apnd, nt_hpnd, nt_ipnd, nt_aero + integer (kind=int_kind) :: nt_fsd, nt_isosno, nt_isoice + integer (kind=int_kind) :: nt_smice, nt_smliq, nt_rhos, nt_rsnw + + integer (kind=int_kind) :: & + nbtrcr, nbtrcr_sw, & + ntrcr_o, nt_fbri, & + nt_bgc_Nit, nt_bgc_Am, nt_bgc_Sil, & + nt_bgc_DMS, nt_bgc_PON, nt_bgc_S, & + nt_bgc_DMSPp, nt_bgc_DMSPd, & + nt_zbgc_frac, nlt_chl_sw, & + nlt_bgc_Nit, nlt_bgc_Am, nlt_bgc_Sil, & + nlt_bgc_DMS, nlt_bgc_DMSPp, nlt_bgc_DMSPd, & + nlt_bgc_PON, nt_bgc_hum, nlt_bgc_hum + + integer (kind=int_kind), dimension(icepack_max_aero) :: & + nlt_zaero_sw ! points to aerosol in trcrn_sw + + integer (kind=int_kind), dimension(icepack_max_algae) :: & + nlt_bgc_N , & ! algae + nlt_bgc_chl + + integer (kind=int_kind), dimension(icepack_max_doc) :: & + nlt_bgc_DOC ! disolved organic carbon + + integer (kind=int_kind), dimension(icepack_max_don) :: & + nlt_bgc_DON ! + + integer (kind=int_kind), dimension(icepack_max_dic) :: & + nlt_bgc_DIC ! disolved inorganic carbon + + integer (kind=int_kind), dimension(icepack_max_fe) :: & + nlt_bgc_Fed , & ! + nlt_bgc_Fep ! + + integer (kind=int_kind), dimension(icepack_max_aero) :: & + nlt_zaero ! non-reacting layer aerosols + + integer (kind=int_kind), dimension(icepack_max_algae) :: & + nt_bgc_N , & ! diatoms, phaeocystis, pico/small + nt_bgc_chl ! diatoms, phaeocystis, pico/small + + integer (kind=int_kind), dimension(icepack_max_doc) :: & + nt_bgc_DOC ! dissolved organic carbon + + integer (kind=int_kind), dimension(icepack_max_don) :: & + nt_bgc_DON ! dissolved organic nitrogen + + integer (kind=int_kind), dimension(icepack_max_dic) :: & + nt_bgc_DIC ! dissolved inorganic carbon + + integer (kind=int_kind), dimension(icepack_max_fe) :: & + nt_bgc_Fed, & ! dissolved iron + nt_bgc_Fep ! particulate iron + + integer (kind=int_kind), dimension(icepack_max_aero) :: & + nt_zaero ! black carbon and other aerosols + + logical (kind=log_kind) :: & + tr_brine, & + tr_bgc_Nit, tr_bgc_Am, tr_bgc_Sil, & + tr_bgc_DMS, tr_bgc_PON, & + tr_bgc_N, tr_bgc_C, tr_bgc_chl, & + tr_bgc_DON, tr_bgc_Fe, tr_zaero, & + tr_bgc_hum + + logical (kind=log_kind) :: & + solve_zsal, skl_bgc, z_tracers + + character(len=*), parameter :: subname='(count_tracers)' + + !----------------------------------------------------------------- + + call icepack_query_parameters( & + solve_zsal_out=solve_zsal, & + skl_bgc_out=skl_bgc, 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__) + + call icepack_query_tracer_flags(tr_iage_out=tr_iage, tr_FY_out=tr_FY, & + tr_lvl_out=tr_lvl, tr_aero_out=tr_aero, tr_pond_out=tr_pond, & + tr_pond_lvl_out=tr_pond_lvl, & + tr_pond_topo_out=tr_pond_topo, tr_brine_out=tr_brine, tr_fsd_out=tr_fsd, & + tr_snow_out=tr_snow, tr_iso_out=tr_iso, & + tr_bgc_Nit_out=tr_bgc_Nit, tr_bgc_Am_out =tr_bgc_Am, tr_bgc_Sil_out=tr_bgc_Sil, & + tr_bgc_DMS_out=tr_bgc_DMS, tr_bgc_PON_out=tr_bgc_PON, & + tr_bgc_N_out =tr_bgc_N, tr_bgc_C_out =tr_bgc_C, tr_bgc_chl_out=tr_bgc_chl, & + tr_bgc_DON_out=tr_bgc_DON, tr_bgc_Fe_out =tr_bgc_Fe, tr_zaero_out =tr_zaero, & + tr_bgc_hum_out=tr_bgc_hum) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + + ntrcr = 0 + + ntrcr = ntrcr + 1 ! count tracers, starting with Tsfc = 1 + nt_Tsfc = ntrcr ! index tracers, starting with Tsfc = 1 + + nt_qice = ntrcr + 1 + ntrcr = ntrcr + nilyr ! qice in nilyr layers + + nt_qsno = ntrcr + 1 + ntrcr = ntrcr + nslyr ! qsno in nslyr layers + + nt_sice = ntrcr + 1 + ntrcr = ntrcr + nilyr ! sice in nilyr layers + + nt_iage = 0 + if (tr_iage) then + ntrcr = ntrcr + 1 + nt_iage = ntrcr ! chronological ice age + endif + + nt_FY = 0 + if (tr_FY) then + ntrcr = ntrcr + 1 + nt_FY = ntrcr ! area of first year ice + endif + + nt_alvl = 0 + nt_vlvl = 0 + if (tr_lvl) then + ntrcr = ntrcr + 1 + nt_alvl = ntrcr + ntrcr = ntrcr + 1 + nt_vlvl = ntrcr + endif + + nt_apnd = 0 + nt_hpnd = 0 + nt_ipnd = 0 + if (tr_pond) then ! all explicit melt pond schemes + ntrcr = ntrcr + 1 + nt_apnd = ntrcr + ntrcr = ntrcr + 1 + nt_hpnd = ntrcr + if (tr_pond_lvl) then + ntrcr = ntrcr + 1 ! refrozen pond ice lid thickness + nt_ipnd = ntrcr ! on level-ice ponds (if frzpnd='hlid') + endif + if (tr_pond_topo) then + ntrcr = ntrcr + 1 ! + nt_ipnd = ntrcr ! refrozen pond ice lid thickness + endif + endif + + nt_smice = 0 + nt_smliq = 0 + nt_rhos = 0 + nt_rsnw = 0 + if (tr_snow) then + nt_smice = ntrcr + 1 + ntrcr = ntrcr + nslyr ! mass of ice in nslyr snow layers + nt_smliq = ntrcr + 1 + ntrcr = ntrcr + nslyr ! mass of liquid in nslyr snow layers + nt_rhos = ntrcr + 1 + ntrcr = ntrcr + nslyr ! snow density in nslyr layers + nt_rsnw = ntrcr + 1 + ntrcr = ntrcr + nslyr ! snow grain radius in nslyr layers + endif + + nt_fsd = 0 + if (tr_fsd) then + nt_fsd = ntrcr + 1 ! floe size distribution + ntrcr = ntrcr + nfsd + endif + + nt_isosno = 0 + nt_isoice = 0 + if (tr_iso) then + nt_isosno = ntrcr + 1 ! isotopes in snow + ntrcr = ntrcr + n_iso + nt_isoice = ntrcr + 1 ! isotopes in ice + ntrcr = ntrcr + n_iso + endif + + nt_aero = 0 + if (tr_aero) then + nt_aero = ntrcr + 1 + ntrcr = ntrcr + 4*n_aero ! 4 dEdd layers, n_aero species + else +!tcx, modify code so we don't have to reset n_aero here + n_aero = 0 !echmod - this is not getting set correctly (overwritten later?) + endif + + !----------------------------------------------------------------- + ! initialize zbgc tracer indices + !----------------------------------------------------------------- + + nbtrcr = 0 + nbtrcr_sw = 0 + nt_zbgc_frac = 0 + + ! vectors of size icepack_max_algae + nlt_bgc_N(:) = 0 + nlt_bgc_chl(:) = 0 + nt_bgc_N(:) = 0 + nt_bgc_chl(:) = 0 + + ! vectors of size icepack_max_dic + nlt_bgc_DIC(:) = 0 + nt_bgc_DIC(:) = 0 + + ! vectors of size icepack_max_doc + nlt_bgc_DOC(:) = 0 + nt_bgc_DOC(:) = 0 + + ! vectors of size icepack_max_don + nlt_bgc_DON(:) = 0 + nt_bgc_DON(:) = 0 + + ! vectors of size icepack_max_fe + nlt_bgc_Fed(:) = 0 + nlt_bgc_Fep(:) = 0 + nt_bgc_Fed(:) = 0 + nt_bgc_Fep(:) = 0 + + ! vectors of size icepack_max_aero + nlt_zaero(:) = 0 + nlt_zaero_sw(:) = 0 + nt_zaero(:) = 0 + + nlt_bgc_Nit = 0 + nlt_bgc_Am = 0 + nlt_bgc_Sil = 0 + nlt_bgc_DMSPp = 0 + nlt_bgc_DMSPd = 0 + nlt_bgc_DMS = 0 + nlt_bgc_PON = 0 + nlt_bgc_hum = 0 +! nlt_bgc_C = 0 + nlt_chl_sw = 0 + + nt_bgc_Nit = 0 + nt_bgc_Am = 0 + nt_bgc_Sil = 0 + nt_bgc_DMSPp = 0 + nt_bgc_DMSPd = 0 + nt_bgc_DMS = 0 + nt_bgc_PON = 0 + nt_bgc_hum = 0 +! nt_bgc_C = 0 + + ntrcr_o = ntrcr + nt_fbri = 0 + if (tr_brine) then + nt_fbri = ntrcr + 1 ! ice volume fraction with salt + ntrcr = ntrcr + 1 + endif + + nt_bgc_S = 0 + if (solve_zsal) then ! .true. only if tr_brine = .true. + nt_bgc_S = ntrcr + 1 + ntrcr = ntrcr + nblyr + endif + + if (skl_bgc .or. z_tracers) then + + if (skl_bgc) then + nk = 1 + elseif (z_tracers) then ! defined on nblyr+1 in ice + ! and 2 snow layers (snow surface + interior) + nk = nblyr + 1 + endif ! skl_bgc or z_tracers + nk_bgc = nk ! number of bgc layers in ice + if (nk > 1) nk_bgc = nk + 2 ! number of bgc layers in ice and snow + + !----------------------------------------------------------------- + ! count tracers and assign tracer indices + !----------------------------------------------------------------- + + if (tr_bgc_N) then + do mm = 1, n_algae + nt_bgc_N(mm) = ntrcr + 1 + do k = 1, nk_bgc + ntrcr = ntrcr + 1 + enddo + nbtrcr = nbtrcr + 1 + nlt_bgc_N(mm) = nbtrcr + enddo ! mm + endif ! tr_bgc_N + + if (tr_bgc_Nit) then + nt_bgc_Nit = ntrcr + 1 + do k = 1, nk_bgc + ntrcr = ntrcr + 1 + enddo + nbtrcr = nbtrcr + 1 + nlt_bgc_Nit = nbtrcr + endif ! tr_bgc_Nit + + if (tr_bgc_C) then + ! + ! Algal C is not yet distinct from algal N + ! * Reqires exudation and/or changing C:N ratios + ! for implementation + ! + ! do mm = 1,n_algae + ! nt_bgc_C(mm) = ntrcr + 1 + ! do k = 1, nk_bgc + ! ntrcr = ntrcr + 1 + ! enddo + ! nbtrcr = nbtrcr + 1 + ! nlt_bgc_C(mm) = nbtrcr + ! enddo ! mm + + do mm = 1, n_doc + nt_bgc_DOC(mm) = ntrcr + 1 + do k = 1, nk_bgc + ntrcr = ntrcr + 1 + enddo + nbtrcr = nbtrcr + 1 + nlt_bgc_DOC(mm) = nbtrcr + enddo ! mm + do mm = 1, n_dic + nt_bgc_DIC(mm) = ntrcr + 1 + do k = 1, nk_bgc + ntrcr = ntrcr + 1 + enddo + nbtrcr = nbtrcr + 1 + nlt_bgc_DIC(mm) = nbtrcr + enddo ! mm + endif ! tr_bgc_C + + if (tr_bgc_chl) then + do mm = 1, n_algae + nt_bgc_chl(mm) = ntrcr + 1 + do k = 1, nk_bgc + ntrcr = ntrcr + 1 + enddo + nbtrcr = nbtrcr + 1 + nlt_bgc_chl(mm) = nbtrcr + enddo ! mm + endif ! tr_bgc_chl + + if (tr_bgc_Am) then + nt_bgc_Am = ntrcr + 1 + do k = 1, nk_bgc + ntrcr = ntrcr + 1 + enddo + nbtrcr = nbtrcr + 1 + nlt_bgc_Am = nbtrcr + endif + if (tr_bgc_Sil) then + nt_bgc_Sil = ntrcr + 1 + do k = 1, nk_bgc + ntrcr = ntrcr + 1 + enddo + nbtrcr = nbtrcr + 1 + nlt_bgc_Sil = nbtrcr + endif + + if (tr_bgc_DMS) then ! all together + nt_bgc_DMSPp = ntrcr + 1 + do k = 1, nk_bgc + ntrcr = ntrcr + 1 + enddo + nbtrcr = nbtrcr + 1 + nlt_bgc_DMSPp = nbtrcr + + nt_bgc_DMSPd = ntrcr + 1 + do k = 1, nk_bgc + ntrcr = ntrcr + 1 + enddo + nbtrcr = nbtrcr + 1 + nlt_bgc_DMSPd = nbtrcr + + nt_bgc_DMS = ntrcr + 1 + do k = 1, nk_bgc + ntrcr = ntrcr + 1 + enddo + nbtrcr = nbtrcr + 1 + nlt_bgc_DMS = nbtrcr + endif + + if (tr_bgc_PON) then + nt_bgc_PON = ntrcr + 1 + do k = 1, nk_bgc + ntrcr = ntrcr + 1 + enddo + nbtrcr = nbtrcr + 1 + nlt_bgc_PON = nbtrcr + endif + + if (tr_bgc_DON) then + do mm = 1, n_don + nt_bgc_DON(mm) = ntrcr + 1 + do k = 1, nk_bgc + ntrcr = ntrcr + 1 + enddo + nbtrcr = nbtrcr + 1 + nlt_bgc_DON(mm) = nbtrcr + enddo ! mm + endif ! tr_bgc_DON + + if (tr_bgc_Fe) then + do mm = 1, n_fed + nt_bgc_Fed(mm) = ntrcr + 1 + do k = 1, nk_bgc + ntrcr = ntrcr + 1 + enddo + nbtrcr = nbtrcr + 1 + nlt_bgc_Fed(mm) = nbtrcr + enddo ! mm + do mm = 1, n_fep + nt_bgc_Fep(mm) = ntrcr + 1 + do k = 1, nk_bgc + ntrcr = ntrcr + 1 + enddo + nbtrcr = nbtrcr + 1 + nlt_bgc_Fep(mm) = nbtrcr + enddo ! mm + endif ! tr_bgc_Fe + + if (tr_bgc_hum) then + nt_bgc_hum = ntrcr + 1 + do k = 1, nk_bgc + ntrcr = ntrcr + 1 + enddo + nbtrcr = nbtrcr + 1 + nlt_bgc_hum = nbtrcr + endif + + endif ! skl_bgc .or. z_tracers + + if (z_tracers) then ! defined on nblyr+1 in ice + ! and 2 snow layers (snow surface + interior) + ! z layer aerosols + if (tr_zaero) then + do mm = 1, n_zaero + nt_zaero(mm) = ntrcr + 1 + do k = 1, nk_bgc + ntrcr = ntrcr + 1 + enddo + nbtrcr = nbtrcr + 1 + nlt_zaero(mm) = nbtrcr + enddo ! mm + endif ! tr_zaero + + if (nbtrcr > 0) then + nt_zbgc_frac = ntrcr + 1 + ntrcr = ntrcr + nbtrcr + endif + endif ! z_tracers + +!tcx, +1 here is the unused tracer, want to get rid of it + ntrcr = ntrcr + 1 + +!tcx, reset unused tracer index, eventually get rid of it. + if (nt_iage <= 0) nt_iage = ntrcr + if (nt_FY <= 0) nt_FY = ntrcr + if (nt_alvl <= 0) nt_alvl = ntrcr + if (nt_vlvl <= 0) nt_vlvl = ntrcr + if (nt_apnd <= 0) nt_apnd = ntrcr + if (nt_hpnd <= 0) nt_hpnd = ntrcr + if (nt_ipnd <= 0) nt_ipnd = ntrcr + if (nt_smice <= 0) nt_smice = ntrcr + if (nt_smliq <= 0) nt_smliq = ntrcr + if (nt_rhos <= 0) nt_rhos = ntrcr + if (nt_rsnw <= 0) nt_rsnw = ntrcr + if (nt_fsd <= 0) nt_fsd = ntrcr + if (nt_isosno<= 0) nt_isosno= ntrcr + if (nt_isoice<= 0) nt_isoice= ntrcr + if (nt_aero <= 0) nt_aero = ntrcr + if (nt_fbri <= 0) nt_fbri = ntrcr + if (nt_bgc_S <= 0) nt_bgc_S = ntrcr + + if (my_task == master_task) then + write(nu_diag,*) ' ' + write(nu_diag,1020) ' ntrcr = ', ntrcr + write(nu_diag,1020) ' nbtrcr = ', nbtrcr + write(nu_diag,1020) ' nbtrcr_sw = ', nbtrcr_sw + write(nu_diag,*) ' ' + write(nu_diag,1020) ' nt_sice = ', nt_sice + write(nu_diag,1020) ' nt_qice = ', nt_qice + write(nu_diag,1020) ' nt_qsno = ', nt_qsno + write(nu_diag,*)' ' + 1020 format (a30,2x,i6) ! integer + call flush_fileunit(nu_diag) + endif ! my_task = master_task + call icepack_init_tracer_sizes(ntrcr_in=ntrcr, & + ntrcr_o_in=ntrcr_o, nbtrcr_in=nbtrcr, nbtrcr_sw_in=nbtrcr_sw) + call icepack_init_tracer_indices(nt_Tsfc_in=nt_Tsfc, nt_sice_in=nt_sice, & + nt_qice_in=nt_qice, nt_qsno_in=nt_qsno, nt_iage_in=nt_iage, nt_fy_in=nt_fy, & + nt_alvl_in=nt_alvl, nt_vlvl_in=nt_vlvl, nt_apnd_in=nt_apnd, nt_hpnd_in=nt_hpnd, & + nt_ipnd_in=nt_ipnd, nt_fsd_in=nt_fsd, nt_aero_in=nt_aero, & + nt_smice_in=nt_smice, nt_smliq_in=nt_smliq, nt_rhos_in=nt_rhos, nt_rsnw_in=nt_rsnw, & + nt_isosno_in=nt_isosno, nt_isoice_in=nt_isoice, nt_fbri_in=nt_fbri, & + nt_bgc_Nit_in=nt_bgc_Nit, nt_bgc_Am_in=nt_bgc_Am, nt_bgc_Sil_in=nt_bgc_Sil, & + nt_bgc_DMS_in=nt_bgc_DMS, nt_bgc_PON_in=nt_bgc_PON, nt_bgc_S_in=nt_bgc_S, & + nt_bgc_N_in=nt_bgc_N, nt_bgc_chl_in=nt_bgc_chl, & + nt_bgc_DOC_in=nt_bgc_DOC, nt_bgc_DON_in=nt_bgc_DON, nt_bgc_DIC_in=nt_bgc_DIC, & + nt_zaero_in=nt_zaero, nt_bgc_DMSPp_in=nt_bgc_DMSPp, nt_bgc_DMSPd_in=nt_bgc_DMSPd, & + nt_bgc_Fed_in=nt_bgc_Fed, nt_bgc_Fep_in=nt_bgc_Fep, nt_zbgc_frac_in=nt_zbgc_frac, & + nlt_zaero_sw_in=nlt_zaero_sw, nlt_chl_sw_in=nlt_chl_sw, nlt_bgc_Sil_in=nlt_bgc_Sil, & + nlt_bgc_N_in=nlt_bgc_N, nlt_bgc_Nit_in=nlt_bgc_Nit, nlt_bgc_Am_in=nlt_bgc_Am, & + nlt_bgc_DMS_in=nlt_bgc_DMS, nlt_bgc_DMSPp_in=nlt_bgc_DMSPp, nlt_bgc_DMSPd_in=nlt_bgc_DMSPd, & + nlt_zaero_in=nlt_zaero, nlt_bgc_chl_in=nlt_bgc_chl, & + nlt_bgc_DIC_in=nlt_bgc_DIC, nlt_bgc_DOC_in=nlt_bgc_DOC, nlt_bgc_PON_in=nlt_bgc_PON, & + nlt_bgc_DON_in=nlt_bgc_DON, nlt_bgc_Fed_in=nlt_bgc_Fed, nlt_bgc_Fep_in=nlt_bgc_Fep, & + nt_bgc_hum_in=nt_bgc_hum, nlt_bgc_hum_in=nlt_bgc_hum) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname//' Icepack Abort2', & + file=__FILE__, line=__LINE__) + + if (my_task == master_task) then + call icepack_write_tracer_flags(nu_diag) + call icepack_write_tracer_sizes(nu_diag) + call icepack_write_tracer_indices(nu_diag) + endif + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname//' Icepack Abort3', & + file=__FILE__, line=__LINE__) + + end subroutine count_tracers + +!======================================================================= + +! Initialize vertical biogeochemistry +! +! author Elizabeth C. Hunke, LANL +! Nicole Jeffery, LANL + + subroutine init_zbgc + + use ice_state, only: trcr_base, trcr_depend, n_trcr_strata, & + nt_strata + use ice_arrays_column, only: R_C2N, R_chl2N, R_C2N_DON, R_Si2N, trcrn_sw + + integer (kind=int_kind) :: & + nbtrcr, nbtrcr_sw, nt_fbri, & + nt_bgc_Nit, nt_bgc_Am, nt_bgc_Sil, & + nt_bgc_DMS, nt_bgc_PON, nt_bgc_S, & + nt_bgc_DMSPp, nt_bgc_DMSPd, & + nt_zbgc_frac, nlt_chl_sw, & + nlt_bgc_Nit, nlt_bgc_Am, nlt_bgc_Sil, & + nlt_bgc_DMS, nlt_bgc_DMSPp, nlt_bgc_DMSPd, & + nlt_bgc_PON, nt_bgc_hum, nlt_bgc_hum + + integer (kind=int_kind), dimension(icepack_max_aero) :: & + nlt_zaero_sw ! points to aerosol in trcrn_sw + + integer (kind=int_kind), dimension(icepack_max_algae) :: & + nlt_bgc_N , & ! algae + nlt_bgc_chl + + integer (kind=int_kind), dimension(icepack_max_doc) :: & + nlt_bgc_DOC ! disolved organic carbon + + integer (kind=int_kind), dimension(icepack_max_don) :: & + nlt_bgc_DON ! + + integer (kind=int_kind), dimension(icepack_max_dic) :: & + nlt_bgc_DIC ! disolved inorganic carbon + + integer (kind=int_kind), dimension(icepack_max_fe) :: & + nlt_bgc_Fed , & ! + nlt_bgc_Fep ! + + integer (kind=int_kind), dimension(icepack_max_aero) :: & + nlt_zaero ! non-reacting layer aerosols + + integer (kind=int_kind), dimension(icepack_max_algae) :: & + nt_bgc_N , & ! diatoms, phaeocystis, pico/small + nt_bgc_chl ! diatoms, phaeocystis, pico/small + + integer (kind=int_kind), dimension(icepack_max_doc) :: & + nt_bgc_DOC ! dissolved organic carbon + + integer (kind=int_kind), dimension(icepack_max_don) :: & + nt_bgc_DON ! dissolved organic nitrogen + + integer (kind=int_kind), dimension(icepack_max_dic) :: & + nt_bgc_DIC ! dissolved inorganic carbon + + integer (kind=int_kind), dimension(icepack_max_fe) :: & + nt_bgc_Fed, & ! dissolved iron + nt_bgc_Fep ! particulate iron + + integer (kind=int_kind), dimension(icepack_max_aero) :: & + nt_zaero ! black carbon and other aerosols + + integer (kind=int_kind), dimension(icepack_max_nbtrcr) :: & + bio_index_o ! relates nlt_bgc_NO to ocean concentration index + + integer (kind=int_kind), dimension(icepack_max_nbtrcr) :: & + bio_index ! relates bio indices, ie. nlt_bgc_N to nt_bgc_N + + logical (kind=log_kind) :: & + tr_brine, & + tr_bgc_Nit, tr_bgc_Am, tr_bgc_Sil, & + tr_bgc_DMS, tr_bgc_PON, & + tr_bgc_N, tr_bgc_C, tr_bgc_chl, & + tr_bgc_DON, tr_bgc_Fe, tr_zaero, & + tr_bgc_hum + + real (kind=dbl_kind) :: & + initbio_frac, & + frazil_scav + + real (kind=dbl_kind), dimension(icepack_max_nbtrcr) :: & + zbgc_frac_init,&! initializes mobile fraction + bgc_tracer_type ! described tracer in mobile or stationary phases + ! < 0 is purely mobile (eg. nitrate) + ! > 0 has timescales for transitions between + ! phases based on whether the ice is melting or growing + + real (kind=dbl_kind), dimension(icepack_max_nbtrcr) :: & + zbgc_init_frac, & ! fraction of ocean tracer concentration in new ice + tau_ret, & ! retention timescale (s), mobile to stationary phase + tau_rel ! release timescale (s), stationary to mobile phase + + logical (kind=log_kind) :: & + skl_bgc, z_tracers, dEdd_algae, solve_zsal + + real (kind=dbl_kind), dimension(icepack_max_algae) :: & + F_abs_chl ! to scale absorption in Dedd + + real (kind=dbl_kind), dimension(icepack_max_algae) :: & + R_S2N , & ! algal S to N (mole/mole) + ! Marchetti et al 2006, 3 umol Fe/mol C for iron limited Pseudo-nitzschia + R_Fe2C , & ! algal Fe to carbon (umol/mmol) + R_Fe2N ! algal Fe to N (umol/mmol) + + real (kind=dbl_kind), dimension(icepack_max_don) :: & + R_Fe2DON ! Fe to N of DON (nmol/umol) + + real (kind=dbl_kind), dimension(icepack_max_doc) :: & + R_Fe2DOC ! Fe to C of DOC (nmol/umol) + + real (kind=dbl_kind), dimension(icepack_max_algae) :: & + chlabs , & ! chla absorption 1/m/(mg/m^3) + alpha2max_low , & ! light limitation (1/(W/m^2)) + beta2max , & ! light inhibition (1/(W/m^2)) + mu_max , & ! maximum growth rate (1/d) + grow_Tdep , & ! T dependence of growth (1/C) + fr_graze , & ! fraction of algae grazed + mort_pre , & ! mortality (1/day) + mort_Tdep , & ! T dependence of mortality (1/C) + k_exude , & ! algal carbon exudation rate (1/d) + K_Nit , & ! nitrate half saturation (mmol/m^3) + K_Am , & ! ammonium half saturation (mmol/m^3) + K_Sil , & ! silicon half saturation (mmol/m^3) + K_Fe ! iron half saturation or micromol/m^3 + + real (kind=dbl_kind), dimension(icepack_max_DON) :: & + f_don , & ! fraction of spilled grazing to DON + kn_bac , & ! Bacterial degredation of DON (1/d) + f_don_Am ! fraction of remineralized DON to Am + + real (kind=dbl_kind), dimension(icepack_max_DOC) :: & + f_doc , & ! fraction of mort_N that goes to each doc pool + f_exude , & ! fraction of exuded carbon to each DOC pool + k_bac ! Bacterial degredation of DOC (1/d) + + integer (kind=int_kind) :: & + k, mm , & ! loop index + nk , & ! layer index + ierr + + integer (kind=int_kind) :: & + ntd , & ! for tracer dependency calculation + nt_depend + + character(len=*), parameter :: subname='(init_zbgc)' + + !------------------------------------------------------------ + ! Tracers have mobile and stationary phases. + ! ice growth allows for retention, ice melt facilitates mobility + ! bgc_tracer_type defines the exchange timescales between these phases + ! -1 : entirely in the mobile phase, no exchange (this is the default) + ! 0 : retention time scale is tau_min, release time scale is tau_max + ! 1 : retention time scale is tau_max, release time scale is tau_min + ! 0.5: retention time scale is tau_min, release time scale is tau_min + ! 2 : retention time scale is tau_max, release time scale is tau_max + ! tau_min and tau_max are defined in icepack_intfc.f90 + !------------------------------------------------------------ + + !----------------------------------------------------------------- + ! get values from icepack + !----------------------------------------------------------------- + + call icepack_query_parameters( & + solve_zsal_out=solve_zsal, & + skl_bgc_out=skl_bgc, z_tracers_out=z_tracers, & + dEdd_algae_out=dEdd_algae, & + grid_o_out=grid_o, l_sk_out=l_sk, & + initbio_frac_out=initbio_frac, & + grid_oS_out=grid_oS, l_skS_out=l_skS, & + phi_snow_out=phi_snow, frazil_scav_out = frazil_scav) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + + call icepack_query_tracer_sizes( & + nbtrcr_out=nbtrcr, nbtrcr_sw_out=nbtrcr_sw) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + + call icepack_query_tracer_flags( & + tr_brine_out =tr_brine, & + tr_bgc_Nit_out=tr_bgc_Nit, tr_bgc_Am_out=tr_bgc_Am, tr_bgc_Sil_out=tr_bgc_Sil, & + tr_bgc_DMS_out=tr_bgc_DMS, tr_bgc_PON_out=tr_bgc_PON, & + tr_bgc_N_out =tr_bgc_N, tr_bgc_C_out =tr_bgc_C, tr_bgc_chl_out=tr_bgc_chl, & + tr_bgc_DON_out=tr_bgc_DON, tr_bgc_Fe_out=tr_bgc_Fe, tr_zaero_out =tr_zaero, & + tr_bgc_hum_out=tr_bgc_hum) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + + call icepack_query_tracer_indices( & + nt_fbri_out=nt_fbri, & + nt_bgc_Nit_out=nt_bgc_Nit, nt_bgc_Am_out=nt_bgc_Am, nt_bgc_Sil_out=nt_bgc_Sil, & + nt_bgc_DMS_out=nt_bgc_DMS, nt_bgc_PON_out=nt_bgc_PON, nt_bgc_S_out=nt_bgc_S, & + nt_bgc_N_out=nt_bgc_N, nt_bgc_chl_out=nt_bgc_chl, & + nt_bgc_DOC_out=nt_bgc_DOC, nt_bgc_DON_out=nt_bgc_DON, nt_bgc_DIC_out=nt_bgc_DIC, & + nt_zaero_out=nt_zaero, nt_bgc_DMSPp_out=nt_bgc_DMSPp, nt_bgc_DMSPd_out=nt_bgc_DMSPd, & + nt_bgc_Fed_out=nt_bgc_Fed, nt_bgc_Fep_out=nt_bgc_Fep, nt_zbgc_frac_out=nt_zbgc_frac, & + nlt_zaero_sw_out=nlt_zaero_sw, nlt_chl_sw_out=nlt_chl_sw, nlt_bgc_Sil_out=nlt_bgc_Sil, & + nlt_bgc_N_out=nlt_bgc_N, nlt_bgc_Nit_out=nlt_bgc_Nit, nlt_bgc_Am_out=nlt_bgc_Am, & + nlt_bgc_DMS_out=nlt_bgc_DMS, nlt_bgc_DMSPp_out=nlt_bgc_DMSPp, nlt_bgc_DMSPd_out=nlt_bgc_DMSPd, & + nlt_zaero_out=nlt_zaero, nlt_bgc_chl_out=nlt_bgc_chl, & + nlt_bgc_DIC_out=nlt_bgc_DIC, nlt_bgc_DOC_out=nlt_bgc_DOC, nlt_bgc_PON_out=nlt_bgc_PON, & + nlt_bgc_DON_out=nlt_bgc_DON, nlt_bgc_Fed_out=nlt_bgc_Fed, nlt_bgc_Fep_out=nlt_bgc_Fep, & + nt_bgc_hum_out=nt_bgc_hum, nlt_bgc_hum_out=nlt_bgc_hum) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + + !----------------------------------------------------------------- + ! Define array parameters + !----------------------------------------------------------------- + + allocate( & + R_C2N_DON(icepack_max_don), & ! carbon to nitrogen mole ratio of DON pool + R_C2N(icepack_max_algae), & ! algal C to N (mole/mole) + R_chl2N(icepack_max_algae), & ! 3 algal chlorophyll to N (mg/mmol) + R_Si2N(icepack_max_algae), & ! silica to nitrogen mole ratio for algal groups + stat=ierr) + if (ierr/=0) call abort_ice(subname//' Out of Memory') + + R_Si2N(1) = ratio_Si2N_diatoms + R_Si2N(2) = ratio_Si2N_sp + R_Si2N(3) = ratio_Si2N_phaeo + + R_S2N(1) = ratio_S2N_diatoms + R_S2N(2) = ratio_S2N_sp + R_S2N(3) = ratio_S2N_phaeo + + R_Fe2C(1) = ratio_Fe2C_diatoms + R_Fe2C(2) = ratio_Fe2C_sp + R_Fe2C(3) = ratio_Fe2C_phaeo + + R_Fe2N(1) = ratio_Fe2N_diatoms + R_Fe2N(2) = ratio_Fe2N_sp + R_Fe2N(3) = ratio_Fe2N_phaeo + + R_C2N(1) = ratio_C2N_diatoms + R_C2N(2) = ratio_C2N_sp + R_C2N(3) = ratio_C2N_phaeo + + R_chl2N(1) = ratio_chl2N_diatoms + R_chl2N(2) = ratio_chl2N_sp + R_chl2N(3) = ratio_chl2N_phaeo + + F_abs_chl(1) = F_abs_chl_diatoms + F_abs_chl(2) = F_abs_chl_sp + F_abs_chl(3) = F_abs_chl_phaeo + + R_Fe2DON(1) = ratio_Fe2DON + R_C2N_DON(1) = ratio_C2N_proteins + + R_Fe2DOC(1) = ratio_Fe2DOC_s + R_Fe2DOC(2) = ratio_Fe2DOC_l + R_Fe2DOC(3) = c0 + + chlabs(1) = chlabs_diatoms + chlabs(2) = chlabs_sp + chlabs(3) = chlabs_phaeo + + alpha2max_low(1) = alpha2max_low_diatoms + alpha2max_low(2) = alpha2max_low_sp + alpha2max_low(3) = alpha2max_low_phaeo + + beta2max(1) = beta2max_diatoms + beta2max(2) = beta2max_sp + beta2max(3) = beta2max_phaeo + + mu_max(1) = mu_max_diatoms + mu_max(2) = mu_max_sp + mu_max(3) = mu_max_phaeo + + grow_Tdep(1) = grow_Tdep_diatoms + grow_Tdep(2) = grow_Tdep_sp + grow_Tdep(3) = grow_Tdep_phaeo + + fr_graze(1) = fr_graze_diatoms + fr_graze(2) = fr_graze_sp + fr_graze(3) = fr_graze_phaeo + + mort_pre(1) = mort_pre_diatoms + mort_pre(2) = mort_pre_sp + mort_pre(3) = mort_pre_phaeo + + mort_Tdep(1) = mort_Tdep_diatoms + mort_Tdep(2) = mort_Tdep_sp + mort_Tdep(3) = mort_Tdep_phaeo + + k_exude(1) = k_exude_diatoms + k_exude(2) = k_exude_sp + k_exude(3) = k_exude_phaeo + + K_Nit(1) = K_Nit_diatoms + K_Nit(2) = K_Nit_sp + K_Nit(3) = K_Nit_phaeo + + K_Am(1) = K_Am_diatoms + K_Am(2) = K_Am_sp + K_Am(3) = K_Am_phaeo + + K_Sil(1) = K_Sil_diatoms + K_Sil(2) = K_Sil_sp + K_Sil(3) = K_Sil_phaeo + + K_Fe(1) = K_Fe_diatoms + K_Fe(2) = K_Fe_sp + K_Fe(3) = K_Fe_phaeo + + f_don(1) = f_don_protein + kn_bac(1) = kn_bac_protein + f_don_Am(1) = f_don_Am_protein + + f_doc(1) = f_doc_s + f_doc(2) = f_doc_l + + f_exude(1) = f_exude_s + f_exude(2) = f_exude_l + k_bac(1) = k_bac_s + k_bac(2) = k_bac_l + + dictype(:) = -c1 + + algaltype(1) = algaltype_diatoms + algaltype(2) = algaltype_sp + algaltype(3) = algaltype_phaeo + + doctype(1) = doctype_s + doctype(2) = doctype_l + + dontype(1) = dontype_protein + + fedtype(1) = fedtype_1 + feptype(1) = feptype_1 + + zaerotype(1) = zaerotype_bc1 + zaerotype(2) = zaerotype_bc2 + zaerotype(3) = zaerotype_dust1 + zaerotype(4) = zaerotype_dust2 + zaerotype(5) = zaerotype_dust3 + zaerotype(6) = zaerotype_dust4 + + call icepack_init_zbgc ( & +!opt R_S2N_in=R_S2N, R_Fe2C_in=R_Fe2C, R_Fe2N_in=R_Fe2N, R_C2N_in=R_C2N, & +!opt R_chl2N_in=R_chl2N, F_abs_chl_in=F_abs_chl, R_Fe2DON_in=R_Fe2DON, R_Fe2DOC_in=R_Fe2DOC, & +!opt mort_Tdep_in=mort_Tdep, k_exude_in=k_exude, & +!opt K_Nit_in=K_Nit, K_Am_in=K_Am, K_sil_in=K_Sil, K_Fe_in=K_Fe, & +!opt f_don_in=f_don, kn_bac_in=kn_bac, f_don_Am_in=f_don_Am, f_exude_in=f_exude, k_bac_in=k_bac, & +!opt fr_resp_in=fr_resp, algal_vel_in=algal_vel, R_dFe2dust_in=R_dFe2dust, & +!opt dustFe_sol_in=dustFe_sol, T_max_in=T_max, fr_mort2min_in=fr_mort2min, fr_dFe_in=fr_dFe, & +!opt op_dep_min_in=op_dep_min, fr_graze_s_in=fr_graze_s, fr_graze_e_in=fr_graze_e, & +!opt k_nitrif_in=k_nitrif, t_iron_conv_in=t_iron_conv, max_loss_in=max_loss, max_dfe_doc1_in=max_dfe_doc1, & +!opt fr_resp_s_in=fr_resp_s, y_sk_DMS_in=y_sk_DMS, t_sk_conv_in=t_sk_conv, t_sk_ox_in=t_sk_ox, & +!opt mu_max_in=mu_max, R_Si2N_in=R_Si2N, R_C2N_DON_in=R_C2N_DON, chlabs_in=chlabs, & +!opt alpha2max_low_in=alpha2max_low, beta2max_in=beta2max, grow_Tdep_in=grow_Tdep, & +!opt fr_graze_in=fr_graze, mort_pre_in=mort_pre, f_doc_in=f_doc,fsal_in=fsal, & + ) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + + !----------------------------------------------------------------- + ! assign tracer dependencies + ! bgc_tracer_type: < 0 purely mobile , >= 0 stationary + !------------------------------------------------------------------ + + if (tr_brine) then + trcr_depend(nt_fbri) = 1 ! volume-weighted + trcr_base (nt_fbri,1) = c0 ! volume-weighted + trcr_base (nt_fbri,2) = c1 ! volume-weighted + trcr_base (nt_fbri,3) = c0 ! volume-weighted + n_trcr_strata(nt_fbri) = 0 + nt_strata (nt_fbri,1) = 0 + nt_strata (nt_fbri,2) = 0 + endif + + ntd = 0 ! if nt_fbri /= 0 then use fbri dependency + if (nt_fbri == 0) ntd = -1 ! otherwise make tracers depend on ice volume + + if (solve_zsal) then ! .true. only if tr_brine = .true. + do k = 1,nblyr + trcr_depend(nt_bgc_S + k - 1) = 2 + nt_fbri + ntd + trcr_base (nt_bgc_S,1) = c0 ! default: ice area + trcr_base (nt_bgc_S,2) = c1 + trcr_base (nt_bgc_S,3) = c0 + n_trcr_strata(nt_bgc_S) = 1 + nt_strata(nt_bgc_S,1) = nt_fbri + nt_strata(nt_bgc_S,2) = 0 + enddo + endif + + bio_index(:) = 0 + bio_index_o(:) = 0 + + if (skl_bgc) then + nk = 1 + nt_depend = 0 + elseif (z_tracers) then ! defined on nblyr+1 in ice + ! and 2 snow layers (snow surface + interior) + nk = nblyr + 1 + nt_depend = 2 + nt_fbri + ntd + endif ! skl_bgc or z_tracers + + if (skl_bgc .or. z_tracers) then + + if (tr_bgc_N) then + do mm = 1, n_algae + call init_bgc_trcr(nk, nt_fbri, & + nt_bgc_N(mm), nlt_bgc_N(mm), & + algaltype(mm), nt_depend, & + bgc_tracer_type, trcr_depend, & + trcr_base, n_trcr_strata, & + nt_strata, bio_index) + bio_index_o(nlt_bgc_N(mm)) = mm + enddo ! mm + endif ! tr_bgc_N + + if (tr_bgc_Nit) then + call init_bgc_trcr(nk, nt_fbri, & + nt_bgc_Nit, nlt_bgc_Nit, & + nitratetype, nt_depend, & + bgc_tracer_type, trcr_depend, & + trcr_base, n_trcr_strata, & + nt_strata, bio_index) + bio_index_o(nlt_bgc_Nit) = icepack_max_algae + 1 + endif ! tr_bgc_Nit + + if (tr_bgc_C) then + ! + ! Algal C is not yet distinct from algal N + ! * Reqires exudation and/or changing C:N ratios + ! for implementation + ! + ! do mm = 1,n_algae + ! call init_bgc_trcr(nk, nt_fbri, & + ! nt_bgc_C(mm), nlt_bgc_C(mm), & + ! algaltype(mm), nt_depend, & + ! bgc_tracer_type, trcr_depend, & + ! trcr_base, n_trcr_strata, & + ! nt_strata, bio_index) + ! bio_index_o(nlt_bgc_C(mm)) = icepack_max_algae + 1 + mm + ! enddo ! mm + + do mm = 1, n_doc + call init_bgc_trcr(nk, nt_fbri, & + nt_bgc_DOC(mm), nlt_bgc_DOC(mm), & + doctype(mm), nt_depend, & + bgc_tracer_type, trcr_depend, & + trcr_base, n_trcr_strata, & + nt_strata, bio_index) + bio_index_o(nlt_bgc_DOC(mm)) = icepack_max_algae + 1 + mm + enddo ! mm + do mm = 1, n_dic + call init_bgc_trcr(nk, nt_fbri, & + nt_bgc_DIC(mm), nlt_bgc_DIC(mm), & + dictype(mm), nt_depend, & + bgc_tracer_type, trcr_depend, & + trcr_base, n_trcr_strata, & + nt_strata, bio_index) + bio_index_o(nlt_bgc_DIC(mm)) = icepack_max_algae + icepack_max_doc + 1 + mm + enddo ! mm + endif ! tr_bgc_C + + if (tr_bgc_chl) then + do mm = 1, n_algae + call init_bgc_trcr(nk, nt_fbri, & + nt_bgc_chl(mm), nlt_bgc_chl(mm), & + algaltype(mm), nt_depend, & + bgc_tracer_type, trcr_depend, & + trcr_base, n_trcr_strata, & + nt_strata, bio_index) + bio_index_o(nlt_bgc_chl(mm)) = icepack_max_algae + 1 + icepack_max_doc + icepack_max_dic + mm + enddo ! mm + endif ! tr_bgc_chl + + if (tr_bgc_Am) then + call init_bgc_trcr(nk, nt_fbri, & + nt_bgc_Am, nlt_bgc_Am, & + ammoniumtype, nt_depend, & + bgc_tracer_type, trcr_depend, & + trcr_base, n_trcr_strata, & + nt_strata, bio_index) + bio_index_o(nlt_bgc_Am) = 2*icepack_max_algae + icepack_max_doc + icepack_max_dic + 2 + endif + if (tr_bgc_Sil) then + call init_bgc_trcr(nk, nt_fbri, & + nt_bgc_Sil, nlt_bgc_Sil, & + silicatetype, nt_depend, & + bgc_tracer_type, trcr_depend, & + trcr_base, n_trcr_strata, & + nt_strata, bio_index) + bio_index_o(nlt_bgc_Sil) = 2*icepack_max_algae + icepack_max_doc + icepack_max_dic + 3 + endif + if (tr_bgc_DMS) then ! all together + call init_bgc_trcr(nk, nt_fbri, & + nt_bgc_DMSPp, nlt_bgc_DMSPp, & + dmspptype, nt_depend, & + bgc_tracer_type, trcr_depend, & + trcr_base, n_trcr_strata, & + nt_strata, bio_index) + bio_index_o(nlt_bgc_DMSPp) = 2*icepack_max_algae + icepack_max_doc + icepack_max_dic + 4 + + call init_bgc_trcr(nk, nt_fbri, & + nt_bgc_DMSPd, nlt_bgc_DMSPd, & + dmspdtype, nt_depend, & + bgc_tracer_type, trcr_depend, & + trcr_base, n_trcr_strata, & + nt_strata, bio_index) + bio_index_o(nlt_bgc_DMSPd) = 2*icepack_max_algae + icepack_max_doc + icepack_max_dic + 5 + + call init_bgc_trcr(nk, nt_fbri, & + nt_bgc_DMS, nlt_bgc_DMS, & + dmspdtype, nt_depend, & + bgc_tracer_type, trcr_depend, & + trcr_base, n_trcr_strata, & + nt_strata, bio_index) + bio_index_o(nlt_bgc_DMS) = 2*icepack_max_algae + icepack_max_doc + icepack_max_dic + 6 + endif + if (tr_bgc_PON) then + call init_bgc_trcr(nk, nt_fbri, & + nt_bgc_PON, nlt_bgc_PON, & + nitratetype, nt_depend, & + bgc_tracer_type, trcr_depend, & + trcr_base, n_trcr_strata, & + nt_strata, bio_index) + bio_index_o(nlt_bgc_PON) = 2*icepack_max_algae + icepack_max_doc + icepack_max_dic + 7 + endif + if (tr_bgc_DON) then + do mm = 1, n_don + call init_bgc_trcr(nk, nt_fbri, & + nt_bgc_DON(mm), nlt_bgc_DON(mm), & + dontype(mm), nt_depend, & + bgc_tracer_type, trcr_depend, & + trcr_base, n_trcr_strata, & + nt_strata, bio_index) + bio_index_o(nlt_bgc_DON(mm)) = 2*icepack_max_algae + icepack_max_doc + icepack_max_dic + 7 + mm + enddo ! mm + endif ! tr_bgc_DON + if (tr_bgc_Fe) then + do mm = 1, n_fed + call init_bgc_trcr(nk, nt_fbri, & + nt_bgc_Fed(mm), nlt_bgc_Fed(mm), & + fedtype(mm), nt_depend, & + bgc_tracer_type, trcr_depend, & + trcr_base, n_trcr_strata, & + nt_strata, bio_index) + bio_index_o(nlt_bgc_Fed(mm)) = 2*icepack_max_algae + icepack_max_doc + icepack_max_dic & + + icepack_max_don + 7 + mm + enddo ! mm + do mm = 1, n_fep + call init_bgc_trcr(nk, nt_fbri, & + nt_bgc_Fep(mm), nlt_bgc_Fep(mm), & + feptype(mm), nt_depend, & + bgc_tracer_type, trcr_depend, & + trcr_base, n_trcr_strata, & + nt_strata, bio_index) + bio_index_o(nlt_bgc_Fep(mm)) = 2*icepack_max_algae + icepack_max_doc + icepack_max_dic & + + icepack_max_don + icepack_max_fe + 7 + mm + enddo ! mm + endif ! tr_bgc_Fe + + if (tr_bgc_hum) then + call init_bgc_trcr(nk, nt_fbri, & + nt_bgc_hum, nlt_bgc_hum, & + humtype, nt_depend, & + bgc_tracer_type, trcr_depend, & + trcr_base, n_trcr_strata, & + nt_strata, bio_index) + bio_index_o(nlt_bgc_hum) = 2*icepack_max_algae + icepack_max_doc + 8 + icepack_max_dic & + + icepack_max_don + 2*icepack_max_fe + icepack_max_aero + endif + endif ! skl_bgc or z_tracers + + if (skl_bgc) then + if (dEdd_algae) then + nlt_chl_sw = 1 + nbtrcr_sw = nilyr+nslyr+2 ! only the bottom layer will be nonzero + endif + + elseif (z_tracers) then ! defined on nblyr+1 in ice + ! and 2 snow layers (snow surface + interior) + if (tr_bgc_N) then + if (dEdd_algae) then + nlt_chl_sw = 1 + nbtrcr_sw = nilyr+nslyr+2 + endif + endif ! tr_bgc_N + endif ! skl_bgc or z_tracers + + if (z_tracers) then ! defined on nblyr+1 in ice + ! and 2 snow layers (snow surface + interior) + + nk = nblyr + 1 + nt_depend = 2 + nt_fbri + ntd + + ! z layer aerosols + if (tr_zaero) then + do mm = 1, n_zaero + if (dEdd_algae) then + nlt_zaero_sw(mm) = nbtrcr_sw + 1 + nbtrcr_sw = nbtrcr_sw + nilyr + nslyr+2 + endif + call init_bgc_trcr(nk, nt_fbri, & + nt_zaero(mm), nlt_zaero(mm), & + zaerotype(mm), nt_depend, & + bgc_tracer_type, trcr_depend, & + trcr_base, n_trcr_strata, & + nt_strata, bio_index) + bio_index_o(nlt_zaero(mm)) = 2*icepack_max_algae + icepack_max_doc + icepack_max_dic & + + icepack_max_don + 2*icepack_max_fe + 7 + mm + enddo ! mm + endif ! tr_zaero + + if (nbtrcr > 0) then + do k = 1,nbtrcr + zbgc_frac_init(k) = c1 + trcr_depend(nt_zbgc_frac+k-1) = 2+nt_fbri + trcr_base(nt_zbgc_frac+ k - 1,1) = c0 + trcr_base(nt_zbgc_frac+ k - 1,2) = c1 + trcr_base(nt_zbgc_frac+ k - 1,3) = c0 + n_trcr_strata(nt_zbgc_frac+ k - 1)= 1 + nt_strata(nt_zbgc_frac+ k - 1,1) = nt_fbri + nt_strata(nt_zbgc_frac+ k - 1,2) = 0 + tau_ret(k) = c1 + tau_rel(k) = c1 + if (bgc_tracer_type(k) >= c0 .and. bgc_tracer_type(k) < p5) then + tau_ret(k) = tau_min + tau_rel(k) = tau_max + zbgc_frac_init(k) = c1 + elseif (bgc_tracer_type(k) >= p5 .and. bgc_tracer_type(k) < c1) then + tau_ret(k) = tau_min + tau_rel(k) = tau_min + zbgc_frac_init(k) = c1 + elseif (bgc_tracer_type(k) >= c1 .and. bgc_tracer_type(k) < c2) then + tau_ret(k) = tau_max + tau_rel(k) = tau_min + zbgc_frac_init(k) = c1 + elseif (bgc_tracer_type(k) >= c2 ) then + tau_ret(k) = tau_max + tau_rel(k) = tau_max + zbgc_frac_init(k) = c1 + endif + enddo + endif + + endif ! z_tracers + + do k = 1, nbtrcr + zbgc_init_frac(k) = frazil_scav + if (bgc_tracer_type(k) < c0) zbgc_init_frac(k) = initbio_frac + enddo + + !----------------------------------------------------------------- + ! set values in icepack + !----------------------------------------------------------------- + + call icepack_init_zbgc( & +!opt zbgc_init_frac_in=zbgc_init_frac, tau_ret_in=tau_ret, tau_rel_in=tau_rel, & +!opt zbgc_frac_init_in=zbgc_frac_init, bgc_tracer_type_in=bgc_tracer_type, & + ) + call icepack_init_tracer_indices( & + bio_index_o_in=bio_index_o, bio_index_in=bio_index) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + + !----------------------------------------------------------------- + ! final consistency checks + !----------------------------------------------------------------- + if (nbtrcr > icepack_max_nbtrcr) then + write (nu_diag,*) subname,' ' + write (nu_diag,*) subname,'nbtrcr > icepack_max_nbtrcr' + write (nu_diag,*) subname,'nbtrcr, icepack_max_nbtrcr:',nbtrcr, icepack_max_nbtrcr + call abort_ice (subname//'ERROR: nbtrcr > icepack_max_nbtrcr') + endif + if (.NOT. dEdd_algae) nbtrcr_sw = 1 + + ! tcraig, added 6/1/21, why is nbtrcr_sw set here? + call icepack_init_tracer_sizes(nbtrcr_sw_in=nbtrcr_sw) + allocate(trcrn_sw(nx_block,ny_block,nbtrcr_sw,ncat,max_blocks)) ! bgc tracers active in the delta-Eddington shortwave + + !----------------------------------------------------------------- + ! spew + !----------------------------------------------------------------- + if (my_task == master_task) then + if (skl_bgc) then + + write(nu_diag,1020) ' number of bio tracers = ', nbtrcr + write(nu_diag,1020) ' number of Isw tracers = ', nbtrcr_sw + + elseif (z_tracers) then + + write(nu_diag,1020) ' number of ztracers = ', nbtrcr + write(nu_diag,1020) ' number of Isw tracers = ', nbtrcr_sw + write(nu_diag,1000) ' initbio_frac = ', initbio_frac + write(nu_diag,1000) ' frazil_scav = ', frazil_scav + + endif ! skl_bgc or solve_bgc + endif ! master_task + + 1000 format (a30,2x,f9.2) ! a30 to align formatted, unformatted statements + 1020 format (a30,2x,i6) ! integer + + end subroutine init_zbgc + +!======================================================================= + + subroutine init_bgc_trcr(nk, nt_fbri, & + nt_bgc, nlt_bgc, & + bgctype, nt_depend, & + bgc_tracer_type, trcr_depend, & + trcr_base, n_trcr_strata, & + nt_strata, bio_index) + + integer (kind=int_kind), intent(in) :: & + nk , & ! counter + nt_depend , & ! tracer dependency index + nt_bgc , & ! tracer index + nlt_bgc , & ! bio tracer index + nt_fbri + + integer (kind=int_kind), dimension(:), intent(inout) :: & + trcr_depend , & ! tracer dependencies + n_trcr_strata, & ! number of underlying tracer layers + bio_index ! + + integer (kind=int_kind), dimension(:,:), intent(inout) :: & + nt_strata ! indices of underlying tracer layers + + real (kind=dbl_kind), dimension(:,:), intent(inout) :: & + trcr_base ! = 0 or 1 depending on tracer dependency + ! argument 2: (1) aice, (2) vice, (3) vsno + + real (kind=dbl_kind), intent(in) :: & + bgctype ! bio tracer transport type (mobile vs stationary) + + real (kind=dbl_kind), dimension(:), intent(inout) :: & + bgc_tracer_type ! bio tracer transport type array + + ! local variables + + integer (kind=int_kind) :: & + k , & ! loop index + n_strata , & ! temporary values + nt_strata1, & ! + nt_strata2 + + real (kind=dbl_kind) :: & + trcr_base1, & ! temporary values + trcr_base2, & + trcr_base3 + + character(len=*), parameter :: subname='(init_bgc_trcr)' + + !-------- + + bgc_tracer_type(nlt_bgc) = bgctype + + if (nk > 1) then ! include vertical bgc in snow + do k = nk, nk+1 + trcr_depend (nt_bgc + k ) = 2 ! snow volume + trcr_base (nt_bgc + k,1) = c0 + trcr_base (nt_bgc + k,2) = c0 + trcr_base (nt_bgc + k,3) = c1 + n_trcr_strata(nt_bgc + k ) = 0 + nt_strata (nt_bgc + k,1) = 0 + nt_strata (nt_bgc + k,2) = 0 + enddo + + trcr_base1 = c0 + trcr_base2 = c1 + trcr_base3 = c0 + n_strata = 1 + nt_strata1 = nt_fbri + nt_strata2 = 0 + else ! nk = 1 + trcr_base1 = c1 + trcr_base2 = c0 + trcr_base3 = c0 + n_strata = 0 + nt_strata1 = 0 + nt_strata2 = 0 + endif ! nk + + do k = 1, nk ! in ice + trcr_depend (nt_bgc + k - 1 ) = nt_depend + trcr_base (nt_bgc + k - 1,1) = trcr_base1 + trcr_base (nt_bgc + k - 1,2) = trcr_base2 + trcr_base (nt_bgc + k - 1,3) = trcr_base3 + n_trcr_strata(nt_bgc + k - 1 ) = n_strata + nt_strata (nt_bgc + k - 1,1) = nt_strata1 + nt_strata (nt_bgc + k - 1,2) = nt_strata2 + enddo + + bio_index (nlt_bgc) = nt_bgc + + end subroutine init_bgc_trcr + +!======================================================================= + + end module ice_init_column + +!======================================================================= diff --git a/cicecore/drivers/unittest/opticep/ice_step_mod.F90 b/cicecore/drivers/unittest/opticep/ice_step_mod.F90 new file mode 100644 index 000000000..ac66255a4 --- /dev/null +++ b/cicecore/drivers/unittest/opticep/ice_step_mod.F90 @@ -0,0 +1,1784 @@ +!======================================================================= +! +! Contains CICE component driver routines common to all drivers. +! +! authors Elizabeth C. Hunke, LANL +! Philip W. Jones, LANL +! William H. Lipscomb, LANL +! +! 2008 ECH: created module by moving subroutines from drivers/cice4/ +! 2014 ECH: created column package + + module ice_step_mod + + use ice_kinds_mod + use ice_blocks, only: block, get_block + use ice_blocks, only: nx_block, ny_block + use ice_constants, only: c0, c1, c1000, c4, p25 + use ice_constants, only: field_loc_center, field_loc_NEcorner, & + field_loc_Nface, field_loc_Eface, & + field_type_scalar, field_type_vector + use ice_domain, only: halo_info, nblocks, blocks_ice + use ice_domain_size, only: max_blocks + use ice_exit, only: abort_ice + use ice_fileunits, only: nu_diag + use icepack_intfc, only: icepack_warnings_flush, icepack_warnings_aborted + use icepack_intfc, only: icepack_prep_radiation + use icepack_intfc, only: icepack_step_therm1 + use icepack_intfc, only: icepack_step_therm2 + use icepack_intfc, only: icepack_aggregate + use icepack_intfc, only: icepack_step_ridge + use icepack_intfc, only: icepack_step_wavefracture + use icepack_intfc, only: icepack_step_radiation + use icepack_intfc, only: icepack_ocn_mixed_layer, icepack_atm_boundary + use icepack_intfc, only: icepack_biogeochemistry, icepack_load_ocean_bio_array + use icepack_intfc, only: icepack_max_algae, icepack_max_nbtrcr, icepack_max_don + use icepack_intfc, only: icepack_max_doc, icepack_max_dic, icepack_max_aero + use icepack_intfc, only: icepack_max_fe, icepack_max_iso + use icepack_intfc, only: icepack_query_parameters + use icepack_intfc, only: icepack_query_tracer_flags, icepack_query_tracer_sizes + use icepack_intfc, only: icepack_query_tracer_indices + + implicit none + private + + public :: step_therm1, step_therm2, step_dyn_horiz, step_dyn_ridge, & + step_snow, prep_radiation, step_radiation, ocean_mixed_layer, & + update_state, biogeochemistry, step_dyn_wave, step_prep + + real (kind=dbl_kind), dimension (:,:,:), allocatable :: & + uvelT_icep, & ! uvel for wind stress computation in icepack + vvelT_icep ! vvel for wind stress computation in icepack + +!======================================================================= + + contains + +!======================================================================= + + subroutine save_init +! saves initial values for aice, aicen, vicen, vsnon + + use ice_state, only: aice, aicen, aice_init, aicen_init, & + vicen, vicen_init, vsnon, vsnon_init + + character(len=*), parameter :: subname = '(save_init)' + + !----------------------------------------------------------------- + ! Save the ice area passed to the coupler (so that history fields + ! can be made consistent with coupler fields). + ! Save the initial ice area and volume in each category. + !----------------------------------------------------------------- + + aice_init = aice + aicen_init = aicen + vicen_init = vicen + vsnon_init = vsnon + + end subroutine save_init + +!======================================================================= + + subroutine step_prep +! prep for step, called outside nblock loop + + use ice_flux, only: uatm, vatm, uatmT, vatmT + use ice_grid, only: grid_atm_dynu, grid_atm_dynv, grid_average_X2Y + use ice_state, only: uvel, vvel + + logical (kind=log_kind) :: & + highfreq ! highfreq flag + + logical (kind=log_kind), save :: & + first_call = .true. ! first call flag + + character(len=*), parameter :: subname = '(step_prep)' + + ! Save initial state + + call save_init + + ! Compute uatmT, vatmT + + call grid_average_X2Y('S',uatm,grid_atm_dynu,uatmT,'T') + call grid_average_X2Y('S',vatm,grid_atm_dynv,vatmT,'T') + + !----------------------------------------------------------------- + ! Compute uvelT_icep, vvelT_icep + !----------------------------------------------------------------- + + if (first_call) then + allocate(uvelT_icep(nx_block,ny_block,max_blocks)) + allocate(vvelT_icep(nx_block,ny_block,max_blocks)) + uvelT_icep = c0 + vvelT_icep = c0 + endif + + call icepack_query_parameters(highfreq_out=highfreq) + + if (highfreq) then + call grid_average_X2Y('A', uvel, 'U', uvelT_icep, 'T') + call grid_average_X2Y('A', vvel, 'U', vvelT_icep, 'T') + endif + + first_call = .false. + + end subroutine step_prep + +!======================================================================= +! +! Scales radiation fields computed on the previous time step. +! +! authors: Elizabeth Hunke, LANL + + subroutine prep_radiation (iblk) + + use ice_domain_size, only: ncat, nilyr, nslyr + use ice_flux, only: scale_factor, swvdr, swvdf, swidr, swidf, & + alvdr_ai, alvdf_ai, alidr_ai, alidf_ai, & + alvdr_init, alvdf_init, alidr_init, alidf_init + use ice_arrays_column, only: fswsfcn, fswintn, & + fswthrun, fswthrun_vdr, fswthrun_vdf, fswthrun_idr, fswthrun_idf, & + fswpenln, Sswabsn, Iswabsn + use ice_state, only: aice, aicen + use ice_timers, only: ice_timer_start, ice_timer_stop, timer_sw + + integer (kind=int_kind), intent(in) :: & + iblk ! block index + + ! local variables + + integer (kind=int_kind) :: & + ilo,ihi,jlo,jhi, & ! beginning and end of physical domain + i, j ! horizontal indices + + type (block) :: & + this_block ! block information for current block + + character(len=*), parameter :: subname = '(prep_radiation)' + + call ice_timer_start(timer_sw,iblk) ! shortwave + + alvdr_init(:,:,iblk) = c0 + alvdf_init(:,:,iblk) = c0 + alidr_init(:,:,iblk) = c0 + alidf_init(:,:,iblk) = c0 + + this_block = get_block(blocks_ice(iblk),iblk) + ilo = this_block%ilo + ihi = this_block%ihi + jlo = this_block%jlo + jhi = this_block%jhi + + !----------------------------------------------------------------- + ! Compute netsw scaling factor (new netsw / old netsw) + !----------------------------------------------------------------- + + do j = jlo, jhi + do i = ilo, ihi + + alvdr_init(i,j,iblk) = alvdr_ai(i,j,iblk) + alvdf_init(i,j,iblk) = alvdf_ai(i,j,iblk) + alidr_init(i,j,iblk) = alidr_ai(i,j,iblk) + alidf_init(i,j,iblk) = alidf_ai(i,j,iblk) + + call icepack_prep_radiation (ncat=ncat, nilyr=nilyr, nslyr=nslyr, & + scale_factor=scale_factor(i,j,iblk), & + aice = aice (i,j, iblk), aicen = aicen (i,j, :,iblk), & + swvdr = swvdr (i,j, iblk), swvdf = swvdf (i,j, iblk), & + swidr = swidr (i,j, iblk), swidf = swidf (i,j, iblk), & + alvdr_ai = alvdr_ai(i,j, iblk), alvdf_ai = alvdf_ai(i,j, iblk), & + alidr_ai = alidr_ai(i,j, iblk), alidf_ai = alidf_ai(i,j, iblk), & + fswsfcn = fswsfcn (i,j, :,iblk), fswintn = fswintn (i,j, :,iblk), & + fswthrun = fswthrun(i,j, :,iblk), & +!opt fswthrun_vdr = fswthrun_vdr(i,j, :,iblk), & +!opt fswthrun_vdf = fswthrun_vdf(i,j, :,iblk), & +!opt fswthrun_idr = fswthrun_idr(i,j, :,iblk), & +!opt fswthrun_idf = fswthrun_idf(i,j, :,iblk), & + fswpenln = fswpenln(i,j,:,:,iblk), & + Sswabsn = Sswabsn (i,j,:,:,iblk), Iswabsn = Iswabsn (i,j,:,:,iblk)) + + enddo ! i + enddo ! j + + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + + call ice_timer_stop(timer_sw,iblk) ! shortwave + + end subroutine prep_radiation + +!======================================================================= +! +! Driver for updating ice and snow internal temperatures and +! computing thermodynamic growth rates and coupler fluxes. +! +! authors: William H. Lipscomb, LANL + + subroutine step_therm1 (dt, iblk) + + use ice_arrays_column, only: ffracn, dhsn, & + Cdn_ocn, Cdn_ocn_skin, Cdn_ocn_floe, Cdn_ocn_keel, Cdn_atm_ratio, & + Cdn_atm, Cdn_atm_skin, Cdn_atm_floe, Cdn_atm_rdg, Cdn_atm_pond, & + hfreebd, hdraft, hridge, distrdg, hkeel, dkeel, lfloe, dfloe, & + fswsfcn, fswintn, Sswabsn, Iswabsn, meltsliqn, meltsliq, & + fswthrun, fswthrun_vdr, fswthrun_vdf, fswthrun_idr, fswthrun_idf + use ice_calendar, only: yday + use ice_domain_size, only: ncat, nilyr, nslyr, n_iso, n_aero + use ice_flux, only: frzmlt, sst, Tf, strocnxT_iavg, strocnyT_iavg, rside, fbot, Tbot, Tsnice, & + meltsn, melttn, meltbn, congeln, snoicen, uatmT, vatmT, fside, wlat, & + wind, rhoa, potT, Qa, zlvl, zlvs, strax, stray, flatn, fsensn, fsurfn, fcondtopn, & + flw, fsnow, fpond, sss, mlt_onset, frz_onset, fcondbotn, fcondbot, fsloss, & + frain, Tair, strairxT, strairyT, fsurf, fcondtop, fsens, & + flat, fswabs, flwout, evap, evaps, evapi, Tref, Qref, Uref, fresh, fsalt, fhocn, & + fswthru, fswthru_vdr, fswthru_vdf, fswthru_idr, fswthru_idf, & + meltt, melts, meltb, congel, snoice, & + flatn_f, fsensn_f, fsurfn_f, fcondtopn_f, & + send_i2x_per_cat, fswthrun_ai, dsnow + use ice_flux_bgc, only: dsnown, faero_atm, faero_ocn, fiso_atm, fiso_ocn, & + Qa_iso, Qref_iso, fiso_evap, HDO_ocn, H2_16O_ocn, H2_18O_ocn + use ice_grid, only: lmask_n, lmask_s, tmask + use ice_state, only: aice, aicen, aicen_init, vicen_init, & + vice, vicen, vsno, vsnon, trcrn, vsnon_init +#ifdef CICE_IN_NEMO + use ice_state, only: aice_init +#endif + +#ifdef CESMCOUPLED + use ice_prescribed_mod, only: prescribed_ice +#else + logical (kind=log_kind) :: & + prescribed_ice ! if .true., use prescribed ice instead of computed +#endif + real (kind=dbl_kind), intent(in) :: & + dt ! time step (s) + + integer (kind=int_kind), intent(in) :: & + iblk ! block index + + ! local variables +#ifdef CICE_IN_NEMO + real (kind=dbl_kind) :: & + raice ! reciprocal of ice concentration +#endif + integer (kind=int_kind) :: & + ilo,ihi,jlo,jhi, & ! beginning and end of physical domain + i, j , & ! horizontal indices + n , & ! thickness category index + k, kk ! indices for aerosols + + integer (kind=int_kind) :: & + ntrcr, nt_apnd, nt_hpnd, nt_ipnd, nt_alvl, nt_vlvl, nt_Tsfc, & + nt_iage, nt_FY, nt_qice, nt_sice, nt_aero, nt_qsno, & + nt_isosno, nt_isoice, nt_rsnw, nt_smice, nt_smliq + + logical (kind=log_kind) :: & + tr_iage, tr_FY, tr_iso, tr_aero, tr_pond, & + tr_pond_lvl, tr_pond_topo, calc_Tsfc, highfreq, tr_snow + + real (kind=dbl_kind) :: & + puny ! a very small number + + real (kind=dbl_kind), dimension(n_aero,2,ncat) :: & + aerosno, aeroice ! kg/m^2 + + real (kind=dbl_kind), dimension(n_iso,ncat) :: & + isosno, isoice ! kg/m^2 + + real (kind=dbl_kind), dimension(nslyr,ncat) :: & + rsnwn, smicen, smliqn + + type (block) :: & + this_block ! block information for current block + + character(len=*), parameter :: subname = '(step_therm1)' + + call icepack_query_parameters(puny_out=puny) + call icepack_query_parameters(calc_Tsfc_out=calc_Tsfc) + call icepack_query_parameters(highfreq_out=highfreq) + call icepack_query_tracer_sizes(ntrcr_out=ntrcr) + call icepack_query_tracer_flags( & + tr_iage_out=tr_iage, tr_FY_out=tr_FY, tr_iso_out=tr_iso, & + tr_aero_out=tr_aero, tr_pond_out=tr_pond, & + tr_pond_lvl_out=tr_pond_lvl, tr_pond_topo_out=tr_pond_topo, & + tr_snow_out=tr_snow) + call icepack_query_tracer_indices( & + nt_apnd_out=nt_apnd, nt_hpnd_out=nt_hpnd, nt_ipnd_out=nt_ipnd, & + nt_alvl_out=nt_alvl, nt_vlvl_out=nt_vlvl, nt_Tsfc_out=nt_Tsfc, & + nt_iage_out=nt_iage, nt_FY_out=nt_FY, & + nt_qice_out=nt_qice, nt_sice_out=nt_sice, & + nt_aero_out=nt_aero, nt_qsno_out=nt_qsno, & + nt_rsnw_out=nt_rsnw, nt_smice_out=nt_smice, nt_smliq_out=nt_smliq, & + nt_isosno_out=nt_isosno, nt_isoice_out=nt_isoice) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + +#ifndef CESMCOUPLED + prescribed_ice = .false. +#endif + + rsnwn (:,:) = c0 + smicen (:,:) = c0 + smliqn (:,:) = c0 + isoice (:,:) = c0 + aerosno(:,:,:) = c0 + aeroice(:,:,:) = c0 + +#ifdef CICE_IN_NEMO + do j = 1, ny_block + do i = 1, nx_block + + !--------------------------------------------------------------- + ! Scale frain and fsnow by ice concentration as these fields + ! are supplied by NEMO multiplied by ice concentration + !--------------------------------------------------------------- + + if (aice_init(i,j,iblk) > puny) then + raice = c1 / aice_init(i,j,iblk) + frain(i,j,iblk) = frain(i,j,iblk)*raice + fsnow(i,j,iblk) = fsnow(i,j,iblk)*raice + else + frain(i,j,iblk) = c0 + fsnow(i,j,iblk) = c0 + endif + + enddo ! i + enddo ! j +#endif + + 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 + + if (tr_snow) then + do n = 1, ncat + do k = 1, nslyr + rsnwn (k,n) = trcrn(i,j,nt_rsnw +k-1,n,iblk) + smicen(k,n) = trcrn(i,j,nt_smice+k-1,n,iblk) + smliqn(k,n) = trcrn(i,j,nt_smliq+k-1,n,iblk) + enddo + enddo + endif ! tr_snow + + if (tr_iso) then ! trcrn(nt_iso*) has units kg/m^3 + do n=1,ncat + do k=1,n_iso + isosno(k,n) = trcrn(i,j,nt_isosno+k-1,n,iblk) * vsnon_init(i,j,n,iblk) + isoice(k,n) = trcrn(i,j,nt_isoice+k-1,n,iblk) * vicen_init(i,j,n,iblk) + enddo + enddo + endif ! tr_iso + + if (tr_aero) then ! trcrn(nt_aero) has units kg/m^3 + do n=1,ncat + do k=1,n_aero + aerosno (k,:,n) = & + trcrn(i,j,nt_aero+(k-1)*4 :nt_aero+(k-1)*4+1,n,iblk) & + * vsnon_init(i,j,n,iblk) + aeroice (k,:,n) = & + trcrn(i,j,nt_aero+(k-1)*4+2:nt_aero+(k-1)*4+3,n,iblk) & + * vicen_init(i,j,n,iblk) + enddo + enddo + endif ! tr_aero + + if (tmask(i,j,iblk)) then + + call icepack_step_therm1(dt=dt, ncat=ncat, & + nilyr=nilyr, nslyr=nslyr, & + aicen_init = aicen_init (i,j,:,iblk), & + vicen_init = vicen_init (i,j,:,iblk), & + vsnon_init = vsnon_init (i,j,:,iblk), & + aice = aice (i,j, iblk), & + aicen = aicen (i,j,:,iblk), & + vice = vice (i,j, iblk), & + vicen = vicen (i,j,:,iblk), & + vsno = vsno (i,j, iblk), & + vsnon = vsnon (i,j,:,iblk), & + uvel = uvelT_icep (i,j, iblk), & + vvel = vvelT_icep (i,j, iblk), & + Tsfc = trcrn (i,j,nt_Tsfc,:,iblk), & + zqsn = trcrn (i,j,nt_qsno:nt_qsno+nslyr-1,:,iblk), & + zqin = trcrn (i,j,nt_qice:nt_qice+nilyr-1,:,iblk), & + zSin = trcrn (i,j,nt_sice:nt_sice+nilyr-1,:,iblk), & + alvl = trcrn (i,j,nt_alvl,:,iblk), & + vlvl = trcrn (i,j,nt_vlvl,:,iblk), & + apnd = trcrn (i,j,nt_apnd,:,iblk), & + hpnd = trcrn (i,j,nt_hpnd,:,iblk), & + ipnd = trcrn (i,j,nt_ipnd,:,iblk), & + iage = trcrn (i,j,nt_iage,:,iblk), & + FY = trcrn (i,j,nt_FY ,:,iblk), & +!opt rsnwn = rsnwn (:,:), & +!opt smicen = smicen (:,:), & +!opt smliqn = smliqn (:,:), & + aerosno = aerosno (:,:,:), & + aeroice = aeroice (:,:,:), & +!opt isosno = isosno (:,:), & +!opt isoice = isoice (:,:), & + uatm = uatmT (i,j, iblk), & + vatm = vatmT (i,j, iblk), & + wind = wind (i,j, iblk), & + zlvl = zlvl (i,j, iblk), & +!opt zlvs = zlvs (i,j, iblk), & + Qa = Qa (i,j, iblk), & +!opt Qa_iso = Qa_iso (i,j,:,iblk), & + rhoa = rhoa (i,j, iblk), & + Tair = Tair (i,j, iblk), & + Tref = Tref (i,j, iblk), & + Qref = Qref (i,j, iblk), & +!opt Qref_iso = Qref_iso (i,j,:,iblk), & + Uref = Uref (i,j, iblk), & + Cdn_atm_ratio= Cdn_atm_ratio(i,j, iblk), & + Cdn_ocn = Cdn_ocn (i,j, iblk), & + Cdn_ocn_skin = Cdn_ocn_skin(i,j, iblk), & + Cdn_ocn_floe = Cdn_ocn_floe(i,j, iblk), & + Cdn_ocn_keel = Cdn_ocn_keel(i,j, iblk), & + Cdn_atm = Cdn_atm (i,j, iblk), & + Cdn_atm_skin = Cdn_atm_skin(i,j, iblk), & + Cdn_atm_floe = Cdn_atm_floe(i,j, iblk), & + Cdn_atm_pond = Cdn_atm_pond(i,j, iblk), & + Cdn_atm_rdg = Cdn_atm_rdg (i,j, iblk), & + hfreebd = hfreebd (i,j, iblk), & + hdraft = hdraft (i,j, iblk), & + hridge = hridge (i,j, iblk), & + distrdg = distrdg (i,j, iblk), & + hkeel = hkeel (i,j, iblk), & + dkeel = dkeel (i,j, iblk), & + lfloe = lfloe (i,j, iblk), & + dfloe = dfloe (i,j, iblk), & + strax = strax (i,j, iblk), & + stray = stray (i,j, iblk), & + strairxT = strairxT (i,j, iblk), & + strairyT = strairyT (i,j, iblk), & + potT = potT (i,j, iblk), & + sst = sst (i,j, iblk), & + sss = sss (i,j, iblk), & + Tf = Tf (i,j, iblk), & + strocnxT = strocnxT_iavg(i,j, iblk), & + strocnyT = strocnyT_iavg(i,j, iblk), & + fbot = fbot (i,j, iblk), & + Tbot = Tbot (i,j, iblk), & + Tsnice = Tsnice (i,j, iblk), & + frzmlt = frzmlt (i,j, iblk), & + rside = rside (i,j, iblk), & + fside = fside (i,j, iblk), & +!opt wlat = wlat (i,j, iblk), & + fsnow = fsnow (i,j, iblk), & + frain = frain (i,j, iblk), & + fpond = fpond (i,j, iblk), & +!opt fsloss = fsloss (i,j, iblk), & + fsurf = fsurf (i,j, iblk), & + fsurfn = fsurfn (i,j,:,iblk), & + fcondtop = fcondtop (i,j, iblk), & + fcondtopn = fcondtopn (i,j,:,iblk), & + fcondbot = fcondbot (i,j, iblk), & + fcondbotn = fcondbotn (i,j,:,iblk), & + fswsfcn = fswsfcn (i,j,:,iblk), & + fswintn = fswintn (i,j,:,iblk), & + fswthrun = fswthrun (i,j,:,iblk), & +!opt fswthrun_vdr = fswthrun_vdr (i,j,:,iblk),& +!opt fswthrun_vdf = fswthrun_vdf (i,j,:,iblk),& +!opt fswthrun_idr = fswthrun_idr (i,j,:,iblk),& +!opt fswthrun_idf = fswthrun_idf (i,j,:,iblk),& + fswabs = fswabs (i,j, iblk), & + flwout = flwout (i,j, iblk), & + Sswabsn = Sswabsn (i,j,:,:,iblk), & + Iswabsn = Iswabsn (i,j,:,:,iblk), & + flw = flw (i,j, iblk), & + fsens = fsens (i,j, iblk), & + fsensn = fsensn (i,j,:,iblk), & + flat = flat (i,j, iblk), & + flatn = flatn (i,j,:,iblk), & + evap = evap (i,j, iblk), & + evaps = evaps (i,j, iblk), & + evapi = evapi (i,j, iblk), & + fresh = fresh (i,j, iblk), & + fsalt = fsalt (i,j, iblk), & + fhocn = fhocn (i,j, iblk), & + fswthru = fswthru (i,j, iblk), & +!opt fswthru_vdr = fswthru_vdr (i,j, iblk), & +!opt fswthru_vdf = fswthru_vdf (i,j, iblk), & +!opt fswthru_idr = fswthru_idr (i,j, iblk), & +!opt fswthru_idf = fswthru_idf (i,j, iblk), & + flatn_f = flatn_f (i,j,:,iblk), & + fsensn_f = fsensn_f (i,j,:,iblk), & + fsurfn_f = fsurfn_f (i,j,:,iblk), & + fcondtopn_f = fcondtopn_f (i,j,:,iblk), & + faero_atm = faero_atm (i,j,1:n_aero,iblk), & + faero_ocn = faero_ocn (i,j,1:n_aero,iblk), & +!opt fiso_atm = fiso_atm (i,j,:,iblk), & +!opt fiso_ocn = fiso_ocn (i,j,:,iblk), & +!opt fiso_evap = fiso_evap (i,j,:,iblk), & +!opt HDO_ocn = HDO_ocn (i,j, iblk), & +!opt H2_16O_ocn = H2_16O_ocn (i,j, iblk), & +!opt H2_18O_ocn = H2_18O_ocn (i,j, iblk), & + dhsn = dhsn (i,j,:,iblk), & + ffracn = ffracn (i,j,:,iblk), & + meltt = meltt (i,j, iblk), & + melttn = melttn (i,j,:,iblk), & + meltb = meltb (i,j, iblk), & + meltbn = meltbn (i,j,:,iblk), & + melts = melts (i,j, iblk), & + meltsn = meltsn (i,j,:,iblk), & + congel = congel (i,j, iblk), & + congeln = congeln (i,j,:,iblk), & + snoice = snoice (i,j, iblk), & + snoicen = snoicen (i,j,:,iblk), & +!opt dsnow = dsnow (i,j, iblk), & + dsnown = dsnown (i,j,:,iblk), & +!opt meltsliq = meltsliq (i,j, iblk), & +!opt meltsliqn = meltsliqn (i,j,:,iblk), & + lmask_n = lmask_n (i,j, iblk), & + lmask_s = lmask_s (i,j, iblk), & + mlt_onset = mlt_onset (i,j, iblk), & + frz_onset = frz_onset (i,j, iblk), & + yday=yday & +!opt prescribed_ice=prescribed_ice, & + ) + + !----------------------------------------------------------------- + ! handle per-category i2x fields, no merging + !----------------------------------------------------------------- + + if (send_i2x_per_cat) then + do n = 1, ncat + ! TODO (mvertens, 2018-12-22): do we need to add the band separated quantities + ! for MOM6 here also? + + fswthrun_ai(i,j,n,iblk) = fswthrun(i,j,n,iblk)*aicen_init(i,j,n,iblk) + enddo ! ncat + endif + + endif + + if (tr_snow) then + do n = 1, ncat + do k = 1, nslyr + trcrn(i,j,nt_rsnw +k-1,n,iblk) = rsnwn (k,n) + trcrn(i,j,nt_smice+k-1,n,iblk) = smicen(k,n) + trcrn(i,j,nt_smliq+k-1,n,iblk) = smliqn(k,n) + enddo + enddo + endif ! tr_snow + + if (tr_iso) then + do n = 1, ncat + if (vicen(i,j,n,iblk) > puny) & + isoice(:,n) = isoice(:,n)/vicen(i,j,n,iblk) + if (vsnon(i,j,n,iblk) > puny) & + isosno(:,n) = isosno(:,n)/vsnon(i,j,n,iblk) + do k = 1, n_iso + trcrn(i,j,nt_isosno+k-1,n,iblk) = isosno(k,n) + trcrn(i,j,nt_isoice+k-1,n,iblk) = isoice(k,n) + enddo + enddo + endif ! tr_iso + + if (tr_aero) then + do n = 1, ncat + if (vicen(i,j,n,iblk) > puny) & + aeroice(:,:,n) = aeroice(:,:,n)/vicen(i,j,n,iblk) + if (vsnon(i,j,n,iblk) > puny) & + aerosno(:,:,n) = aerosno(:,:,n)/vsnon(i,j,n,iblk) + do k = 1, n_aero + do kk = 1, 2 + trcrn(i,j,nt_aero+(k-1)*4+kk-1,n,iblk)=aerosno(k,kk,n) + trcrn(i,j,nt_aero+(k-1)*4+kk+1,n,iblk)=aeroice(k,kk,n) + enddo + enddo + enddo + endif ! tr_aero + + enddo ! i + enddo ! j + + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + + end subroutine step_therm1 + +!======================================================================= +! Driver for thermodynamic changes not needed for coupling: +! transport in thickness space, lateral growth and melting. +! +! authors: William H. Lipscomb, LANL +! Elizabeth C. Hunke, LANL + + subroutine step_therm2 (dt, iblk) + + use ice_arrays_column, only: hin_max, fzsal, ocean_bio, wave_sig_ht, & + wave_spectrum, wavefreq, dwavefreq, & + first_ice, bgrid, cgrid, igrid, floe_rad_c, floe_binwidth, & + d_afsd_latg, d_afsd_newi, d_afsd_latm, d_afsd_weld + use ice_calendar, only: yday + use ice_domain_size, only: ncat, nilyr, nslyr, nblyr, nfsd + use ice_flux, only: fresh, frain, fpond, frzmlt, frazil, frz_onset, & + update_ocn_f, fsalt, Tf, sss, salinz, fhocn, rside, fside, wlat, & + meltl, frazil_diag + use ice_flux_bgc, only: flux_bio, faero_ocn, & + fiso_ocn, HDO_ocn, H2_16O_ocn, H2_18O_ocn + use ice_grid, only: tmask + use ice_state, only: aice, aicen, aice0, trcr_depend, & + aicen_init, vicen_init, trcrn, vicen, vsnon, & + trcr_base, n_trcr_strata, nt_strata + + real (kind=dbl_kind), intent(in) :: & + dt ! time step + + integer (kind=int_kind), intent(in) :: & + iblk ! block index + + ! local variables + + integer (kind=int_kind) :: & + ilo,ihi,jlo,jhi, & ! beginning and end of physical domain + i, j ! horizontal indices + + integer (kind=int_kind) :: & + ntrcr, nbtrcr, nltrcr + + logical (kind=log_kind) :: & + tr_fsd, & ! floe size distribution tracers + z_tracers, & ! vertical biogeochemistry + solve_zsal ! zsalinity + + type (block) :: & + this_block ! block information for current block + + character(len=*), parameter :: subname = '(step_therm2)' + + call icepack_query_parameters(z_tracers_out=z_tracers,solve_zsal_out=solve_zsal) + call icepack_query_tracer_sizes(ntrcr_out=ntrcr, nbtrcr_out=nbtrcr) + call icepack_query_tracer_flags(tr_fsd_out=tr_fsd) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + + ! nltrcr is only used as a zbgc flag in icepack (number of zbgc tracers > 0) + if (z_tracers .or. solve_zsal) then + nltrcr = 1 + else + nltrcr = 0 + endif + + 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 + + if (tmask(i,j,iblk)) then + + ! significant wave height for FSD + if (tr_fsd) & + wave_sig_ht(i,j,iblk) = c4*SQRT(SUM(wave_spectrum(i,j,:,iblk)*dwavefreq(:))) + + call icepack_step_therm2(dt=dt, ncat=ncat, & + nltrcr=nltrcr, nilyr=nilyr, nslyr=nslyr, nblyr=nblyr, & + hin_max = hin_max (:), & + aicen = aicen (i,j,:,iblk), & + vicen = vicen (i,j,:,iblk), & + vsnon = vsnon (i,j,:,iblk), & + aicen_init = aicen_init(i,j,:,iblk), & + vicen_init = vicen_init(i,j,:,iblk), & + trcrn = trcrn (i,j,:,:,iblk), & + aice0 = aice0 (i,j, iblk), & + aice = aice (i,j, iblk), & + trcr_depend= trcr_depend(:), & + trcr_base = trcr_base(:,:), & + n_trcr_strata = n_trcr_strata(:), & + nt_strata = nt_strata(:,:), & + Tf = Tf (i,j, iblk), & + sss = sss (i,j, iblk), & + salinz = salinz (i,j,:,iblk), & + rside = rside (i,j, iblk), & + meltl = meltl (i,j, iblk), & + fside = fside (i,j, iblk), & +!opt wlat = wlat (i,j, iblk), & + frzmlt = frzmlt (i,j, iblk), & + frazil = frazil (i,j, iblk), & + frain = frain (i,j, iblk), & + fpond = fpond (i,j, iblk), & + fresh = fresh (i,j, iblk), & + fsalt = fsalt (i,j, iblk), & + fhocn = fhocn (i,j, iblk), & + update_ocn_f = update_ocn_f, & + bgrid = bgrid, & + cgrid = cgrid, & + igrid = igrid, & + faero_ocn = faero_ocn (i,j,:,iblk), & + first_ice = first_ice (i,j,:,iblk), & + fzsal = fzsal (i,j, iblk), & + flux_bio = flux_bio (i,j,1:nbtrcr,iblk), & + ocean_bio = ocean_bio (i,j,1:nbtrcr,iblk), & + frazil_diag= frazil_diag(i,j,iblk) & +!opt frz_onset = frz_onset (i,j, iblk), & +!opt yday = yday, & +!opt fiso_ocn = fiso_ocn (i,j,:,iblk), & +!opt HDO_ocn = HDO_ocn (i,j, iblk), & +!opt H2_16O_ocn = H2_16O_ocn(i,j, iblk), & +!opt H2_18O_ocn = H2_18O_ocn(i,j, iblk), & +!opt nfsd = nfsd, & +!opt wave_sig_ht= wave_sig_ht(i,j,iblk), & +!opt wave_spectrum = wave_spectrum(i,j,:,iblk), & +!opt wavefreq = wavefreq(:), & +!opt dwavefreq = dwavefreq(:), & +!opt d_afsd_latg= d_afsd_latg(i,j,:,iblk),& +!opt d_afsd_newi= d_afsd_newi(i,j,:,iblk),& +!opt d_afsd_latm= d_afsd_latm(i,j,:,iblk),& +!opt d_afsd_weld= d_afsd_weld(i,j,:,iblk),& +!opt floe_rad_c = floe_rad_c(:), & +!opt floe_binwidth = floe_binwidth(:) & + ) + endif ! tmask + + enddo ! i + enddo ! j + + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + + end subroutine step_therm2 + +!======================================================================= +! +! finalize thermo updates +! +! authors: Elizabeth Hunke, LANL + + subroutine update_state (dt, daidt, dvidt, dagedt, offset) + + use ice_domain_size, only: ncat +! use ice_grid, only: tmask + use ice_state, only: aicen, trcrn, vicen, vsnon, & + aice, trcr, vice, vsno, aice0, trcr_depend, & + bound_state, trcr_base, nt_strata, n_trcr_strata + use ice_timers, only: ice_timer_start, ice_timer_stop, timer_bound, timer_updstate + + real (kind=dbl_kind), intent(in) :: & + dt ! time step + + real (kind=dbl_kind), dimension(:,:,:), intent(inout), optional :: & + daidt, & ! change in ice area per time step + dvidt, & ! change in ice volume per time step + dagedt ! change in ice age per time step + + real (kind=dbl_kind), intent(in), optional :: & + offset ! d(age)/dt time offset = dt for thermo, 0 for dyn + + integer (kind=int_kind) :: & + iblk, & ! block index + i,j, & ! horizontal indices + ntrcr, & ! + nt_iage ! + + logical (kind=log_kind) :: & + tr_iage ! + + character(len=*), parameter :: subname='(update_state)' + + call ice_timer_start(timer_updstate) + call icepack_query_tracer_flags(tr_iage_out=tr_iage) + call icepack_query_tracer_sizes(ntrcr_out=ntrcr) + call icepack_query_tracer_indices(nt_iage_out=nt_iage) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + + !------------------------------------------------------------------- + ! Ghost cell updates for state variables. + !------------------------------------------------------------------- + + call ice_timer_start(timer_bound) + call bound_state (aicen, & + vicen, vsnon, & + ntrcr, trcrn) + call ice_timer_stop(timer_bound) + + !$OMP PARALLEL DO PRIVATE(iblk,i,j) SCHEDULE(runtime) + do iblk = 1, nblocks + do j = 1, ny_block + do i = 1, nx_block + + !----------------------------------------------------------------- + ! Aggregate the updated state variables (includes ghost cells). + !----------------------------------------------------------------- + +! if (tmask(i,j,iblk)) & + call icepack_aggregate(ncat = ncat, & + aicen = aicen(i,j,:,iblk), & + trcrn = trcrn(i,j,:,:,iblk), & + vicen = vicen(i,j,:,iblk), & + vsnon = vsnon(i,j,:,iblk), & + aice = aice (i,j, iblk), & + trcr = trcr (i,j,:,iblk), & + vice = vice (i,j, iblk), & + vsno = vsno (i,j, iblk), & + aice0 = aice0(i,j, iblk), & + ntrcr = ntrcr, & + trcr_depend = trcr_depend(:), & + trcr_base = trcr_base(:,:), & + n_trcr_strata = n_trcr_strata(:), & + nt_strata = nt_strata(:,:)) + + if (present(offset)) then + + !----------------------------------------------------------------- + ! Compute thermodynamic area and volume tendencies. + !----------------------------------------------------------------- + + daidt(i,j,iblk) = (aice(i,j,iblk) - daidt(i,j,iblk)) / dt + dvidt(i,j,iblk) = (vice(i,j,iblk) - dvidt(i,j,iblk)) / dt + if (tr_iage) then + if (offset > c0) then ! thermo + if (trcr(i,j,nt_iage,iblk) > c0) & + dagedt(i,j,iblk) = (trcr(i,j,nt_iage,iblk) & + - dagedt(i,j,iblk) - offset) / dt + else ! dynamics + dagedt(i,j,iblk) = (trcr(i,j,nt_iage,iblk) & + - dagedt(i,j,iblk)) / dt + endif + endif ! tr_iage + endif ! present(offset) + + enddo ! i + enddo ! j + enddo ! iblk + !$OMP END PARALLEL DO + + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + call ice_timer_stop(timer_updstate) + + end subroutine update_state + +!======================================================================= +! +! Run one time step of wave-fracturing the floe size distribution +! +! authors: Lettie Roach, NIWA +! Elizabeth C. Hunke, LANL + + subroutine step_dyn_wave (dt) + + use ice_arrays_column, only: wave_spectrum, & + d_afsd_wave, floe_rad_l, floe_rad_c, wavefreq, dwavefreq + use ice_domain_size, only: ncat, nfsd, nfreq + use ice_state, only: trcrn, aicen, aice, vice + use ice_timers, only: ice_timer_start, ice_timer_stop, timer_column, & + timer_fsd + + real (kind=dbl_kind), intent(in) :: & + dt ! time step + + ! local variables + + type (block) :: & + this_block ! block information for current block + + integer (kind=int_kind) :: & + ilo,ihi,jlo,jhi, & ! beginning and end of physical domain + iblk, & ! block index + i, j ! horizontal indices + + character (len=char_len) :: wave_spec_type + + character(len=*), parameter :: subname = '(step_dyn_wave)' + + call ice_timer_start(timer_column) + call ice_timer_start(timer_fsd) + + call icepack_query_parameters(wave_spec_type_out=wave_spec_type) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + + !$OMP PARALLEL DO PRIVATE(iblk,i,j,ilo,ihi,jlo,jhi,this_block) + 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 + d_afsd_wave(i,j,:,iblk) = c0 + call icepack_step_wavefracture (wave_spec_type, & + dt, ncat, nfsd, nfreq, & + aice (i,j, iblk), & + vice (i,j, iblk), & + aicen (i,j,:, iblk), & + floe_rad_l(:), floe_rad_c(:), & + wave_spectrum (i,j,:, iblk), & + wavefreq(:), dwavefreq(:), & + trcrn (i,j,:,:,iblk), & + d_afsd_wave (i,j,:, iblk)) + end do ! i + end do ! j + end do ! iblk + !$OMP END PARALLEL DO + + call ice_timer_stop(timer_fsd) + call ice_timer_stop(timer_column) + + end subroutine step_dyn_wave + +!======================================================================= +! +! Run one time step of dynamics and horizontal transport. +! NOTE: The evp and transport modules include boundary updates, so +! they cannot be done inside a single block loop. +! +! authors: William H. Lipscomb, LANL +! Elizabeth C. Hunke, LANL + + subroutine step_dyn_horiz (dt) + + use ice_boundary, only: ice_HaloUpdate + use ice_dyn_evp, only: evp + use ice_dyn_eap, only: eap + use ice_dyn_vp, only: implicit_solver + use ice_dyn_shared, only: kdyn + use ice_flux, only: strocnxU, strocnyU, strocnxT_iavg, strocnyT_iavg + use ice_flux, only: init_history_dyn + use ice_grid, only: grid_average_X2Y + use ice_state, only: aiU + use ice_transport_driver, only: advection, transport_upwind, transport_remap + + real (kind=dbl_kind), intent(in) :: & + dt ! dynamics time step + + ! local variables + + type (block) :: & + this_block ! block information for current block + + integer (kind=int_kind) :: & + ilo,ihi,jlo,jhi, & ! beginning and end of physical domain + iblk, & ! block index + i, j ! horizontal indices + + real (kind=dbl_kind), dimension (nx_block,ny_block,max_blocks) :: & + work1, & ! temporary + work2 ! temporary + + character(len=*), parameter :: subname = '(step_dyn_horiz)' + + call init_history_dyn ! initialize dynamic history variables + + !----------------------------------------------------------------- + ! Ice dynamics (momentum equation) + !----------------------------------------------------------------- + + if (kdyn == 1) call evp (dt) + if (kdyn == 2) call eap (dt) + if (kdyn == 3) call implicit_solver (dt) + + !----------------------------------------------------------------- + ! Compute strocnxT_iavg, strocnyT_iavg for thermo and coupling + !----------------------------------------------------------------- + + ! strocn computed on U, N, E as needed. Map strocn U divided by aiU to T + ! conservation requires aiU be divided before averaging + work1 = c0 + work2 = c0 + !$OMP PARALLEL DO PRIVATE(iblk,i,j,ilo,ihi,jlo,jhi,this_block) + 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 + if (aiU(i,j,iblk) /= c0) then + work1(i,j,iblk) = strocnxU(i,j,iblk)/aiU(i,j,iblk) + work2(i,j,iblk) = strocnyU(i,j,iblk)/aiU(i,j,iblk) + endif + enddo + enddo + enddo + !$OMP END PARALLEL DO + call ice_HaloUpdate (work1, halo_info, & + field_loc_NEcorner, field_type_vector) + call ice_HaloUpdate (work2, halo_info, & + field_loc_NEcorner, field_type_vector) + call grid_average_X2Y('F', work1, 'U', strocnxT_iavg, 'T') ! shift + call grid_average_X2Y('F', work2, 'U', strocnyT_iavg, 'T') + + !----------------------------------------------------------------- + ! Horizontal ice transport + !----------------------------------------------------------------- + + if (advection == 'upwind') then + call transport_upwind (dt) ! upwind + elseif (advection == 'remap') then + call transport_remap (dt) ! incremental remapping + endif + + end subroutine step_dyn_horiz + +!======================================================================= +! +! Run one time step of ridging. +! +! authors: William H. Lipscomb, LANL +! Elizabeth C. Hunke, LANL + + subroutine step_dyn_ridge (dt, ndtd, iblk) + + use ice_arrays_column, only: hin_max, fzsal, first_ice + use ice_domain_size, only: ncat, nilyr, nslyr, n_aero, nblyr + use ice_flux, only: & + rdg_conv, rdg_shear, dardg1dt, dardg2dt, & + dvirdgdt, opening, fpond, fresh, fhocn, & + aparticn, krdgn, aredistn, vredistn, dardg1ndt, dardg2ndt, & + dvirdgndt, araftn, vraftn, fsalt + use ice_flux_bgc, only: flux_bio, faero_ocn, fiso_ocn + use ice_grid, only: tmask + use ice_state, only: trcrn, vsnon, aicen, vicen, & + aice, aice0, trcr_depend, n_trcr_strata, & + trcr_base, nt_strata + use ice_timers, only: ice_timer_start, ice_timer_stop, timer_column, & + timer_ridge + + real (kind=dbl_kind), intent(in) :: & + dt ! time step + + integer (kind=int_kind), intent(in) :: & + ndtd, & ! number of dynamics subcycles + iblk ! block index + + ! local variables + + type (block) :: & + this_block ! block information for current block + + integer (kind=int_kind) :: & + ilo,ihi,jlo,jhi, & ! beginning and end of physical domain + i, j, & ! horizontal indices + ntrcr, & ! + nbtrcr ! + + character(len=*), parameter :: subname = '(step_dyn_ridge)' + + !----------------------------------------------------------------- + ! Ridging + !----------------------------------------------------------------- + + call ice_timer_start(timer_column,iblk) + call ice_timer_start(timer_ridge,iblk) + + call icepack_query_tracer_sizes(ntrcr_out=ntrcr, nbtrcr_out=nbtrcr) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + + 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 + +!echmod: this changes the answers, continue using tmask for now +! call aggregate_area (ncat, aicen(i,j,:,iblk), atmp, atmp0) +! if (atmp > c0) then + + if (tmask(i,j,iblk)) then + + call icepack_step_ridge (dt=dt, ndtd=ndtd, & + nilyr=nilyr, nslyr=nslyr, nblyr=nblyr, & + ncat=ncat, n_aero=n_aero, hin_max=hin_max(:), & + trcr_depend = trcr_depend (:), & + trcr_base = trcr_base (:,:), & + n_trcr_strata = n_trcr_strata(:), & + nt_strata = nt_strata (:,:), & + trcrn = trcrn (i,j,:,:,iblk), & + rdg_conv = rdg_conv (i,j, iblk), & + rdg_shear = rdg_shear(i,j, iblk), & + aicen = aicen (i,j,:,iblk), & + vicen = vicen (i,j,:,iblk), & + vsnon = vsnon (i,j,:,iblk), & + aice0 = aice0 (i,j, iblk), & + dardg1dt = dardg1dt (i,j, iblk), & + dardg2dt = dardg2dt (i,j, iblk), & + dvirdgdt = dvirdgdt (i,j, iblk), & + opening = opening (i,j, iblk), & + fpond = fpond (i,j, iblk), & + fresh = fresh (i,j, iblk), & + fhocn = fhocn (i,j, iblk), & + faero_ocn = faero_ocn(i,j,:,iblk), & +!opt fiso_ocn = fiso_ocn (i,j,:,iblk), & + aparticn = aparticn (i,j,:,iblk), & + krdgn = krdgn (i,j,:,iblk), & + aredistn = aredistn (i,j,:,iblk), & + vredistn = vredistn (i,j,:,iblk), & + dardg1ndt = dardg1ndt(i,j,:,iblk), & + dardg2ndt = dardg2ndt(i,j,:,iblk), & + dvirdgndt = dvirdgndt(i,j,:,iblk), & + araftn = araftn (i,j,:,iblk), & + vraftn = vraftn (i,j,:,iblk), & + aice = aice (i,j, iblk), & + fsalt = fsalt (i,j, iblk), & + first_ice = first_ice(i,j,:,iblk), & + fzsal = fzsal (i,j, iblk), & + flux_bio = flux_bio (i,j,1:nbtrcr,iblk)) + + endif ! tmask + + enddo ! i + enddo ! j + + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + + call ice_timer_stop(timer_ridge,iblk) + call ice_timer_stop(timer_column,iblk) + + end subroutine step_dyn_ridge + +!======================================================================= +! +! Updates snow tracers +! +! authors: Elizabeth C. Hunke, LANL +! Nicole Jeffery, LANL + + subroutine step_snow (dt, iblk) + + use ice_calendar, only: nstreams + use ice_domain_size, only: ncat, nslyr, nilyr + use ice_flux, only: snwcnt, wind, fresh, fhocn, fsloss, fsnow + use ice_state, only: trcrn, vsno, vsnon, vicen, aicen, aice + use icepack_intfc, only: icepack_step_snow + + real (kind=dbl_kind), intent(in) :: & + dt ! time step + + integer (kind=int_kind), intent(in) :: & + iblk ! block index + + ! local variables + + integer (kind=int_kind) :: & + nt_smice, nt_smliq, nt_rsnw, & + nt_Tsfc, nt_qice, nt_sice, nt_qsno, & + nt_alvl, nt_vlvl, nt_rhos + + integer (kind=int_kind) :: & + ilo,ihi,jlo,jhi, & ! beginning and end of physical domain + i, j, & ! horizontal indices + ns ! history streams index + + real (kind=dbl_kind) :: & + puny + + real (kind=dbl_kind) :: & + fhs ! flag for presence of snow + + character(len=*), parameter :: subname = '(step_snow)' + + type (block) :: & + this_block ! block information for current block + + this_block = get_block(blocks_ice(iblk),iblk) + ilo = this_block%ilo + ihi = this_block%ihi + jlo = this_block%jlo + jhi = this_block%jhi + + !----------------------------------------------------------------- + ! query icepack values + !----------------------------------------------------------------- + + call icepack_query_parameters(puny_out=puny) + call icepack_query_tracer_indices( & + nt_smice_out=nt_smice, nt_smliq_out=nt_smliq, & + nt_rsnw_out=nt_rsnw, nt_Tsfc_out=nt_Tsfc, & + nt_qice_out=nt_qice, nt_sice_out=nt_sice, nt_qsno_out=nt_qsno, & + nt_alvl_out=nt_alvl, nt_vlvl_out=nt_vlvl, nt_rhos_out=nt_rhos) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + + !----------------------------------------------------------------- + ! Snow redistribution and metamorphosis + !----------------------------------------------------------------- + + do j = jlo, jhi + do i = ilo, ihi + + call icepack_step_snow (dt, nilyr, & + nslyr, ncat, & + wind (i,j, iblk), & + aice (i,j, iblk), & + aicen(i,j,:,iblk), & + vicen(i,j,:,iblk), & + vsnon(i,j,:,iblk), & + trcrn(i,j,nt_Tsfc,:,iblk), & + trcrn(i,j,nt_qice,:,iblk), & ! top layer only + trcrn(i,j,nt_sice,:,iblk), & ! top layer only + trcrn(i,j,nt_qsno:nt_qsno+nslyr-1,:,iblk), & + trcrn(i,j,nt_alvl,:,iblk), & + trcrn(i,j,nt_vlvl,:,iblk), & + trcrn(i,j,nt_smice:nt_smice+nslyr-1,:,iblk), & + trcrn(i,j,nt_smliq:nt_smliq+nslyr-1,:,iblk), & + trcrn(i,j,nt_rsnw:nt_rsnw+nslyr-1,:,iblk), & + trcrn(i,j,nt_rhos:nt_rhos+nslyr-1,:,iblk), & + fresh (i,j,iblk), & + fhocn (i,j,iblk), & + fsloss (i,j,iblk), & + fsnow (i,j,iblk)) + enddo + enddo + + ! increment counter for history averaging + do j = jlo, jhi + do i = ilo, ihi + fhs = c0 + if (vsno(i,j,iblk) > puny) fhs = c1 + do ns = 1, nstreams + snwcnt(i,j,iblk,ns) = snwcnt(i,j,iblk,ns) + fhs + enddo + enddo + enddo + + end subroutine step_snow + +!======================================================================= +! +! Computes radiation fields +! +! authors: William H. Lipscomb, LANL +! David Bailey, NCAR +! Elizabeth C. Hunke, LANL + + subroutine step_radiation (dt, iblk) + + use ice_arrays_column, only: ffracn, dhsn, & + fswsfcn, fswintn, fswpenln, Sswabsn, Iswabsn, & + fswthrun, fswthrun_vdr, fswthrun_vdf, fswthrun_idr, fswthrun_idf, & + albicen, albsnon, albpndn, & + alvdrn, alidrn, alvdfn, alidfn, apeffn, trcrn_sw, snowfracn, & + kaer_tab, waer_tab, gaer_tab, kaer_bc_tab, waer_bc_tab, & + gaer_bc_tab, bcenh, swgrid, igrid + use ice_calendar, only: calendar_type, days_per_year, nextsw_cday, yday, msec + use ice_domain_size, only: ncat, n_aero, nilyr, nslyr, n_zaero, n_algae, nblyr + use ice_flux, only: swvdr, swvdf, swidr, swidf, coszen, fsnow + use ice_grid, only: TLAT, TLON, tmask + use ice_state, only: aicen, vicen, vsnon, trcrn + use ice_timers, only: ice_timer_start, ice_timer_stop, timer_sw + use ice_communicate, only: my_task + use ice_diagnostics, only: npnt, print_points, pmloc, piloc, pjloc + + real (kind=dbl_kind), intent(in) :: & + dt ! time step + + integer (kind=int_kind), intent(in) :: & + iblk ! block index + + ! local variables + + integer (kind=int_kind) :: & + ilo,ihi,jlo,jhi, & ! beginning and end of physical domain + i, j, n, k, & ! horizontal indices + ipoint ! index for print diagnostic + + type (block) :: & + this_block ! block information for current block + + integer (kind=int_kind) :: & + nt_Tsfc, nt_alvl, nt_rsnw, & + nt_apnd, nt_hpnd, nt_ipnd, nt_aero, nlt_chl_sw, & + ntrcr, nbtrcr, nbtrcr_sw, nt_fbri + + integer (kind=int_kind), dimension(icepack_max_algae) :: & + nt_bgc_N + + integer (kind=int_kind), dimension(icepack_max_aero) :: & + nlt_zaero_sw, nt_zaero + + logical (kind=log_kind) :: & + tr_bgc_N, tr_zaero, tr_brine, dEdd_algae, modal_aero, snwgrain + + real (kind=dbl_kind), dimension(ncat) :: & + fbri ! brine height to ice thickness + + real(kind= dbl_kind), dimension(:,:), allocatable :: & + ztrcr_sw, & ! zaerosols (kg/m^3) and chla (mg/m^3) + rsnow ! snow grain radius tracer (10^-6 m) + + logical (kind=log_kind) :: & + debug, & ! flag for printing debugging information + l_print_point ! flag for printing debugging information + + character(len=*), parameter :: subname = '(step_radiation)' + + call ice_timer_start(timer_sw,iblk) ! shortwave + + call icepack_query_tracer_sizes(ntrcr_out=ntrcr, & + nbtrcr_out=nbtrcr, nbtrcr_sw_out=nbtrcr_sw) + call icepack_query_tracer_flags( & + tr_brine_out=tr_brine, tr_bgc_N_out=tr_bgc_N, tr_zaero_out=tr_zaero) + call icepack_query_tracer_indices( & + nt_Tsfc_out=nt_Tsfc, nt_alvl_out=nt_alvl, nt_rsnw_out=nt_rsnw, & + nt_apnd_out=nt_apnd, nt_hpnd_out=nt_hpnd, nt_ipnd_out=nt_ipnd, nt_aero_out=nt_aero, & + nlt_chl_sw_out=nlt_chl_sw, nlt_zaero_sw_out=nlt_zaero_sw, & + nt_fbri_out=nt_fbri, nt_zaero_out=nt_zaero, nt_bgc_N_out=nt_bgc_N) + call icepack_query_parameters(dEdd_algae_out=dEdd_algae, modal_aero_out=modal_aero, & + snwgrain_out=snwgrain) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + + allocate(ztrcr_sw(nbtrcr_sw,ncat)) + allocate(rsnow(nslyr,ncat)) + + 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 + + l_print_point = .false. + debug = .false. + if (debug .and. print_points) then + do ipoint = 1, npnt + if (my_task == pmloc(ipoint) .and. & + i == piloc(ipoint) .and. & + j == pjloc(ipoint)) & + l_print_point = .true. + write (nu_diag, *) 'my_task = ',my_task + enddo ! ipoint + endif + fbri (:) = c0 + ztrcr_sw(:,:) = c0 + rsnow (:,:) = c0 + do n = 1, ncat + if (tr_brine) fbri(n) = trcrn(i,j,nt_fbri,n,iblk) + if (snwgrain) then + do k = 1, nslyr + rsnow(k,n) = trcrn(i,j,nt_rsnw+k-1,n,iblk) + enddo + endif + enddo + + if (tmask(i,j,iblk)) then + + call icepack_step_radiation (dt=dt, ncat=ncat, & + nblyr=nblyr, nilyr=nilyr, nslyr=nslyr, & + dEdd_algae=dEdd_algae, & + swgrid=swgrid(:), igrid=igrid(:), & + fbri=fbri(:), & + aicen=aicen(i,j, :,iblk), & + vicen=vicen(i,j, :,iblk), & + vsnon=vsnon(i,j, :,iblk), & + Tsfcn=trcrn(i,j,nt_Tsfc,:,iblk), & + alvln=trcrn(i,j,nt_alvl,:,iblk), & + apndn=trcrn(i,j,nt_apnd,:,iblk), & + hpndn=trcrn(i,j,nt_hpnd,:,iblk), & + ipndn=trcrn(i,j,nt_ipnd,:,iblk), & + aeron=trcrn(i,j,nt_aero:nt_aero+4*n_aero-1,:,iblk), & + bgcNn=trcrn(i,j,nt_bgc_N(1):nt_bgc_N(1)+n_algae*(nblyr+3)-1,:,iblk), & + zaeron=trcrn(i,j,nt_zaero(1):nt_zaero(1)+n_zaero*(nblyr+3)-1,:,iblk), & + trcrn_bgcsw=ztrcr_sw, & + TLAT=TLAT(i,j,iblk), TLON=TLON(i,j,iblk), & + calendar_type=calendar_type, & + days_per_year=days_per_year, & + nextsw_cday=nextsw_cday, yday=yday, & + sec=msec, & + kaer_tab=kaer_tab, kaer_bc_tab=kaer_bc_tab(:,:), & + waer_tab=waer_tab, waer_bc_tab=waer_bc_tab(:,:), & + gaer_tab=gaer_tab, gaer_bc_tab=gaer_bc_tab(:,:), & + bcenh=bcenh(:,:,:), & + modal_aero=modal_aero, & + swvdr =swvdr (i,j ,iblk), swvdf =swvdf (i,j ,iblk), & + swidr =swidr (i,j ,iblk), swidf =swidf (i,j ,iblk), & + coszen =coszen (i,j ,iblk), fsnow =fsnow (i,j ,iblk), & + alvdrn =alvdrn (i,j,: ,iblk), alvdfn =alvdfn (i,j,: ,iblk), & + alidrn =alidrn (i,j,: ,iblk), alidfn =alidfn (i,j,: ,iblk), & + fswsfcn =fswsfcn (i,j,: ,iblk), fswintn =fswintn (i,j,: ,iblk), & + fswthrun =fswthrun (i,j,: ,iblk), & +!opt fswthrun_vdr =fswthrun_vdr (i,j,: ,iblk), & +!opt fswthrun_vdf =fswthrun_vdf (i,j,: ,iblk), & +!opt fswthrun_idr =fswthrun_idr (i,j,: ,iblk), & +!opt fswthrun_idf =fswthrun_idf (i,j,: ,iblk), & + fswpenln=fswpenln(i,j,:,:,iblk), & + Sswabsn =Sswabsn (i,j,:,:,iblk), Iswabsn =Iswabsn (i,j,:,:,iblk), & + albicen =albicen (i,j,: ,iblk), albsnon =albsnon (i,j,: ,iblk), & + albpndn =albpndn (i,j,: ,iblk), apeffn =apeffn (i,j,: ,iblk), & + snowfracn=snowfracn(i,j,: ,iblk), & + dhsn =dhsn (i,j,: ,iblk), ffracn =ffracn(i,j,:,iblk), & +!opt rsnow =rsnow (:,:), & + l_print_point=l_print_point) + endif + + if (dEdd_algae .and. (tr_zaero .or. tr_bgc_N)) then + do n = 1, ncat + do k = 1, nbtrcr_sw + trcrn_sw(i,j,k,n,iblk) = ztrcr_sw(k,n) + enddo + enddo + endif + + enddo ! i + enddo ! j + + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + + deallocate(ztrcr_sw) + deallocate(rsnow) + + call ice_timer_stop(timer_sw,iblk) ! shortwave + + end subroutine step_radiation + +!======================================================================= +! Ocean mixed layer calculation (internal to sea ice model). +! Allows heat storage in ocean for uncoupled runs. +! +! authors: John Weatherly, CRREL +! C.M. Bitz, UW +! Elizabeth C. Hunke, LANL +! Bruce P. Briegleb, NCAR +! William H. Lipscomb, LANL + + subroutine ocean_mixed_layer (dt, iblk) + + use ice_arrays_column, only: Cdn_atm, Cdn_atm_ratio + use ice_flux, only: sst, Tf, Qa, uatmT, vatmT, wind, potT, rhoa, zlvl, & + frzmlt, fhocn, fswthru, flw, flwout_ocn, fsens_ocn, flat_ocn, evap_ocn, & + alvdr_ocn, alidr_ocn, alvdf_ocn, alidf_ocn, swidf, swvdf, swidr, swvdr, & + qdp, hmix, strairx_ocn, strairy_ocn, Tref_ocn, Qref_ocn + use ice_grid, only: tmask + use ice_state, only: aice + + real (kind=dbl_kind), intent(in) :: & + dt ! time step + + integer (kind=int_kind), intent(in) :: & + iblk ! block index + + ! local variables + + real (kind=dbl_kind) :: albocn + + real (kind=dbl_kind), parameter :: & + frzmlt_max = c1000 ! max magnitude of frzmlt (W/m^2) + + integer (kind=int_kind) :: & + i, j , & ! horizontal indices + ij ! combined ij index + + real (kind=dbl_kind), dimension(nx_block,ny_block) :: & + delt , & ! potential temperature difference (K) + delq , & ! specific humidity difference (kg/kg) + shcoef, & ! transfer coefficient for sensible heat + lhcoef ! transfer coefficient for latent heat + + integer (kind=int_kind) :: & + icells ! number of ocean cells + + integer (kind=int_kind), dimension(nx_block*ny_block) :: & + indxi, indxj ! compressed indices for ocean cells + + character(len=*), parameter :: subname = '(ocn_mixed_layer)' + + !----------------------------------------------------------------- + + call icepack_query_parameters(albocn_out=albocn) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + + !----------------------------------------------------------------- + ! Identify ocean cells. + ! Set fluxes to zero in land cells. + !----------------------------------------------------------------- + + icells = 0 + indxi(:) = 0 + indxj(:) = 0 + + do j = 1, ny_block + do i = 1, nx_block + + if (tmask(i,j,iblk)) then + icells = icells + 1 + indxi(icells) = i + indxj(icells) = j + else + sst (i,j,iblk) = c0 + frzmlt (i,j,iblk) = c0 + flwout_ocn(i,j,iblk) = c0 + fsens_ocn (i,j,iblk) = c0 + flat_ocn (i,j,iblk) = c0 + evap_ocn (i,j,iblk) = c0 + endif + enddo ! i + enddo ! j + + !----------------------------------------------------------------- + ! Compute boundary layer quantities + !----------------------------------------------------------------- + + do ij = 1, icells + i = indxi(ij) + j = indxj(ij) + + call icepack_atm_boundary(sfctype = 'ocn', & + Tsf = sst (i,j,iblk), & + potT = potT (i,j,iblk), & + uatm = uatmT (i,j,iblk), & + vatm = vatmT (i,j,iblk), & + wind = wind (i,j,iblk), & + zlvl = zlvl (i,j,iblk), & + Qa = Qa (i,j,iblk), & + rhoa = rhoa (i,j,iblk), & + strx = strairx_ocn(i,j,iblk), & + stry = strairy_ocn(i,j,iblk), & + Tref = Tref_ocn (i,j,iblk), & + Qref = Qref_ocn (i,j,iblk), & + delt = delt (i,j), & + delq = delq (i,j), & + lhcoef = lhcoef (i,j), & + shcoef = shcoef (i,j), & + Cdn_atm = Cdn_atm (i,j,iblk), & + Cdn_atm_ratio_n = Cdn_atm_ratio(i,j,iblk)) + enddo ! ij + + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + + !----------------------------------------------------------------- + ! Ocean albedo + ! For now, assume albedo = albocn in each spectral band. + !----------------------------------------------------------------- + + alvdr_ocn(:,:,iblk) = albocn + alidr_ocn(:,:,iblk) = albocn + alvdf_ocn(:,:,iblk) = albocn + alidf_ocn(:,:,iblk) = albocn + + !----------------------------------------------------------------- + ! Compute ocean fluxes and update SST + !----------------------------------------------------------------- + + do ij = 1, icells + i = indxi(ij) + j = indxj(ij) + + call icepack_ocn_mixed_layer(alvdr_ocn=alvdr_ocn(i,j,iblk), swvdr =swvdr (i,j,iblk), & + alidr_ocn=alidr_ocn(i,j,iblk), swidr =swidr (i,j,iblk), & + alvdf_ocn=alvdf_ocn(i,j,iblk), swvdf =swvdf (i,j,iblk), & + alidf_ocn=alidf_ocn(i,j,iblk), swidf =swidf (i,j,iblk), & + sst =sst (i,j,iblk), flwout_ocn=flwout_ocn(i,j,iblk), & + fsens_ocn=fsens_ocn(i,j,iblk), shcoef=shcoef(i,j), & + flat_ocn =flat_ocn (i,j,iblk), lhcoef=lhcoef(i,j), & + evap_ocn =evap_ocn (i,j,iblk), flw =flw (i,j,iblk), & + delt =delt (i,j), delq =delq (i,j), & + aice =aice (i,j,iblk), fhocn =fhocn (i,j,iblk), & + fswthru =fswthru (i,j,iblk), hmix =hmix (i,j,iblk), & + Tf =Tf (i,j,iblk), qdp =qdp (i,j,iblk), & + frzmlt =frzmlt (i,j,iblk), dt =dt) + enddo ! ij + + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + + end subroutine ocean_mixed_layer + +!======================================================================= + + subroutine biogeochemistry (dt, iblk) + + use ice_arrays_column, only: upNO, upNH, iDi, iki, zfswin, & + zsal_tot, darcy_V, grow_net, & + PP_net, hbri,dhbr_bot, dhbr_top, Zoo,& + fbio_snoice, fbio_atmice, ocean_bio, & + first_ice, fswpenln, bphi, bTiz, ice_bio_net, & + snow_bio_net, fswthrun, Rayleigh_criteria, & + ocean_bio_all, sice_rho, fzsal, fzsal_g, & + bgrid, igrid, icgrid, cgrid + use ice_domain_size, only: nblyr, nilyr, nslyr, n_algae, n_zaero, ncat, & + n_doc, n_dic, n_don, n_fed, n_fep + use ice_flux, only: meltbn, melttn, congeln, snoicen, & + sst, sss, fsnow, meltsn + use ice_flux_bgc, only: hin_old, flux_bio, flux_bio_atm, faero_atm, & + nit, amm, sil, dmsp, dms, algalN, doc, don, dic, fed, fep, zaeros, hum + use ice_state, only: aicen_init, vicen_init, aicen, vicen, vsnon, & + trcrn, vsnon_init, aice0 + use ice_timers, only: timer_bgc, ice_timer_start, ice_timer_stop + + real (kind=dbl_kind), intent(in) :: & + dt ! time step + + integer (kind=int_kind), intent(in) :: & + iblk ! block index + + ! local variables + + integer (kind=int_kind) :: & + i, j , & ! horizontal indices + ilo,ihi,jlo,jhi, & ! beginning and end of physical domain + mm ! tracer index + + type (block) :: & + this_block ! block information for current block + + integer (kind=int_kind) :: & + nbtrcr, ntrcr + + integer (kind=int_kind), dimension(icepack_max_aero) :: & + nlt_zaero + + integer (kind=int_kind), dimension(icepack_max_nbtrcr) :: & + bio_index_o + + logical (kind=log_kind) :: & + skl_bgc, tr_brine, tr_zaero + + character(len=*), parameter :: subname='(biogeochemistry)' + + call icepack_query_tracer_flags(tr_brine_out=tr_brine) + call icepack_query_parameters(skl_bgc_out=skl_bgc) + call icepack_query_tracer_sizes(ntrcr_out=ntrcr, nbtrcr_out=nbtrcr) + call icepack_query_tracer_flags(tr_zaero_out=tr_zaero) + call icepack_query_tracer_indices(nlt_zaero_out=nlt_zaero) + call icepack_query_tracer_indices(bio_index_o_out=bio_index_o) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + + if (tr_brine .or. skl_bgc) then + + call ice_timer_start(timer_bgc,iblk) ! biogeochemistry + + this_block = get_block(blocks_ice(iblk),iblk) + ilo = this_block%ilo + ihi = this_block%ihi + jlo = this_block%jlo + jhi = this_block%jhi + + ! Define ocean concentrations for tracers used in simulation + do j = jlo, jhi + do i = ilo, ihi + + call icepack_load_ocean_bio_array(max_nbtrcr = icepack_max_nbtrcr, & + max_algae = icepack_max_algae, max_don = icepack_max_don, & + max_doc = icepack_max_doc, max_dic = icepack_max_dic, & + max_aero = icepack_max_aero, max_fe = icepack_max_fe, & + nit = nit(i,j, iblk), amm = amm (i,j, iblk), & + sil = sil(i,j, iblk), dmsp = dmsp (i,j, iblk), & + dms = dms(i,j, iblk), algalN = algalN(i,j,:,iblk), & + doc = doc(i,j,:,iblk), don = don (i,j,:,iblk), & + dic = dic(i,j,:,iblk), fed = fed (i,j,:,iblk), & + fep = fep(i,j,:,iblk), zaeros = zaeros(i,j,:,iblk), & + hum = hum(i,j, iblk), & + ocean_bio_all = ocean_bio_all(i,j,:,iblk)) + + do mm = 1,nbtrcr + ocean_bio(i,j,mm,iblk) = ocean_bio_all(i,j,bio_index_o(mm),iblk) + enddo ! mm + if (tr_zaero) then + do mm = 1, n_zaero ! update aerosols + flux_bio_atm(i,j,nlt_zaero(mm),iblk) = faero_atm(i,j,mm,iblk) + enddo ! mm + endif + + call icepack_biogeochemistry(dt=dt, ntrcr=ntrcr, nbtrcr=nbtrcr,& + bgrid=bgrid, igrid=igrid, icgrid=icgrid, cgrid=cgrid, & + nblyr=nblyr, nilyr=nilyr, nslyr=nslyr, n_algae=n_algae, n_zaero=n_zaero, & + ncat=ncat, n_doc=n_doc, n_dic=n_dic, n_don=n_don, n_fed=n_fed, n_fep=n_fep, & + upNO = upNO (i,j, iblk), & + upNH = upNH (i,j, iblk), & + iDi = iDi (i,j,:,:, iblk), & + iki = iki (i,j,:,:, iblk), & + zfswin = zfswin (i,j,:,:, iblk), & + zsal_tot = zsal_tot (i,j, iblk), & + darcy_V = darcy_V (i,j,:, iblk), & + grow_net = grow_net (i,j, iblk), & + PP_net = PP_net (i,j, iblk), & + hbri = hbri (i,j, iblk), & + dhbr_bot = dhbr_bot (i,j,:, iblk), & + dhbr_top = dhbr_top (i,j,:, iblk), & + Zoo = Zoo (i,j,:,:, iblk), & + fbio_snoice = fbio_snoice (i,j,:, iblk), & + fbio_atmice = fbio_atmice (i,j,:, iblk), & + ocean_bio = ocean_bio (i,j,1:nbtrcr, iblk), & + first_ice = first_ice (i,j,:, iblk), & + fswpenln = fswpenln (i,j,:,:, iblk), & + bphi = bphi (i,j,:,:, iblk), & + bTiz = bTiz (i,j,:,:, iblk), & + ice_bio_net = ice_bio_net (i,j,1:nbtrcr, iblk), & + snow_bio_net = snow_bio_net(i,j,1:nbtrcr, iblk), & + fswthrun = fswthrun (i,j,:, iblk), & + sice_rho = sice_rho (i,j,:, iblk), & + fzsal = fzsal (i,j, iblk), & + fzsal_g = fzsal_g (i,j, iblk), & + meltbn = meltbn (i,j,:, iblk), & + melttn = melttn (i,j,:, iblk), & + congeln = congeln (i,j,:, iblk), & + snoicen = snoicen (i,j,:, iblk), & + sst = sst (i,j, iblk), & + sss = sss (i,j, iblk), & + fsnow = fsnow (i,j, iblk), & + meltsn = meltsn (i,j,:, iblk), & + hin_old = hin_old (i,j,:, iblk), & + flux_bio = flux_bio (i,j,1:nbtrcr, iblk), & + flux_bio_atm = flux_bio_atm(i,j,1:nbtrcr, iblk), & + aicen_init = aicen_init (i,j,:, iblk), & + vicen_init = vicen_init (i,j,:, iblk), & + aicen = aicen (i,j,:, iblk), & + vicen = vicen (i,j,:, iblk), & + vsnon = vsnon (i,j,:, iblk), & + aice0 = aice0 (i,j, iblk), & + trcrn = trcrn (i,j,:,:, iblk), & + vsnon_init = vsnon_init (i,j,:, iblk), & + Rayleigh_criteria = Rayleigh_criteria(i,j,iblk), & + skl_bgc = skl_bgc) + + enddo ! i + enddo ! j + + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + + call ice_timer_stop(timer_bgc,iblk) ! biogeochemistry + + endif ! tr_brine .or. skl_bgc + + end subroutine biogeochemistry + +!======================================================================= + + end module ice_step_mod + +!======================================================================= diff --git a/configuration/scripts/Makefile b/configuration/scripts/Makefile index 872f426ad..d109472b0 100644 --- a/configuration/scripts/Makefile +++ b/configuration/scripts/Makefile @@ -74,7 +74,7 @@ AR := ar .SUFFIXES: -.PHONY: all cice libcice targets target db_files db_flags clean realclean helloworld calchk sumchk bcstchk gridavgchk halochk optargs +.PHONY: all cice libcice targets target db_files db_flags clean realclean helloworld calchk sumchk bcstchk gridavgchk halochk optargs opticep all: $(EXEC) cice: $(EXEC) @@ -93,7 +93,7 @@ targets: @echo " " @echo "Supported Makefile Targets are: cice, libcice, makdep, depends, clean, realclean" @echo " Diagnostics: targets, db_files, db_flags" - @echo " Unit Tests : helloworld, calchk, sumchk, bcstchk, gridavgchk, halochk, optargs" + @echo " Unit Tests : helloworld, calchk, sumchk, bcstchk, gridavgchk, halochk, optargs, opticep" target: targets db_files: @@ -153,6 +153,8 @@ gridavgchk: $(EXEC) halochk: $(EXEC) +opticep: $(EXEC) + # this builds just a subset of source code specified explicitly and requires a separate target HWOBJS := helloworld.o diff --git a/configuration/scripts/options/set_env.opticep b/configuration/scripts/options/set_env.opticep new file mode 100644 index 000000000..81339ea42 --- /dev/null +++ b/configuration/scripts/options/set_env.opticep @@ -0,0 +1,2 @@ +setenv ICE_DRVOPT unittest/opticep +setenv ICE_TARGET opticep diff --git a/configuration/scripts/tests/baseline.script b/configuration/scripts/tests/baseline.script index 2700fe71f..a24236c9e 100644 --- a/configuration/scripts/tests/baseline.script +++ b/configuration/scripts/tests/baseline.script @@ -33,8 +33,13 @@ if (${ICE_BASECOM} != ${ICE_SPVAL}) then echo "base_file: ${base_file}" echo "test_file: ${test_file}" - ${ICE_CASEDIR}/casescripts/comparelog.csh ${base_file} ${test_file} notcicefile - set bfbstatus = $status + if (${ICE_TARGET} == "opticep") then + ${ICE_CASEDIR}/casescripts/comparelog.csh ${base_file} ${test_file} modcicefile + set bfbstatus = $status + else + ${ICE_CASEDIR}/casescripts/comparelog.csh ${base_file} ${test_file} notcicefile + set bfbstatus = $status + endif else if (${ICE_BFBTYPE} =~ qcchk*) then set test_dir = ${ICE_RUNDIR} @@ -160,8 +165,13 @@ if (${ICE_BFBCOMP} != ${ICE_SPVAL}) then echo "base_file: ${base_file}" echo "test_file: ${test_file}" - ${ICE_CASEDIR}/casescripts/comparelog.csh ${base_file} ${test_file} - set bfbstatus = $status + if (${ICE_TARGET} == "opticep") then + ${ICE_CASEDIR}/casescripts/comparelog.csh ${base_file} ${test_file} modcicefile + set bfbstatus = $status + else + ${ICE_CASEDIR}/casescripts/comparelog.csh ${base_file} ${test_file} + set bfbstatus = $status + endif else if (${ICE_BFBTYPE} == "logrest") then set test_file = `ls -1t ${ICE_RUNDIR}/cice.runlog* | head -1` @@ -172,8 +182,13 @@ if (${ICE_BFBCOMP} != ${ICE_SPVAL}) then echo "base_file: ${base_file}" echo "test_file: ${test_file}" - ${ICE_CASEDIR}/casescripts/comparelog.csh ${base_file} ${test_file} - set bfbstatusl = $status + if (${ICE_TARGET} == "opticep") then + ${ICE_CASEDIR}/casescripts/comparelog.csh ${base_file} ${test_file} modcicefile + set bfbstatus = $status + else + ${ICE_CASEDIR}/casescripts/comparelog.csh ${base_file} ${test_file} + set bfbstatusl = $status + endif set test_dir = ${ICE_RUNDIR}/restart set base_dir = ${ICE_RUNDIR}/../${ICE_BFBCOMP}.${ICE_TESTID}/restart diff --git a/configuration/scripts/tests/comparelog.csh b/configuration/scripts/tests/comparelog.csh index 576289cd7..6659906b8 100755 --- a/configuration/scripts/tests/comparelog.csh +++ b/configuration/scripts/tests/comparelog.csh @@ -16,6 +16,7 @@ set filearg = 0 set cicefile = 0 set notcicefile = "notcicefile" +set modcicefile = "modcicefile" if ( $#argv == 2 ) then set cicefile = 1 set filearg = 1 @@ -23,12 +24,18 @@ if ( $#argv == 2 ) then set test_data = $argv[2] if ("$argv[1]" == "${notcicefile}") set filearg = 0 if ("$argv[2]" == "${notcicefile}") set filearg = 0 + if ("$argv[1]" == "${modcicefile}") set filearg = 0 + if ("$argv[2]" == "${modcicefile}") set filearg = 0 else if ( $#argv == 3 ) then set cicefile = 0 set filearg = 1 set base_data = $argv[1] set test_data = $argv[2] - if ("$argv[3]" != "${notcicefile}") set filearg = 0 + if ("$argv[3]" == "${modcicefile}") then + set cicefile = 2 + else if ("$argv[3]" != "${notcicefile}") then + set filearg = 0 + endif endif if (${filearg} == 0) then @@ -57,6 +64,9 @@ if (${filearg} == 1) then if (${cicefile} == 1) then cat ${base_data} | grep -A 99999999 "total ice area (km^2)" | grep -e istep1: -e = | grep -iv "min, max, sum" | grep -iv "init_vert" | grep -iv "ridge_ice" >&! ${base_out} cat ${test_data} | grep -A 99999999 "total ice area (km^2)" | grep -e istep1: -e = | grep -iv "min, max, sum" | grep -iv "init_vert" | grep -iv "ridge_ice" >&! ${test_out} + else if (${cicefile} == 2) then + cat ${base_data} | grep -A 99999999 "total ice area (km^2)" | grep -e "total " -e "arwt " -e "max " -e "kinetic" >&! ${base_out} + cat ${test_data} | grep -A 99999999 "total ice area (km^2)" | grep -e "total " -e "arwt " -e "max " -e "kinetic" >&! ${test_out} else sed -n '/RunningUnitTest/,$p' ${base_data} >! ${base_out} sed -n '/RunningUnitTest/,$p' ${test_data} >! ${test_out} diff --git a/configuration/scripts/tests/unittest_suite.ts b/configuration/scripts/tests/unittest_suite.ts index e64bea2f7..840fc822e 100644 --- a/configuration/scripts/tests/unittest_suite.ts +++ b/configuration/scripts/tests/unittest_suite.ts @@ -1,6 +1,7 @@ # Test Grid PEs Sets BFB-compare +smoke gx3 8x2 diag1,run5day +smoke gx3 4x2x25x29x4 debug,run2day,dslenderX2 unittest gx3 1x1 helloworld -unittest gx3 1x1 optargs unittest gx3 1x1 calchk,short unittest gx3 4x1x25x29x4 sumchk unittest gx3 1x1x25x29x16 sumchk @@ -28,3 +29,7 @@ unittest tx1 4x2 halochk,dwblockall unittest tx1 4x2 halochk,dwblockall,tripolet unittest tx1 4x2x65x45x10 halochk,dwblockall unittest tx1 4x2x57x43x12 halochk,dwblockall,tripolet +unittest gx3 1x1 optargs +unittest gx3 1x1 opticep +unittest gx3 4x2x25x29x4 debug,run2day,dslenderX2,opticep,cmplog smoke_gx3_4x2x25x29x4_debug_dslenderX2_run2day +unittest gx3 8x2 diag1,run5day,opticep,cmplog smoke_gx3_8x2_diag1_run5day diff --git a/doc/source/user_guide/ug_testing.rst b/doc/source/user_guide/ug_testing.rst index f04bdf19a..e382eba17 100644 --- a/doc/source/user_guide/ug_testing.rst +++ b/doc/source/user_guide/ug_testing.rst @@ -742,6 +742,8 @@ The following are brief descriptions of some of the current unit tests, in the Makefile - **optargs** is a unit test that tests passing optional arguments down a calling tree and verifying that the optional attribute is preserved correctly. + - **opticep** is a cice test that turns off the icepack optional arguments passed into icepack. This + can only be run with a subset of CICE/Icepack cases to verify the optional arguments are working correctly. - **sumchk** is a unit test that exercises the methods in ice_global_reductions.F90. This test requires that a CICE grid and decomposition be initialized, so CICE_InitMod.F90 is leveraged to initialize the model prior to running a suite of unit validation tests to verify correctness. diff --git a/icepack b/icepack index d024340f1..4728746ea 160000 --- a/icepack +++ b/icepack @@ -1 +1 @@ -Subproject commit d024340f19676bc5f6c0effe0c5dbfb763a5882a +Subproject commit 4728746ea2926bf10acc5de354b3eae16d418af5 From 4cb296c4003014fe57d6d00f86868a78a532fc95 Mon Sep 17 00:00:00 2001 From: JFLemieux73 <31927797+JFLemieux73@users.noreply.github.com> Date: Tue, 25 Jul 2023 16:11:33 +0000 Subject: [PATCH 11/76] 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 --- .../cicedyn/dynamics/ice_transport_driver.F90 | 12 +- .../cicedyn/dynamics/ice_transport_remap.F90 | 113 ++++++++---------- cicecore/cicedyn/general/ice_init.F90 | 34 ++++-- doc/source/science_guide/sg_horiztrans.rst | 2 +- 4 files changed, 78 insertions(+), 83 deletions(-) diff --git a/cicecore/cicedyn/dynamics/ice_transport_driver.F90 b/cicecore/cicedyn/dynamics/ice_transport_driver.F90 index 30fe546e0..4f9d84d98 100644 --- a/cicecore/cicedyn/dynamics/ice_transport_driver.F90 +++ b/cicecore/cicedyn/dynamics/ice_transport_driver.F90 @@ -37,9 +37,6 @@ module ice_transport_driver ! 'upwind' => 1st order donor cell scheme ! 'remap' => remapping scheme - logical, parameter :: & - l_fixed_area = .false. ! if true, prescribe area flux across each edge - ! NOTE: For remapping, hice and hsno are considered tracers. ! ntrace is not equal to ntrcr! @@ -81,6 +78,7 @@ subroutine init_transport use ice_state, only: trcr_depend use ice_timers, only: ice_timer_start, ice_timer_stop, timer_advect use ice_transport_remap, only: init_remap + use ice_grid, only: grid_ice integer (kind=int_kind) :: & k, nt, nt1 ! tracer indices @@ -236,7 +234,7 @@ subroutine init_transport endif ! master_task 1000 format (1x,a,2x,i6,2x,i6,2x,i4,4x,l4) - if (trim(advection)=='remap') call init_remap ! grid quantities + if (trim(advection)=='remap') call init_remap ! grid quantities call ice_timer_stop(timer_advect) ! advection @@ -545,19 +543,17 @@ subroutine transport_remap (dt) call horizontal_remap (dt, ntrace, & uvel (:,:,:), vvel (:,:,:), & aim (:,:,:,:), trm(:,:,:,:,:), & - l_fixed_area, & tracer_type, depend, & has_dependents, integral_order, & - l_dp_midpt, grid_ice, & + l_dp_midpt, & uvelE (:,:,:), vvelN (:,:,:)) else call horizontal_remap (dt, ntrace, & uvel (:,:,:), vvel (:,:,:), & aim (:,:,:,:), trm(:,:,:,:,:), & - l_fixed_area, & tracer_type, depend, & has_dependents, integral_order, & - l_dp_midpt, grid_ice) + l_dp_midpt) endif !------------------------------------------------------------------- diff --git a/cicecore/cicedyn/dynamics/ice_transport_remap.F90 b/cicecore/cicedyn/dynamics/ice_transport_remap.F90 index 286a51711..eb0dd17cf 100644 --- a/cicecore/cicedyn/dynamics/ice_transport_remap.F90 +++ b/cicecore/cicedyn/dynamics/ice_transport_remap.F90 @@ -42,6 +42,7 @@ module ice_transport_remap 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_grid, only : grid_ice implicit none private @@ -57,6 +58,11 @@ module ice_transport_remap p5625m = -9._dbl_kind/16._dbl_kind ,& p52083 = 25._dbl_kind/48._dbl_kind + logical :: & + l_fixed_area ! if true, prescribe area flux across each edge + ! if false, area flux is determined internally + ! and is passed out + logical (kind=log_kind), parameter :: bugcheck = .false. !======================================================================= @@ -293,6 +299,29 @@ subroutine init_remap enddo !$OMP END PARALLEL DO + !------------------------------------------------------------------- + ! Set logical l_fixed_area depending of the grid type. + ! + ! If l_fixed_area is true, the area of each departure region is + ! computed in advance (e.g., by taking the divergence of the + ! velocity field and passed to locate_triangles. The departure + ! regions are adjusted to obtain the desired area. + ! If false, edgearea is computed in locate_triangles and passed out. + ! + ! l_fixed_area = .false. has been the default approach in CICE. It is + ! used like this for the B-grid. However, idealized tests with the + ! C-grid have shown that l_fixed_area = .false. leads to a checkerboard + ! pattern in prognostic fields (e.g. aice). Using l_fixed_area = .true. + ! eliminates the checkerboard pattern in C-grid simulations. + ! + !------------------------------------------------------------------- + + if (grid_ice == 'CD' .or. grid_ice == 'C') then + l_fixed_area = .false. !jlem temporary + else + l_fixed_area = .false. + endif + end subroutine init_remap !======================================================================= @@ -316,11 +345,10 @@ end subroutine init_remap subroutine horizontal_remap (dt, ntrace, & uvel, vvel, & mm, tm, & - l_fixed_area, & tracer_type, depend, & has_dependents, & integral_order, & - l_dp_midpt, grid_ice, & + l_dp_midpt, & uvelE, vvelN) use ice_boundary, only: ice_halo, ice_HaloMask, ice_HaloUpdate, & @@ -353,21 +381,6 @@ subroutine horizontal_remap (dt, ntrace, & real (kind=dbl_kind), intent(inout), dimension (nx_block,ny_block,ntrace,ncat,max_blocks) :: & tm ! mean tracer values in each grid cell - character (len=char_len_long), intent(in) :: & - grid_ice ! ice grid, B, C, etc - - !------------------------------------------------------------------- - ! If l_fixed_area is true, the area of each departure region is - ! computed in advance (e.g., by taking the divergence of the - ! velocity field and passed to locate_triangles. The departure - ! regions are adjusted to obtain the desired area. - ! If false, edgearea is computed in locate_triangles and passed out. - !------------------------------------------------------------------- - - logical, intent(in) :: & - l_fixed_area ! if true, edgearea_e and edgearea_n are prescribed - ! if false, edgearea is computed here and passed out - integer (kind=int_kind), dimension (ntrace), intent(in) :: & tracer_type , & ! = 1, 2, or 3 (see comments above) depend ! tracer dependencies (see above) @@ -716,8 +729,7 @@ subroutine horizontal_remap (dt, ntrace, & dxu (:,:,iblk), dyu(:,:,iblk), & xp (:,:,:,:), yp (:,:,:,:), & iflux, jflux, & - triarea, & - l_fixed_area, edgearea_e(:,:)) + triarea, edgearea_e(:,:)) !------------------------------------------------------------------- ! Given triangle vertices, compute coordinates of triangle points @@ -776,8 +788,7 @@ subroutine horizontal_remap (dt, ntrace, & dxu (:,:,iblk), dyu (:,:,iblk), & xp (:,:,:,:), yp(:,:,:,:), & iflux, jflux, & - triarea, & - l_fixed_area, edgearea_n(:,:)) + triarea, edgearea_n(:,:)) call triangle_coordinates (nx_block, ny_block, & integral_order, icellsng(:,iblk), & @@ -1696,8 +1707,7 @@ subroutine locate_triangles (nx_block, ny_block, & dxu, dyu, & xp, yp, & iflux, jflux, & - triarea, & - l_fixed_area, edgearea) + triarea, edgearea) integer (kind=int_kind), intent(in) :: & nx_block, ny_block, & ! block dimensions @@ -1730,12 +1740,6 @@ subroutine locate_triangles (nx_block, ny_block, & indxi , & ! compressed index in i-direction indxj ! compressed index in j-direction - logical, intent(in) :: & - l_fixed_area ! if true, the area of each departure region is - ! passed in as edgearea - ! if false, edgearea if determined internally - ! and is passed out - real (kind=dbl_kind), dimension(nx_block,ny_block), intent(inout) :: & edgearea ! area of departure region for each edge ! edgearea > 0 for eastward/northward flow @@ -1838,7 +1842,7 @@ subroutine locate_triangles (nx_block, ny_block, & ! BL | BC | BR (bottom left, center, right) ! | | ! - ! and the transport is across the edge between cells TC and TB. + ! and the transport is across the edge between cells TC and BC. ! ! Departure points are scaled to a local coordinate system ! whose origin is at the midpoint of the edge. @@ -1951,45 +1955,32 @@ subroutine locate_triangles (nx_block, ny_block, & ! Compute mask for edges with nonzero departure areas !------------------------------------------------------------------- - if (l_fixed_area) then - icellsd = 0 + icellsd = 0 + if (trim(edge) == 'north') then do j = jb, je do i = ib, ie - if (edgearea(i,j) /= c0) then + if (dpx(i-1,j)/=c0 .or. dpy(i-1,j)/=c0 & + .or. & + dpx(i,j)/=c0 .or. dpy(i,j)/=c0) then icellsd = icellsd + 1 indxid(icellsd) = i indxjd(icellsd) = j endif enddo enddo - else - icellsd = 0 - if (trim(edge) == 'north') then - do j = jb, je - do i = ib, ie - if (dpx(i-1,j)/=c0 .or. dpy(i-1,j)/=c0 & - .or. & - dpx(i,j)/=c0 .or. dpy(i,j)/=c0) then - icellsd = icellsd + 1 - indxid(icellsd) = i - indxjd(icellsd) = j - endif - enddo - enddo - else ! east edge - do j = jb, je - do i = ib, ie - if (dpx(i,j-1)/=c0 .or. dpy(i,j-1)/=c0 & - .or. & - dpx(i,j)/=c0 .or. dpy(i,j)/=c0) then - icellsd = icellsd + 1 - indxid(icellsd) = i - indxjd(icellsd) = j - endif - enddo - enddo - endif ! edge = north/east - endif ! l_fixed_area + else ! east edge + do j = jb, je + do i = ib, ie + if (dpx(i,j-1)/=c0 .or. dpy(i,j-1)/=c0 & + .or. & + dpx(i,j)/=c0 .or. dpy(i,j)/=c0) then + icellsd = icellsd + 1 + indxid(icellsd) = i + indxjd(icellsd) = j + endif + enddo + enddo + endif ! edge = north/east !------------------------------------------------------------------- ! Scale the departure points diff --git a/cicecore/cicedyn/general/ice_init.F90 b/cicecore/cicedyn/general/ice_init.F90 index 2c8b1db3b..3b8d83d1f 100644 --- a/cicecore/cicedyn/general/ice_init.F90 +++ b/cicecore/cicedyn/general/ice_init.F90 @@ -2542,7 +2542,7 @@ subroutine init_state use ice_domain, only: nblocks, blocks_ice, halo_info use ice_domain_size, only: ncat, nilyr, nslyr, n_iso, n_aero, nfsd use ice_flux, only: sst, Tf, Tair, salinz, Tmltz - use ice_grid, only: tmask, ULON, TLAT, grid_ice, grid_average_X2Y + use ice_grid, only: tmask, umask, ULON, TLAT, grid_ice, grid_average_X2Y use ice_boundary, only: ice_HaloUpdate use ice_constants, only: field_loc_Nface, field_loc_Eface, field_type_scalar use ice_state, only: trcr_depend, aicen, trcrn, vicen, vsnon, & @@ -2730,6 +2730,7 @@ subroutine init_state ilo, ihi, jlo, jhi, & iglob, jglob, & ice_ic, tmask(:,:, iblk), & + umask(:,:, iblk), & ULON (:,:, iblk), & TLAT (:,:, iblk), & Tair (:,:, iblk), sst (:,:, iblk), & @@ -2752,10 +2753,10 @@ subroutine init_state if (grid_ice == 'CD' .or. grid_ice == 'C') then - call grid_average_X2Y('S',uvel,'U',uvelN,'N') - call grid_average_X2Y('S',vvel,'U',vvelN,'N') - call grid_average_X2Y('S',uvel,'U',uvelE,'E') - call grid_average_X2Y('S',vvel,'U',vvelE,'E') + call grid_average_X2Y('A',uvel,'U',uvelN,'N') + call grid_average_X2Y('A',vvel,'U',vvelN,'N') + call grid_average_X2Y('A',uvel,'U',uvelE,'E') + call grid_average_X2Y('A',vvel,'U',vvelE,'E') ! Halo update on North, East faces call ice_HaloUpdate(uvelN, halo_info, & @@ -2770,7 +2771,6 @@ subroutine init_state endif - !----------------------------------------------------------------- ! compute aggregate ice state and open water area !----------------------------------------------------------------- @@ -2829,8 +2829,9 @@ subroutine set_state_var (nx_block, ny_block, & ilo, ihi, jlo, jhi, & iglob, jglob, & ice_ic, tmask, & - ULON, & - TLAT, & + umask, & + ULON, & + TLAT, & Tair, sst, & Tf, & salinz, Tmltz, & @@ -2855,7 +2856,8 @@ subroutine set_state_var (nx_block, ny_block, & ice_ic ! method of ice cover initialization logical (kind=log_kind), dimension (nx_block,ny_block), intent(in) :: & - tmask ! true for ice/ocean cells + tmask , & ! true for ice/ocean cells + umask ! for U points real (kind=dbl_kind), dimension (nx_block,ny_block), intent(in) :: & ULON , & ! longitude of velocity pts (radians) @@ -3303,13 +3305,19 @@ subroutine set_state_var (nx_block, ny_block, & domain_length = dxrect*cm_to_m*nx_global period = c12*secday ! 12 days rotational period max_vel = pi*domain_length/period + do j = 1, ny_block do i = 1, nx_block - uvel(i,j) = c2*max_vel*(real(jglob(j), kind=dbl_kind) - p5) & - / real(ny_global - 1, kind=dbl_kind) - max_vel - vvel(i,j) = -c2*max_vel*(real(iglob(i), kind=dbl_kind) - p5) & - / real(nx_global - 1, kind=dbl_kind) + max_vel + if (umask(i,j)) then + uvel(i,j) = c2*max_vel*(real(jglob(j), kind=dbl_kind) - p5) & + / real(ny_global - 1, kind=dbl_kind) - max_vel + vvel(i,j) = -c2*max_vel*(real(iglob(i), kind=dbl_kind) - p5) & + / real(nx_global - 1, kind=dbl_kind) + max_vel + else + uvel(i,j) = c0 + vvel(i,j) = c0 + endif enddo ! j enddo ! i else diff --git a/doc/source/science_guide/sg_horiztrans.rst b/doc/source/science_guide/sg_horiztrans.rst index 7862b5689..10b668755 100644 --- a/doc/source/science_guide/sg_horiztrans.rst +++ b/doc/source/science_guide/sg_horiztrans.rst @@ -39,7 +39,7 @@ remapping scheme of :cite:`Dukowicz00` as modified for sea ice by - The upwind scheme uses velocity points at the East and North face (i.e. :math:`uvelE=u` at the E point and :math:`vvelN=v` at the N point) of a T gridcell. As such, the prognostic C grid velocity components (:math:`uvelE` and :math:`vvelN`) can be passed directly to the upwind transport scheme. If the upwind scheme is used with the B grid, the B grid velocities, :math:`uvelU` and :math:`vvelU` (respectively :math:`u` and :math:`v` at the U point) are interpolated to the E and N points first. (Note however that the upwind scheme does not transport all potentially available tracers.) -- The remapping scheme uses :math:`uvelU` and :math:`vvelU` if l_fixed_area is false and :math:`uvelE` and :math:`vvelN` if l_fixed_area is true. l_fixed_area is hardcoded to false by default and further described below. As such, the B grid velocities (:math:`uvelU` and :math:`vvelU`) are used directly in the remapping scheme, while the C grid velocities (:math:`uvelE` and :math:`vvelN`) are interpolated to U points first. If l_fixed_area is changed to true, then the reverse is true. The C grid velocities are used directly and the B grid velocities are interpolated. +- Remapping is naturally a B-grid transport scheme as the corner (U point) velocity components :math:`uvelU` and :math:`vvelU` are used to calculate departure points. Nevertheless, the remapping scheme can also be used with the C grid by first interpolating :math:`uvelE` and :math:`vvelN` to the U points. The remapping scheme has several desirable features: From 7e8dc5b2aeffe98a6a7fd91dbb8e93ced1e3369c Mon Sep 17 00:00:00 2001 From: Tony Craig Date: Thu, 10 Aug 2023 13:06:41 -0700 Subject: [PATCH 12/76] Update conda_macos to fix problems with Github Actions testing (#853) * test ghactions * update master to main in github actions --- .github/workflows/test-cice.yml | 43 +++++++++++++++---- .../scripts/machines/Macros.conda_macos | 10 +++-- 2 files changed, 41 insertions(+), 12 deletions(-) diff --git a/.github/workflows/test-cice.yml b/.github/workflows/test-cice.yml index 70fdc4c14..b04ca1714 100644 --- a/.github/workflows/test-cice.yml +++ b/.github/workflows/test-cice.yml @@ -7,7 +7,7 @@ name: GHActions on: push: branches: - - master + - main - 'CICE*' - 'ghactions*' pull_request: @@ -27,8 +27,12 @@ jobs: matrix: # os: [macos-latest, ubuntu-latest] os: [macos-latest] +# os: [macos-13] # os: [ubuntu-latest] include: +# - os: macos-13 +# envdef: macos +# minicond: Miniconda3-latest-MacOSX-x86_64.sh - os: macos-latest envdef: macos minicond: Miniconda3-latest-MacOSX-x86_64.sh @@ -98,10 +102,26 @@ jobs: conda env create -f configuration/scripts/machines/environment.yml - name: check conda env run: | - conda activate cice && which mpicc && which mpifort && which make + conda activate cice && which clang && which gfortran && which mpicc && which mpifort && which make + clang --version + gfortran --version mpifort --version mpicc --version make --version +# echo "mpifort -v:" +# mpifort -v +# echo "mpifort --showme:compile:" +# mpifort --showme:compile +# echo "mpifort --showme:link:" +# mpifort --showme:link +# echo "mpifort --showme:command:" +# mpifort --showme:command +# echo "mpifort --showme:libdirs:" +# mpifort --showme:libdirs +# echo "mpifort --showme:libs:" +# mpifort --showme:libs +# echo "mpifort --showme:incdirs:" +# mpifort --showme:incdirs - name: check setup case run: | cd $HOME/cice @@ -110,12 +130,19 @@ jobs: run: | cd $HOME/cice ./cice.setup -m conda -e ${{ matrix.envdef }} --test smoke --testid c0 -# - name: compile case -# run: | -# cd $HOME/cice -# ./cice.setup -m conda -e ${{ matrix.envdef }} -c case1 -# cd case1 -# ./cice.build + - name: run hello world unit test + run: | + cd $HOME/cice + ./cice.setup -m conda -e ${{ matrix.envdef }} --test unittest --pes 2x1 -s helloworld --testid hw01 + cd *helloworld*hw01 + ./cice.build + ./cice.run + - name: check cice compile + run: | + cd $HOME/cice + ./cice.setup -m conda -e ${{ matrix.envdef }} -c case1 --pes 2x2 -s diag1 + cd case1 + ./cice.build - name: download input data run: | cd $HOME/cice-dirs/input diff --git a/configuration/scripts/machines/Macros.conda_macos b/configuration/scripts/machines/Macros.conda_macos index 9be1b9ab4..fad87507c 100644 --- a/configuration/scripts/machines/Macros.conda_macos +++ b/configuration/scripts/machines/Macros.conda_macos @@ -22,8 +22,10 @@ endif # C and Fortran compilers and MPI wrappers SCC := clang SFC := gfortran -MPICC := mpicc -MPIFC := mpifort +#MPICC := mpicc +#MPIFC := mpifort +MPICC := clang +MPIFC := gfortran ifeq ($(ICE_COMMDIR), mpi) FC := $(MPIFC) @@ -37,7 +39,7 @@ endif LD:= $(FC) # Location of the compiled Fortran modules (NetCDF) -MODDIR += -I$(CONDA_PREFIX)/include +MODDIR += -I$(CONDA_PREFIX)/include -I$(CONDA_PREFIX)/lib # Location of the system C header files (required on recent macOS to compile makdep) SDKPATH = $(shell xcrun --show-sdk-path) @@ -49,7 +51,7 @@ else endif # Libraries to be passed to the linker -SLIBS := -L$(CONDA_PREFIX)/lib -lnetcdf -lnetcdff -llapack +SLIBS := -L$(CONDA_PREFIX)/lib -lnetcdf -lnetcdff -llapack -lmpi_usempif08 -lmpi_usempi_ignore_tkr -lmpi_mpifh -lmpi # Necessary flag to compile with OpenMP support ifeq ($(ICE_THREADED), true) From 8322416793ae2b76c2bafa9c7b9b108c289ede9d Mon Sep 17 00:00:00 2001 From: Elizabeth Hunke Date: Fri, 18 Aug 2023 17:34:24 -0600 Subject: [PATCH 13/76] 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 --- cicecore/cicedyn/general/ice_init.F90 | 2 +- cicecore/cicedyn/general/ice_step_mod.F90 | 15 ++-- .../cicedyn/infrastructure/ice_read_write.F90 | 1 + configuration/scripts/cice.batch.csh | 6 +- configuration/scripts/cice.launch.csh | 4 +- .../scripts/machines/Macros.badger_intel | 56 --------------- .../scripts/machines/Macros.chicoma_intel | 58 +++++++++++++++ .../scripts/machines/env.badger_intel | 47 ------------ .../scripts/machines/env.chicoma_intel | 71 +++++++++++++++++++ icepack | 2 +- 10 files changed, 145 insertions(+), 117 deletions(-) delete mode 100644 configuration/scripts/machines/Macros.badger_intel create mode 100644 configuration/scripts/machines/Macros.chicoma_intel delete mode 100644 configuration/scripts/machines/env.badger_intel create mode 100755 configuration/scripts/machines/env.chicoma_intel diff --git a/cicecore/cicedyn/general/ice_init.F90 b/cicecore/cicedyn/general/ice_init.F90 index 3b8d83d1f..4ed128f5e 100644 --- a/cicecore/cicedyn/general/ice_init.F90 +++ b/cicecore/cicedyn/general/ice_init.F90 @@ -1356,7 +1356,7 @@ subroutine input_data abort_list = trim(abort_list)//":8" endif - if (snwredist(1:4) /= 'none' .and. .not. tr_snow) then + if (snwredist(1:3) == 'ITD' .and. .not. tr_snow) then if (my_task == master_task) then write (nu_diag,*) 'ERROR: snwredist on but tr_snow=F' write (nu_diag,*) 'ERROR: Use tr_snow=T for snow redistribution' diff --git a/cicecore/cicedyn/general/ice_step_mod.F90 b/cicecore/cicedyn/general/ice_step_mod.F90 index 56510c247..31989c73c 100644 --- a/cicecore/cicedyn/general/ice_step_mod.F90 +++ b/cicecore/cicedyn/general/ice_step_mod.F90 @@ -275,7 +275,7 @@ subroutine step_therm1 (dt, iblk) logical (kind=log_kind) :: & tr_iage, tr_FY, tr_iso, tr_aero, tr_pond, & - tr_pond_lvl, tr_pond_topo, calc_Tsfc, highfreq, tr_snow + tr_pond_lvl, tr_pond_topo, calc_Tsfc, snwgrain real (kind=dbl_kind) :: & puny ! a very small number @@ -296,13 +296,12 @@ subroutine step_therm1 (dt, iblk) call icepack_query_parameters(puny_out=puny) call icepack_query_parameters(calc_Tsfc_out=calc_Tsfc) - call icepack_query_parameters(highfreq_out=highfreq) + call icepack_query_parameters(snwgrain_out=snwgrain) call icepack_query_tracer_sizes(ntrcr_out=ntrcr) call icepack_query_tracer_flags( & tr_iage_out=tr_iage, tr_FY_out=tr_FY, tr_iso_out=tr_iso, & tr_aero_out=tr_aero, tr_pond_out=tr_pond, & - tr_pond_lvl_out=tr_pond_lvl, tr_pond_topo_out=tr_pond_topo, & - tr_snow_out=tr_snow) + tr_pond_lvl_out=tr_pond_lvl, tr_pond_topo_out=tr_pond_topo) call icepack_query_tracer_indices( & nt_apnd_out=nt_apnd, nt_hpnd_out=nt_hpnd, nt_ipnd_out=nt_ipnd, & nt_alvl_out=nt_alvl, nt_vlvl_out=nt_vlvl, nt_Tsfc_out=nt_Tsfc, & @@ -357,7 +356,7 @@ subroutine step_therm1 (dt, iblk) do j = jlo, jhi do i = ilo, ihi - if (tr_snow) then + if (snwgrain) then do n = 1, ncat do k = 1, nslyr rsnwn (k,n) = trcrn(i,j,nt_rsnw +k-1,n,iblk) @@ -365,7 +364,7 @@ subroutine step_therm1 (dt, iblk) smliqn(k,n) = trcrn(i,j,nt_smliq+k-1,n,iblk) enddo enddo - endif ! tr_snow + endif ! snwgrain if (tr_iso) then ! trcrn(nt_iso*) has units kg/m^3 do n=1,ncat @@ -556,7 +555,7 @@ subroutine step_therm1 (dt, iblk) endif - if (tr_snow) then + if (snwgrain) then do n = 1, ncat do k = 1, nslyr trcrn(i,j,nt_rsnw +k-1,n,iblk) = rsnwn (k,n) @@ -564,7 +563,7 @@ subroutine step_therm1 (dt, iblk) trcrn(i,j,nt_smliq+k-1,n,iblk) = smliqn(k,n) enddo enddo - endif ! tr_snow + endif ! snwgrain if (tr_iso) then do n = 1, ncat diff --git a/cicecore/cicedyn/infrastructure/ice_read_write.F90 b/cicecore/cicedyn/infrastructure/ice_read_write.F90 index b9074d8f6..041f3516b 100644 --- a/cicecore/cicedyn/infrastructure/ice_read_write.F90 +++ b/cicecore/cicedyn/infrastructure/ice_read_write.F90 @@ -1272,6 +1272,7 @@ subroutine ice_read_nc_xy(fid, nrec, varname, work, diag, & if (orca_halogrid .and. .not. present(restart_ext)) deallocate(work_g2) #else + work = c0 ! to satisfy intent(out) attribute call abort_ice(subname//' ERROR: USE_NETCDF cpp not defined', & file=__FILE__, line=__LINE__) #endif diff --git a/configuration/scripts/cice.batch.csh b/configuration/scripts/cice.batch.csh index 5a47decf1..263b16d02 100755 --- a/configuration/scripts/cice.batch.csh +++ b/configuration/scripts/cice.batch.csh @@ -184,7 +184,7 @@ cat >> ${jobfile} <> ${jobfile} << EOFB #SBATCH -J ${ICE_CASENAME} #SBATCH -t ${batchtime} @@ -194,7 +194,9 @@ cat >> ${jobfile} << EOFB #SBATCH -o slurm%j.out ###SBATCH --mail-type END,FAIL ###SBATCH --mail-user=eclare@lanl.gov -#SBATCH --qos=standby +##SBATCH --qos=debug +#SBATCH --qos=standard +##SBATCH --qos=standby EOFB else if (${ICE_MACHINE} =~ fram*) then diff --git a/configuration/scripts/cice.launch.csh b/configuration/scripts/cice.launch.csh index 971bc0075..fe72e5a27 100755 --- a/configuration/scripts/cice.launch.csh +++ b/configuration/scripts/cice.launch.csh @@ -119,14 +119,14 @@ EOFR endif #======= -else if (${ICE_MACHCOMP} =~ badger*) then +else if (${ICE_MACHCOMP} =~ chicoma*) then if (${ICE_COMMDIR} =~ serial*) then cat >> ${jobfile} << EOFR ./cice >&! \$ICE_RUNLOG_FILE EOFR else cat >> ${jobfile} << EOFR -mpirun -np ${ntasks} ./cice >&! \$ICE_RUNLOG_FILE +srun -n ${ntasks} -c ${nthrds} ./cice >&! \$ICE_RUNLOG_FILE EOFR endif diff --git a/configuration/scripts/machines/Macros.badger_intel b/configuration/scripts/machines/Macros.badger_intel deleted file mode 100644 index ce4eccc9c..000000000 --- a/configuration/scripts/machines/Macros.badger_intel +++ /dev/null @@ -1,56 +0,0 @@ -#============================================================================== -# Macros file for LANL badger, intel compiler -#============================================================================== - -CPP := fpp -CPPDEFS := -DFORTRANUNDERSCORE ${ICE_CPPDEFS} -CFLAGS := -c -O2 -fp-model precise -xHost - -FIXEDFLAGS := -132 -FREEFLAGS := -FR -FFLAGS := -fp-model precise -convert big_endian -assume byterecl -ftz -traceback -xHost -FFLAGS_NOOPT:= -O0 - -ifeq ($(ICE_BLDDEBUG), true) - FFLAGS += -O0 -g -check uninit -check bounds -check pointers -fpe0 -check noarg_temp_created -else - FFLAGS += -O2 -endif - -SCC := icc -SFC := ifort -MPICC := mpicc -MPIFC := mpif90 - -ifeq ($(ICE_COMMDIR), mpi) - FC := $(MPIFC) - CC := $(MPICC) -else - FC := $(SFC) - CC := $(SCC) -endif -LD:= $(FC) - -NETCDF_PATH := /usr/projects/hpcsoft/toss3/common/netcdf/4.4.0_intel-18.0.5 -PNETCDF_PATH := /usr/projects/hpcsoft/toss3/badger/netcdf/4.4.0_intel-18.0.5_openmpi-2.1.2 - -PIO_CONFIG_OPTS:= --enable-filesystem-hints=gpfs - -ifeq ($(ICE_IOTYPE), netcdf) - INCLDIR := $(INCLDIR) -I$(NETCDF_PATH)/include -I$(PNETCDF_PATH)/include - - LIB_NETCDF := $(NETCDF_PATH)/lib - LIB_PNETCDF := $(PNETCDF_PATH)/lib - LIB_MPI := $(IMPILIBDIR) - - SLIBS := -L$(LIB_NETCDF) -lnetcdf -L$(LIB_PNETCDF) -lnetcdff -else - SLIBS := -endif - -ifeq ($(ICE_THREADED), true) - LDFLAGS += -qopenmp - CFLAGS += -qopenmp - FFLAGS += -qopenmp -endif - diff --git a/configuration/scripts/machines/Macros.chicoma_intel b/configuration/scripts/machines/Macros.chicoma_intel new file mode 100644 index 000000000..7767aff8f --- /dev/null +++ b/configuration/scripts/machines/Macros.chicoma_intel @@ -0,0 +1,58 @@ +#============================================================================== +# Macros file for LANL chicoma, intel compiler +#============================================================================== + +CPP := fpp +CPPDEFS := -DFORTRANUNDERSCORE ${ICE_CPPDEFS} +CFLAGS := -c -O2 -fp-model precise -fcommon + +FIXEDFLAGS := -132 +FREEFLAGS := -FR +FFLAGS := -fp-model precise -convert big_endian -assume byterecl -ftz -traceback +# -mcmodel medium -shared-intel +FFLAGS_NOOPT:= -O0 + +ifeq ($(ICE_BLDDEBUG), true) + FFLAGS += -O0 -g -check uninit -check bounds -check pointers -fpe0 -check noarg_temp_created +# FFLAGS += -O0 -g -check all -fpe0 -ftrapuv -fp-model except -check noarg_temp_created -init=snan,arrays +else + FFLAGS += -O2 +endif + +SCC := cc +SFC := ftn +MPICC := cc +MPIFC := ftn + +ifeq ($(ICE_COMMDIR), mpi) + FC := $(MPIFC) + CC := $(MPICC) +else + FC := $(SFC) + CC := $(SCC) +endif +LD:= $(FC) + +# defined by module +#NETCDF_PATH := $(NETCDF_DIR) +NETCDF_PATH := /opt/cray/pe/netcdf-hdf5parallel/4.9.0.1/intel/19.0/ +#PNETCDF_PATH := $(PNETCDF) +#PNETCDF_PATH := /glade/apps/opt/pnetcdf/1.3.0/intel/default +#LAPACK_LIBDIR := /glade/apps/opt/lapack/3.4.2/intel/12.1.5/lib + +#PIO_CONFIG_OPTS:= --enable-filesystem-hints=gpfs + +#INCLDIR := $(INCLDIR) +INCLDIR += -I$(NETCDF_PATH)/include + +LIB_NETCDF := $(NETCDF_PATH)/lib +#LIB_PNETCDF := $(PNETCDF_PATH)/lib +#LIB_MPI := $(IMPILIBDIR) +SLIBS := -L$(LIB_NETCDF) -lnetcdf -lnetcdff + +ifeq ($(ICE_THREADED), true) + LDFLAGS += -qopenmp + CFLAGS += -qopenmp + FFLAGS += -qopenmp +endif + diff --git a/configuration/scripts/machines/env.badger_intel b/configuration/scripts/machines/env.badger_intel deleted file mode 100644 index 5532b26d6..000000000 --- a/configuration/scripts/machines/env.badger_intel +++ /dev/null @@ -1,47 +0,0 @@ -#!/bin/tcsh -f - -set inp = "undefined" -if ($#argv == 1) then - set inp = $1 -endif - -if ("$inp" != "-nomodules") then - -#source /usr/share/Modules/init/csh - -#module purge -#module load intel -#module load openmpi -module unload hdf5-serial -module unload hdf5-parallel -module unload netcdf-serial -module unload netcdf-h5parallel -module load hdf5-serial -module load netcdf-serial/4.4.0 -module load hdf5-parallel -module load netcdf-h5parallel/4.4.0 - -#setenv OMP_STACKSIZE 256M -#setenv MP_LABELIO yes -#setenv MP_INFOLEVEL 2 -#setenv MP_SHARED_MEMORY yes -#setenv MP_EUILIB us -#setenv MP_EAGER_LIMIT 0 - -endif - -setenv ICE_MACHINE_MACHNAME badger -setenv ICE_MACHINE_MACHINFO "Penguin Intel Xeon Broadwell" -setenv ICE_MACHINE_ENVNAME intel -setenv ICE_MACHINE_ENVINFO "(Note: can vary) ifort 19.0.4.243 20190416, openmpi/2.1.2, netcdf4.4.0" -setenv ICE_MACHINE_MAKE gmake -setenv ICE_MACHINE_WKDIR /net/scratch4/$user/CICE_RUNS -setenv ICE_MACHINE_INPUTDATA /usr/projects/climate/eclare/DATA/Consortium -setenv ICE_MACHINE_BASELINE /net/scratch4/$user/CICE_BASELINE -setenv ICE_MACHINE_SUBMIT "sbatch " -#setenv ICE_MACHINE_ACCT e3sm -setenv ICE_MACHINE_ACCT climatehilat -setenv ICE_MACHINE_QUEUE "default" -setenv ICE_MACHINE_TPNODE 16 -setenv ICE_MACHINE_BLDTHRDS 1 -setenv ICE_MACHINE_QSTAT "squeue --jobs=" diff --git a/configuration/scripts/machines/env.chicoma_intel b/configuration/scripts/machines/env.chicoma_intel new file mode 100755 index 000000000..a324ec0fe --- /dev/null +++ b/configuration/scripts/machines/env.chicoma_intel @@ -0,0 +1,71 @@ +#!/bin/csh -f + +# this works (current defaults with PrgEnv-intel) +#Currently Loaded Modules: +# 1) craype-x86-rome 7) python/3.10-anaconda-2023.03 13) cray-mpich/8.1.21 +# 2) libfabric/1.15.0.0 8) craype/2.7.19 14) totalview/2023.1.6 +# 3) craype-network-ofi 9) cray-dsmml/0.2.2 15) use.own +# 4) perftools-base/22.09.0 10) cray-libsci/22.11.1.2 16) idl/8.5 +# 5) xpmem/2.4.4-2.3_13.8__gff0e1d9.shasta 11) PrgEnv-intel/8.3.3 17) cray-hdf5-parallel/1.12.2.1 +# 6) git/2.40.0 12) intel/2022.2.1 18) cray-netcdf-hdf5parallel/4.9.0.1 + +set inp = "undefined" +if ($#argv == 1) then + set inp = $1 +endif + +if ("$inp" != "-nomodules") then + +#source /opt/modules/default/init/csh + +#module unload PrgEnv-cray +#module unload PrgEnv-gnu +#module unload PrgEnv-intel +#module unload PrgEnv-pgi +#module load PrgEnv-intel/8.3.3 + +#module unload intel +#module load intel/2022.2.1 + +#module unload cray-mpich +#module unload cray-mpich2 +#module load cray-mpich/8.1.21 + +#module unload netcdf +#module unload cray-netcdf +#module unload cray-hdf5 +#module unload cray-hdf5-parallel +#module unload cray-netcdf-hdf5parallel +#module unload cray-parallel-netcdf +#module load cray-hdf5/1.12.2.1 +#module load cray-netcdf/4.9.0.1 +#module load cray-hdf5-parallel/1.12.2.1 +#module load cray-netcdf-hdf5parallel/4.9.0.1 + +#module unload cray-libsci +#module unload craype-hugepages2M +#module load craype-broadwell + +#setenv NETCDF_PATH ${NETCDF_DIR} +#setenv NETCDF_PATH /opt/cray/pe/netcdf/4.9.0.1/intel/19.0 +#setenv NETCDF_PATH /opt/cray/pe/netcdf-hdf5parallel/4.9.0.1/intel/19.0 +limit coredumpsize unlimited +limit stacksize unlimited +setenv OMP_STACKSIZE 64M + +endif + +setenv ICE_MACHINE_MACHNAME chicoma +setenv ICE_MACHINE_MACHINFO "HPE Cray EX, AMD EPYC 7H12 processors" +setenv ICE_MACHINE_ENVNAME intel +setenv ICE_MACHINE_ENVINFO "PrgEnv-intel/8.3.3 intel/2022.2.1 cray-mpich/8.1.21 cray-hdf4-parallel/1/12.2.1 cray-netcdf-hdf5parallel/4.9.0.1" +setenv ICE_MACHINE_MAKE gmake +setenv ICE_MACHINE_WKDIR /lustre/scratch5/$user/CICE_RUNS +setenv ICE_MACHINE_INPUTDATA /usr/projects/climate/eclare/DATA/Consortium +setenv ICE_MACHINE_BASELINE /lustre/scratch5/$user/CICE_BASELINE +setenv ICE_MACHINE_SUBMIT "sbatch " +setenv ICE_MACHINE_ACCT t23_cice +setenv ICE_MACHINE_QUEUE "debug" +setenv ICE_MACHINE_TPNODE 128 # tasks per node +setenv ICE_MACHINE_BLDTHRDS 12 +setenv ICE_MACHINE_QSTAT "squeue --jobs=" diff --git a/icepack b/icepack index 4728746ea..86cae16d1 160000 --- a/icepack +++ b/icepack @@ -1 +1 @@ -Subproject commit 4728746ea2926bf10acc5de354b3eae16d418af5 +Subproject commit 86cae16d1b7c4c4f8a410fccac155374afac777f From 357103a2df0428089d54bdacf9eab621a5e1f710 Mon Sep 17 00:00:00 2001 From: Tony Craig Date: Tue, 22 Aug 2023 11:27:28 -0700 Subject: [PATCH 14/76] 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) --- .../cicedyn/analysis/ice_diagnostics_bgc.F90 | 225 +----------------- cicecore/cicedyn/analysis/ice_history.F90 | 4 +- cicecore/cicedyn/analysis/ice_history_bgc.F90 | 130 ++-------- .../cicedyn/dynamics/ice_transport_driver.F90 | 8 +- cicecore/cicedyn/general/ice_flux.F90 | 10 - cicecore/cicedyn/general/ice_flux_bgc.F90 | 6 - cicecore/cicedyn/general/ice_step_mod.F90 | 23 +- .../io/io_binary/ice_restart.F90 | 20 +- .../io/io_netcdf/ice_restart.F90 | 15 +- .../infrastructure/io/io_pio2/ice_restart.F90 | 14 +- .../drivers/standalone/cice/CICE_InitMod.F90 | 10 +- .../drivers/standalone/cice/CICE_RunMod.F90 | 19 +- .../unittest/gridavgchk/CICE_InitMod.F90 | 75 ++++-- .../drivers/unittest/halochk/CICE_InitMod.F90 | 75 ++++-- .../drivers/unittest/opticep/CICE_InitMod.F90 | 10 +- .../drivers/unittest/opticep/CICE_RunMod.F90 | 19 +- .../unittest/opticep/ice_init_column.F90 | 144 ++--------- .../drivers/unittest/opticep/ice_step_mod.F90 | 32 +-- .../drivers/unittest/sumchk/CICE_InitMod.F90 | 76 ++++-- cicecore/shared/ice_arrays_column.F90 | 75 ++---- cicecore/shared/ice_init_column.F90 | 138 ++--------- cicecore/shared/ice_restart_column.F90 | 94 +------- configuration/scripts/options/set_nml.zsal | 8 - doc/source/user_guide/ug_case_settings.rst | 4 +- icepack | 2 +- 25 files changed, 320 insertions(+), 916 deletions(-) delete mode 100644 configuration/scripts/options/set_nml.zsal diff --git a/cicecore/cicedyn/analysis/ice_diagnostics_bgc.F90 b/cicecore/cicedyn/analysis/ice_diagnostics_bgc.F90 index f4528dd5d..1caabab02 100644 --- a/cicecore/cicedyn/analysis/ice_diagnostics_bgc.F90 +++ b/cicecore/cicedyn/analysis/ice_diagnostics_bgc.F90 @@ -24,7 +24,7 @@ module ice_diagnostics_bgc implicit none private - public :: hbrine_diags, bgc_diags, zsal_diags + public :: hbrine_diags, bgc_diags !======================================================================= @@ -715,7 +715,7 @@ subroutine bgc_diags endif if (tr_bgc_N) then write(nu_diag,*) '---------------------------------------------------' - write(nu_diag,900) 'tot algal growth (1/d) = ',pgrow_net(1),pgrow_net(2) + write(nu_diag,901) 'tot algal growth (1/d) = ',pgrow_net(1),pgrow_net(2) do kk = 1,n_algae write(nu_diag,*) ' algal conc. (mmol N/m^3) or flux (mmol N/m^2/d)' write(nu_diag,1020) ' type:', kk @@ -846,230 +846,11 @@ subroutine bgc_diags 802 format (f24.17,2x,f24.17) 803 format (a25,2x,a25) 900 format (a25,2x,f24.17,2x,f24.17) + 901 format (a25,2x,g24.17,2x,g24.17) 1020 format (a30,2x,i6) ! integer end subroutine bgc_diags -!======================================================================= -! -! Writes diagnostic info (max, min, global sums, etc) to standard out -! -! authors: Elizabeth C. Hunke, LANL -! Bruce P. Briegleb, NCAR -! Cecilia M. Bitz, UW -! Nicole Jeffery, LANL - - subroutine zsal_diags - - use ice_arrays_column, only: fzsal, fzsal_g, sice_rho, bTiz, & - iDi, bphi, dhbr_top, dhbr_bot, darcy_V - use ice_broadcast, only: broadcast_scalar, broadcast_array - use ice_diagnostics, only: npnt, print_points, pmloc, piloc, pjloc, & - pbloc - use ice_domain_size, only: nblyr, ncat, nilyr - use ice_state, only: aicen, aice, vice, trcr, trcrn, vicen, vsno - - ! local variables - - integer (kind=int_kind) :: & - i, j, k, n, nn, iblk - - ! fields at diagnostic points - real (kind=dbl_kind), dimension(npnt) :: & - phinS, phinS1,& - phbrn,pdh_top1,pdh_bot1, psice_rho, pfzsal, & - pfzsal_g, pdarcy_V1 - - ! vertical fields of category 1 at diagnostic points for bgc layer model - real (kind=dbl_kind), dimension(npnt,nblyr+2) :: & - pphin, pphin1 - real (kind=dbl_kind), dimension(npnt,nblyr) :: & - pSin, pSice, pSin1 - - real (kind=dbl_kind), dimension(npnt,nblyr+1) :: & - pbTiz, piDin - - real (kind=dbl_kind) :: & - rhosi, rhow, rhos - - logical (kind=log_kind) :: tr_brine - - integer (kind=int_kind) :: nt_fbri, nt_bgc_S, nt_sice - character(len=*), parameter :: subname = '(zsal_diags)' - - call icepack_query_parameters(rhosi_out=rhosi, rhow_out=rhow, rhos_out=rhos) - call icepack_query_tracer_flags(tr_brine_out=tr_brine) - call icepack_query_tracer_indices(nt_fbri_out=nt_fbri, nt_bgc_S_out=nt_bgc_S, & - nt_sice_out=nt_sice) - call icepack_warnings_flush(nu_diag) - if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & - file=__FILE__, line=__LINE__) - - !----------------------------------------------------------------- - ! salinity and microstructure of the ice - !----------------------------------------------------------------- - - if (print_points) then - - !----------------------------------------------------------------- - ! state of the ice and associated fluxes for 2 defined points - ! NOTE these are computed for the last timestep only (not avg) - !----------------------------------------------------------------- - - do n = 1, npnt - if (my_task == pmloc(n)) then - i = piloc(n) - j = pjloc(n) - iblk = pbloc(n) - - pfzsal(n) = fzsal(i,j,iblk) - pfzsal_g(n) = fzsal_g(i,j,iblk) - phinS(n) = c0 - phinS1(n) = c0 - phbrn(n) = c0 - psice_rho(n) = c0 - pdh_top1(n) = c0 - pdh_bot1(n) = c0 - pdarcy_V1(n) = c0 - do nn = 1,ncat - psice_rho(n) = psice_rho(n) + sice_rho(i,j,nn,iblk)*aicen(i,j,nn,iblk) - enddo - if (aice(i,j,iblk) > c0) & - psice_rho(n) = psice_rho(n)/aice(i,j,iblk) - if (tr_brine .and. aice(i,j,iblk) > c0) then - phinS(n) = trcr(i,j,nt_fbri,iblk)*vice(i,j,iblk)/aice(i,j,iblk) - phbrn(n) = (c1 - rhosi/rhow)*vice(i,j,iblk)/aice(i,j,iblk) & - - rhos/rhow *vsno(i,j,iblk)/aice(i,j,iblk) - endif - if (tr_brine .and. aicen(i,j,1,iblk)> c0) then - phinS1(n) = trcrn(i,j,nt_fbri,1,iblk) & - * vicen(i,j,1,iblk)/aicen(i,j,1,iblk) - pdh_top1(n) = dhbr_top(i,j,1,iblk) - pdh_bot1(n) = dhbr_bot(i,j,1,iblk) - pdarcy_V1(n) = darcy_V(i,j,1,iblk) - endif - do k = 1, nblyr+1 - pbTiz(n,k) = c0 - piDin(n,k) = c0 - do nn = 1,ncat - pbTiz(n,k) = pbTiz(n,k) + bTiz(i,j,k,nn,iblk)*vicen(i,j,nn,iblk) - piDin(n,k) = piDin(n,k) + iDi(i,j,k,nn,iblk)*vicen(i,j,nn,iblk) - enddo - if (vice(i,j,iblk) > c0) then - pbTiz(n,k) = pbTiz(n,k)/vice(i,j,iblk) - piDin(n,k) = piDin(n,k)/vice(i,j,iblk) - endif - enddo ! k - do k = 1, nblyr+2 - pphin(n,k) = c0 - pphin1(n,k) = c0 - if (aicen(i,j,1,iblk) > c0) pphin1(n,k) = bphi(i,j,k,1,iblk) - do nn = 1,ncat - pphin(n,k) = pphin(n,k) + bphi(i,j,k,nn,iblk)*vicen(i,j,nn,iblk) - enddo - if (vice(i,j,iblk) > c0) then - pphin(n,k) = pphin(n,k)/vice(i,j,iblk) - endif - enddo - do k = 1,nblyr - pSin(n,k) = c0 - pSin1(n,k) = c0 - pSin(n,k)= trcr(i,j,nt_bgc_S+k-1,iblk) - if (aicen(i,j,1,iblk) > c0) pSin1(n,k) = trcrn(i,j,nt_bgc_S+k-1,1,iblk) - enddo - do k = 1,nilyr - pSice(n,k) = trcr(i,j,nt_sice+k-1,iblk) - enddo - endif ! my_task = pmloc - - call broadcast_scalar(phinS (n), pmloc(n)) - call broadcast_scalar(phinS1 (n), pmloc(n)) - call broadcast_scalar(phbrn (n), pmloc(n)) - call broadcast_scalar(pdh_top1 (n), pmloc(n)) - call broadcast_scalar(pdh_bot1 (n), pmloc(n)) - call broadcast_scalar(psice_rho(n), pmloc(n)) - call broadcast_scalar(pfzsal_g (n), pmloc(n)) - call broadcast_scalar(pdarcy_V1(n), pmloc(n)) - call broadcast_scalar(pfzsal (n), pmloc(n)) - call broadcast_array (pbTiz (n,:), pmloc(n)) - call broadcast_array (piDin (n,:), pmloc(n)) - call broadcast_array (pphin (n,:), pmloc(n)) - call broadcast_array (pphin1 (n,:), pmloc(n)) - call broadcast_array (pSin (n,:), pmloc(n)) - call broadcast_array (pSin1 (n,:), pmloc(n)) - call broadcast_array (pSice (n,:), pmloc(n)) - enddo ! npnt - endif ! print_points - - !----------------------------------------------------------------- - ! start spewing - !----------------------------------------------------------------- - - if (my_task == master_task) then - - call flush_fileunit(nu_diag) - - !----------------------------------------------------------------- - ! diagnostics for Arctic and Antarctic points - !----------------------------------------------------------------- - - if (print_points) then - - write(nu_diag,*) ' ' - write(nu_diag,902) ' Brine height ' - write(nu_diag,900) 'hbrin = ',phinS(1),phinS(2) - write(nu_diag,900) 'hbrin cat 1 = ',phinS1(1),phinS1(2) - write(nu_diag,900) 'Freeboard = ',phbrn(1),phbrn(2) - write(nu_diag,900) 'dhbrin cat 1 top = ',pdh_top1(1),pdh_top1(2) - write(nu_diag,900) 'dhbrin cat 1 bottom = ',pdh_bot1(1),pdh_bot1(2) - write(nu_diag,*) ' ' - write(nu_diag,902) ' zSalinity ' - write(nu_diag,900) 'Avg density (kg/m^3) = ',psice_rho(1),psice_rho(2) - write(nu_diag,900) 'Salt flux (kg/m^2/s) = ',pfzsal(1),pfzsal(2) - write(nu_diag,900) 'Grav. Drain. Salt flux = ',pfzsal_g(1),pfzsal_g(2) - write(nu_diag,900) 'Darcy V cat 1 (m/s) = ',pdarcy_V1(1),pdarcy_V1(2) - write(nu_diag,*) ' ' - write(nu_diag,*) ' Top down bgc Layer Model' - write(nu_diag,*) ' ' - write(nu_diag,803) 'bTiz(1) ice temp',' bTiz(2) ice temp ' - write(nu_diag,*) '---------------------------------------------------' - write(nu_diag,802) ((pbTiz(n,k),n = 1,2), k = 1,nblyr+1) - write(nu_diag,*) ' ' - write(nu_diag,803) 'iDi(1) diffusivity ','iDi(2) diffusivity ' - write(nu_diag,*) '---------------------------------------------------' - write(nu_diag,802) ((piDin(n,k),n=1,2), k = 1,nblyr+1) - write(nu_diag,*) ' ' - write(nu_diag,803) 'bphi(1) porosity ','bphi(2) porosity ' - write(nu_diag,*) '---------------------------------------------------' - write(nu_diag,802) ((pphin(n,k),n=1,2), k = 1,nblyr+1) - write(nu_diag,*) ' ' - write(nu_diag,803) 'phi1(1) porosity ','phi1(2) porosity ' - write(nu_diag,*) '---------------------------------------------------' - write(nu_diag,802) ((pphin1(n,k),n=1,2), k = 1,nblyr+1) - write(nu_diag,*) ' ' - write(nu_diag,803) 'zsal(1) cat 1 ','zsal(2) cat 1 ' - write(nu_diag,*) '---------------------------------------------------' - write(nu_diag,802) ((pSin1(n,k),n=1,2), k = 1,nblyr) - write(nu_diag,*) ' ' - write(nu_diag,803) 'zsal(1) Avg S ','zsal(2) Avg S ' - write(nu_diag,*) '---------------------------------------------------' - write(nu_diag,802) ((pSin(n,k),n=1,2), k = 1,nblyr) - write(nu_diag,*) ' ' - write(nu_diag,803) 'Sice(1) Ice S ','Sice(2) Ice S ' - write(nu_diag,*) '---------------------------------------------------' - write(nu_diag,802) ((pSice(n,k),n=1,2), k = 1,nilyr) - write(nu_diag,*) ' ' - - endif ! print_points - endif ! my_task = master_task - - 802 format (f24.17,2x,f24.17) - 803 format (a25,2x,a25) - 900 format (a25,2x,f24.17,2x,f24.17) - 902 format (a25,10x,f6.1,1x,f6.1,9x,f6.1,1x,f6.1) - - end subroutine zsal_diags - !======================================================================= end module ice_diagnostics_bgc diff --git a/cicecore/cicedyn/analysis/ice_history.F90 b/cicecore/cicedyn/analysis/ice_history.F90 index 3eda456ec..80bce65b4 100644 --- a/cicecore/cicedyn/analysis/ice_history.F90 +++ b/cicecore/cicedyn/analysis/ice_history.F90 @@ -92,7 +92,7 @@ subroutine init_hist (dt) logical (kind=log_kind) :: formdrag logical (kind=log_kind) :: tr_iage, tr_FY, tr_lvl, tr_pond, tr_aero, tr_brine logical (kind=log_kind) :: tr_fsd, tr_snow - logical (kind=log_kind) :: skl_bgc, solve_zsal, solve_zbgc, z_tracers + logical (kind=log_kind) :: skl_bgc, solve_zbgc, z_tracers integer (kind=int_kind) :: n, ns, ns1, ns2 integer (kind=int_kind), dimension(max_nstrm) :: & ntmp @@ -222,7 +222,7 @@ subroutine init_hist (dt) call icepack_query_parameters(rhofresh_out=rhofresh, Tffresh_out=Tffresh, & secday_out=secday, rad_to_deg_out=rad_to_deg) call icepack_query_parameters(formdrag_out=formdrag, skl_bgc_out=skl_bgc, & - solve_zsal_out=solve_zsal, solve_zbgc_out=solve_zbgc, z_tracers_out=z_tracers) + solve_zbgc_out=solve_zbgc, z_tracers_out=z_tracers) call icepack_query_tracer_flags(tr_iage_out=tr_iage, tr_FY_out=tr_FY, & tr_lvl_out=tr_lvl, tr_pond_out=tr_pond, tr_aero_out=tr_aero, & tr_brine_out=tr_brine, tr_fsd_out=tr_fsd, tr_snow_out=tr_snow) diff --git a/cicecore/cicedyn/analysis/ice_history_bgc.F90 b/cicecore/cicedyn/analysis/ice_history_bgc.F90 index 6974a087b..7c87c1f70 100644 --- a/cicecore/cicedyn/analysis/ice_history_bgc.F90 +++ b/cicecore/cicedyn/analysis/ice_history_bgc.F90 @@ -39,9 +39,6 @@ module ice_history_bgc f_iso = 'x', & f_faero_atm = 'x', f_faero_ocn = 'x', & f_aero = 'x', & - f_fzsal = 'm', f_fzsal_ai = 'm', & - f_fzsal_g = 'm', f_fzsal_g_ai = 'm', & - f_zsal = 'x', & f_fbio = 'x', f_fbio_ai = 'x', & f_zaero = 'x', f_bgc_S = 'x', & f_bgc_N = 'x', f_bgc_C = 'x', & @@ -153,11 +150,6 @@ module ice_history_bgc ! field indices !--------------------------------------------------------------- - integer (kind=int_kind), dimension(max_nstrm), public :: & - n_fzsal , n_fzsal_ai , & - n_fzsal_g , n_fzsal_g_ai , & - n_zsal - integer(kind=int_kind), dimension(icepack_max_iso,max_nstrm) :: & n_fiso_atm , & n_fiso_ocn , & @@ -216,7 +208,6 @@ module ice_history_bgc n_bgc_Fed_cat1, n_bgc_Fep_cat1 integer(kind=int_kind), dimension(max_nstrm) :: & - n_bgc_S , & n_fNit , n_fNit_ai , & n_fAm , n_fAm_ai , & n_fSil , n_fSil_ai , & @@ -282,7 +273,7 @@ subroutine init_hist_bgc_2D tr_bgc_DMS, tr_bgc_PON, & tr_bgc_N, tr_bgc_C, tr_bgc_chl, & tr_bgc_DON, tr_bgc_Fe, tr_bgc_hum, & - skl_bgc, solve_zsal, z_tracers + skl_bgc, z_tracers character(len=char_len) :: nml_name ! for namelist check character(len=char_len_long) :: tmpstr2 ! for namelist check @@ -290,7 +281,7 @@ subroutine init_hist_bgc_2D character(len=*), parameter :: subname = '(init_hist_bgc_2D)' call icepack_query_parameters(skl_bgc_out=skl_bgc, & - solve_zsal_out=solve_zsal, z_tracers_out=z_tracers) + z_tracers_out=z_tracers) call icepack_query_tracer_flags( & tr_iso_out =tr_iso, tr_zaero_out =tr_zaero, & tr_aero_out =tr_aero, tr_brine_out =tr_brine, & @@ -629,25 +620,6 @@ subroutine init_hist_bgc_2D f_bgc_DMS_cat1 = f_bgc_DMS f_bgc_PON_cat1 = f_bgc_PON - if (solve_zsal) then - f_fzsal = f_fsalt - f_fzsal_g = f_fsalt - f_fzsal_ai = f_fsalt_ai - f_fzsal_g_ai = f_fsalt_ai - f_zsal = f_sice - f_fsalt = 'x' - f_fsalt_ai = 'x' - f_sice = 'x' - else - f_fzsal = 'x' - f_fzsal_g = 'x' - f_fzsal_ai = 'x' - f_fzsal_g_ai = 'x' - f_zsal = 'x' - f_bgc_S = 'x' - f_iki = 'x' - endif - call broadcast_scalar (f_fiso_atm, master_task) call broadcast_scalar (f_fiso_ocn, master_task) call broadcast_scalar (f_iso, master_task) @@ -656,11 +628,6 @@ subroutine init_hist_bgc_2D call broadcast_scalar (f_aero, master_task) call broadcast_scalar (f_fbri, master_task) call broadcast_scalar (f_hbri, master_task) - call broadcast_scalar (f_fzsal, master_task) - call broadcast_scalar (f_fzsal_ai, master_task) - call broadcast_scalar (f_fzsal_g, master_task) - call broadcast_scalar (f_fzsal_g_ai, master_task) - call broadcast_scalar (f_zsal, master_task) call broadcast_scalar (f_fNit, master_task) call broadcast_scalar (f_fNit_ai, master_task) call broadcast_scalar (f_fDOC, master_task) @@ -740,7 +707,6 @@ subroutine init_hist_bgc_2D call broadcast_scalar (f_bphi, master_task) call broadcast_scalar (f_iDi, master_task) call broadcast_scalar (f_iki, master_task) - call broadcast_scalar (f_bgc_S, master_task) call broadcast_scalar (f_zfswin, master_task) call broadcast_scalar (f_PPnet, master_task) call broadcast_scalar (f_algalpeak, master_task) @@ -800,7 +766,7 @@ subroutine init_hist_bgc_2D ! 2D variables - if (tr_iso .or. tr_aero .or. tr_brine .or. solve_zsal .or. skl_bgc) then + if (tr_iso .or. tr_aero .or. tr_brine .or. skl_bgc) then do ns = 1, nstreams if (histfreq(ns) /= 'x') then @@ -839,33 +805,6 @@ subroutine init_hist_bgc_2D enddo endif - ! zsalinity - - call define_hist_field(n_fzsal,"fzsal","kg/m^2/s",tstr2D, tcstr, & - "prognostic salt flux ice to ocn (cpl)", & - "if positive, ocean gains salt", c1, c0, & - ns, f_fzsal) - - call define_hist_field(n_fzsal_ai,"fzsal_ai","kg/m^2/s",tstr2D, tcstr, & - "prognostic salt flux ice to ocean", & - "weighted by ice area", c1, c0, & - ns, f_fzsal_ai) - - call define_hist_field(n_fzsal_g,"fzsal_g","kg/m^2/s",tstr2D, tcstr, & - "Gravity drainage salt flux ice to ocn (cpl)", & - "if positive, ocean gains salt", c1, c0, & - ns, f_fzsal_g) - - call define_hist_field(n_fzsal_g_ai,"fzsal_g_ai","kg/m^2/s",tstr2D, tcstr, & - "Gravity drainage salt flux ice to ocean", & - "weighted by ice area", c1, c0, & - ns, f_fzsal_g_ai) - - call define_hist_field(n_zsal,"zsal_tot","g/m^2",tstr2D, tcstr, & - "Total Salt content", & - "In ice volume*fbri", c1, c0, & - ns, f_zsal) - ! Aerosols if (f_aero(1:1) /= 'x') then do n=1,n_aero @@ -1851,19 +1790,18 @@ subroutine init_hist_bgc_3Db integer (kind=int_kind) :: ns real (kind=dbl_kind) :: secday - logical (kind=log_kind) :: solve_zsal, z_tracers + logical (kind=log_kind) :: z_tracers character(len=*), parameter :: subname = '(init_hist_bgc_3Db)' ! biology vertical grid call icepack_query_parameters(secday_out=secday) - call icepack_query_parameters( & - solve_zsal_out=solve_zsal, z_tracers_out=z_tracers) + call icepack_query_parameters(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__) - if (z_tracers .or. solve_zsal) then + if (z_tracers) then do ns = 1, nstreams if (histfreq(ns) /= 'x') then @@ -1889,11 +1827,6 @@ subroutine init_hist_bgc_3Db "permeability", "on bio interface grid", 1.0e6_dbl_kind, c0, & ns, f_iki) - if (f_bgc_S(1:1) /= 'x') & - call define_hist_field(n_bgc_S,"bgc_S","ppt",tstr3Db, tcstr, & - "bulk salinity", "on bio grid", c1, c0, & - ns, f_bgc_S) - if (f_zfswin(1:1) /= 'x') & call define_hist_field(n_zfswin,"zfswin","W/m^2",tstr3Db, tcstr, & "internal ice PAR", "on bio interface grid", c1, c0, & @@ -1902,7 +1835,7 @@ subroutine init_hist_bgc_3Db endif ! histfreq(ns) /= 'x' enddo ! ns - endif ! z_tracers or solve_zsal + endif ! z_tracers end subroutine init_hist_bgc_3Db @@ -1914,14 +1847,14 @@ subroutine accum_hist_bgc (iblk) use ice_arrays_column, only: ocean_bio, & grow_net, PP_net, upNO, upNH, ice_bio_net, snow_bio_net, & - hbri, bTiz, bphi, zfswin, iDi, iki, zsal_tot, fzsal, fzsal_g, & + hbri, bTiz, bphi, zfswin, iDi, iki, & R_C2N, R_chl2N use ice_blocks, only: block, get_block, nx_block, ny_block use ice_domain, only: blocks_ice use ice_domain_size, only: nblyr use ice_flux, only: sss use ice_flux_bgc, only: fiso_atm, fiso_ocn, faero_atm, faero_ocn, & - flux_bio, flux_bio_ai, fzsal_ai, fzsal_g_ai + flux_bio, flux_bio_ai use ice_history_shared, only: n2D, a2D, a3Dc, & n3Dzcum, n3Dbcum, a3Db, a3Da, & ncat_hist, accum_hist_field, nzblyr, nzalyr @@ -1954,12 +1887,12 @@ subroutine accum_hist_bgc (iblk) workii logical (kind=log_kind) :: & - skl_bgc, z_tracers, tr_iso, tr_aero, tr_brine, solve_zsal + skl_bgc, z_tracers, tr_iso, tr_aero, tr_brine integer(kind=int_kind) :: & nt_isosno, nt_isoice, nt_aero, nt_fbri, & nt_bgc_Nit, nt_bgc_Am, nt_bgc_Sil, nt_bgc_DMSPp, & - nt_bgc_DMSPd, nt_bgc_DMS, nt_bgc_PON, nt_bgc_S, & + nt_bgc_DMSPd, nt_bgc_DMS, nt_bgc_PON, & nt_zbgc_frac, nlt_chl_sw, & nlt_bgc_Nit, nlt_bgc_Am, nlt_bgc_Sil, & nlt_bgc_DMS, nlt_bgc_PON, & @@ -2000,7 +1933,7 @@ subroutine accum_hist_bgc (iblk) call icepack_query_tracer_flags(tr_iso_out=tr_iso, & tr_aero_out=tr_aero, tr_brine_out=tr_brine) call icepack_query_parameters(skl_bgc_out=skl_bgc, & - solve_zsal_out=solve_zsal, z_tracers_out=z_tracers) + z_tracers_out=z_tracers) call icepack_query_tracer_indices( & nt_isosno_out=nt_isosno, nt_isoice_out=nt_isoice, & nt_aero_out=nt_aero, & @@ -2012,7 +1945,7 @@ subroutine accum_hist_bgc (iblk) nt_bgc_Sil_out=nt_bgc_Sil, nt_bgc_DMSPp_out=nt_bgc_DMSPp, & nt_bgc_DMSPd_out=nt_bgc_DMSPd, nt_bgc_DMS_out=nt_bgc_DMS, & nt_bgc_PON_out=nt_bgc_PON, & - nt_bgc_S_out=nt_bgc_S, nt_bgc_Fed_out=nt_bgc_Fed, & + nt_bgc_Fed_out=nt_bgc_Fed, & nt_bgc_Fep_out=nt_bgc_Fep, nt_zbgc_frac_out=nt_zbgc_frac, & nlt_zaero_sw_out=nlt_zaero_sw, nlt_chl_sw_out=nlt_chl_sw, & nlt_bgc_Nit_out=nlt_bgc_Nit, nlt_bgc_Am_out=nlt_bgc_Am, & @@ -2042,19 +1975,7 @@ subroutine accum_hist_bgc (iblk) ! 2d bgc fields if (allocated(a2D)) then - if (tr_iso .or. tr_aero .or. tr_brine .or. solve_zsal .or. skl_bgc) then - - ! zsalinity - if (f_fzsal (1:1) /= 'x') & - call accum_hist_field(n_fzsal, iblk, fzsal(:,:,iblk), a2D) - if (f_fzsal_ai(1:1)/= 'x') & - call accum_hist_field(n_fzsal_ai, iblk, fzsal_ai(:,:,iblk), a2D) - if (f_fzsal_g (1:1) /= 'x') & - call accum_hist_field(n_fzsal_g, iblk, fzsal_g(:,:,iblk), a2D) - if (f_fzsal_g_ai(1:1)/= 'x') & - call accum_hist_field(n_fzsal_g_ai,iblk, fzsal_g_ai(:,:,iblk), a2D) - if (f_zsal (1:1) /= 'x') & - call accum_hist_field(n_zsal, iblk, zsal_tot(:,:,iblk), a2D) + if (tr_iso .or. tr_aero .or. tr_brine .or. skl_bgc) then ! isotopes if (f_fiso_atm(1:1) /= 'x') then @@ -2663,7 +2584,7 @@ subroutine accum_hist_bgc (iblk) call accum_hist_field(n_hbri, iblk, & hbri(:,:,iblk), a2D) - endif ! 2d bgc tracers, tr_aero, tr_brine, solve_zsal, skl_bgc + endif ! 2d bgc tracers, tr_aero, tr_brine, skl_bgc endif ! allocated(a2D) ! 3D category fields @@ -2679,7 +2600,7 @@ subroutine accum_hist_bgc (iblk) endif ! allocated(a3Dc) if (allocated(a3Db)) then - if (z_tracers .or. solve_zsal) then + if (z_tracers) then ! 3Db category fields if (f_bTin (1:1) /= 'x') then @@ -2714,21 +2635,6 @@ subroutine accum_hist_bgc (iblk) workz(:,:,1:nzblyr), a3Db) endif - if (f_bgc_S (1:1) /= 'x') then - workz(:,:,:) = c0 - do j = jlo, jhi - do i = ilo, ihi - if (aice(i,j,iblk) > c0) then - workz(i,j,1) = trcr(i,j,nt_bgc_S,iblk) - workz(i,j,2:nblyr+1) = trcr(i,j,nt_bgc_S:nt_bgc_S+nblyr-1,iblk) - workz(i,j,nblyr+2) = sss(i,j,iblk) - endif - enddo ! i - enddo ! j - call accum_hist_field(n_bgc_S-n3Dzcum, iblk, nzblyr, & - workz(:,:,1:nzblyr), a3Db) - endif - if (f_zfswin (1:1) /= 'x') then workz(:,:,:) = c0 do n = 1, ncat_hist @@ -3492,7 +3398,7 @@ subroutine init_history_bgc use ice_arrays_column, only: PP_net, grow_net, hbri, & ice_bio_net, snow_bio_net, fbio_snoice, fbio_atmice, & - fzsal, fzsal_g, zfswin + zfswin use ice_flux_bgc, only: flux_bio, flux_bio_ai, fnit, fsil, & famm, fdmsp, fdms, fhum, fdust, falgalN, fdoc, fdic, & fdon, ffep, ffed @@ -3508,8 +3414,6 @@ subroutine init_history_bgc snow_bio_net(:,:,:,:) = c0 fbio_snoice (:,:,:,:) = c0 fbio_atmice (:,:,:,:) = c0 - fzsal (:,:,:) = c0 - fzsal_g (:,:,:) = c0 zfswin (:,:,:,:,:) = c0 fnit (:,:,:) = c0 fsil (:,:,:) = c0 diff --git a/cicecore/cicedyn/dynamics/ice_transport_driver.F90 b/cicecore/cicedyn/dynamics/ice_transport_driver.F90 index 4f9d84d98..8ff833086 100644 --- a/cicecore/cicedyn/dynamics/ice_transport_driver.F90 +++ b/cicecore/cicedyn/dynamics/ice_transport_driver.F90 @@ -89,7 +89,7 @@ subroutine init_transport nt_alvl , nt_vlvl , & nt_apnd , nt_hpnd , nt_ipnd , nt_fsd , & nt_smice , nt_smliq , nt_rhos , nt_rsnw , & - nt_isosno, nt_isoice, nt_bgc_Nit, nt_bgc_S + nt_isosno, nt_isoice, nt_bgc_Nit character(len=*), parameter :: subname = '(init_transport)' @@ -102,8 +102,7 @@ subroutine init_transport nt_alvl_out=nt_alvl, nt_vlvl_out=nt_vlvl, & nt_apnd_out=nt_apnd, nt_hpnd_out=nt_hpnd, nt_ipnd_out=nt_ipnd, & nt_smice_out=nt_smice, nt_smliq_out=nt_smliq, nt_rhos_out=nt_rhos, & - nt_rsnw_out=nt_rsnw, & - nt_bgc_Nit_out=nt_bgc_Nit, nt_bgc_S_out=nt_bgc_S, & + nt_rsnw_out=nt_rsnw, nt_bgc_Nit_out=nt_bgc_Nit, & nt_isosno_out=nt_isosno, nt_isoice_out=nt_isoice) call icepack_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & @@ -226,9 +225,6 @@ subroutine init_transport if (nt-k==nt_bgc_Nit) & write(nu_diag,1000) 'nt_bgc_Nit ',nt,depend(nt),tracer_type(nt),& has_dependents(nt) - if (nt-k==nt_bgc_S) & - write(nu_diag,1000) 'nt_bgc_S ',nt,depend(nt),tracer_type(nt),& - has_dependents(nt) enddo write(nu_diag,*) ' ' endif ! master_task diff --git a/cicecore/cicedyn/general/ice_flux.F90 b/cicecore/cicedyn/general/ice_flux.F90 index 5145fec66..29f5c489b 100644 --- a/cicecore/cicedyn/general/ice_flux.F90 +++ b/cicecore/cicedyn/general/ice_flux.F90 @@ -1125,7 +1125,6 @@ subroutine scale_fluxes (nx_block, ny_block, & faero_ocn, & alvdr, alidr, & alvdf, alidf, & - fzsal, fzsal_g, & flux_bio, & fsurf, fcondtop, & Uref, wind, & @@ -1189,11 +1188,6 @@ subroutine scale_fluxes (nx_block, ny_block, & fsurf , & ! surface heat flux (W/m**2) fcondtop ! top surface conductive flux (W/m**2) - ! zsalinity fluxes - real (kind=dbl_kind), dimension(nx_block,ny_block), intent(inout) :: & - fzsal , & ! salt flux to ocean with prognositic salinity (kg/m2/s) - fzsal_g ! Gravity drainage salt flux to ocean (kg/m2/s) - ! isotopes real (kind=dbl_kind), dimension(nx_block,ny_block,icepack_max_iso), & optional, intent(inout) :: & @@ -1246,8 +1240,6 @@ subroutine scale_fluxes (nx_block, ny_block, & alidr (i,j) = alidr (i,j) * ar alvdf (i,j) = alvdf (i,j) * ar alidf (i,j) = alidf (i,j) * ar - fzsal (i,j) = fzsal (i,j) * ar - fzsal_g (i,j) = fzsal_g (i,j) * ar flux_bio (i,j,:) = flux_bio (i,j,:) * ar faero_ocn(i,j,:) = faero_ocn(i,j,:) * ar if (present(Qref_iso )) Qref_iso (i,j,:) = Qref_iso (i,j,:) * ar @@ -1278,8 +1270,6 @@ subroutine scale_fluxes (nx_block, ny_block, & alidr (i,j) = c0 alvdf (i,j) = c0 alidf (i,j) = c0 - fzsal (i,j) = c0 - fzsal_g (i,j) = c0 flux_bio (i,j,:) = c0 faero_ocn(i,j,:) = c0 if (present(Qref_iso )) Qref_iso (i,j,:) = c0 diff --git a/cicecore/cicedyn/general/ice_flux_bgc.F90 b/cicecore/cicedyn/general/ice_flux_bgc.F90 index 0d9184fb7..9c07971ff 100644 --- a/cicecore/cicedyn/general/ice_flux_bgc.F90 +++ b/cicecore/cicedyn/general/ice_flux_bgc.F90 @@ -44,10 +44,6 @@ module ice_flux_bgc flux_bio , & ! all bio fluxes to ocean flux_bio_ai ! all bio fluxes to ocean, averaged over grid cell - real (kind=dbl_kind), dimension (:,:,:), allocatable, public :: & - fzsal_ai, & ! salt flux to ocean from zsalinity (kg/m^2/s) - fzsal_g_ai ! gravity drainage salt flux to ocean (kg/m^2/s) - ! internal logical (kind=log_kind), public :: & @@ -121,8 +117,6 @@ subroutine alloc_flux_bgc integer (int_kind) :: ierr allocate( & - fzsal_ai (nx_block,ny_block,max_blocks), & ! salt flux to ocean from zsalinity (kg/m^2/s) - fzsal_g_ai (nx_block,ny_block,max_blocks), & ! gravity drainage salt flux to ocean (kg/m^2/s) nit (nx_block,ny_block,max_blocks), & ! ocean nitrate (mmol/m^3) amm (nx_block,ny_block,max_blocks), & ! ammonia/um (mmol/m^3) sil (nx_block,ny_block,max_blocks), & ! silicate (mmol/m^3) diff --git a/cicecore/cicedyn/general/ice_step_mod.F90 b/cicecore/cicedyn/general/ice_step_mod.F90 index 31989c73c..89dba3d12 100644 --- a/cicecore/cicedyn/general/ice_step_mod.F90 +++ b/cicecore/cicedyn/general/ice_step_mod.F90 @@ -611,7 +611,7 @@ end subroutine step_therm1 subroutine step_therm2 (dt, iblk) - use ice_arrays_column, only: hin_max, fzsal, ocean_bio, wave_sig_ht, & + use ice_arrays_column, only: hin_max, ocean_bio, wave_sig_ht, & wave_spectrum, wavefreq, dwavefreq, & first_ice, bgrid, cgrid, igrid, floe_rad_c, floe_binwidth, & d_afsd_latg, d_afsd_newi, d_afsd_latm, d_afsd_weld @@ -644,15 +644,14 @@ subroutine step_therm2 (dt, iblk) logical (kind=log_kind) :: & tr_fsd, & ! floe size distribution tracers - z_tracers, & ! vertical biogeochemistry - solve_zsal ! zsalinity + z_tracers ! vertical biogeochemistry type (block) :: & this_block ! block information for current block character(len=*), parameter :: subname = '(step_therm2)' - call icepack_query_parameters(z_tracers_out=z_tracers,solve_zsal_out=solve_zsal) + call icepack_query_parameters(z_tracers_out=z_tracers) call icepack_query_tracer_sizes(ntrcr_out=ntrcr, nbtrcr_out=nbtrcr) call icepack_query_tracer_flags(tr_fsd_out=tr_fsd) call icepack_warnings_flush(nu_diag) @@ -660,7 +659,7 @@ subroutine step_therm2 (dt, iblk) file=__FILE__, line=__LINE__) ! nltrcr is only used as a zbgc flag in icepack (number of zbgc tracers > 0) - if (z_tracers .or. solve_zsal) then + if (z_tracers) then nltrcr = 1 else nltrcr = 0 @@ -716,7 +715,6 @@ subroutine step_therm2 (dt, iblk) igrid = igrid, & faero_ocn = faero_ocn (i,j,:,iblk), & first_ice = first_ice (i,j,:,iblk), & - fzsal = fzsal (i,j, iblk), & flux_bio = flux_bio (i,j,1:nbtrcr,iblk), & ocean_bio = ocean_bio (i,j,1:nbtrcr,iblk), & frazil_diag= frazil_diag(i,j,iblk), & @@ -1038,7 +1036,7 @@ end subroutine step_dyn_horiz subroutine step_dyn_ridge (dt, ndtd, iblk) - use ice_arrays_column, only: hin_max, fzsal, first_ice + use ice_arrays_column, only: hin_max, first_ice use ice_domain_size, only: ncat, nilyr, nslyr, n_aero, nblyr use ice_flux, only: & rdg_conv, rdg_shear, dardg1dt, dardg2dt, & @@ -1135,7 +1133,6 @@ subroutine step_dyn_ridge (dt, ndtd, iblk) aice = aice (i,j, iblk), & fsalt = fsalt (i,j, iblk), & first_ice = first_ice(i,j,:,iblk), & - fzsal = fzsal (i,j, iblk), & flux_bio = flux_bio (i,j,1:nbtrcr,iblk)) endif ! tmask @@ -1614,12 +1611,12 @@ end subroutine ocean_mixed_layer subroutine biogeochemistry (dt, iblk) use ice_arrays_column, only: upNO, upNH, iDi, iki, zfswin, & - zsal_tot, darcy_V, grow_net, & + darcy_V, grow_net, & PP_net, hbri,dhbr_bot, dhbr_top, Zoo,& fbio_snoice, fbio_atmice, ocean_bio, & first_ice, fswpenln, bphi, bTiz, ice_bio_net, & - snow_bio_net, fswthrun, Rayleigh_criteria, & - ocean_bio_all, sice_rho, fzsal, fzsal_g, & + snow_bio_net, fswthrun, & + ocean_bio_all, sice_rho, & bgrid, igrid, icgrid, cgrid use ice_domain_size, only: nblyr, nilyr, nslyr, n_algae, n_zaero, ncat, & n_doc, n_dic, n_don, n_fed, n_fep @@ -1716,7 +1713,6 @@ subroutine biogeochemistry (dt, iblk) iDi = iDi (i,j,:,:, iblk), & iki = iki (i,j,:,:, iblk), & zfswin = zfswin (i,j,:,:, iblk), & - zsal_tot = zsal_tot (i,j, iblk), & darcy_V = darcy_V (i,j,:, iblk), & grow_net = grow_net (i,j, iblk), & PP_net = PP_net (i,j, iblk), & @@ -1735,8 +1731,6 @@ subroutine biogeochemistry (dt, iblk) snow_bio_net = snow_bio_net(i,j,1:nbtrcr, iblk), & fswthrun = fswthrun (i,j,:, iblk), & sice_rho = sice_rho (i,j,:, iblk), & - fzsal = fzsal (i,j, iblk), & - fzsal_g = fzsal_g (i,j, iblk), & meltbn = meltbn (i,j,:, iblk), & melttn = melttn (i,j,:, iblk), & congeln = congeln (i,j,:, iblk), & @@ -1756,7 +1750,6 @@ subroutine biogeochemistry (dt, iblk) aice0 = aice0 (i,j, iblk), & trcrn = trcrn (i,j,:,:, iblk), & vsnon_init = vsnon_init (i,j,:, iblk), & - Rayleigh_criteria = Rayleigh_criteria(i,j,iblk), & skl_bgc = skl_bgc) enddo ! i diff --git a/cicecore/cicedyn/infrastructure/io/io_binary/ice_restart.F90 b/cicecore/cicedyn/infrastructure/io/io_binary/ice_restart.F90 index 3e7abe3a3..cc158fccc 100644 --- a/cicecore/cicedyn/infrastructure/io/io_binary/ice_restart.F90 +++ b/cicecore/cicedyn/infrastructure/io/io_binary/ice_restart.F90 @@ -57,8 +57,7 @@ subroutine init_restart_read(ice_ic) ! local variables logical (kind=log_kind) :: & - solve_zsal, tr_fsd, & - tr_iage, tr_FY, tr_lvl, tr_iso, tr_aero, & + tr_fsd, tr_iage, tr_FY, tr_lvl, tr_iso, tr_aero, & tr_pond_topo, tr_pond_lvl, tr_brine, tr_snow character(len=char_len_long) :: & @@ -77,8 +76,6 @@ subroutine init_restart_read(ice_ic) character(len=*), parameter :: subname = '(init_restart_read)' - call icepack_query_parameters( & - solve_zsal_out=solve_zsal) call icepack_query_tracer_sizes( & nbtrcr_out=nbtrcr) call icepack_query_tracer_flags( & @@ -308,7 +305,7 @@ subroutine init_restart_read(ice_ic) endif endif - if (solve_zsal .or. nbtrcr > 0) then + 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') @@ -393,8 +390,7 @@ subroutine init_restart_write(filename_spec) ! local variables logical (kind=log_kind) :: & - solve_zsal, tr_fsd, & - tr_iage, tr_FY, tr_lvl, tr_iso, tr_aero, & + tr_fsd, tr_iage, tr_FY, tr_lvl, tr_iso, tr_aero, & tr_pond_topo, tr_pond_lvl, tr_brine, tr_snow integer (kind=int_kind) :: & @@ -404,8 +400,6 @@ subroutine init_restart_write(filename_spec) character(len=*), parameter :: subname = '(init_restart_write)' - call icepack_query_parameters( & - solve_zsal_out=solve_zsal) call icepack_query_tracer_sizes( & nbtrcr_out=nbtrcr) call icepack_query_tracer_flags( & @@ -623,7 +617,7 @@ subroutine init_restart_write(filename_spec) endif - if (solve_zsal .or. nbtrcr > 0) then + if (nbtrcr > 0) then write(filename,'(a,a,a,i4.4,a,i2.2,a,i2.2,a,i5.5)') & restart_dir(1:lenstr(restart_dir)), & @@ -810,7 +804,6 @@ subroutine final_restart() use ice_communicate, only: my_task, master_task logical (kind=log_kind) :: & - solve_zsal, & tr_iage, tr_FY, tr_lvl, tr_iso, tr_aero, & tr_pond_topo, tr_pond_lvl, tr_brine, tr_snow @@ -819,8 +812,6 @@ subroutine final_restart() character(len=*), parameter :: subname = '(final_restart)' - call icepack_query_parameters( & - solve_zsal_out=solve_zsal) call icepack_query_tracer_sizes( & nbtrcr_out=nbtrcr) call icepack_query_tracer_flags( & @@ -844,8 +835,7 @@ subroutine final_restart() if (tr_pond_topo) close(nu_dump_pond) if (tr_snow) close(nu_dump_snow) if (tr_brine) close(nu_dump_hbrine) - if (solve_zsal .or. nbtrcr > 0) & - close(nu_dump_bgc) + if (nbtrcr > 0) close(nu_dump_bgc) write(nu_diag,*) 'Restart read/written ',istep1,timesecs endif diff --git a/cicecore/cicedyn/infrastructure/io/io_netcdf/ice_restart.F90 b/cicecore/cicedyn/infrastructure/io/io_netcdf/ice_restart.F90 index ed49a48f5..8a648f56b 100644 --- a/cicecore/cicedyn/infrastructure/io/io_netcdf/ice_restart.F90 +++ b/cicecore/cicedyn/infrastructure/io/io_netcdf/ice_restart.F90 @@ -144,7 +144,7 @@ subroutine init_restart_write(filename_spec) ! local variables logical (kind=log_kind) :: & - solve_zsal, skl_bgc, z_tracers, tr_fsd, & + skl_bgc, z_tracers, tr_fsd, & 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, & @@ -176,7 +176,7 @@ subroutine init_restart_write(filename_spec) #ifdef USE_NETCDF call icepack_query_parameters( & - solve_zsal_out=solve_zsal, skl_bgc_out=skl_bgc, z_tracers_out=z_tracers) + skl_bgc_out=skl_bgc, z_tracers_out=z_tracers) call icepack_query_tracer_sizes( & nbtrcr_out=nbtrcr) call icepack_query_tracer_flags( & @@ -376,8 +376,6 @@ subroutine init_restart_write(filename_spec) endif endif !nbtrcr - if (solve_zsal) call define_rest_field(ncid,'sss',dims) - deallocate(dims) !----------------------------------------------------------------- @@ -483,8 +481,6 @@ subroutine init_restart_write(filename_spec) enddo endif endif !skl_bgc - if (solve_zsal) & - call define_rest_field(ncid,'Rayleigh',dims) !----------------------------------------------------------------- ! 4D restart fields, written as layers of 3D @@ -536,13 +532,6 @@ subroutine init_restart_write(filename_spec) enddo endif - if (solve_zsal) then - do k = 1, nblyr - write(nchar,'(i3.3)') k - call define_rest_field(ncid,'zSalinity'//trim(nchar),dims) - enddo - endif - if (z_tracers) then if (tr_zaero) then do n = 1, n_zaero diff --git a/cicecore/cicedyn/infrastructure/io/io_pio2/ice_restart.F90 b/cicecore/cicedyn/infrastructure/io/io_pio2/ice_restart.F90 index cdfbac87a..9119fac27 100644 --- a/cicecore/cicedyn/infrastructure/io/io_pio2/ice_restart.F90 +++ b/cicecore/cicedyn/infrastructure/io/io_pio2/ice_restart.F90 @@ -148,7 +148,7 @@ subroutine init_restart_write(filename_spec) use ice_grid, only: grid_ice logical (kind=log_kind) :: & - solve_zsal, skl_bgc, z_tracers + skl_bgc, z_tracers logical (kind=log_kind) :: & tr_iage, tr_FY, tr_lvl, tr_iso, tr_aero, & @@ -196,7 +196,7 @@ subroutine init_restart_write(filename_spec) 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(solve_zsal_out=solve_zsal, skl_bgc_out=skl_bgc, & + call icepack_query_parameters(skl_bgc_out=skl_bgc, & z_tracers_out=z_tracers) call icepack_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & @@ -380,8 +380,6 @@ subroutine init_restart_write(filename_spec) endif endif !nbtrcr - if (solve_zsal) call define_rest_field(File,'sss',dims) - deallocate(dims) !----------------------------------------------------------------- @@ -487,8 +485,6 @@ subroutine init_restart_write(filename_spec) enddo endif endif !skl_bgc - if (solve_zsal) & - call define_rest_field(File,'Rayleigh',dims) !----------------------------------------------------------------- ! 4D restart fields, written as layers of 3D @@ -540,12 +536,6 @@ subroutine init_restart_write(filename_spec) enddo endif - if (solve_zsal) then - do k = 1, nblyr - write(nchar,'(i3.3)') k - call define_rest_field(File,'zSalinity'//trim(nchar),dims) - enddo - endif if (z_tracers) then if (tr_zaero) then do n = 1, n_zaero diff --git a/cicecore/drivers/standalone/cice/CICE_InitMod.F90 b/cicecore/drivers/standalone/cice/CICE_InitMod.F90 index 0371c7f38..dc9fece6e 100644 --- a/cicecore/drivers/standalone/cice/CICE_InitMod.F90 +++ b/cicecore/drivers/standalone/cice/CICE_InitMod.F90 @@ -277,7 +277,7 @@ subroutine init_restart restart_iso, read_restart_iso, & restart_aero, read_restart_aero, & restart_hbrine, read_restart_hbrine, & - restart_zsal, restart_bgc + restart_bgc use ice_restart_driver, only: restartfile use ice_restart_shared, only: runtype, restart use ice_state ! almost everything @@ -288,7 +288,7 @@ subroutine init_restart logical(kind=log_kind) :: & tr_iage, tr_FY, tr_lvl, tr_pond_lvl, & tr_pond_topo, tr_snow, tr_fsd, tr_iso, tr_aero, tr_brine, & - skl_bgc, z_tracers, solve_zsal + skl_bgc, z_tracers integer(kind=int_kind) :: & ntrcr integer(kind=int_kind) :: & @@ -304,7 +304,7 @@ subroutine init_restart file=__FILE__, line=__LINE__) call icepack_query_parameters(skl_bgc_out=skl_bgc, & - z_tracers_out=z_tracers, solve_zsal_out=solve_zsal) + z_tracers_out=z_tracers) call icepack_query_tracer_flags(tr_iage_out=tr_iage, tr_FY_out=tr_FY, & tr_lvl_out=tr_lvl, tr_pond_lvl_out=tr_pond_lvl, & tr_pond_topo_out=tr_pond_topo, tr_aero_out=tr_aero, tr_brine_out=tr_brine, & @@ -450,8 +450,6 @@ subroutine init_restart if (trim(runtype) == 'continue') then if (tr_brine) & restart_hbrine = .true. - if (solve_zsal) & - restart_zsal = .true. if (skl_bgc .or. z_tracers) & restart_bgc = .true. endif @@ -461,7 +459,7 @@ subroutine init_restart if (tr_brine .and. restart_hbrine) call read_restart_hbrine endif - if (solve_zsal .or. skl_bgc .or. z_tracers) then ! biogeochemistry + if (skl_bgc .or. z_tracers) then ! biogeochemistry if (tr_fsd) then write (nu_diag,*) 'FSD implementation incomplete for use with BGC' call icepack_warnings_flush(nu_diag) diff --git a/cicecore/drivers/standalone/cice/CICE_RunMod.F90 b/cicecore/drivers/standalone/cice/CICE_RunMod.F90 index ae7f7ab1f..42514e06c 100644 --- a/cicecore/drivers/standalone/cice/CICE_RunMod.F90 +++ b/cicecore/drivers/standalone/cice/CICE_RunMod.F90 @@ -141,7 +141,7 @@ subroutine ice_step use ice_boundary, only: ice_HaloUpdate use ice_calendar, only: dt, dt_dyn, ndtd, diagfreq, write_restart, istep use ice_diagnostics, only: init_mass_diags, runtime_diags, debug_model, debug_ice - use ice_diagnostics_bgc, only: hbrine_diags, zsal_diags, bgc_diags + use ice_diagnostics_bgc, only: hbrine_diags, bgc_diags use ice_domain, only: halo_info, nblocks use ice_dyn_eap, only: write_restart_eap use ice_dyn_shared, only: kdyn, kridge @@ -175,7 +175,7 @@ subroutine ice_step logical (kind=log_kind) :: & tr_iage, tr_FY, tr_lvl, tr_fsd, tr_snow, & tr_pond_lvl, tr_pond_topo, tr_brine, tr_iso, tr_aero, & - calc_Tsfc, skl_bgc, solve_zsal, z_tracers, wave_spec + calc_Tsfc, skl_bgc, z_tracers, wave_spec character(len=*), parameter :: subname = '(ice_step)' @@ -189,8 +189,7 @@ subroutine ice_step endif call icepack_query_parameters(calc_Tsfc_out=calc_Tsfc, skl_bgc_out=skl_bgc, & - solve_zsal_out=solve_zsal, z_tracers_out=z_tracers, ktherm_out=ktherm, & - wave_spec_out=wave_spec) + z_tracers_out=z_tracers, ktherm_out=ktherm, wave_spec_out=wave_spec) call icepack_query_tracer_flags(tr_iage_out=tr_iage, tr_FY_out=tr_FY, & tr_lvl_out=tr_lvl, tr_pond_lvl_out=tr_pond_lvl, & tr_pond_topo_out=tr_pond_topo, tr_brine_out=tr_brine, tr_aero_out=tr_aero, & @@ -377,7 +376,6 @@ subroutine ice_step call ice_timer_start(timer_diags) ! diagnostics if (mod(istep,diagfreq) == 0) then call runtime_diags(dt) ! log file - if (solve_zsal) call zsal_diags if (skl_bgc .or. z_tracers) call bgc_diags if (tr_brine) call hbrine_diags if (my_task == master_task) then @@ -402,7 +400,7 @@ subroutine ice_step if (tr_fsd) call write_restart_fsd if (tr_iso) call write_restart_iso if (tr_aero) call write_restart_aero - if (solve_zsal .or. skl_bgc .or. z_tracers) & + if (skl_bgc .or. z_tracers) & call write_restart_bgc if (tr_brine) call write_restart_hbrine if (kdyn == 2) call write_restart_eap @@ -421,7 +419,7 @@ end subroutine ice_step subroutine coupling_prep (iblk) use ice_arrays_column, only: alvdfn, alidfn, alvdrn, alidrn, & - albicen, albsnon, albpndn, apeffn, fzsal_g, fzsal, snowfracn + albicen, albsnon, albpndn, apeffn, snowfracn use ice_blocks, only: nx_block, ny_block, get_block, block use ice_domain, only: blocks_ice use ice_calendar, only: dt, nstreams @@ -436,7 +434,7 @@ subroutine coupling_prep (iblk) fsens, flat, fswabs, flwout, evap, Tref, Qref, & scale_fluxes, frzmlt_init, frzmlt use ice_flux_bgc, only: faero_ocn, fiso_ocn, Qref_iso, fiso_evap, & - fzsal_ai, fzsal_g_ai, flux_bio, flux_bio_ai + flux_bio, flux_bio_ai use ice_grid, only: tmask use ice_state, only: aicen, aice #ifdef CICE_IN_NEMO @@ -587,8 +585,6 @@ subroutine coupling_prep (iblk) fsalt_ai (i,j,iblk) = fsalt (i,j,iblk) fhocn_ai (i,j,iblk) = fhocn (i,j,iblk) fswthru_ai(i,j,iblk) = fswthru(i,j,iblk) - fzsal_ai (i,j,iblk) = fzsal (i,j,iblk) - fzsal_g_ai(i,j,iblk) = fzsal_g(i,j,iblk) if (nbtrcr > 0) then do k = 1, nbtrcr @@ -634,8 +630,7 @@ subroutine coupling_prep (iblk) faero_ocn(:,:,:,iblk), & alvdr (:,:,iblk), alidr (:,:,iblk), & alvdf (:,:,iblk), alidf (:,:,iblk), & - fzsal (:,:,iblk), fzsal_g (:,:,iblk), & - flux_bio (:,:,1:nbtrcr,iblk), & + flux_bio =flux_bio (:,:,1:nbtrcr,iblk), & Qref_iso =Qref_iso (:,:,:,iblk), & fiso_evap=fiso_evap(:,:,:,iblk), & fiso_ocn =fiso_ocn (:,:,:,iblk)) diff --git a/cicecore/drivers/unittest/gridavgchk/CICE_InitMod.F90 b/cicecore/drivers/unittest/gridavgchk/CICE_InitMod.F90 index 9ed1c5cbc..dc9fece6e 100644 --- a/cicecore/drivers/unittest/gridavgchk/CICE_InitMod.F90 +++ b/cicecore/drivers/unittest/gridavgchk/CICE_InitMod.F90 @@ -15,9 +15,11 @@ module CICE_InitMod use ice_kinds_mod use ice_exit, only: abort_ice use ice_fileunits, only: init_fileunits, nu_diag + use ice_memusage, only: ice_memusage_init, ice_memusage_print use icepack_intfc, only: icepack_aggregate use icepack_intfc, only: icepack_init_itd, icepack_init_itd_hist use icepack_intfc, only: icepack_init_fsd_bounds, icepack_init_wave + use icepack_intfc, only: icepack_init_snow use icepack_intfc, only: icepack_configure use icepack_intfc, only: icepack_warnings_flush, icepack_warnings_aborted use icepack_intfc, only: icepack_query_parameters, icepack_query_tracer_flags, & @@ -64,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, istep, istep1, write_ic, & + use ice_calendar, only: dt, dt_dyn, write_ic, & init_calendar, advance_timestep, calc_timesteps use ice_communicate, only: init_communicate, my_task, master_task use ice_diagnostics, only: init_diags @@ -77,7 +79,7 @@ subroutine cice_init use ice_flux, only: init_coupler_flux, init_history_therm, & init_history_dyn, init_flux_atm, init_flux_ocn, alloc_flux use ice_forcing, only: init_forcing_ocn, init_forcing_atmo, & - get_forcing_atmo, get_forcing_ocn, get_wave_spec + get_forcing_atmo, get_forcing_ocn, get_wave_spec, init_snowtable use ice_forcing_bgc, only: get_forcing_bgc, get_atm_bgc, & faero_default, faero_optics, alloc_forcing_bgc, fiso_default use ice_grid, only: init_grid1, init_grid2, alloc_grid @@ -91,7 +93,8 @@ subroutine cice_init use ice_transport_driver, only: init_transport logical(kind=log_kind) :: tr_aero, tr_zaero, skl_bgc, z_tracers, & - tr_iso, tr_fsd, wave_spec + tr_iso, tr_fsd, wave_spec, tr_snow + character(len=char_len) :: snw_aging_table character(len=*), parameter :: subname = '(cice_init)' call init_communicate ! initial setup for message passing @@ -109,6 +112,12 @@ subroutine cice_init call input_zbgc ! vertical biogeochemistry namelist call count_tracers ! count tracers + ! Call this as early as possible, must be after memory_stats is read + if (my_task == master_task) then + call ice_memusage_init(nu_diag) + call ice_memusage_print(nu_diag,subname//':start') + endif + call init_domain_blocks ! set up block decomposition call init_grid1 ! domain distribution call alloc_grid ! allocate grid arrays @@ -162,7 +171,7 @@ subroutine cice_init call ice_HaloRestore_init ! restored boundary conditions call icepack_query_parameters(skl_bgc_out=skl_bgc, z_tracers_out=z_tracers, & - wave_spec_out=wave_spec) + wave_spec_out=wave_spec, snw_aging_table_out=snw_aging_table) call icepack_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call abort_ice(trim(subname), & file=__FILE__,line= __LINE__) @@ -176,7 +185,7 @@ subroutine cice_init call calc_timesteps ! update timestep counter if not using npt_unit="1" call icepack_query_tracer_flags(tr_aero_out=tr_aero, tr_zaero_out=tr_zaero) - call icepack_query_tracer_flags(tr_iso_out=tr_iso) + call icepack_query_tracer_flags(tr_iso_out=tr_iso, tr_snow_out=tr_snow) call icepack_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call abort_ice(trim(subname), & file=__FILE__,line= __LINE__) @@ -190,6 +199,8 @@ subroutine cice_init if (trim(runtype) == 'continue' .or. restart) & call init_shortwave ! initialize radiative transfer + if (write_ic) call accum_hist(dt) ! write initial conditions + ! tcraig, use advance_timestep here ! istep = istep + 1 ! update time step counters ! istep1 = istep1 + 1 @@ -207,8 +218,20 @@ subroutine cice_init call get_forcing_atmo ! atmospheric forcing from data call get_forcing_ocn(dt) ! ocean forcing from data + ! snow aging lookup table initialization + if (tr_snow) then ! advanced snow physics + call icepack_init_snow() + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + if (snw_aging_table(1:4) /= 'test') then + call init_snowtable() + endif + endif + ! isotopes if (tr_iso) call fiso_default ! default values + ! aerosols ! if (tr_aero) call faero_data ! data file ! if (tr_zaero) call fzaero_data ! data file (gx1) @@ -222,7 +245,9 @@ subroutine cice_init call init_flux_atm ! initialize atmosphere fluxes sent to coupler call init_flux_ocn ! initialize ocean fluxes sent to coupler - if (write_ic) call accum_hist(dt) ! write initial conditions + if (my_task == master_task) then + call ice_memusage_print(nu_diag,subname//':end') + endif end subroutine cice_init @@ -235,23 +260,24 @@ subroutine init_restart use ice_calendar, only: calendar use ice_constants, only: c0 use ice_domain, only: nblocks - use ice_domain_size, only: ncat, n_iso, n_aero, nfsd + use ice_domain_size, only: ncat, n_iso, n_aero, nfsd, nslyr use ice_dyn_eap, only: read_restart_eap use ice_dyn_shared, only: kdyn use ice_grid, only: tmask use ice_init, only: ice_ic - use ice_init_column, only: init_age, init_FY, init_lvl, & + use ice_init_column, only: init_age, init_FY, init_lvl, init_snowtracers, & init_meltponds_lvl, init_meltponds_topo, & init_isotope, init_aerosol, init_hbrine, init_bgc, init_fsd use ice_restart_column, only: restart_age, read_restart_age, & restart_FY, read_restart_FY, restart_lvl, read_restart_lvl, & restart_pond_lvl, read_restart_pond_lvl, & restart_pond_topo, read_restart_pond_topo, & + restart_snow, read_restart_snow, & restart_fsd, read_restart_fsd, & restart_iso, read_restart_iso, & restart_aero, read_restart_aero, & restart_hbrine, read_restart_hbrine, & - restart_zsal, restart_bgc + restart_bgc use ice_restart_driver, only: restartfile use ice_restart_shared, only: runtype, restart use ice_state ! almost everything @@ -261,12 +287,13 @@ subroutine init_restart iblk ! block index logical(kind=log_kind) :: & tr_iage, tr_FY, tr_lvl, tr_pond_lvl, & - tr_pond_topo, tr_fsd, tr_iso, tr_aero, tr_brine, & - skl_bgc, z_tracers, solve_zsal + tr_pond_topo, tr_snow, tr_fsd, tr_iso, tr_aero, tr_brine, & + skl_bgc, z_tracers integer(kind=int_kind) :: & ntrcr integer(kind=int_kind) :: & nt_alvl, nt_vlvl, nt_apnd, nt_hpnd, nt_ipnd, & + nt_smice, nt_smliq, nt_rhos, nt_rsnw, & nt_iage, nt_FY, nt_aero, nt_fsd, nt_isosno, nt_isoice character(len=*), parameter :: subname = '(init_restart)' @@ -277,14 +304,16 @@ subroutine init_restart file=__FILE__, line=__LINE__) call icepack_query_parameters(skl_bgc_out=skl_bgc, & - z_tracers_out=z_tracers, solve_zsal_out=solve_zsal) + z_tracers_out=z_tracers) call icepack_query_tracer_flags(tr_iage_out=tr_iage, tr_FY_out=tr_FY, & tr_lvl_out=tr_lvl, tr_pond_lvl_out=tr_pond_lvl, & tr_pond_topo_out=tr_pond_topo, tr_aero_out=tr_aero, tr_brine_out=tr_brine, & - tr_fsd_out=tr_fsd, tr_iso_out=tr_iso) + tr_snow_out=tr_snow, tr_fsd_out=tr_fsd, tr_iso_out=tr_iso) call icepack_query_tracer_indices(nt_alvl_out=nt_alvl, nt_vlvl_out=nt_vlvl, & nt_apnd_out=nt_apnd, nt_hpnd_out=nt_hpnd, nt_ipnd_out=nt_ipnd, & nt_iage_out=nt_iage, nt_FY_out=nt_FY, nt_aero_out=nt_aero, nt_fsd_out=nt_fsd, & + nt_smice_out=nt_smice, nt_smliq_out=nt_smliq, & + nt_rhos_out=nt_rhos, nt_rsnw_out=nt_rsnw, & nt_isosno_out=nt_isosno, nt_isoice_out=nt_isoice) call icepack_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & @@ -368,6 +397,22 @@ subroutine init_restart enddo ! iblk endif ! .not. restart_pond endif + + ! snow redistribution/metamorphism + if (tr_snow) then + if (trim(runtype) == 'continue') restart_snow = .true. + if (restart_snow) then + call read_restart_snow + else + do iblk = 1, nblocks + call init_snowtracers(trcrn(:,:,nt_smice:nt_smice+nslyr-1,:,iblk), & + trcrn(:,:,nt_smliq:nt_smliq+nslyr-1,:,iblk), & + trcrn(:,:,nt_rhos :nt_rhos +nslyr-1,:,iblk), & + trcrn(:,:,nt_rsnw :nt_rsnw +nslyr-1,:,iblk)) + enddo ! iblk + endif + endif + ! floe size distribution if (tr_fsd) then if (trim(runtype) == 'continue') restart_fsd = .true. @@ -405,8 +450,6 @@ subroutine init_restart if (trim(runtype) == 'continue') then if (tr_brine) & restart_hbrine = .true. - if (solve_zsal) & - restart_zsal = .true. if (skl_bgc .or. z_tracers) & restart_bgc = .true. endif @@ -416,7 +459,7 @@ subroutine init_restart if (tr_brine .and. restart_hbrine) call read_restart_hbrine endif - if (solve_zsal .or. skl_bgc .or. z_tracers) then ! biogeochemistry + if (skl_bgc .or. z_tracers) then ! biogeochemistry if (tr_fsd) then write (nu_diag,*) 'FSD implementation incomplete for use with BGC' call icepack_warnings_flush(nu_diag) diff --git a/cicecore/drivers/unittest/halochk/CICE_InitMod.F90 b/cicecore/drivers/unittest/halochk/CICE_InitMod.F90 index 9ed1c5cbc..dc9fece6e 100644 --- a/cicecore/drivers/unittest/halochk/CICE_InitMod.F90 +++ b/cicecore/drivers/unittest/halochk/CICE_InitMod.F90 @@ -15,9 +15,11 @@ module CICE_InitMod use ice_kinds_mod use ice_exit, only: abort_ice use ice_fileunits, only: init_fileunits, nu_diag + use ice_memusage, only: ice_memusage_init, ice_memusage_print use icepack_intfc, only: icepack_aggregate use icepack_intfc, only: icepack_init_itd, icepack_init_itd_hist use icepack_intfc, only: icepack_init_fsd_bounds, icepack_init_wave + use icepack_intfc, only: icepack_init_snow use icepack_intfc, only: icepack_configure use icepack_intfc, only: icepack_warnings_flush, icepack_warnings_aborted use icepack_intfc, only: icepack_query_parameters, icepack_query_tracer_flags, & @@ -64,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, istep, istep1, write_ic, & + use ice_calendar, only: dt, dt_dyn, write_ic, & init_calendar, advance_timestep, calc_timesteps use ice_communicate, only: init_communicate, my_task, master_task use ice_diagnostics, only: init_diags @@ -77,7 +79,7 @@ subroutine cice_init use ice_flux, only: init_coupler_flux, init_history_therm, & init_history_dyn, init_flux_atm, init_flux_ocn, alloc_flux use ice_forcing, only: init_forcing_ocn, init_forcing_atmo, & - get_forcing_atmo, get_forcing_ocn, get_wave_spec + get_forcing_atmo, get_forcing_ocn, get_wave_spec, init_snowtable use ice_forcing_bgc, only: get_forcing_bgc, get_atm_bgc, & faero_default, faero_optics, alloc_forcing_bgc, fiso_default use ice_grid, only: init_grid1, init_grid2, alloc_grid @@ -91,7 +93,8 @@ subroutine cice_init use ice_transport_driver, only: init_transport logical(kind=log_kind) :: tr_aero, tr_zaero, skl_bgc, z_tracers, & - tr_iso, tr_fsd, wave_spec + tr_iso, tr_fsd, wave_spec, tr_snow + character(len=char_len) :: snw_aging_table character(len=*), parameter :: subname = '(cice_init)' call init_communicate ! initial setup for message passing @@ -109,6 +112,12 @@ subroutine cice_init call input_zbgc ! vertical biogeochemistry namelist call count_tracers ! count tracers + ! Call this as early as possible, must be after memory_stats is read + if (my_task == master_task) then + call ice_memusage_init(nu_diag) + call ice_memusage_print(nu_diag,subname//':start') + endif + call init_domain_blocks ! set up block decomposition call init_grid1 ! domain distribution call alloc_grid ! allocate grid arrays @@ -162,7 +171,7 @@ subroutine cice_init call ice_HaloRestore_init ! restored boundary conditions call icepack_query_parameters(skl_bgc_out=skl_bgc, z_tracers_out=z_tracers, & - wave_spec_out=wave_spec) + wave_spec_out=wave_spec, snw_aging_table_out=snw_aging_table) call icepack_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call abort_ice(trim(subname), & file=__FILE__,line= __LINE__) @@ -176,7 +185,7 @@ subroutine cice_init call calc_timesteps ! update timestep counter if not using npt_unit="1" call icepack_query_tracer_flags(tr_aero_out=tr_aero, tr_zaero_out=tr_zaero) - call icepack_query_tracer_flags(tr_iso_out=tr_iso) + call icepack_query_tracer_flags(tr_iso_out=tr_iso, tr_snow_out=tr_snow) call icepack_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call abort_ice(trim(subname), & file=__FILE__,line= __LINE__) @@ -190,6 +199,8 @@ subroutine cice_init if (trim(runtype) == 'continue' .or. restart) & call init_shortwave ! initialize radiative transfer + if (write_ic) call accum_hist(dt) ! write initial conditions + ! tcraig, use advance_timestep here ! istep = istep + 1 ! update time step counters ! istep1 = istep1 + 1 @@ -207,8 +218,20 @@ subroutine cice_init call get_forcing_atmo ! atmospheric forcing from data call get_forcing_ocn(dt) ! ocean forcing from data + ! snow aging lookup table initialization + if (tr_snow) then ! advanced snow physics + call icepack_init_snow() + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + if (snw_aging_table(1:4) /= 'test') then + call init_snowtable() + endif + endif + ! isotopes if (tr_iso) call fiso_default ! default values + ! aerosols ! if (tr_aero) call faero_data ! data file ! if (tr_zaero) call fzaero_data ! data file (gx1) @@ -222,7 +245,9 @@ subroutine cice_init call init_flux_atm ! initialize atmosphere fluxes sent to coupler call init_flux_ocn ! initialize ocean fluxes sent to coupler - if (write_ic) call accum_hist(dt) ! write initial conditions + if (my_task == master_task) then + call ice_memusage_print(nu_diag,subname//':end') + endif end subroutine cice_init @@ -235,23 +260,24 @@ subroutine init_restart use ice_calendar, only: calendar use ice_constants, only: c0 use ice_domain, only: nblocks - use ice_domain_size, only: ncat, n_iso, n_aero, nfsd + use ice_domain_size, only: ncat, n_iso, n_aero, nfsd, nslyr use ice_dyn_eap, only: read_restart_eap use ice_dyn_shared, only: kdyn use ice_grid, only: tmask use ice_init, only: ice_ic - use ice_init_column, only: init_age, init_FY, init_lvl, & + use ice_init_column, only: init_age, init_FY, init_lvl, init_snowtracers, & init_meltponds_lvl, init_meltponds_topo, & init_isotope, init_aerosol, init_hbrine, init_bgc, init_fsd use ice_restart_column, only: restart_age, read_restart_age, & restart_FY, read_restart_FY, restart_lvl, read_restart_lvl, & restart_pond_lvl, read_restart_pond_lvl, & restart_pond_topo, read_restart_pond_topo, & + restart_snow, read_restart_snow, & restart_fsd, read_restart_fsd, & restart_iso, read_restart_iso, & restart_aero, read_restart_aero, & restart_hbrine, read_restart_hbrine, & - restart_zsal, restart_bgc + restart_bgc use ice_restart_driver, only: restartfile use ice_restart_shared, only: runtype, restart use ice_state ! almost everything @@ -261,12 +287,13 @@ subroutine init_restart iblk ! block index logical(kind=log_kind) :: & tr_iage, tr_FY, tr_lvl, tr_pond_lvl, & - tr_pond_topo, tr_fsd, tr_iso, tr_aero, tr_brine, & - skl_bgc, z_tracers, solve_zsal + tr_pond_topo, tr_snow, tr_fsd, tr_iso, tr_aero, tr_brine, & + skl_bgc, z_tracers integer(kind=int_kind) :: & ntrcr integer(kind=int_kind) :: & nt_alvl, nt_vlvl, nt_apnd, nt_hpnd, nt_ipnd, & + nt_smice, nt_smliq, nt_rhos, nt_rsnw, & nt_iage, nt_FY, nt_aero, nt_fsd, nt_isosno, nt_isoice character(len=*), parameter :: subname = '(init_restart)' @@ -277,14 +304,16 @@ subroutine init_restart file=__FILE__, line=__LINE__) call icepack_query_parameters(skl_bgc_out=skl_bgc, & - z_tracers_out=z_tracers, solve_zsal_out=solve_zsal) + z_tracers_out=z_tracers) call icepack_query_tracer_flags(tr_iage_out=tr_iage, tr_FY_out=tr_FY, & tr_lvl_out=tr_lvl, tr_pond_lvl_out=tr_pond_lvl, & tr_pond_topo_out=tr_pond_topo, tr_aero_out=tr_aero, tr_brine_out=tr_brine, & - tr_fsd_out=tr_fsd, tr_iso_out=tr_iso) + tr_snow_out=tr_snow, tr_fsd_out=tr_fsd, tr_iso_out=tr_iso) call icepack_query_tracer_indices(nt_alvl_out=nt_alvl, nt_vlvl_out=nt_vlvl, & nt_apnd_out=nt_apnd, nt_hpnd_out=nt_hpnd, nt_ipnd_out=nt_ipnd, & nt_iage_out=nt_iage, nt_FY_out=nt_FY, nt_aero_out=nt_aero, nt_fsd_out=nt_fsd, & + nt_smice_out=nt_smice, nt_smliq_out=nt_smliq, & + nt_rhos_out=nt_rhos, nt_rsnw_out=nt_rsnw, & nt_isosno_out=nt_isosno, nt_isoice_out=nt_isoice) call icepack_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & @@ -368,6 +397,22 @@ subroutine init_restart enddo ! iblk endif ! .not. restart_pond endif + + ! snow redistribution/metamorphism + if (tr_snow) then + if (trim(runtype) == 'continue') restart_snow = .true. + if (restart_snow) then + call read_restart_snow + else + do iblk = 1, nblocks + call init_snowtracers(trcrn(:,:,nt_smice:nt_smice+nslyr-1,:,iblk), & + trcrn(:,:,nt_smliq:nt_smliq+nslyr-1,:,iblk), & + trcrn(:,:,nt_rhos :nt_rhos +nslyr-1,:,iblk), & + trcrn(:,:,nt_rsnw :nt_rsnw +nslyr-1,:,iblk)) + enddo ! iblk + endif + endif + ! floe size distribution if (tr_fsd) then if (trim(runtype) == 'continue') restart_fsd = .true. @@ -405,8 +450,6 @@ subroutine init_restart if (trim(runtype) == 'continue') then if (tr_brine) & restart_hbrine = .true. - if (solve_zsal) & - restart_zsal = .true. if (skl_bgc .or. z_tracers) & restart_bgc = .true. endif @@ -416,7 +459,7 @@ subroutine init_restart if (tr_brine .and. restart_hbrine) call read_restart_hbrine endif - if (solve_zsal .or. skl_bgc .or. z_tracers) then ! biogeochemistry + if (skl_bgc .or. z_tracers) then ! biogeochemistry if (tr_fsd) then write (nu_diag,*) 'FSD implementation incomplete for use with BGC' call icepack_warnings_flush(nu_diag) diff --git a/cicecore/drivers/unittest/opticep/CICE_InitMod.F90 b/cicecore/drivers/unittest/opticep/CICE_InitMod.F90 index 0371c7f38..dc9fece6e 100644 --- a/cicecore/drivers/unittest/opticep/CICE_InitMod.F90 +++ b/cicecore/drivers/unittest/opticep/CICE_InitMod.F90 @@ -277,7 +277,7 @@ subroutine init_restart restart_iso, read_restart_iso, & restart_aero, read_restart_aero, & restart_hbrine, read_restart_hbrine, & - restart_zsal, restart_bgc + restart_bgc use ice_restart_driver, only: restartfile use ice_restart_shared, only: runtype, restart use ice_state ! almost everything @@ -288,7 +288,7 @@ subroutine init_restart logical(kind=log_kind) :: & tr_iage, tr_FY, tr_lvl, tr_pond_lvl, & tr_pond_topo, tr_snow, tr_fsd, tr_iso, tr_aero, tr_brine, & - skl_bgc, z_tracers, solve_zsal + skl_bgc, z_tracers integer(kind=int_kind) :: & ntrcr integer(kind=int_kind) :: & @@ -304,7 +304,7 @@ subroutine init_restart file=__FILE__, line=__LINE__) call icepack_query_parameters(skl_bgc_out=skl_bgc, & - z_tracers_out=z_tracers, solve_zsal_out=solve_zsal) + z_tracers_out=z_tracers) call icepack_query_tracer_flags(tr_iage_out=tr_iage, tr_FY_out=tr_FY, & tr_lvl_out=tr_lvl, tr_pond_lvl_out=tr_pond_lvl, & tr_pond_topo_out=tr_pond_topo, tr_aero_out=tr_aero, tr_brine_out=tr_brine, & @@ -450,8 +450,6 @@ subroutine init_restart if (trim(runtype) == 'continue') then if (tr_brine) & restart_hbrine = .true. - if (solve_zsal) & - restart_zsal = .true. if (skl_bgc .or. z_tracers) & restart_bgc = .true. endif @@ -461,7 +459,7 @@ subroutine init_restart if (tr_brine .and. restart_hbrine) call read_restart_hbrine endif - if (solve_zsal .or. skl_bgc .or. z_tracers) then ! biogeochemistry + if (skl_bgc .or. z_tracers) then ! biogeochemistry if (tr_fsd) then write (nu_diag,*) 'FSD implementation incomplete for use with BGC' call icepack_warnings_flush(nu_diag) diff --git a/cicecore/drivers/unittest/opticep/CICE_RunMod.F90 b/cicecore/drivers/unittest/opticep/CICE_RunMod.F90 index ae7f7ab1f..42514e06c 100644 --- a/cicecore/drivers/unittest/opticep/CICE_RunMod.F90 +++ b/cicecore/drivers/unittest/opticep/CICE_RunMod.F90 @@ -141,7 +141,7 @@ subroutine ice_step use ice_boundary, only: ice_HaloUpdate use ice_calendar, only: dt, dt_dyn, ndtd, diagfreq, write_restart, istep use ice_diagnostics, only: init_mass_diags, runtime_diags, debug_model, debug_ice - use ice_diagnostics_bgc, only: hbrine_diags, zsal_diags, bgc_diags + use ice_diagnostics_bgc, only: hbrine_diags, bgc_diags use ice_domain, only: halo_info, nblocks use ice_dyn_eap, only: write_restart_eap use ice_dyn_shared, only: kdyn, kridge @@ -175,7 +175,7 @@ subroutine ice_step logical (kind=log_kind) :: & tr_iage, tr_FY, tr_lvl, tr_fsd, tr_snow, & tr_pond_lvl, tr_pond_topo, tr_brine, tr_iso, tr_aero, & - calc_Tsfc, skl_bgc, solve_zsal, z_tracers, wave_spec + calc_Tsfc, skl_bgc, z_tracers, wave_spec character(len=*), parameter :: subname = '(ice_step)' @@ -189,8 +189,7 @@ subroutine ice_step endif call icepack_query_parameters(calc_Tsfc_out=calc_Tsfc, skl_bgc_out=skl_bgc, & - solve_zsal_out=solve_zsal, z_tracers_out=z_tracers, ktherm_out=ktherm, & - wave_spec_out=wave_spec) + z_tracers_out=z_tracers, ktherm_out=ktherm, wave_spec_out=wave_spec) call icepack_query_tracer_flags(tr_iage_out=tr_iage, tr_FY_out=tr_FY, & tr_lvl_out=tr_lvl, tr_pond_lvl_out=tr_pond_lvl, & tr_pond_topo_out=tr_pond_topo, tr_brine_out=tr_brine, tr_aero_out=tr_aero, & @@ -377,7 +376,6 @@ subroutine ice_step call ice_timer_start(timer_diags) ! diagnostics if (mod(istep,diagfreq) == 0) then call runtime_diags(dt) ! log file - if (solve_zsal) call zsal_diags if (skl_bgc .or. z_tracers) call bgc_diags if (tr_brine) call hbrine_diags if (my_task == master_task) then @@ -402,7 +400,7 @@ subroutine ice_step if (tr_fsd) call write_restart_fsd if (tr_iso) call write_restart_iso if (tr_aero) call write_restart_aero - if (solve_zsal .or. skl_bgc .or. z_tracers) & + if (skl_bgc .or. z_tracers) & call write_restart_bgc if (tr_brine) call write_restart_hbrine if (kdyn == 2) call write_restart_eap @@ -421,7 +419,7 @@ end subroutine ice_step subroutine coupling_prep (iblk) use ice_arrays_column, only: alvdfn, alidfn, alvdrn, alidrn, & - albicen, albsnon, albpndn, apeffn, fzsal_g, fzsal, snowfracn + albicen, albsnon, albpndn, apeffn, snowfracn use ice_blocks, only: nx_block, ny_block, get_block, block use ice_domain, only: blocks_ice use ice_calendar, only: dt, nstreams @@ -436,7 +434,7 @@ subroutine coupling_prep (iblk) fsens, flat, fswabs, flwout, evap, Tref, Qref, & scale_fluxes, frzmlt_init, frzmlt use ice_flux_bgc, only: faero_ocn, fiso_ocn, Qref_iso, fiso_evap, & - fzsal_ai, fzsal_g_ai, flux_bio, flux_bio_ai + flux_bio, flux_bio_ai use ice_grid, only: tmask use ice_state, only: aicen, aice #ifdef CICE_IN_NEMO @@ -587,8 +585,6 @@ subroutine coupling_prep (iblk) fsalt_ai (i,j,iblk) = fsalt (i,j,iblk) fhocn_ai (i,j,iblk) = fhocn (i,j,iblk) fswthru_ai(i,j,iblk) = fswthru(i,j,iblk) - fzsal_ai (i,j,iblk) = fzsal (i,j,iblk) - fzsal_g_ai(i,j,iblk) = fzsal_g(i,j,iblk) if (nbtrcr > 0) then do k = 1, nbtrcr @@ -634,8 +630,7 @@ subroutine coupling_prep (iblk) faero_ocn(:,:,:,iblk), & alvdr (:,:,iblk), alidr (:,:,iblk), & alvdf (:,:,iblk), alidf (:,:,iblk), & - fzsal (:,:,iblk), fzsal_g (:,:,iblk), & - flux_bio (:,:,1:nbtrcr,iblk), & + flux_bio =flux_bio (:,:,1:nbtrcr,iblk), & Qref_iso =Qref_iso (:,:,:,iblk), & fiso_evap=fiso_evap(:,:,:,iblk), & fiso_ocn =fiso_ocn (:,:,:,iblk)) diff --git a/cicecore/drivers/unittest/opticep/ice_init_column.F90 b/cicecore/drivers/unittest/opticep/ice_init_column.F90 index 82f3f4a1e..04749b98c 100644 --- a/cicecore/drivers/unittest/opticep/ice_init_column.F90 +++ b/cicecore/drivers/unittest/opticep/ice_init_column.F90 @@ -35,7 +35,7 @@ module ice_init_column use icepack_intfc, only: icepack_init_zbgc use icepack_intfc, only: icepack_init_thermo use icepack_intfc, only: icepack_step_radiation, icepack_init_orbit - use icepack_intfc, only: icepack_init_bgc, icepack_init_zsalinity + use icepack_intfc, only: icepack_init_bgc use icepack_intfc, only: icepack_init_ocean_bio, icepack_load_ocean_bio_array use icepack_intfc, only: icepack_init_hbrine @@ -389,7 +389,7 @@ subroutine init_shortwave albpndn=albpndn(i,j,:,iblk), apeffn=apeffn(i,j,:,iblk), & snowfracn=snowfracn(i,j,:,iblk), & dhsn=dhsn(i,j,:,iblk), ffracn=ffracn(i,j,:,iblk), & -!opt rsnow=rsnow(:,:), & + rsnow=rsnow(:,:), & l_print_point=l_print_point, & initonly = .true.) endif @@ -734,16 +734,14 @@ subroutine init_bgc() use ice_arrays_column, only: zfswin, trcrn_sw, & ocean_bio_all, ice_bio_net, snow_bio_net, & - cgrid, igrid, bphi, iDi, bTiz, iki, & - Rayleigh_criteria, Rayleigh_real + cgrid, igrid, bphi, iDi, bTiz, iki use ice_blocks, only: block, get_block use ice_domain, only: nblocks, blocks_ice use ice_flux, only: sss use ice_flux_bgc, only: nit, amm, sil, dmsp, dms, algalN, & doc, don, dic, fed, fep, zaeros, hum use ice_forcing_bgc, only: init_bgc_data, get_forcing_bgc - use ice_restart_column, only: restart_zsal, & - read_restart_bgc, restart_bgc + use ice_restart_column, only: read_restart_bgc, restart_bgc use ice_state, only: trcrn ! local variables @@ -757,10 +755,6 @@ subroutine init_bgc() integer (kind=int_kind) :: & max_nbtrcr, max_algae, max_don, max_doc, max_dic, max_aero, max_fe - logical (kind=log_kind) :: & - RayleighC , & - solve_zsal - type (block) :: & this_block ! block information for current block @@ -770,20 +764,15 @@ subroutine init_bgc() real(kind=dbl_kind), dimension(nilyr,ncat) :: & sicen - real(kind=dbl_kind) :: & - RayleighR - integer (kind=int_kind) :: & - nbtrcr, ntrcr, ntrcr_o, & - nt_sice, nt_bgc_S + nbtrcr, ntrcr, ntrcr_o, nt_sice character(len=*), parameter :: subname='(init_bgc)' ! Initialize - call icepack_query_parameters(solve_zsal_out=solve_zsal) call icepack_query_tracer_sizes(nbtrcr_out=nbtrcr, ntrcr_out=ntrcr, ntrcr_o_out=ntrcr_o) - call icepack_query_tracer_indices(nt_sice_out=nt_sice, nt_bgc_S_out=nt_bgc_S) + call icepack_query_tracer_indices(nt_sice_out=nt_sice) call icepack_query_tracer_sizes(max_nbtrcr_out=max_nbtrcr, & max_algae_out=max_algae, max_don_out=max_don, max_doc_out=max_doc, & max_dic_out=max_dic, max_aero_out=max_aero, max_fe_out=max_fe) @@ -804,53 +793,6 @@ subroutine init_bgc() zfswin (:,:,:,:,:) = c0 ! shortwave flux on bio grid trcrn_sw (:,:,:,:,:) = c0 ! tracers active in the shortwave calculation trcrn_bgc (:,:) = c0 - RayleighR = c0 - RayleighC = .false. - - !----------------------------------------------------------------- - ! zsalinity initialization - !----------------------------------------------------------------- - - if (solve_zsal) then ! default values - - !$OMP PARALLEL DO PRIVATE(iblk,i,j,k,n,ilo,ihi,jlo,jhi,this_block,trcrn_bgc) - 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 - call icepack_init_zsalinity(nblyr=nblyr, ntrcr_o=ntrcr_o, & - Rayleigh_criteria = RayleighC, & - Rayleigh_real = RayleighR, & - trcrn_bgc = trcrn_bgc, & - nt_bgc_S = nt_bgc_S, & - ncat = ncat, & - sss = sss(i,j,iblk)) - if (.not. restart_zsal) then - Rayleigh_real (i,j,iblk) = RayleighR - Rayleigh_criteria(i,j,iblk) = RayleighC - do n = 1,ncat - do k = 1, nblyr - trcrn (i,j,nt_bgc_S+k-1, n,iblk) = & - trcrn_bgc( nt_bgc_S+k-1-ntrcr_o,n) - enddo - enddo - endif - enddo ! i - enddo ! j - enddo ! iblk - !$OMP END PARALLEL DO - call icepack_warnings_flush(nu_diag) - if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & - file=__FILE__, line=__LINE__) - endif ! solve_zsal - - if (.not. solve_zsal) restart_zsal = .false. !----------------------------------------------------------------- ! biogeochemistry initialization @@ -966,7 +908,7 @@ subroutine init_bgc() ! read restart to complete BGC initialization !----------------------------------------------------------------- - if (restart_zsal .or. restart_bgc) call read_restart_bgc + if (restart_bgc) call read_restart_bgc deallocate(trcrn_bgc) @@ -1025,8 +967,7 @@ subroutine input_zbgc use ice_arrays_column, only: restore_bgc, optics_file, optics_file_fieldname use ice_broadcast, only: broadcast_scalar - use ice_restart_column, only: restart_bgc, restart_zsal, & - restart_hbrine + use ice_restart_column, only: restart_bgc, restart_hbrine use ice_restart_shared, only: restart character (len=char_len) :: & @@ -1045,7 +986,7 @@ subroutine input_zbgc logical (kind=log_kind) :: & solve_zsal, skl_bgc, z_tracers, scale_bgc, solve_zbgc, dEdd_algae, & - modal_aero + modal_aero, restart_zsal character (char_len) :: & bgc_flux_type @@ -1474,7 +1415,6 @@ subroutine input_zbgc write(nu_diag,*) subname//' WARNING: restart = false, setting bgc restart flags to false' restart_bgc = .false. restart_hbrine = .false. - restart_zsal = .false. endif if (solve_zsal) then @@ -1484,22 +1424,6 @@ subroutine input_zbgc abort_flag = 101 endif -#ifdef UNDEPRECATE_ZSAL - if (solve_zsal .and. nblyr < 1) then - if (my_task == master_task) then - write(nu_diag,*) subname,' ERROR: solve_zsal=T but 0 zsalinity tracers' - endif - abort_flag = 101 - endif - - if (solve_zsal .and. ((.not. tr_brine) .or. (ktherm /= 1))) then - if (my_task == master_task) then - write(nu_diag,*) subname,' ERROR: solve_zsal needs tr_brine=T and ktherm=1' - endif - abort_flag = 102 - endif -#endif - if (tr_brine .and. nblyr < 1 ) then if (my_task == master_task) then write(nu_diag,*) subname,' ERROR: tr_brine=T but no biology layers compiled' @@ -1680,12 +1604,7 @@ subroutine input_zbgc write(nu_diag,1010) ' restart_hbrine = ', restart_hbrine write(nu_diag,1005) ' phi_snow = ', phi_snow endif - write(nu_diag,1010) ' solve_zsal = ', solve_zsal - if (solve_zsal) then - write(nu_diag,1010) ' restart_zsal = ', restart_zsal - write(nu_diag,1000) ' grid_oS = ', grid_oS - write(nu_diag,1005) ' l_skS = ', l_skS - endif + write(nu_diag,1010) ' solve_zsal (deprecated) = ', solve_zsal write(nu_diag,1010) ' skl_bgc = ', skl_bgc write(nu_diag,1010) ' restart_bgc = ', restart_bgc @@ -1753,7 +1672,7 @@ subroutine input_zbgc !----------------------------------------------------------------- call icepack_init_parameters( & - ktherm_in=ktherm, shortwave_in=shortwave, solve_zsal_in=solve_zsal, & + ktherm_in=ktherm, shortwave_in=shortwave, & skl_bgc_in=skl_bgc, z_tracers_in=z_tracers, scale_bgc_in=scale_bgc, & dEdd_algae_in=dEdd_algae, & solve_zbgc_in=solve_zbgc, & @@ -1816,7 +1735,7 @@ subroutine count_tracers nbtrcr, nbtrcr_sw, & ntrcr_o, nt_fbri, & nt_bgc_Nit, nt_bgc_Am, nt_bgc_Sil, & - nt_bgc_DMS, nt_bgc_PON, nt_bgc_S, & + nt_bgc_DMS, nt_bgc_PON, & nt_bgc_DMSPp, nt_bgc_DMSPd, & nt_zbgc_frac, nlt_chl_sw, & nlt_bgc_Nit, nlt_bgc_Am, nlt_bgc_Sil, & @@ -1875,14 +1794,13 @@ subroutine count_tracers tr_bgc_hum logical (kind=log_kind) :: & - solve_zsal, skl_bgc, z_tracers + skl_bgc, z_tracers character(len=*), parameter :: subname='(count_tracers)' !----------------------------------------------------------------- call icepack_query_parameters( & - solve_zsal_out=solve_zsal, & skl_bgc_out=skl_bgc, z_tracers_out=z_tracers) call icepack_warnings_flush(nu_diag) @@ -2060,12 +1978,6 @@ subroutine count_tracers ntrcr = ntrcr + 1 endif - nt_bgc_S = 0 - if (solve_zsal) then ! .true. only if tr_brine = .true. - nt_bgc_S = ntrcr + 1 - ntrcr = ntrcr + nblyr - endif - if (skl_bgc .or. z_tracers) then if (skl_bgc) then @@ -2275,7 +2187,7 @@ subroutine count_tracers if (nt_isoice<= 0) nt_isoice= ntrcr if (nt_aero <= 0) nt_aero = ntrcr if (nt_fbri <= 0) nt_fbri = ntrcr - if (nt_bgc_S <= 0) nt_bgc_S = ntrcr +! if (nt_bgc_S <= 0) nt_bgc_S = ntrcr if (my_task == master_task) then write(nu_diag,*) ' ' @@ -2299,7 +2211,7 @@ subroutine count_tracers nt_smice_in=nt_smice, nt_smliq_in=nt_smliq, nt_rhos_in=nt_rhos, nt_rsnw_in=nt_rsnw, & nt_isosno_in=nt_isosno, nt_isoice_in=nt_isoice, nt_fbri_in=nt_fbri, & nt_bgc_Nit_in=nt_bgc_Nit, nt_bgc_Am_in=nt_bgc_Am, nt_bgc_Sil_in=nt_bgc_Sil, & - nt_bgc_DMS_in=nt_bgc_DMS, nt_bgc_PON_in=nt_bgc_PON, nt_bgc_S_in=nt_bgc_S, & + nt_bgc_DMS_in=nt_bgc_DMS, nt_bgc_PON_in=nt_bgc_PON, & nt_bgc_N_in=nt_bgc_N, nt_bgc_chl_in=nt_bgc_chl, & nt_bgc_DOC_in=nt_bgc_DOC, nt_bgc_DON_in=nt_bgc_DON, nt_bgc_DIC_in=nt_bgc_DIC, & nt_zaero_in=nt_zaero, nt_bgc_DMSPp_in=nt_bgc_DMSPp, nt_bgc_DMSPd_in=nt_bgc_DMSPd, & @@ -2342,7 +2254,7 @@ subroutine init_zbgc integer (kind=int_kind) :: & nbtrcr, nbtrcr_sw, nt_fbri, & nt_bgc_Nit, nt_bgc_Am, nt_bgc_Sil, & - nt_bgc_DMS, nt_bgc_PON, nt_bgc_S, & + nt_bgc_DMS, nt_bgc_PON, & nt_bgc_DMSPp, nt_bgc_DMSPd, & nt_zbgc_frac, nlt_chl_sw, & nlt_bgc_Nit, nlt_bgc_Am, nlt_bgc_Sil, & @@ -2423,7 +2335,7 @@ subroutine init_zbgc tau_rel ! release timescale (s), stationary to mobile phase logical (kind=log_kind) :: & - skl_bgc, z_tracers, dEdd_algae, solve_zsal + skl_bgc, z_tracers, dEdd_algae real (kind=dbl_kind), dimension(icepack_max_algae) :: & F_abs_chl ! to scale absorption in Dedd @@ -2493,12 +2405,10 @@ subroutine init_zbgc !----------------------------------------------------------------- call icepack_query_parameters( & - solve_zsal_out=solve_zsal, & skl_bgc_out=skl_bgc, z_tracers_out=z_tracers, & dEdd_algae_out=dEdd_algae, & grid_o_out=grid_o, l_sk_out=l_sk, & initbio_frac_out=initbio_frac, & - grid_oS_out=grid_oS, l_skS_out=l_skS, & phi_snow_out=phi_snow, frazil_scav_out = frazil_scav) call icepack_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & @@ -2524,7 +2434,7 @@ subroutine init_zbgc call icepack_query_tracer_indices( & nt_fbri_out=nt_fbri, & nt_bgc_Nit_out=nt_bgc_Nit, nt_bgc_Am_out=nt_bgc_Am, nt_bgc_Sil_out=nt_bgc_Sil, & - nt_bgc_DMS_out=nt_bgc_DMS, nt_bgc_PON_out=nt_bgc_PON, nt_bgc_S_out=nt_bgc_S, & + nt_bgc_DMS_out=nt_bgc_DMS, nt_bgc_PON_out=nt_bgc_PON, & nt_bgc_N_out=nt_bgc_N, nt_bgc_chl_out=nt_bgc_chl, & nt_bgc_DOC_out=nt_bgc_DOC, nt_bgc_DON_out=nt_bgc_DON, nt_bgc_DIC_out=nt_bgc_DIC, & nt_zaero_out=nt_zaero, nt_bgc_DMSPp_out=nt_bgc_DMSPp, nt_bgc_DMSPd_out=nt_bgc_DMSPd, & @@ -2685,7 +2595,7 @@ subroutine init_zbgc !opt fr_resp_s_in=fr_resp_s, y_sk_DMS_in=y_sk_DMS, t_sk_conv_in=t_sk_conv, t_sk_ox_in=t_sk_ox, & !opt mu_max_in=mu_max, R_Si2N_in=R_Si2N, R_C2N_DON_in=R_C2N_DON, chlabs_in=chlabs, & !opt alpha2max_low_in=alpha2max_low, beta2max_in=beta2max, grow_Tdep_in=grow_Tdep, & -!opt fr_graze_in=fr_graze, mort_pre_in=mort_pre, f_doc_in=f_doc,fsal_in=fsal, & +!opt fr_graze_in=fr_graze, mort_pre_in=mort_pre, f_doc_in=f_doc,fsal_in=fsal) ) call icepack_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & @@ -2709,18 +2619,6 @@ subroutine init_zbgc ntd = 0 ! if nt_fbri /= 0 then use fbri dependency if (nt_fbri == 0) ntd = -1 ! otherwise make tracers depend on ice volume - if (solve_zsal) then ! .true. only if tr_brine = .true. - do k = 1,nblyr - trcr_depend(nt_bgc_S + k - 1) = 2 + nt_fbri + ntd - trcr_base (nt_bgc_S,1) = c0 ! default: ice area - trcr_base (nt_bgc_S,2) = c1 - trcr_base (nt_bgc_S,3) = c0 - n_trcr_strata(nt_bgc_S) = 1 - nt_strata(nt_bgc_S,1) = nt_fbri - nt_strata(nt_bgc_S,2) = 0 - enddo - endif - bio_index(:) = 0 bio_index_o(:) = 0 @@ -2988,8 +2886,8 @@ subroutine init_zbgc call icepack_init_zbgc( & !opt zbgc_init_frac_in=zbgc_init_frac, tau_ret_in=tau_ret, tau_rel_in=tau_rel, & -!opt zbgc_frac_init_in=zbgc_frac_init, bgc_tracer_type_in=bgc_tracer_type, & - ) +!opt zbgc_frac_init_in=zbgc_frac_init, bgc_tracer_type_in=bgc_tracer_type) + ) call icepack_init_tracer_indices( & bio_index_o_in=bio_index_o, bio_index_in=bio_index) call icepack_warnings_flush(nu_diag) diff --git a/cicecore/drivers/unittest/opticep/ice_step_mod.F90 b/cicecore/drivers/unittest/opticep/ice_step_mod.F90 index ac66255a4..c291d8802 100644 --- a/cicecore/drivers/unittest/opticep/ice_step_mod.F90 +++ b/cicecore/drivers/unittest/opticep/ice_step_mod.F90 @@ -539,9 +539,8 @@ subroutine step_therm1 (dt, iblk) lmask_s = lmask_s (i,j, iblk), & mlt_onset = mlt_onset (i,j, iblk), & frz_onset = frz_onset (i,j, iblk), & - yday=yday & -!opt prescribed_ice=prescribed_ice, & - ) + yday=yday) +!opt prescribed_ice=prescribed_ice) !----------------------------------------------------------------- ! handle per-category i2x fields, no merging @@ -614,7 +613,7 @@ end subroutine step_therm1 subroutine step_therm2 (dt, iblk) - use ice_arrays_column, only: hin_max, fzsal, ocean_bio, wave_sig_ht, & + use ice_arrays_column, only: hin_max, ocean_bio, wave_sig_ht, & wave_spectrum, wavefreq, dwavefreq, & first_ice, bgrid, cgrid, igrid, floe_rad_c, floe_binwidth, & d_afsd_latg, d_afsd_newi, d_afsd_latm, d_afsd_weld @@ -647,15 +646,14 @@ subroutine step_therm2 (dt, iblk) logical (kind=log_kind) :: & tr_fsd, & ! floe size distribution tracers - z_tracers, & ! vertical biogeochemistry - solve_zsal ! zsalinity + z_tracers ! vertical biogeochemistry type (block) :: & this_block ! block information for current block character(len=*), parameter :: subname = '(step_therm2)' - call icepack_query_parameters(z_tracers_out=z_tracers,solve_zsal_out=solve_zsal) + call icepack_query_parameters(z_tracers_out=z_tracers) call icepack_query_tracer_sizes(ntrcr_out=ntrcr, nbtrcr_out=nbtrcr) call icepack_query_tracer_flags(tr_fsd_out=tr_fsd) call icepack_warnings_flush(nu_diag) @@ -663,7 +661,7 @@ subroutine step_therm2 (dt, iblk) file=__FILE__, line=__LINE__) ! nltrcr is only used as a zbgc flag in icepack (number of zbgc tracers > 0) - if (z_tracers .or. solve_zsal) then + if (z_tracers) then nltrcr = 1 else nltrcr = 0 @@ -719,7 +717,6 @@ subroutine step_therm2 (dt, iblk) igrid = igrid, & faero_ocn = faero_ocn (i,j,:,iblk), & first_ice = first_ice (i,j,:,iblk), & - fzsal = fzsal (i,j, iblk), & flux_bio = flux_bio (i,j,1:nbtrcr,iblk), & ocean_bio = ocean_bio (i,j,1:nbtrcr,iblk), & frazil_diag= frazil_diag(i,j,iblk) & @@ -739,7 +736,7 @@ subroutine step_therm2 (dt, iblk) !opt d_afsd_latm= d_afsd_latm(i,j,:,iblk),& !opt d_afsd_weld= d_afsd_weld(i,j,:,iblk),& !opt floe_rad_c = floe_rad_c(:), & -!opt floe_binwidth = floe_binwidth(:) & +!opt floe_binwidth = floe_binwidth(:)) ) endif ! tmask @@ -1042,7 +1039,7 @@ end subroutine step_dyn_horiz subroutine step_dyn_ridge (dt, ndtd, iblk) - use ice_arrays_column, only: hin_max, fzsal, first_ice + use ice_arrays_column, only: hin_max, first_ice use ice_domain_size, only: ncat, nilyr, nslyr, n_aero, nblyr use ice_flux, only: & rdg_conv, rdg_shear, dardg1dt, dardg2dt, & @@ -1139,7 +1136,6 @@ subroutine step_dyn_ridge (dt, ndtd, iblk) aice = aice (i,j, iblk), & fsalt = fsalt (i,j, iblk), & first_ice = first_ice(i,j,:,iblk), & - fzsal = fzsal (i,j, iblk), & flux_bio = flux_bio (i,j,1:nbtrcr,iblk)) endif ! tmask @@ -1431,7 +1427,7 @@ subroutine step_radiation (dt, iblk) albpndn =albpndn (i,j,: ,iblk), apeffn =apeffn (i,j,: ,iblk), & snowfracn=snowfracn(i,j,: ,iblk), & dhsn =dhsn (i,j,: ,iblk), ffracn =ffracn(i,j,:,iblk), & -!opt rsnow =rsnow (:,:), & +!opt rsnow =rsnow (:,:), l_print_point=l_print_point) endif @@ -1619,12 +1615,12 @@ end subroutine ocean_mixed_layer subroutine biogeochemistry (dt, iblk) use ice_arrays_column, only: upNO, upNH, iDi, iki, zfswin, & - zsal_tot, darcy_V, grow_net, & + darcy_V, grow_net, & PP_net, hbri,dhbr_bot, dhbr_top, Zoo,& fbio_snoice, fbio_atmice, ocean_bio, & first_ice, fswpenln, bphi, bTiz, ice_bio_net, & - snow_bio_net, fswthrun, Rayleigh_criteria, & - ocean_bio_all, sice_rho, fzsal, fzsal_g, & + snow_bio_net, fswthrun, & + ocean_bio_all, sice_rho, & bgrid, igrid, icgrid, cgrid use ice_domain_size, only: nblyr, nilyr, nslyr, n_algae, n_zaero, ncat, & n_doc, n_dic, n_don, n_fed, n_fep @@ -1721,7 +1717,6 @@ subroutine biogeochemistry (dt, iblk) iDi = iDi (i,j,:,:, iblk), & iki = iki (i,j,:,:, iblk), & zfswin = zfswin (i,j,:,:, iblk), & - zsal_tot = zsal_tot (i,j, iblk), & darcy_V = darcy_V (i,j,:, iblk), & grow_net = grow_net (i,j, iblk), & PP_net = PP_net (i,j, iblk), & @@ -1740,8 +1735,6 @@ subroutine biogeochemistry (dt, iblk) snow_bio_net = snow_bio_net(i,j,1:nbtrcr, iblk), & fswthrun = fswthrun (i,j,:, iblk), & sice_rho = sice_rho (i,j,:, iblk), & - fzsal = fzsal (i,j, iblk), & - fzsal_g = fzsal_g (i,j, iblk), & meltbn = meltbn (i,j,:, iblk), & melttn = melttn (i,j,:, iblk), & congeln = congeln (i,j,:, iblk), & @@ -1761,7 +1754,6 @@ subroutine biogeochemistry (dt, iblk) aice0 = aice0 (i,j, iblk), & trcrn = trcrn (i,j,:,:, iblk), & vsnon_init = vsnon_init (i,j,:, iblk), & - Rayleigh_criteria = Rayleigh_criteria(i,j,iblk), & skl_bgc = skl_bgc) enddo ! i diff --git a/cicecore/drivers/unittest/sumchk/CICE_InitMod.F90 b/cicecore/drivers/unittest/sumchk/CICE_InitMod.F90 index 8a5070d25..dc9fece6e 100644 --- a/cicecore/drivers/unittest/sumchk/CICE_InitMod.F90 +++ b/cicecore/drivers/unittest/sumchk/CICE_InitMod.F90 @@ -15,9 +15,11 @@ module CICE_InitMod use ice_kinds_mod use ice_exit, only: abort_ice use ice_fileunits, only: init_fileunits, nu_diag + use ice_memusage, only: ice_memusage_init, ice_memusage_print use icepack_intfc, only: icepack_aggregate use icepack_intfc, only: icepack_init_itd, icepack_init_itd_hist use icepack_intfc, only: icepack_init_fsd_bounds, icepack_init_wave + use icepack_intfc, only: icepack_init_snow use icepack_intfc, only: icepack_configure use icepack_intfc, only: icepack_warnings_flush, icepack_warnings_aborted use icepack_intfc, only: icepack_query_parameters, icepack_query_tracer_flags, & @@ -64,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, istep, istep1, write_ic, & + use ice_calendar, only: dt, dt_dyn, write_ic, & init_calendar, advance_timestep, calc_timesteps use ice_communicate, only: init_communicate, my_task, master_task use ice_diagnostics, only: init_diags @@ -74,11 +76,10 @@ subroutine cice_init use ice_dyn_evp, only: init_evp use ice_dyn_vp, only: init_vp use ice_dyn_shared, only: kdyn - use ice_dyn_vp, only: init_vp use ice_flux, only: init_coupler_flux, init_history_therm, & init_history_dyn, init_flux_atm, init_flux_ocn, alloc_flux use ice_forcing, only: init_forcing_ocn, init_forcing_atmo, & - get_forcing_atmo, get_forcing_ocn, get_wave_spec + get_forcing_atmo, get_forcing_ocn, get_wave_spec, init_snowtable use ice_forcing_bgc, only: get_forcing_bgc, get_atm_bgc, & faero_default, faero_optics, alloc_forcing_bgc, fiso_default use ice_grid, only: init_grid1, init_grid2, alloc_grid @@ -92,7 +93,8 @@ subroutine cice_init use ice_transport_driver, only: init_transport logical(kind=log_kind) :: tr_aero, tr_zaero, skl_bgc, z_tracers, & - tr_iso, tr_fsd, wave_spec + tr_iso, tr_fsd, wave_spec, tr_snow + character(len=char_len) :: snw_aging_table character(len=*), parameter :: subname = '(cice_init)' call init_communicate ! initial setup for message passing @@ -110,6 +112,12 @@ subroutine cice_init call input_zbgc ! vertical biogeochemistry namelist call count_tracers ! count tracers + ! Call this as early as possible, must be after memory_stats is read + if (my_task == master_task) then + call ice_memusage_init(nu_diag) + call ice_memusage_print(nu_diag,subname//':start') + endif + call init_domain_blocks ! set up block decomposition call init_grid1 ! domain distribution call alloc_grid ! allocate grid arrays @@ -163,7 +171,7 @@ subroutine cice_init call ice_HaloRestore_init ! restored boundary conditions call icepack_query_parameters(skl_bgc_out=skl_bgc, z_tracers_out=z_tracers, & - wave_spec_out=wave_spec) + wave_spec_out=wave_spec, snw_aging_table_out=snw_aging_table) call icepack_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call abort_ice(trim(subname), & file=__FILE__,line= __LINE__) @@ -177,7 +185,7 @@ subroutine cice_init call calc_timesteps ! update timestep counter if not using npt_unit="1" call icepack_query_tracer_flags(tr_aero_out=tr_aero, tr_zaero_out=tr_zaero) - call icepack_query_tracer_flags(tr_iso_out=tr_iso) + call icepack_query_tracer_flags(tr_iso_out=tr_iso, tr_snow_out=tr_snow) call icepack_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call abort_ice(trim(subname), & file=__FILE__,line= __LINE__) @@ -191,6 +199,8 @@ subroutine cice_init if (trim(runtype) == 'continue' .or. restart) & call init_shortwave ! initialize radiative transfer + if (write_ic) call accum_hist(dt) ! write initial conditions + ! tcraig, use advance_timestep here ! istep = istep + 1 ! update time step counters ! istep1 = istep1 + 1 @@ -208,8 +218,20 @@ subroutine cice_init call get_forcing_atmo ! atmospheric forcing from data call get_forcing_ocn(dt) ! ocean forcing from data + ! snow aging lookup table initialization + if (tr_snow) then ! advanced snow physics + call icepack_init_snow() + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + if (snw_aging_table(1:4) /= 'test') then + call init_snowtable() + endif + endif + ! isotopes if (tr_iso) call fiso_default ! default values + ! aerosols ! if (tr_aero) call faero_data ! data file ! if (tr_zaero) call fzaero_data ! data file (gx1) @@ -223,7 +245,9 @@ subroutine cice_init call init_flux_atm ! initialize atmosphere fluxes sent to coupler call init_flux_ocn ! initialize ocean fluxes sent to coupler - if (write_ic) call accum_hist(dt) ! write initial conditions + if (my_task == master_task) then + call ice_memusage_print(nu_diag,subname//':end') + endif end subroutine cice_init @@ -236,23 +260,24 @@ subroutine init_restart use ice_calendar, only: calendar use ice_constants, only: c0 use ice_domain, only: nblocks - use ice_domain_size, only: ncat, n_iso, n_aero, nfsd + use ice_domain_size, only: ncat, n_iso, n_aero, nfsd, nslyr use ice_dyn_eap, only: read_restart_eap use ice_dyn_shared, only: kdyn use ice_grid, only: tmask use ice_init, only: ice_ic - use ice_init_column, only: init_age, init_FY, init_lvl, & + use ice_init_column, only: init_age, init_FY, init_lvl, init_snowtracers, & init_meltponds_lvl, init_meltponds_topo, & init_isotope, init_aerosol, init_hbrine, init_bgc, init_fsd use ice_restart_column, only: restart_age, read_restart_age, & restart_FY, read_restart_FY, restart_lvl, read_restart_lvl, & restart_pond_lvl, read_restart_pond_lvl, & restart_pond_topo, read_restart_pond_topo, & + restart_snow, read_restart_snow, & restart_fsd, read_restart_fsd, & restart_iso, read_restart_iso, & restart_aero, read_restart_aero, & restart_hbrine, read_restart_hbrine, & - restart_zsal, restart_bgc + restart_bgc use ice_restart_driver, only: restartfile use ice_restart_shared, only: runtype, restart use ice_state ! almost everything @@ -262,12 +287,13 @@ subroutine init_restart iblk ! block index logical(kind=log_kind) :: & tr_iage, tr_FY, tr_lvl, tr_pond_lvl, & - tr_pond_topo, tr_fsd, tr_iso, tr_aero, tr_brine, & - skl_bgc, z_tracers, solve_zsal + tr_pond_topo, tr_snow, tr_fsd, tr_iso, tr_aero, tr_brine, & + skl_bgc, z_tracers integer(kind=int_kind) :: & ntrcr integer(kind=int_kind) :: & nt_alvl, nt_vlvl, nt_apnd, nt_hpnd, nt_ipnd, & + nt_smice, nt_smliq, nt_rhos, nt_rsnw, & nt_iage, nt_FY, nt_aero, nt_fsd, nt_isosno, nt_isoice character(len=*), parameter :: subname = '(init_restart)' @@ -278,14 +304,16 @@ subroutine init_restart file=__FILE__, line=__LINE__) call icepack_query_parameters(skl_bgc_out=skl_bgc, & - z_tracers_out=z_tracers, solve_zsal_out=solve_zsal) + z_tracers_out=z_tracers) call icepack_query_tracer_flags(tr_iage_out=tr_iage, tr_FY_out=tr_FY, & tr_lvl_out=tr_lvl, tr_pond_lvl_out=tr_pond_lvl, & tr_pond_topo_out=tr_pond_topo, tr_aero_out=tr_aero, tr_brine_out=tr_brine, & - tr_fsd_out=tr_fsd, tr_iso_out=tr_iso) + tr_snow_out=tr_snow, tr_fsd_out=tr_fsd, tr_iso_out=tr_iso) call icepack_query_tracer_indices(nt_alvl_out=nt_alvl, nt_vlvl_out=nt_vlvl, & nt_apnd_out=nt_apnd, nt_hpnd_out=nt_hpnd, nt_ipnd_out=nt_ipnd, & nt_iage_out=nt_iage, nt_FY_out=nt_FY, nt_aero_out=nt_aero, nt_fsd_out=nt_fsd, & + nt_smice_out=nt_smice, nt_smliq_out=nt_smliq, & + nt_rhos_out=nt_rhos, nt_rsnw_out=nt_rsnw, & nt_isosno_out=nt_isosno, nt_isoice_out=nt_isoice) call icepack_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & @@ -369,6 +397,22 @@ subroutine init_restart enddo ! iblk endif ! .not. restart_pond endif + + ! snow redistribution/metamorphism + if (tr_snow) then + if (trim(runtype) == 'continue') restart_snow = .true. + if (restart_snow) then + call read_restart_snow + else + do iblk = 1, nblocks + call init_snowtracers(trcrn(:,:,nt_smice:nt_smice+nslyr-1,:,iblk), & + trcrn(:,:,nt_smliq:nt_smliq+nslyr-1,:,iblk), & + trcrn(:,:,nt_rhos :nt_rhos +nslyr-1,:,iblk), & + trcrn(:,:,nt_rsnw :nt_rsnw +nslyr-1,:,iblk)) + enddo ! iblk + endif + endif + ! floe size distribution if (tr_fsd) then if (trim(runtype) == 'continue') restart_fsd = .true. @@ -406,8 +450,6 @@ subroutine init_restart if (trim(runtype) == 'continue') then if (tr_brine) & restart_hbrine = .true. - if (solve_zsal) & - restart_zsal = .true. if (skl_bgc .or. z_tracers) & restart_bgc = .true. endif @@ -417,7 +459,7 @@ subroutine init_restart if (tr_brine .and. restart_hbrine) call read_restart_hbrine endif - if (solve_zsal .or. skl_bgc .or. z_tracers) then ! biogeochemistry + if (skl_bgc .or. z_tracers) then ! biogeochemistry if (tr_fsd) then write (nu_diag,*) 'FSD implementation incomplete for use with BGC' call icepack_warnings_flush(nu_diag) diff --git a/cicecore/shared/ice_arrays_column.F90 b/cicecore/shared/ice_arrays_column.F90 index b4727d3fd..66f1819fa 100644 --- a/cicecore/shared/ice_arrays_column.F90 +++ b/cicecore/shared/ice_arrays_column.F90 @@ -69,32 +69,27 @@ module ice_arrays_column character (len=35), public, allocatable :: c_hi_range(:) ! icepack_snow.F90 - real (kind=dbl_kind), public, & - dimension (:,:,:), allocatable :: & + real (kind=dbl_kind), public, dimension (:,:,:), allocatable :: & meltsliq ! snow melt mass (kg/m^2/step-->kg/m^2/day) - real (kind=dbl_kind), public, & - dimension (:,:,:,:), allocatable :: & + real (kind=dbl_kind), public, dimension (:,:,:,:), allocatable :: & meltsliqn ! snow melt mass in category n (kg/m^2) ! icepack_meltpond_lvl.F90 - real (kind=dbl_kind), public, & - dimension (:,:,:,:), allocatable :: & + real (kind=dbl_kind), public, dimension (:,:,:,:), allocatable :: & dhsn, & ! depth difference for snow on sea ice and pond ice ffracn ! fraction of fsurfn used to melt ipond ! icepack_shortwave.F90 ! category albedos - real (kind=dbl_kind), & - dimension (:,:,:,:), allocatable, public :: & + real (kind=dbl_kind), dimension (:,:,:,:), allocatable, public :: & alvdrn , & ! visible direct albedo (fraction) alidrn , & ! near-ir direct albedo (fraction) alvdfn , & ! visible diffuse albedo (fraction) alidfn ! near-ir diffuse albedo (fraction) ! albedo components for history - real (kind=dbl_kind), & - dimension (:,:,:,:), allocatable, public :: & + real (kind=dbl_kind), dimension (:,:,:,:), allocatable, public :: & albicen, & ! bare ice albsnon, & ! snow albpndn, & ! pond @@ -104,16 +99,13 @@ module ice_arrays_column snowfracn ! Category snow fraction used in radiation ! shortwave components - real (kind=dbl_kind), & - dimension (:,:,:,:,:), allocatable, public :: & + real (kind=dbl_kind), dimension (:,:,:,:,:), allocatable, public :: & Iswabsn ! SW radiation absorbed in ice layers (W m-2) - real (kind=dbl_kind), & - dimension (:,:,:,:,:), allocatable, public :: & + real (kind=dbl_kind), dimension (:,:,:,:,:), allocatable, public :: & Sswabsn ! SW radiation absorbed in snow layers (W m-2) - real (kind=dbl_kind), dimension (:,:,:,:), allocatable, & - public :: & + real (kind=dbl_kind), dimension (:,:,:,:), allocatable, public :: & fswsfcn , & ! SW absorbed at ice/snow surface (W m-2) fswthrun , & ! SW through ice to ocean (W/m^2) fswthrun_vdr , & ! vis dir SW through ice to ocean (W/m^2) @@ -122,8 +114,7 @@ module ice_arrays_column fswthrun_idf , & ! nir dif SW through ice to ocean (W/m^2) fswintn ! SW absorbed in ice interior, below surface (W m-2) - real (kind=dbl_kind), dimension (:,:,:,:,:), allocatable, & - public :: & + real (kind=dbl_kind), dimension (:,:,:,:,:), allocatable, public :: & fswpenln ! visible SW entering ice layers (W m-2) ! aerosol optical properties -> band | @@ -197,55 +188,33 @@ module ice_arrays_column integer (kind=int_kind), dimension(:,:,:,:), allocatable, public :: & algal_peak ! vertical location of algal maximum, 0 if no maximum - real (kind=dbl_kind), & - dimension (:,:,:,:,:), allocatable, public :: & + real (kind=dbl_kind), dimension (:,:,:,:,:), allocatable, public :: & Zoo ! N losses accumulated in timestep (ie. zooplankton/bacteria) ! mmol/m^3 - real (kind=dbl_kind), & - dimension (:,:,:,:), allocatable, public :: & + real (kind=dbl_kind), dimension (:,:,:,:), allocatable, public :: & dhbr_top , & ! brine top change dhbr_bot ! brine bottom change - real (kind=dbl_kind), & - dimension (:,:,:), allocatable, public :: & + real (kind=dbl_kind), dimension (:,:,:), allocatable, public :: & grow_net , & ! Specific growth rate (/s) per grid cell PP_net , & ! Total production (mg C/m^2/s) per grid cell hbri ! brine height, area-averaged for comparison with hi (m) - real (kind=dbl_kind), & - dimension (:,:,:,:,:), allocatable, public :: & + real (kind=dbl_kind), dimension (:,:,:,:,:), allocatable, public :: & bphi , & ! porosity of layers bTiz ! layer temperatures interpolated on bio grid (C) - real (kind=dbl_kind), & - dimension (:,:,:,:), allocatable, public :: & + real (kind=dbl_kind), dimension (:,:,:,:), allocatable, public :: & darcy_V ! darcy velocity positive up (m/s) real (kind=dbl_kind), dimension (:,:,:), allocatable, public :: & - zsal_tot , & ! Total ice salinity in per grid cell (g/m^2) chl_net , & ! Total chla (mg chla/m^2) per grid cell NO_net ! Total nitrate per grid cell - logical (kind=log_kind), dimension (:,:,:), allocatable, public :: & - Rayleigh_criteria ! .true. means Ra_c was reached - - real (kind=dbl_kind), dimension (:,:,:), allocatable, public :: & - Rayleigh_real ! .true. = c1, .false. = c0 - - real (kind=dbl_kind), & - dimension (:,:,:,:), allocatable, public :: & + real (kind=dbl_kind), dimension (:,:,:,:), allocatable, public :: & sice_rho ! avg sea ice density (kg/m^3) ! ech: diagnostic only? - real (kind=dbl_kind), & - dimension (:,:,:,:), allocatable, public :: & - fzsaln, & ! category fzsal(kg/m^2/s) - fzsaln_g ! salt flux from gravity drainage only - - real (kind=dbl_kind), dimension (:,:,:), allocatable, public :: & - fzsal , & ! Total flux of salt to ocean at time step for conservation - fzsal_g ! Total gravity drainage flux - real (kind=dbl_kind), dimension (:,:,:,:,:), allocatable, public :: & zfswin ! Shortwave flux into layers interpolated on bio grid (W/m^2) @@ -257,13 +226,11 @@ module ice_arrays_column upNO , & ! nitrate uptake rate (mmol/m^2/d) times aice upNH ! ammonium uptake rate (mmol/m^2/d) times aice - real (kind=dbl_kind), & - dimension(:,:,:,:,:), allocatable, public :: & + real (kind=dbl_kind), dimension(:,:,:,:,:), allocatable, public :: & trcrn_sw ! bgc tracers active in the delta-Eddington shortwave ! calculation on the shortwave grid (swgrid) - real (kind=dbl_kind), & - dimension (:,:,:,:), allocatable, public :: & + real (kind=dbl_kind), dimension (:,:,:,:), allocatable, public :: & ice_bio_net , & ! depth integrated tracer (mmol/m^2) snow_bio_net ! depth integrated snow tracer (mmol/m^2) @@ -354,14 +321,8 @@ subroutine alloc_arrays_column grow_net (nx_block,ny_block,max_blocks), & ! Specific growth rate (/s) per grid cell PP_net (nx_block,ny_block,max_blocks), & ! Total production (mg C/m^2/s) per grid cell hbri (nx_block,ny_block,max_blocks), & ! brine height, area-averaged for comparison with hi (m) - zsal_tot (nx_block,ny_block,max_blocks), & ! Total ice salinity in per grid cell (g/m^2) chl_net (nx_block,ny_block,max_blocks), & ! Total chla (mg chla/m^2) per grid cell NO_net (nx_block,ny_block,max_blocks), & ! Total nitrate per grid cell - Rayleigh_criteria & - (nx_block,ny_block,max_blocks), & ! .true. means Ra_c was reached - Rayleigh_real(nx_block,ny_block,max_blocks), & ! .true. = c1, .false. = c0 - fzsal (nx_block,ny_block,max_blocks), & ! Total flux of salt to ocean at time step for conservation - fzsal_g (nx_block,ny_block,max_blocks), & ! Total gravity drainage flux upNO (nx_block,ny_block,max_blocks), & ! nitrate uptake rate (mmol/m^2/d) times aice upNH (nx_block,ny_block,max_blocks), & ! ammonium uptake rate (mmol/m^2/d) times aice meltsliq (nx_block,ny_block,max_blocks), & ! snow melt mass (kg/m^2) @@ -391,8 +352,6 @@ subroutine alloc_arrays_column dhbr_bot (nx_block,ny_block,ncat,max_blocks), & ! brine bottom change darcy_V (nx_block,ny_block,ncat,max_blocks), & ! darcy velocity positive up (m/s) sice_rho (nx_block,ny_block,ncat,max_blocks), & ! avg sea ice density (kg/m^3) ! ech: diagnostic only? - fzsaln (nx_block,ny_block,ncat,max_blocks), & ! category fzsal(kg/m^2/s) - fzsaln_g (nx_block,ny_block,ncat,max_blocks), & ! salt flux from gravity drainage only Iswabsn (nx_block,ny_block,nilyr,ncat,max_blocks), & ! SW radiation absorbed in ice layers (W m-2) Sswabsn (nx_block,ny_block,nslyr,ncat,max_blocks), & ! SW radiation absorbed in snow layers (W m-2) fswpenln (nx_block,ny_block,nilyr+1,ncat,max_blocks), & ! visible SW entering ice layers (W m-2) diff --git a/cicecore/shared/ice_init_column.F90 b/cicecore/shared/ice_init_column.F90 index 0d06b0aac..5b25dc165 100644 --- a/cicecore/shared/ice_init_column.F90 +++ b/cicecore/shared/ice_init_column.F90 @@ -35,7 +35,7 @@ module ice_init_column use icepack_intfc, only: icepack_init_zbgc use icepack_intfc, only: icepack_init_thermo use icepack_intfc, only: icepack_step_radiation, icepack_init_orbit - use icepack_intfc, only: icepack_init_bgc, icepack_init_zsalinity + use icepack_intfc, only: icepack_init_bgc use icepack_intfc, only: icepack_init_ocean_bio, icepack_load_ocean_bio_array use icepack_intfc, only: icepack_init_hbrine @@ -734,16 +734,14 @@ subroutine init_bgc() use ice_arrays_column, only: zfswin, trcrn_sw, & ocean_bio_all, ice_bio_net, snow_bio_net, & - cgrid, igrid, bphi, iDi, bTiz, iki, & - Rayleigh_criteria, Rayleigh_real + cgrid, igrid, bphi, iDi, bTiz, iki use ice_blocks, only: block, get_block use ice_domain, only: nblocks, blocks_ice use ice_flux, only: sss use ice_flux_bgc, only: nit, amm, sil, dmsp, dms, algalN, & doc, don, dic, fed, fep, zaeros, hum use ice_forcing_bgc, only: init_bgc_data, get_forcing_bgc - use ice_restart_column, only: restart_zsal, & - read_restart_bgc, restart_bgc + use ice_restart_column, only: read_restart_bgc, restart_bgc use ice_state, only: trcrn ! local variables @@ -757,10 +755,6 @@ subroutine init_bgc() integer (kind=int_kind) :: & max_nbtrcr, max_algae, max_don, max_doc, max_dic, max_aero, max_fe - logical (kind=log_kind) :: & - RayleighC , & - solve_zsal - type (block) :: & this_block ! block information for current block @@ -770,20 +764,15 @@ subroutine init_bgc() real(kind=dbl_kind), dimension(nilyr,ncat) :: & sicen - real(kind=dbl_kind) :: & - RayleighR - integer (kind=int_kind) :: & - nbtrcr, ntrcr, ntrcr_o, & - nt_sice, nt_bgc_S + nbtrcr, ntrcr, ntrcr_o, nt_sice character(len=*), parameter :: subname='(init_bgc)' ! Initialize - call icepack_query_parameters(solve_zsal_out=solve_zsal) call icepack_query_tracer_sizes(nbtrcr_out=nbtrcr, ntrcr_out=ntrcr, ntrcr_o_out=ntrcr_o) - call icepack_query_tracer_indices(nt_sice_out=nt_sice, nt_bgc_S_out=nt_bgc_S) + call icepack_query_tracer_indices(nt_sice_out=nt_sice) call icepack_query_tracer_sizes(max_nbtrcr_out=max_nbtrcr, & max_algae_out=max_algae, max_don_out=max_don, max_doc_out=max_doc, & max_dic_out=max_dic, max_aero_out=max_aero, max_fe_out=max_fe) @@ -804,53 +793,6 @@ subroutine init_bgc() zfswin (:,:,:,:,:) = c0 ! shortwave flux on bio grid trcrn_sw (:,:,:,:,:) = c0 ! tracers active in the shortwave calculation trcrn_bgc (:,:) = c0 - RayleighR = c0 - RayleighC = .false. - - !----------------------------------------------------------------- - ! zsalinity initialization - !----------------------------------------------------------------- - - if (solve_zsal) then ! default values - - !$OMP PARALLEL DO PRIVATE(iblk,i,j,k,n,ilo,ihi,jlo,jhi,this_block,trcrn_bgc) - 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 - call icepack_init_zsalinity(nblyr=nblyr, ntrcr_o=ntrcr_o, & - Rayleigh_criteria = RayleighC, & - Rayleigh_real = RayleighR, & - trcrn_bgc = trcrn_bgc, & - nt_bgc_S = nt_bgc_S, & - ncat = ncat, & - sss = sss(i,j,iblk)) - if (.not. restart_zsal) then - Rayleigh_real (i,j,iblk) = RayleighR - Rayleigh_criteria(i,j,iblk) = RayleighC - do n = 1,ncat - do k = 1, nblyr - trcrn (i,j,nt_bgc_S+k-1, n,iblk) = & - trcrn_bgc( nt_bgc_S+k-1-ntrcr_o,n) - enddo - enddo - endif - enddo ! i - enddo ! j - enddo ! iblk - !$OMP END PARALLEL DO - call icepack_warnings_flush(nu_diag) - if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & - file=__FILE__, line=__LINE__) - endif ! solve_zsal - - if (.not. solve_zsal) restart_zsal = .false. !----------------------------------------------------------------- ! biogeochemistry initialization @@ -966,7 +908,7 @@ subroutine init_bgc() ! read restart to complete BGC initialization !----------------------------------------------------------------- - if (restart_zsal .or. restart_bgc) call read_restart_bgc + if (restart_bgc) call read_restart_bgc deallocate(trcrn_bgc) @@ -1025,8 +967,7 @@ subroutine input_zbgc use ice_arrays_column, only: restore_bgc, optics_file, optics_file_fieldname use ice_broadcast, only: broadcast_scalar - use ice_restart_column, only: restart_bgc, restart_zsal, & - restart_hbrine + use ice_restart_column, only: restart_bgc, restart_hbrine use ice_restart_shared, only: restart character (len=char_len) :: & @@ -1045,7 +986,7 @@ subroutine input_zbgc logical (kind=log_kind) :: & solve_zsal, skl_bgc, z_tracers, scale_bgc, solve_zbgc, dEdd_algae, & - modal_aero + modal_aero, restart_zsal character (char_len) :: & bgc_flux_type @@ -1474,7 +1415,6 @@ subroutine input_zbgc write(nu_diag,*) subname//' WARNING: restart = false, setting bgc restart flags to false' restart_bgc = .false. restart_hbrine = .false. - restart_zsal = .false. endif if (solve_zsal) then @@ -1484,22 +1424,6 @@ subroutine input_zbgc abort_flag = 101 endif -#ifdef UNDEPRECATE_ZSAL - if (solve_zsal .and. nblyr < 1) then - if (my_task == master_task) then - write(nu_diag,*) subname,' ERROR: solve_zsal=T but 0 zsalinity tracers' - endif - abort_flag = 101 - endif - - if (solve_zsal .and. ((.not. tr_brine) .or. (ktherm /= 1))) then - if (my_task == master_task) then - write(nu_diag,*) subname,' ERROR: solve_zsal needs tr_brine=T and ktherm=1' - endif - abort_flag = 102 - endif -#endif - if (tr_brine .and. nblyr < 1 ) then if (my_task == master_task) then write(nu_diag,*) subname,' ERROR: tr_brine=T but no biology layers compiled' @@ -1680,12 +1604,9 @@ subroutine input_zbgc write(nu_diag,1010) ' restart_hbrine = ', restart_hbrine write(nu_diag,1005) ' phi_snow = ', phi_snow endif - write(nu_diag,1010) ' solve_zsal = ', solve_zsal - if (solve_zsal) then - write(nu_diag,1010) ' restart_zsal = ', restart_zsal - write(nu_diag,1000) ' grid_oS = ', grid_oS - write(nu_diag,1005) ' l_skS = ', l_skS - endif + write(nu_diag,1010) ' solve_zsal (deprecated) = ', solve_zsal + write(nu_diag,* ) ' WARNING: zsalinity has been deprecated. Namelists and interfaces' + write(nu_diag,* ) ' will be removed in a future version' write(nu_diag,1010) ' skl_bgc = ', skl_bgc write(nu_diag,1010) ' restart_bgc = ', restart_bgc @@ -1753,7 +1674,7 @@ subroutine input_zbgc !----------------------------------------------------------------- call icepack_init_parameters( & - ktherm_in=ktherm, shortwave_in=shortwave, solve_zsal_in=solve_zsal, & + ktherm_in=ktherm, shortwave_in=shortwave, & skl_bgc_in=skl_bgc, z_tracers_in=z_tracers, scale_bgc_in=scale_bgc, & dEdd_algae_in=dEdd_algae, & solve_zbgc_in=solve_zbgc, & @@ -1816,7 +1737,7 @@ subroutine count_tracers nbtrcr, nbtrcr_sw, & ntrcr_o, nt_fbri, & nt_bgc_Nit, nt_bgc_Am, nt_bgc_Sil, & - nt_bgc_DMS, nt_bgc_PON, nt_bgc_S, & + nt_bgc_DMS, nt_bgc_PON, & nt_bgc_DMSPp, nt_bgc_DMSPd, & nt_zbgc_frac, nlt_chl_sw, & nlt_bgc_Nit, nlt_bgc_Am, nlt_bgc_Sil, & @@ -1875,14 +1796,13 @@ subroutine count_tracers tr_bgc_hum logical (kind=log_kind) :: & - solve_zsal, skl_bgc, z_tracers + skl_bgc, z_tracers character(len=*), parameter :: subname='(count_tracers)' !----------------------------------------------------------------- call icepack_query_parameters( & - solve_zsal_out=solve_zsal, & skl_bgc_out=skl_bgc, z_tracers_out=z_tracers) call icepack_warnings_flush(nu_diag) @@ -2060,12 +1980,6 @@ subroutine count_tracers ntrcr = ntrcr + 1 endif - nt_bgc_S = 0 - if (solve_zsal) then ! .true. only if tr_brine = .true. - nt_bgc_S = ntrcr + 1 - ntrcr = ntrcr + nblyr - endif - if (skl_bgc .or. z_tracers) then if (skl_bgc) then @@ -2275,7 +2189,7 @@ subroutine count_tracers if (nt_isoice<= 0) nt_isoice= ntrcr if (nt_aero <= 0) nt_aero = ntrcr if (nt_fbri <= 0) nt_fbri = ntrcr - if (nt_bgc_S <= 0) nt_bgc_S = ntrcr +! if (nt_bgc_S <= 0) nt_bgc_S = ntrcr if (my_task == master_task) then write(nu_diag,*) ' ' @@ -2299,7 +2213,7 @@ subroutine count_tracers nt_smice_in=nt_smice, nt_smliq_in=nt_smliq, nt_rhos_in=nt_rhos, nt_rsnw_in=nt_rsnw, & nt_isosno_in=nt_isosno, nt_isoice_in=nt_isoice, nt_fbri_in=nt_fbri, & nt_bgc_Nit_in=nt_bgc_Nit, nt_bgc_Am_in=nt_bgc_Am, nt_bgc_Sil_in=nt_bgc_Sil, & - nt_bgc_DMS_in=nt_bgc_DMS, nt_bgc_PON_in=nt_bgc_PON, nt_bgc_S_in=nt_bgc_S, & + nt_bgc_DMS_in=nt_bgc_DMS, nt_bgc_PON_in=nt_bgc_PON, & nt_bgc_N_in=nt_bgc_N, nt_bgc_chl_in=nt_bgc_chl, & nt_bgc_DOC_in=nt_bgc_DOC, nt_bgc_DON_in=nt_bgc_DON, nt_bgc_DIC_in=nt_bgc_DIC, & nt_zaero_in=nt_zaero, nt_bgc_DMSPp_in=nt_bgc_DMSPp, nt_bgc_DMSPd_in=nt_bgc_DMSPd, & @@ -2342,7 +2256,7 @@ subroutine init_zbgc integer (kind=int_kind) :: & nbtrcr, nbtrcr_sw, nt_fbri, & nt_bgc_Nit, nt_bgc_Am, nt_bgc_Sil, & - nt_bgc_DMS, nt_bgc_PON, nt_bgc_S, & + nt_bgc_DMS, nt_bgc_PON, & nt_bgc_DMSPp, nt_bgc_DMSPd, & nt_zbgc_frac, nlt_chl_sw, & nlt_bgc_Nit, nlt_bgc_Am, nlt_bgc_Sil, & @@ -2423,7 +2337,7 @@ subroutine init_zbgc tau_rel ! release timescale (s), stationary to mobile phase logical (kind=log_kind) :: & - skl_bgc, z_tracers, dEdd_algae, solve_zsal + skl_bgc, z_tracers, dEdd_algae real (kind=dbl_kind), dimension(icepack_max_algae) :: & F_abs_chl ! to scale absorption in Dedd @@ -2493,12 +2407,10 @@ subroutine init_zbgc !----------------------------------------------------------------- call icepack_query_parameters( & - solve_zsal_out=solve_zsal, & skl_bgc_out=skl_bgc, z_tracers_out=z_tracers, & dEdd_algae_out=dEdd_algae, & grid_o_out=grid_o, l_sk_out=l_sk, & initbio_frac_out=initbio_frac, & - grid_oS_out=grid_oS, l_skS_out=l_skS, & phi_snow_out=phi_snow, frazil_scav_out = frazil_scav) call icepack_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & @@ -2524,7 +2436,7 @@ subroutine init_zbgc call icepack_query_tracer_indices( & nt_fbri_out=nt_fbri, & nt_bgc_Nit_out=nt_bgc_Nit, nt_bgc_Am_out=nt_bgc_Am, nt_bgc_Sil_out=nt_bgc_Sil, & - nt_bgc_DMS_out=nt_bgc_DMS, nt_bgc_PON_out=nt_bgc_PON, nt_bgc_S_out=nt_bgc_S, & + nt_bgc_DMS_out=nt_bgc_DMS, nt_bgc_PON_out=nt_bgc_PON, & nt_bgc_N_out=nt_bgc_N, nt_bgc_chl_out=nt_bgc_chl, & nt_bgc_DOC_out=nt_bgc_DOC, nt_bgc_DON_out=nt_bgc_DON, nt_bgc_DIC_out=nt_bgc_DIC, & nt_zaero_out=nt_zaero, nt_bgc_DMSPp_out=nt_bgc_DMSPp, nt_bgc_DMSPd_out=nt_bgc_DMSPd, & @@ -2708,18 +2620,6 @@ subroutine init_zbgc ntd = 0 ! if nt_fbri /= 0 then use fbri dependency if (nt_fbri == 0) ntd = -1 ! otherwise make tracers depend on ice volume - if (solve_zsal) then ! .true. only if tr_brine = .true. - do k = 1,nblyr - trcr_depend(nt_bgc_S + k - 1) = 2 + nt_fbri + ntd - trcr_base (nt_bgc_S,1) = c0 ! default: ice area - trcr_base (nt_bgc_S,2) = c1 - trcr_base (nt_bgc_S,3) = c0 - n_trcr_strata(nt_bgc_S) = 1 - nt_strata(nt_bgc_S,1) = nt_fbri - nt_strata(nt_bgc_S,2) = 0 - enddo - endif - bio_index(:) = 0 bio_index_o(:) = 0 diff --git a/cicecore/shared/ice_restart_column.F90 b/cicecore/shared/ice_restart_column.F90 index 86ff170c7..2c5b18c36 100644 --- a/cicecore/shared/ice_restart_column.F90 +++ b/cicecore/shared/ice_restart_column.F90 @@ -48,7 +48,6 @@ module ice_restart_column restart_fsd , & ! if .true., read floe size restart file restart_iso , & ! if .true., read isotope tracer restart file restart_aero , & ! if .true., read aerosol tracer restart file - restart_zsal , & ! if .true., read Salinity from restart file restart_hbrine , & ! if .true., read hbrine from restart file restart_bgc ! if .true., read bgc restart file @@ -908,7 +907,6 @@ end subroutine write_restart_hbrine subroutine write_restart_bgc() - use ice_arrays_column, only: Rayleigh_criteria, Rayleigh_real use ice_blocks, only: block, get_block use ice_domain, only: nblocks, blocks_ice use ice_domain_size, only: ncat, n_algae, n_doc, n_dic, & @@ -932,7 +930,7 @@ subroutine write_restart_bgc() character (len=3) :: nchar, ncharb - integer (kind=int_kind) :: nt_bgc_S, nt_bgc_Am, & + integer (kind=int_kind) :: nt_bgc_Am, & nt_bgc_DMS, nt_bgc_DMSPd, & nt_bgc_DMSPp, nt_bgc_Nit, nt_bgc_Sil, & nt_bgc_PON, nt_zbgc_frac, nt_bgc_hum, nbtrcr @@ -963,14 +961,14 @@ subroutine write_restart_bgc() tr_bgc_DON, tr_bgc_Fe, tr_zaero , tr_bgc_chl, & tr_bgc_hum - logical (kind=log_kind) :: skl_bgc, solve_zsal + logical (kind=log_kind) :: skl_bgc type (block) :: & this_block ! block information for current block character(len=*),parameter :: subname='(write_restart_bgc)' - call icepack_query_parameters(skl_bgc_out=skl_bgc, solve_zsal_out=solve_zsal) + call icepack_query_parameters(skl_bgc_out=skl_bgc) call icepack_query_tracer_sizes(nbtrcr_out=nbtrcr) call icepack_query_tracer_flags(tr_bgc_Nit_out=tr_bgc_Nit, & tr_bgc_Am_out=tr_bgc_Am, tr_bgc_Sil_out=tr_bgc_Sil, & @@ -978,7 +976,7 @@ subroutine write_restart_bgc() tr_bgc_N_out=tr_bgc_N, tr_bgc_C_out=tr_bgc_C, & tr_bgc_DON_out=tr_bgc_DON, tr_bgc_Fe_out=tr_bgc_Fe, tr_zaero_out=tr_zaero, & tr_bgc_chl_out=tr_bgc_chl, tr_bgc_hum_out=tr_bgc_hum) - call icepack_query_tracer_indices(nt_bgc_S_out=nt_bgc_S, nt_bgc_Am_out=nt_bgc_Am, & + call icepack_query_tracer_indices(nt_bgc_Am_out=nt_bgc_Am, & nt_bgc_DMS_out=nt_bgc_DMS, nt_bgc_DMSPd_out=nt_bgc_DMSPd, & nt_bgc_C_out=nt_bgc_C, nt_bgc_chl_out=nt_bgc_chl, & nt_bgc_DMSPp_out=nt_bgc_DMSPp, nt_bgc_Nit_out=nt_bgc_Nit, & @@ -1018,49 +1016,12 @@ subroutine write_restart_bgc() if (tr_bgc_DON) don (i,j,:,iblk) = c0 if (tr_bgc_Fe ) fed (i,j,:,iblk) = c0 if (tr_bgc_Fe ) fep (i,j,:,iblk) = c0 - if (solve_zsal) sss (i,j ,iblk) = c0 endif enddo enddo enddo !$OMP END PARALLEL DO - !----------------------------------------------------------------- - ! Salinity and extras - !----------------------------------------------------------------- - if (solve_zsal) then - - do k = 1,nblyr - write(nchar,'(i3.3)') k - call write_restart_field(nu_dump_bgc,0,trcrn(:,:,nt_bgc_S+k-1,:,:),'ruf8', & - 'zSalinity'//trim(nchar),ncat,diag) - enddo - - call write_restart_field(nu_dump_bgc,0,sss,'ruf8','sss',1,diag) - - !$OMP PARALLEL DO PRIVATE(iblk,i,j,ilo,ihi,jlo,jhi,this_block) - 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 - if (Rayleigh_criteria(i,j,iblk)) then - Rayleigh_real (i,j,iblk) = c1 - elseif (.NOT. Rayleigh_criteria(i,j,iblk)) then - Rayleigh_real (i,j,iblk) = c0 - endif - enddo - enddo - enddo - !$OMP END PARALLEL DO - - call write_restart_field(nu_dump_bgc,0,Rayleigh_real,'ruf8','Rayleigh',1,diag) - - endif ! solve_zsal - !----------------------------------------------------------------- ! Skeletal layer BGC !----------------------------------------------------------------- @@ -1352,7 +1313,6 @@ end subroutine write_restart_bgc subroutine read_restart_bgc() - use ice_arrays_column, only: Rayleigh_real, Rayleigh_criteria use ice_blocks, only: block, get_block use ice_communicate, only: my_task, master_task use ice_domain, only: nblocks, blocks_ice @@ -1377,7 +1337,7 @@ subroutine read_restart_bgc() logical (kind=log_kind) :: diag - integer (kind=int_kind) :: nt_bgc_S, nt_bgc_Am, & + integer (kind=int_kind) :: nt_bgc_Am, & nt_bgc_DMS, nt_bgc_DMSPd, & nt_bgc_DMSPp, nt_bgc_Nit, nt_bgc_Sil, & nt_bgc_PON, nt_zbgc_frac, nt_bgc_hum, nbtrcr @@ -1408,13 +1368,13 @@ subroutine read_restart_bgc() tr_bgc_DON, tr_bgc_Fe, tr_zaero , tr_bgc_chl, & tr_bgc_hum - logical (kind=log_kind) :: skl_bgc, solve_zsal + logical (kind=log_kind) :: skl_bgc character (len=3) :: nchar, ncharb character(len=*),parameter :: subname='(read_restart_bgc)' - call icepack_query_parameters(skl_bgc_out=skl_bgc, solve_zsal_out=solve_zsal) + call icepack_query_parameters(skl_bgc_out=skl_bgc) call icepack_query_tracer_sizes(nbtrcr_out=nbtrcr) call icepack_query_tracer_flags(tr_bgc_Nit_out=tr_bgc_Nit, & tr_bgc_Am_out=tr_bgc_Am, tr_bgc_Sil_out=tr_bgc_Sil, & @@ -1422,7 +1382,7 @@ subroutine read_restart_bgc() tr_bgc_N_out=tr_bgc_N, tr_bgc_C_out=tr_bgc_C, & tr_bgc_DON_out=tr_bgc_DON, tr_bgc_Fe_out=tr_bgc_Fe, tr_zaero_out=tr_zaero, & tr_bgc_chl_out=tr_bgc_chl, tr_bgc_hum_out=tr_bgc_hum) - call icepack_query_tracer_indices(nt_bgc_S_out=nt_bgc_S, nt_bgc_Am_out=nt_bgc_Am, & + call icepack_query_tracer_indices(nt_bgc_Am_out=nt_bgc_Am, & nt_bgc_DMS_out=nt_bgc_DMS, nt_bgc_DMSPd_out=nt_bgc_DMSPd, & nt_bgc_C_out=nt_bgc_C, nt_bgc_chl_out=nt_bgc_chl, & nt_bgc_DMSPp_out=nt_bgc_DMSPp, nt_bgc_Nit_out=nt_bgc_Nit, & @@ -1436,44 +1396,6 @@ subroutine read_restart_bgc() diag = .true. - !----------------------------------------------------------------- - ! Salinity and extras - !----------------------------------------------------------------- - - if (restart_zsal) then - - if (my_task == master_task) write(nu_diag,*) subname,'zSalinity restart' - do k = 1,nblyr - write(nchar,'(i3.3)') k - call read_restart_field(nu_restart_bgc,0,trcrn(:,:,nt_bgc_S+k-1,:,:),'ruf8', & - 'zSalinity'//trim(nchar),ncat,diag,field_loc_center,field_type_scalar) - enddo - - if (my_task == master_task) write(nu_diag,*) subname,'sea surface salinity' - call read_restart_field(nu_restart_bgc,0,sss,'ruf8','sss',1,diag) - call read_restart_field(nu_restart_bgc,0,Rayleigh_real,'ruf8','Rayleigh',1,diag) - - !$OMP PARALLEL DO PRIVATE(iblk,i,j,ilo,ihi,jlo,jhi,this_block) - 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 - if (Rayleigh_real (i,j,iblk) .GE. c1) then - Rayleigh_criteria (i,j,iblk) = .true. - elseif (Rayleigh_real (i,j,iblk) < c1) then - Rayleigh_criteria (i,j,iblk) = .false. - endif - enddo - enddo - enddo ! iblk - !$OMP END PARALLEL DO - endif ! restart_zsal - !----------------------------------------------------------------- ! Skeletal Layer BGC !----------------------------------------------------------------- diff --git a/configuration/scripts/options/set_nml.zsal b/configuration/scripts/options/set_nml.zsal deleted file mode 100644 index 724893ffc..000000000 --- a/configuration/scripts/options/set_nml.zsal +++ /dev/null @@ -1,8 +0,0 @@ -nblyr = 7 -ktherm = 1 -sw_redist = .true. -tfrz_option = 'linear_salt' -tr_brine = .true. -solve_zsal = .true. -ice_ic = 'internal' - diff --git a/doc/source/user_guide/ug_case_settings.rst b/doc/source/user_guide/ug_case_settings.rst index 516f3238d..b60f8f751 100644 --- a/doc/source/user_guide/ug_case_settings.rst +++ b/doc/source/user_guide/ug_case_settings.rst @@ -739,7 +739,7 @@ zbgc_nml "``f_exude_s``", "real", "fraction of exudation to DOC saccharids", "1.0" "``grid_o``", "real", "z biology for bottom flux", "5.0" "``grid_o_t``", "real", "z biology for top flux", "5.0" - "``grid_oS``", "real", "z salinity for bottom flux", "5.0" + "``grid_oS``", "real", "zsalinity DEPRECATED", "" "``grow_Tdep_diatoms``", "real", "temperature dependence growth diatoms per degC", "0.06" "``grow_Tdep_phaeo``", "real", "temperature dependence growth phaeocystis per degC", "0.06" "``grow_Tdep_sp``", "real", "temperature dependence growth small plankton per degC", "0.06" @@ -765,7 +765,7 @@ zbgc_nml "``K_Sil_sp``", "real", "silicate half saturation small plankton mmol/m^3", "0.0" "``kn_bac_protein``", "real", "bacterial degradation of DON per day", "0.03" "``l_sk``", "real", "characteristic diffusive scale in m", "7.0" - "``l_skS``", "real", "z salinity characteristic diffusive scale in m", "7.0" + "``l_skS``", "real", "zsalinity DEPRECATED", "" "``max_dfe_doc1``", "real", "max ratio of dFe to saccharides in the ice in nm Fe / muM C", "0.2" "``max_loss``", "real", "restrict uptake to percent of remaining value", "0.9" "``modal_aero``", "logical", "modal aerosols", "``.false.``" diff --git a/icepack b/icepack index 86cae16d1..f5e093f51 160000 --- a/icepack +++ b/icepack @@ -1 +1 @@ -Subproject commit 86cae16d1b7c4c4f8a410fccac155374afac777f +Subproject commit f5e093f5148554674079d5c7fc0702a41b81f744 From 933b148cb141a16d74615092af62c3e8d36777a2 Mon Sep 17 00:00:00 2001 From: Tony Craig Date: Thu, 24 Aug 2023 10:23:56 -0700 Subject: [PATCH 15/76] 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 --- cicecore/cicedyn/general/ice_init.F90 | 69 +++++++++-------- .../io/io_netcdf/ice_restart.F90 | 4 +- .../infrastructure/io/io_pio2/ice_restart.F90 | 9 ++- cicecore/shared/ice_calendar.F90 | 77 +++++++++++-------- configuration/scripts/ice_in | 8 +- configuration/scripts/options/set_nml.histall | 2 +- configuration/scripts/options/set_nml.histdbg | 2 +- doc/source/cice_index.rst | 4 +- doc/source/user_guide/ug_case_settings.rst | 15 ++-- doc/source/user_guide/ug_implementation.rst | 5 +- 10 files changed, 110 insertions(+), 85 deletions(-) diff --git a/cicecore/cicedyn/general/ice_init.F90 b/cicecore/cicedyn/general/ice_init.F90 index 4ed128f5e..47fedf538 100644 --- a/cicecore/cicedyn/general/ice_init.F90 +++ b/cicecore/cicedyn/general/ice_init.F90 @@ -322,7 +322,7 @@ subroutine input_data histfreq(4) = 'm' ! output frequency option for different streams histfreq(5) = 'y' ! output frequency option for different streams histfreq_n(:) = 1 ! output frequency - histfreq_base = 'zero' ! output frequency reference date + histfreq_base(:) = 'zero' ! output frequency reference date hist_avg(:) = .true. ! if true, write time-averages (not snapshots) history_format = 'default' ! history file format hist_time_axis = 'end' ! History file time axis averaging interval position @@ -334,9 +334,11 @@ subroutine input_data cpl_bgc = .false. ! couple bgc thru driver incond_dir = history_dir ! write to history dir for default incond_file = 'iceh_ic'! file prefix - dumpfreq='y' ! restart frequency option - dumpfreq_n = 1 ! restart frequency - dumpfreq_base = 'init' ! restart frequency reference date + dumpfreq(:)='x' ! restart frequency option + dumpfreq_n(:) = 1 ! restart frequency + dumpfreq_base(:) = 'init' ! restart frequency reference date + 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 restart_file = 'iced' ! restart file name prefix @@ -901,10 +903,13 @@ subroutine input_data call broadcast_scalar(diag_file, master_task) do n = 1, max_nstrm call broadcast_scalar(histfreq(n), master_task) + call broadcast_scalar(histfreq_base(n), master_task) + call broadcast_scalar(dumpfreq(n), master_task) + call broadcast_scalar(dumpfreq_base(n), master_task) enddo - call broadcast_array(histfreq_n, master_task) - call broadcast_scalar(histfreq_base, master_task) call broadcast_array(hist_avg, master_task) + call broadcast_array(histfreq_n, master_task) + call broadcast_array(dumpfreq_n, master_task) call broadcast_scalar(history_dir, master_task) call broadcast_scalar(history_file, master_task) call broadcast_scalar(history_precision, master_task) @@ -914,9 +919,6 @@ subroutine input_data call broadcast_scalar(cpl_bgc, master_task) call broadcast_scalar(incond_dir, master_task) call broadcast_scalar(incond_file, master_task) - call broadcast_scalar(dumpfreq, master_task) - call broadcast_scalar(dumpfreq_n, master_task) - call broadcast_scalar(dumpfreq_base, master_task) call broadcast_scalar(dump_last, master_task) call broadcast_scalar(restart_file, master_task) call broadcast_scalar(restart, master_task) @@ -1569,33 +1571,32 @@ subroutine input_data abort_list = trim(abort_list)//":22" endif - if(histfreq_base /= 'init' .and. histfreq_base /= 'zero') then - write (nu_diag,*) subname//' ERROR: bad value for histfreq_base, allowed values: init, zero' - abort_list = trim(abort_list)//":24" - endif + do n = 1,max_nstrm + 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 + 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 + + if (.not.(scan(dumpfreq(n)(1:1),'ymdhx1YMDHX') == 1 .and. (dumpfreq(n)(2:2) == '1' .or. dumpfreq(n)(2:2) == ' '))) then + if (my_task == master_task) then + write(nu_diag,*) subname//' WARNING: unrecognized dumpfreq=', trim(dumpfreq(n)) + write(nu_diag,*) subname//' WARNING: No restarts files will be written for this stream' + write(nu_diag,*) subname//' WARNING: Allowed values : y,m,d,h,x,1 followed by an optional 1' + endif + dumpfreq(n) = 'x' + endif + enddo 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 - if(dumpfreq_base /= 'init' .and. dumpfreq_base /= 'zero') then - write (nu_diag,*) subname//' ERROR: bad value for dumpfreq_base, allowed values: init, zero' - abort_list = trim(abort_list)//":25" - endif - - if (.not.(trim(dumpfreq) == 'y' .or. trim(dumpfreq) == 'Y' .or. & - trim(dumpfreq) == 'm' .or. trim(dumpfreq) == 'M' .or. & - trim(dumpfreq) == 'd' .or. trim(dumpfreq) == 'D' .or. & - trim(dumpfreq) == 'h' .or. trim(dumpfreq) == 'H' .or. & - trim(dumpfreq) == '1' )) then - if (my_task == master_task) then - write(nu_diag,*) subname//' WARNING: unrecognized dumpfreq=', trim(dumpfreq) - write(nu_diag,*) subname//' WARNING: No restarts files will be written' - write(nu_diag,*) subname//' WARNING: Allowed values : ''y'', ''m'', ''d'', ''h'', ''1''' - endif - endif - ! Implicit solver input validation if (kdyn == 3) then if (.not. (trim(algo_nonlin) == 'picard' .or. trim(algo_nonlin) == 'anderson')) then @@ -2319,7 +2320,7 @@ subroutine input_data write(nu_diag,1021) ' numax = ', numax 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,1033) ' histfreq_base = ', histfreq_base(:) 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) @@ -2330,9 +2331,9 @@ subroutine input_data write(nu_diag,1039) ' Initial condition will be written in ', & trim(incond_dir) endif - write(nu_diag,1031) ' dumpfreq = ', trim(dumpfreq) - write(nu_diag,1021) ' dumpfreq_n = ', dumpfreq_n - write(nu_diag,1031) ' dumpfreq_base = ', trim(dumpfreq_base) + write(nu_diag,1033) ' dumpfreq = ', dumpfreq(:) + write(nu_diag,1023) ' dumpfreq_n = ', dumpfreq_n(:) + write(nu_diag,1033) ' dumpfreq_base = ', dumpfreq_base(:) write(nu_diag,1011) ' dump_last = ', dump_last write(nu_diag,1011) ' restart = ', restart write(nu_diag,1031) ' restart_dir = ', trim(restart_dir) diff --git a/cicecore/cicedyn/infrastructure/io/io_netcdf/ice_restart.F90 b/cicecore/cicedyn/infrastructure/io/io_netcdf/ice_restart.F90 index 8a648f56b..84fcbe5b7 100644 --- a/cicecore/cicedyn/infrastructure/io/io_netcdf/ice_restart.F90 +++ b/cicecore/cicedyn/infrastructure/io/io_netcdf/ice_restart.F90 @@ -823,7 +823,7 @@ end subroutine write_restart_field subroutine final_restart() - use ice_calendar, only: istep1, idate + use ice_calendar, only: istep1, myear, mmonth, mday, msec integer (kind=int_kind) :: status @@ -833,7 +833,7 @@ subroutine final_restart() status = nf90_close(ncid) if (my_task == master_task) & - write(nu_diag,*) 'Restart read/written ',istep1,idate + 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 #else call abort_ice(subname//'ERROR: USE_NETCDF cpp not defined', & diff --git a/cicecore/cicedyn/infrastructure/io/io_pio2/ice_restart.F90 b/cicecore/cicedyn/infrastructure/io/io_pio2/ice_restart.F90 index 9119fac27..aefcf61f9 100644 --- a/cicecore/cicedyn/infrastructure/io/io_pio2/ice_restart.F90 +++ b/cicecore/cicedyn/infrastructure/io/io_pio2/ice_restart.F90 @@ -111,7 +111,7 @@ subroutine init_restart_read(ice_ic) ! endif if (my_task == master_task) then - write(nu_diag,*) '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) @@ -880,7 +880,7 @@ end subroutine write_restart_field subroutine final_restart() - use ice_calendar, only: istep1, idate, msec + use ice_calendar, only: istep1, myear, mmonth, mday, msec character(len=*), parameter :: subname = '(final_restart)' @@ -888,8 +888,9 @@ subroutine final_restart() call PIO_freeDecomp(File,iodesc3d_ncat) call pio_closefile(File) - if (my_task == master_task) & - write(nu_diag,*) 'Restart read/written ',istep1,idate,msec + 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 + endif end subroutine final_restart diff --git a/cicecore/shared/ice_calendar.F90 b/cicecore/shared/ice_calendar.F90 index 7bd0c73b2..17f18edb2 100644 --- a/cicecore/shared/ice_calendar.F90 +++ b/cicecore/shared/ice_calendar.F90 @@ -102,9 +102,9 @@ module ice_calendar stop_now , & ! if 1, end program execution write_restart, & ! if 1, write restart now diagfreq , & ! diagnostic output frequency (10 = once per 10 dt) - dumpfreq_n , & ! restart output frequency (10 = once per 10 d,m,y) nstreams , & ! number of history output streams - histfreq_n(max_nstrm) ! history output frequency + dumpfreq_n(max_nstrm), & ! restart output frequency (10 = once per 10 d,m,y) + histfreq_n(max_nstrm) ! history output frequency logical (kind=log_kind), public :: & new_year , & ! new year = .true. @@ -126,16 +126,18 @@ module ice_calendar force_restart_now, & ! force a restart now write_history(max_nstrm) ! write history now - character (len=1), public :: & + character (len=2), public :: & npt_unit, & ! run length unit, 'y', 'm', 'd', 'h', 's', '1' npt0_unit, & ! original run length unit, 'y', 'm', 'd', 'h', 's', '1' - histfreq(max_nstrm), & ! history output frequency, 'y','m','d','h','1' - dumpfreq ! restart frequency, 'y','m','d' + histfreq(max_nstrm), & ! history output frequency, 'y','m','d','h','1','x' + dumpfreq(max_nstrm) ! restart frequency, 'y','m','d', h', '1', 'x' followed by optional 1 character (len=char_len), public :: & - dumpfreq_base = 'zero', & ! restart frequency basetime ('zero', 'init') - histfreq_base = 'init', & ! history frequency basetime ('zero', 'init') - calendar_type ! define calendar type + dumpfreq_base(max_nstrm), & ! restart frequency basetime ('zero', 'init') + histfreq_base(max_nstrm), & ! history frequency basetime ('zero', 'init') + calendar_type ! define calendar type + data dumpfreq_base / 'init', 'init', 'init', 'init', 'init' / + data histfreq_base / 'zero', 'zero', 'zero', 'zero', 'zero' / ! PRIVATE @@ -408,10 +410,10 @@ subroutine calendar() ! History writing flags - call compute_relative_elapsed(histfreq_base, elapsed_years, elapsed_months, elapsed_days, elapsed_hours) - do ns = 1, nstreams + call compute_relative_elapsed(histfreq_base(ns), elapsed_years, elapsed_months, elapsed_days, elapsed_hours) + select case (histfreq(ns)) case ("y", "Y") if (new_year .and. histfreq_n(ns)/=0) then @@ -442,27 +444,40 @@ subroutine calendar() enddo - ! Restart writing flag - - call compute_relative_elapsed(dumpfreq_base, elapsed_years, elapsed_months, elapsed_days, elapsed_hours) - - select case (dumpfreq) - case ("y", "Y") - if (new_year .and. mod(elapsed_years, dumpfreq_n)==0) & - write_restart = 1 - case ("m", "M") - if (new_month .and. mod(elapsed_months,dumpfreq_n)==0) & - write_restart = 1 - case ("d", "D") - if (new_day .and. mod(elapsed_days, dumpfreq_n)==0) & - write_restart = 1 - case ("h", "H") - if (new_hour .and. mod(elapsed_hours, dumpfreq_n)==0) & - write_restart = 1 - case ("1") - if (mod(istep1, dumpfreq_n)==0) & - write_restart = 1 - end select + ! Restart writing flag, set dumpfreq to 'x" if stream is written once + + do ns = 1, max_nstrm + + call compute_relative_elapsed(dumpfreq_base(ns), elapsed_years, elapsed_months, elapsed_days, elapsed_hours) + + select case (dumpfreq(ns)(1:1)) + case ("y", "Y") + if (new_year .and. mod(elapsed_years, dumpfreq_n(ns))==0) then + write_restart = 1 + if (dumpfreq(ns)(2:2) == '1') dumpfreq(ns) = 'x' + endif + case ("m", "M") + if (new_month .and. mod(elapsed_months,dumpfreq_n(ns))==0) then + write_restart = 1 + if (dumpfreq(ns)(2:2) == '1') dumpfreq(ns) = 'x' + endif + case ("d", "D") + if (new_day .and. mod(elapsed_days, dumpfreq_n(ns))==0) then + write_restart = 1 + if (dumpfreq(ns)(2:2) == '1') dumpfreq(ns) = 'x' + endif + case ("h", "H") + if (new_hour .and. mod(elapsed_hours, dumpfreq_n(ns))==0) then + write_restart = 1 + if (dumpfreq(ns)(2:2) == '1') dumpfreq(ns) = 'x' + endif + case ("1") + if (mod(istep1, dumpfreq_n(ns))==0) then + write_restart = 1 + if (dumpfreq(ns)(2:2) == '1') dumpfreq(ns) = 'x' + endif + end select + enddo if (force_restart_now) write_restart = 1 diff --git a/configuration/scripts/ice_in b/configuration/scripts/ice_in index e0e317e40..8fff799dc 100644 --- a/configuration/scripts/ice_in +++ b/configuration/scripts/ice_in @@ -21,9 +21,9 @@ restart_dir = './restart/' restart_file = 'iced' pointer_file = './ice.restart_file' - dumpfreq = 'd' - dumpfreq_n = 1 - dumpfreq_base = 'init' + dumpfreq = 'd','x','x','x','x' + dumpfreq_n = 1 , 1 , 1 , 1 , 1 + dumpfreq_base = 'init','init','init','init','init' dump_last = .false. bfbflag = 'off' diagfreq = 24 @@ -47,7 +47,7 @@ lonpnt(2) = -45. histfreq = 'm','x','x','x','x' histfreq_n = 1 , 1 , 1 , 1 , 1 - histfreq_base = 'zero' + histfreq_base = 'zero','zero','zero','zero','zero' hist_avg = .true.,.true.,.true.,.true.,.true. history_dir = './history/' history_file = 'iceh' diff --git a/configuration/scripts/options/set_nml.histall b/configuration/scripts/options/set_nml.histall index 758289099..78932cba8 100644 --- a/configuration/scripts/options/set_nml.histall +++ b/configuration/scripts/options/set_nml.histall @@ -1,6 +1,6 @@ histfreq = 'm','d','1','h','x' histfreq_n = 1,2,6,4,1 - histfreq_base = 'zero' + histfreq_base = 'zero','zero','zero','zero','zero' write_ic = .true. f_tmask = .true. f_blkmask = .true. diff --git a/configuration/scripts/options/set_nml.histdbg b/configuration/scripts/options/set_nml.histdbg index 247d185fd..43ae8e566 100644 --- a/configuration/scripts/options/set_nml.histdbg +++ b/configuration/scripts/options/set_nml.histdbg @@ -1,6 +1,6 @@ histfreq = 'm','d','1','h','x' histfreq_n = 1,1,1,1,1 - histfreq_base = 'zero' + histfreq_base = 'zero','zero','zero','zero','zero' write_ic = .true. f_tmask = .true. f_blkmask = .true. diff --git a/doc/source/cice_index.rst b/doc/source/cice_index.rst index 36c772eff..cf01323d8 100644 --- a/doc/source/cice_index.rst +++ b/doc/source/cice_index.rst @@ -185,7 +185,7 @@ either Celsius or Kelvin units). Deprecated parameters are listed at the end. "dtei", "1/dte, where dte is the EVP subcycling time step", "1/s" "dump_file", "output file for restart dump", "" "dumpfreq", "dump frequency for restarts, y, m, d, h or 1", "" - "dumpfreq_base", "reference date for restart output", "" + "dumpfreq_base", "reference date for restart output, zero or init", "" "dumpfreq_n", "restart output frequency", "" "dump_last", "if true, write restart on last time step of simulation", "" "dwavefreq", "widths of wave frequency bins", "1/s" @@ -316,7 +316,7 @@ either Celsius or Kelvin units). Deprecated parameters are listed at the end. "hin_max", "category thickness limits", "m" "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_base", "reference date for history output, zero or init", "" "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", "" diff --git a/doc/source/user_guide/ug_case_settings.rst b/doc/source/user_guide/ug_case_settings.rst index b60f8f751..ba596863c 100644 --- a/doc/source/user_guide/ug_case_settings.rst +++ b/doc/source/user_guide/ug_case_settings.rst @@ -167,14 +167,19 @@ setup_nml "", "``file``", "write diagnostic output to file", "" "``diag_file``", "string", "diagnostic output file", "'ice_diag.d'" "``dt``", "real", "thermodynamics time step length in seconds", "3600." - "``dumpfreq``", "``d``", "write restart every ``dumpfreq_n`` days", "``y``" + "``dumpfreq``", "``d``", "write restart every ``dumpfreq_n`` days", "'y','x','x','x','x'" + "", "``d1``", "write restart once after ``dumpfreq_n`` days", "" "", "``h``", "write restart every ``dumpfreq_n`` hours", "" + "", "``h1``", "write restart once after ``dumpfreq_n`` hours", "" "", "``m``", "write restart every ``dumpfreq_n`` months", "" + "", "``m1``", "write restart once after ``dumpfreq_n`` months", "" "", "``y``", "write restart every ``dumpfreq_n`` years", "" - "", "``1``", "write restart every ``dumpfreq_n`` time step", "" - "``dumpfreq_base``", "init", "restart output frequency relative to year_init, month_init, day_init", "init" + "", "``y1``", "write restart once after ``dumpfreq_n`` years", "" + "", "``1``", "write restart every ``dumpfreq_n`` time steps", "" + "", "``11``", "write restart once after ``dumpfreq_n`` time steps", "" + "``dumpfreq_base``", "init", "restart output frequency relative to year_init, month_init, day_init", "'init','init','init','init','init'" "", "zero", "restart output frequency relative to year-month-day of 0000-01-01", "" - "``dumpfreq_n``", "integer", "write restart frequency with ``dumpfreq``", "1" + "``dumpfreq_n``", "integer array", "write restart frequency with ``dumpfreq``", "1,1,1,1,1" "``dump_last``", "logical", "write restart on last time step of simulation", "``.false.``" "``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'" @@ -183,7 +188,7 @@ setup_nml "", "``x``", "unused frequency stream (not written)", "" "", "``y``", "write history every ``histfreq_n`` years", "" "", "``1``", "write history every ``histfreq_n`` time step", "" - "``histfreq_base``", "init", "history output frequency relative to year_init, month_init, day_init", "zero" + "``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_dir``", "string", "path to history output directory", "'./'" diff --git a/doc/source/user_guide/ug_implementation.rst b/doc/source/user_guide/ug_implementation.rst index 9bcf205b4..8480eb9aa 100644 --- a/doc/source/user_guide/ug_implementation.rst +++ b/doc/source/user_guide/ug_implementation.rst @@ -891,6 +891,8 @@ will be relative to the model initial date specified by ``year_init``, in setting output frequencies. `init` is the default for ``dumpfreq_base`` and makes it easy to generate restarts 5 or 10 model days after startup as we often do in testing. +Both ``histfreq_base`` and ``dumpfreq_base`` are arrays +and can be set for each stream separately. In general, output is always written at the start of the year, month, day, or hour without @@ -1408,7 +1410,8 @@ 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 variables ``dumpfreq`` and ``dumpfreq_n`` relative to a reference date -specified by ``dumpfreq_base``. The pointer to the filename from +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 which the restart data is to be read for a continuation run is set in ``pointer_file``. The code assumes that auxiliary binary tracer restart files will be identified using the same pointer and file name prefix, From e8a69abde90b99fc6528d469b8698506a99f6e2a Mon Sep 17 00:00:00 2001 From: Denise Worthen Date: Mon, 28 Aug 2023 16:00:41 -0400 Subject: [PATCH 16/76] 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 --- cicecore/drivers/nuopc/cmeps/CICE_InitMod.F90 | 11 +-- cicecore/drivers/nuopc/cmeps/CICE_RunMod.F90 | 39 +++++---- .../drivers/nuopc/cmeps/cice_wrapper_mod.F90 | 84 +++++++++++++++++-- .../drivers/nuopc/cmeps/ice_comp_nuopc.F90 | 27 +++++- 4 files changed, 127 insertions(+), 34 deletions(-) diff --git a/cicecore/drivers/nuopc/cmeps/CICE_InitMod.F90 b/cicecore/drivers/nuopc/cmeps/CICE_InitMod.F90 index 0ba672f3d..270e7b371 100644 --- a/cicecore/drivers/nuopc/cmeps/CICE_InitMod.F90 +++ b/cicecore/drivers/nuopc/cmeps/CICE_InitMod.F90 @@ -232,7 +232,7 @@ subroutine init_restart() restart_iso, read_restart_iso, & restart_aero, read_restart_aero, & restart_hbrine, read_restart_hbrine, & - restart_zsal, restart_bgc + restart_bgc use ice_restart_driver, only: restartfile use ice_restart_shared, only: runtype, restart use ice_state ! almost everything @@ -243,7 +243,7 @@ subroutine init_restart() logical(kind=log_kind) :: & tr_iage, tr_FY, tr_lvl, tr_pond_lvl, & tr_pond_topo, tr_fsd, tr_iso, tr_aero, tr_brine, tr_snow, & - skl_bgc, z_tracers, solve_zsal + skl_bgc, z_tracers integer(kind=int_kind) :: & ntrcr integer(kind=int_kind) :: & @@ -259,8 +259,7 @@ subroutine init_restart() if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & file=__FILE__, line=__LINE__) - call icepack_query_parameters(skl_bgc_out=skl_bgc, & - z_tracers_out=z_tracers, solve_zsal_out=solve_zsal) + call icepack_query_parameters(skl_bgc_out=skl_bgc, z_tracers_out=z_tracers) call icepack_query_tracer_flags(tr_iage_out=tr_iage, tr_FY_out=tr_FY, & tr_lvl_out=tr_lvl, tr_pond_lvl_out=tr_pond_lvl, & tr_pond_topo_out=tr_pond_topo, tr_aero_out=tr_aero, tr_brine_out=tr_brine, & @@ -404,8 +403,6 @@ subroutine init_restart() if (trim(runtype) == 'continue') then if (tr_brine) & restart_hbrine = .true. - if (solve_zsal) & - restart_zsal = .true. if (skl_bgc .or. z_tracers) & restart_bgc = .true. endif @@ -415,7 +412,7 @@ subroutine init_restart() if (tr_brine .and. restart_hbrine) call read_restart_hbrine endif - if (solve_zsal .or. skl_bgc .or. z_tracers) then ! biogeochemistry + if (skl_bgc .or. z_tracers) then ! biogeochemistry if (tr_fsd) then write (nu_diag,*) 'FSD implementation incomplete for use with BGC' call icepack_warnings_flush(nu_diag) diff --git a/cicecore/drivers/nuopc/cmeps/CICE_RunMod.F90 b/cicecore/drivers/nuopc/cmeps/CICE_RunMod.F90 index e908f509f..483048051 100644 --- a/cicecore/drivers/nuopc/cmeps/CICE_RunMod.F90 +++ b/cicecore/drivers/nuopc/cmeps/CICE_RunMod.F90 @@ -16,6 +16,7 @@ module CICE_RunMod use ice_kinds_mod use cice_wrapper_mod, only : t_startf, t_stopf, t_barrierf + use cice_wrapper_mod, only : ufs_logfhour use ice_fileunits, only: nu_diag use ice_arrays_column, only: oceanmixed_ice use ice_constants, only: c0, c1 @@ -107,11 +108,13 @@ end subroutine CICE_Run subroutine ice_step + use ice_constants, only: c3600 use ice_boundary, only: ice_HaloUpdate use ice_calendar, only: dt, dt_dyn, ndtd, diagfreq, write_restart, istep - use ice_calendar, only: idate, msec + use ice_calendar, only: idate, myear, mmonth, mday, msec, timesecs + use ice_calendar, only: calendar_sec2hms, write_history, nstreams, histfreq use ice_diagnostics, only: init_mass_diags, runtime_diags, debug_model, debug_ice - use ice_diagnostics_bgc, only: hbrine_diags, zsal_diags, bgc_diags + use ice_diagnostics_bgc, only: hbrine_diags, bgc_diags use ice_domain, only: halo_info, nblocks use ice_dyn_eap, only: write_restart_eap use ice_dyn_shared, only: kdyn, kridge @@ -133,7 +136,7 @@ subroutine ice_step use ice_timers, only: ice_timer_start, ice_timer_stop, & timer_diags, timer_column, timer_thermo, timer_bound, & timer_hist, timer_readwrite - use ice_communicate, only: MPI_COMM_ICE + use ice_communicate, only: MPI_COMM_ICE, my_task, master_task use ice_prescribed_mod integer (kind=int_kind) :: & @@ -147,11 +150,13 @@ subroutine ice_step logical (kind=log_kind) :: & tr_iage, tr_FY, tr_lvl, tr_fsd, tr_snow, & tr_pond_lvl, tr_pond_topo, tr_brine, tr_iso, tr_aero, & - calc_Tsfc, skl_bgc, solve_zsal, z_tracers, wave_spec + calc_Tsfc, skl_bgc, z_tracers, wave_spec character(len=*), parameter :: subname = '(ice_step)' character (len=char_len) :: plabeld + integer (kind=int_kind) :: hh,mm,ss,ns + character (len=char_len) :: logmsg if (debug_model) then plabeld = 'beginning time step' @@ -161,8 +166,7 @@ subroutine ice_step endif call icepack_query_parameters(calc_Tsfc_out=calc_Tsfc, skl_bgc_out=skl_bgc, & - solve_zsal_out=solve_zsal, z_tracers_out=z_tracers, ktherm_out=ktherm, & - wave_spec_out=wave_spec) + z_tracers_out=z_tracers, ktherm_out=ktherm, wave_spec_out=wave_spec) call icepack_query_tracer_flags(tr_iage_out=tr_iage, tr_FY_out=tr_FY, & tr_lvl_out=tr_lvl, tr_pond_lvl_out=tr_pond_lvl, & tr_pond_topo_out=tr_pond_topo, tr_brine_out=tr_brine, tr_aero_out=tr_aero, & @@ -354,7 +358,6 @@ subroutine ice_step call ice_timer_start(timer_diags) ! diagnostics if (mod(istep,diagfreq) == 0) then call runtime_diags(dt) ! log file - if (solve_zsal) call zsal_diags if (skl_bgc .or. z_tracers) call bgc_diags if (tr_brine) call hbrine_diags endif @@ -376,7 +379,7 @@ subroutine ice_step if (tr_fsd) call write_restart_fsd if (tr_iso) call write_restart_iso if (tr_aero) call write_restart_aero - if (solve_zsal .or. skl_bgc .or. z_tracers) & + if (skl_bgc .or. z_tracers) & call write_restart_bgc if (tr_brine) call write_restart_hbrine if (kdyn == 2) call write_restart_eap @@ -384,7 +387,15 @@ subroutine ice_step endif call ice_timer_stop(timer_readwrite) ! reading/writing - + if (my_task == master_task) then + do ns = 1,nstreams + if (write_history(ns) .and. histfreq(ns) .eq. 'h') then + call calendar_sec2hms(msec,hh,mm,ss) + write(logmsg,'(6(i4,2x))')myear,mmonth,mday,hh,mm,ss + call ufs_logfhour(trim(logmsg),timesecs/c3600) + end if + end do + end if end subroutine ice_step !======================================================================= @@ -396,7 +407,7 @@ end subroutine ice_step subroutine coupling_prep (iblk) use ice_arrays_column, only: alvdfn, alidfn, alvdrn, alidrn, & - albicen, albsnon, albpndn, apeffn, fzsal_g, fzsal, snowfracn + albicen, albsnon, albpndn, apeffn, snowfracn use ice_blocks, only: nx_block, ny_block, get_block, block use ice_domain, only: blocks_ice use ice_calendar, only: dt, nstreams @@ -411,9 +422,8 @@ subroutine coupling_prep (iblk) fsens, flat, fswabs, flwout, evap, Tref, Qref, & scale_fluxes, frzmlt_init, frzmlt, Uref, wind use ice_flux_bgc, only: faero_ocn, fiso_ocn, Qref_iso, fiso_evap, & - fzsal_ai, fzsal_g_ai, flux_bio, flux_bio_ai, & - fnit, fsil, famm, fdmsp, fdms, fhum, fdust, falgalN, & - fdoc, fdic, fdon, ffep, ffed, bgcflux_ice_to_ocn + flux_bio, flux_bio_ai, fnit, fsil, famm, fdmsp, fdms, fhum, & + fdust, falgalN, fdoc, fdic, fdon, ffep, ffed, bgcflux_ice_to_ocn use ice_grid, only: tmask use ice_state, only: aicen, aice use ice_state, only: aice_init @@ -566,8 +576,6 @@ subroutine coupling_prep (iblk) fsalt_ai (i,j,iblk) = fsalt (i,j,iblk) fhocn_ai (i,j,iblk) = fhocn (i,j,iblk) fswthru_ai(i,j,iblk) = fswthru(i,j,iblk) - fzsal_ai (i,j,iblk) = fzsal (i,j,iblk) - fzsal_g_ai(i,j,iblk) = fzsal_g(i,j,iblk) if (nbtrcr > 0) then do k = 1, nbtrcr @@ -613,7 +621,6 @@ subroutine coupling_prep (iblk) faero_ocn(:,:,:,iblk), & alvdr (:,:,iblk), alidr (:,:,iblk), & alvdf (:,:,iblk), alidf (:,:,iblk), & - fzsal (:,:,iblk), fzsal_g (:,:,iblk), & flux_bio (:,:,1:nbtrcr,iblk), & Qref_iso =Qref_iso (:,:,:,iblk), & fiso_evap=fiso_evap(:,:,:,iblk), & diff --git a/cicecore/drivers/nuopc/cmeps/cice_wrapper_mod.F90 b/cicecore/drivers/nuopc/cmeps/cice_wrapper_mod.F90 index 0da2ed491..d0aafbb43 100644 --- a/cicecore/drivers/nuopc/cmeps/cice_wrapper_mod.F90 +++ b/cicecore/drivers/nuopc/cmeps/cice_wrapper_mod.F90 @@ -1,25 +1,93 @@ module cice_wrapper_mod #ifdef CESMCOUPLED - use perf_mod , only : t_startf, t_stopf, t_barrierf - use shr_file_mod , only : shr_file_getlogunit, shr_file_setlogunit + use perf_mod , only : t_startf, t_stopf, t_barrierf + use shr_file_mod , only : shr_file_getlogunit, shr_file_setlogunit + use ice_kinds_mod , only : dbl_kind, int_kind, char_len, char_len_long + + implicit none + + real(dbl_kind) :: wtime = 0.0 +contains + ! Define stub routines that do nothing - they are just here to avoid + ! having cppdefs in the main program + subroutine ufs_settimer(timevalue) + real(dbl_kind), intent(inout) :: timevalue + end subroutine ufs_settimer + subroutine ufs_logtimer(nunit,elapsedsecs,string,runtimelog,time0) + integer, intent(in) :: nunit + integer(int_kind), intent(in) :: elapsedsecs + character(len=*), intent(in) :: string + logical, intent(in) :: runtimelog + real(dbl_kind), intent(in) :: time0 + end subroutine ufs_logtimer + subroutine ufs_file_setLogUnit(filename,nunit,runtimelog) + character(len=*), intent(in) :: filename + logical, intent(in) :: runtimelog + integer, intent(out) :: nunit + end subroutine ufs_file_setLogUnit + subroutine ufs_logfhour(msg,hour) + character(len=*), intent(in) :: msg + real(dbl_kind), intent(in) :: hour + end subroutine ufs_logfhour #else + + use ice_kinds_mod , only : dbl_kind, int_kind, char_len, char_len_long + + implicit none + + real(dbl_kind) :: wtime = 0.0 contains + subroutine ufs_settimer(timevalue) + real(dbl_kind), intent(inout) :: timevalue + real(dbl_kind) :: MPI_Wtime + timevalue = MPI_Wtime() + end subroutine ufs_settimer + + subroutine ufs_logtimer(nunit,elapsedsecs,string,runtimelog,time0) + integer, intent(in) :: nunit + integer(int_kind), intent(in) :: elapsedsecs + character(len=*), intent(in) :: string + logical, intent(in) :: runtimelog + real(dbl_kind), intent(in) :: time0 + real(dbl_kind) :: MPI_Wtime, timevalue + if (.not. runtimelog) return + if (time0 > 0.) then + timevalue = MPI_Wtime()-time0 + write(nunit,*)elapsedsecs,' CICE '//trim(string),timevalue + end if + end subroutine ufs_logtimer - ! These are just stub routines put in place to remove + subroutine ufs_file_setLogUnit(filename,nunit,runtimelog) + character(len=*), intent(in) :: filename + logical, intent(in) :: runtimelog + integer, intent(out) :: nunit + if (.not. runtimelog) return + open (newunit=nunit, file=trim(filename)) + end subroutine ufs_file_setLogUnit + subroutine ufs_logfhour(msg,hour) + character(len=*), intent(in) :: msg + real(dbl_kind), intent(in) :: hour + character(len=char_len) :: filename + integer(int_kind) :: nunit + write(filename,'(a,i3.3)')'log.ice.f',int(hour) + open(newunit=nunit,file=trim(filename)) + write(nunit,'(a)')'completed: cice' + write(nunit,'(a,f10.3)')'forecast hour:',hour + write(nunit,'(a)')'valid time: '//trim(msg) + close(nunit) + end subroutine ufs_logfhour + + ! Define stub routines that do nothing - they are just here to avoid + ! having cppdefs in the main program subroutine shr_file_setLogUnit(nunit) integer, intent(in) :: nunit - ! do nothing for this stub - its just here to replace - ! having cppdefs in the main program end subroutine shr_file_setLogUnit subroutine shr_file_getLogUnit(nunit) integer, intent(in) :: nunit - ! do nothing for this stub - its just here to replace - ! having cppdefs in the main program end subroutine shr_file_getLogUnit - subroutine t_startf(string) character(len=*) :: string end subroutine t_startf diff --git a/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 b/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 index b94fcff05..4bdb7deb2 100644 --- a/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 +++ b/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 @@ -38,6 +38,7 @@ module ice_comp_nuopc use icepack_intfc , only : icepack_query_tracer_flags, icepack_query_parameters use cice_wrapper_mod , only : t_startf, t_stopf, t_barrierf use cice_wrapper_mod , only : shr_file_getlogunit, shr_file_setlogunit + use cice_wrapper_mod , only : ufs_settimer, ufs_logtimer, ufs_file_setlogunit, wtime #ifdef CESMCOUPLED use shr_const_mod use shr_orb_mod , only : shr_orb_decl, shr_orb_params, SHR_ORB_UNDEF_REAL, SHR_ORB_UNDEF_INT @@ -87,11 +88,12 @@ module ice_comp_nuopc type(ESMF_Mesh) :: ice_mesh - integer :: nthrds ! Number of threads to use in this component - + integer :: nthrds ! Number of threads to use in this component + integer :: nu_timer = 6 ! Simple timer log, unused except by UFS integer :: dbug = 0 logical :: profile_memory = .false. logical :: mastertask + logical :: runtimelog = .false. integer :: start_ymd ! Start date (YYYYMMDD) integer :: start_tod ! start time of day (s) integer :: curr_ymd ! Current date (YYYYMMDD) @@ -245,6 +247,8 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) character(len=*), parameter :: subname=trim(modName)//':(InitializeAdvertise) ' !-------------------------------- + call ufs_settimer(wtime) + call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldName", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (isPresent .and. isSet) then @@ -305,6 +309,12 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) write(logmsg,'(i6)') dbug call ESMF_LogWrite('CICE_cap: dbug = '//trim(logmsg), ESMF_LOGMSG_INFO) + call NUOPC_CompAttributeGet(gcomp, name="RunTimeLog", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) runtimelog=(trim(cvalue)=="true") + write(logmsg,*) runtimelog + call ESMF_LogWrite('CICE_cap:RunTimeLog = '//trim(logmsg), ESMF_LOGMSG_INFO) + !---------------------------------------------------------------------------- ! generate local mpi comm !---------------------------------------------------------------------------- @@ -487,6 +497,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! Set the nu_diag_set flag so it's not reset later call shr_file_setLogUnit (shrlogunit) + call ufs_file_setLogUnit('./log.ice.timer',nu_timer,runtimelog) call NUOPC_CompAttributeGet(gcomp, name="diro", value=cvalue, & isPresent=isPresent, isSet=isSet, rc=rc) @@ -699,7 +710,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) end if call t_stopf ('cice_init_total') - + if (mastertask) call ufs_logtimer(nu_timer,msec,'InitializeAdvertise time: ',runtimelog,wtime) end subroutine InitializeAdvertise !=============================================================================== @@ -735,6 +746,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) rc = ESMF_SUCCESS if (dbug > 5) call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) + call ufs_settimer(wtime) !---------------------------------------------------------------------------- ! Second cice initialization phase -after initializing grid info !---------------------------------------------------------------------------- @@ -912,6 +924,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) call flush_fileunit(nu_diag) + if (mastertask) call ufs_logtimer(nu_timer,msec,'InitializeRealize time: ',runtimelog,wtime) end subroutine InitializeRealize !=============================================================================== @@ -957,6 +970,8 @@ subroutine ModelAdvance(gcomp, rc) !-------------------------------- rc = ESMF_SUCCESS + if (mastertask) call ufs_logtimer(nu_timer,msec,'ModelAdvance time since last step: ',runtimelog,wtime) + call ufs_settimer(wtime) call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) @@ -1177,6 +1192,9 @@ subroutine ModelAdvance(gcomp, rc) if (dbug > 5) call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) + if (mastertask) call ufs_logtimer(nu_timer,msec,'ModelAdvance time: ',runtimelog,wtime) + call ufs_settimer(wtime) + end subroutine ModelAdvance !=============================================================================== @@ -1321,6 +1339,7 @@ subroutine ModelFinalize(gcomp, rc) !-------------------------------- rc = ESMF_SUCCESS + call ufs_settimer(wtime) if (dbug > 5) call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) if (my_task == master_task) then write(nu_diag,F91) @@ -1329,6 +1348,8 @@ subroutine ModelFinalize(gcomp, rc) end if if (dbug > 5) call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) + if(mastertask) call ufs_logtimer(nu_timer,msec,'ModelFinalize time: ',runtimelog,wtime) + end subroutine ModelFinalize !=============================================================================== From 32dc48eae101749b437bd777c18830e3c397b17a Mon Sep 17 00:00:00 2001 From: Tony Craig Date: Thu, 31 Aug 2023 13:05:54 -0700 Subject: [PATCH 17/76] Update Icepack to #23b6c1272b50d42ca, Aug 30, 2023 (#857) Includes thin ice enthalpy fix, not bit-for-bit. --- icepack | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/icepack b/icepack index f5e093f51..23b6c1272 160000 --- a/icepack +++ b/icepack @@ -1 +1 @@ -Subproject commit f5e093f5148554674079d5c7fc0702a41b81f744 +Subproject commit 23b6c1272b50d42cad7928ffe0005d6ee673dee9 From cbbac74cd9073dce8eb44fa23cabb573913aa44f Mon Sep 17 00:00:00 2001 From: "David A. Bailey" Date: Tue, 5 Sep 2023 14:22:59 -0600 Subject: [PATCH 18/76] Only print messages in CAP on master task (#861) --- cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 b/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 index 4bdb7deb2..5dec8a942 100644 --- a/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 +++ b/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 @@ -609,7 +609,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) if (tfrz_option_driver /= tfrz_option) then write(errmsg,'(a)') trim(subname)//'WARNING: tfrz_option from driver '//trim(tfrz_option_driver)//& ' is overwriting tfrz_option from cice namelist '//trim(tfrz_option) - write(nu_diag,*) trim(errmsg) + if (mastertask) write(nu_diag,*) trim(errmsg) call icepack_warnings_flush(nu_diag) call icepack_init_parameters(tfrz_option_in=tfrz_option_driver) endif @@ -624,7 +624,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) if (atmiter_conv_driver /= atmiter_conv) then write(errmsg,'(a,d13.5,a,d13.5)') trim(subname)//'WARNING: atmiter_ from driver ',& atmiter_conv_driver,' is overwritting atmiter_conv from cice namelist ',atmiter_conv - write(nu_diag,*) trim(errmsg) + if(mastertask) write(nu_diag,*) trim(errmsg) call icepack_warnings_flush(nu_diag) call icepack_init_parameters(atmiter_conv_in=atmiter_conv_driver) end if From 714bab97540e5b75c0f2b6c11cd061277cdb322d Mon Sep 17 00:00:00 2001 From: Tony Craig Date: Thu, 7 Sep 2023 14:20:29 -0700 Subject: [PATCH 19/76] 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 --- .../scripts/machines/Macros.cheyenne_gnu | 6 +- .../scripts/machines/Macros.cheyenne_intel | 6 +- .../scripts/machines/Macros.cheyenne_pgi | 6 +- .../scripts/machines/Macros.derecho_cray | 66 ++++++++++++++++ .../scripts/machines/Macros.derecho_gnu | 75 +++++++++++++++++++ .../scripts/machines/Macros.derecho_intel | 19 ++--- .../machines/Macros.derecho_intelclassic | 62 +++++++++++++++ .../machines/Macros.derecho_inteloneapi | 62 +++++++++++++++ .../scripts/machines/Macros.derecho_nvhpc | 68 +++++++++++++++++ .../scripts/machines/env.cheyenne_gnu | 20 ++--- .../scripts/machines/env.cheyenne_intel | 20 ++--- .../scripts/machines/env.cheyenne_pgi | 20 ++--- .../scripts/machines/env.chicoma_intel | 0 .../scripts/machines/env.derecho_cray | 72 ++++++++++++++++++ .../scripts/machines/env.derecho_gnu | 72 ++++++++++++++++++ .../scripts/machines/env.derecho_intel | 8 +- .../scripts/machines/env.derecho_intelclassic | 72 ++++++++++++++++++ .../scripts/machines/env.derecho_inteloneapi | 72 ++++++++++++++++++ .../scripts/machines/env.derecho_nvhpc | 72 ++++++++++++++++++ 19 files changed, 743 insertions(+), 55 deletions(-) create mode 100644 configuration/scripts/machines/Macros.derecho_cray create mode 100644 configuration/scripts/machines/Macros.derecho_gnu create mode 100644 configuration/scripts/machines/Macros.derecho_intelclassic create mode 100644 configuration/scripts/machines/Macros.derecho_inteloneapi create mode 100644 configuration/scripts/machines/Macros.derecho_nvhpc mode change 100755 => 100644 configuration/scripts/machines/env.chicoma_intel create mode 100644 configuration/scripts/machines/env.derecho_cray create mode 100644 configuration/scripts/machines/env.derecho_gnu create mode 100644 configuration/scripts/machines/env.derecho_intelclassic create mode 100644 configuration/scripts/machines/env.derecho_inteloneapi create mode 100644 configuration/scripts/machines/env.derecho_nvhpc diff --git a/configuration/scripts/machines/Macros.cheyenne_gnu b/configuration/scripts/machines/Macros.cheyenne_gnu index 5d3859ec8..c83f71567 100644 --- a/configuration/scripts/machines/Macros.cheyenne_gnu +++ b/configuration/scripts/machines/Macros.cheyenne_gnu @@ -57,7 +57,7 @@ LIB_NETCDF := $(NETCDF_PATH)/lib #LIB_PNETCDF := $(PNETCDF_PATH)/lib LIB_MPI := $(IMPILIBDIR) -#SLIBS := -L$(LIB_NETCDF) -lnetcdf -lnetcdff -L$(LIB_PNETCDF) -lpnetcdf -lgptl +#SLIBS := -L$(LIB_NETCDF) -lnetcdf -lnetcdff -L$(LIB_PNETCDF) -lpnetcdf SLIBS := -L$(LIB_NETCDF) -lnetcdf -lnetcdff ifeq ($(ICE_THREADED), true) @@ -72,8 +72,8 @@ ifeq ($(ICE_IOTYPE), pio1) endif ifeq ($(ICE_IOTYPE), pio2) - CPPDEFS := $(CPPDEFS) -DGPTL + CPPDEFS := $(CPPDEFS) LIB_PIO := $(PIO_LIBDIR) - SLIBS := $(SLIBS) -L$(LIB_PIO) -lpiof -lpioc -lgptl + SLIBS := $(SLIBS) -L$(LIB_PIO) -lpiof -lpioc endif diff --git a/configuration/scripts/machines/Macros.cheyenne_intel b/configuration/scripts/machines/Macros.cheyenne_intel index 6fb3a002a..b1726558d 100644 --- a/configuration/scripts/machines/Macros.cheyenne_intel +++ b/configuration/scripts/machines/Macros.cheyenne_intel @@ -46,7 +46,7 @@ LIB_NETCDF := $(NETCDF_PATH)/lib #LIB_PNETCDF := $(PNETCDF_PATH)/lib LIB_MPI := $(IMPILIBDIR) -#SLIBS := -L$(LIB_NETCDF) -lnetcdf -lnetcdff -L$(LIB_PNETCDF) -lpnetcdf -lgptl +#SLIBS := -L$(LIB_NETCDF) -lnetcdf -lnetcdff -L$(LIB_PNETCDF) -lpnetcdf SLIBS := -L$(LIB_NETCDF) -lnetcdf -lnetcdff ifeq ($(ICE_THREADED), true) @@ -61,8 +61,8 @@ ifeq ($(ICE_IOTYPE), pio1) endif ifeq ($(ICE_IOTYPE), pio2) - CPPDEFS := $(CPPDEFS) -DGPTL + CPPDEFS := $(CPPDEFS) LIB_PIO := $(PIO_LIBDIR) - SLIBS := $(SLIBS) -L$(LIB_PIO) -lpiof -lpioc -lgptl + SLIBS := $(SLIBS) -L$(LIB_PIO) -lpiof -lpioc endif diff --git a/configuration/scripts/machines/Macros.cheyenne_pgi b/configuration/scripts/machines/Macros.cheyenne_pgi index c1a8a0465..2e2fd5291 100644 --- a/configuration/scripts/machines/Macros.cheyenne_pgi +++ b/configuration/scripts/machines/Macros.cheyenne_pgi @@ -45,7 +45,7 @@ LIB_NETCDF := $(NETCDF_PATH)/lib #LIB_PNETCDF := $(PNETCDF_PATH)/lib LIB_MPI := $(IMPILIBDIR) -#SLIBS := -L$(LIB_NETCDF) -lnetcdf -lnetcdff -L$(LIB_PNETCDF) -lpnetcdf -lgptl +#SLIBS := -L$(LIB_NETCDF) -lnetcdf -lnetcdff -L$(LIB_PNETCDF) -lpnetcdf SLIBS := -L$(LIB_NETCDF) -lnetcdf -lnetcdff ifeq ($(ICE_THREADED), true) @@ -60,8 +60,8 @@ ifeq ($(ICE_IOTYPE), pio1) endif ifeq ($(ICE_IOTYPE), pio2) - CPPDEFS := $(CPPDEFS) -DGPTL + CPPDEFS := $(CPPDEFS) LIB_PIO := $(PIO_LIBDIR) - SLIBS := $(SLIBS) -L$(LIB_PIO) -lpiof -lpioc -lgptl + SLIBS := $(SLIBS) -L$(LIB_PIO) -lpiof -lpioc endif diff --git a/configuration/scripts/machines/Macros.derecho_cray b/configuration/scripts/machines/Macros.derecho_cray new file mode 100644 index 000000000..d90c7f984 --- /dev/null +++ b/configuration/scripts/machines/Macros.derecho_cray @@ -0,0 +1,66 @@ +#============================================================================== +# Macros file for NCAR derecho, cray compiler +#============================================================================== + +CPP := ftn -e P +CPPDEFS := -DFORTRANUNDERSCORE -DNO_R16 ${ICE_CPPDEFS} +CFLAGS := -c -O2 + +FIXEDFLAGS := -132 +FREEFLAGS := +FFLAGS := -hbyteswapio +FFLAGS_NOOPT:= -O0 +LDFLAGS := -hbyteswapio + +ifeq ($(ICE_BLDDEBUG), true) + FFLAGS += -O0 -hfp0 -g -Rbcdps -Ktrap=fp +else + FFLAGS += -O2 -hfp0 # -eo +endif + +SCC := cc +SFC := ftn +MPICC := cc +MPIFC := ftn + +ifeq ($(ICE_COMMDIR), mpi) + FC := $(MPIFC) + CC := $(MPICC) +else + FC := $(SFC) + CC := $(SCC) +endif +LD:= $(FC) + +# defined by module +#NETCDF_PATH := $(NETCDF) + +#PIO_CONFIG_OPTS:= --enable-filesystem-hints=gpfs + +#INCLDIR := $(INCLDIR) +#INCLDIR += -I$(NETCDF_PATH)/include + +LIB_NETCDF := $(NETCDF)/lib +##LIB_PNETCDF := $(PNETCDF_PATH)/lib + +SLIBS := -L$(LIB_NETCDF) -lnetcdf -lnetcdff + +ifeq ($(ICE_THREADED), true) + LDFLAGS += -fopenmp + CFLAGS += -fopenmp + FFLAGS += -fopenmp +else + LDFLAGS += -hnoomp +# CFLAGS += -hnoomp + FFLAGS += -hnoomp +endif + +ifeq ($(ICE_IOTYPE), pio1) + LIB_PIO := $(PIO)/lib + SLIBS := $(SLIBS) -L$(LIB_PIO) -lpio +endif + +ifeq ($(ICE_IOTYPE), pio2) + LIB_PIO := $(PIO)/lib + SLIBS := $(SLIBS) -L$(LIB_PIO) -lpiof -lpioc +endif diff --git a/configuration/scripts/machines/Macros.derecho_gnu b/configuration/scripts/machines/Macros.derecho_gnu new file mode 100644 index 000000000..e42e06f06 --- /dev/null +++ b/configuration/scripts/machines/Macros.derecho_gnu @@ -0,0 +1,75 @@ +#============================================================================== +# Makefile macros for NCAR derecho, gnu compiler +#============================================================================== + +CPP := ftn -E +CPPDEFS := -DFORTRANUNDERSCORE ${ICE_CPPDEFS} +CFLAGS := -c + +FIXEDFLAGS := -ffixed-line-length-132 +FREEFLAGS := -ffree-form +FFLAGS := -fconvert=big-endian -fbacktrace -ffree-line-length-none -fallow-argument-mismatch +FFLAGS_NOOPT:= -O0 + +ifeq ($(ICE_BLDDEBUG), true) + FFLAGS += -O0 -g -fcheck=bounds -finit-real=nan -fimplicit-none -ffpe-trap=invalid,zero,overflow --std f2008 +# FFLAGS += -O0 -g -fcheck=all -finit-real=snan -fimplicit-none -ffpe-trap=invalid,zero,overflow + CFLAGS += -O0 +endif + +ifeq ($(ICE_COVERAGE), true) + FFLAGS += -O0 -g -fprofile-arcs -ftest-coverage + CFLAGS += -O0 -g -coverage + LDFLAGS += -g -ftest-coverage -fprofile-arcs +endif + +ifneq ($(ICE_BLDDEBUG), true) +ifneq ($(ICE_COVERAGE), true) + FFLAGS += -O2 + CFLAGS += -O2 +endif +endif + +SCC := gcc +SFC := gfortran +MPICC := mpicc +MPIFC := mpif90 + +ifeq ($(ICE_COMMDIR), mpi) + FC := $(MPIFC) + CC := $(MPICC) +else + FC := $(SFC) + CC := $(SCC) +endif +LD:= $(FC) + +NETCDF_PATH := $(NETCDF) + +#PIO_CONFIG_OPTS:= --enable-filesystem-hints=gpfs + +#INCLDIR := $(INCLDIR) + +LIB_NETCDF := $(NETCDF_PATH)/lib +#LIB_PNETCDF := $(PNETCDF_PATH)/lib +#LIB_MPI := $(IMPILIBDIR) + +#SLIBS := -L$(LIB_NETCDF) -lnetcdf -lnetcdff -L$(LIB_PNETCDF) -lpnetcdf +SLIBS := -L$(LIB_NETCDF) -lnetcdf -lnetcdff + +ifeq ($(ICE_THREADED), true) + LDFLAGS += -fopenmp + CFLAGS += -fopenmp + FFLAGS += -fopenmp +endif + +ifeq ($(ICE_IOTYPE), pio1) + LIB_PIO := $(PIO)/lib + SLIBS := $(SLIBS) -L$(LIB_PIO) -lpio +endif + +ifeq ($(ICE_IOTYPE), pio2) + LIB_PIO := $(PIO)/lib + SLIBS := $(SLIBS) -L$(LIB_PIO) -lpiof -lpioc +endif + diff --git a/configuration/scripts/machines/Macros.derecho_intel b/configuration/scripts/machines/Macros.derecho_intel index df0d2320e..cd349c57d 100644 --- a/configuration/scripts/machines/Macros.derecho_intel +++ b/configuration/scripts/machines/Macros.derecho_intel @@ -1,5 +1,5 @@ #============================================================================== -# Makefile macros for NCAR cheyenne, intel compiler +# Makefile macros for NCAR derecho, intel compiler #============================================================================== CPP := fpp @@ -37,14 +37,11 @@ NETCDF_PATH := $(NETCDF) #PIO_CONFIG_OPTS:= --enable-filesystem-hints=gpfs -PNETCDF_PATH := $(PNETCDF) -#PNETCDF_PATH := /glade/u/apps/ch/opt/pio/2.2/mpt/2.15f/intel/17.0.1/lib +#PNETCDF_PATH := $(PNETCDF) -INCLDIR := $(INCLDIR) +#INCLDIR := $(INCLDIR) LIB_NETCDF := $(NETCDF)/lib -#LIB_PNETCDF := $(PNETCDF_PATH)/lib -#LIB_MPI := $(IMPILIBDIR) #SLIBS := -L$(LIB_NETCDF) -lnetcdf -lnetcdff -L$(LIB_PNETCDF) -lpnetcdf -lgptl SLIBS := -L$(LIB_NETCDF) -lnetcdf -lnetcdff @@ -55,15 +52,11 @@ ifeq ($(ICE_THREADED), true) FFLAGS += -qopenmp endif -#ifeq ($(ICE_IOTYPE), pio1) -# LIB_PIO := $(PIO_LIBDIR) -# SLIBS := $(SLIBS) -L$(LIB_PIO) -lpio -#endif +ifeq ($(ICE_IOTYPE), pio1) + SLIBS := $(SLIBS) -lpio +endif ifeq ($(ICE_IOTYPE), pio2) -# CPPDEFS := $(CPPDEFS) -DGPTL -# LIB_PIO := $(PIO_LIBDIR) -# SLIBS := $(SLIBS) -L$(LIB_PIO) -lpiof -lpioc -lgptl SLIBS := $(SLIBS) -lpiof -lpioc endif diff --git a/configuration/scripts/machines/Macros.derecho_intelclassic b/configuration/scripts/machines/Macros.derecho_intelclassic new file mode 100644 index 000000000..e0ffd44e4 --- /dev/null +++ b/configuration/scripts/machines/Macros.derecho_intelclassic @@ -0,0 +1,62 @@ +#============================================================================== +# Makefile macros for NCAR derecho, intel compiler +#============================================================================== + +CPP := fpp +CPPDEFS := -DFORTRANUNDERSCORE ${ICE_CPPDEFS} +CFLAGS := -c -O2 -fp-model precise -march=core-avx2 + +FIXEDFLAGS := -fixed -132 +FREEFLAGS := -free +FFLAGS := -fp-model precise -convert big_endian -assume byterecl -ftz -traceback -march=core-avx2 +FFLAGS_NOOPT:= -O0 + +ifeq ($(ICE_BLDDEBUG), true) + FFLAGS += -O0 -g -check uninit -check bounds -check pointers -fpe0 -check noarg_temp_created -link_mpi=dbg +# FFLAGS += -O0 -g -check all -fpe0 -ftrapuv -fp-model except -check noarg_temp_created -link_mpi=dbg -stand f08 +# FFLAGS += -O0 -g -check all -fpe0 -ftrapuv -fp-model except -check noarg_temp_created -init=snan,arrays -link_mpi=dbg +else + FFLAGS += -O2 +endif + +SCC := icc +SFC := ifort +MPICC := mpicc +MPIFC := mpif90 + +ifeq ($(ICE_COMMDIR), mpi) + FC := $(MPIFC) + CC := $(MPICC) +else + FC := $(SFC) + CC := $(SCC) +endif +LD:= $(FC) + +NETCDF_PATH := $(NETCDF) + +#PIO_CONFIG_OPTS:= --enable-filesystem-hints=gpfs + +#PNETCDF_PATH := $(PNETCDF) + +#INCLDIR := $(INCLDIR) + +LIB_NETCDF := $(NETCDF)/lib + +#SLIBS := -L$(LIB_NETCDF) -lnetcdf -lnetcdff -L$(LIB_PNETCDF) -lpnetcdf -lgptl +SLIBS := -L$(LIB_NETCDF) -lnetcdf -lnetcdff + +ifeq ($(ICE_THREADED), true) + LDFLAGS += -qopenmp + CFLAGS += -qopenmp + FFLAGS += -qopenmp +endif + +ifeq ($(ICE_IOTYPE), pio1) + SLIBS := $(SLIBS) -lpio +endif + +ifeq ($(ICE_IOTYPE), pio2) + SLIBS := $(SLIBS) -lpiof -lpioc +endif + diff --git a/configuration/scripts/machines/Macros.derecho_inteloneapi b/configuration/scripts/machines/Macros.derecho_inteloneapi new file mode 100644 index 000000000..ae6640388 --- /dev/null +++ b/configuration/scripts/machines/Macros.derecho_inteloneapi @@ -0,0 +1,62 @@ +#============================================================================== +# Makefile macros for NCAR derecho, intel compiler +#============================================================================== + +CPP := fpp +CPPDEFS := -DFORTRANUNDERSCORE ${ICE_CPPDEFS} +CFLAGS := -c -O2 -fp-model precise -march=core-avx2 + +FIXEDFLAGS := -fixed -132 +FREEFLAGS := -free +FFLAGS := -fp-model precise -convert big_endian -assume byterecl -ftz -traceback -march=core-avx2 +FFLAGS_NOOPT:= -O0 + +ifeq ($(ICE_BLDDEBUG), true) + FFLAGS += -O0 -g -check uninit -check bounds -check pointers -fpe0 -check noarg_temp_created -link_mpi=dbg +# FFLAGS += -O0 -g -check all -fpe0 -ftrapuv -fp-model except -check noarg_temp_created -link_mpi=dbg -stand f08 +# FFLAGS += -O0 -g -check all -fpe0 -ftrapuv -fp-model except -check noarg_temp_created -init=snan,arrays -link_mpi=dbg +else + FFLAGS += -O2 +endif + +SCC := icx +SFC := ifx +MPICC := mpicc +MPIFC := mpif90 + +ifeq ($(ICE_COMMDIR), mpi) + FC := $(MPIFC) + CC := $(MPICC) +else + FC := $(SFC) + CC := $(SCC) +endif +LD:= $(FC) + +NETCDF_PATH := $(NETCDF) + +#PIO_CONFIG_OPTS:= --enable-filesystem-hints=gpfs + +#PNETCDF_PATH := $(PNETCDF) + +#INCLDIR := $(INCLDIR) + +LIB_NETCDF := $(NETCDF)/lib + +#SLIBS := -L$(LIB_NETCDF) -lnetcdf -lnetcdff -L$(LIB_PNETCDF) -lpnetcdf -lgptl +SLIBS := -L$(LIB_NETCDF) -lnetcdf -lnetcdff + +ifeq ($(ICE_THREADED), true) + LDFLAGS += -qopenmp + CFLAGS += -qopenmp + FFLAGS += -qopenmp +endif + +ifeq ($(ICE_IOTYPE), pio1) + SLIBS := $(SLIBS) -lpio +endif + +ifeq ($(ICE_IOTYPE), pio2) + SLIBS := $(SLIBS) -lpiof -lpioc +endif + diff --git a/configuration/scripts/machines/Macros.derecho_nvhpc b/configuration/scripts/machines/Macros.derecho_nvhpc new file mode 100644 index 000000000..015010bcd --- /dev/null +++ b/configuration/scripts/machines/Macros.derecho_nvhpc @@ -0,0 +1,68 @@ +#============================================================================== +# Makefile macros for NCAR derecho, nvhpc compiler +#============================================================================== + +CPP := nvc -Mcpp +CPPDEFS := -DFORTRANUNDERSCORE -DNO_R16 ${ICE_CPPDEFS} +CFLAGS := -c -Kieee + +FIXEDFLAGS := -Mfixed +FREEFLAGS := -Mfree +FFLAGS := -Kieee -byteswapio -traceback +FFLAGS_NOOPT:= -O0 + +ifeq ($(ICE_BLDDEBUG), true) +# FFLAGS += -O0 -g -Ktrap=fp -Mbounds -Mchkptr +# FFLAGS += -O0 -g -Ktrap=fp -Mbounds +# FFLAGS += -O0 -Ktrap=fp -Mbounds -Mchkptr + FFLAGS += -O0 -Ktrap=fp + CFLAGS += -O0 +else +# FFLAGS += -O2 -Mnofma -target=zen3 + FFLAGS += -O2 + CFLAGS += -O2 +endif + +SCC := nvc +SFC := nvfortran +MPICC := mpicc +MPIFC := mpif90 + +ifeq ($(ICE_COMMDIR), mpi) + FC := $(MPIFC) + CC := $(MPICC) +else + FC := $(SFC) + CC := $(SCC) +endif +LD:= $(FC) + +NETCDF_PATH := $(NETCDF) + +#PIO_CONFIG_OPTS:= --enable-filesystem-hints=gpfs + +#INCLDIR := $(INCLDIR) + +LIB_NETCDF := $(NETCDF_PATH)/lib +#LIB_PNETCDF := $(PNETCDF_PATH)/lib +#LIB_MPI := $(IMPILIBDIR) + +#SLIBS := -L$(LIB_NETCDF) -lnetcdf -lnetcdff -L$(LIB_PNETCDF) -lpnetcdf +SLIBS := -L$(LIB_NETCDF) -lnetcdf -lnetcdff + +ifeq ($(ICE_THREADED), true) + LDFLAGS += -mp + CFLAGS += -mp + FFLAGS += -mp +endif + +ifeq ($(ICE_IOTYPE), pio1) + LIB_PIO := $(PIO)/lib + SLIBS := $(SLIBS) -L$(LIB_PIO) -lpio +endif + +ifeq ($(ICE_IOTYPE), pio2) + LIB_PIO := $(PIO)/lib + SLIBS := $(SLIBS) -L$(LIB_PIO) -lpiof -lpioc +endif + diff --git a/configuration/scripts/machines/env.cheyenne_gnu b/configuration/scripts/machines/env.cheyenne_gnu index fb29543f8..1c0da68b0 100644 --- a/configuration/scripts/machines/env.cheyenne_gnu +++ b/configuration/scripts/machines/env.cheyenne_gnu @@ -7,24 +7,24 @@ endif if ("$inp" != "-nomodules") then -source /glade/u/apps/ch/opt/lmod/7.2.1/lmod/7.2.1/init/csh +source ${MODULESHOME}/init/csh module purge -module load ncarenv/1.2 -module load gnu/8.3.0 -module load mpt/2.19 +module load ncarenv/1.3 +module load gnu/10.1.0 +module load mpt/2.25 module load ncarcompilers/0.5.0 -module load netcdf/4.6.3 +module load netcdf/4.8.1 if ($?ICE_IOTYPE) then if ($ICE_IOTYPE =~ pio*) then - module unload netcdf - module load netcdf-mpi/4.6.3 - module load pnetcdf/1.11.1 + module load pnetcdf/1.12.2 if ($ICE_IOTYPE == "pio1") then module load pio/1.10.1 else - module load pio/2.4.4 + module unload netcdf + module load netcdf-mpi/4.8.1 + module load pio/2.5.4 endif endif endif @@ -49,7 +49,7 @@ limit stacksize unlimited setenv ICE_MACHINE_MACHNAME cheyenne setenv ICE_MACHINE_MACHINFO "SGI ICE XA Xeon E5-2697V4 Broadwell" setenv ICE_MACHINE_ENVNAME gnu -setenv ICE_MACHINE_ENVINFO "GNU Fortran (GCC) 8.3.0, mpt2.19, netcdf4.6.3, pnetcdf1.11.1, pio1.10.1, pio2.4.4" +setenv ICE_MACHINE_ENVINFO "GNU Fortran (GCC) 10.1.0, mpt2.25, netcdf4.8.1, pnetcdf1.12.2, pio1.10.1, pio2.5.4" setenv ICE_MACHINE_MAKE gmake setenv ICE_MACHINE_WKDIR /glade/scratch/$user/CICE_RUNS setenv ICE_MACHINE_INPUTDATA /glade/p/cesm/pcwg_dev diff --git a/configuration/scripts/machines/env.cheyenne_intel b/configuration/scripts/machines/env.cheyenne_intel index 2c6eedec6..572460f04 100644 --- a/configuration/scripts/machines/env.cheyenne_intel +++ b/configuration/scripts/machines/env.cheyenne_intel @@ -7,24 +7,24 @@ endif if ("$inp" != "-nomodules") then -source /glade/u/apps/ch/opt/lmod/7.2.1/lmod/7.2.1/init/csh +source ${MODULESHOME}/init/csh module purge -module load ncarenv/1.2 -module load intel/19.0.2 -module load mpt/2.19 +module load ncarenv/1.3 +module load intel/19.1.1 +module load mpt/2.25 module load ncarcompilers/0.5.0 -module load netcdf/4.6.3 +module load netcdf/4.8.1 if ($?ICE_IOTYPE) then if ($ICE_IOTYPE =~ pio*) then - module unload netcdf - module load netcdf-mpi/4.6.3 - module load pnetcdf/1.11.1 + module load pnetcdf/1.12.2 if ($ICE_IOTYPE == "pio1") then module load pio/1.10.1 else - module load pio/2.4.4 + module unload netcdf + module load netcdf-mpi/4.8.1 + module load pio/2.5.4 endif endif endif @@ -49,7 +49,7 @@ limit stacksize unlimited setenv ICE_MACHINE_MACHNAME cheyenne setenv ICE_MACHINE_MACHINFO "SGI ICE XA Xeon E5-2697V4 Broadwell" setenv ICE_MACHINE_ENVNAME intel -setenv ICE_MACHINE_ENVINFO "ifort 19.0.2.187 20190117, mpt2.19, netcdf4.6.3, pnetcdf1.11.1, pio1.10.1, pio2.4.4" +setenv ICE_MACHINE_ENVINFO "ifort 19.1.1.217 20200306, mpt2.25, netcdf4.8.1, pnetcdf1.12.2, pio1.10.1, pio2.5.4" setenv ICE_MACHINE_MAKE gmake setenv ICE_MACHINE_WKDIR /glade/scratch/$user/CICE_RUNS setenv ICE_MACHINE_INPUTDATA /glade/p/cesm/pcwg_dev diff --git a/configuration/scripts/machines/env.cheyenne_pgi b/configuration/scripts/machines/env.cheyenne_pgi index e6e339f08..2959d12e6 100644 --- a/configuration/scripts/machines/env.cheyenne_pgi +++ b/configuration/scripts/machines/env.cheyenne_pgi @@ -7,24 +7,24 @@ endif if ("$inp" != "-nomodules") then -source /glade/u/apps/ch/opt/lmod/7.2.1/lmod/7.2.1/init/csh +source ${MODULESHOME}/init/csh module purge -module load ncarenv/1.2 -module load pgi/19.9 -module load mpt/2.21 +module load ncarenv/1.3 +module load pgi/20.4 +module load mpt/2.22 module load ncarcompilers/0.5.0 -module load netcdf/4.7.3 +module load netcdf/4.7.4 if ($?ICE_IOTYPE) then if ($ICE_IOTYPE =~ pio*) then - module unload netcdf - module load netcdf-mpi/4.7.3 - module load pnetcdf/1.12.1 + module load pnetcdf/1.12.2 if ($ICE_IOTYPE == "pio1") then module load pio/1.10.1 else - module load pio/2.4.4 + module unload netcdf + module load netcdf-mpi/4.7.4 + module load pio/2.5.4 endif endif endif @@ -49,7 +49,7 @@ limit stacksize unlimited setenv ICE_MACHINE_MACHNAME cheyenne setenv ICE_MACHINE_MACHINFO "SGI ICE XA Xeon E5-2697V4 Broadwell" setenv ICE_MACHINE_ENVNAME pgi -setenv ICE_MACHINE_ENVINFO "pgf90 19.9-0, mpt2.21, netcdf4.7.3, pnetcdf1.12.1, pio1.10.1, pio2.4.4" +setenv ICE_MACHINE_ENVINFO "pgf90 20.4-0, mpt2.22, netcdf4.7.4, pnetcdf1.12.2, pio1.10.1, pio2.5.4" setenv ICE_MACHINE_MAKE gmake setenv ICE_MACHINE_WKDIR /glade/scratch/$user/CICE_RUNS setenv ICE_MACHINE_INPUTDATA /glade/p/cesm/pcwg_dev diff --git a/configuration/scripts/machines/env.chicoma_intel b/configuration/scripts/machines/env.chicoma_intel old mode 100755 new mode 100644 diff --git a/configuration/scripts/machines/env.derecho_cray b/configuration/scripts/machines/env.derecho_cray new file mode 100644 index 000000000..5c4542840 --- /dev/null +++ b/configuration/scripts/machines/env.derecho_cray @@ -0,0 +1,72 @@ +#!/bin/csh -f + +set inp = "undefined" +if ($#argv == 1) then + set inp = $1 +endif + +if ("$inp" != "-nomodules") then + +source ${MODULESHOME}/init/csh + +module --force purge +module load ncarenv/23.06 +module load craype +module load cce/15.0.1 +module load ncarcompilers +module load cray-mpich/8.1.25 +module load netcdf/4.9.2 +#module load hdf5/1.12.2 +#module load netcdf-mpi/4.9.2 + +module load cray-libsci/23.02.1.1 + +if ($?ICE_IOTYPE) then +if ($ICE_IOTYPE =~ pio*) then + module load parallel-netcdf/1.12.3 + if ($ICE_IOTYPE == "pio1") then + module load parallelio/1.10.1 + else + module load parallelio/2.6.1 + endif +endif +endif + +if ($?ICE_BFBTYPE) then +if ($ICE_BFBTYPE =~ qcchk*) then + module load conda +# conda env create -f ../../configuration/scripts/tests/qctest.yml + conda activate qctest +endif +endif + +# For perftools with mpiexec +# module load perftools-base +# module load perftools +#setenv PALS_TRANSFER FALSE + +endif + +limit coredumpsize unlimited +limit stacksize unlimited +setenv PALS_QUIET TRUE + +# May be needed for OpenMP memory +setenv OMP_STACKSIZE 64M +# OMP runtime diagnostics +#setenv OMP_DISPLAY_ENV TRUE + +setenv ICE_MACHINE_MACHNAME derecho +setenv ICE_MACHINE_MACHINFO "HPE Cray EX Milan Slingshot 11" +setenv ICE_MACHINE_ENVNAME cray +setenv ICE_MACHINE_ENVINFO "cce 15.0.1, cray-mpich 8.1.25, netcdf4.9.2, pnetcdf1.12.3, pio1.10.1, pio2.6.1" +setenv ICE_MACHINE_MAKE gmake +setenv ICE_MACHINE_WKDIR /glade/derecho/scratch/$user/CICE_RUNS +setenv ICE_MACHINE_INPUTDATA /glade/p/cesm/pcwg_dev +setenv ICE_MACHINE_BASELINE /glade/derecho/scratch/$user/CICE_BASELINE +setenv ICE_MACHINE_SUBMIT "qsub" +setenv ICE_MACHINE_ACCT P00000000 +setenv ICE_MACHINE_QUEUE "main" +setenv ICE_MACHINE_TPNODE 128 +setenv ICE_MACHINE_BLDTHRDS 8 +setenv ICE_MACHINE_QSTAT "qstat " diff --git a/configuration/scripts/machines/env.derecho_gnu b/configuration/scripts/machines/env.derecho_gnu new file mode 100644 index 000000000..d6378fa05 --- /dev/null +++ b/configuration/scripts/machines/env.derecho_gnu @@ -0,0 +1,72 @@ +#!/bin/csh -f + +set inp = "undefined" +if ($#argv == 1) then + set inp = $1 +endif + +if ("$inp" != "-nomodules") then + +source ${MODULESHOME}/init/csh + +module --force purge +module load ncarenv/23.06 +module load craype +module load gcc/12.2.0 +module load ncarcompilers +module load cray-mpich/8.1.25 +module load netcdf/4.9.2 +#module load hdf5/1.12.2 +#module load netcdf-mpi/4.9.2 + +module load cray-libsci/23.02.1.1 + +if ($?ICE_IOTYPE) then +if ($ICE_IOTYPE =~ pio*) then + module load parallel-netcdf/1.12.3 + if ($ICE_IOTYPE == "pio1") then + module load parallelio/1.10.1 + else + module load parallelio/2.6.2 + endif +endif +endif + +if ($?ICE_BFBTYPE) then +if ($ICE_BFBTYPE =~ qcchk*) then + module load conda +# conda env create -f ../../configuration/scripts/tests/qctest.yml + conda activate qctest +endif +endif + +# For perftools with mpiexec +# module load perftools-base +# module load perftools +#setenv PALS_TRANSFER FALSE + +endif + +limit coredumpsize unlimited +limit stacksize unlimited +setenv PALS_QUIET TRUE + +# May be needed for OpenMP memory +setenv OMP_STACKSIZE 64M +# OMP runtime diagnostics +#setenv OMP_DISPLAY_ENV TRUE + +setenv ICE_MACHINE_MACHNAME derecho +setenv ICE_MACHINE_MACHINFO "HPE Cray EX Milan Slingshot 11" +setenv ICE_MACHINE_ENVNAME gnu +setenv ICE_MACHINE_ENVINFO "gcc 12.2.0 20220819, cray-mpich 8.1.25, netcdf4.9.2, pnetcdf1.12.3, pio1.10.1, pio2.6.2" +setenv ICE_MACHINE_MAKE gmake +setenv ICE_MACHINE_WKDIR /glade/derecho/scratch/$user/CICE_RUNS +setenv ICE_MACHINE_INPUTDATA /glade/p/cesm/pcwg_dev +setenv ICE_MACHINE_BASELINE /glade/derecho/scratch/$user/CICE_BASELINE +setenv ICE_MACHINE_SUBMIT "qsub" +setenv ICE_MACHINE_ACCT P00000000 +setenv ICE_MACHINE_QUEUE "main" +setenv ICE_MACHINE_TPNODE 128 +setenv ICE_MACHINE_BLDTHRDS 8 +setenv ICE_MACHINE_QSTAT "qstat " diff --git a/configuration/scripts/machines/env.derecho_intel b/configuration/scripts/machines/env.derecho_intel index baa053e75..5c3e593d4 100644 --- a/configuration/scripts/machines/env.derecho_intel +++ b/configuration/scripts/machines/env.derecho_intel @@ -15,8 +15,10 @@ module load craype module load intel/2023.0.0 module load ncarcompilers module load cray-mpich/8.1.25 +module load netcdf/4.9.2 #module load hdf5/1.12.2 -module load netcdf-mpi/4.9.2 +#module load netcdf-mpi/4.9.2 + module load cray-libsci/23.02.1.1 if ($?ICE_IOTYPE) then @@ -25,7 +27,7 @@ if ($ICE_IOTYPE =~ pio*) then if ($ICE_IOTYPE == "pio1") then module load parallelio/1.10.1 else - module load parallelio/2.6.0 + module load parallelio/2.6.1 endif endif endif @@ -57,7 +59,7 @@ setenv OMP_STACKSIZE 64M setenv ICE_MACHINE_MACHNAME derecho setenv ICE_MACHINE_MACHINFO "HPE Cray EX Milan Slingshot 11" setenv ICE_MACHINE_ENVNAME intel -setenv ICE_MACHINE_ENVINFO "ifort 2021.8.0 20221119, cray-mpich 2.25, netcdf-mpi4.9.2, pnetcdf1.12.3, pio2.6.0" +setenv ICE_MACHINE_ENVINFO "ifort 2021.8.0 20221119, oneAPI DPC++/C++ 2023.0.0.20221201), cray-mpich 8.1.25, netcdf4.9.2, pnetcdf1.12.3, pio1.10.1, pio2.6.1" setenv ICE_MACHINE_MAKE gmake setenv ICE_MACHINE_WKDIR /glade/derecho/scratch/$user/CICE_RUNS setenv ICE_MACHINE_INPUTDATA /glade/p/cesm/pcwg_dev diff --git a/configuration/scripts/machines/env.derecho_intelclassic b/configuration/scripts/machines/env.derecho_intelclassic new file mode 100644 index 000000000..39b08e1bc --- /dev/null +++ b/configuration/scripts/machines/env.derecho_intelclassic @@ -0,0 +1,72 @@ +#!/bin/csh -f + +set inp = "undefined" +if ($#argv == 1) then + set inp = $1 +endif + +if ("$inp" != "-nomodules") then + +source ${MODULESHOME}/init/csh + +module --force purge +module load ncarenv/23.06 +module load craype +module load intel-classic/2023.0.0 +module load ncarcompilers +module load cray-mpich/8.1.25 +module load netcdf/4.9.2 +#module load hdf5/1.12.2 +#module load netcdf-mpi/4.9.2 + +#module load cray-libsci/23.02.1.1 + +if ($?ICE_IOTYPE) then +if ($ICE_IOTYPE =~ pio*) then + module load parallel-netcdf/1.12.3 + if ($ICE_IOTYPE == "pio1") then + module load parallelio/1.10.1 + else + module load parallelio/2.6.2 + endif +endif +endif + +if ($?ICE_BFBTYPE) then +if ($ICE_BFBTYPE =~ qcchk*) then + module load conda +# conda env create -f ../../configuration/scripts/tests/qctest.yml + conda activate qctest +endif +endif + +# For perftools with mpiexec +# module load perftools-base +# module load perftools +#setenv PALS_TRANSFER FALSE + +endif + +limit coredumpsize unlimited +limit stacksize unlimited +setenv PALS_QUIET TRUE + +# May be needed for OpenMP memory +setenv OMP_STACKSIZE 64M +# OMP runtime diagnostics +#setenv OMP_DISPLAY_ENV TRUE + +setenv ICE_MACHINE_MACHNAME derecho +setenv ICE_MACHINE_MACHINFO "HPE Cray EX Milan Slingshot 11" +setenv ICE_MACHINE_ENVNAME intelclassic +setenv ICE_MACHINE_ENVINFO "icc/ifort 2021.8.0 20221119, cray-mpich 8.1.25, netcdf4.9.2, pnetcdf1.12.3, pio1.10.1, pio2.6.2" +setenv ICE_MACHINE_MAKE gmake +setenv ICE_MACHINE_WKDIR /glade/derecho/scratch/$user/CICE_RUNS +setenv ICE_MACHINE_INPUTDATA /glade/p/cesm/pcwg_dev +setenv ICE_MACHINE_BASELINE /glade/derecho/scratch/$user/CICE_BASELINE +setenv ICE_MACHINE_SUBMIT "qsub" +setenv ICE_MACHINE_ACCT P00000000 +setenv ICE_MACHINE_QUEUE "main" +setenv ICE_MACHINE_TPNODE 128 +setenv ICE_MACHINE_BLDTHRDS 8 +setenv ICE_MACHINE_QSTAT "qstat " diff --git a/configuration/scripts/machines/env.derecho_inteloneapi b/configuration/scripts/machines/env.derecho_inteloneapi new file mode 100644 index 000000000..a4f173404 --- /dev/null +++ b/configuration/scripts/machines/env.derecho_inteloneapi @@ -0,0 +1,72 @@ +#!/bin/csh -f + +set inp = "undefined" +if ($#argv == 1) then + set inp = $1 +endif + +if ("$inp" != "-nomodules") then + +source ${MODULESHOME}/init/csh + +module --force purge +module load ncarenv/23.06 +module load craype +module load intel-oneapi/2023.0.0 +module load ncarcompilers +module load cray-mpich/8.1.25 +module load netcdf/4.9.2 +#module load hdf5/1.12.2 +#module load netcdf-mpi/4.9.2 + +module load cray-libsci/23.02.1.1 + +if ($?ICE_IOTYPE) then +if ($ICE_IOTYPE =~ pio*) then + module load parallel-netcdf/1.12.3 + if ($ICE_IOTYPE == "pio1") then + module load parallelio/1.10.1 + else + module load parallelio/2.6.1 + endif +endif +endif + +if ($?ICE_BFBTYPE) then +if ($ICE_BFBTYPE =~ qcchk*) then + module load conda +# conda env create -f ../../configuration/scripts/tests/qctest.yml + conda activate qctest +endif +endif + +# For perftools with mpiexec +# module load perftools-base +# module load perftools +#setenv PALS_TRANSFER FALSE + +endif + +limit coredumpsize unlimited +limit stacksize unlimited +setenv PALS_QUIET TRUE + +# May be needed for OpenMP memory +setenv OMP_STACKSIZE 64M +# OMP runtime diagnostics +#setenv OMP_DISPLAY_ENV TRUE + +setenv ICE_MACHINE_MACHNAME derecho +setenv ICE_MACHINE_MACHINFO "HPE Cray EX Milan Slingshot 11" +setenv ICE_MACHINE_ENVNAME inteloneapi +setenv ICE_MACHINE_ENVINFO "ifx 2023.0.0 20221201, oneAPI DPC++/C++ 2023.0.0.20221201, cray-mpich 8.1.25, netcdf4.9.2, pnetcdf1.12.3, pio1.10.1, pio2.6.1" +setenv ICE_MACHINE_MAKE gmake +setenv ICE_MACHINE_WKDIR /glade/derecho/scratch/$user/CICE_RUNS +setenv ICE_MACHINE_INPUTDATA /glade/p/cesm/pcwg_dev +setenv ICE_MACHINE_BASELINE /glade/derecho/scratch/$user/CICE_BASELINE +setenv ICE_MACHINE_SUBMIT "qsub" +setenv ICE_MACHINE_ACCT P00000000 +setenv ICE_MACHINE_QUEUE "main" +setenv ICE_MACHINE_TPNODE 128 +setenv ICE_MACHINE_BLDTHRDS 8 +setenv ICE_MACHINE_QSTAT "qstat " diff --git a/configuration/scripts/machines/env.derecho_nvhpc b/configuration/scripts/machines/env.derecho_nvhpc new file mode 100644 index 000000000..52702d4f7 --- /dev/null +++ b/configuration/scripts/machines/env.derecho_nvhpc @@ -0,0 +1,72 @@ +#!/bin/csh -f + +set inp = "undefined" +if ($#argv == 1) then + set inp = $1 +endif + +if ("$inp" != "-nomodules") then + +source ${MODULESHOME}/init/csh + +module --force purge +module load ncarenv/23.06 +module load craype +module load nvhpc/23.5 +module load ncarcompilers +module load cray-mpich/8.1.25 +module load netcdf/4.9.2 +#module load hdf5/1.12.2 +#module load netcdf-mpi/4.9.2 + +module load cray-libsci/23.02.1.1 + +if ($?ICE_IOTYPE) then +if ($ICE_IOTYPE =~ pio*) then + module load parallel-netcdf/1.12.3 + if ($ICE_IOTYPE == "pio1") then + module load parallelio/1.10.1 + else + module load parallelio/2.6.0 + endif +endif +endif + +if ($?ICE_BFBTYPE) then +if ($ICE_BFBTYPE =~ qcchk*) then + module load conda +# conda env create -f ../../configuration/scripts/tests/qctest.yml + conda activate qctest +endif +endif + +# For perftools with mpiexec +# module load perftools-base +# module load perftools +#setenv PALS_TRANSFER FALSE + +endif + +limit coredumpsize unlimited +limit stacksize unlimited +setenv PALS_QUIET TRUE + +# May be needed for OpenMP memory +setenv OMP_STACKSIZE 64M +# OMP runtime diagnostics +#setenv OMP_DISPLAY_ENV TRUE + +setenv ICE_MACHINE_MACHNAME derecho +setenv ICE_MACHINE_MACHINFO "HPE Cray EX Milan Slingshot 11" +setenv ICE_MACHINE_ENVNAME nvhpc +setenv ICE_MACHINE_ENVINFO "nvc 23.5-0, cray-mpich 8.1.25, netcdf4.9.2, pnetcdf1.12.3, pio1.10.1, pio2.6.0" +setenv ICE_MACHINE_MAKE gmake +setenv ICE_MACHINE_WKDIR /glade/derecho/scratch/$user/CICE_RUNS +setenv ICE_MACHINE_INPUTDATA /glade/p/cesm/pcwg_dev +setenv ICE_MACHINE_BASELINE /glade/derecho/scratch/$user/CICE_BASELINE +setenv ICE_MACHINE_SUBMIT "qsub" +setenv ICE_MACHINE_ACCT P00000000 +setenv ICE_MACHINE_QUEUE "main" +setenv ICE_MACHINE_TPNODE 128 +setenv ICE_MACHINE_BLDTHRDS 8 +setenv ICE_MACHINE_QSTAT "qstat " From 06282a538e03599aed27bc3c5506ccc31a590069 Mon Sep 17 00:00:00 2001 From: Tony Craig Date: Fri, 8 Sep 2023 11:26:45 -0700 Subject: [PATCH 20/76] Update version to 6.4.2 (#864) Update License and Copyright Update Icepack for version/copyright --- LICENSE.pdf | Bin 113509 -> 55036 bytes cicecore/drivers/direct/hadgem3/CICE.F90 | 4 ++-- cicecore/drivers/mct/cesm1/CICE_copyright.txt | 4 ++-- .../drivers/nuopc/cmeps/CICE_copyright.txt | 4 ++-- cicecore/drivers/nuopc/dmi/CICE.F90 | 4 ++-- cicecore/drivers/standalone/cice/CICE.F90 | 4 ++-- cicecore/drivers/unittest/opticep/CICE.F90 | 4 ++-- cicecore/version.txt | 2 +- doc/source/conf.py | 6 +++--- doc/source/intro/copyright.rst | 2 +- icepack | 2 +- 11 files changed, 18 insertions(+), 18 deletions(-) diff --git a/LICENSE.pdf b/LICENSE.pdf index d98d3da80d4be814224a113d781d15426d4bbf6d..80ae31d5183808e151adbeca14f21d7b66e4761a 100644 GIT binary patch literal 55036 zcmaI6b8zHg(=HsF8+&5gw#|)=jWN;2wv*i?8*OZRW81cEJM-mv&wI{$>iqFlO;!K8 z`|7LjyK8Eurmvw?k&t3!W#T}foI5+&L0|>2031zi5CjC6HLP9jEC4hLvf`3T>XNhw z%qlL9=5A&dE&v*JTWb^MuR?%5D=QB`+R@SK3n}4f1_Y>CIG9_wSh&y%2_bwv{)dYF ze<;mN0IUeiVu}D}B}W%~6TANbas3ZS%G%ELs|mA|or$Z3goT--xdj5Vf`x;X>kj}I z3k#=^5CG`vVqs#B;F)=0pchZn>g<k)4kjA#tNqLh7UCB2+gd;%)bJq) zk~SO9+I*t)aLDp0J=)U41krbX!>*3WXyZg^waXvymNWbODGYkM^uH3D8C$3ZIpUmj zg5IwDJN=*guKc^+_HyPvwm?@^AVb+q2H!ZypxgBU$RY8M2-Tgrz3*dQ%Av@~RGLkq*uY`J}5?rvZYe)v}{HRk?Pxb3>dPawByWKy5B-3d+eTvxcH!{xO7cYDh z#uWFb|FwZH*E&~_Hfyk5f4tl*%S4*KT)LJu!^9&t5K}^~6Zv7X^HL;#|6~0-d!=85 zd=w1!)-j%7F6H8M?&w)~zuLBiY`FX))x3#2hi+=1@Ni2Y585M6+-4lhxHMzro&G*C zH+}|N!qg%__&xsSdCwUcKZ+ISJM`uCX70oaPAYeFKFp6`j!2Gu4f*7chLKxvu1@uP zXcz)3`q$#*Ev@uSF?3EFFS9?Jm!$o*S%3fFtkP$l_>v7VibX#;+ONumn-}#WQ0T9KzIu(?<&YJoDLu%Roji)X^W6 zh#)Q_o)M6XH)l>r>(a}j|JUqn5EWSFtHO`B)T+O2)2E|51UGy~t< z5kv?fV+|WDT|Gke82?_8eBG0pQHACT9^OWU8Kp|23CDsqqH3_e{c1gaX7H3vKIvwa zRrUHrTI874CIUJ?3)(5Mna;O_5TNRGe=5OGuB2U6Dh@OD!KrPP7ZFVin-@MK#EC(~ z)~9WH6#q<2;;*sBw`UH3}xTgt22GE%&VzenS`_!@-xI9ypG4RBR=z zCspnUADEgv%Q+vkRgvwNK%!JS5-UUwHd)NPn|Y!>mI1QGC{mII`OXwDtR$cp25rB{ ze%}@_T_H84uXnQB0f78{)No|m%Zbmjgo-U&K# z*=@vZC`5pZ`{lI3rC|!+6aqmwX$_{$u|L?2;G_FAk9dqRMp=Ug9?^G;`84==`iC}c zl??FE(sJ9kK#_f#?k@7`;{tRH-N&|(li~1KOXc@by|~$fpZ}1mZQXx# z4ac|y9$?A@{Gmu7B1&>(yO;tE<}NvvH+2{Os65(T#4)x}%yklFnF|NqfLjbETttRE zlL+eS#posw>1qxpe3nmr%f%LtMn@1wLb`SC{SDK%9RUM0S#w>5N9g^QQC8#2L#cCk z0aa~0t}C8M7NGI4V$biz8CC(4ftXT$FxUq}1^ShCb z;03EslRC<-`xGPH@4sZWzw(=cx|}6XI4gbA;Gn(62AS}rn8jK~RwO(QPMVlYuas;l zAVN*Fx*j>Sjv4#$1k_%b=^30l8h%5%y$H4`8WqmoiRr&aHI;5pQ^ghQ5mC~=p?&S0 zK@Mnh-xVNwrg(U{313(H{dkXpmRqRb))=?1kbR_S$0(yYta>F6$dU2ON{s~&tHS5O zP-v0u5Qv@WW$yi9E89>ew$7zOad8)*BS#^Wry?`%^PSk8{m9B58D z7Fr>rwEpVQjOkJ;lV%?L1hemU0Bdw`5fJzHk;QxwifosYRDea%Ovb&1{-=(&%C)bR2scFd+$w_wOP4BAxhs=01Z=<4w{+O9xD3u9VcbBQ9KPFqP{3P$pl316TJS z{eo05xdO_Y?21(ysLTi%`Hft6g3QwY%yKDD4XIE`f}8JczjTspQ2v6;damd~etc@|{U z?A%mHe>#XF<64&%9_Z$Kn-#VB`#*+h|P&gnv)PATYZjVXD z&A-IQw+b)vHT7F=?##D5}+Spc6C_%eHkQYWm3Te^`g(-*qoCFE{ODliet0 zbyZI-hp%ltTy7_voi1~XaCNwQfpBcSyN%>FEg)a_RYBeWG?b~noF3#sC*#ELY$ zmTfI~BAR50=3N|}sPQuiN!DjKV}`+FQkux~>HagO`-<;SfUOoj*Y?4JoCf`9(yR{y zj_okrKTr>WqVZ2%@04~DejeI*-wyXQhWOHP4R%@@TclBOC|#7lj{gXJ0R>SzC;QhQ zp$CO^g^J_2KwVop671`6XrBh?b{l4u@(qg=w1}Hi@s7+ttU$GWvpAH8ID2FE@dmUY zcB5{%%UB5#IgWVlpe;K^-Nk7+#S>`zlT|CZ6ePm&^4daP*f?JBkWY-2SHy)}7yqojp zfRS27FOmb;LW%=F91ceoC!TxFQ?(~|j+eTjsOIb%Yq9o}l0}-PW&KPG z(FEKK(?7wu}0Ef8FaS%hh^ z17g8Yo>HvZkY9ABR+N;F!bBWMu7eO=hzWs@Wr>J(j=u z-pv1Tl1zAb_gs%%NwEJD^iEox-&!M+qfgG;A9$qn07dOkw^~X2U4**5Naw-wBIC7k zSUc^Bzg$QYITkuS@40@WEH#@(mJ|H?yg}zdaF6Stfk%6VI;T>{Ku~Ez#+JVo*d?P}nW*f%1#$ZC{$cS(N!l06v(klCAgILG39D5;G-&yZ{NPi+ zU1HjH*|a3<`=sSB`=~36GOtB4mC$uP1}qA$17&fKnQH-4{8)Vt>dtsuPa9>P$?k9_ z<@?LIOeDs$(H0Ybx{kI|{-S1Ph@or;NlDyvKHmb;o#ZKEsdOo$JBfekh2(_~qNz|6 zR?M`@sq;RfhbMYpCbZe4^ISXaj9IKcBnD012Hje!!>CQ%jVwfQas^;)WT>cdHmIFC zebx@h2tOGMt17sBj|#|bgUre06&EBbz}d{&3xEK+lVv2x4TB9eSLS)aVrhj;_){T= zF4tSaiLY_pa`DMcRcK=HHnAW5bMigeb4c`dt>U_Gbp~1Ecq{N$>}>J`s00j++*`j(@_k`RyWqXazs@7S?|+} z?->_vq>Hp%pr4>UCGC3hy9Se7*99(2i4u&$WJbbJ|DItovHXT7=tJ*jw34MeAuWSHS=wEZp_Gk;z(tMW|Md*0(A`y=*rb8f| zKuqzLZg*0hP8Aj@$b+zkgFyV7<-ofg_}C`m@7#b#YjAl^8bf(8wPtjHmm)dvR6Su$ z3^F6WhQbqq8(#i3j44ew1)1njE%DHj-$#=l$@PiS*d(BI;kT*SFwG1VXh(NbVBrK2llsm5Q8$HMhkTLj&SIBVI{ zk+6%5$;Xl~GCecVBwMAiM?f1x6T)zyr*Ys&?q%uEVdp&ZbouSonJdy#ct~RFjae~W z*%$4_)KbWy5sCCg6xiKm=!QAUndpI51WZqNte!Cad(?#m)gN(Aa{zd`FvGCF8!EpD z*JwLW907vTc~{3a(lhDNq(yhw$KUPD&e2+~#)G_8(G6i_CHQTA4Ms>Tr{Wg2dZbz( znCCpefRvL7qE>YyQs8f%P+7YOlK(iz{iPFlRQOZ$&-M7PKA|=IO5Zqj>uAy;uiKwEX?*|{FYK7`FnMLWUSGbi4A7~cTBMg=*?(nTA&UmY7 zQ>8+r72OY^fAH1sC2H1IE)y}Y-@`m2pryD-#Z+AF+V{M+kG6@tyURLY3B{!?hHnW> zm>GSsp;o0T0@gw1Rb2i(PXzh|*26R)0m)@;AiU|eSkq7;cP5bC_ne*DI|C4`zi4kF zF4{EM`0a_D{HR&pev4>sdo(ba>|}~S%nNpaNVen0ge^RRq@&gxqxwi{+;RloO>ZQx zkY)}xXwv*m7c22}&aj9GPbT=vHN|#r+N!Ue@9L2sOC6JcCIJ9_28-K*ud9sBH^eAh zwvB5QVerigk!-}T$asSXcKlJ1f;7l#b8sVKVv_wPj^`@Q3^MEB4+Oe6aoa%?X5sxT zF3lfS1bJe3#;R^35~PXLmKH<#X`ZQx07c1ma{klEL*XM1l*RtR9{4~Mu#mRA#rjId zUpBgj3oGM)J2=hQv zYI?lV6sB%szqXgRh{PMit0-!MIT$p&6q#moZM15uOLae{ zm&cUw$?KdX0Y>8J3>}CkBb|Zd^h-yz>$cZaF&!uPE)}5;qK+vxSJ;q+)0ZRt_^$4F z;=#CbOfC|ZePb5vj!pVgbfjvsh>S~t4o{!xm6H^^gc67vDYZP8ipvgmiV3R7S1thA zs~1xV-9%Zg%NDSj2ME=v9wwQ%YEZ}KJD&<#(Ymx7yD2UqPevbsIEU~#4yV5<34Rpj z&q-yIKiQ@Gu|M306g&z1pBZLq0a3ZiKuMa#3@;wxh-Cu2Bc+xVV)%dlr$xD82_46gB2f~DH0)<(c?RKXtzR_tqSkbUtY!rpwyw* z&%1dlZd(p%8$u1X{QgVvL7E&2tHveXv>M4ndha$CVem676z)xaAKUYD$6UJNx*#V( zx67!Op8oa?^`z2%5f#4=GN{}?;^y_OhH;#)>)PIo^SVceXd&Jt7_4kY+UxfUw>r^l zL&$gf$2aUeA&qTy>14({&yloMPbWve1E#9lKDX9JY6+9j+YXCGX7huY3}#8#jW_!8o2HqdkG8>lrXvh%|iQnIIi=0Lbla_jRQ zl4JI5v*-GDDt=lI}a1%u{rte}iC9%?|_o?&y=NOx+ zr8KUsp3Ww@ePeg4$EcrF;dj61)3eSh`|9;;x2ohQUx*Rl?^kDA;*;j@_GybVS6X@< z9{pF=2e4u^j~gRDEOVV8M27BOdxIHss275!F1vWzkCD{|*JWEhcv5uH`)pVFp`LVF z8vg3Zwq~U!-F>!-LhZaHPv5V|gSH|#|6G%KlW&!jBcrwG!P8xlubApj<{GHYDqH9? z^E@b8Sj_6Xcz;5kXRYqQrakrs|F%83kj>45CuzBGdlv2r{)DRhSG$o;rY7|up&ATz zkJ+z8IAY@heAb_d3rkaEZPZH4#B;f(2)XRZI=`}hA| z@U#8T?q1`klLdfT#l-4sWv^xdbaZnuvj76V#Dp*Hz)ao36`=QDvH`P(g{LckS=Rmw zDE8l0{J*WN0Rpq6r>nHO>(~1KKc&*_fd5DcYF}ajvy`KQ>wjWW8~~30#J(b&0M7rF z{ZC%e!ra(okA#ZIC1nB)|0BQzb{r`I)JpXT*xQVNY zouk!%+E{(fI9Yi)IKD3T|09L4bMUfp{NGy0dB;y<4ap{9zcPob zvy037?EB3VimZYRyM*b4j95k*)us?q@m`cX3Ok6Peyj+@n7vN0xZtq>vt%$BCrsbd zl9KIX8YXg{prBEty=|0}tI|_T;9s;T<2#CRgrf z(xH5CeKl-^Jp{`J@5SgN$^*lX-gn3}|FZ_lXrGUpcx4D&9Fq)^@$)pd1Al=(!CB>$ zU;_a<7l{1b;5K%`fd>ORcfTj}`F166L=^G5SF=~g_1;amEnyjP(hFZYhlW*&}KohWM^dBF{EUF56e+ND;`SBJdm-KO$ihjCN2vI=cuIcI680qdBluTIvr8Pq1U?+>La1P*a5Wx_-AhKXQ~ z*b~2l&Jg#JYB>tc!fcctYynE+8@;X74@k`jc)%9JIYb?3!Oqh8NzgLGomc<of_Oj6Cd#3psCfz9h){N^N|t=zF5u#>fem^qs#q}sTX@uvoWr%@%UH1k;v9= zYCbK7lgcc1%Pe+;h4{nLHCdh8V1CH1f|WoFw`xe2d^&dUTdJ9l!0W^@mD!&N-|;~q zOS9Ow+Cjc^Gq#j%&olKb7NiY0*L-!~0*EfKQtsb3?Eh8G7$jsrO*)U63iYf!+;QAG!0=c|z2`Zk5Q+ zx_WB!H}pm-^O>8R(9r;|WayfNx|ePV1psU=K{8ZBz{#2s*pn*Dsb zoARg-MaJL<$uQiopP6U!x#GlzuZWGw03EWCOed9Okjh!SCzN)22~LY`FFVWiyZ*^8&P`zKgf9bF<)w%A;K_ev zV5|1a`!YwhK?mRRJ7wfW*Kl^?q$44LUAvuHeRXadBYSh~9#d4|9cwn=pf@p3ul9kA^)mHwjg*M= zEuYF)>SZc{KM`(_<)iG$XP5JC-ay>+4~0r~y6gN#jCV>SWyb?IJval*_}Nu@-QZ&` z)_X0o8ykP3Z^KA++&oYbU&Gv*-I|{Y{}sXbn$~!yPBUjl?s}t-r@Vb*{k1^+b83elXzk09MU}0XpGGBLEGrP}i>p2#Yul*; z``l|oYsy8Z+u~_>lQ)Ka*)A-{a2 z9s%yjH4p@OK6(-M_D72oz_^ozzis zB==GHlAR!R#ktnOL^f1=3>3EzX2tZy02q#M+ z89`#Rhe33efRA1}<_B%_=+@?b`_w?})T=k+qhy9S{{TX4`bHsSd{US=J zN51-NEEiGwlV))Pp=}t9Enu~j$Z9O^_q^x09&AP}$dE?_UlwsiJ{yN?Z0}>Cv?7J` zfmhcBdOC)D9d62uq*#V<%otTnM4RGn7<)v1Qa{|0hln@?@)|pC&n)xFaobxhV2b)) z_a7Z6>x1VhO`IgOVM7qJxV*iPZu<8=N0l<>?&xdOTMSLJk&n96{jmdTb&u`!!@P|Z zIJ262ZM!$@6gAZQojaz^!pP@qMwmqTkppvV9qCId-+kX(Ax#zGivlA!S(BXW#0oJc zWla-#E&*CkRe7pBMqbpaft60kttV$sctc99B>AZ8*v*00t=XOi;vDH?zt>u)7xtyrsfjyV<|%bZ|((A-5MY{ zJ)rerH$2(ivEtk??0TO3Pz*zb`;4~fQ^3%K<9?z%`cc|!DDJ!aT$1aJ-0f4|(!GTE zj1l8^Q^#vf+vrM%&*P9+#oqmq>-o?jq z=H=OS8rl_J?wEB|-eblCIvNc-D#Sfky+!%C<2vX%?m9ST6v2X3M~q99OWr-$uIrp} zMRY~krMg{INUu}$GpM(cMm^^HxaNAfr<}8bvu>#h7i}@!cbYBLA`KJsa^YR?tCr(u zLiKZM!~>nW!h5tT#PDfSBgMhJ7}{eVlWeE9Yw8yT7q#m|RGDTL=@znw2$mQ>=5cC_ zV;}{<^FXs#p#@9L9PuM0J1=Lf!kkc0>DIi9OnL4_j7amk9<;_*eh%}(Dxlj1tLaL) zB5(A~0nI_?1H5dXV3_m;<`w(dJiHVdWv9$g@v2A8ahCTU`^WEJBmP0WJXgxYsk=U? zg|;$**Ku}`gjhlMIr|i?1Uh@jY;xFnT?N0)5!o*Bb^|dAF!+WI0EvS8%mt`$KlMFh zVv6`uw31FoL>fpp(cbroM1!f>iVj=n<^CMY@)>$cIg8LxL+R`)*JQ#`#Qg(4&c$2J zr8`l_0*W~S8SRR4-QZ7vt(;T;FxIB`zwg-d_2Hpn0;Pkwzb^Zdw}^&0q@5KvW2kpG zN`h?xN>`y+rA%yDISp2Sz3vlR(a3ep<@w|6u`Y4A@I{z1gF5`;-$D3we&jC%`ied+ zb&q1%F$e2(wj!1`;-4MRIVaOmwXi!V11K+REMd#w=AEC&B?lxu%+6CUm~S3Cy!YRS z?NG-Moacqi50xrzj6rY-*R6Pu=m_-Amx z(aYO;5@bUvj*B}8pdhs~lU+ocZGvWK#`xoff;J2!2 zJllvqe(`%GbX$-cbx#TW(S4QVdAQXJ%wG5DOq z`Jhq@iRFJr!dMm`lHLhHX8dy5&t|$F=FY#|B+HQ9Sq8i? z%U{kTbhUw0Dpl$;mAYtsOqY3n)?60S5?bn%ozHR1nLub_{=OHk+@_mtZB#x$<;G`c zWHx`o!FR4$jOBK;HWV*bXu7oHmC2jQ!aGWW3>m#LEbUe0%iB5d@@R1q_rNEp6fIf} z)}b{|z)~=PS#OwQZB(dgtAW7epDtQC6Cf5Edn}5q746yS%XPNg2@zhdh^m+9uw~4G z`@om43NDqk@?#zkSvN)pX;9(K#?Gj6{s-n?)d>7b7$ce71>9QS@GPTZo7p}URz)=$ zw`UXQETx`wwiT`yt7pJ2*BKw375P14G4ZXQA#cUTO|KHCq5At7G962aUAr$M zS5oN3n@gsC03N4Fl1i!Mdrb>X(E$=y`9iiu(^{i(z4_XOW!r*X?F#VxQQ-{+og{Xq z1V+`K+tfnCDt`t=>e|}?wAwk6lC6_WJJ-2k2{cb9LSbC4cOgWn@3U-Ly)bMepX*F) zj_(6cULAocUMN+}Ba(oFb@2?mw>@3vmbQrB7*~(kr zT{#Y1V6tY&?5X9VicqJQd=gn5Rl94dXVnCu=5;zz1H8gNK*phJ%?dOKYx5|5c>Kb;Mz`G+DL` z%@9dsiWFJ;Baws8I8!sa{-BT6iXG=a1N3#jav1EdFGc12P}x zr~~nd`-dR5ugo(r27i}7VBk+Qi4bFJI+m`XnwqM=7Lkl5li`me;6Zoy^%1Q}B2@*8)2{$v%aK&^_FbtJkG)API zOiGL#g=u8qfJJ0~ngrRLUkezCho2C!z{SFgHt(9%)Ksi3iqR z_&{{DfsdQ`MFMGKu$-+e@UO%4L1SZKqqrQs?HSeLg5~NI^Wc!4#(5Cg5{uRffeRMS z!mg;rYl^&1VEeu8t}ZZ$y$wp3!B8zJ>+{x8!hR!y6jD0ox;LVSkz5K1UzPjEa0I%# zRLpRLk#`9r@9Zee#Y{$VLc7%K40n*r}KG1zmtdJn-{UJ#s?@8rAW!*wqoe-i zkGZ7a!yCsT4%R$g%=JddLW+qnbY*ol(~hcAMYF!jmgc3cOc@!Q`)&=`9KKk z-RsqF(C+B1?9D2%HQd48Sy~4%zB1kW2cLLW;Sdk<+;Lm(qW+z_y_zc63U?-WeX@M_ zX4#1S+<2!NrC{xcayWp5#BRI+b7&)RnpCo10m(k#COgbwxO+p zKMghNbUJ>i$vzMZ7=N>Kx2$F_Hs5$j)9u4V_Z1)HuB&7Byo@nyj4PZxb~`BWWpI;> z6-|R#`kS8+iYxX#tco~GA#D*O>Zb={YVR+)1f)$(*IzYqO>#`pOBi=RF?fz#gB|F4 z6)1RygsZG10OZ;{(J50Spv?EQMOTfx^x!U3vzJfw8i6%e7nfWCec!jVLvXZA?Y>|q zs%-XQRdKbzz4|dgD_i4SlTd|FD^p|GH>yQUje~X-lPHR5z-xdi)T_g^BdN)nzrjFP zbpEx$xw621cCBii%;eEQvgUrgl(HwK$W2d!mNNG0Rt%5P0 zNukrRy=lZ|UNI-N^Wa|i(llhR)10{&o~tIVC7cmfcf0BDT&@V&{z<948Pv7^?i=Qb zS2C27Ud+|M{y3ssAmOGMi7CR8F`*u$-m89FWcPalbrN-IDx*t>i;9OzfXZ>)Qpc@^ zPe1E>hYmL4U~g^vvSm8=F|zkvdxpiClrZOO>&%<@i9%Mt3x>`1e=`AwE1`gc%*rKziNs40-cb9cWLmQs7CQbP*N$yQh2}s=mU({2-n; z9?T;ANNSSm>W~sHlFBj4A6h)$h81jd(O{u4a%oR7%S}000&OpW=Bh#AMxX?vt&=6x zn|iO67WW5^==|TLtr>eXaji*<<^C(>ImZjA_oue^=8!#`xxe$n^D{_ayxMAsr&PR$ zmsH{z6SE~co8uv#WXh;jgAM(aO?kYmyuJ}kztvLT*j};k!}d0F+}bN2M>G%0DJ3Sd zVS}s&L9lr6deg#@pA7dTp-}MoptbCNw~BXiZIE9K2nK>q>(k`N?gLj+qQFP4!q?Ib zq1dz<^&XR{&+sZ-Z1YS|FjSi5VM#F5cBU=A*ooNd%&XTf0OR4JIn zf*ddF#2Knd0QF<%WE5F2v_ebp>~H-10~G9E9Fu&XFsR%}kE09t+tl$ufFl_}kk7OO z9B@k{#^>4#&dF#2qa8(0)ee>9#xHfb&ycW_bTAuvQ#q&SDI;K}D=AS>uif#&bZ%j9 z!)RH$m%qai=E>6t;UN)TaI+)Smu}p%swO^(Xw#l&M3zB*MCnRBw7y*#=I7-h;4rU* zn<}au6^i=j6{1=Dkhj4OyB)3*W#}AoxUyA5Lu>-OLjRU9yi_xA@HH*aA;&D|= z`g#q^UnOiMu5`#D?Kj(im z5Ro}AT3a7Ca-OqiWGrB9^}y#)dZ6qgioVKiwNq0gu5b&mmu<{n6`0rHt@zv$(Syl9 z5{^3#C6QLTy&SBa7}+{#ppe%F{F<9hBb@Ba+LGiyc@KLvXbAqvIMFujvby5LD^ERk zrZ9^Dp#n0fZcF84J9Ix+j1VD|MT{9rL<>Z`|Ri_txN_EEsFi413nx(-7u7 zu~sC@e(Jqi_!wsF?JIwkUw(?ud}@2q+Igz=kuj)MJ9w&X6wmdUaW3`ygXXL}@nK>3 z)l0)GhFIe)?KMKoGrww>z}`MGnQFXnB#infX7Jyls#GW^_N^)<=sYM?Wijj~X*{5oXvFON- z5N+s2;!oiJn5RD?l$cWBDBEuatSjwx;1Khn!clQ``i)Io(IZU*YEBFrSn#0_(}MD$ zYJQ~XS3HSeGr?pcV8VH6M-(%eFJQBS&ciJVP*)(}LVWjwL}(m*QC_~Uc3gMR4P4%< zef)(%&I`-OZYX6xXF^n+ngR2YAm6qA9Q!wCy!!(NeJ1D`!#ogv2EkH-z?^gy-5&~8 z8$HWd+SS=LnEV0KJQ$HRJRf#F!f;sXp42a%OAUoATN6EaTO5hh57y+G{7?*xwU-rD ztkm&_16ztAK);_x0u7Or`2iVIRLGPS6EMg#Ncx8l8uBk%EmRbmJnwH&h6iPua2`|W zp+FWeXS9@p&M-L|$%-JC{vJXMl|UY-8xj^w7&5IsfCPLQnk|~L7$cHYMKF}9Ad;w^ z$U8q$uucCCfHZEK=bMe1e_ux(b}jlTnzXp!F6DFrA9!jnOFt_MVQu7|1q;~&mOe^8 z+K>w&Y;44yiR-C+8dxeoX@42X3{CGZyz@8x->(pUJG6~YC|RnG17Ly z@DUd*=+1PztZ6V45pyQrc9EW;cNO}lW}-4;cnEaSkDM|Q)zxx(u%^R!P*>5b_dT%` z6p2D#SdeQWi^$!3k@}%o*xjJ8dl~vA332-D`YBmpZ*0DHXS56lEl7u?OyTtC)q&+| z{-Ice-^E~e8>b^%5Nhb5gxsb?7_4kJCm=+ec{ACaTm!yVf;d$;noA6 z_4-kb+28SRR9i4^SX&5goco`4;9FpCJe-(!v0G5*nq7Rp5qGC-^#w;LJ1g{xN30o( zp91c?rTPt*Lt2Q4rPjf_WIJH_chLKbc^`Wm(LH+dOFc}uhXk*2ciFFbc1gA)=W}*+ z;--4A`#Wl|Zhm^QJ)pFA-w1C%MKFtfyP@oF-mzE?dzL zsP3DKa1e=CYtmhA!miMGw65TI_3G{?C%7BfIN@HC{+#XPd6FHDA@*xpQ(;0;g`S!DF;L$L zXoB}ce)7b~MF|uHe8tI}>)Ouzgg(08%bbe`DhW^We(?N1j@ehnSxI=1_XGFneu}r) z{|f`0JjnqnfntEKR+)3cdzqhjUn!nql7mdY6yU4s?cngzb=OHg>e4g#y=YPs`mx_ z>QDWZ{-XLn0lxs?EBIIcuhVU3cIE(I{U%S|c#E%&GC!$~?zz7>M|eLJzlvOx{DXn7 z1Yay)W^DeWA!i9*uR`c zxa1zEtwh1)UiDFjEqw1+E+BrSFw_JGs23&(hreJ#C8655K)+D(ckUW-L?BPF!^?bx_g0p7A&gaS!a3WbfI4BnrFR-~>IqhU;x%&iE5>m3 zExqy%-eJ4M85ol>I@NX*{fQ^{fJF-nsRSEji`MJGmp8xSrjhKMY@!uP{5srXSh&sh zcPp7vBuAywpn7Q-2{*xxDRrZuRqc`Fk-kSlfxET->VC@LGD51$UhwV$KDm|cH%y68 za)~8meA49N_`)RwnS{&O7@eHF-6BKbHV#vSN@=eYES5Aqv4oJ{ zyjcsHnvjFaXP|_AM&^_<7}SXMO_0zVm#IF8=AW1!|7DP-+O@-+8I@PPLuI7RrDn#q zVeh9`sMJRb>2$%@kEROeF7xCyuU!Q)(%tdw5+POqN@c+>Z6JATgMLV$R%noJ{W-DR z_jPu&kKls+HCrzIQ;%5P6=7ikufuAYC;ozkLZrT!f8Vk1kQ6&C}BqjQCHr?AN)4O7!wPWCSggkS#Ro@P zqzc=*;{~15vRUvxY^C(Z*pcJ!rR3&9b&1${YFsi1m4MR1GM7dT10hL8uCg38^#?`1 zBGKLEEW|ujt|0ImmMiiNlE5?#b$xyHJBXp(wEorq4>v%_zZFtP=un(@0WO!+Am8Vm zRe{spCqyJY6|yL0zjUTVi@NNUvV1~ZXcIbwO~PS8A?zVf(tWZ%GJo44*6WE=?6nis ziPiGr=t}WLrm`eR=+J&^6Zukp`;Qakzhi&2U{vau@U(n3T45pB-P5k}^$|snTyABa zUhnE7M#-#pL9UcbrQEjMO}U42Ww|DnY?y)@@G9KIHh~efY*+8$i-z?!$GzHr@@FE&(mRxI)q$3vC*RrTc~%IJn;WX$C?8(->w>Z|^pcO8BH zyZ&R_?rLAKl~f*kU}4-pWNiO~D5H}|gbJK78{8vhNsczhCdXli3>=b!EehoM$WS-R>jHBt8orIJpRyVg0$M(0yb>f9}q;>6w7 zOQ_D%M{bk!p!n+;%M{Ce%PNb^(npk%h5grzF7QddE}zim+vKA@=N|F{t}{K6q^v1) zK3zrE(dX!XdWim=s;JYuo7{e0pN}Nc8r^ycE-R5OtP^KiJ8>)M+@@gv>EqMu)Z{t! zel>;G&X(vAMl@V9=E_Pcri*M}>AcN}`7MUTYEi!OMFTEL(z&1&CC0uei4wtI4p3f( zqEaY>6`37Gp`=QGNkzp#Vat@$hel|71~|=YVo1qq40;rUj&Ya zbt6^zedN~OygU*5=#kz7aT4zn%615H(MD{2WaEw;DHm?u|blqmxKpg-gf z`(+Aw*pQp6L2`-7il!2e5kr1$WGd09ixu&y#H-I?Y$GNzUu+dzhabMi7C>h-YN_Cy zgL1NQVfiy#i5(XoW1n))J-NXkTZc@t%Gp)hZhT~7?e3Lb9e4D9xprF2?{t}#+QS7i z?+LoR(Yr78joCQjy0!;q%SNreYwnmycWxN4^P1#!kJm?X3RUuIg?7WdF^z+A@@hPq zU*0%o)~ZLDRki}9+l|t7;yJdIESGk-;1*r#EiH)5FI^t!(st>(TwU(#!(F-ErB66E zyB-Vo>bAR{&fODvN%NBSJ-tl{8luosmpWq8+g)LO*w9FBB{%4AGCTo>!B9mSp^=Qt zn?imOnOr&-=8`#dR_@%$?9yw*QU^F4gs>>&@%3*4gfr-L1OQbhr5d z+oQQpMxHF~lkHR;*M6ZpZa5w}UXriWt0PrVNd}e3>s6q0MPwXAJKud2@*?J0^f@(Z zVniO5xQk<0Br_!u%B6BDmA92|DnDENv&7R)vxp5d~_6A$p)-0RdqF`P|KgimLTVH?T zx3A3GlB^v4!M5k;O;|<-ER~kboY_@Apki#(ZCB2_K6g0Xa^t26H$K<1VDyG7)?7NX zbKSmW?F%Pudw1T-F>|h7GNx>HtpD?2o7=8?VEM!mm2+`lzbth`cpP=Y4iTc0O0S8$ zFMluaend7~woJZKwOoC*ZmE8mR5Pw821YBF!31V1PNff-41%kZk&A=F+L4u(d;t|<~}k*GDE(U-<2;& z`EB`|@(<_B^2u(Lq92P%n&&iBitt8$H)u?6^49T4_XT*gn&AnmebjxCrRiFT;nCOFy8o^tfF zD%LwUp}8Z0QYV?UM#+liW7&G^CM&f*L&D&IKcSV+ZR%5ex5-%4QF4I+X}Qpt^fMC@ zU16-Imia<5ZB-W6oUzoVL$%D>yB)3SK4BYJu)NydKGcmaS3kMRT^oEmj%*UVoQg@W0}AhL~}Sf@9{j$ZgFtILerKgv*JG zigaEyVBtTpxrr+?_+S3q_!hQF>9I>c{`jwEIQxrpAWz~6F&n(pv5m4_Rx%T>hk9}# z+mj7BUgF87SJ)}w&j4ggLJXq8K{g@1+i+TbZ;DZBNk&C zC!RR*x35Sn{SjBLe(^;S-GI1Ta;pqRqh8c_)ZQk)!fLdLE|bgc&UWM|{Orfc;d18n z#+%EyA1&s7PkuVtmzz#@dD6*tp4?;Qo^+3BDbpLZ*m$LJlyR6i(lf^2Vw@-edzOe@vekxe<7#oWd97!S_W|Pr;(ewEJiCm$#6P%pdG;A!6JN=B&GVu0p!lWn zn0UcK;Z$D6YmAU$z?WQU|viAKR{v#C^SRdyfwQBoVR4&7{! zOno%oJH|siee^5I;FAnZhLZ-t@R;w4Zm!)<7iy2gB_cO7n@Yq7@l$D2~eU z;Ig{aQ0$1VMvE!x0PzG7_x>xc7FWKQP$uvn)4JC4Kf7Ac+CuzFPP%9e<7r?ZDJ5yk zm@A`}3QwH*=j6cPsr}=}J4=U>zXZv_%GR-Gj$c-pchzTKk(b{c6Y<8B;jqyW|FvxL zPxr35Odbx)iv5LCh@OVde8l$O0D$Z>`DpM!6b8|iQhX9j@~nk5p0%a-xgLsab#09t zcYP80Jf<52%OlH5?=QKpbaUu;r3YOHBM0*|vZ_A%d9QI+MHSPE>_8dwrBAK)vQo)k zh~V^;l}N!n1b0qZeW*UX*7ZJlH}pa2(Xdh$B4K@rC|DJ4SC+>XvgKLh#U%})QDqZJ zvvX49ZfX)itQt=yh1#k*s=BH+RjFKYS4k5HqS6)e_yc-oayKnZaEA6U!E%rg|%g~P@XN$_{ zb*udW(d)MPgQX!5WQ9;3^@fB%{-DBAp*WCNUaq#~=h^KxTAar;WqmHmWolnl&b?aZ zb@f))l(A@U-7xM;S(rY0N;c7W;@LENye#S+R5*ZThz;dtNw!Hw0pYMrkg-IK-c$xM z;*$|P2)`wT3l$a%9bc%!V-})bj~GB*Hi~q-(Z{034V6{Tkhj1O?ZknM8@=>Y6wg;D zP92peMIfC?f+(g@`-9l*Hx5r4Y^ul!B*3C@;lB z2%4XX3pTQ}6-rt=$$|w7U_s|OV+7b?B5igkg8uT-l7SWc^oRDRpV_3C9=5T)Ep3Y^ zO=%m1?|Mq1=eA+(U5AdI=_(x`w&z4HDW#)+JMHcbE6!XKo>FOds8m*8f63L4+kTqweq`yGJI1m9 zdY8bc)F*Nya&?GMsaEZYkr<5$G4I{R`#g^rA2IJVK5f>jJUDu?Qn<#t)OMTDZF@+# z+qG5LBdB$PK}K^%2rYspdHy#A!JE)tG-OwjA?)2R+&&w7_A3e0g6itdm>=SBs ztkZAQQ+=NhlVVwFx)lf^CF0hnOvG!dHc^vHLIqSOd=6rCcpcQi)x$9|JbfD9*P^Wp z_$|h_3p&ww>}2~Jo-Iy&R(;~DQ%E_?o_v*y*JpJrba(l)dHk4*l%m)gP=}a^l__ zUt8v#*?)3R|5LlVcarKq{CZu1*`4Lm%CG1z-M@2f|2v2J`oCV^`FPfj$A8>?dLJ3L zXN1k-jKh`Z!6WG5TiUV_x3b!&5O7Vi@OEXtRNOR`pr_ge0=zUqE8=N(byFqyM* zJc80nR=d`CXr4;pb%Q^k^t$!_pxy8E<{1on>ddp*K$V>sVBpty`!NWlz=(qFLXy>cZ&Zpasrhrbw)u`Z!3KvUMYzVYxWWd(q z8IEWhE{J~1g>rt$Ri0g9*)EUKDu%OiJ;v+_#AQXuF?lBtx5YW(?DVs98?Knv&eDq) zhEHa;ig4cCio2`I65+_5R-}-$2;ty9%I7UkP-#j^KVR)c_p)hZi zuQ1%*|LoiSN1uIXYBm{0?8HgxbC|9d;C`?jXS|eDNYzsLtn90^ABaEU*c#sxKU}Vw z;OtOzC|9Xgsk;iuv_Eo6VRN(?ibQr`rf=g`Q5Z#q+MMG)mYtoWQg2nM6kDs=DH@cba*R^Iwmy@Z zcw0+~w-!ddMKP>8&$ZQu7R@2I;2zsl-hqcIp&UdmDv?V?L7*-8o)MamT6u)$!ye0=}AV&0(7 z7S4_jt;t*b)0gph)Ms~v#>Hh;W5ilok~c$6&m0RDFY3>mmL1INubC9F`(i^^_HPZ_ zMQNJQd7URO-2dJcO;#h5s2?TD{(@BzDcF`5>mwd%V0e0kTBg<{W5T`B-O-n$?+b57 zkIRm0evhg3lFZ?WIb4!C8;bvB(VfCImq076lb^{@ zdVgy@Cp>;A<7cvHMtWz?`Y1wVINUvniHQt_SWJUK6P~J&*h;Mz>`Q0mhxz1@@5YbO zhr=Y&Q2(7?<1360II}xGF4v*gcu^^Yf9Qj*h8c5FXkRwY?=K%SD%?L|mfvZ1gu?@T z%Y}LAaR0kgTJo5@M&NGqJKSx`NUJnXBO6vsoe@_a6&<3J`YNP~wu+^y4o8P`X~BBO zdS}v+bZU!YOSG%Cf}^6?)l|_@ajWb}+2IPAPPkdSw?Y`9Lb*8p889=c1gqf|HG{zALM5m4k63WmIZnnb-G9h-R%pJb1MO|mCoGBugko2k(}#!MM^t}>_0 zGP8_H!;A!aWIHF&KKi|+)g+p7i80rkOVJQIDT%C^T#@DHjx3+voskt1BCfMol#7Z> z?Fc_EGAW5?cd86amieMeQ5DXMO5cKp#X9eTKoHjwp(V zHf$)$9H5zH&ac|}78d1el$joEBSR_rn2DX<$xO_gDEC|0DbH#`JA`j*xNzBNFMTC1 zJC0%>x9r*eGpjrA{%2R?tu@}7%cgvma@Nk)B_=aq$q6vc(HBRdf1ibESf1u3kF7^i+yzZg? z0QI^x{-DL{cKd_4aTNK3bNoydfMYZz^jmqh%Y0wSVM@ULu}az`n8-I~Q;= z;9uTmPHFh0so<yi3`JlLZNN!HL+(9tHey%!xDX-k=Z#PY^PfxW`DrxbrXM3?RA^{L9+>oTIFz3 zrZr9#(-NnQRdoi`9jY$XVU>_lk+`Z!)us}rsP?K3s05Xa6;p8yRQ094-_Gh{pkK=2 z20**7!{6mU>=)wxCV!h>*y}&wr%Wi9q9iy?CdJP zCzVfW_#!@K;nR2WFqmz6KCcuuohueuV5 zS=LaD(^Wyo(;2jju9eo)`=nm|cEj${-F1J~zgMC+Yl&c>3MwzT1y+}AfURVc;jI#t z7Oixka-CQ0(HB6N#MIU5G3s04<+AtT>oTKS>(s_cIW3iHrKW~Q$s=^Lw3F`CBx~P* zkKh1#hrTO(315>%tRi;jV8zcE+#(*c`X{fh? zHBJq25F!qn)9p|=RQb8?$lwTNs($7r4(v47$uG8IXA*9yQlVG66>LZF2V!1#oU(^%ZkU#fauF=vl5~>3Nl&}SG1SY~75`sdkD-|!4c z@MEy^>@oPP8Gr`B0`_GWTk#_9F4bZ>cqSp9f6@`0q1G7A6}zrQ$F6YL4Gz1&K|gbS zgS*N3o109e1<3hjU{d>U7s50a8w z1d;f_N2I_+I*VRSyM6chp78DR=}4fD+%A}31Kp+}0gcx!`hz~N z58@z!0H0@@M4BC>f(n=2JlaQJlw!7jcQ{k4HC$CRJXOP0MYF-*-g@3pOxql%PVuiq zajhI_Wrs4h7c9WNfY^nfT|-!NGur{T=PP7)`xpK6S?PqZl^?fe&YS2HbtN}Ud+^%X zl)C!XVY1!$mW4+d_;>Bq$QhbfG5+|=p$BYhQ0F~X~)aM!VjRmr} z(maF=iM2T9li7|dW6K=(ko#l%93ME2kuM#3y#o*Ciuka&P~oVE4|fQ*c*Kz#7ZeV8 z+-?`5kdLv!P-U-llsn7g)g@y}X2Wt=;#lTf6z_($j+^55!9DRO;L-S|l4Qy2_E#Ny zOFpu{?>JC$!v2Nh3+LgIZ{bJ#ck%EDGSWUQHi@*@C&cF3mpWf|ycB=e@oxO6<7nKF zzA^K8-7bHin6n7(=_-FPeTU}f48lxGAX(sW0&zMVj6R0OV_9*BJsxw!NDRkrcR8JQ zs%C$qD;|&Jsp7xDeasmv4)}cjP5z{x?Hh;v3jYSFgp?4%2+=NG_$zVn?3smrgF6^b1AFBCCvhk^Lsz;MxD5VTiJqj$HXjMHA#b5 z>2R1T9iq7sRE|n}U+TaPd!;>|Rhj55In6MVQSc4lvUV$gQx8`)2O2Lq?J^Yb?b_{EC2A)nuTR+mfp#K-d!SpEKZ zfb0#R<;pEpeq0E!gM)_Ku+F^p-<(~w$mO_h&)unD0){_hwq12v)+bJ^PKz1vh*!x) ztP~UMXwK+4Pi=OZ^GP*Sn#aH>^Awn5o)2@)%gqmvC&(VM!@Q6DNX&nygq;#v0MCJ) zb?mVz#J?3i4u6L2m@wjtrCn}YcUCDwy8PCnVoz6P3a|X*tpH>Qnv#RpbT3P++Kb%vXry2?^?EhB6&Yer~+^GXMY?B7u zV}4xugysoRb~Rb1Tus&}Wpyfj9thSvh1!u|f6<15APVea2x~j{4IZ_VI zF(uev!J+A|-$rIHDziz9ny=zDTsUefM ztYP<%>|2s3x33Gy(p^xDulnn%@>ua=$0GNl>=k((#dl>ZmpPse?auqq{bBY8A%!y{ z7U$(whASh3^Ww#mB6A`g#a+ePmw~vl^RpYX-*bNGmOq|HUJJc%{~+{!{AmsQ83v%+RgJXg;7*tvd@@zIMRVh_waEY$COLBF%Z`i?s=lj_>SOwx>F$~7$&jug_eBPB%_IyN zB_Jr8nE@gJVn#VafHfncT&sx(x4Q`;#{^^)Z$^U&{ zbx(r3`};Ua)qC~oRdpTT`zl?EVDgigXNpJEdH5AZDMWO3DrW>IjA31d~IjE=0_Fp1IF7NuSh9yf-5;ROA~x5Aw?hHBOnROL*SKbCd|+MQ^ZdVk?b^rUt)_07WBq=!{+MRzA}O+T1? z7=4|7B)PxveBo#1KNQXuY%=9V0b0&rENky6_LQ$oUR@H~csdk9o@me!i&I)ANMYsL z9!q$^(vi^Vyp~MHY2?O=b@CguN^@=5hlw%V2bar9Tt7F=F%#TAj^?P~H$v4(^f}$p zkqL)Gw8L)4Y9uccxB7tLR$sKbM#c8W=+#&#qGN}pPNa8^be`;FI;%XvY@R#^o?tc~ z_j(9sd&r=NV7BMWwGSO5>d^j9;y0_8|lV0&2syf3sz5>c&?C{<8<1h0zme1%FR%W6jjQ7y>&^rz97;ZGv` zRU=`2SPwdV&|S}fp5!JB6L(J^mg;56fmtLnI3pIfa=BOx5tRSGkpvF(Ce+a+3YaFC zubTbhY^|c&B2p-|vPOsl5#G`7e|BQe*PcYm@SR)VzrYm|zWu`9TY4_1Z=?~L-S$Be z(Rlp&9h0fqn{FSl()XgrKC^SL3+xNyXMbffV>;1IZ_xen7xKt~9JGa@9HtDFHRo2N z)wJO3nM8~Albzk20VZhLtZepg4r~sxW}DegwN3SyuCrWcyUxDNF%lVxj+92qyZPHK zyKKAcw>oy^9y2{wkz`xNR<+f_m2fp&12<&Bq(;IEw^|^2qMd@HAS_^irRo42~1_nDWtz25Yw03Fd#x6T!v1DDAU^Zb< zd*)@!J!A5iYj^T~?*7sP<;O}>nQyhdn49W3-Q&K9?+#L1>EM3!GNRE=)bwKNw%UX3 zpha%Cs|y40tz@9*I{Gih@%e zC3LCeeBMdF=0vJ;;!wuC#qbx;zK=0)%-iHA)dJ#A;C-byL|>~@ z$LG3w(z9Rx{L0t=<(lo?zCcXG5>al~zRPxAJioGH$CV$y_u>a%6U>cB3H|#$pBuh) zW5<>G$ak*0d+j~{QS(Pj0QvK=Y;=IgMt{_MHlmI6#_-0-$I!>)8igZX(COm>P|pOXB&aAYIr!KlJ*B$@l%sT?y&*gB>H4Ytm|srP89l%Y zgw6?sqzQ!132~n{nu`E^w8IfpM2c*V?2DKp&(Imld-fgO0#wjT=${v#{b_Z}km2k* zGXw-Lf(fjp1}8XZaa8dG&YhBao6aM6Gn8(r;ia|f4I=7*$rwrB1OGW_eTEMqWw?mW zqeH|H!zEm%uQ*Z`SM(!mpT`n;Y35rXo_}p~rn;OQa-(H*S>3Z)>OB6R*?XGJs zMf2gQTF$<1ehNR;BD&=mRmN&ZTd7(m5m-sm>TA8BYKHA$SF+n3CM}_*I}#n~MTte} zhtpg(T~E{f~wsh}Z@i_|EfEIMa{W(nU(VP5kA(=@@qCI@2v9lc)Z&v`DM{^2j*D65Mg z9HqK8=?|~mbJcA>UWGZ1Ijw06qN6jv_~Ea<^5AC%|4hp}F4DAGa%|?Q)ju3te%;}p z(b`TGzR@aUt?XX`yJ-24=wPF?;TbyQMG?t1$^81LJxY5yI~F9sPt%ZQPM(}XB?$Dh z%2Et@c}x9qFCx-}VubKjYDNfOzC>F67Bx}*FZsRb=@|2j@0jvz;6UuJocVG8Hv-=@ zA7PJi<|oXLvX665cpmkdAL1q)6Y_)JiJ19n&lcZxrtRW*%)HUN!Pg(Vg1wqEZ{h~| zP2y$tL62FF^;2t^4dykhS&daq-JZqNGP_x0vs{MHcrsoymLOy0*l_G*%-l3=hbVhY z6}FQB8%qObmIVN=d3}&v5_MoPi=sJJc+ZD?zb$)p?}YcX*W`V(?9n~_ zo&%oK9<%Bh_KbMOJtog2{q_+x_Qe=P{$b)V- zlt4g)(ij*aINOJi!3fed^S>_DYT4PeHfu^t{$=y&w#&MUXb|b8o<(M>d8KBHwO{ex zr%a#Q=#D1LnkE#J9Up!FH;nVTLbztZL;)yK@a(U+9T)=ZOvHe_BLeEqrrb^pePH0A z({xBE2Tc~4w(u0V3w`wl0mL~_^b4$wv-0E%1ZB3)$#%t6x8fxTfXEBgAjHq%HiTRK zP2A}eYNh4EplLvORA5tVj?Y^%){H9?$OhXo>Gn>x9;lX=unV~rmZib9>;N~w4~hfU zfxtj{ZTr>i7Va9$Re`I5AFFILZDY4_+r%3zH(75A+z{Lmx`MxYTqrGx`Wq5wnjfuFkQi2!CxgXD}Ebfe&-L>g zEsTkyL@Z{7yrs5KHrmeBEiHFWn3Cu91j|CmWN{i#HYoF)1zGrdS_ZJkaNkP+|AiOk zqRE4LUI>MFK@dY&?utZsip7ZF3b=!=Oeq`8$X0xobR-o_*W0^;^~tj%PX{fcI(c@h z?k@A3YPDG6K|DJc2!$eoC=x?lFoXv}r7+LO!BSf;wX+-tdqU-QyxH!O)0qrb@+sOP z!dFm)d0%E9ZpZKJpk8Y?0wPI(W2#WDmfOeMC)%0S?VH<&+egU8>+Pr8`Sv&Y-wKyl zf`P3taT z-Y)wN1M|*x_#Nlr;{T3}=dU@*-pk{EoYXr=48q1ArvG57z&Hm8>ds`mwnhY2Y8kJh zifn06O;^p(Ao9eU=-9+agFO(GbfrOUCXSkOgH1e5)VLkB3nT8_?CqJ^AIzRe&VIaL zbuXHS-c@Sdd1U!jM#Wm3%kOt(X(`!VEg%!3^I>o50*t|_YU0-So@Fk7|4XJTKjlkl znpTb{J~hM9yT&$kq+B+cXYo+BvU4U%zkPGrm*MRMs~uRM-jA`m!Q`79#cAS{AjauK zY)@B41LT%c&KOlRrTpD=iuUs?Pc`r#2`>jWBfUR|;L>&{viXHn54wT+WXvo_p?s;` zQ7=jEy40uV^ggB!0Ao)yQQbz};Jh(DlDo0+VElo^Bj^$7@z~?>#}khf9xpwccvgEh z^-TAX#!J!*!57q*>Qj9`m4B-K)pEKoB$p&rj;qOBrdTRnAeH5^Ixp6lF6Wj|SWWL! z`^tSM`%Etu&~=5IOSk2AmrM(CgVwuV0R%dNpVzgBUHeYQzl*#wd7XS zQZeSFOk{=P_3mznn+o{-ENkYkYM@4rLRiIAQ5ju|hS3N*fTqyv=rj`1B>gwtu~1#3 zZc!PvgNpBq)A33AJ4f`sFSZct%n(+EFbg|BAflO71d0&BBzqI3{vq@^f9=43gJ5vS zQuIOmWH4d?DxuK@14l|I8!ydgu&x6V_SLa1xviz)KH@7ySoa}V=D0F_bvNAxUeknR z11tHPy31NmD3*E=FNvkzdaCS&@u?%;dOYI=&iML4Zyjpp9fFJL+kp0n}P4J?BP5awcKAeo6YzxG9KC#qg0gSGU;SSE0)WPkzT$S4R9MH1DXEv zwd}RrwV7+%M#|%8oV}I1H8b8eUf$dGHS{%lU-@|Wr{UMj>TT>UZdZmu934c4LKsb{ z!6=m}1}Q@|j40t?B$-ltKCI@tG5B*l59kq3XYf`=N%=|{uFPk+bV@NtB?MpJh=3~T z^G=@q8wpAAw){}g(H%q+jO)BW6EzZ#9VMFNH`Fvd1=&_p)8(|D?oW@T$I}yOE5E=mJr>yl>su+lbgu7ra^!NV8)c?SHu&Qzr z{X7uZa!K#(u~6!g{LB<+sIzxpSX%B*(F-G`)fb>35_`j)otW1Y*MDecX7(E`brto| z-CH^mqNe5Z$;)O}ps!w54CVb`tzC9@n%T|lr#h$$m}SlECbdB#k{UX^8BdTaYP`h) zHe49hC~L*QS(#o}@xm0m{Y#>ZR^a7%;FVR#+)AAzEmt584^_a26f0E3l+Bl`R$ag+ zwd&z8tetq5b@J>_^axC{T1`6@q>xdC%upmP!u94&RB5^~jb())xlW?nPLyWgb^auG z0+sLvApuiUujX>crJtODFr}cr)e^e1Ld$D9k*r4R$G%I(x$mb+?f zSoZcvjq!#_2(2`)WEZK6;wyXf#_ljL+BubqFGDNDWtL^N6*xaCp`3hC-EoKYVXR&w(WvHf(2z6`5QnwOsK~GJ>vJ(vg)UcINNwdvr zvi2(Ae#~0xtCh{lR)r}kI~7{_6h;%c<8rUwOXJ%ffwbj94L`R@X0h%xS&CByR2bH% zip^@RR`G*>AHM;1UFBJ*2Ty76i}pIDMYVBlLNn>wX^kG&kS4(-?OA#O#ZewC21e_i zN%Rpt5-io*Io)1Yxqfb(VA1QR7>55mk>aE zz=Ab9OT8-tt%zF@w*qd3IgfDbZxG+7#&WIP&(1Exq|JJK?zxOahzs(NcyowA_ZS9p zU^^sZmtOKu$<7Nl-xSII;GGR?8d{1jrL@w4y*FMoFC>dT_~2IW$d&Cq=)U~wh3mUl z-uiK;|1%$5(7y17^~v2=#^d>(Vn?;Gej*#aFn8PR_imZz=4`#)UtIWkG}PmvEw#g%^8MVf~T+Mrlc1!(qgf+DcxZfLNWLh z_&7KQj*XbjDUE`>8FrmQ1N6e>{N)gANBi`rF~F0!>9N5<)T-@3V9Ri|rnQRG={@IWVbQ$X9{i^tfAy{> z`yXEKP?b=d9k~jXkJmSS=}TK`wG934u|NL%nJl{fVd1 zx6pUF@A}{3PlbM`oLJo`GO;w6d+1{J1&0GBab49CV} zG!>I#DhZt(iA|gr33WPVi(MIh&4C=>^=bka2FcZ3heq#~>-Z)uu^&dQXti~Zm9~~7 z5;HeUjZhQR0cwhRof2Sxrk=Pqa7%#h51_pP6qrO-T|Uhsij`QSERvaB5MOYN{+!`H zfgG}-vC)~)p;My-ta7==^zqEvxi(S)s3iNs82S%m-786s1}i1`Z94gpnQ|4%6YN1)s*^B{a-y0)mCF&<(9>ayamshCQH2X2~3KbL={n zEfon>JCQSp8-()bfLy#fG<2c?d7zlUVca-ImCjB*y<|zX1SoQ0u2>x|-E6wqe5Yx= zw7)b};`GvZiKa^4HcxJyc^$tt_eG9d$|1GXB`y)yi}#xzZQEDkrb?%Cw5n2S>=_L0 z7R&_~^{T7Y%hW5yYt$Rnz0_Xy3GNv8Vw)w!yVBM^IpSLA38%e%p-6aP6dz_Wh-J)(Yv(AV!H#|AM9m5AyCw|N-(4`i{EM&uoixo1Do8%e#l7S>&0$W* z*>0s70q}&yc(S}xSWGVwR!7&;YlRQfWAtvqXGAxD zl0y`ClA}kVg=YuBB?mZ`+hKB3Wv>S=)g{;E&7Pf}y`I-RCXXlhACPH&_9SK?;BPo+ zI2iP$avh%Wr9lL5g!>`y%>?TXFWTze>D}XHyl33*aYzT5;OR2IhkuP{Bwpw7o$v?v z*LjwI!tOCqy8*74ye^mRP&a{r&)=$c=CmEz;YtMjEbR*-3!0J(RsmMcjDpxQ3ZeSb zSk5PfL&gB4a$`>Xim}z^?d*Shu{9=kq2L#*@Yf6Oa99{ z*W5zS`{8xhU4Dam_pcE8`P+#5!4o|L$!`7ASRPtUQOu3zyQv(_H?dnQ5PntAf$bEC zULDLK$<89)o<%%~@RRYg{+%uZg4$(*`bMZ9`;3wArHg!0i})zYk#$U>;6a&%Dk9TU z(p2Nbv@~rnr6~}nk4rDYzvCo7r-{hNC5PbzP8&7`4$U$6;}A?PnD1=7%{e;6+Yd$fd*bL&gqvh|J(`H@jXWQrBhIAeL%Dve z{Fd9YvXkXGQNjQ|i7t714_0_5>30vJw%jC=bXz8iWQS9_$KgOp0M@66hpVLR=`q?y z!)TN3q}9ElSargV0K_-jN9({ zJ2TeXn8BKDsTnybYiYMPrFl}CHxr`L?qmr4UCa~~lFl>lfZI7yt6&wdSrQ2N5D}QL z=I5z+&?6yj{+gLrvzZJ12M-P$9=&>?ryB89mPezhq8@sOSvm8_cs!p>W)^;!-ng`P z_rG1gu+SZ;#XjzGwSVN53ztHjkPBuPGyez6PKGK-o9JzA z+t$!j8(U;Axl1)Qx>j%6+I4+uWE0fZy2W>^vZr?E{96|7S#kU7FZjNoJg|Dwbj*Cn zcS!kO^?NI(Hl5t``li#Hf&tZ2k!tSF=qB@{{PNC5kn%E}vE@O^zd(jEE;dLr5?n5~ zz>jN4*1$d_V?Lz8>u_5e(CQZ1(%7r**PhoHZ4!O?@IY=n2JY`)>Nc1w?~Uz`Js)FY z&0|Q54~gNqx-zjGEr&{d%XK`oJP)X|yx)!7lZe+{TY0pT#~mkxJJi?*7N7-_OuKIN zFBeOG)bAhn)Bfk^A5$zwu2obo-X*e}|6+7;KJQrdZ%i5Uy9i#_sZ~r_k4j~U_3^owOTZTNYJR)7pU&Z zpw*d?%v9!N#+0$c%uLJri95g7Wgr-t>(x!=P5P#N_?eqG!J#3GwYtf^=ZlNcVq(Qv z+^%|&!#m=A858@-vwzZ^B#Oogf`OM@qj!>iPIo=fK#le?)6dZT41z##nt?~@4_8Tx z&&t5hgP07Rqi~PR)f+cGgKofjo%qyla72*k4Xjm+&5+J?ZtRql8zo`=qdB8Y$*6RS zqzYq-)MN@XZvcyENKjx4vh>F!n2#r8E^+AP*lRHw^NF!D)8Jf(5$!b%kBqf!wM|p) zxl&IU<8EBBp=VLD77F_mWKL-v?UnXwJHz&+R;P+uTWYW)`U|T<)FrvKDq5&44xx4F4I#9CL%1i1rw8XzE8CZ=XvOkcr%o?WAyUfJ8$uVA zE)G#^vKOn=BHx0LQH`w?9oAfZ@Jm!}q)ZziKS>4~C9F*sixP&>nk0j*jJ*X=B+aug zio3frxWnM??(XiexVyW%+oFpv?(Xioi#sffyFR{i?>XQ9#k+CiO-xK=W>r>K{<1Qo zr@A})^iI{8RiYa6RU9o{SkV$astn2eiDs;~3~GDA{(@Apu>HokqzT{W18b|cX4BJT zn_+N!W*v8Bip#m+T;Stsfa2MzngH*49#T|S@MZSW?@tRRmSx;;z3Js7%jfj4<&QLC z1GTJo*@}(E!*)?cjY{MXIQ`W3w;jS!H&(hQu%aw|9v1(hyvoizT1%6uV7r6l`N_-m zx%mp}Utt4>^AA>gEZ(av_`O}b1NHci_FY%+ikeVO&dwh*rRqOdL$d_T2Zv63zp4gE zUs~UcIJP21(nTpG0Y#Lh2UWJc z1(m5uDHLefyEn1xQ;DCA1`aDf>{u*40A@$p44H6Q?<7Olpo|FT?bbA8;l|~}pza8k zKa@GYXR%sceM2j?6|+NIM!DgMiw1m^;i~!dlGPI<5zN@BwPJbfbBB}^#Yo>8;M)G9 z$Ft=)I8@h33_L%XaQtX?#`kGN{14M|LFW4rlsc@iZI3Ie&eQOu%<^($;bio@*#d?8 zPfJE%ljPOZ-5zGd^{~kBX_@5_PTEi`KyHF_4W{k4$xt#XneYR1#sExa2#OA)P&Bqv zb`aK@Yw`OD%oLWbOw8W?%ui(Y`M>vA9o^2EMmcatDBEXiD{Bf<;rqJGNXU(m6v_1S zzjh&PbKQ)suQ2776cMCU_6Ol;4|*ZhXw9GB-QyB& zZZ8klF7_`qCzS3=(#XUOb7OC8b$Y|ZV}zOwNL=+xfUo_A5$MaqefkcvhyK=2CW(k4 zLpd`DDmpr}`f(OD0z0TZF9!K3hK5KbnT$T}H@+y{n0>Cez*C*v2ju0cEctuE{7Yor z3LVe-zDQ7M7-mn0sMVZ|MIxrDS21n~OXpo<6{07NM|`*@R~Cy3f_y0mnpjUMM8bpZ z+tg^aM$UG++MS+0iGT4-{#j`73np82EH(Osz+sb#1`;Kbf82L)npZ@wK<&#Wk}{JS zcy@=QX!hbVUEd`je1YMH6H+ZN?=c*gY1>T8bk6F^3h$-r$3xFLBz&}RPz;0!F0XTr zAUv=4?_WpLBNj{dZU|#RTW%+!hGSL!lFksKkts!T8VJq$Q@8T81@I_)f2nN9BA2Yq zIB-ErHSmcNyp7{%UUMMu3X6{s(6+M}C6rUzQocbkrzgIW7H)|%CBB-(OknG(^}u+7 zP*IE2gD013r6#g|lZomHOeYb909$R$T=`Ls7w+1gGWRmWNPF0-gUAGZ`-d!eS;8^m z`CgS&cH;dgo8E|$lbzjdCU3r^fypE@!l>-QnUx3>aF$t2RI|uJNAmW0JAgd|I~jUU zG8!@yaR6QH^G7kpWYZAYHl2f)Q}Sn03s0*AaZy++*`l(y-c!@N_>uUi?wxMD^)azo z&#o}=ZQPUY4iuM)QtH0zpgGE(?+P^0(@1r)a|#|tN| zVGc2$Kdl~M4QTMW|34kn%8bzpj^ zo~cE4qe;hR*6v!mHezZ!41mx#d^9ab2Xu_*L`qX>KqR2rhKz~Up?G{q)YWNKdlc-; zgwlX=@&t{K=5|7%!~5kO2sNp?x0463pqJKOSuRA)xK{kcI@Oa(qmGeH zPX4x3L#h*JGGidoginH}vR2G!CbNj7oQzQ)Q{c6^!WThD+Md|r#v1PJ&iuCyhx2tXyI<^U7XDzmwI7%_u_@TWA}88 ztN@_xS!{}O8*3gCQ^Gvv1ob*PcjC1yS5{b(NoPpQgY`u5s zB@EMPwCxm6rj9To(QhQUf)G$FK|}VcK47&!vS7g$a%j;N>W1Kn3k}=PZB?QB-D!nT zf(!?-?MH$0%Dfi|n?zzRI=Mom51B9v!7(YCb*cI?T61Nuhil$`nvj4-Z}Y~)sLDxW zhHuy9-&R2aCaU*aOYD;1to7}em@12y7<8hT!CELjI|cGA!Pk!yMXU*pDqguNTK(L| z+x5>b8jXgSaq^osU(CCt^^}lJI2p=3EW>k?qk(SO;28*|Y(1A?4e=OnTJqbm>mqy4n(~BS zEuZj@TGS1QRuhL#`X)9u0rn{a+{SH-l@Zp8WdQqP3b&Tqe{{DADfL3l4DJDO-k2Vj!O^rGuclAf-i+`&%^bud?`KQhH{W{Mb>1E7%FCdE?H&?>AS(F9|-~ z6w81@U871F&d1&aV~j3+gMbRtc@>oHB?_C>Q{ay#q#A=(x6K*1sgC>eWOwmN-L|c+ z^{dH@z+yy1V=p@kxDOo!#K4PQkDTvFzpk8UB!6K?#d2CYFZo=bUavFcX6bg?^Z#gK zazcyrs2qAPJ&J@&Av0~S6=+zNYFyPj5S3ehR~<66h#lwqEKl>HBa{cRO+I`w;mZLs!__>d-OQsMKJKd~a#5$zROdHQ zL+8VZlgbbEyQj)1b+%?19r2&R0J+xIj&Ghuj>%h*UMmXbXm;&!W(l+6v@vyM3_VQP@G=GAZe)5c(m zDm(b}zB!?$#9DE7Z~Y<7ErvVYa8p}X^{Vw}X5Q)v3<@siU!etJRjKmcT588QloRP9|cT zi9wBMlMg|;aoRfqiYinY4aytG&ZJ+nyj`#WSn)NP&=l?b#1e~pMiFFBCgymy#)Ikr zVm51t9j|`>%-~Z4S~(=76!frhngMMS{Bg8??%!yMjp30JJeM4-Ut6{4yOH#mMJeV0 za*<9Xg_{Q?d<>q51y`p*og#Q?$%YX4gE*W5mGN>xNm9QvVvM-iVq!EDlyP8EE*XAC zTGvpEOm)WJ5=F-En_RtQ^$-OaR^l&phh06F*Y@i??k z?-)I^pv=Bl+ZK&?NqGt_j=vSBcI-V+PlmPktKl|e%~9FyMj||?3HvqR><>bJ&Ef=< zLMDn~-S960uXQmTPpwIhOA1v6wbTv|GFYn37KK9~Z+TD-E9 z4MBUJBuv4c=sX?pQ1WKk z<3Fykq>B+|tRMimBe5>EPM{BiT_6Mm5Seh98xVUN8c|Y?XsFwAVn~6t;~4cih}fLQ z;vjmN*vbr4zev3{LWu5(u6qJ|s0ffh^^6X;qpd3H#yb05@H=$Z{yupn#+(tdqdVDM z#uZ`nZ^O@dV=(ONYLcaVmARn*{5kU7N`%UI(*choE|XFYTCVz(@CijswDn?`b|zO7 zyNIX1I$hTZ&}cCn^bx};U>-;BL;Fp~eS9S77!aSvvP-U0sj!cYn5&_;;FEogbZ01Mta5@g^38*sEfeL zi^G>)IuWN>;`-9JdX%1X2EfQyt*XdzPmN+d!nkzWc(1|wfd2> zMI7){8}PhjD7e1*bTiE~{o%arF|)yskdzXTr$56NV$2}FeCmn5(r_!)T>{WQHx;-r=bTeN~DE7!K6F~~ADLHY!X-XDYA=NK?q3X53= zgIR_Wt{`Vzf50IRa{(Pp`{V1fpfQ6Vfa4Tr+3DeZ5G0b2w2vGXh&JrS|8xek(E$_Z zS^0^CBH0jJDzC-OcNYih?Jfpgr%r`EiPqxCyqeq{>P9PNR69y zR+IFvzigZNlD9W;UUWA(H^grKYyk|to9+Aobf3UStWV8;jeJfe+-d_=_S0LXC`%UY z^{`>u&%aLCShWkVw1m2O@k;R4+!@Al;uYxqX>$a6DTehPO_IZ~Nkmwq!|$YIJv9rA zk$iBK-vl8D<3~{-{@{XoAFVkehnk|9hc98WkunDn1iw#lS_+z;E5-D#QV$qZI&m0O zl~q?XXzcT-sWt4Xi=U_|cb1la=%c#tK@I@MtT1OcsB&Ql%5=fxhJEtI*KJYcq`<7; zc-Y`d($BU1j!TO@V)^R3SQmGzerBq_>sx0?%7|egszbhxuG(e=T$jEGwWpe$nf|o> zoMUhOFncM?Ba$?JsF|cirM|Yb-X8GvtgBx0m=UOFpJ#QPPaE~;^G+gF4c818h&JX9 zL2BJg`UOMYs9eA*FBaK^CN3ZL$M>E5SF%76Lpuo^P_!#ixkx}f>N_fhH*8iUxy1EL z|3R4&4Z_UB@@dU!o;79OE(TqQ@EODj$)XngvqJ;8R&ptFhZ>q=2Zn%qRh{a0NMEq9 zVNIF7b?G~Vwvk>`$N1nas8C!U@-h-UyUBdZh~)T`%&Vv6O!Na!X8|%Iv&0w zL#K9DF8I-4^k@|y4`Mtu52d81VX0QuE*K8!bz@r! zIVQ4VC5mbBG^y0GRVe636)ULJ8+mg5%or!O5{E_=;^Nt5IpXAzxpT7Umb@%BnWw^- zy>4AwOqg^V>K$gZuR$B9CTvY^+aOWYox+V&&YSRXpDKVTT4zn|Q7}KVZD8A~5|e`-X0?fC`Fv^hz7`+C)d)~A?6hvtz3(oc$dy`#D+|+c5+aE;S6i}a!T?+f0@K3ct z_tbL`{nB4kZ4%zZOG2%-m740s_%sMcW;SRgxCwt>H~IkG1-&M@zm1xuVsM^GA7`5V zS!-Lnk=RWV(D`0J^f8e$g->FW?vS7~JCBMXPH~f!w;_DizDEvsGQ&Z!7r=-ED+VqF zSN=5Kukh(&u!fs)Xf|NM%)L;;EIH>+Mt>f`nJt#e93WK8seFC9ceg+u}b8glU(9mVRh7C4yHD zqM*7%kxtKy%*`2fhqizAH^O*~Q)$g6BKstmY$YO@3pMc*O0P=NML3a z)*~+^^>12?Xewjcs?%~>ElE$B6;~dZwU?t;wc4g5D_?<O~_BtuDTbRS6sh*o`YyL3XbN8IU$mD9-FiepV;5G`5 z${d)!@xC7OCx$WSq{0EGd;7SKE;GD+_9N+n-7f~NC`%*NKr4e85k5tWKPIhwTq6NK zOTXj~Y3$T;w3H+0F&QZ#AAB)FblBHvr9FD+v2x^auI4?@aEmm)le1CB`E+zlA?FLnSD4_=5VayjV14mErF~ z=ORB9Jn~)U-SwUxKZMU;fauui+x@oPw0&(1z86nO*1-8Gc@2#NLFeH}Y{GYVw9I0j zEm7SJh5grW{Wkj;nP|i%jQ2@&0&FX*D>}=v9zy`7Y!E|)GKKr}!lTd$I~dIuT2Hk$ zrFK=n+J@`y;36Gll^%^>Odto&@SzBg^#?)#{FWP>@q_fPcrCtR9LTtB?9)44erSp> zS$&m=$$%cVMJZdyMkuXAwwCu(8QDOQMYj9zGQJXtZ0|mrP4S^mkSv_U zs5mYApqz~b9LHk>r|HS@^k5@Rww0n^m>jvSx?GX|{0MMhOe&?CE+~ajVd3Fyn{OC_ z*AyVh-H!PL%|WaK!MFxZRgbub2HFjvv)o*jiCRJoQJpDhEiLrOFE3p`+6pO?=WJ}l(8_C;r|lu%mEO8#hJ*^NsXx+1QSya{Z~U{h(@cx8Ar-rtpW+5I+j{J{FM|!vJa=3 zlJSWVNK5T@CyvS4r+7+?#&!|7!ANABp-LSiNslmYl2!}#CiP7Yh?;g#ChhbXRzel1 zJa;oE37H+(>dPu`8<9O;W8TM2b+Za?%CaE!@cZxXZ0?@~^~3`f zEQs(fFZHBdu-)eIp45S{3Z^*frw+}uLojMW7UQe%d7jGGBCNgs(O{a7cf6NuGMQwl zGui^bFqL6$f>9E7_v!6Tid;IiEb&oW&C@B#aC+4jly~{4oR2^7cYRAW6{W~s#IX<9 z_W~QnXP>0|H+2Zw<|6pmTek_NV4Rqb)DBCEUY3Otl(2owsM9ymwPu*mv7%#A#Xro0 zs-6Rmh*5elJb`VTA6)l1pLJL2pPJwake_ja^aQ90)ROPB5c!A-!vU3DbUjsF*wp8k zO1VQ$2%6G4Hk`ktR;)7UnSZ(dvOrQ*@)|{DxKkMkUOh<{~l%t`b!SD-Sgmvh|M_$&MywZ!dkMy)a5h zkdVrbQ^K)UV>!`(tO>7>{jtQHmSg{*Z{D=);X9@fv#nH?z4&W$dXRlXJRO)j)t)ag5Fu}vSu())it#I5f>-)Ts2yOO|8dsX)vg#k-gcl-pBKd2q8oKo~1Nj=Usy6etNj^hgX&;(fm%qnZDZ|v}98T4v2k2~!3}$P#)2%`} zJLjB+12vkA;}??WB&!9bt(xB*~>?_UbCXt*Z?rq`AcgkoqIf7I^^C#OHVwC6fkWbU#Lr!`MkwE%v^oz$IV8HdM?{UhIp1$Bg)F@8ek*k9#8sJ zdWrwu79YPcy&4XxUFMs?7JFQkpUowP8hW#m>iS?wt3}@!A+(;ESi8WTRyaLLpnD%D z){*J&74%!pm^#U*RUqKa=7u}C8*e2bPoM8cu2%`hjOvOiP$2BV!m&*Q4-H+os6h6X?FYqCvF75Mm<9;bBXTXi_g)8AOhnZzS z>ihJ0LG!v{Xr~V|KeM>V{M!`qeDC?${d!?XjG{~%KWl))g&@Abk^x2GO>8Tp32V@`s}-zoGKdUfCJaY1)R7#olD8#a^b$#3)lpU zInDr*)IVF8l900>VK)W*@{m{i7^P*rZ_=P9zyG!~nOSQ#pKLC8#XNJQV?i`dy*>vf zxBhH-GXb> zOfKEs*Yo4L3;n;YBxLphjygJT8)fPjApK0YQj zFGq6#lZ1o4tC+cqsk61CtAjJ#fAI>&c3&;R|Mj6$v$ivLQ84#Vaj-MCS5lQ%`|4wB zZ0Q2vfMXJNF*Ub$1#odQGcq%?vT(sM{WH`*A_f*_4n|fW7dtl`ld7w^od$q|nGwj! z&dmO$CTi>`Wo~V0nTiTiffd6YAA|ei+09^)l4lYJk z_ODI=238;kBL^FhgB8F61Ofrfz%QQbtBp>o8aCJ|#7^M6qJzagONX5#u^@QF%`{nPg!ELpw`lNM8RkdzjaH+BRtNt=BE zVeRVmUt(1+moF5g?JXPtU(lci2vY7?Qst;fX=&}L17{6%dFOHcRz{~<*Wo2aq0y(+9 z7{-c!{ z_;qw{E;ax=I|m~(I}0lt;NRANseh*d{Ev2y|Iy~+;{G}wkeTB@TL0DlKaKtGy#8(d zcf5af|E0LuSQ)w4I63~0$Iu6Ge4)bj-(B_IwYFW&oxdX1*4Wit z%-qz$%p8tM&fMP8)#}Tg+yVlC{~ha|x%$bI_8~wN@y8E1rr+Wa?f`j;(9}6Gllcgl zSI{9M71?2}5$&r-c2@GFZ?M%qeznA=RO;_4y6B!ayU@!*J9+iL2D$XQ!2E+7>*b_s z)GZFe5^3LDuzQ-$zU_8?E3#*tc^5(E zxJpf_XK;39VOz)r8M(g`;29*ZP1^EoDmQ=2~su$}hy@1{&Gm;I9nywG7l8)a|YRaqvF@{r}EotpCpHfBBvnz{1VJ z!S)CcJ%gVqteBJ;drS+b(0(fG>{7dwF8-vmWX@^o*9GI_B%Ad%hQ2? z&wEPf-6i|a^#^X(rGT$%>p8D?03XC5)vn+2T2Y}nnTFykYM&vzQIGjv?3qp>BjL8V zVc&~1`tfYqrCaYKV&D-Hh}&stbBbkGOPw#GkT1%mr9y3O6(sM;)%%k|BBi3C=P9HI zE-}~%85sEni}}LW-z2>&<_8CAflFeR(lYObt*4ADzXRRWOLjPdzwE<3C>+XNL(cDgLUqWRrx0}3cL6ky(QvmDo3fbGUCm} zn;XxLXmK6!Z{W53{^n-uY-evonrk!Cu50>1&dZ+h#$)X~)C`To&_klxEv^jT(# zpP-m7WHY3@8HJ^7AA5z-l*A%v0I_gQniz#01bF*e;u4Swsc^U74nW|HkRFQh$_ACF#qlfp zUwO7P%i8nHH;Lv5|3us*YXh;dL>Oeo*FJHz1aQqQNhcD+TyN}H&I+L>k4X&UN(nC& zCir8M*VjalyUfn}F+MJ~TQwp*ToNs{;tqF-+z;&(5}G(Mbu)wA+>%!QJXsx)DTqkx z4Siz&}%FNN45K>Z|qjZ*TZ|f z#>m<=K4{(h;wPe<@ByNqbrR(mQ7qcr;rvqJll91?FJC)n_=r2dZFb;IsA57zd?)>6 zq`W{&HrLN}$Tm2Ig09fyD>SG^nsg5%8l?O+vkew)`cg0sb+Ws4Yhy0(m#3 zAf@2Mq^lOq01cW3d_I6FEN9JjFy@NJDcRnP3s<&tPWz6?80jK4Yokg*q_++1qObLm z60{)-?-XfQ;9B`w)6L}7fC7qrFQOBu@Wji!D`l=C`607K@oG&%sCZfQ8mc=KG2F_w z%ylL^x4#XNFrYXj@{*WzV8RkcPdYg!f1q%~vo76J0@;*mAb||48oEBvxF^&l5#zSE zTxp}eTG4CEWD`*MKK)RTYI~@I6ZKFB;S)f&5kmGGfp-VI>!DAeh!hGfBttHF9LE{b zAZ8rVjDKB-h>~G#LZKnSSKJ>Um~2R6@2w`U&z4oTb6Dzfa(IX3&AA!0s_??_E?x&q zBO-J{a{zldK!3i>VvK2^2v-oT;1p55!)IA#uUeySr^H|BZQ!P5xAdkC|7+F1^U`zV zdh_pGPuF|PL)in?q3Yc;QWFiQC$JJP%14R)Vh|qa?+xgckA>S217{5x<6h2c{b@J_($ad){M4SrU(9rv;eixKvT0Pp zJH!{LU$>r_L*Q$s&?&& zSb?!pjy#VHR9PoEGj6@YdGLq!6TzV+(ugBfb%fM|T^+DBhox6bi*iUB2PD?-pg$IQ z=#rbojAt5#8I*$g{i4*{)SW}dfDx@9icfbT`8AAlhhlTp0sbBuiN%Jw`XqibycLM$ zMq?K?UWpTI0Bt&@`CGD|>rl8&H4A|?Z8}IQ|K=D_eI>vA2BsUA^px6jd$ z+2hGpjg5u{pjg&BdpqMyUOJs$I?6s{(YRF`eQ%%Mf`((njP1ltCr*a~E>*~)-a{#k z;6^h{tk+{Kk>35XW+eDb6|Pc*1q<3dyK9%*@o_gp{ z8@3bp?lAV3YB{SV{6uyDc7vArDqQotBoJFcg=-+#K_XjnQu;UxR~82qwrq}h8=31Xj($}T=#^k2 z(p%EYnC2vf9l6cMNJgFFB)<)j))cq)CKn(K zy|{b83rc&0)e%GLPX9Qe$x2MF;pyubV3Eq!OJ~J}#?kWi;5jhURb*2}xNZe)(I75X zDzVRmqr~cDZXCEmankwpYtwV4rhBD`J~KLaxg~Wn6X8iP*t$cQOO9q&Pf3gu$k z48<+lkD%|;$HIKZq13>khTJrK5t_`=zH0K-ZSYi4!2+(QmK_HDic(Fmf!>#C5JD3j zq7!mLv?+SIN!$i)q%Ql#YC3APs>^Defsa%U#`>Mg--Ng0=#N?fGnSJ*qd44N7 zX@BBiFT8SWBR$o<4Sw~JTN!&-#3{@?I7Wi&49$}P&wLox*j?2EAxhv)*`+vtsdBzZ z{RWK`8BSVVbU>?CQQ_i1v}VHi0b^D{0PEDE-0=Ip-zU-|VTYwHO5LF68!Zjt>fHBB zrHC>t`>Qvpa4h6f^KoZmn30`{yIsYqg_Q{9b~=n98agvDtAO32F*|5s%}}P%p=wq- z7Zje3@Ni)RFC|fRQMW1;!G1c~t?=nPuNPlYJ16xeN1Zf=)pn7PTBgzVY>}7UqVK@E zdD-*?TZH7p;?Xp_bdZC?Qgiv#xq-@{!?+49%@%Dam>ZP|8Eulzq;sW}+VQ$wm+k(Tc>a z^Hv{s0W#O1ZYi~s1q`V>Tdal9p|X#BqpBUd7IL#uEHhY^mi4&eST1;LvIUJGKTDv2 z)POVWHEoG^Nt~2!k~?VyD9YDUA#Cv03=0MtWaMxclMQ%mn~&~JXiSayg7PnkhV3{Zhjxd zObkBHCGB>dywz#-)@dbdI6AEc?ea0O=IZ*c-_x(=H2j9E4#tGG9*$onMSB4oLJOAM zcM|~%O)UQ&p9%pf>ryG`^H)O{f>bG}kNk?-4$PV*s}cTAtuUewjOc}sAE&kuI>&Ts z-3FfV`>WBHb>u-8gMUBz0n%Fs-2%NXXeYV^)c}+!r@dWCerlrJkks zlU7LW#CbwX3JU--ccw=LTr2{_Q40yE6fdYqf5?WkUPzpY7m(|1960YUa=NovgX~d9 z_G5q?nxXYtjk>40^1ZIYF*n6!^F{esDn=j&Ff{T#MEM&1TdADOi!zU#lc2L5!56OB zp^4NFX4oxV@Ma~bQtDF8Qr`}?#4q&AC3V7@kZ3|fHNvS$#$9!H(43xx6?LHS^Gejz;w9J$x4r-Ggzcz#jGKNqmQKH!d|GaY^~u~T?`?+d&SoR!Ly z&GZ=b#(ej2sT?lG$UN1^AKQE zyY26JOAb``2`Mi;DwkCE0xAVEXXXpMYceT0Gqbze%(L0>Yej=^U7#m^Ce|!7RxH1K zSzbbGB6$-r{ISJIxGCt*rA)kJTqOLTdTe^nwIM}MID8%PD~<8bh0&CSf6v9X?8>(6 z!keJpCXJ9alMsriBrZ|s1rr*MGh@}`s|b9p_o_rBk_s;mBogIJ%+o!It$O<;1!PMP zSA2tW(M_{#0=d);6(Ky*YS)xCauz;m>7wrbZ^Ku8CM(&xQPzu!Wd#8&LA64X4kdIX zsF?M%$vmnv=syTeUZOEQI&aEnDy{>|Py%g;+rBjXx>AhT2EHiweLh;rYIFX&P4!I7DkqxZC=G&v#bWf_#ZDHYNy zo@`Ng8I%S#^D@71YLu&1zcqiWDKFKT8)>EW2?2c|^z6zG*!_ux8=ad$E&3qN>EbOW zy9)+03`@~ub|<8Q_ALj70{viaett`%Xw*vlkWfk_9gUiX5a$e?+IpF~Sfm@Af@C@} zW)cs!y`Df;)Rp^Uq13!a%vfAj|6H#Q7lxUsyMOrRu9P!1BV?0Da68`t*XV+`{De&j zv%hcL?6Qw4+@20sAIqD(o-cJ8hoZiV+?AD=%a&3wad22XXZ(?#j_Ef&0zeQW!Q^lt zu;}I{S%W2gGDxmRlDjGMvOO1z(}EJZfrEy=m6HB=@K~8K&7AtjVo<{5vnvlH6&mHL zR)&t=QfBsqxh>0*Qx;E-Z{?Ib@x+s_-iQwJ@AfHo8~zkn#2r$5&S>)Xb{MDNoS3$# zl$cn4ngs^ZhP}`+xUFO%g^9L7ma=YT+(m;_SXYi^1Ox~vm(QCh%=0<*Lxx)6N;rMa zfM|X-LE&_Ks&q*O(~nA6^dEIy9h7PpH8gPYcUa?b?{o^P`u&x!J~4QOMQu&h^`u&= zOG|=ly=%JqYFm7sV)mCvb~Rk{8W)j^UA7QD+Ke_fj+cvSj~2@z+PdBU^$iIL@zU+H z^A*!B#)3*Wjh(%<_%>JEt5=L!gQ_Cal| z&rFmYb9Mxl8pOO7EUeXop-4+rafK{RBAddBEnRz1(u@bMCIeN$_LD669Rw13 z85GAY<8mzCHl{Zfcd$!!oz!uXnk!}707hkD%h;1h0SYmYEQ10w3|y>zS($?pw80d@ zE^i7!a-DE`_*wbnF$N_@hJz|^Boe!e1J4|ZHbk0@8ZZc4ip7D(8uE-3l@ofytVT(& z3V{&g-D7qPMD(KKO7sXqpPyz%)r*wg(eUq|%P2&MiX6vT`v9W>ka?p9gsVwO+zG=K z5noeDfis!#l#sfE3YtKTf|SrmlAtf3HgdU#Aq?502%RHoNAjZtgxa1&XM%5{xD<9e zLwGx%L-M2eh$5K~kEwsa`f)#mq3b}i5LJJq9E*Z5kQf}2a-gR z?fM?_;tV^n=>=-RQA`NqfQzDzI(NZ@lce`M9_ms@phoVaAP)=!(VpRO;Y7B};qNDVNM=8Z~!H$ru^bJR5h=ko>${le*(xUztpqR)2B335$#_qe8 zOXPy0*ZES)iRBL0V^Pu=_Su#T=Ypr8{^6PlqnS7cBA1cQL|8{=koiNw@30Jo0l}}C zfauq7@i9hNdud8BZ8#Qm&^xs8_ev3M5J#jRm`60{o%7F;tB!hb8Fa5ZI$D8k2w0?y z5xs!gK)O`LLQpIc187Z?@%zYv0mM3-Yl${ECklFDy|6ZH``}*E+VCn=hj5!zen`BRi`55Ml~676VS9ptsVC)72Ar-m2)mV__7d%sKMWuL~7N1?nI z`quuF0AIorsIBN5ihgyuPtuEHPY?sq zHv|L8H-aspH!ycvhrSGg-e6AD-tgAc)m?l~{A=BKXk+X>kE_}nJc8gy6l9k-qAkfc zPywMgD&I)Y(EWs~`Wsq;Fh!Jr;LS)uGW!TaBji2iwU{S5-{>d&(fv9@FUViJAVpvW zB>A_epO=0wkDrGE?>P#ucRxS+egxd}7JM8MKix6;A1?}ChAIj=4*Zxs-C2D63{u>l z^?Ui)e!lbD_;JZQ{Nr+8z>oOx^i|>dwBTdr$K|1bAJgNh&nLX!3-l*RLC>FDMZx36 z&p*B|0Y14O+kX~6sTIBiv(I;nuXh1&0XvH{pToc|ArM5N2JZE9Q2=1Tp<(VpS1F7s zahT&_{kT}ry@#yqC~J5k8uhq)u)zS$Uu{E#{?XFXA^v>v35 zS^^w$CI>u2S%y6CuF#$!`ZRO8n2SkKVxa=3Wt;h|(c;=u4B7}!SvjL@*MM`Ld7Pu= z6y770v*4zYKNTgC2iy+~CT{UxmFM;{moauNkTHv|GW9}YntI8~jucTmAdA`+dwUI3b|Q4s0YZ<_z82Hyy!(do{Ej2DuGzB`}v3xTW`j}dUgJVW0i zXWRMtxKe4UbK}#3gR(@dEfsN6q&-YEmmHbJaKvq2$}2C1dd9F*b!M#Hym|foEx^0> zv89hMy?aZXGWDVBlHdEh`;N&f(EHHim-@hU_h);2s#So@6z{PoyV?H!g(Ahw8~WqT%jssvI|OWXZF$o$OZ!rA4b-Cw)}OF435>Ugh)1Xcr(Oi|b9D>M}>$cztlz;X%0ik?uW#^{2DoqB_xJ>SUGQ{?u8HV_Fg$Acr zIyz^+=4MRZ=59FVFZ1XA@PIuwFyvB{gFAMonhn9Fq|wxqyq5`^mnYA3zup)Cl#W{* z&C+$~AG>(Zf^(9&+o9g!){$5%-zw>$^#e3dQnRXRwI&YZ?=lTfx1?mCl^E^G5?IbP z{nnWY*tayDr7Cs-%t)JIHxnsa^vCEkj_W!p;nd+gPb!lT!B*fQz=hr_CQ4Yr3=Z|a z+K)NE0`gCf1j$TOD=_EyeW}q6fV7B2=zEMt$sO*!6 zB;C6xsqwt>Ts~{zGV-L66{T&K&Hj5mdvK%&5iiq!`dY5nqUCihGk!Ytbj{Wbj-$%d zbh(=G{D73-450#na=qDB%>6>(??&q19(BgOJ;XKzww*o1op+BZ3KFUYC_V2Lkn|ST zg23D)_W!52JB^2O?H>SsN{7NjC5$CavNQ<8jG3_}OHCL>LbC5;pBejBsbm>4lAUDB z63V`X82ipxGE|g(sSHOH|6Avr>gf4DpXc3ky_(POUasGLE%WO8yKnY*uVyo*xwH71 zFKZ@ed~1hWxoMlN7;s*1&n4EB-|kMe+qj^uoNhLKy)Y6CGITH_Iu_KqMXOC;kW7L9 zPBl4scgyj7Zefg=9mb}N2jn5(n!AQu@jok@dEd!H*o7{pC76Bqn7^Vgi_dzEdiAt`y5=ae4y=ILX~D9zx8 zMfl7oE$PmaLDc8I#V3+vc076}m;R9NUwjI>)_9g!BDtnO|RWx&_}!cf&?G*+J}Z zOoF)Jl7Sb)1tV&PJSW&(N-Om2EU!jS9J34$;das_kjX_{>mS%jSXQa9VupBr=DBc0 zlQf(w&MhuJmzi1((y2J$+h0Fueb2T^s>nE;Cs?@$W@9!MbjQByaOYf19_ZjU=6&g`K0X@CKf&S^c*9rj z@Tn|d%};ZvRFdyeEez5*7Rhfv6jF;%U%hQEL!HugbMW??QX&bPn+G#$cHa9WKnu5n zGIaT)n=a*Ji!p^12imP`pAsoh@uPX=s?0)kXKZ91UB)$@jV^j6Ye0U!wyKy@<#{{9 zrLDs8!nn%gopmC)RHe93-sF5?GAi9{&7mdLyl%lX!w-^`Hm&sruoQwLqh6B+p!PU} z>4R9%%o}zN;)FSGKHuZxdE&#EtJ)MSJ~QB9z);G%MNX5B#hEhwCnALOjEfqX?hpL$ zV(&VWV2x6ZvTXqxigRO?=(diKy{s&w~Un6w}3=hZ-!~oscIr*Wx?`JDcAKKjC@G z{WS4W!Xq{){p4$@7IbajVemL_r+ znpEY7G)I;2%#;WEd|7kZzDT+^SE_I7yGqtCPd_4|HsE#W=}YG7AeCzJ5ww5_RA21a z`LNhfyjp2@KE>WW3t8NK;MPMB)iHfvt++pX3X{$| z#AECpHN-vo{2()XI(n?Z)adiP?&>Jz(`P;#t}o|WPM@k7V!04=eww%5F6d0oi;c!p zEcZh96slC-^XhP|<$CRJuojz5ZW@1ciES_OSJh7XW{yw4=#?Xx)k^vz zHKki$H-m|PWR9m!EC%+uXho{?LM}J+02ygo)y&Tx9_&-jNpHMTd>`xCOB(b{lIgM? z48x43g1M`NWR2!dH5@xHr2DKTY6Y|mS{a!gd3&ivRzAWoLV=}k%3$tMgl*scqZ=*^ zM@y2ugv6u3X-7vxggN++csM#cM3hf|O3y!L*)5pipf*WUO_;^>-pl8aH*wNaj8xA} z1xkmwLY52YBcqYJ#~YBo&N99=!mDB|zMxSlPlI?tS*!I76&r1ofQ(3R%$AzyK$Im@ zEeO`mnz(Us*@v#a_c96nW&l(FTXl3g&sB(H`sFu;u3s5B*>s7MC>q&wdZyp#BlOZD79Fl1j z6GKHBnycCFnF@H{wPp4RWa9}Xfu=E6)>6T~BD%F11i7HXqVHD9i$v2Zyq9unc%r)L z=S3vG)d1n%2g@r>Tu69Y9+|w^A0wv-o~e{b)YT=V3@>*m2DTM7Fbyc&JgKi)7MTm8 zj4fco2ePM+iRFUI*B`fxU6iPLKJL=mk8?Z$z@-s_|Xd$mNx)dtYy|$x78O!j> z+m-d&n+ex)ODIrK={6C(_gU@+ot&$Wk}rGuHmx_j;TcN!yw9Cv`csb;d31y7vPZ|H zTc|t=rNg{EunU4Scf8rMY)$Z5tI^uczxPKk8;kzyiJ`Wzi8gFt%%x&`qf13P89AVz zUO3UQJ;_k%BaL+HCmbrfF4AI%w=~Q?{&0hOmKRNFHY5skW9$Fb8NSMZ8nWYcAgT)v zvAN|_Y|EeB7-&m3<_B;HB*%#gP3YTV@r z@}6#uLae(~R$I4*zg1Y6ouBGL&_MDyTKoGF3BJ#VU=56YqP&fE><7iEx4r7mGH~J~ zd`3HsSI5Q>3X}=Oz*twu?gCWnkHFQyDT)lKuI z*aycbx2o`U@4Us6h3qA{hukmfwCr3@aHWS_b?LRcBmtU8b(-03LemKaz0f7et^*%+ z@ucym40P;x_n*se>xH1{b}U1a`@%xJ)nl$MCI!mJVqyuPWS$-|`o$h4sjtasiA8N_ zLP-_g2i1|mP~0{MX)7|hVtaqmr!UQ9@Y*x{)=(v(DkB&P$7>4f+fBGcf4pPfC?OLbXL}0$jb)SmyceC8L@CIntrUj}I~Egqw4P(mo-P z4KbN;tZX?;Pv$_Tfve$^oFEsgW}xk>j`)cW;Su}P!e!PS<^B-H92JnwPbO*JK$^`Y z2c{a-26?Od=a=EPKVFwLetu)|x#z|HX2td3Z@GwvaUsOf!>AoE@nmtb^7D>92wJYl zo#I^^*E9ECOhRc+P+DbTYLFcJaTY;+2VZQf$|AIJL#^r$*h}cSq^u)VJX>l=S&<1B0Gcb}`G|4on>}#JLU^fG$~$RHf`L4+xLQ zT@KHSIB-(1SJp_ZKfNqWn1MCcI2rYA9OmhwFKWmNq7E?bd!zYGVk zmnmTGA294NSy#-Eer1}_f9o`Vxb8ol_n)Nw+@GXf8E0?q_ye*7cJeRCj*^6nOCh9T zK;$RL4i!g10dxL0WQW1Uk$`{RHS0ehI|2$scOCYBg6sg(6oqF|0kUOm$&{KNq;*i2}XWL?msN}k6*ht_%5%F!AQi6B*e3Ad<`qRUZ+S4eso9D1+#@Tl~`nl_w7x zo(rllwvE(HXHaQBdL!WW?BY0Mu&}*P%_&+Jns71Fbt8AIe#v49fq9}}m63aP@^F%g z?A9x-gRu4pBD353Vawhx)_w&XH`Tgz5ic(!ISKc=`>5*JnCo3q4Awg`_{lU$SWgLf zRdku72ji&WRjPgzAKOP&_s94Q{yvCKfcSo>Nw!G!i7od!cw_PDNilngzK~Tye5gXv zIDbf4O8MvnJ@66LmtvC)O(z|D^toLEt%&1S#JcS94-w9+kn5vfNF|w$H2~i$7G~-!S-(Z z5tEceA@{^!Qb?cz;h*QhVK5}HO7~m~1$x{QlYs%n8o$JV>WjTGxb)s!U{E*=(Br%9 zdwwt|0@w|EVp1^V-uz(FlD|AJFdo0;0+&X}?9CYtg90@n-}@lo%z>gD+-}8@uDuT+ v+7XNrIxa3i)zI!N0DqUeH8J1dJ5ct3Cz#_1-{u1jlYycb1qIc#)fxW}2Uz;G literal 113509 zcmd42WpG^0vMngI&|+q0sm07JTe6s$nOn@v%*@Ozi)Ar0Gcz+kf9IYz_fEVsGk>R} ze^l(Os?1!qDk^tnZgM$Mae5{O_V47odsB1YVL6EyiEIrlzVq?|q|I%N^&QOJjg5$y z0MbO9jGSDY09hg?Mt~R*2RjEl3*gsZfzn?AJ0lxFl1P(?m6M%_iJe88pZ~kDjnO~T z5dDYWcV@Q#Rw8O_XlrCFr|)3x_*bQft(B9tjUy2oK+eI~$lMTU>p;ZB%+C)HH@5;B zI{?J3^nu3zH3T3fs>#dADk{#zDaOXg#mXqmDaOvh#408(!X+do#K|Ti#KFwZ%fZPZ z#v&rZCL+ov^tX?&keDbVD;FyhrwB7Ui>Np|zcxV1#>m)Jlaq*r^PjefEfL3G^ArHm z#x|xvGa@eLe{6C7mzV4S1zTGn5!b)uihq$IVr2&?x!D;5)D(KIrLfo9gK) z{B=Ta9?eh?GE#8-PtS}m-5}xsJiH$~7(5gi9hbvzJZ!A{dhAOU#$#6Ib)zuD#4FAb zqj5g$%J4M583jTE3{pfvUr-QZFc{na)A)Zt{WtMsjDh+_`apdmrhfq~r*CTfmlFSK z{|ju9zcMRZ)Bk1}6XSmm7O}Mf8ruLJ|MKQvBSai*?SySzHUH_t{`VON7qd1%<}bPQ z|Bt7CS@?J4zcncsJK8!q7#jbZmbMOxcKU|K|8P{1k%*c7pSl0?Qp^=7p$Pm-%D)1M ze+2)<9SKDyBIbX#(m#E~|626VIA&c&A{LhaGKyLEFIE240idMBNW}V&bqar*Ohl~z zWww$MGZ8E6zh{thur*XP25JKSZdQPju`BQ|#r{(9AH773|3$!mK>8nm{Da)T(fkkV zEpG1M2qa=+`@a^Qo$2qg|J}`8|23JcfrTQ_`hQa3JVQN3t0ifu`v)HdbmUbHWrEbTEjCWksAyfHo226BCxPJ9ZdA!TWRHR;lM^V)PgIl@%!Y74sdUYNL$ z06EpXa$|$i>{SNy%tMj&qFiAJH09E+a|MMwxU7$Xgem^Fjf3`zBOD<~Z^!2gTL1yy z>s`v%?eWaz7C^VFz0LJ;4p9}e`)g=|Fnd#LQ_Ji1q_}rtjgT<#>*V6DqGhQ@_x*I_ zu40K}i9_JybvL5|bLq-v^Ygw!VruLC<8%pA*5`dEBt^9bV)OURQTx^NURDKW4xiim z{f`3(am*a;&+CDOhlnd%=c2%fA=QE%O8M^sK5j3&8`WB#pN9_Uy2p;IP%v?)rT2)$Z+C0sbw-E3W95H2W7<6@fo{k?PQdD_d zZtf3H7rHOfacRXA53e6zLozsQ0iWz8$qEg|dH}QA&mHy5oXxT+%9^i_?}u z96qkM&lO{Y42$`?yr0RCb}qqz=g<2mF+Sa(#9lwZW8o;#09_mHURBmd2>O)uBQ`0I z@`Y(yJc-&H#`Lyp5tYu3w-fjsTW(Ekw;SM-n;Nm{Et9GwE+ACh7G&sdZfY*uZmB(xoVS&GMwtwmZlY9HTeWvVH?l+ zTV!jMq9$!zQs9s%;)W%%xL6~()P&IN8=(hz zJ0_k-L4ll&+;8+hPhp;`!)QU_G+65Z@*oxL&F&4w;;39vNjut}oURu^HK<=S9cP)g z6K_EQJK8)(T!%GDPu9C@-@3L9+6P(;*8`TGx?;Q@SHY(!LX|uT(K<`jy~5+y;wVP~?(ryR!|Y8{T#0kp(Plq7O*G&wq_3J`=DNtsMmJBC>@eY!g_3)1R#&d}s64 zZ^WE9v2sT+UUt$&tYccUXh+Lf4y*-K@++M{Ie{AnW=a5rC^=yiQ*Fu(MNLvgt(hzj ze9VC+{k-jA$I62ohA(N8ZRS&WYnZdWdFMgB#~|hj&9UrC zv&(EOCqsk#$g@-+Gpf4w?GOI{F9c0ku;U#?iO=u+q2DpmXOV|Gm; z$J!kqPuOD>4>rv{TpN|6`q-d|@IXQ8CU(V=@yGQVSBqq6Fl=0pB_Ixz4bsfbklr-S6GUNSU&%s57KFDcz7gIuae|V zwo%bQk{>o1pP8LyEC^`#0whb+Hw$tO67rFOseRbI1`zr+D25fM&$U~!5 zEmEJH&#F?^;1N)o_Rj?>MG*3BrpY*pEI)Q7l$kk`Rzgg^Gt4*4icvNcj+iPU71@*Q zVl^b~al%|Ce&k6;oTjb^}r8^vOzSseum?an*zBWDh%aJ$V>A}D+K@&_-Hz0<@a7O|Y0SKa32qnmps z5I3ERuzUhbi<8=BvVS+Nh?@$@ktqoC1S!of{Vmoo;%^M|i69S!=pBL#kJR`*DvoJm%)8{B=kjFpbZ5_UnwTU{9^y>V%cL)JA{4 zd&SQCph>qp{y~{eR=k^2`5IeP=8P7Om%&q)tQZFVO)LS>0-sU;I-7Y@Z~gg*RnCu1 zeWy^pcFDT3fa<=*fo)1bT}%#;)g+yCDY6sI*_MPGl+ww^r^hc5Opasmw9^6$C%AaB z(NTE;`bh6Wk*w38z*b59CD8_aZu#!c?;Erc7(DEWRK8iK`Tm=A)QlPT)`YJ22$k3b z+Ko}atu%A}b>BEzb8D4~V0;af{B8BSLxFK&E^57#AuDk16dk&*T}NK2?)q4-0kCmU z)rg%~fO$y$qKWM%hSfgV&^**VUq%}`I0Yu?03oB&UNEIxsnLS^S}!lwr%8g|=tx-M zfsmCXM5il}^L}v0c;jH0le#yv=#>!aV=*cB@sk(noGLZc6FJR|^RLqn z{;a2zuB+45ZY5RkYy4M$hiy0R+1t+3RAhVBki@RnbZ|tMFo!?Pte0G^9Hm?<(s=P> zql4#K2vhgg{oZjz>)_hPYAx>o+>t4POSAw3Y)7tr_7s*AKU`uk@4Rls*xUyi`8Wp1 zl^AP$U>=eW##P82UL{_Aw0}+0=SeP0H+=Q6et#84^C%e&`&rC^*jNU1R0G| zxn`o*9%|#T7&b2u8CK5;=@m@}u5=m^*utV+{y`CJK_+&WP6v2>c$8 zQOyXL;M2r0&4^s~(}(aD3?4ngtMYDK3W(*DQbwfBnXnqK6?&q7HedW3WL)- z>@E|-{=NMNg$4h4&Viu@6C=)=>g;|kil78ee>kdnv0n2YRAcj#rDJN3JA8z6kevbu zJ?r+kAtPSAdFT>Y2!r*oJo+DRm_7;|-H9E{Lk>IAZ@Y0F?tv%0m$R2N)oW1&rrfQJ zk`pJ5aeerz6!jj%+W|u)kE#8K*Mk)7kBAq<;UyBzooA8VdLlL*^{3yMONrCI7WSHF z3*Z5~HsAPGZ#SO!)_LfqU(zy9e?}J2h6gyGsm7dmUSU z?sCm(isZaU&?*0}QSFqSdXL?7T>}4%E%7<~3S{Yz>Q1cc+iHIZ-x@G(`nZ0#e!_vO z4YJ`E+{zEKQJMg?Vj9;Q4b307laFu{;Pp)k7X9sXd<`fknyaZ35>Egltz+68N?Gm3 zHcl_-lUa*=dM@r8X)HQ~2~4yJq@r6*m4PWr2gtQo;`l{M=y?MCGGBq&Vy4x@nZ5po zix!zXM66}OX;6yRO{o9{NXvN@(isanM+^)Z|BB^YYjK`1YGoG>nYU2PVx3TWrXZao zlF941-!NQ|ZmnNd1uv|Vj$uc=d+xPU*L>Sf=2YCCBw{Fh5XmaItO}9h4MU4d#Jwxq zH>~}7H+1%=nPn7zisrC+H$v(Wx63aOB|({N%StT<2cL>m_tdUk(ZODoB$@_md}|em zuT#&0XnUWK?}`KgzkjLOcz}_@4OTA%$pn!!J$tW~msHM8WdcdE{T9S?;bcKPwkkyslWSu~6Wy-H>n! zZNQO5czmtAY`{5#1ou)J>L~9eqnDoj)Bky(oTcj2>;sq3!6?*ZXRNP)K_LpIt)7|~ zB*pe-rmuiW;mV?|xnQl#QU3O)5FkC?K8s1=rB8B$XGfyeXpPKFx?#x&jiIEf#=5lIV??Qb92+HyPV5 z;u=JRQ8FY-AzDU-p(>xSS)!_Inm566_zR_vq=(qA?mo__w4^PkcLy0w@QchK3dIn| zKbo&l=QL4a<2wgJhttZU4(gWE-OF3=hg29erT(T``;KB$3nk|XzE{42fiHxg1qbD{ z{X2G9><(Q=26lI^3O=8~>QyPh;H-(-GLXqf_`vL{foQix#!^fAdt_gw8{;e14bze~ z7dOZ~u{2`LzGuUp=8^wPK-@jc(ay0JQE>gMSqavt_DBcNuU)|*s*a-njf#!Ka6M(6 zG}&NA{phk&_6`;!L7iKRl%oKln`;JIQ?H|$NlAl zy`!D#^YYE`Ph0mqx(Uq)c=_m1aFh>1Ondp^qc!m~)aDmy$~tw~uIP!2Qo|EDt>^Ja z-pjko%|>uJxc$7ZgBdkN{NP*6%C2>w=KvnP1Y|R&+*T+il-keXgp+R#)D2?6l|-NN zq1i|)+j>y<3M6WvJo1P)jL!np5&E^-IBs1D&|(2_YLR&mjv1&*B3!-4eG{1B>Sp%W z1-=`YKO6?31H_oe;H4`BOCYA&l<(@IlfvGFFO5ee5#`42)x~o)AiFUMpwO{U`5>k| zi59Ur`$;>rClsVjzE|kg8VCh~5F%nZ;)jrY(BmxKLt4^EA4G zdj&mcFliFKNaI2R=8B4uUf=_Ht284#P_7%rNOo7~CUGQq zOh3Q-{DyVvR!bewSzMt=B5h>+<#-t;0BIZS)~VSzq(@2<_>t^GPwU@Lfe;^^$xq4F zDub>a#P2X8$k*6WJHG!7_2N*@&`kdh0={Z`Tr6L8jS!mx+t$1sY?)+{bSNJ=$rr;& zD$Nh;t=7ihJd!cpllFvoArE&qQF8~L8t$|@!;cYuK#+{XxLCwT((arPofWnWC7Hob zBbMInKn0{Q#yqX88|53_1gKJoyZ&ZqsTA-Rc%J5LqmtR_raZlHPw5|?8h=UK;HwEA zp;<8svx^}-IMRr1-iqjRJSpNpi1FRARh5R)He&|~*x5+FVeYYr$XKBxpb(bPF(g>4 zA9VG>tJ6su@)r$EBbnzP!P=T_Dmt{fHNo{o3vSIHiSeFjGTbOr`=}j2Z*PrAk6ip! zpEimgC=>kBCG5#3te**0dj&;RPH>Kxk`(a}qjfoU{?sUtFG393MP?;Vndayvs+)4 zk0)OQ6D#vVP{LS6gSK+5EaV!CeB42w#>EB4{!MU2Yzt95yS66LYb^w@{ABSh?g~jNAbMYLPer8{Co&TXoj*0(4xml! z{^o$gMU!d3VZVMHYU~$Xml13tSnAh>gJ&^C+YEKad=t`E=*K|p^1oR%9rof6VXV8R#kHx%}Ojn+JStQKsHMNy`h zk&Em@y0G7P%R?aOE5BiVu@>Kj*WsCIX!?Re3|7sAyEwpl*yUArHh;>8ke)z1GTW(+&Yo>k&D5W7 zNUB6p0Gy5~q+yp}yNDiDS##5cS-tLQbyqeXM{3qXBnO2eZ&HQyVcy%5K<%fZwX)-O zDyNSg7q%bdI|y2sxYk`*4wvpZJ`16$T8x5+hsP$A^XbzGGa|ShiKXGD>*I0yKAJfBI};&u1%dbzDIb+OU&a&sE-Y?Q>*)&4Zx7OA$TovPXDYJWL@8*2gjJhd&TWdQ)D5sAOxULJ>NaUUC#d$)AP;QH=2 zyw%7_`&>8B)VZG>%6q&^ExCo)_{=tJAA4S&HVRQQJoFIRIZo(Q&nF22*F3J@0AII5 z0{q_F(K{C#&(HLdWt*G+Pto^|8FB9y6UR5E9Hjgm*kfbO-j?8tK5LPlZ6wZTAb{co z+0C|CS!;~D6=uH+&cmQpEldsR-9_7gu~!>70iA_aEq66|GfN?gB@BiTo)i|2k~TA_ z7PJKpH1zetQmkKO2k?SO92%-E$J85Kb6f8xFp*#AeyNiwWbbC-O|Iu#G8?>7h*k)4$vkth?g=tv&9X_OK{rV&7S zWkbW1_U*;P9b{8fGgm$N2NLw7-mj;Vu{5chfMc)c<%GwUr<*>3DGEp4*RvrOQdhL6 z$Q_!KpyyaJK5WOh`_H?x6`=e;p&!iSG{DNM_FD5C!xhg_3ly&v@U8kO{~Og|4ESJY7}n3c zR1E!o19pv%J$320?HdM)2fRW)_&5q3=m04crZNc~Dz(!k(wpy(6PdA{@9f?SFg>BE zltW-<2KiJ}piFSLpJa66g=iBCfH%;*&Z;bucF9{#3dG^_hkcaiVLgS?9I-bAA?JGg zddfN?wvoew?wn3EVey((HcKK+$2*w2>2zCt+sZijw?&Zwhow94Wa8j#md6s=>x{$- zR;%l7LJR|D$4+-vIV%VR!#P}sP16mjREz4px%%rVO7+y$UF_sJYD*D@G}=Nt5oA%z zL&^%DkEgz^&Cj=^g_^Iog7soD|Ji8${Ch>PlgzD-TZqu4BkC%@pz@F+y<$JQXK{6-9 zUbNA{yzchaq9eb8mZe1^M|4C=}5TiVUf1^1>EJ7@L||CR*z;q7`y;$Z?a+iy@e z>tWajycaq#r+H?cKg7JeciJCHK`+V1BZJ-yKy-$S?cGdO+s&31+(VbGQE+lsBDu?H zSD|Uv%)wm-xtk-$9juHFK#D~&o_;@#*)*c{FC3cRER&nGDTTWFdXSn64A2^*M(23;r;W zu_Z9a29k)*2gm?x8(-b9dwuU?55+GN8ns>Shz(e?t)?npVq=T`>@*Jc8{tYG zPX-UK(q>P<{D+j22ZbU6aLB#+DkgrN71jS(Ob7rCwZMu(eh-$xM#WCU^;3RVx@0nm z!&`{1nK(8Q10c%xdWhYKLgSC+TMg&rT9_zD597~TG+=#2_W6gEOj~r>5?#DN=5EVW zrrdQ&Nr3o=!ksyGIw$CQ>W<~LdW@&t5@*yT*6h-nJV*6Z+zA024zo~_%t@20x(i5T zku`3B;Y)osnM0M>RDoUWw#B(N0U$1qe*6rBW8SZ_D%mM^4w{SprXcyGy<|msCyBtuJ*{xin)>w#(&QHx z!XQRHbr5;h@?yaxgTF~LE$@P`A@8%g6xQ0laF zzeP-N(VBFbeG4T_qmKg)BF>#MYmzloLE;ppH%qirqS~P>_7Hb+RmXAy5dI0#-A%QK z!Z^lux#6{8eD>E!Zl9ShGafd&KUO+h`-ky2vY0#1GPuVsI*_~0jqLfeydLAK*DC25 zdW**7P5I^LVc9JO?C&~x82bGh~!%@flxqdZaGAF24+(*JBy{_RstSp4v72&#|{# zoRz0nRH?Nv)K_|5WYdllhxQ^rZ*cwzzMClbzXySs&cWS!?b!iylan@ShEl6u$w-bK~f5Puy2?@D8#zJWW;FlucQOeyyzm$0IZ zPI)2GEEO)Abu&krePa_;BtDa}Ejb_+i**)la~qp$by>O9XL4dH!kU^vhN_qRdGGJA8WPvp>JciyeWz&FgEw zmm#x^1Dh9gb0}@hUY}93cIm`f$Say0(OC?LOqL>13wl8OM}+$m&;z0ctQYzZ(aS&O z8vl-7g#M{OviVzb0T4BIHa9d@kP!Y)Wl8@#qWN2E^0%Ub<-dz4TtTyvU6d48FhZs} zIXb6NNQlVqaok~uW_cvhA>_lPeC5D`11X$EA;r;rRk0zQRG>LF^i#LUxwX+ zfj}qrb9Fc%M7(gBWrMgDo9>50gh?3`BQK?z9~=*xyxue@z8EmkCicnfgt|&k-8aHV zGh+JI*d~jClB-*%nZ;dH;ayy)FCLn`bgyg?cq@MJ4ZFW7-%y-SWeY`St8ZDIR{}aQ zKpx37GVmL^l9WLjt-lE#>{QBL5rN!7f;4Vs-Vp>_>BRT%!c)RUoS$1cg63E<&>nNV z<@no)Z!r^7DT3bg74 zLy3g~=EAc2F))JB>3zrZWw8U_BmxQal|%wh24|22GZ%!Y7vf(AffZs}26YawumhR* zbDxIz<q;Q#5CbWBwP(>HxVH@ zPBicVk+4{#c)^!xic&0^fbu*MIlg;RAWj>!cED>c)HD(6w+~RSK;%@gIsNa;AkDrj zwLEyx5`V_FMP1P|p)h;ac7C*C@FTSR!Q8>U2B8bm{gVJKI1CLwBd!LGdm}0wt40Qj zOl%oPQV3QimL7{xi2FNAGR}S<{98z#ekvBmAogB}dgP9QivFU(55|R5!&DV%%tLk) zBo@CH|008hx?(lTN&#mWcI1pG`hFF?7(LC}lsfQb{c|2XgrOenT|7JQRxB-M8@6hQ z7R05iJXt{pU+XjlG-y^hxgp2S_SK6pL^TQP)#-ITE~8W5KLh{VZ6WL9KK zNI1|(&>w-we^}-HN@am0!ANfXS_ag0(aS;|Qg{@<640cA$uJejsM8w#l%y<3v?=%~ zI*AiTxQ!$nu+#;0WUI+?h;+#j;|1grsVLB7f8dD;ul(Zr@mtVM&`qRB;d`mgyjpo` zTb71wr>NHtFMvb>OUhl!-bhtKMVw{QS&9d_Y~oUiONuT-4y7)!&yUaI_f|0ZUcp{P zzk*toJn@~zKYT$_V(Ixw2B8M&24MyPyKDpUYz?~p|PRyOd?4#NdirZDVJ8ZT|isNDz`3|ooBS5u+X>nR3aV%F<>1+J6r@t!)c)Z+*3R=sV>*O~6UV>B7OrQN~GO9c05!w@DvKKS)1f z9cnbwfNO%#IM6t1(qT+WyBt?CA#aG_%B!lrD50O>FWji$t1>KYP%|y~)i8;w9nYZ2 zA=IMPqUa(l`xBrB(5;cb%Hx;Msmdwrmgv^>8SR-STGfjX%IGc43(xD;&(<&4F(fUI ztC*oF&?w*;Z{5GK%(wE<`bLZR6ERLAVkogB;Rt66PA4>_Mm0{grX~K#;L75v zgrA!~j6aGWwadAy!VB=M{{i;l{JL?sbba)?^d<|z2~i1i3|j~x4xs|Y5629H0_gMzmL(@Uo*i?0_Zm+sM4FN78{ua_#80w$01L^8}-QO+;5K9T|A#d?V zgS1CcH`>p}?{N?*f%SniqAC5_VTMxGQs`29V6s9@+fMbmw|@I&iLr?V)GTE)WfSIs zjn9p9!sPnlwY1tSe3YGlKGp(8k+xCug-d1Be8HJGX(~r`llIi;Pw5BANU{v_0Cl(q zi~3Dd3FDkm`ElgK`~CENn=$;6yOB3% zR9UR0km$@j7>wmi!Q7{xR)m)3XwsIib(C^;=W^}~rtKkPj9Xt~H*9a>xJ z-m>x!sZRCdUSN%YJNt{fNd zTj9Z=n}{&X5N=foE^QvKEU(Us;E$+9 zg7)lW-E(jAlcp={&J(+akL10o=q^aFqgU-Wz~*C{*Fp4G7A|rp_^Cvd#8l)<m#G%{W%x&tKyRI&5AC8N57A}H^cj(xRZ0)XW68jC;=BwnD<*(3Tu2_QlWW zfYvf~P=blx7@g8F4tRUNe~;`=!C*;=C-$|Vq8fiT_Y~9I7NaaY|B0Kslee|xm1-<^ z*1aAky(6Om9Wnm{uB@8mJj5OC`%#&7`jIR)uB`;#`C*#Q-mgObMG$U0DCWWIb6CD& zHz%sjXcw+;pYOmV^kcA8%lGx|qh=4*sVt}vo+Yg${FN_60X{(_c73R}Jom0u`3^9iatwx{|crCi21znkzm%G%3BP&Bs+z=dn!um0fv zexBvEXRe%C9Xvg)ZEa^Fo+|^8r~;`(u`_d2{M?^FDK$}FHLA-WDZJF( z${&sFb?@Z5z&$7Y)L<)qKMt-{T(|CadpyeF5Pxca7ogvf07if)m|+Shef4mXL#KQ3 zmc6diSKr5cV(+Lrd;DH47NG;0H<9k)bb!MNTifI~N2tK4bA2apxXYn6lSJ{rLY?@F zrduVbTt$1a0N7UDRNQ{lK9y>8=iGqS^QS`?DH`kk=zV10Dt+i37AuIV7dBBJ|7cA7 zT$KLmjU}_k%`?R37RDDW)e)g4drG|}evzqpRsxt9JqOb!9+N=~hMkw6gGI3`mOqR_ zi~aY7KntnGSd~kHAz=(V$)UTWFgKBzJ3X#&%qi-ikZnHQDC^>8p}}M7FL3o!3|h^GR0$2Rrt_yRz>E zajfA?$rQ{ASaW9INV7~7*$uJjOIk`3H;bF@b>Nz>H_K1JSErs65tt?wQN3hcPV%GaS-h3f)kOT|4&5W?Z=3*h6CnY9@bH4g~fq_Y#g z;7%ZrP9r@^ z(`J_Eje|2Qe~ttz>W)rIQv(-i+D&&Qv!NzTC%Kd>bx+|(hcoJ^Wd-C<(GV(^+k)?s z7!2Sl0iwqg)Ga;()wHE#+7vSVw6)RkXZl;*la|L5x-hu%@#d5xy~FXM-=Nw;_xO}5 ziy7U1Deo2oLw)AJSNqHD!^JBuca@o9E!6FE6gk!lf~azzkR(D*c(_6GH|m22LouHl zwesm7D7O>ga~)?<%jnSoYR}UUH-d%3q{-i^S^8;iz9+{QQcY&%_}Gje;mQ#UtIcIr zQkYWXcrTB;e+_#Ts@FLcFdXq##P6gAQgx90B1yg)lomOX*Z5vmZ7`o(0uF8_{PDRPgJ6e8npZq+RYg)!$8&OO#p=s25~bN}E@9 zA4L9k4bohzovD}28E~z)M{jDUNW^PHkAB~#gyp-6E_?PIfmU+PC4X39XGGUXUaOm`S(RyLuiXIwcq`Or3a z%qLViQDRblQevvCqda!3mhdTXSiB(9GU0DH=@Akz#ZI6Sp`w8FCo8(2wVjr8qR1a#N(yHu6sC-MztF z1bxbcyqrXH-n;>H221m=o&x#=2PbE;zaPwTp`>HC8cq9f)jTd2SF?Ce{sv@pRPT{J zHc7c>MMR;5pb(LfK{))ha}89L1mPhcfXO?UX)3I>v9gBAq8jf}qm=K}^QCFhfK#wl zXv2y9aeS=yRr)$KDEE~bu9A8z{w+Nh6>|4u(g_cxSZ0mx>+&h@G8ajgXsU5A~ctMiYd9J;smsuLpC(yhqsd86&{dVj7;XG+(yb(IF zc)p`$sly+yI?Bh4;fs*mr4m9Z56(2P9pl6zX>b7#-$yCVG*(-^r#KPrJGBlgUgJKweL{6~;54b@Y=JkT3!-f;;xNQc zBjD)SQ+$S^ESz=-6z_7gh~ug6n#>pb>g`~#wzXkP*IX@dCqpKjw02xeRaxaX>}Ri> zX#|C7=_g`t>H&F3Zjo?<>Qbm33AGBH8j=r)Np5GNc~+;ZV(QidKz>#esHbt{uXxfk zQLVjS{h~oYTE5J4PbeBZD#@v{_v`WDqE2fYFkRW*Y1~PzY`b259A~;Z*9e83=|7a@Rs1wM9Vh5sXygbcTAbsS z%ZTIh`nIt#YdX78bulwXQ?1^4~TzjW3<~!9Omorh1dK1Gw-w`V$LUTug*QUb<%THwGNO9 z(%RpDj%S@3cX^c@hG$|yL&Qhah6y9ayqeSwSo`C=E+4%YTn;%kjnX0F+PB1L^KK+`q~zt(6l&Nk86hTfi)kU2Ub0-l$)~E@}?OmPH_ zlVJ32iHSjF!$b+gk@>5Es6B5(6b?@VoTE#?Q6!6bdz43jtX1Tw-v7St}Y{v zv;gy%tlmzO!bR1yxrIwL&vrvOv5_+gkW)2Vb$#GavP1`MB zQ}w$B>^w6Y-~RmAD*yLKHJc9xW%n21%OL8c#-kvF+1?82KT6Qjlt%98qg1rwY_Jmn zDd@!z#VV>x(3Feo-Tu1vAIFXxL&8EAcYU@Wbq+ggE~azUrmAc&rK~`J1-uQa2t^dDAV<2ASUY;F%Oc+XQ)LEuesY!1-wkLQcaT3t}QcVt@ib>9H(91$Hcr zh|WnXl1d~?fN`a>KNMi;0&PNd;~ebaU<7lf)|PG4<)laRQvRqEqZytL%(K}HwJLb5 z{}^8rcGu5|a>j_QIVbfV=Ix2{CR}_Wf5NU;=bSQ>*$Dh3c~=AZATUDp%!2z3{qZwz z3e17ABzvKFQP@Q&CuqGj*AyIiynXCQ&lAD(Jh&6YdT_{K3r|vjFoJC?aBN=ICmL?V zc$Ts`4vgnAf-Gfd!f>*`|Ko`N1DDnQOPur~=ldnC$MIUXFQ2~?XF!JvPp~21AAZt| zpuMtg5srN@lpQ&S1eAUk@KW^luwt~5>b@b!S!!l{YpCs}-X&gP9aI}s)aKgvZ?1DP zCJoe#(z0G--jd-5L}?+eakk9JT|=BtJwY&7OBPdC6y&>Xy8$*1zIQ&&j){Yw^Ih2W z$ZlU50fpb{#7UtRxxQx(c_KdMj63$6{Zd89>RGPQeL_@^=X&Iju4WHoKiHAZ%Vg6)Heo{$RE`++c9n6IX^|h$5xs8ejq$vishP=w4dY>! z`o!UynWUQb6!NQynf$WwEp|45iC3G03I83vHdhNq@Zyd`uJSG1IzlnwzTVX}1KMGPN zNdL0JcOS|-oTrtKTek_~fQ=$R8e-)ZmK2^+N|q(*MW3ZtQy4cRF(x4dHOtPxCBF8# z^!WvKjyMZ*%X;4}nW8{_gYts?6(jfggBFyJbY=_j9_%2Rk?(j}G+`7r-=Cw!??^0R zUW%fuS5q}W%`B&#=v7tkVq}+s8TIaS#A^jgRbCtPy<@}c4UC*D@EKi_DiF!Azu$~m z#t zZmJ9T*)nu2gIgP)qe~lC8x-Nh&pD2}jE1MT4v#6mBQ1_PZIw3FG43z<-_swcN5dME zXAUL#cchq3Yx3)d?yK=hah;DO4+usQvzuiacgdZqO^3FRzZTPhLOy}&d#BzlF4v8Y-=w5-T`IAJeElBKjeeiDa`-Wk zu))+MS}v@sf;6D8QL@i~y@D_C(@6Yy>IZAKJ8tNX5FWnG-VrDl%S+yawX%wCXNWr# z?X^cy{|#wz-&jJ><&Rt0%c4a?QdP5z6!MbaSKE#yqXsTfZVR1TuesDV8r4o?zxyJM zrzWMjnVDCp=CDYe`7Z+IxfiycYGofFWfHk6h5=_QZ}{=wi$+AA3rt=c*S<6iK3ppz z7rbf>ZHcQHRm-(*c_l{s_{p8e!EPbj37>l+JO3ABXBksh@UD9(r4%a#N^vjl?rudl z?(XjHF2&v5-QA09+}$?5afgj_`@bJ zg$+9}roGSE_&~BcL7RcCO3!fFGJ(N#ajea_k<0k@4{!QK4`s4#V$^PD-`bm_p)&S$ zL&W3P3$M6gcBi0*=tb2GBlazZ#%u524Z=0`Pr)ruiuB7fX@7)=3Ll$xD{%!-B{%Sru=8 zPvTY*#Ws}02uy7E)Y%#np%-Rz6lttyrQfit9m1o|7kK1#svWk++WP`V%-z_p|7i~O zFaI#ugq(muw0lpCXTyI77j6zk$NIBH7qD=Psu}v+~eH4hn+hs-z%*|?YKcww#$({ zs>?EbDnQ-4c`j#No*4cd3a+zxeoA=bX9TlkUIY{#uVb(Djf@rjmik&up!pcB*J8wF zpNDRXzX+Kb0Nd2VUouFT(@_=V~KRd+JWana@DYW~FiuZ`#E z2a|(1zrBrHsIK3)&J_nd*>t;COWHnuh5Gl(+$c%^0?`%sggewbI)3)GZH#gm!aE0) zqW9M_8xd0EO!)C?++A3D^Q+uu(`H>Vr&+mh1`D*X{}Ms3&GZ>L96TL7*Sabe^x!?% zne`P1i@w3M@Vol1{5i@2p6(qywm+!3vX6GjknkL}ge}hHxuYMUTstmF&*eSxSgfx$ zp1l^Jw>hj^_>c<%UK@) zdpF%s%$?Sc(`K~5YGL{nyk@zQ$Ho1uNnx4u=j`8R{EnOs0h!B^+UK6pm$-RZm(>f+ zBx*zsY}pnk$PR;IHP;9uATd=ary@*Pqt2MVIsKR#Gg1C`>5*N1Z*X_tlWTms3qLHb zJ}E0Rc?Q^bjDuJ&&s&mFjRK@|+2@${MF8Fy%$Ii_q`o(u5qo#@jjy<&76Kd{JIY2K zC9n$*80kn%$aS|81%q;#G#CS^!i(P#ehTY9b6 zI_az)9oyOAjh~psDr;{%tQ|!hNe^<<^%(ZDm-@lM>|?b{ssYo^NRmW%$2F{F#?eCo zm+P7K0SOoOC>v(`mB!}{{(hP>&p)D*gcu)InD+B&iGaT)H_f$T940zGm!w2BWFm4_ z&1Vo(m|kVK-aYRQvs1u@_L5ZGZ1{LuGiKL&Fz-vbq9XbvJ6TTZ!wAeX6(kk>tqE_M z=ZkjC0ht1qT`DMkyipYP;1=;f$ZpK0eg0)N~EP7 zhLI0h;;Uh{%JLUo)ly{>zM4zjM(h@O2()8Q3o)To)!%k}CY_|qysXpn1|PGKiOcDn zJ=e;o_DPggmQ%P(rMKcwCqyVY!LYL$r|XH$D4e}NXWeQz*6|)(MQGv9)Ktf1uQ(6z z#vUzi>jA+KO%qz*Ct&`M*H>lOT%Y=9&ky?b()bo}HwwruU-=bY`&#EJt$gk`58rfS z9;(D)0Zb(V5s<-P!Sw}?V@j{^>4c3zm8I0?$SX}a3?^f3n$gx|l~*IJGhze^?*8qR z>or#9G&kB<=zbVGz28)Bo{{la7uX}ULmm19Mj@AwaSI;IDTm8s#LZLe@z)4;jZ>Mp z=7=UF@m>gA;a*<4VwNUZ^e+XI^7x5cy7FmH&>02C`sMOi9HZ`PTLlx-vm8c-UmZtk zXuXWE2H_jnT`upL$+k(!swbu0mX-cq$?&+<1nH$wfF%Wzyv})ksB)-@JLs8s5g){A zq;@{I@q5^i@8#9!!K3G*d~Btwgw#YSdXy_)HzSsr2^yVoIVWsnF5h(lc62!78| z3piI!E3`C9qBzwkr_=D#6pOmsAHTqB|4i-)7!`%UF^7C;tZst;F=_0ME6sANxk3vb z4w9tc8@^11dJcL0KH(Y=A|9vcsLXf6r8oZ!#OX~D0 zVt0L)#~{v^XYa>3Q>o-`aLk+^)}2eeL-XBEv7f*wnEe|wa^O(6%26K$>idtikKb}b z>GUF?*bTAANPRzRyw$U?6WL8s;)eeHt& zSEg%Rs=%UMZ5pwQPZvw~yJRinQedK{@!D+hH#PYF-eEA+=WO2pZink*q#&MP`>X5)l6ZnN93Nop7*D>l7A1@ zpze;Wa)HD7zGv`vX#`=<#}0f~0KYJ>dn$o&Pc-3&g1p(C&A-FJ6q@9Vj7ym)a z0q-sSRNt0yYN8OuPS@$Xdt@3-OrkHr1^lq+XQ0p;ngc z-j;q(6z@bC!QPs_(h~sIo+tNj38Ut^mED5~zcY*-3t;HgOCfZdj>Tn-tlZz(ne^~l z>tmjm?j>prq+Dm>xK-y?1231xS8)a?Q&-ad^y1&C+@u=pQ|K9N&{9e9(G-vV#IEIv zhBWP)$%=;ojlKWvR}#h#de2h*>{W&^fYY5`mtMcfK7UulF?Uo@B#KYHDpP(U?$ReJ z{zcqdG-N?+q`M96!H~#nSp9Q&&5*|sJ70K6N)ZkfO_Ut&5B?HLQ6HR1Y} zZ`E{$*{VMrU--Nrp{azw3g_NuSB?2E&vM=zAX}S!FPqaPO?$6Ba2Z>9Ke957yODc^ z_PX3|{NT>N&3&CN;TLBKJL~gEinxI*qdd@{elR+FG}SxtZJE;?)*TDx{v8A0A%0YZON4^|9A)+0$!UT$w4c4=09QM+xb1?E;d{KbWUtt63NPKD|7l!G`@% zjPYZF?R3d*sDc^vT+oVnF3l4t;UdiN^$vsT*+mq9J9SH<0hKP}r* zjUN3VK2RTL@{^i=HX_2TD&anrtYB_c$TrWf5X8z@D$1{#wjUk?Ut`CUsSMJ8;y`8!z6LwDceio6jA7 zon5i-7X}WcN>5uIK2SW0J`@%XtytqY3ynnC&5jA(HNdy>)&s8gA%_kZ+9kB%L<6~E zGMN6;m}@m+TS(9x#HWs)I5e=YDrbA@Dm~z8Z_qe&<&E?b77dIYQph<(6pCgP@gDC4 zLfLxx%rF0=?aG7WyJJI8*si#j zbQClBPxB&s$gdASdns7{620kT<#i%$1*=o;894QVz?{RWC|jS1n>+wpvFcvk203oi zF2j*NB67mDZS~upF?1roFRnk`f|X0}wwQ|Fat8Qw|9Zk79NTskt{YE?;W7I9V;yYE zJ-ThIubDUg^IWkPze!;f&e{r`p8w&1V8t8Uh!;-y=?IqBEu}t+-z)vYg5m z?5!8%hW8b6IFCyR!KV~tOos} zTkM3g$0#WPf27yad5-yukp|`J1>R5efQFRZlyqG491mzn4~2Qgs?_n4OjhOP4DYEp zj@=f3>j+Gvj~aA;i!!m!s~`&vvW+5x|4_4V9-|4*m)BS!+}9|??|ZJ$$(3pJv~t71 zzGMOHJ+q8l0YYMsq|RBh#%B)smnamC_9jxnR;WHY7Hz^&k(aSum@x+3MFo?en*A`h zeH`6&sPNlx&RB55FXLLV(x(iJm_QiD>pUAg<&9I_Aa2CjOF$J2YtVJ~rL{@IO<1~B zHpk__+YUJ+?(wS6ZQ6KT0kG?tW4=0y3+_IxcqVbZy_#n_=-|zSHJ*ul8$11Ne|f%4 zkmVwIgWc+?>za0#KhDa=5X8Gx9)9e5*?(h^CcRzVd~xsH452Vv{bSU&V95)y znLwV#wVY!whItt4sn1p`r-t3VBF z0MMZry$D|hoxHhoM$f0}Uh4MqlH_-8Xb8vB>yiTwc(a|+tle8zi^sUCz50c|fVC%! zaN~Yu%&80G6pN`ClHJEzh6C2f|MxwA+W70n{mD1mIJMn=!gcznk8#8}t9YZeBSp6xR)n| z_^799fqo28Sp&ct21*(67W{dLlO?9^`*1F*Feek!m!_0sip%RP7xFwLUJhsdSn4B8 zW(%Z*pT~J!SB3^5Gy&ujC&ctg%QmAxnhRCJ9^H3q$_QSmRTyElU-(uj4-#6 zlk;r?9%XsP%^FSYdg*_EOS>1L;d~5RE8p#^Bt`e?^YC>Whik%X)YHuyXh>w^hYx?- z)OkxfxEpxrsxDdV(PlIZH8YiVmJ-aEX_84MUnr{dc*Se=O)$=Ve4lsGiw*LI$? zotaO_0 zJbp+BHPf3Z$80(enKOA7wcNaie)#+@lB}baiyT7e7IJC-4*DtOCb-br62mX=tuL>A z_kIdq?`!j`%qzk{?Vmz-9b4BXQXA2)`0t9m5~NgGct7BjM+2q|NQHmcqM;C%^aO(v zw_~?;^cA&v#ZLRluaFq2@OxK@2$Sk1nj&4JZY7%lKs)~MAlbe_3hN+0wvRuXh8Q}r zEx1Fm=B#HyhLKG?1}p}-{sM>(r6Y|t3Qs`&cJIy`fj{0~&SH}{zkH~#RF5?Jh#q7P zX|B@eTc7%=*RK6X(e<9nZN8%j+C@f0Db+mB)=Dj*T3VS-w7sWf#M@jnyM^$DDeb{dShMNI>V-*@y+n0$ z#VH1#63vhNoO}9q2JMB(=z{sUjv%v&dlp=l z6egZWA^qn#gY~VVO*}Egj6?j8u{bg9S#o0Im#J-ndR&J3txOWHto5fHcz5#c^zBQs z6tQkvKeIqSe-!;R2<>4u5cvwhUTd%yCI|Y^J<{M&&efEojj#S2yScghzl~kprvs6LGsB@=8>IsWg5$24n)Y#E2$eh5e((H-7 zJ1(uPj>csRd=n+>45kpaM#@tIY*RXZZKi*WLE>lK^{FN7<*af0>NeZXs!*FD*Yy_5 zPP4{mYdZGLB`e&z=vBFOQ)?%7aFoq3J#yQycB#(9-c7rvc1Pv1iOQKXy=w~c_2t(( zI4l@bD8xg~ptjiVug3Ol%xQlxQ7QBTQ{dX7-&D#l=s3J>A2-4~P+dr+`grFNk)VtY zs?HTm&#^9gfh>Kh#+Bcz|8CR-US9L%A<|+0=c-ws17qdGoxylQlN(k-sUo}6Eh|o; zK(WX7Qt(=FWfRi))S%evSQLqqW?L1pL@O^B)Q1y5si>)$Eyys=$ECMMRTTEmhR%9O z$F8BDSsbOeiY}Tnu6@sLWv!g-KMXzeh%BHMDi%s_m2qQm1D*9O+Kf8Kx&mAp*|j?Y zu`MIMB7bi8)wlJgpF4~>Pe^g##=fGxGV@1;-9QozQ0OC}3&OB~pCuDb{f!a_UBzh_ zA)wnQ#Rc4JBmqL)bv;R@?RQfrva9*(>3JPl`e^%RAY}Ut@NO1%8iUAJ72%MiHz$%B z|K%71_rCi`ptgW*uP^WGi{uw9n5zAsJW;6w23suZ(8K;FeSe>?c_zL|OF#ZIrq|ce z+iBItA>&>tXmwBRM0gZQRY9lsFgyYSr{QA|YL+WI_ThAHYCHBXT}QR*N!hlCXy*|F z-#Tc>^;fV1-%iS<6XcB;h z1)Ssp(cqb|lAl4Zz=a3lcNVgp(6&Fb0kP_*d9py1^jD!`#m>a*I|S9{KvK1IPh%&2_^r8$MjLF?3o=t zvO<7)zzvnpE_7PR*E|#;STadOxJ^^?(1oTY5u4~4;T0w+ze{>dul9=I$q&7$#m#9D z`lR5XoA;YX#s$}yhVTHnB0*O{j!DHK!9^59$C{)9%b5-yp}N49$vypZFt^M-l4rfn zw=I?TVjVDr+`HuFq1ZtoE@!WZ`Fn_KM&uY_&CM}$vepg>vaW(}t*)A{l3r1mj0u^x zGm!&}cG3}?6hWeOAI&VynB!wxL(!kJu0OQ&_f<g*L$KoQth#s4KTDVm`@h&H#5Y4m^}M3jXAKH=k$R zeX5_&B4~+S4?7DxdpYkst9~HwoYpl18P_@}^YF${OB5IW-LYT6`x&-R6qB(#pu#6= zkGZtMt8M*r>Sz6BJm>9)==DNsnaJO6Bi?}o#fI8!oJGk5-WA)XkOZ-p0hr+j`8oSL zU%KSdJ2;Cbq+>5Jsc$89f*wcK)e4*O9a5Aw{4b_-%Mp!sCG)HnRY-~ZantTIVYg)~ zAUpL%SBBLq%LUx(t!`Uj&ZClf-b6kyljCk^Qp>C>`AizSw@Mlpwdb~uKAZL7;VGu5 zMyj-ER`j)kb(k!>LrO1Ej_lhNrw?6@uQ4gK1rmFK!%oX5czay6h8UfI|j(E$()Gk-OriY4tP?!9KIWxB?otinO#VcaIX)_ zKIwl?v5(Wbu@S<$>1U7E_0CcaD&8rQlwW|KYbp~tHUfx@2C2wD{Ql-H{4s4)^ybGn z|93mPa3BJejVX^@+#h=HrM73EO%CPB`>D{){jXUa9gN5Tg9APu(?uDn!(JH<MQa1E^L1<4s#fEx zu2zlwTAA`XGWK?PiMmo$slD5cGREHv$FY}ZdcSkFXJ4)ZA@}UH7(d4Dh}6B<_lDIo zP6>L&%FeN-PgNyRr-HA8#09Po0 zR-PJjEQDLJ9twMSnSLnM1Ks0`e1K{mN?n3p(8pKr&l_;G`^Z-w+kAO_q*W1YWL*qE zk0Ix90p~7SMRO10hVHNUysC3O?+N4&$;y#pUGgkzny5~D1DOd{+aPGaPwxocU(_{% z#YDmFa}}~?lI)^P-hsoMrPk(Ip>-lp&aq}9#DDuSIcuP*h@ba6C|EN|(-5@3f0ZH0 zI0!pvtFhs|)`R{6rP>7F{9kz2|AXQFZ_V(`ENuUeS3R!Za)1#j^wJjre_fFNXMO4ySB}goKDkC53cku3~{2NU$y2`)j4p2lVveW_CCw0NQB3-E2>e zl@t41kr&VI?QF@d>AU{)LpFzFd3i30-XCHtDRw-O;<}>J$DTB$F3)_rQ%9XAi|<38 zBukg$=slF0EU1;Q1Y&k=dTc!hs)htWQ6xODO+(R6p$-w6F2#NN*`P<35ZaA{)Y>f%v@#I_%m!J{ZT*Bzu^MN? zHG9h_5_Yumng_Lpr{h6#4eIP~$CnLAWL5)CRgoi`$6IZ2+HLJb1=wk*+2?Uzo`=%O#0I{gK3`;~o}+-A!z zW>z2A#A%`3c6@(0-7Rwx;}@k)IYwL%w5D{sJj&fGcQ&W;dhY7V3_7j!nd1#{y%M3$ zNi0e7Imq|a14royV-1OK9q|j*!dmN8JS7=0std5I&7CEnfvN>5r@dh?2@D}~lswMW zvWUp8t?j?v0?bxn_C~K%&bDzt(l|bCfid$=vT7{LB_Q_%o~%GMdnmZky&rq;Fuq9y zgBth2nrFl9(HGuI9i(60n9$G}ac{4%e8-hGBVw-@+DkNNoqAVIFxO~oF^n?(y+(XE zyCrVd*?5cH>O(lkbXw2}-DdSJQWX@bX-uN64m~T~s zqieeQeRxNqYn0NPMqz(Or(~4$hAds6_PuQVsAaA8<*4%>OQ$ULc=6fpSxL#_WKztBA^8E%RY$b^F z@zcjXyrAJ|dsgMN@e&^?O?dN7%2}LFgT&O>B6%4niR8UXkV?y#O7RJ{VKaALOhsfz zWKI?4DYaquRuupX%P32h;>J3<`u6Oe+~c+@@h^Y-`+YP42ZCJ|0`UUXouIj_xx`T* z?&;4sKVC(9xO955@#cws&0Sg3UDLB+3eKg8dmaVD^lSW~Y3tvI<;W?-jtopP;%Kmg zoaur;#(z5i zZ&ZMu~Rmp+)req}1N%tWyj zn?|hKeaqN8%!sas)-qjQ&(4|3K>`GrWq?hld2%9iPIY75g546_;vsd*Awx>l?_)l8 zf2aM*bKY*kyC)~qNEn zY9A>y4WSkFfD4w*g#k?hpV6}CGTuqsx^z`$kz zaLfQd=I`O3)I1WC;En=>JJ)IGCG31D@6eC}vgr2Pd4^z(F6c@X5;i(PHm+aCN8zbu z5KveP2UQE7tyP*Ct~0YZF)~Vd_sISxCm;&g_#4Q6xXoNto?1VmGWz4>o$;jf@6Ys5 z<%m2@@x*n*rASH)3A(Hi6~Cf)KbghpRJ*IRNB2gYc;gK5luW4P^6+OZ5t)7w>+V36 z9NCBOq0+3CWeiO@8t+^Lrjt(zr*3}*Z!-On$;GpgEk%AKF3E%;E}RMsNCV1?&1#9 z0XPcWj(iul9bI5)7A&HiUFgOCDjb^1d$blVS(Wpt99deWce0g;7RTGUiAqv?5jNGD zZYnX7TV3UKe%VUr%Jb{(@nQBXg-A(vlajTY#a>88z+Z2^I@I^1)%2dswa=g97Z%!{ z&h+T4Yppl+kdbt$q%9jos|N1-3$%`4%1|O?eD>4Tl~P*Qn~2%Xb@>77b2j!?446?{ zI6HhPHv7pZ{XWf7ImB}6movA-@f}7f!3VmRp^X7}xlV#E9#i_J9n(95`P#8cuw*R& zvTiNG#~p|75d=2i>B;}`4$!~&hX@u__$ILY9X02CItM2wAu9ChYX)jl;OzUKFA)U4 zCPV*xGiIj@ZYD3+r|^>_a_XjDcx zW0do4z*i=W^H|NA&1SyB0Z$TFS@)k`u4htsO-?Hml;d>SPWbPrsS~o%n$Ln}OZD(l zxTsPx*R_bnII3>b5!3+BHf|v!(RiFR|LA&Uc~ocDW=ZR7ydVNouRol}v;x9pT70LR z-a$6p`pNQfJr0|T!Q}4hw6EXMtR5YP==#`(6-#)RE|MMZT$$@vs1RlFN6?CP>rX^1 zQ82y^{{-1LQPL7eDD-D{{H~J0lNM})nuzne^v0;g;fKd5EcOyg+qq%jE2)@Re&doD zHNwm8ChCA)4J~`Y8y(p|`w!6Lid6`)-j1`h%VHfc^XsX73QxJQaS6@3B76DhVU>%u z%#eyfY!q8w(DC|75CtlXRRuWL=KcprGuHGmlKRNxo1uVfT4RQh1Az2|Zv(UdLok4u zOLW%ja6fjJ@opSVx}8p>nodSl&~JNc%4n{t$}E&MxuWpcCY*9wQTY&!Fu!tsEkxwq z1YLg~%f3YP=qq4%xikA6IZyxMGV0eDKMo~9zPv1>5X?4C+XQ3>tK=Z%F= z;R`r03+pSmI|#3*0ji{3q)VZNUkE3&4#PER3*cpcR60^#wKA|VW0GL=ru?-3{f-jD ztwU5-rQls%La~(c7(Mmy@-Z$~xa4v{He|M$V8x6ZG(SFGnq1nRimJ9#r%KP=;k9?Y zI&WRwR<(PrIqxmtp8GpwYHyERuxDAl+76n4EbDB;=LvBLd z(E$pj?pDFhHp*Qd;>D|Ss=h_?`Q!P$u$@FI<#`%o^as$?Up@IPI_8_UoEj}Qv&l8# zH=S?=nj>FzdpZ0Gi$x39`CZOjf0t^x`$q*xFEizffMS4;Zo=*Pf$IJ8{X?Ik5rkn4 z2^$JWG?Rni&Z#Guf<=p^HeomW(02*EPAKhcZU*nCh5?S)?|&Cxf@Dv5)fl{1K*_ROXJ3Za1<}>)Xwduh z>2lD=NFm_QDeg|UH#gwtQ`K4vr0~0~gS?(H%|((;l{9H41m<{h(pk9rXwZZMGdt zKINCt=(5#q>?VK6^?BwnH~E;0zXAmMVB|hMaD`*9l+ed}-QVwP>Y;%xTDgrk{cSlN zsV3}o^E}i+7 zN80>?0Eh8#ncqu)-S~U!WB1+iqjW)6!AZ3v4^N7`cwFtlA0jy=KJ{sW z5V23x52il_xW|2iZWqMpSt2qBCFs+`J>yCUPZ{BX>(p z(M=OM(a5SYLNqFf+d~nU#NAlT(Cb@@?}#VB@zcR{Hhz!ZV=SM_FADHt@Gm>*&eePDd}62I|;NFAeALQip-i8`?%$!`TZln9Uvf!BK%RwZ>zD! z>67Rbd}}vG(q|^U5DWDZAf+bHb+J|)#mx~9*VPWsTNP5KfHKRxznHwH?Q!v`3=~{% z)uhve_onPU!e3}xkQg)Hq>K;bH>AHN;2YY$CUz@zXH9g<1t%o2>wSdmv&30Qdz9c* zfySK{^?it@jf2>d;}!Soqb>H4OQEk>~VPHkJ@2&5L~nvpY@jTzgH zHceAK?>p4&+>gK1OXN^^O!u=Jw&qePy#Z#+I8ENfw+6uF%lylNbl?5oviJD{y|7*; z+xN;A!R`wuO6%49Rky&Hpg4}I2`q9!|E5q}T|_7vH25NWpcyf&-a z8_dOq>sn<_oo_KgqMN*Wc0n1=Ahx*PV3i=IazU#++;bdW?7E;M{>$Y|AD{YuTjqxt^*mi<2&Z$|Uurgrmp5QdYTg`ah^B#{*aowE% zj%4&D=wA(nkyM+JSbtCWv`-v-5e*ZIiki7&-XBF1U~Erho0LoVmVW@O!oUkd^Dov+ z6{>o}oG3wRi8FrY8aF;yJU2HRWp=VXfX8g2eUB%y=eMMar>J@qW>B2~L!g~N=~EVZ zHU;XyYEp#RuU^up%{HtN@$}r7>5`pxV;xChYTs-A`#M?Yc`>|nwTLR6*Kf*xvRVt5 zMjyIly=#%LZ}g6Pj{8@xgD03j6#Tw)Bi&Q@`?$ZHlkxUi$iI=U(S@GpZlrqIt1M!K zEq8-AoD#o&5k_Fc`YsanJ)kTkr5{Q-j*?%Vsvt#}&SaQ5?@qVk(F?uc5pX%daeCqNV3ger z(Kv0bEdu=IpFBB&})KS*IP~5m~wwbR24-2+~#0g>W%TBF_u_ZulWdi{ze-> zWv^zeWeek@JBC+VNkCCFhi*uhd>%v6Zq?MT{z4rjS6T?}S!&D;w@QFlNuX{ZMdmszQ&Yv>?6EOV{U& zpL6se+TB{#hq^K!^RCsEz~-C%@~YGs6-CL#!JBWjJiq2G&dgl{Fa6|MH z$$W6*|JA$q3Nan8nl0iS3_u^%5ZU(Kg?$#N`f|~>gK*+2KSxrU#9IZ~vWMXn--KJ? zdPedBSaS8-=&eXS{T%Clr7Jl{8qcbka=O{5;OBUbV`Fi+GCS#w@@JBV?hSjgt-Ze( z-RPY6`!VZP<0sj+3_^fMUMa?>QtKZ`8mB_991wxV-qNEAiWqm(q#1l_{9*WjjdL0_ zR3eK$ozVq;q<0CcB7I|`CdmzU|zTJv93M|&d+|qYa zadM^KV<1Dx8f!x%xWZ(<6xP^QNhBml+M5GJ0zguSs8&GJccYsdg?`R+QogdvzrDoo z%H?4WCp0n#tCEZhTI71yrt_)SN|pOPcbx4E$%)LbUbRSs(xsBJuI;SE1);{VCRvw~ zMx$Ok^i8WZ`b~FrPhIi~0&V#V+JkfJjXzZ~?|g<9o8seMHCy z-2J+vAigAt?$e>(nO@f+&BfIhK7d86KRLC|*$aje{Sh-|kC5M_Uh0;|li22rJ$U>7 z77mk{UrMh}ra6GMID!t-8Nm3KtzpJr&vJo35FaDAleP5wdA4lQ$t_dsrVqYJZNkV} zEATno1EE|{`a{-K6G*iY(#3l8lHn$*R9_l-1yQ<`+7)Z!FR@_+WCTvuMYCzhyy{UT zrzaLOb4pCzrd~~P2(sPV6&R_FKyebYvA=qq0GOeerJfD3w;bq`WF^a zAC&xZ2LiY5-JF>4M^5QtE*=7W9PeU-We+kk!g|f53G%fq>=D(qQo`M9@RDV@@_n&} z=YO6Qs@{WtE#%sNex+o$l|?(T;=Z<%LOUsS9*8wO<>iFG58}Dr+xXWb^DgM|4&eUB z>o{zsHDXU7_C&aQJweB@^Ktr(B+F{tZrxRSeMZlnY9i`6q|tmJn_~lJL+tPE`UoFP ztC-IQ?@sjb3#QUKGum})G9J{P zyrNa`@T?7*y<6W9KkA3&B@8e2dqmUzs`2k8(Ft?K{1My#4x<~ApCloEn&5@*+B5{a zdZ9LgV5jFU?=EAx61S#OHtCF{R1;$>+d-f%H600BX>oet}wGh>5x>G zjAC)0aV-vUwvH0a9`^Bng0=%UbqSR+MfUlj{iPA@(|otzM9VVnB=c~m@Uz*{cYv}4 zS@k^?CuMW`>RIk$WB(^Cgj-|VLk{N2Ug<+m$Vk)KvAL$6XBj^!Fyo0;!pv3z+)Kj8 z`BE{e7v2+p<;I9zGO)PN`_0Pctc|FG14QmpU1|O1wnN^=>sd4XS8VoUDYoExvN5yZ zq5AZ(SLRo;Dj!a~7YE5J71Ezm=;|KbhGeT*Wu7ht6j*c|C3O!O}>)ys!NXo)8eCG0U z$obi~=g#Z{IkR!e&8>*)x>I9Xx5)Pjq3jUH#WAM!(#&s6mn*9zB6U7Z1&k$rg;BfH65=2V(&pT%@(Rbc?D)&gNZH7 zzHY!nZ%XLbNw;hRZ~V2;Edg#)A~ecXkrbM>y`|0SLM=?l)|4JcFD~TvVh_BTN_xMQ z{X`IEcSGksu+}3*+iX&E2r2g&iWv)>pb|HMAW-qV%x83)KlXJui278e&G zg!U<&ykf_FFaRooZvAt!?AJ1#){65HcNY^}_ph1+xZ`K_pR5+oVwszflFH{Rop>N7fi-97>mIVKxZ_csY?d}$n%DiFWBvHFMayCFmr#2^6*mO!a(`ek-vJE(F6%*LxH z+zpIyTc9+g-}Qf|HB=^W``f#_>T zy4`dFds~jnE63J3-j+#Act3f%DVyL{pPT}+7n~Jucq3k&-KTv-ciU`&{NrJS6`nXP zuBR})vkxFr@M`hn^~WIUj*>f1>8fan^ODOj)2=A6o;+& zp5MIji3k@Z`ed(WJ)zjaRFB?q0DmF*-8>zanPrg{;a!b01Y@iw|IQ+7 zhi40rKQB~5!=@$kJ*FUxGvPk(2w~tC=6`zwJL8u{^tGz?)nU;o-3?jky3&*%e4#Gb zQ@OJ>^4awnxKWFtw2S(;WJ zp&&g$te}xNp!a9+$xG8pSF9-(U=}axR;(`SpUs@ZyLG54=uZ==dn&xTUP*Zk2dYTC ziGiQI&1^@1UeYsgPfi~XbdHbNA%H~9Z1FU;TPM&C z9>MB-*z>&z1b8APxgaQ{;th?|j`n*odRpdGm%s?0tsU34iSNODxtB%IVlhWB1o=#@ z#;T7RsbTICIr?(xRywE--i-2=0I*(grnQEiqYhw5Vu%4hn7*|WPKi4JcDZ^c*o3vg z4ytFRr49mvOWSU&gCt6W7*meeK`~A@45uvH>r{rb$~G+f2tw@-c&;LqQ3_7iS`QtkKG~D29KG~OVTWCW?cYJ;Dqr(C`lO2R!#-tjrha0U zyKz{bMd6-?JoOA|C;=fvhsFozj$~OMU=um{?XC&*;4U3G&U_GDt7U9+&s>|o%dSL@ z{|oN))8wr)U}q}Cjy*MZ`Op{D3de3k%s7Uj2j#+3`;QZEkV{nBO|IJ~kSID=wEw`3awJC!fF-Pi+&%cR;_jDz=vWiC?(pulf^{AS;Bh?FZeY z(v)KuH%=wzLnIrkB<%ikKuQ>F^5dOg_HS$kqs`x5+4HMvkq_45V2q%sd>4T+`X=p= zXWgCVa#+VmbBr*CKk?QJHyM<_Bh8%ik!z*r#2HCOo4R6x(r*OlIA-0!jxXMSo3oMOE{PS*oTUHCNGaJh8$mB)J9BTVuU+$ z#zh3=>HMlh*41meFH@yp0bki;BMD+IsY7NFwhWU z0Vz5w%a#-GH0++;7w6e}i?}p|+^t$HxZK?r8RlJkV9c8rf}YkhYxg5B(C=5p!FXvuz=M&7OdH>IdJL$@|5y z(gsLbqE0@{8NeAHYd-{tSWWON4;+wAXmWX&kr9}$6nFb7Y+6|nRO%tt@|v@KdZzOR zr!2|ONpDiRNoPrKii=a!uuUv6I#~^`i-6e}>5Or7M$##&B3G-OEWk-XA0T3+HCkw~ zUx@Sq6AhIueCF1^nu|!_9`uHGZ`as*<>b-Y+CY{Vgmr~^rb10h_(H`)WhHkgMFB^Z zWynAz7gK--liJV8NI9jOPh1D{`W0(m=oqFsFWGCw!4>b)1M7{C(n<*L4C+hC71k@R z$7oC)GAp`Iu34uA^}dsJYFrr6I5Em!J?JN&6>WmJ2R9;*H~wQk_y^VzJLxBqS2vN1 zkjVoA3rOQ+fu80VlC%kp_m(~EiOqK?q%~XfP9~SmC-`7RBS5|EuB1RHlJEmJ+B{oY zHj}h>VgH6%$^T;P9D+oNx;1<2mTlX%ZQHha%eHOXwr$(CZL_O;@cMQ18~hO&ImqET z5&PuMTzh?>jH&bdQeSu`HgJrrVj$%p5Y`}>EX-DatU+c?es6S?0LlFi3ZGa)XTU7K zlsD3G)`zHEv_Jix55^JQsBMIGAD7BORkkr^y)q9~y;EC=VBdRAosE=JsMAUD4(6ua zf<5v>5STheQAkTv*t*)Z6Y9&b{m}~tLKRD}Oom`7!r9WKu0H=omatl)2{q`YJpLwHg%Ypsg(O>R2l|=`XJ9RS)r^VA z2K?p#dfW=*r^+PZR5uFVbZQMYT!KX_>P+6t=~mIrf@}H~c7rGl!)0U3O$KX9y`V~# ziUkR^jY@q=!?xh6J%X-dT3~=2VkEp znt%ka81Pa<7_Z>OefR$Krz!Z-YB-G#xmln(u$?%r;KViNfLVC>mQ|R{K|GybY&8H$ zrPM(!NDdz8M{Fy-3Tni)5_(CwOR3-R+p`h#AlAO%JI21s0rhgIu}@jO2u}z3(s?w4 zALqD1`AG#!>tapGWy`@8O>){^Y-s6W`IVJa43rF{3drnMgQi0#gBANBQ9gA#O?7ry z#;zvMmzq}prtPw9ci9d$o{DW;s7a$KN~YpJZnYIWWSbB}UY|n`V47D*surBeCwAbkcTXVbFn0`gQvq!LhcEeZ1PA3OEyb5OyR% zOBTD2Q2m_c~nE)fJ|le?C&P>+829W1M~())P>Am=S{{MO6CNn0)Viu>FXgWxDdsh zzYf?*c&-!q#GIe*%lSdg4KB)&o^#_wrZ0vxs zOsd|=b9pu0fV9zzlWnaHk+vLrW9iw5({cb~_Ea<8hv=>Iu=Q|zuvz|Uy7YNM{%WIO zy?{;6%QbBF6qaZNp-TM9UIA0mB8HgR=z}T@KI$rVlPdLF`JOTUO2|~|gRFQf+8lSV zam8>wE%iAl^|S?Yrh1rzxCNrPMhqvZlXPypX~)(&-cnFY(&7<8*eO1~Q`0_0?|tt` zj6;COA<8?H6(nk|*DZ1dEl%JDLYLL$d=jtuqs**F1gXoc z&um;QThG=k>?xRf&^NX_M!Nu(g@6wZo2l?;#_12mw2z3R^59QmT0B>SjoRhJuN2W7lf@VG`5|Mao zB~OgBoDiHcmuaBp(-)eBQqr*L* z*b`}Cw2ftB>8MFBZOOSXdEj|4c+j?SuVG&TI|e%Xvn)c^t8ElF7EzRyGnQh%VtX1<9&DITr>$#6b0@YtDEa*Xpur0UK~HC5`apP{+)JPotU_F{;-l zC^bk2tCNOTKxcrLqYo+ccD<1VPi^ih}%(jn6?|1?Y$eTV32 zWVN}K$EGndEQpxEq(1k2^f$==WHfMdCn>T96^y7pOU@XeAf0Gk#DW;Kg z4Qj((qZ4Z52Tk5-6~(4Xf-;7sMbalcms3UzTmv>u?^G~%zQ!6w5UkafHtq8aUO~Ks zmmY;{RF^iztHm{K8j_z!pHNVUyA6z=n`5WKEg zG;#GziM?UqX?=}-7uxQfAyr$`iDFcrN`e|{tDb2>t8z|mL?L~vi7?I--FQU|8Hnd< zHTM?TE3Heoni(Qi`@EX*oN#t0+#xQQ$AoXl+cfTJ<$nb?9M!s+&b94Qv17_8wq5pZ z+6nH=uO;%-(4M0{5_<{$Ly1mkqXah<|H-IMtV=for%p&_o{;k#GB49Yipu4KFHLC} zU$&(wOZdC(Oujw&F-GVMa0yD{OL9+ni|hO1x4{?c3F!&%idYH}F<8fat{HeJc)2r(n<40mFhn_e# z@uYl#EIyZy#?vP*E;mOZ4+*NIb*(U0AL^^N+X@KQbQ*AxJ!_D*tFRl)2S-#TJXb~a zm_UN{gRJ*Q2XQ#>e;}IK{}V)-fr0)1A(;Okq}*=)3GHuzVXR=sycO*3s)UJ}Q2|>> zrx!A1+okdB&|n2RyyGxT z6yjFN5#D6ZfkPPB$Yx59zLhPTuwfiDbZNOjdGNV*xr*3zPPe@FzaHqC>wBW>d{^=Y z4-Z}THykd(wKVnnL+nF5OCZ@-Ek!8!K#dspU-mnX|KI;0j%T3zPgaVao}T5uyz%sm zZ2yh?b_GyY^pH|CMdIDL>Y_fN_sD}S4&|Gu0$^!MNggZEPKrt&l}sg!zJ+rWpFkrk z1KdpIo5P2s6WkOOWo9JAFd-)~q+&y%--E9Q-PqJBX5>II5KF$q%{4yRcCK-F@H)x7 z`Ix@>oObEkHR8ds-9=sXgurP$C0eVi5 zx3s(*!2;+3bE>~e3h#L#osFqa;r#n*i~5!NZtqd_!<9h(>b=1`ArIe21!$Y84vuWy zCkp;VDJF|B|JMpg$Z`D7p>~i#CK#MZ6hFtLFBDnq01Pi#w$UsqUy;MZON4PvijBk% zqnTtZ*q(c?BwXZMr|{BwXp066|Jy0goh;Sxm{d2`DrLx0+|o+yh0hsyp1y+CZ$w}E zhTISq5bAouA&aAANS`=s7-0fNunb0Tq=$wUXOJC{FA{`8s30#&M3L|CHQZ%9lz*Hs zm_6z8JhkV0ud!fx;ln6QBu^cgX$F9I3;t9~Vv->Mo54ynK11$}(R#SDEd2>qip zzUk8NKPkosXe(h+>LO-4jqzBl>Z7MdjbXcVHu55+zzWx{xMwNj*KW_()t4_1LZh2S z?O)PhOcvVnGk5j7^kTjSsmap#3R2e1`?<7*Pg#13Fqa+2*H zG&@R}0Nt+D?CKp@eE&VaFaW*hm{IpBNPA!*VYCQa_MqcXJv%GYU|3bRx8rp9$dtVwt`0 z=hWg0kHCU8+s5sb#OIY-|rDT4yEpvWA_<)eLlj9sv)BL<`Vw->b%J#5pWQjO%D_o0_p#g>K%?)5WAMR=i= zjmwUkEM4yep@iDDwYD0YscEpRE1=wB_>`{~oZ6yLqJi>Xy|~811aUF9$Gim6924tf zIrCFE&4kwS=@*LO6sBbS1zHCpdQs^okz?jHx+mr^(w&I1-$|ZQX`O`=6Az*vgQ@dB zj;;A~xZLf)aM(h#{ALj#OE*c&ySxZmZDF4EDBe<_W3Ezw{Urg6>0S#cu8jVB z3FrzqG==-Aj|JF`cn%JckzoRa7ExI3#0&~;C1KdOHBVEIPQW$sj35v8pr)+?_RvAz z0X%~+0NQaAzq3Mc z!Y}U-)C`0W%_ZW*?0H9INI`2>0*$xZ@ob-{7=!~JbCt#X)Lc#yA-VFcAdNVT9(KG(n`M|`^&cO74 z4^~%z%T6~>rKLCCU#+-H^Q5yW$=IY3!$-PQe40@_p8y_fZ0)bZaVRi7zBYm%fkn7z z5IGETv3=w3^1i~|0TBS!EQCf=({jw}PN1Q%*)4nm$%QC zPR(>yLypJq@VWZ*1J_BL%hx*eL})e?oF7q2<@Fiic+I67Q48%_>vjsIBrZIGc2DQO zp>wUZ7;m>MN_ST3nWTvwyhE9Kd-a)lt+Y%LjSd9lHijw@42?GTFXT4+&l9nqxek*t zR}VMP@g0pVhoRT6v48T<+RF{@>eW9EtvuuxnjKc1S@}J0oVv7-7m3|lXlGFmVEhtf z{YcF@OtCAW!E^-hX`5o9=U#V$`2uMzmSAl}?k28rZF@HwB`C;&ob@tb=UJOjb4wN9A3!oo?o2gpN$-c=XMFIz9<(6;9rch)yBTHQ(tBjKhN-?r(1p{x z2F>X=ZDjoR5%3aSQPRNu;Pcd-vd-W)v4&s-adL#eR*Bh=Pc(mv%h219xa4FC_5dcG zyuyLH`0{{G{npafbJ2d>RUHIk9VIMG8b@;K9^7mWCoV-!`V@3>>KcyaMAFY}&&b}u z9mo+eDwk!k%KUSq1bAenR}^|hiB6-ITh4e9Jt35B3~=FcXKWPj=;s`8+PI=|b6RLj zYUS2l*+9}T6N!N}E! zSU$4@=6=I|L$ni|%zq-8d};x;*!+W&-*8VU_iC;}YQlfnUQqU66nq~|_BbWp0Skr6 zd~ly|3So067qkzKKH~15KZY-EgxlbbJcbuKBhDii7pwJ?Hq##5S&|nxs&q-uj=V1a@1;(oQk;XC%VQ_?{+jDN=>r1VsPOT=Z1rRB*TI z+=1G3X75Y(9wm@WL%KCSj81DL(ESk3q`*jMEHoazE4qFGEiZ62WHuU)%xNSJ@Dnb_ zS~9xDg-{uB+Z(};{N#=WonNoysQxq#A)O|#L-I5lfr6EZMR^QBNTuQ__{t$W)xmYT z!eLO@VR>?mK{PcMos)q9OIC&49B*>rYhXIR9Q?Rg{1QCU3VvT3Yy=KyUpSM`Oh_#N zubvdnW9^{S3#%z6fhABFj3V=nZJL$v_^LB%mXN1OKSe&cDyif1epUuc|$F9^QsMJ8Ww+Gn63eXzJYv7j9BF3j1pkSaDA} z2N604!a4^)HFaZRE((!;QpyG~2pz6cylbX5EQni*kBIY;7jt{T2>*iNiSrBxpryB= zreIhn`Rq+v^-1G>U|2mzKA65TDJp=!9N8TEHZMyRyb2@l zw_RXUviPoCf+w2s+q_yUQOBP5=x}$-_ktDvB?MLD;SYb%;Oh^IGMIiwGuj>LB$^(| z*r3xKm@+?L8l5)o=@G}1;T|n8iLEDXxP=6a3$}~Pp=;5DQv^82)yAins-t(t0VOJN zVs(P3%HKfd+cu#(;^YdsAY^zQ%FnRWV?DUm% z(grd(_SL?Ksf$De4;Z71ym*ArjhR0hKl;9e)gy0@1V~(D<7oh#YeOGxe*{2wy#&kS zJnJYvGvR`$N0I9I9#7YkZ?i+kxRr!3B2C!?+K`;MT?ANmIhAIo<~4}mJg5XSc#?^0 z9n=ACD{Rsu49Y#bSsu^i*oH2_L2u!um@iwRSfZHG%u3A{G96*$3|EmaA6iyvh+EEM zG`eY2sZ=31Nl7-orPUqSXG%)HS%i^V*cwO(5!3o@$j9QvfEQ?hoQrP+sw{K3P)KWP zieGe=oq^viN19yrKMuNDYHWN*MdM5SyAUFuvKg0Ss38;_ab1G0ZgkQZ;TJI957yM? z>Us~>=)aZ(mLMcBIKBy73P(SGFw=K(euNWYQ>6J1=Jaft7DjSlhz-xj%Vj zh{zn^X7*CO*o@vw$Niq=Zer9fIvg2}{U<$>dePB(fOlbPsgVv_&y(%wj8&*w|D6o! z#@$ul_MpXzpyzceg5lcV5f%IAM&z%f&>4$p8^$g3>^v6|-ykQqsOjBrV980M3}vDW z-?O)Om2-A3=0j|(eHGlptqot~=Fp^WSE`>}gFStN9~mm;aaM4@{$>r7yy?hnARPx( z5GmPIjMo~LQabFsOg|?Uk^XwwW(dX0m^MN31)vey%|PSnL(|&lkA@n{)6Wp{so2cF z6dH4N6st3sW-7r`nVn9%B0}!k)e}sOcg^ixNyxbCAxV|{MpO0omOkUDv!Xte9l03$ z?H(rDy(#X#WBmF;W1W#%1UK~u+nCJ-giG^lEH|@>#^stV%Z)Y<>5Y5dO-sn0RVMG6 zki>`YBb}!5O}>Z~tMxuR$TAnSwO9}B9V_W9>kMP{6LU)dUpl@c8EGMT(+)W$Jdj2xr|v5w zlEI=*VaoZa(QL8d?r(p>WEq67+3D4c1GsxXX)Z3&t*s^8inTEl|K%F95(A*IISx4Z9nfsXcnCqB52AlOXTd9|uMXjJ%f-w!FJO+j6;AI98JcRzuVm=RddJIC3 z*Enc|P+{A+Hu+VVug=$Y>8lPPLYG5hx;8!8?k@e&L{dXsMOejIMRp~~J%&bg!HUIn z2IheQ!}JYv25B@=~a}FH5jc->SY=c_{;3 zszQ2+;wQw50Fe|Iyb4|sad0}HK~!= zxI9`|LEnMPS)N0}lf=VS9KAmp42BaD!=DtEi^C=SChpIH`wqs7zku@r-Qy30*C9-V zJfe=4On<|2+z$s06D-9LUsjTy#Jf_@mOP=EETTR+nGY_e09_BkRCJRz2|Z8568K~c zY=Pt9dnNUkC`Bkwj5ttF&E)(R1niN>EVT)^<_&R$56_Eh14I7+><15gsc#sO zsh}b5yDYCe@Q0q5J2>!*rE810B*3?iSBXCvg{P8(Lc+WLoj_QhOP1Z?WxCfr zgu5zo5dZs@Rte<*Px6c4!f}R0bum1HNbC^a%+9XDrG;&F4F2UdfP7<7x=}tfHQd}s zAcz~oa5&Ri;F9FjvU$kQ>S5V2 zL{Jg5#Dmgd)+8Xt+C4S~d&lquA27e8BDZWe#zP-UF!;vt20FaN2Q@k~aGt@xSJsLqO|nEE#UMw1xmiUf#=}I~qPn5Hun8xe25^D_=y#pM zuT+#zYXy*MNpwp__isONym23Y-5laJB8}j#wyY-CMGWJhdw?3w36Q0W(cnRjVbsTI z$#lb(^88L|_!Q~VVY_!zbmz7!IN4u1Pg(~`4Xtj>deBsRG3GK!F|g^3C~B0#%F@SW z%hDE7o;tguPR+8OWk^kZs=f2V&G%3A{~OXsvZ%ySr8r#Ytvw{DM}T`pG5K)jx*HkrD%`-1}EI|x&KK{FpHjGScT$nEP=bH+YMLYcNX-`eEnq(!G-yZY!$hjWV-!mACgf>n$VJ9x; z4}icI+5>UxhlSo2^dk$_%Y4_P`ukt6ux~%_aafdIc*Ca3IBCO$H3(0_`T3Ur!J{cUjDo z&oNzirT}#}HRgbz9q#wDh?MI7ssQL|(<6sFcURJO8P?10+ViaF832~-ydaymbj+N~ z8R#P-2$9L(TK36&s=o8v!i80+vtkeLMg-AVBeB&1uD22#V$~QZ`Q(W>tfMW$XaJ@)@MS6nsxD*GUxi0P+6{Nt3$L> zcghY-(l6GIz%40`L5n5SLxjnXf^tf_9mQ4YMy1!J)`U(%ptYS`mTll)V|^BN@G7f1 zwiguE3)EAr{JQM>X_ip2?A*>Al+c%GV8|Jk$)CpgNikBs3|HaX1zm8r!i1PO5j6m7 zQ_?lhJ@Y5|JdpQI`FluvVq`OfR)^;l;uOEX*Lw1|jVQJWy7LtKcrF1uIpaK2?9J!U zOH;iKpn(kb_~P+2&kSXt)|~+bfXzn~_F!zTh~o7gqf3T>j^wZ3Zo4^=eE7uR<)AH% zhE|%jI!N_@T=xhz-*I<;cmY@b75U(&DB_Y`fQ5y19--6$XO?09GW=MQ;;0fk#4Qys z72e|OrCD%uDO=!FKh$p|%bC1;-@>&_KA4$T0Ci9W&wh+A2az`>rU>XGQHRFkqb8AV z5T~8mnc&kNE2|V-d&Fu5$9mG9VOk8%tZ5*t+HB5St5ZgEtAK{6f=)S{&tR`N!*%)! zlFj8DYk!rsDnVkr!gykyPOaS;U!SG!QC{U!IYvR*z9A2C^4-Is!g~O2tgt$aFIQ?O zhxMwuP(4jpT30OYQ71Q~_Q1rAXG{eR7lL>y3u8&-JnAe`ZZY?2_FuRET)*e+_?YbSGT!E(zs^8?nu2^Y0{;A@ z`3angIge_>h|$xW))L3EN#v#3zVQI86=T$o0GZi1#p;sqPp3hVn@}8PpT&|K^G#a} z(4&rco~mWdcG3oSE&`94!8@)N#rCW4J+uRj6vf^z^U zxZj!O_2Ksh-#VbaXEAEnNidA9juzzcQ0+bqe!5tGeyM7+a=Iz1piyr#c&i`MemH5$ zqGgpy+oUV&w%HF{Pd`^uHfE5Q*FmAB4ihHalcU>xapS%=P>oyAr=4t3r;cAUVmf_r z)QHj`hFIMtvjms9c`hQ{GN(t#WN*k!3E(b0eUlJ&Sq~{c)4fS}zI$+=eQe5RaHsi6 z$+oX9@vJ6I@`NtT>zrIccr4O2hk0jk+yllQ-C4)Fd@K@8`gD`<4vA+axOq7M(v2`Q zZlIO!@S;9D!&HT7c4SRSnZx(mZrp7&b~`dQB9o1&#A$2fUS$=!QY?+ve@=eK{|!av zGH54T-Hdkzv7?|N4AgW_F5aL$H8Xd9`^q{pHs`Pwx3x>RMKsYm6DTHc5w9pIVjj2l zOewr$I{bYHUW@C~WI#~g#Ac;}rnzcsC8U1b#h^Bq#Coxo*{I>#d#w+R7*K0}s;HvT zhXbL(z2RbOT}s*Z;vZ3+c6xh5=HRr8VuF;t!O4uq-1*DaWUuL-zBRiRSIoK_O!pF; zWIE2RJ&l5Wt#c%K;jb7#399M@NGBX%ZofzJV=Eu$X?w{=ZgB@aeF65q5LK;bD(i43 z$AjK!yAZ1Q%-*xDpu<9>Zoj}`#1LZ&HC$totUvBxEg^F@?NEi9ouN8Df|dykXtUlj z7!v0QbSH)A)@Vh5uEhYq5Ti>vq<&W9J3?%})p*TchVz7g6IZOPPkxH|$qDcoP=M>z zRczWRf}Q*=<4QOZ?+}_C9Ly8#c;?EbtuYQS#0U*HgjPa!lzv|yg`N!aEY3qjca-pZ zqRX0k{Y|)eak$;ij2kmRng>L6JRIk#UuBj$1d`gW%xJ-4-%y~-X@SbLW_NLSfphJI z1pyO)m|q`l>rtm@Y^to3UFiQ2e5lv*xY*RAyxi+f?z^_jw9a~IQmD?7B|C<;K44Gh zgh$Lq88CNpRe>vY!H2pi?bSuj#<6NE^dJ#~Hk8^Zb^@abhP=gc03R>%?LnpG^5E7v zrMtBZ({J+skz~Z6hEprc>pn9t^Dv>go_zQi8T)mxDwtdn@k)w!b6J0;Ej-=bm5g&6 zy3enS>tbf>%b8_?UJq)VP-9_DerRks-gfo%o$>EH_Fea7Pp%z@ z)Ec4}Tb5>{eLl38;E#+h=HYdn`QxW;Gr8!G@LL(a+oZ41Pm*OUb2mAV1vW}JAjsLCnjO%hAK^<<}r>Z zPy8KeYEP}95k%ip5*l~$J?=>g+92C9*(+?P{3*aE@M<>@_uw>W zkEleFqpfqTF}eG#FLFLe!Tm?F^Sus#G&WX$-%k}Hja@b3iO2X5XpuO(Ox30Uc^>#r z-(&deN;u^Va!ElNZP#8nmNGyN^5$cSYTJBQmfd!xHqn999OA@Z>tNo9eqs^6%SOCk!vmpea80 z?DfUy|DKK{KKV6NW#ge9pus7>xKm*8`1Pu5YT`C^Kks&k^)8=T=5FR23LO{U9Q!J$O!z_oEpch0$>ptsJ4FhFXm=7w7kg9<0c78o))KG;;D)m|Dzt7^` zXFR}*+%$=FH4Uz1h^XUEi$QLpnKhq;XG?c^G}5mV7)9RFTr27oTF8VQzYVeXGm$h~ z6feyzYzoka5R?5M`RN#k%{19;3NFY6O28+rPb=MYzcaGSq?}6dnf;RXVas7z!6<u(Xb;@U3jr2W%r;M766#!B zG2iiGcpz=3IT(DO$;mF@E7LW@Aj{DENH!%*!i+8<3m5EmObQ)rr&tb23DM|-K?+d{ z6PBC?{W}5jfKNQ5y+!(@lk=%@og!Zbn4>yjanLp4L)~FQ-DH^#^2h=&9;7w1j=VSpGx}z)B1H7sCgd#QUEl z;&6lka)e`gSkqjlv;Epk^nM2aPM8oso1i(nPL7McMypc30XrF*o{l^+vc!GKpTc)2 zQ!Z)hH}K|0UDzzm(7i(CWK5bQDCwUyrCZ;e>}cEu|N0A34oap$wWId|uP3-UJALkZ zP!0Cj=alQRh)MUkk18m2sx!5p+@8YM0}!8=R9R=o7>he+U+)&T%{??L7jn{y(zt!$ z=`^4wJnJA%eeIr#|Ao3h(Z3^kfXr0rhlGSlOxBt{gA>UPFn*BRSuB+gn3)RY5(|ma z7VQv4w?3K=qy;||DMFuQnd3!`N|wMYlV}SHO`3T#&P$epoXOD=M+H+S8i3r>HYX6vDHevt->GPD6GEV1k@G^o0Pp zOs;wm7BMdoF+MA9w@HW?wpjfo^DgP#hFD2O?y)|A;mK2~^Y7?Nw4KqT&s*)Tu_E5Gs zNUgL#BPLY#5o1S{<*Sz8S}BE!Sd?2TDhC0-Vf4{@7WE#k3$WA?=$KYa&}7SjkvDdi zs({VUl9V*mb$8o;$6szRIUA>G@s=^TYd%XyH$BuhtSzmkG{>p%pxWQkObnnn7wBgM z9c>jf#Cp_TK&X0b5f<}xq?d!{k`^i(wi7;!TE0+pUEln$dqeTM`)a!Q$r-a}iX`ur>@$rwqetW5T%5h+F zbCPLF=XK3$;K55vTURv|b7=HYT&p*Kb*!oKc37;qd7EA=l@}FNP5hhD`M$WEsei1u zod|iHNA=Fa@f1T}FkTxuv2s z*G2<9hk^VafVoeHC{I2D3umbx!8?Ku{54#|d8Tzx7#*i(>3PEE6g~YhFfg0TDfTmp zPWVx1*bw$U?VtvDC^F)y%}Q{~Z9Y!^F2VAzHH>T{W-C1F3}VrWLY;r%VS z{d@f>JKU(Wy0E*=#Dsa{4ad5p)_etWjg)5`r}ZJrly{<=)zNfjy{qxM>tluZE8)bX zXCluX;Zie-oqF<4f?e0yk<*zonp0>$7Tbz&Qh9RGXaL6(k?q;0Qr$m(g#dRD_}edq zou-dR9q~TrH#>uQpwF+|Q3DWh*XAC*eI~w&BtgA-k!VVDl5?_SDu2zKcTnJQ@bz&7 zb2>pp*475lv(`4gjL-*{TlxnlhO)DyXQC;loT*f$SIvy} zc122`+0&j4IjgYYt2sELq0+-ZKbu4gDVyT^(2uscI_p$_kIq3=XUy9}v~1>JXdz|q z40m9`<1`CGMz_N5^x`sle{2Z`JuX4iL{?uvteBrs@}X3O`lB14X3=|~d)BVZxy!ig zspI`7?Yil5>4v$h(0%M%aU|oJ6??=hCn9G95~5Vov0MvyTA*a>YWDQfJ!D(^Dsyks zWaoN;Ei-a0A`_%!os2E*muta%?UH6PIh9Z^NqB&c0^}&403%<+D+_PtJfk^5lsV=i zDx@oFiIy|DH9D=Tk1PFIHPJNEG~6&iv_>zFvu41l41G1)@s&M&zIvw5c_4phKV23x zX7_>D0&cFox}?kGjjoHyBjV@^*;TQNMv-AUEX}*%iY*-sb9|Ii{*eiOku(l=e$&s*VAQS=9lYN# zLIyXaZMfy3zNmvh|D@vO=1trFSujU7FT#U1T}McHjke#BqU&VN5@&tZ=XOZ$TxpHtFz~-T*<+;6LfGpiMHgnqn9P0r?RM|1WEGf z($-Rq3U19em8@X7d4i4P?RYqDFibFva;K6Vl`GY!^AM=t%RsRDdOTE@F%e3FSa22^ zdwStmq+FM-oOn`YHJ@b~fS7ADTaGqjzqIHP%ln6^(gZP}&vnI)vGaZyl+?*hw?% z4|jUt>&WAqfv$PBnt`u_We%B9tVRf6Bzp$AkC7FA&d>}8o^BrdeHeR=lhs^xbzaA> z090x2Mz`FX=gW|dWTMY$f(hhj+q3(Q0O9Rd?URpn=c&%(kME@YOKX>E3r*LN>2W~S zq8hhC_H&wra*U<-tS;*+#H~6K*=^REf0}hi__HHRy&?R&0f-1L;op3FU?Cj%;f0-L z^QY;HNqzudzWTXly-wDycnqoTi*+TZd$*zbx^oF}CHb_6UAaF|b#j9DrR$^Nj&lM9 zU1U~J85(EQj~oZk#iC*62xTR)>t~g#1n*I&LuJZF$X$U|p_Sp)Qrf~b(Kb{a98KDr z)flr-W;IP(mRs39UAH)QG*{Tk9hEPrJV_<@VhS>yg(a*h3$vN-6>fZecVj#0rEfbZx~QCN5KV7wsB*T3tg0`{mQR8 zhxa`o=b0zDI^$t^wxJ7>Wp14EFlr(Nc2Q}0+PcTd>82?T{j%=Dg|_wk_I90}leX*Z z^XO|scYCqHW^eYQD`SJE&C^ixXp_ z#PuXNeO&LXo^MVe8{{Z+T5ZN*s7OIUQEZUe!p}JdCWvMlOIDF|c^{I~R9WgZ_vz`2 z9!aC=SICHEi}vdJz}Wv*ze32F3!3Vr1NPHIQ?`Bi@(%jx|5HL^8d~vpRypc`8iVT!gs6WGCDL!j38_fPE5Ro)Dcs14Nt^vj~Q*F*=Jk#Ta85|9nr%{ zWohis+l-H@8Cs!7zJ#F9NQ9|X_Fs6lR(+Ocg_;nz&B9ehsZE`8a+9|iFdrgkAZUT? zThX;@;~|{BN@|)x$vLmv8lyyuDJe;WD6BeN_IC+_zB&yI?5_z?rnnFBj251s&cHuG zV$SCJ)btW=I9V-QH8gY^g#?mu6Uvvi6 z(%TICITf7gQ*4~2ev!B_I*(VMUyoEDcIUeJV$111~ z0!4j9@GT>Xm5fJijzL4ts(H!gTI+u$yDN4fV$|=&v-kIXg~wYS`!xKtbrgfUh%{3{ z&of3Ywgq>eM@eY}UnW4Rj8GsTAe%I@n$i9pj&U$f>w8Gm6A#1_TH~CL)y5bl$g(tL z$fN@;40KC^B8S_e05o6;Bd9>o@Jq14<(yl@PBU3CD-SBmy)`?hQDEIw#ljxI5JV}Q zjrNRa7ER5tnql0YARM-?1zIXvc5rCRx=-4)OkV=?q9;Lj{c?{~W|wdN`DBrgDCdn> zmIu!iFkftRmMd^HsOeF$j7OmOfG1+e$Lw@2B4G$-rii)Q<{*O`Z z)orHRJ-IZ_YaO_AsJj0m+!51lS1-l9MLS<3JZ#$ekYOT_zw3n;M+Hp1C$97X)IxTK zH2>hN{w1ydQ6UOD6sVtVh}t|{OKxvD^_c4t_9(bP^@96y=%QM^>iJTU$b%gE{Fx)t)4PFZ1TnMmw**slYAW z(XOGEKv8Z&lL*v-BMgVt!?Os{KxHVl;mS`iH@ZBwMv3=7ZXcihOuzU$?e&-rK+L>Ye!26 z=tYTy5!1(!pxp_`^U_s{14}E2gcHick-$3u$@j|;EEMEc@Z4EhdW z<02_HG6QW+baYqyf)Z=gjXJd~hk! zcI&V8z3r{#X>b1N zoKyVr#177OKHnOii;?lej~1wP73W9Q^^>&rr6$aeK?+`?(PpPd!kgz%K4O}&3FPpA zL9|C$(Lj^#P4yazSDIAwwi6>$0jT|Oj|lQC$PYZaU^BBjL_1KA+CWkA1um#g8nE%# zrUvoS%5M&C4Ijqm;rE=n$hyA<)ZAI`w0q3H@M#|F;PSXHyF>&9g`FM7^)mG+TT0R` zRMk$G?sC`Dd{!M{Sd(>rhWWDs)n-e6xwkCC}B2u(_{IRk;d+RpmQyLjU6L z*g1Osm_$-EFkaLO$fumoSXND(uF)g1m;ofra4j z(cXh_4x(H|rd!jGWft3ouqaZ{9-L9VfqIM_h<*rU%!O2|Y1dQwQUW+mDb!VEl{p_0 z#&PgNnvQXu9D+2H2Oww}>hNv1ng%xQ8+J04vr+A_96g;eL%;Ofjy$FngMx6wxPwU$ z$Q}e|z!}aCHGmvYnPssTqqb)1Mg5W$>~v-M%+ zJg}jO(kWU||Knx9*M1B1!;$9_QA5R*>UEs5=92xkv~R$HUDL#7-hj!Z67FP;iA-TTY7hz&SChWJ7;yls`sk@JxTCgpSTP}dQ7=DKF%3TWANs-*3dbz z_)3CpUulD%aLD=jQ&FLJ4=l&Z!h>b0*`l_5f@+l!r*>EQI8K?VSl#Crh4W~{!(fkt zB8bU@$*h`RK?LyXHCAn3I6LWgyv2yLF$yo~R3dSyn#AWOUHU#yB!}7@+m`oOIeT1y z`GIu#{L`F;6Pp!-I&Ef-mv*?cr_0v(VPf%WFfET1$pMdtyqS&y6`d%gf^wZPh4XQj z-q5?1mAD;Uvb6?U(+7egi|I@7ReYz=Y0oesq^XaCxd#9X8M%rq!96Sf#2Iop60W3C zsc1Hwjz$HdliOLKt?Z}V=g@0LKkdOy#LbBpzIR;7h2m3L%O4LACBXBmUYsftSyc$b z9Dv~3P^-muCYzdxYuHjhn$BXOBZUm4v;G4o;mK&-zw zVhVWN3XZsyO1FX|?wu9?#tu$_8#G`GtzXfqffs-20)FJs0#L)BBM11kf){7brZ9E) zW1o$yU51j9h)NaFYV8pUX8j3A4tper9FZ`PVSjIg<=gRAEbQTS1ud%n4K0$8bS)eK zfD#of7_{WuxiKvTvG?4vom;qVyq!My+59$RI8380&7T?bd}YbXGl!D%A`WAo7b1)B zS7WfKW!WmAz=y4CvNdh9!`THZ{7$PQ9Io_TDfH&@+1D3!#yIq6Vm1CDR^w{=pu#EU z<%!cPm@`@wW0FI1GGDD++g*Eww$IV$yrOi6V}~>CNIUiAiH-WLdcjd!QPf`BS9^>2 zxOlu)Gzd59kJJh?wScnYZviXEfnc?=K94BtGd^fQgjRW4<$Yy#ha;ell?kR;Ku61IMr^T;Sw*YJd50AX#R=@~B9~$Rko9>D?Gb8@ zcq0q~=t)`PGGj#I?U7kEOQGvPiH>u|4}OqnZwK^vQfSJ@{XIinpOc39P)HiR_Gubm+`|tYOK0d%zu9b_A?w$Xrs0Re@E1K9G%ehL5`P&x*Rnk3i`+z4d|34{t_K&(S( zL}L-&>sA4j!D9&S~F`?KJUV#bWqmPt`CIFN8kyil!c>H(qBYY=Q?(dtid&bcj z$7hJP89R&R+ID0a@K)~+1iY?df1ujys_+L|ysjz!0Q0)?{6U-7OhA1^SRO0ay0oMbKaNsyXx#X7{^K9tusn-N zK&5}>LRhH&H@>7GpSpnVVH?4a;>jdyR@NkNq_Sl4%+txa5$BmfrK$4FQ{%h}EvyAF zfVBM^di}~Ahq6meOHbeVCA*^E%P#q{BwYHHZos`141-qy_q^m?g?Fv-D^iPJK|a46 zt8w~!EK6&(UKjHR9A1~zA8>kI)F0G&T^4`PYQgfO#Reb8Kc|+n45!HP))~1Nh9YJfFqAx!}%5{D_Auw%*zA?f-s6fa>S~^;S~P& zHDR3abFg7o{LA!W;+1I+e~tO`h2ZoZ%DiG0VFSUttaHdT_7`OqGgq0OF)>K4TgV1> zm1$#gQ_YpNhw}~@wW|rWiY*nG(pom3En@?0o4kYFD~}lWnGU56P5ZU+H&sTfo(d*x z$E&JtCR?j^lD%}d>9s1Y9vT;6DuY+&F_z-n2nk)Iu1$9fd9nIU@=3K>r+4a;w1%bR zsd9VEL-awmM?Sy~y4;?o>`#~jo(4}#a{(zxGE3r?^kU^3=InQ0=} zLVQV{m#ofDCaVcGRyV0ylBB6xtT$o<7;k65oZe?TY+|N}M$~8u3!Qr%4U;CtV$sR< z^$;TVMjdv$TCIvQmA2tKqA8h7hyyCxr=qG1n)?2y6D$hq66s$%tpj@`sq&`8)beR!S7%oo zj^=V+t)tM`nCHu{!>8wtACT%~$yCQ3zJ^V8@b@~71f?Ux5-%MYLc$3}S!FwOJ5bP` zlO`fKqH1kv{bV?0fo$ZwUVynkBMJ_uLPZXRieO+=tc)D!oa>F-6Zy7fBuf9U{LNB3 zf$(>76eCK3iQ%n#wv?W_>c1{Jb5(uHR+BALXszPRGhbnGQ!5f>UPt~0S~A5|TIHpm zl+9c@r*J4^ zAZWG(GW(ODSs(d>LbEPd38|0xs2sQmpBcEE4f^i&J?cB?GtfYW-X^C^OKaz|i#-gS zPw)o{C%7z=19@JTYgdALo;#4c%ts4P(dk%2S2|WFHaYI5_a$C-yybY0e&{e79Wd&slhczzt)n(M!yyzV zqmD>YP&-sfyIqKr5|pr)Y_D_FIBSxPRc%!(@fCxOj!n+>$w9KsaYOQ6a(D7k@=$Vj zRl4fu_Lm$-s(uUCl%rLn_75B%IFDC-O8#m8EE&c(>g>}K3u&i)L1LBt3g?TC7m}|# zUQfQ`cqeJfS#Nz_SCKzZp>QooDq4RqXV3L39E*$Fgys{6lTfF_!P(W6WFkN5uqP7^ z*xxXAxVbp(OsB;cHj~L{Oq=`$)>mhuBH;7+cl*A1}#9$?P** zxFxnyS>&+7aoGiimQTBQrU5!{7AP>zP=E+Hz(Oo_Teahx3tF%czRNKFO*JmjV1?`l z$LQh=!j+KVVncJ0ROfJ5>Ku}_j%Xcq_RQGP{q{P0GQTe8uA+P-sFQL#s%)T+grIX4 z;{7mZF=q+7UhENuOU`aO#J=2gh;wmB;Rt?(34C4k;?gyxX9a8^-B+5aF#XIaSGYZy zjU{2P$v3sm#h%PZ^aLG9Tm<_~xIJ;^Nb;g!;hDdS8%}TB>@5w4t9@&QjSFM$X!wh_ zMWuLp@La>-7dI0+_RiP`(8=atfBG{8D_aMx)ViHgCb!jWXVmIuG|I|t6Kz-6?tyR6 z7}MAS0V|-L=MMndE9uD>_e&wIAcBEKg%Jo>VQXZL{ThqkcyChm&>|bBm$O z-fMyG)d@!z+7DzpNZ8mTBOYrb!!wLv-GLJM-T|PaTwKSq!{dodDIIXuK|18wH)ON5 z&RS@N-&6sDvkq#@8^iiKT;^yl`N#hJIwr#%PFbAJnRxlv-oNm%=r8jBBX0q;#TLa)6R*y~ z%rr{1^t$Yo_@>f(+3S9L__G6-ZM$vt$l=eoT?RdPP4-vWm$NJ3b=N?r{d{QF)VjQ&U#fM0T_}m>N6_|?e)Yl{`HaOP1))!wL>#Ml4ShLCT zWav=rZP(kyZ-vy(s8kV))P?J!lVZt=h0#l*eH8;0`WFc;DlRE*E&h%3ZI|ki82wr3 zP5WD+H?hz7VMtvp2i-9(%xGGFfO=gTe-Mnnz#k-TUsw zfi9A;TPPRx6{(75Rd5i&o=z<#>F|yDE-U9IX&4%BUhrQe`oxiYQ3~W|Kn0<90P= zg*WXiugK8LNBrE7rfjvHl_STgxa&N=-xkU3w;>trRP>wN?izPugTsO%17KUNI8glafwg4D3I>a zWrGZ!Em38UEa%Unp+6{&oL7D3DM%XmE|})&Ul06Z$J;-xT-#K0p?l@sGq0bQYG+qv zHw<_oX-xF47kYWFb@mok56zL6l2Bvo4Mf7lxsl5e(a_ZIxKy5>i9VPK)a%V_eS>hiUht>n&bO>wL~WsW;7qe0g=CO5r@<+JhxP0{P!R(9KKQG@g@5-%o5MTSsqc?!YuRO5k zmfJ4d|Ma@8v+I6jPCsPusg{i_t8eO|u4l2&a(i}l_La}GH;Ery`(QSmeR6o)w(rx1 zzdbat2~gvfu9cv4yg9_qQ=m2+a`445tWeI@0JYu_c_H{hxiBmAa5-~$?G?*IcpX6( zj)d`@Hi~b5g|4Dkv31^czKww^!h>|H@1Amew=Vo-<^G|%tc`6F!_Up z+-?<=Sy?y~3NV@vBS&a2UO3g1mh4eBa_oH2*ob$}2tiFlc!&k)o9zL=}Ou6bXiszN!=@XWe08 zpT+(wEVEqH#20H7w_@m3K0Fv8?S7C@G9$a&JvaMM6 z+zY#|gG0!bjMD7JuQR8{M>lNFM6y@i*kNFI&_}M_vJ0>Dkb$v3h$`@>iR@kl&z;sg z%kbrBGk@*FEXGKQD&9uhn9hQ?ey7VvYbVwg2`+JwW07-F(IS^xWmK6+>5+PIy?(uM zy=kMl&(r7aOY|kTX>ZhTHEuOsZ{8YzM0_MAS&b=UwXw#Xa#y=+xD!CR==1ozB_-u> z=)rr(V$zxPB)xbGqIz=8OykVbdHMy$i=+i53*zuB^DL`7&%nq)DQf zS8hlVy`d}~m9QwAO(msaD;8#LLd~fsx51&T!U{F;eGX7j7q{>%(Jwcyke0-`g$J(^ z#PM+zMUOM+9p*YQX|78lZ~?BJ*CVQjTpC8*9tCbjS<;yYP6amVz%RBmLg1zF}X;qQ+TdUVXr!c=jsCXLT}u|S9=pbgLov*BF}D* z=sCn;_4&5r7+n@pT^^-0K0?417@$U;TIUzo2&Wfgz>UZ&XA+P zmdN@VgtJZWD&pN47_h1I68C>mH17k<%AC`)|BYSj;n?MfeN~pL*O7uLfI=#R44IVBfgN5%JT|~t7GbV^&IskvltGBqgBDG zXiKmqx+khBiPl9~dvd-0D)W8O!_j|4)D5QG9s-QNPJf_O*+alKki#E@DFy2*3&)JQ zQfS71-N$DbnRgYnS;=tSw}k7*l1`_U4Ru<)?B~-a@kM+n)v_f&AKM1X)|XbzPv*4; za+?f%#By_Ejg+K)$=%6x@_15AdVLDueG1@x3gCSKt96TwuCY;@vgX?0mw_EM55Kd` znK<>O*3GqS1)%&rI(Wk1hh^++CD+Ng?mfOG(R#tAp$S?nrV)QE&%)n0VQO1A%is`8!(AUW`IEE4#t)@7$!=_5VAP&n@bpy_XuR3Lm=S9$q*h1NWS0st7SX) zzPxv3chz6jRn=A9XFuOL|LWaW-u>@u5D2v7v)RST9kW0G(J#OL@MlK3AoyZ_7cVe(YU^lb1* z=()(=)So2Fli`1g{EOwF^@xO!&lA=srKkK)1T2q8Q?4n`!-1)k2X;j{FvxBqPoP5A>_05Nb5KitDMi?1h@`PF@H=C00E~zb zuRtZ8hDy{>i3Wcij!apH9b;$zh|mRON_SF7(WZnv4V0fYfI58(DF<2hHeeXPdeGZY z3SQd#>N74LQl!%`ZNymgP(V@>$ZHWLK&pWZh<154f!9SbzZKa4mS!Z<@}Oj@V+k@| z3IS)OZu#dG*?Ms;D_15d9>y;brw>WNz+!(zrcB6J(^=|X$qiS5ZxwVN-OE|;&gnO50WCs!0!Rn4Q(jnxZlreSGVzSwRu zqxcIZVk}T?ixra{Qo}xaX1 zvPan#i^)ifAn^}Ozbsh6EZ&GO>Mc}@(Spa}j(YM5Bp(|cebL6@(-Zrnc11gUdb{qc z$&%)<+gpMEjz%M~Si+_#JeV4dVMnYQm*rN9)7PpURtd#~-`8Wc4s3RKJ^4ZbAr%3$ zI$)9&$+qBY*2e&@p4_L`31batHiug0&_SWrG1)QIVOraCqcSh^Eo^+ZUWeUH0prCCz`hIhtS zD(B97owpg>d3GQ-_i%pw>kNBtMS-L`7s~jDcrWqsJQqWoP+$lOg_zh^C?J5FpoLb$ zA{p}72lxTxn!&jA*UAnD)e!^FpyQhFq;jzrzHSG@H(gp1OP`$6r?7u8%@O{1Eu(v3x znZE9JW@chJ9>|>srq6Y!@A~jL(`6rh)%=OugE=JWYpvF<zrn_DMJH@83B`cV3D_PF|F>dDq8(~q}5S$!`3T=u!#vwa5#UQ%C(zM#F-m>K-3 z=cn4A?574}o~o*OTD456P^nhWQ)`}@wjkA$ua%Yy2yhH)gSElqgXS08*{9oYt=?VQ zRW&azjXFkCCR;k34lEiNToqZIw|aaPmZ@BxdMx!=#oW|qt>(y}UUcUwqFYE+%+V}; z714+_BGXq9&GqG)IsX@otiQp#^SW(SMXR#*lvY(yZqw=+5Lmlsz^VcW5Ycdze0u?m zJJ26(SQuacK+;9SxmLPrwKv+=-m0pttlh_0JESeZXvnK+RiCC+D=D{tauY0AYoo7^ zFpWsCA;~XaIlu-=z(cs0hM?2O(9>>$?L|NIHvn%?fLs5w?pmU))3$0Rty2JSNCar; z-wx`7P0jfJ*n4Ae{h%7>S&$f!OCuvQ&$*A+?0_HtYRS&IEO+kMg+K6}Fb11{AHJC} z@Du)!LD_V$%8ISkMJD)m7fqVd3q0Tp3?1}M!W23v}&G4A7y7; zjl8jiMlMM$~LkwS03i9n@&swm;^N+N9c>b0^w8J*(%EUD-twE0{j_$7{ZFnRxB+g4*%lw|O0|$_n<&MyBWD zi^Si}T`;``CIPeCvfg0Oy_|h)?hE~Szt(2TW-V%D(`NPscJH3cuw|;mvdibb&pLVv ze!uE>GwgB&FSv?i1_IBPC&?=^GTqat#PD$c;+sh2)h-EL5+1IZ%fVZMH|1{1-yhtS zw}vfYt0>g`lE0wUhHDm!1roC07tJZ)3^Gz7pDAQ3wc0YK*DgfN`r^c$TFg zg=^a;YLjfzdY5!pVX|$qwx{hMfarO&b~OIe_!~9tZgf7nw_sutFrkL)o6Kp^q)@0t z1;YtWgwVtzlLIIQPQ4GTBgrzcR%^b1Efn7bs|Beh7o>bHWJ#(Fb3&q?4o-70aQO6} zIVcMQBX>yy-9^4opjDTVm4a_%!#?yjz~G-W5Y>$CX{l@ZT3*i&=O^-$`Ki2=KP-M_ zf0azpFk&vH2;8QHkq~#D$U^2??~DZiOSy5cxx%edtPS%NvB`O0%(=K2K5q73=+E^7 zjx=VdIm&q>m9di%8y&%XuMojtB32;HMvD-Uzk_U5S`jlm_4uu?)BbooCgK!}Q)c+#^LY%Xm&&VCk&Y`tjV+>u!BqB4@&@W$sp zcYbxqmlKyHs%y_@=+o$~b)M<|vzkoT1~`Im0LV~r#2=L^S=nxVAD-S6o({k|wmSWUG{w_LcQjy^H%-p109{h5c^ZUCLc{*ZRPn0WmqS zWk4L4yM*qAm12AMb1*&~f&=2!)^HT;4LlZdv;B1ymYqoE-MGV~@zwPXvtuEs>Q%jH zZ>$Y%32hIVs-Zhj|8zT;ik`T(P+utGu_vgtMSC6J+hNl(-EFp4X4+Z%cvk2_<#Bg6 zzW9&u3s^_Go?}-C8AQ_Yi9m2=liA7aRMxC#Pi4i)EX%5NQ1&@-F)Ee)FjA8ZbOgFW zPeiMY4oP=5G-M?vB@{QZQxc=n`o)VDe~RY|5bNAoLh;qf5+WFc8bD;KX?g;~58%Li zvnR&XlRE}Z5~i)>ZqPBMQq|zJeI^I60Ha2^e6v!1d3`}FZSnT@_4J8W8)hm*qo7u; zRkYUa4J4N0-k9L=x{@t1)|y^mX~cv+xm#oPZo4O@#+b7ei+=0E7%3Rs2n^F^^rH=Z zgDA7Wz|RPQBL2B)-++f}pprly=yV636cqUeU~RNI=xp?Acy@!Yv3f(dLl0_baf289 zuv2=(4&T(?=*3GZC|E04+pxBs!5k1Z(jNc^zypUu=7a;;h_?=Gb2w@V6{G2G_&tk< z<(BDfHM@D?VcE8Co0`0mDa1KFHd&1I{5_uPEJf|y4Mx>SdM;lw98`q`Ju zYnN>3TYc9x?(k=>Ufi+d#toTWpJ;6@_g6Z*+c!)VljoQ2p8Nit3w%<`!oDvpd611Q z4420nD=;03c=|(haX4am05xeD_WoJf@k|19ue}EtFd}IdAKKJ#=t&4H@Fv#^7<|Ob z2Kay^1qSZ{$Ase@j!+OY+SKU66&@LCBp1iz1SI#A^5 zi(q?dg2#LA=ulaL375cmbPk=HK!pgp5I_)FM?xaeKi$p;xC<+N_-_xu zmv0&LCVWdmL5E< z10qTh*D#!EIo=|*KzqP)b)Hczi0Q${5Y)P;uU&UnuWDUVK5?)juW#SPhlyC44BfB(k)-x_{wgG&p= z+MLYW-gQl5^H;yRwO%iX?;rX7|MA`zC;R(N2mXFVL`_f37H0pi&aRifz4!SjQp>_J z(Af}lR7z|mD%&TUnGt!>H8JuRWrtkTSOZy?O&U*4AVrF=jTb+p0FHTi+KV_Z20u7R zdMn<6S&dPIe6%z+aP%Z6reoCC;296Edc3x+y<14rFC1*yXc1%H_2zYm@2!_MMK{Hy zD=gPrCWXn=G#sqs+8e^JEVf?EVYMMN65Em<4~@sJ5ABS7*7JaO$~_f&9I51|)B7#D1f_$3j+d$g|ONfAW59GJPs7xi$7L=pL@&m4sMAS4$G}HPFs@YBD7X zDHSn90<=%0rjY)f#{!;8wWK}~e;uj8?*+0p36J+GGN-iC`#cRiq&@Ycq=T(>>~@Hb zs>*Su&RQ&!AIrdo}*f)?xI*2PD} zzccd2RDnCTbI0tCu@gHu=^>MP^5hQKXghYE@HE*_Sr@-7er??JU>s6^$0+!xudfgD zvmx2bOL2G%VOmf_6!kiVz@J4`=YhtMzh{8PjKY8D2k3IyQt(3oNVf_a+)|9 z57>$)Jv@-$)oo7X5_|$elTx`%#B0dHD&(Od3rjG1j;b>x7s>9K7l;>ma26WRnBbq- zq}W89>G5$u#FBPg#vb5OF@TaT>j>`9M{5lw7FdcTAIXg_@?-eJVa_vawZi4(FRIpxQcL>Mh1y!} z673VpHtl9@kFZC3N;)FF*k;ek-n?VblkhI_$Mb=~SR%e8iPP-nvY&rz$ucXKlO}so zu%{g8`E-Tu@s9^415XD`NkqlPz&piZEADlFq0&w3L(A*d#g)Z(G{F*UPR{NeL%k~f z!T+GXU?gx=E^$%4N^SVK;Em);W;vhD$wf^lnXxEHS&g+>%3RcvrvM>426o`wfLdni z)&XIA08@v<#RQsxQ#fXuww$GK-b^%0)J+BEumGBnC=$0+zuMUww5029%E(GhE8u&J zCx^cD#s~j)(^`n#NU4Rn+g+(ZwB0^;s$yMuS#{IW&3m_PzGB&VAHMJcTfXMWuX5@8 z;cH)C9&@L6e4o9#WTLV5%9nodA4K`9A%)kW`;QMLVAJPNenAdE(*j+AVl!aXuxi$T z`fIwt2plB}XjFqq*G|uH2}}dsP1sgUY8%bEC8|nBlQz6fXVc&SNoushJ^czl1A`wN zBCaua*zF)R655d3)PV_W)D{!@!w{$*Lq*v<)yMslXkWQkFwrd#ww~XF@rgz?b%sb? z#dO(wCA8%ohtc~eDnmYR{)TxU+F{_MBs>~%Y>xQA=SwE=oHWGKf<5SIv4VeyT`1B{ z{H5_wLJJ+->)26%1v>e?;!cSz^sr}3Xe>M~jQd_OS;ATjCT6S=000&tKeXUjJk%{G zN%7DodgFET-Rs&a-BD}Uw#j=*U<-OGZjMOIWV1@>9%=EfwC)l=XT8_)S@rJtKZxH7 z9q_&^{>=4r^*!;wOkU5pG%ioz>2}$^BfaE0B|(2mEq93~8}XAB{4~^KTP7~Itxc{M z*V`_|+=#opyTT87|Izl3%3=9{ZLjh@@z>%Tj`tLwd>qr@O2;K}2d(M5Bk+rfja`bkrR8*=bNO`uPIrq$-Cv(Ws@rFC?y;61JMxY5*`$+Td6{OHr4zU)Tdu3s|tvv-*E!>9T; zW%~5Lp{Ukc)REk5`J7M^2hWiT*>de3~pwSGa2bDLY9#vnYe=y(h z?KB0z5p-LnbI_S2s>h4g46Y;>30!L(VOHW?#ytUk8?Wki&c%E`ZtLgVBXBy~%LY@E zW`&-^#~*`+;|+oJMfYnD`5(%emY9|}R)p_1-R-bEY-ZK=J5p1aLVAz9$M!Y#Ywo@6 zHWh(vaZB5lk{FYn(+TQ~xii@yD-FZpueB9DZYzrURWQb3 zcG3RbaPkj}@9$%6rNd0sTM9+yak{4Wm^V;Q+_TOE1B*2g!4Pej!$Gj-8<9JV>`KoZX3*rtsz= zWx0OyWb?j2F6+-_1BIB7_hn){Cqx*eCYBEb`b;o`ifX{}5(zhcLsV5t?;PA#bR+oQ zL;@>BqEruNG@Sy8o*N3I77Xb+GWb34F`C^94O0$IuD{FA9*<=gt($$VSU5ktZ{MZ^ zJFeQ)-<=3{4JDJgiXMB{w0idO$<}fvQ&@7Tc=3vbyZ-gMCGCBQdg>alx8sUe&R+qQ zaNgW9)Bg$2Vu7$y7&Xlj{pz3b1ctwyd#J~Rh8mm2>)WnhCkk!WiuI!VHS<94+RfX0 zuggtr-i^+acLwhY?XG`z(Va_ouexXL7lU66J+$_)`G{pYI34(7%CIX4GsI4?=X{f?{=BpA!C3R$|G{!`p{yw_^_!%cZ7$OYM2d&C(%pydGX(= zH@|5O%Dg*t#VUm_WETQ(x#nL@HR#s_mJMNzsir4^l-XX}UE5PL)k37tYYtMgwR)ps znq1G;)3dceCSdS`X%(Ny_s}62P?-uCb3JC0XFz<;=qQNl-d$j83loKz!tsK+;G`q* zmJwIR;J3PmZ05ps+UDA3eedbHg z#EFasFYoKwZ6H+;>=v1=mDzyIsxnK;%q26ANw(@eLuDZvUVK=3{lK?(E>G0q zp_iY<3=kv-JmzyeEyZ=M(TkVW*I#_>(L2Y#TXLd*xXD$zq3`HpOO}_DsakB}$LEc0 zzxwY#{LbC0?C!d>rMuK%{-Lc)x`$U^y0mNVgKDjR>+{p!>gs;@m+XS#gQNEy)h$+A zFrrwjD<&on`f?4QTSMZ^Vr!YWXvbxr-`Lp`3T4l?U6$-frY{liz5eE}Z9ISH&3i6B z|D(U@+LWzj7TvL;I}k9#jKQoAg6Y5D%l3%RpQE|seNf3LH&fgSSJO%;L)#$^Swx`v z0}iXh;0>cYM94|;|4@!}d6HNvm+G$PQG{T2IK+_@zecJ(MAvAi#1QSp;C&tf#K7QW z4BpjUbb33#UOR&iI*3Mpeo=9WMh&f_9u$iVE@`6X1fT zH_YRB>d_ZF0aGHM7+x{lV=@xveS}Tj5FXZ%I$z=w^WC^8UDBObxN)FxgFxX%gVKx~ z@?FhXVyLf|rTCF4zB|Q_OyOxx@mM?tf57);r6>Lf*)9y)`+C8tbU)mrXpZ4Qmk2Bb zCmPX4ijIR-qI$JYZ>uYPrC{w{NEJc%P|cWy5{reG{}x?_-)ADkgwI zLi706_F^JG)T$H{>QFjWOrRXwsaMkVd}XjZQD4Hee2>7N5|*Fatt#PA#x|v}y$W+F z6UrXtCyE*Pm*;ih2~(L$vVFLHynUkGJlQ_gF79n-)M#p^{dl{%eZ2Q^_{IqR!%QZ7 z8Fn?T=X2sfGP)Z^Jd(bAZaVlPF$*9S(Ok?Djsffzk>X@LG$W5ZR8M_W&OM<}CVdXa@ZmAs`)kJrj)C|% zm2t)iPi5G6W+F3{c{Fn>W6?6h8BwQ2hLm|{XE$H>^&4y8v-mbPL9%Tyk0}ZkZ_ARc{N_P#^O`mi)TEZ=vkX~xw z#*u~V>F=HjvEdLK4^4!oFlEH4kR`M)z3(45^U!U>@`mk=wPA9@CB>r|5hY%+Py7P_ z1+*ju<&Owfx#N(In~>b7`z4m}HjU|l$VuXebGjyb&rm;E)P#sIsK3~@U_o2k!Uea7 zI|k<#FRlO*k%+_!PUf>bKyNH;Yg;gvn$r_Q$?xZ=Vpr<@6M0^nJ&BAlgA3328e(>~g z{ee~zxiEez+#od$JO~6ojw9dX8O2Ibrjwh_wPLNfO{Y`knGb28p~WemFrw`RcuqWtd^@b5Jy)fzdFJ$ zQrBzdw7QXPbiJwmQMIgeuSkB^_Fd)wRxCkVKuyMz$))1?F00+`^0q`AaaY2bw5~Ia zAeS+!u6M8ZTEplIoJg({=W$%s9!MiZeVJ-f^1#&yw_<9ATR`TDHJo=i@X<|u$Ae!f zeEV;5O^3lL&Z`*wne%F;(&%gQDl{EWsF8*{1|h?h9G~h3I&MUDG0~02RBAXGNrWp< zUinr^ehpog59gC87=A4n5ZRTE!3C@)R%}Tqn7kCb6#{Qsv1&y z1$2O9@9L{Vjvt{Nlod1|4u=$b%`xc^PdV6e#~TiD!ZAY`kzjBSPzI4CD%_#$giN(6 zR8-XFQem!TxWXnYQFJ@%iEz;Mme)v~l}v{Dy}>Sa#oY1Hz7We~-1cDVLeu$s zmPg%bl2PYD|GFTf{6-Cmkuf|X1fhJm_VqceOln4=xU^wh+F%|Lm~5mLG58I)RxvOX zEC#P|QG>xR4)Dyi<#~t|87~P_>Y@Lc_e{>3suW%;b&^rqv`5LtgZ-(#c#Z{{_i`QT z^AXcg%32VlW{k>+PVr0(-ISpcF(9$W)7FMcbT}~ikzr68M&tm`zK}FJG!>i)p2DmY z_~G{tEbFGV-rrcz&4T+{w)PAMnI0Stjt3_&b;YANP;wL#(oicaCan4Nd=eYCBv}=K zWzb&LxD2iJNPR)~l!FaB*tlcDG39vFamrzF>lLqunzSw2TI1xLA0Gs@$TK{q$M+#{<2zB6Cdpp1HX`$TNNtn<3D-WXjN+i|SK(Xi3-Tb@OYu`8C|gDZXV~L#xp- z*#53@4Xur?f$g8`cDe>-`S|unpk7=@3xunkOIMH>(3YeFTNr%6-(9_WbW@Y1kQ2Zy(o)5p^A{cldW_qgh}Ebk zA*J`WU^eJ)1E}zpuoSNl^uuJ!4#h56%@%3-G8AJ6mC;}@f;Qc$n#Lxyy_$&RXI*#o z7AvJpU#*u-^zQ8ydud-_&BnpZ>eb0L!)wIJHB)OuVU4;*Tmz0j=nHhO8Q(N|SiBf| z@Q%=7w)Jk_gMyqsjzoc4TsVtaleiOj!P3i@P=NydQOU+aG=(Rn$jvBxx%0D@;oEI` zhOKBQ+>%Y_GL96WU9MJV_FT^p7%rL&64tM-Y><|AR>J|ya-z~h+d4wam8=C|DrNsR zJBX506~f9~Uy($Cn&ST9|BIK%RTyvc0yj|#o;8)Z#xigNXWhrYFrd5G@K#Uzm0cTd z^u0}*|GS34kG@@x3@Oj-umP= z>*Az^Z|zvsRax>DviL0-(YyI2g}#S$Pa^Z)2>VwY&kvTh-1D2mf-P=;`#FE#4%z8W ze$MnU8OqL2_N|%}v;4ERJ#9%Yr*h7iIC%KA9aFFO zBf)e2x0z5efwfH}uRAaBE=HQ`NAJ9_^z-SE5w!YvT&nKce1h4ENh+Hb$CB?)d3ZuK z?K2+dEy~?Th+Fex?ZMEOdJ)UU2a3~$h8L+QK3Y>NNbui0KWy2Vs!i3+nI~*=UwJ9Y zYQ;6N@ICo(Lh|0{n9Oha>{`D2?)P^m3Gs&{mwx>^V(s;i%{ctlmjLeiuq+4o;J@+H zu2mK1eYPyvr%8woFxegaI4<_$z5XhK$V*AdPMckgUhC9IOC`9QuIIK~yznWtbbne) zQb@bG=Ei*_JI$@0>u*sLuJg$X2l{fDK9sQH^c>%R-r%e`GsD*5pp^ViiUViKNwaA9zxbscKa8asH-PmwOYTxtV>ibtB^{w}XRrRc^$x#$5jm-;g zRjpR-zxryQ$%-%2VoPIG%G1(5E#Zxt;(jv%S79fTEgC2yfg`p28N9Mv9-66imaz%9 z_=*tlYnSru_83af=o{bYZ?PcUzFFX>48OkC2S={;aqZdT>w`vmzD<1-3+1prmB!AO z6y-Ry{%FiJ$NP1(V4Z7+myReL{*q~xqnOoL+v^p)ZpYYM1K6&wM;9h%rA(4>^f?2=rw;5sNGI zy$l5A8O8o2u(wy~h$@-Wli#kwZJ*G1!*T40qj4Jhdd7UVm(~47ZnC^Fju%$GXPufC zV*UJ;mt^6yYca($>)qv+#a-APOPP8&mV9U|RpJG_lwD#=REp3=88W8Hw{-}HP z*3)etYVxkSov$jPlx)VwYZ1%vS6{u7_!;8Icv|_$y57lq__c~)_{wXgA6mp!m0X${ zFCJ5q{2@qwY~S#8Mb6z|zns^avYcT-q+`SODlLs$-Da}&+G^?PCXySb=UcyDR)0Ep zN!ul58OEeRwyG?5-JKgXCl&0lTn3Bq^@^<2VkJ@HN5l6;q~W_QFKg6qSXAuy5=-~XE_Xc?8~MQhfKHWD?<8o)zt{Ppt93v^GpdsDEH}LHf!e(V(q);o9FdZ=T$+`rMk7V52~zU0dwz z;tkhWIj2-ln0t+>KVQ}G==S(?{7cC#MKf$x zUmcnyLYIBuD<2Gw=_Py#oQXM*T(=Vc;Uee$i{fGddt>DH(ryo{hEngfNEt2PDbxI| za(`$raa@GGd*S?(-j*ut>ozXC`EbpSWujJs%H!+W@G_Z$ob|lUdf7z+kNDC9tjk%$ zb)wqx-798nY~Cz1|Iq$%_1%@l){l+VDi0H0Ho81^(y6QtESM*1y{1BwP+Yuvy}{+@ zmu(OD^LQ>cO|UF)I%6&Li1SwHvwMNP@egKR&rI-gpV_S2yP=%4D{i`6^@aFD@tH;i ziyy_eEd%AIOvkbwhWCi!^PWv{mzVk;xsr3)jr^7j-9g5@IMe+7(L@ION34H@jD^I6ROy@ML9Zd&;}E$lhy1eap!%$$P!F6|h9) zoGh@EUVg1)Z`+h@+Ag;Soep8sH2-UBYH7_OBn>z51Ki&x`EwjXtr3s(v-{`}~hqE7-2EwfV7ZpVAxN;g02f5?p$Q zNx}`I1+7D6l*uQSTGR693XExDpE+@zS3l%_%bGd4e#x6mcKL#z^#$h1lRDQId=)#= zb~wqWt7YYtGkVrn!mp491_x;Mnow%x$`+cNCr};)4EK7arS;JQ%EZL| zp?aUA_<2*y3NA*m`ro+r)*l~|$}Xpp9eVnv$X%Q99FkLV*3s31dz0wu*X6eGo2CZv z2-7_oG4X^T#dr0D!9`{F8DsZGMP=FBz0-y2TzDC*Y&WfvH}+&3#@rP2f0QdCslaBD zSsxO%>SWs2^6B#AjoMS^W%E~7QxCSC9##>} zT=ITN+p*-9_-=EtBQc)Ba;XhcryZ={ObIGo_Tvf{S?*(4t~&bJO}BE9da}y%g$~J$ z18d6Y3C-Ke?u_Pp@U6a0nzk$88A&Q#SkAAxvE3yz$ct(;7@0D{ueX&_+;OBuEI`L$ z^suni;2FV{CH#k;9=~~z=MK+g!Y(&ks*}|ly{o-{j=x$N_OMKDSqPVe7n;yhTOm{}wZUlw)3hAg;%Y;xO0zVZSR%3$4``k<@?W2BRZ5b!YESxr{8e(i&8&@ZHm$M zxt;Zv%S=HsL@=1G&p&lrjm{05)ho_-3rbuz(2+ivWOQ@G;gTbXx^eEKpRPp+lpHJ< ztL0l=ufVmu&~*BJatvHkq6+wA7QIG_o$P(>bZk6Nqm!(Rm?D6b;L; zaf%r@kaz0SJwBcWmuMb!F5J0}JNa6?KdyeQ(a_^hic;LLCr>A7x7Px}MRs`H(13DG zwE}ycm@#*WY>fRtyO598llFQZC2{(*MPbFdIzAOT9H|tC&OWt_9fn05VbQYDEDF^E z^MXS|m-2Ms-MVhfRGUVxl2@VbWQ*;|tj|>yYgzhzeWdK_-j0XWkH$CNdU;I#o*1WK z`h@Yrr56|qcDa>_3Xy)N+njHGdoa;-A$7OMg^!k2hIkF}pRWWCyT7&SR{u<^s~I-u zylAo3LjCTVE`Q1Ht+!W}D#{a@Sc()$%H+0-uEa~+rH@b4W~JpVYIa-mK~`lQe(4ZJ zL5q>QW%b(wPh-Ngo-0>vE#JOCrLO-{SZ&`i1FN2dJGjVKmGf`5znQEi4B%2){g372 zT5hthU9|TN`zLjA@5*(#opQEv*4-=Rd|aO@Mx=c|{_HsWROr~ZOIauHOjs70_w@+y zI;NCX*%0JwL(b=U4C(GO;mBX8dN5u0<^HRDq` zEi@r-yh(i1RrLj~`4*{8se%o5p=)N$pSyPF3#C}6?`ux#(F|xmeCU16zUs}qikp_! z#Vah;7u8%U6xTGz_Q!19BS*NNWlLPRc0&HK z0;6bTrF)9@)I`;IO@!5MVK$Ap=f%g3GmV6ePiUy@e#}mj+eMH z=){KPLc-1T4Se6l7KLgklsH{G7}BVxcI2tW*Qet$dXYny+%y9FHoRcDv*CNt;vqK! z5&yz7JLVn!C_3|kT+o_*D7D6ToSXXA?pV*ri0%E)_p4%KeykK>Paz3upI&$H!osF| z@inq``zW?J*#YNMQSY?l&YZZ$kXh7}$ZE?*p~;#A@Hw?Gy{(M!+cM|hXnyA3V)IDs%7TPPYf|zae^jp8SllMlcf|Dzove0> zD`)$&sKuARq%AiT7yM#+%6^r^E(f<|?APQQ4(wrn>?p{p+_`c?mw{&Ah_KJiQyOWv z_E929k#Q{}jUOZX?Oe4xJRJ4xe;$;1apHDL&o-e;aU&g5@7X0IzGm`i+|@KYxI+@( zc+u1H^z*fm6|2MQd+l1C4| zc*Nh;LUqJRVMW5D9zlu4tFsKY60&-H4Q!iSHVqM<*uTA+=Y7_#%3X84OP^Omj(3w? zKZ{mOLVQ7;(9~uB#2fIL?-AX{vaR2-{E&bfJMBQi?Gp^w+~e_-%2fvQ^E-I2f8n%H@cX{8kA0Vv=vdjV z*v7omMu+X!ZQ#y0dUl-wm3*^m*F6vOQ;8+-zS(c-y{KSZt+2mdtN6u*J$A+ZrFRv& z0vy<`JW>++x#ErOkEy9gW4HR!`)nM%x;1YLAFI1M@``(D$wX=4@_DiqDkOUF?L%DW zt}B{GsvX;|+^Uy6&EV&i+cep7w#x+RlzXPR>e(&fczpZa4~!qNX-Gkt>AN zF7vu~t~y`bq)M~+L#-i7T~|U(+DYw$5gTkDkF)RCy!O;`zMBiKMqb^MS7fz#{e%0h zZ(1+5TnHPu@+NM#-?_;TU2h(~xV+nKBv4!_Afr!GY(^6D_~W_5{oQphEls);Uwr>m zf9j$4sIK+l?0|C;nR!`XUQZnBd6(8O+JCXuC}91H{{FI&D_6R=7rhErF0}VkJ15s! zlrlW<`jtndfwyzvblu^Qt6L|Fzh=Grpe%b!+p@$*n&Oyy&!YcSt$4~B`7332J3Hkz zYR#;%{A}BNBHW~{(`rqqgw~-$p(%?l&#b+a8PuYEKBz=oPp;h7z~&W%b7 zA6((=vG%>%^o0d$PwrCa-N8@2Q?ogyx+g}5r+ameJ-=DoisOgMW7m?GL@IEZseiQc zVljT-z^BP#EEOuvou_@_=E7_G1C=;o^#no*f64Qk9@XXZ2a|Ic*W}D>TW-jidB`^| zPs-}ve?#tINgHRmLDzyUn+sSkT-hQLm7#80urQCKfrX(fVD_AJfK$D#_1Vgsd}bWR zQfH+PT+@GKL-g%n3Dp;*C+L>0^d%RhpEA|A5Vpc9ojqCZT+dlqi`_SMMT2|=G8@**W zf6Ti)_&rVShwekVJL^M=;Ig$AsMln`0Tlx=Y+`2$;uTkmQl)Gu_ zwCmU+-E~!kmc92G9=WHD^ZKhcwNXrRhuvGA7`+@1ewwt}%XPZHc6#@o>D^bS+amkN zXf>KrA6eORuQqnh`VO~L3*Z5Z-qaq{ZRvgJmeMq*w zQC#vSJG8jlIdnz7r@UQme&l;~m#H;x7JP7V_EE|`bVVqfFeTnpyLBMy+nam!_fqbK zD^Ci&)C^PZNzak$zA;ppl~vSS*xa@#?hb!%gyUO^&qQ|Qwa3_ zWmU_g88@Gi9dk0}vQKfEpA=NmPuEx?BNvq^{KUAYM1{?LzCbwsE&FwdJ)=){>R)J{g^bUtmXh%z5wTS)QO{k430E7rowk&Vur! z)Hi)I;12cte7OH4|9^gif@g z#ch$q^ZOPu#=^G8dS2j9qVJL*x~z8^vRrB&txUOHtZ_7lVAVe!So@gWLiP39#cmd= zL#D&Wy($Z={6d8Elz4|BxqSC2Zv{EX?C-r0(yZbjZ)TxcM7bsNzkcBtxf| zZS1C>zNQoV9$aHZ&%Jdv#8ZnNHbgyovt?7NP?N2FQ3$t_WB!d@Q6lQ=gvMN@#K-GH z7OXx<=}D+}THBH3Ahs$ZB8~l`hMMpjQD4@@8Ej{w?Z=mWzHT%bBXw#$%hh=M&w_8- z_sJg9so7hiI)7SA(K9v@zy0=u`Ok&vt7Ns54WpMl;GBOXX7bprJDit9@-FGES-W>; zhib~F4L^^yYAucmxg=CQxlivo{+q~;`Pr8S1D8qazP~cH;LQA`J>?>C&nzko`d9^? zcfMV#!duq(^iJS~{D|uf59U`F^sM)_QfrN2l(Xejs4j#oOXb^DXUk7lt@Wy$%9~O& z)EI-0`^y?_&x}bOyhD6(`hNMq?W@&6JsL?`Qawpe9M5U{>^vcQO!p4|=cp$8y4<@} z`@TxA>2ca^u0CJB=c1tUGsUjO>pBkT?NF*;II>}$`>M%_b0jIc+I^5R<7*$&~D*fId;pbk&HL?pP9BnNy-qFPUJ?Cf(UjuM-pC}Ys~g^O zo{LSsp{OCGwnTB^Q!ajf?RmX{9jhipBZ)7PO4|La%}clR7SF3V+PG|c{J@Z=_*aYg zEuR|YO7axps`bf%irzT!@wi)rUGN*EwU%vbmWyQnFhgAto!W8L*roA}R}`15=F#$PU2+_;t74bN2FLKm z3cTQ{u;kfc(X8=~@~%Yk@eXP$^%9SLfyV3RJv|Fo>ifOt#`lix!-8hL7}&{)L7L!!q?6G z#QZ9hAFwIf^KKP>%8|e9ID1keE7d@;Bf5R@_m3$ZBNX0j7R3wsYSBU;Hm;72kmS}K zjj-Q8)E*Jm^qGxQtG46X%gQBdL@K_&A(1;}Wiynn-7+5h!iaS}7o`?G8B;kF@#MwL8@4`ozL6eCgtyFHVIhG~Zm9d6C1P2cRMwdODi zLc+{WRO5cShSoA3W{xTNPX$?=K2k{}tvqdFkb5M@!Qfb0<`F)LRU(T{URxcd8E-y# z=<(Jvxgk03rNVw&-$`B%UUdE3-3@0&lnU-f9Od0IDC4!d_O)Jm&6!hPhUrI!h^yu0 zGQ|>08eFZ1@a|`WrRyJ_4{`cbzgX#sy`;5XI$y|-7dDsy}P@(y6Cj(v$s75 zxb#;`HrNz_EzJ-y~evTV^(j_A1%l!>=N5q1o5@#;la1n zXM#R?$M<_ygd}oVnU7oNSUuZgv&oL*Y!Kz_2^-4mokNf1F0-#2GJWp*>_<6g&Xp%k z!iCKjACwX$CZ3yGl$_~2Z~UV?9xn(hov~ZqeSTx1>CWdis+#GZLAn)?$fZ@3>9#{l zAl*^j;X$>!{Cw5B4<+sLwC=@K++N~c;9t43G5vjuTY{}d{>yhKg2Xw#eZaGR4q15K z+!il=?(wCaKG!U7yc(4QEp7^)x2bef z_3^z~`zw|QBvKELeNNViRkerTc989q_f~j8&@$Wn)2Eg-`c%B-m|WO6Y(T8p z*^SD(w{%$<<53Hv(VCud*x&f6(7i7IvVDiXExAf-l(D)iHY1z+V3l&uM$7ac>$^(L z8XgwX$8!5FNIy%qf)7(H0BH2P7(V{ezD4TF3X($NDtwHMqCIrxK5$_+ic ze|%}s#;(=&R<8x6I?t?}yfHeOaB;JP>&u@CTpmk5%SB$ky!K_BjYG1?a*C~jSbQo; ziEu41`SZOK_ih%c<94s$GLHOP!Hshu5V~Qm2tIDu< z1gqlsl)aFls((EI|4r|l=7x$^n&eNXBr zp%*+`m9}R1eoOh2oCXD36`M^Smp9jRk!|J+ITtwB-_P^YN|cqomG0m!@a#fsoKmm$ zXI3ZsBetw>B~??XvU{BuE(^UwmAtobi+)^d)2T9r2wRVFk%wE(Y>wFdk|*88^!)uR zep7j(E`<*VrNhO=MM6XFFDy;ECw;k%{;afj-}F#^*xL_jrdl6vR(sewN_^ljcRYw^ z8ECazv@vf{^(Jc{y?~LP=FhUcKUq`QwPXM4;}iaH@n>U75{W`ovIv4d2;u9jwAsi| z$r4qJoCEEh>;vupaPC#shxpn%dN>E-9GqR#j=S+?`aVtSLr#BVR3NH}?%; z{>~O*#+Hs@9*zw7_2gp*pL{-WjB3@@@sH0{jDI7K=&_h*9 z19jjw8=2y?eEgkp6h*3nBc4FRF$jtTDw#|ruf-AZM7$E7szjhD5b(-GyfU7GoBb!H z#sxJMeRj6 z58V7Q-N)b3$H!C6+Q;ANxAC*Bf0|(AYs_-*f3(W)V}Dx*NT9sYIW!nx4p72ai%D@6)M4uH;}qoR?5}2I?}#(8z-`76 z@QMVIA{A#AWbYpshBMXH)$;KUbPfqrQTmq&zwO}UsO;k7?`0pTX7B6k>F#Kc_zaC! zQTn6nU&jZ!2YNdH1`Hw+VoVLsz<+I>>+p0(f}rea@9nB86{6te3?ImO21=K6mW+6S~|uSI*Lv{jv*>aXiZP|e_fK<`mZ}-kp3AcM0X=2Wo;kFAjFaS z+G;^T?oP^7dn(<9?%<$6aB-k05GiCw1v5qYII)K*Td#6i6g8S%L0EBPlph@Xi!_3f+-nPnuizx4E{`tp&|Ie@eYsG&y`Gt!Ar1B5C{u3U#R#`D*vGCKf%(kG5-^~xc&%&;NDJEDi}hXzs6X^KVqzZbCsv- z?jI0{WBj_(qbeEWh|HkN#9^mJpw}NEm)ii*3U7+Hz*8;CD>{PjDYeO);U7)kGhCBG zC9~Y+Xnq}UDSYbn0-2)I!oA%(x7awAv50psTK`v&{^#38CP?HtkO(vc6XEY*QfbrR z-lxtt@7Yx%Ett2KwA_YY!%gFqvxs27HjVE_RFLdgr>pi+@%mf0xLNJhtXrH9x7K|9 zvcsa9k7w9SM|Ww>%aw{H!tYwOa`-|m-V<<_?@r#+&08S-n3ucQ{QQrb(jWaawNe`S z;})NkwsN`j+Q3WOCbRthbG8`8FWxNi=kZhXw$!Iwsx^MpRRw(P=s) zEiH=XN5T>8erFR02Nu?qy1L`NJcc|x5o>Vi_Qd^8L#&BE*B7w~+wb5w znDmpCjfcf$#XRA^;sd;C|G*G`XO~3;0(FtBtd5E9qJNtvApJixO+Zs5K$-xL$I%#y zWFp1Mkxs+%1Oz1lUWrIkAW%`BfJB^=@PG0IUjM(BCm<@|i3&u5C7z*-rz;cS_5V(u z;D21@pFF|;yYmEiI+1QqrJxL!gOdV3llq@arI5L9H9IEI;(Ag>xM@9iQ+66Aj94(v!ZI$3MOvw_i!XRda&=&2B z!!sjVQ+rouH7tdKzJ11)p8W_~(>}l%fuLlmZ)&ZfA#dsKEdti0XPXVo||Gsebl zywM`Rfr2pdzkZKRge#{%;_wX#CDtARy}C=jotOK*V2RWYe~q=%tUIEvRV>bF@u7WnKwk@Q-2U(2P7Uq8M0UOt%==+kv|`JDmZ9X@uKKaIXmQk=RU zMmN8d;>J>Nz{KQM!L@r|?LW2Y)L#DVDO2%M|5AeX2YjEdLzHT=Mh#)}XN6tdDk+Tf zEQ|ZB**n8Gu?v2<#X2~kom6OQcmVG}5H0-?BxoTMQhz{SEV?RQ^1&%?d%V8X%1^hs z=WYBRCev`^a<;&Qk?psXlv$VYe;Bf4S+pu~1LyIz3Dc|W2~x6D>-FOTnjR17C)~Em zgsw2-Aio(N5_;RQSO3Ir!EwEL$>EAIN!zM?p0s#LcuVpKwb2-&?>UAMq6{8-FyyfAyUo9zmMm1q; z!SylTpJDIxlWQ6u-e3Gwb08_DU{yhUho7BMVr!P3laZRFN7eVZVSU-n6z``apV~8a zU5k?t@>l5mP?+(kptC{#SlXo&ja8i1nv*x*_Uw6o{ZkiTb$U~{W7*bKM~t+uxeTgb z@)Q?ZWFxP6+?gbK{IwzH{h8<00$joMe2$~ae!fAGfhAG|asO`FtL?2z zZaMcIEXn)I{jG<1S5GphOoRK1-&U2NKGyI%ElF3|4nERvcDXKcl2s!k?DnfiT=Jz@!7;&SswBz5lqxrj5=)oPtP?NQjmO|)3H zc2C_aPlObr?@m3tmVs-k%VsUKYiQt@NRH!gF+B8id7Cd|vtXa%WYWC}qr;V+#Uj+D z;-BJb&)>~-cHX8?nO=G0X~9qP_CF})~Ptw>t#KA`4iA;=?9Iw29_ zY_2oyY}Pv2`>I|}LOx~kLU7Ccr}gwE`qqZVy0bf)-`k~3=I*z;Lsd6-f6lS(g@%k& zv2(m+ZGF4XuEfrinJXnqLK&nbyGX~L*i`gqW_@bUHj=!!Bcu3j|Es+U5!2!PJI*)a zZg(+86}faZbnGqECgVBS+;h|wUUuxz$ZVL}kVnPv}>=(67@nMZk zLBbyX#jBridmeDua7VO4dR$b;VBPsmALWxCEv=dK8qrNn4r~%#U^+jlv*>4_dhMl* z-BdxRQ_0~xmt7Q{j<2E(bm=vpP!~2Qv^2?HQolkjp&#i_B)Xs77^D}c%NlrEw?-m0 zy^oyB@1C-JJKtit04I~tdDKIudn{u&l{aM@AMG6YEV8E894BJ5ZGYIu$NW`G4o3^_ z<>UzpIXP)sx^N%QnP#s^nIG})8&)QkcgiK{=0>_~rxd^FKk+reH2tgDx%MVbzMDK{ zCtOwEpRf}k=QwXDyIA-7QiJx_@JHcp3k`e>@|$m6=EQHRQCM*LwX?MTsp_r!ol<}L z`5xzek!Kj`BiVOGRA85**iW6yO?TW+Rt+u|Vx3$Ud%?`9|Grv*ex$qYgV3DgAwzfG ztxu4?aZ1TD#>-sZcO|K=Qmok=fx zKdt{+spCp291c$?99Sh1MxskDi@6Wzuy4{Gf!IdKSnofFqL)}8D#^eO2v9_5a) zM>&s30{Wg)f`r8^>g_+`PTA0hT65%99(j_*aH?jX~>d{5~al;0NZYE8hsnm@Z zy9;mjAC#fH$c(&FpW0Tn=_plqP3o%Mm11M7EAHk)vAJf-;rQyBt7}= zwC=P|#c0oWfzZjbD$*}TWlS%`n~zxSxwo-R{N-2s1V>g`?NutQ`C%(n>_d94Z9I4K ze#`5DQ*?Ky9jV#tlqG~N%8uNsOfxnWTV^E}y5!iZihURYcctUb%}xA3xcCE-3PPpI|vx-(L@(12bfjc z^&Q^$vqoWbbRmcIS`Mvy>zX9CYYUie6gWSex3MG7sq@F3g36}7JQf>PExc4}YIs!M zL##V_EOiw=M`khJQU|MR-IAAtt<4jNOPdY(N|F5pxsqONe>eZCC^-*A1UBxTz}(vcdU4-!PQEwDe{fy zV-LhMf;T1w=cO$XY$reSP17h_*^tet;riy0az~_%$&GIewa)#f!wugSIYu`!mLKqR z)3#b_zUYy4v94t8p0CEAqQ6t?Yg;NW9e7cEcj9~G;86J6h0aS|?qmd~MSJqAJa;rA zX!Gq{_gZf+E6a%ipRB*)5X0Oos{VJcRZCynA~Yb-*$cb)p`eQvaIE#UEq(O#wT<9g z!8x~8N!uDeD#PQIkYhUceG=SAQJ9|g+!vcL6%9Zx?CdQfdWBmeye*9e9;9fg6TGG|Z; zwrCj)YB(BpXewF{g)x8t01(xGFQMIzM#j-7SPu=hqoLE{Xmkt_SQQRW2jG~K=@bl^ z2yBEEIvoc!v?>Fz4ku?2013j$n}weSa3jQ{^U^4`b1-0V(_kE6 z3(<)Hm?zL@;iWU-MX;cCvAKvd&{^RO1O}7N1fT%{5dm0*z+iGT;^J8z08Xa=;z>j@ z__h^&T#WH35f2=XhjYOhhLn6^VaovC!S)0GqavJB$#x`In?$6*J1T)rzE3=dkg>b0C|*P5^d=v?Dqp8Muu^fs^BblMr-JN6`O9-8m}%TdK`b7~2!({ZA#vv4HWvErELx z^?nxVc&79N4`6fAUT6#rIB!n7 zVPk<0D8RAUIe=p^t$?@<*)|wY0quhIfp(#RmO%T>t%XSmk`Ne!U_dlL`;w7a1fn@*PxX!orJInryygJj4%t(!m1<&#f}PX2qP2{V241o zMI42&Nd-!yHY6=`C7MSDJ&)R`;A;QTN3x?Lj3fOBSfLVu(}5$XXiv~0WY9-6u)$=& zHns+w8o`3v5vHjinN+|orf11S;4~x=us`gB;F;TpjIY)KMB~xfkSw4vAPdloED~@! z*219JQb}|>8b}ol+)ZX1_<6u1m=6d34jnW&@-^sSf#?Xkuo4{)nvn{;1W?ccLv%zL z@HgpzT{`$dNL$ju{-Qbqs6@gn9!UM4-eGT$RAgT%c66}4bfm@5`oOz%&}L9WJEQZX zRw@zG(R9!ubl?@N4P=-O`WWGa&Hz0K<2Aqb0>=Ez-0}oyr zvmK-og97^Dr^rA*pwlw&jJbYr)L|a-?tn53>_6CPGzL5igmVNv*n4;f=&^qA4nX%} zW56L`Al;7ILHZbQN@hEFC9@c0fMhaI!~_^*5JAt+wS&LFK=OjxN#LFSY6lMobTzXb z<^o@lK!dM^Ohb zECYm|4ht|q*chPTXFFgv@Fdm&RAGQWPXP>ozXkCDNGYt0xDKQDzrNcsKpQYH&V)5+ zfL)jiA2>pk1M9#V*gD`t{m~9UfEJ-5ssYb35T5`aG0^EiTTp-(8NdY$-~dEP25{2vNij1vsjp0-%D1025%15Z&NWD2cX!Goc5tEr<+M02BgJ z6j&dTW=kMaAj}6ggun!}0On`FRM4*!GDK!5ge0K253Pd2J`@TPfRo@cdprX05`h4u zLqouan)3&dl|t+Nf1~_!#PHv~|Jm2Y&OLYj|F%Syc@A&?Q~CS4O#IH_`R_}#-tY5% zdq;SkJI8+sza0=9_=^Z~14M)0-UH4Ta%Mr)L5z@L#@rqxj>wopiERKz|L-;ehYA1% zHv%h}j5J4h>;Rw;ks_QGcO?EOMFGM<0=`E*PyzV_yAQ8m58)MSLpB=ti$nrrHrIi& z7ho~~bP{AQ=JfjCl&}&gLr8&uw}FHTezbW`#-R)8KoaObq_Cj^l0yOw$b<)}K@ud9 zn0=rJ2_#U0%s%jQ;SEeSHV-Tmyn%~@ode<(cmok<_MuhaSj;}~rU)c3?#w>$WZ;d7 z8K|IDkb%eM0f)fb94tT{c$TY#*G442p@_htwGv zNX+a5)dX)qQDokrhL!;$BRd8a?17XhvlAPE91zrws7wYbBl83mI1-TbH#-M;FhpL6 zL&3j7;DafgGhvV-LqH?<6zhU4!f#!`>c~5u?E*D9YY?Fotpg-wcF~a(Fl{BY!Wqaw z(%CL>K>p~$@^K(_7^EPwprrw30-O_SXdbeL80Nw4`;#jM$3V6bNhUI6P{AHxC14V~ z!E_WR&i28I$o$Us!M-T0o$W)bfZkyC5eR?Y=r2Ctp8)ya`t88FAkdIsgwBG30C<2R z0UrP=2sGpyG5fG4z#X#>frk0uXdZAFJea-%RM09wS>`<8Fn9y6ADagp25(Fc0xD<~ z;4VzmD9G?(aXFY!sGyN3LPlaw0Zl=m0RJG*11b>E&dCs}KnrY#1O?*ZIX?tW2YLb? zD24+*MBy+2#j=>DqJZ@N#T%i3FGN7$EOS#tatLT=CxA!%%WZ*(7In=k5DEzHuP&7T zB2bZo4_*ya$Vi7m78dzJ$daO72xGx50J!mVaFeJIL%{>nxl|(FmVi7j8aN(QFi7yg z{1hrmd!m#p73p;p$fAY7(}l;ZoKg`2s6bJSs#K(pQIO0OMJm$xR3IrPid4|}e-b{- z%|{L&a^ukXNkp_8A|Dm#gkb~>&@UcDktnbxP#v+&-*{{PTRUukr~(l%ld=$y|KR{4 z(~L+Csv8TinI%j?8k!0k8re^%pa_@g4bdSAog0qy1(r8JIutS}kOv3;f_NA+vrqx= z4)!L3Ci|7>fgPEFI0~<3?J|M_=)gd!Ok}&6HrNhQ>VSJ11Z;?92`DDU)Iaip0U9h* z0Mwo7(LkUuiqugC9x4#}fvQ4Oh66%3ve+niM*u(tuKR#p(F=2Tq)q7{ zoXlD12LP1a< zF{7jF0PG;hlcIwsMMg@M4!IJPA%hAwh)F$o16~Ew!8`>pDS?i(3brY_Pl7Fw@+X4; zqWUkKB4rCGgN!h&h}16~0AeC>_WB4*6Cx=C40LmL&R2YT`&j7G6RH4KIydf(AsA2$_LA3+6kw?owq(zwo=12gCfaC>3 z5lSY&8$hE*jq`_>)QtIe9fKPbLK>`jab8TcP@W=pR zYs1y)Y%_uc-BDxB=$0A-5Mnw=rp`gan1ciu8k*-If!hw|Xz-MYD2aeA0!ajBGh`f4 z^DHD_#AlnqA0$HNV0JXHEqoJ;^f(m2oyf~V#D@yH%mERbRe*E=2NN?eE|_HhrkJrf z6kTutmarHATxsO*V^@UW-y`|7C3aSP> z3Sv~0#-Rg?%*EDlT@N`ckU->hW7;3Y4(0x_8K5X2mkMq@xJzWb2(0cb7-Hl@NC6ok90h`AwwDyX>km0Xs3d3QSrc8DBLC@lK>PVL+WGh zU>I@`We}47RQ@{1Z-AqD7{Grj=MeM1m6%HcNdCKZ{;nMpVIbgK`FG>c{>WtfU5N;Z zB=^td->vtbwxe?)yv&sdp9t2!D=|C(EdN{icjuUE|4-rj^SIxys^Oyz&|1hjM5CaB z-B$mFL}*LI5`Qkyu@TDWwm@Ux9li%azBqE<(0wsfz(S*VlDP?rDN)c!V^%kza~#u%H4uk&1K}(*IOYnM9`AMT5ZifCrEhJUFPJ2g>&#I}0^55h-Mp4?~g- z4-gk*xlr6kq=LmniV!LQ4EihuI|>z?NO*$-A<(c;4~Zj6`4izD6Ftzi5CRP(jEIRc z*c7NhK7zuqg9_Rc`5`DX4>i<@1Q}UaDoVgnL2OYp3>B;oT^?Y4XlDrK;Gzaq&}8s) zF!WKuoq;!iA6@=XA!>&QKn&UvD%d=<0yYmlkg-LCK_MDE0JRv5NDWZIm0`kynrO(- zA_CD6+Gz;whzn>4?GVHf0UQ|GY3PtBL}Q{I#b`ttAR60(h7e5y z{{%ZO4Y_{kYXa=JGzjqEnihqUSOu+&e0K~O%=H6P%LE4V+kwVR@dxDzAANyA#DIYW z2X@s7-E`=ogL;HXc0??gg)7b3NeJ&q^5OWXf*yeBS$zUuvB5Ot??NjY2>6}t0;;2Y z7=}K$+=n;7D6%6^L3l!5FNR0JD!egm2UMuG;PV610*^7kkD{R&bY%AsBVzZS=)x02 z61wrEBh8IWAh;6P-79?00l_Tnfb24J5&_%^`1A)_0I4V*N7@A{@Ri7{{9$)5bFvMB z3S%Knf+;4re}We{4T{d-7!aGG2cjJy1!6PiuvtBZ8qqZLVG|N05IL9*0t1g(EevrM z^IJ3oIuXSZOele9@CNupaR3Umpc&?(L^leY&{*_c&78sn_Cq-pbQCg*MUdt|(G)xo zd!xl@G%P?w&I<-C<}sp>52gV&F;4?vg{hd|MF9pw{ug2$a28-WL@0ETi%A5!$%V8m zYDT-jVkrKB3hV;>NkRXC`KfROl$Attu$4fqAqbe+XX0iO`D1(uC~ zYj60Z0g#QZZqa92P=Rj%NbuDi0|^fbsvx6>IfQqm!zq%=rLOLt33Nq6@{e0xy;_rAaHzTf@i=RSMR?C#l} zot@d8o!JG;TNTpbvmngRuog zz|0s-gINKwLUxg?5E*cTsUipfHbGTE1hgF5!M(Nh16#OStbj6sS_>qG*0B(&LMQ_z zLWqL)Zb1NH3%miFx1fAzK?bb}LA3xG-)4cdbWr1BrGcztlhoVsbr2%-5wA{cVkqI;i1b>(U zhyWuBFdhJ{Kp=p5Ccs#r^gyWrUVtbNf}kIuoM4L2$^_~FfdK`90MrTMI!w@Fg$azq zTlFWjBmhr9F#dr-g#s4(2L^-{cmnOXg@LAmC(vWipkacTDH9M@e_>E55F!16L8U;m zg4=u$NijjA^%e$D44(eg1sZ$MV(~8wDg_A5zxhBZ(BAVc49KDXXv4u4{aNP2$bzs2Xgxwd>gWXhPHn|(H{b#K78vS~)B%zI?A_do(El%k7f4$CH#lUR3Vj9838cja z5vWNJmD~(*t zc<=-e^9Kf%0x>zLGl4=F3ZT^kln){^$ng4hJORsV=m}8kZIi(W1-7(cyxbxiA}q-C z`VX=p!U7t;+i?XVU|>Mw2*?cZ0DT;qZ2~#~5vUM|0|GdRKpF=ydZBNC+T11qlLtuX zb3(NT@1c1C^!}Frvw>j&*8rsGDn-nw& zN)A!ct;zxFN1%29J3Y|20*((X5EZf9>V-h30#k3Wmj|W!!{q@!K@z}kK>#slC@nDV z02(>yHRvr!5pgRHfHDFId1&H)+dB{#AokXb9b)|~z^)I}6Yvq}0n8&0AvN|V-Nv#g;*doZ37X27QjjVzyLb{ zPhjl-fq@CvzkM7?>_f#v--9+K{;h)kk=5-q8ua7eD%_?6ouvba0V)y_+Yn;GzgwO3 zKMM$`IH*tm{r*!V{8d(f?6mjuK1c?y zUzu2#nL7a_vixITN7&?D|o*l3m2n0!1Nb3c*6mOwo1~wMf z?$o!=`sBb{pZwNcpXLwD!rBC&`}TBz+ZVD1HYWdf_kPHYNeSGM=452fC<`5vZGD?b z?N1$nJp!YIlL0t2TgcYT8ahuv3HVg00@ci)g9ZLirzuADzfA)J>A&FxYWV-^-_4VP9neM;^-uWL6*S~Gs|6U+q;!OX!L5meERsT;XI+cgYu`0ONC+^cBA6FhS zkP=w&wG)fr8f%vLJO`AOkxC|O-4+H+Hn&3rjx-@fXUl>0POvSJB0c!J7%+_w;p zd*g!Y?cCF?RdS}`$%U>H&ugbjs9T2(|8(NJ7bT;Oy?4*qaN4;^+NZd9-MWS4=kq9x zFGiQ~G6jhkFG<~I@6*5rdCc9`1lMPKSxT1mY{di2aF2c~M_@?Zkv@9Qu3G#6x*xL*4^r*8%(TZ2d{kAOVxwS#|q>%;~FC zUL;i4@M=2VlAE+N{uksN`b0IqNspT`ei}X%XqFEZAqZG}Dj-5c_hnK3H94sY@>4|QP*(0W^vy}ISWoh+%7=b!mFRIxvFs!LQFl{u^ z7PD8BJZ?>9LYbcWu=%s^CwXLH+8}BZbt}v~g7}S5Dq9M&X?j%L5d9eiPS$hH*aU9; zAbu_>3G1+S%$Y$;Gza%F*>4Jk7Hph*oT9H*8SDKFP3wp%(sM#besLQLx!pJV*q&iG z5AXb0mt_p`lYuGgsp>+*+T(^e)s-Ox3MPd7Qojs))bTx9cLlO3$01aNTDDZQdKA_3vdSxHLJO#91N=Mei2haBoltD}Ieb?Rh}5PHM|m}e(EcdVzG z`5kzTA7POYDC$N+c92Wjq;`hKk6So#n8}kDzu{@h-@$?0k^oabN$s3tSXP<}^9psW z>v1t&)j7&xX7gpSptt$#<>bqN9I}UZ*k-dH)v=70S3E`;(75DRR9A$c^s$X<4_Dli zf4Ay^xP53HO;EGD_^R8r2(x@EtILPzg(&UE<9SpU{HG?T13Mkrh^qbHeiH}!pS{o6 zdw9+ixDz8%JfvdUAbTlV8EKOxauO-B{50`Nh)LpQ;H50iS4(Gwh(U{*sic+E%_2^T zl^IH!xBl*TDIN{2b(}{xO|k`^FS9-U-@hP!87+5bX&|}G z{g|)62B$orG*KX{#VICy2*+ar5#t9khF2Rp1{LPZZ1pB;Ea!#f?=-cY8sFp@%wl@# z58k~~>|Uc5OJ^93jawW;w@P=;?x>R6;Y0CCIyj0V+L7IfpCOtKoZ;*>E_;8D^n{o{ zab421I?=J@-Tr;E1>HAccJ>X4n_ifi+>2gaO_S*DIUMf;Mv&Xh2?t)8N`J8kWlNIK z2o=_p-Id3vmGqql*R~hUmkKeybqMw{4b`fkl;?*QU_tebsGcqoQ;hkMJ*++Or zZHQvo2_2nycMUPp!m#|9RKTJV$&V?%>rrJc(%|QMshfp&?Ku=PfGWJMmbes`8xy2!kkkC zM~P+f=g7QIZYqyHTdGdy{KRoJ7dTi)XdM>1h&=KADyce5y-%DLCsm&9jhOuL+DXjg zNmlj3-TQWgR6D`O?wyJq&H?JrWDRH}J}gb2&kclCzd`7J$z+ujJ-Wmu+Jr}>u}k(H zjh&{_b}%d1jMo^Sk{q)*Xffz_t$hkJ&hFy}NL)xE7&IIPi5jwH8mHoA-Ve4ih+lrh z%g+j{#&M|M!+9q< zWNidrO4}rMMyFrn8bNnC$uV|(_q|ZB9ihutCQ}YPSlk1!Z1q~Bib1a zr;pGxv|+*Hh(Gq5E!D!4O$GAv1r8&;L$U(2^p`1S+r);diDi2$Ziuhnn>ygs2k=cV ze}C4kdE^p-!A>c(;^=SL>ZW9I*@>k=86SI!{=6Wm!i>9S<3az7V(jB5iFU4M@`$Ih zeimOmJWVcVJ?UFSpPO{hoi|WD08S=F7U4hKTI2wCh0fcgl9Q6|plf>uj z#zfM60VUi3C(^UwaDLt{vbq2ZWj9)1%HJQSr< znm78F8KNEQ<%1t=Y=lVeCI5DZ!TNV}q9$CXcD8oC=eXzG->mXB?k0PJ%XoJRZMs^c zrd~Z|&uUUh;^g9I;0~E#W}bYXw9IDvd6IpJ?Zi|UWxE22D1Zg_jq*6t=vlq2ovYcf zO05!~xcj3+278e?ev$^=)_J2((Y1kER-@8S>LynVDa(GjpjAE#)S|eQ&SDCnO{ZU% zen>eRh+bJ#$s9isD_PUcAZ>og<0ex*YU6~d9X)GUE81^prerEbNTd{PZ!zi>*}~4g zpD|05Coz$Dl8I%HH_DT{^K9`RElt@*gIeKto3L_e3w*X7M*|W%qG&Zq$v|47ha9Dr=iqnje}i9E^Q6?GAz%3h>99Sy-nn9AYAmuGE73`yvT&P1k{ed{j=q?N z8v%aDQsJd#BEm-D#w&-r*B<3<64tVeqIpf?Rq5QhV;_`du`2S2A6#zJh4%Uz-;c-= zMToko*PuX#?;&inweLF`o@R9xd3vDd((R%5nvtf+wWqi%g^Wl;mnogExjriNL12Z) z(9~>X*ECb}*t?eJ(H8bwand{^DaRL{#J`+a#78redadO$ueJv~igyd0wNA21f@Hei z$ZHKQ2#HUQaNw(*6zserW#3P%$l-Tar%vat=W3(H?%VGA?MWV-k|g|2Q0Um6r(s}E zver5w}n26=QH{x2T8)JOrOd8bUx-ur#~^tci{CmT8WoY`=pw* z`bkyWCS7!}kJe2(4VNY&Mtons-NLC&HL$4Fxh53v-lrkU(5r0*2Tj!+N24uBZJrg+wSlAxX2WhnR_N&Q9x!Lri$lG zQ>q?n_<=A{hRsv8p7pUlm*Yxra#IKzesfT70;^dOPsw#RO|ryEnd`BD8d=5c&H6*1 zgv!gdkcY9UHk+E3*jH1_U%#olA1nvzUb@T;>D}xEy3U?oT8%d(n8~I+8MvoIJmKOo z(|v4|#DG}%`AvxD^Q7e`cr#&i+5OQ)B_ALrf3hM14BD25DQt?5BjC3WHeYW z)p%$JJ1<)w7NWhe&XqEc7sI|=c^7qP_yvXT#Kl*XN|$+}uRhwI@6*kF@VfIKli`JB zrh9Ym-5tDBaL@WP(kpmQggK%-yQCx~z{C)3`>mih|0Pv1#+i7b1i|r@(pmFrDX%&WA}??4>tbBaK22 zVVuO=H%}+j>}RTqUxYS`Es^hzikw#n(1(w>9DjC2t-<=5iP&=XvE9ha?5$W~JY7aV zjOdMaHrba+Y9!wh#E5e?{=C#2F6+`CSo1QB^w=W?3EMiDa~U-+Vr-i|Fzk|$=ahQ+ zU;o}TuhKl(&Dx)$QbyqKzq5Mt#3-gkam$O=n04V=<6~VJenz6NeK@?`7a!z9xn=yl z23o6Pl+W8aB{L7V?ugToBf@mM432(ZC#-(r6SpPnj3Gu$@ci+J?EGq9VN0a_=Hp9t zbodo`zFn*zL_Z`yhyT)_wk#(@6C~B|XW~pG>qY7E*^_XHJGDnLY$5Jh?tQp`I)$JN zk8&p9#TLF7i95J@KryU` zT^dt_Es**vK7d5EWxCycy&K}`8 zR-5;sI?{T)`b1!$oA^>2#+-s%`wCy==iB?g?R@e9YXeNaE zFwEmXUvGT}rffcf={(~wcH?)PtG=}rTz%t{W^o2{xO8p^V$gmH`-#ownxC+mWEy+=DIVwg#@5X=)I%7;2F zoAIlQnu&4;$$r}^ouge1Q>4fobDEoX8)*ew{lat}>l`+6}+bHJjHh zR?^vVHcSyj+X~=Yt$$AG;pflGF3EaerV-{7?~r`7$X4_^LTo+m(j9jhrtEp&)oq8g z@Z;&K9!)`7wArsm>x`?9SLc<%Y{WjoXI*EweOPD1$nEB(t^+^Ua61S6E0vA3*DDM; zDH~<8cB3831Tpf(3X)-u1BdXKA8x*DUzhrdBZY;{tmN~MKJC#1|MJJfw7QEa zoHb9hC?}9IdyC@WQyu#n^u)rSKh{%?CTkKvkvK7>YP5E!D4oTL-o^X$CY6AU{FH$I z%dU2pt5jy=0`|Ub_EFh5Yro%CemvtBqF8j@HgJSO=VnMa|*iTd8U`#FhEO!J74j_X|egF++4jNJknhbW3N zmDYR}5_7V6f)lAXjfINlauhzhRGg|GTRKWr?Ru1JQ&&lU76*u$H{Oj}HtwQ>VQ=3% zuqC}hWp3x0rIj08MRW;Kp0exa+~!~NQ_9209MlL(K~-U4sg$rRq*dIEi;kwPOH163 zy*qmq;JnnQBs6zt(dw0yfZ)4It0uigtGu)gqlee)_&i1H;zS*hbYts?*f0+F;tFBi z0KCG*@_H@OV4FRcvZ4$M<(#;brcyf*AG4CJchC6de7#UAFHCa%1X~o_XG3OI98}~B zFt*I-obwHE>TnvQL{}|x1!CPe?M|JSNtOtMboN|mhfex2Y0MfNa)y5uPTY_OzO7Yv zzzliXu_NOpaP?%_jdNidb=@MwwVFQ77P0YLj5Dz}>&?FDP+9)@xoVhe*`60(i_>C@ z`$FlY$T0IsxGTICmS#8%g3H*)sFD3+dM1)3RZ zQg>i*{%0GR8`LGK!LoeyUtMj3N8U`#WQt=I+T)`|hjW2*RF@1xyM8_`DIN&{sfF<@ zTgF={Uu5{phWJSe9~wzW**r1JD5zk*Nt@rQyN@*Qdb3$=*sSX>tIuZXAL@XV!ENSv|P&36r=Sytg+Tc|^%TJ}mOHML@ASHHgf)=9r>HTHOK zPG)~Kz%_aBo6oS4kQ82SwlYbfCP%op>eYnt@vN$ib-aG^ps59_@^--my8v?E*4&|_ z(vDw7b6q5%mJyyYyVE;c-@>duoE@Iy)>Jyf4bkg4sRzs9N#iB+BrDt@+NU*@O{D3` zf%W(+=I2X?=B#ytJ2@TIc_E6Jc(HGRsjSqEj;@>=4dX9nDoWv4^+cpHh@T{ce~cBVpR z>61yu%YD{Fj)*x^sy_D;hDrK!4F)Ewz;6cOt@$vbeP8sT&4t-&`aP2VRdA|nhqRTs zgRn*C6{v%yCG@&>iCxh<*@0^HqXjR!zN!|CyT(o>jmWDrDUs`}{DKkTGyJ#TYD`p@ zV;-l*J7r^bFOO0;r4Jc+j?stS+DtVapj&4rizcdXd#y$NPEi?-{(h;g@6RPD``9#M zOnsMu-6qdX&182~J2?(6{F$D^il-x6wn(Mc6Ow}W@lOTt6n2Du^)ID+pLjad)@pCo ziTi1*q$Kp6^>iWl;j7ir_P<$4VRYQ)J7~FgUS1(ie6hk5f#_m>IY-Ip(@c`>^)$Lh z`;yk4Qj+G8lAghn-JQ1$CrSqzo|Ik$f~r(jg$Ca^;$j|MdI}s*ilgCKa_8Z7|5PZ7Ln2}&%jJNA%;)Q&;z7a%FMj9Q z61@egrQwcDq)kUk_V}u7n}V=ejCReEyquo(Nz)7Gj zcsr6zeN{i>lJKON_O(VZ`yf*Cu9O{hK-Y%~X4OuZV+ple|6y7#(Gy;jCj1hCyHoBr z<-7;=*(|5n?Q;PUSnj5zwOFtx@Lr_I@;b9Br(up{%o`qJVqc1<;1s^9X%RpBIuIsY zKZT+2m2Bu8Sz(1$U&Ppkr|6f4ar(WC3j2_Bc|9kDn|ARp-fws>&23UV#lAGGqFg4R z`(NBw5Db#@@f)v>Pwhy38h$fTe0XFlt@j`KWEuxg(%VdMzq4f}O=OmtNfs*eC`)kPzb z7NWDzC!MA`*qg@a{E`UR_Hq5S_=w#cJ0B6{e#0FppI!QdNB7U3@=4dyzD`*ERqErP zF&KZK@1qmdG2dG8oxCH(TEjx`pvV&S6?OvgWE%}9vs$M!0Zp|fF|!XgckZCKY7Gw~ zdZV|bHZKD~zcxm^=hxslvX6|C7J}jGrNRfvgx%<5vUA7fdTnl#TfQQ7jbRDB#M#o* zKkKX(te@FeDPEYPW@uYGJm2TIvRaGpUyCjtw#!?h(v6$ASx>rVIfpT`)jwNbk_k@BnvL4|?c+d}Gbg)FJQa$U`NW3(oI3ur$5{EoCD&y? zg&n3nGVMF|jYC4saEu-@0$$^En*>{a(fo8m~CVBVqf zaN|4yijJgnHt~)$q18tE#4WGUC8R6Xg)7YV7btX}uXQG{Tf-&1>$yMuWFNbGd}Go$ z?U#|a!*yMIIz3a8>;Cqm;BlpC322x?XjfedCLP+Kgo7Mg64kKhbuRG$MNo-*esO0sDolF`LHAnT!3r>DC zxjZ;lJ=gocnJV?h4|mD>P)F0$$|qX(B0pgBZ*6ob&|SRf;P$aUF8G-%LBij;z(0~z z89l~byp^Wnjte8~`0&N$g_>TMu0mrCq55{&^%aM*9$M+ug@;@1CCe4aAe(a_;tWG} zN!FyYu&+vJC1kS@!nIn)_T2sq84XX2pTa}5{>eUC>)$=Xgz>dyF)Yk-=#&Eg(&41NSY>G^ix<8#kp0eM87vpS;t z+~WiYdsjwJ>w*xarvg8$=|^p*YIiKvJoRyPXy`hn>bT0B+mH5+&p)mePx5>|5pDNw zj^^+bK^k6(uCP}e(XRQI(CQ$B6_FqX)SdS}E%i2JHVSn` zZqgQw4sD1>yvVhjI2dmQ9(Gx1tO^}T+Cl@SnAo$H*@XQ|#b31)oZvrpiEx`#ie9V3Jnyu3H=aMtF0 zHX}{z4HMLP$vg4Vy?t>Wa~LLn4L4TxU>)%c_bn+q+Pj=c-A6F03DR<34i3LgRw9L! zz$>0LL;{BPyLgT`)_3V9Yttnc}hQ^s?_asG*B|`BoxGZP9miXY8wUk8#rIFK@NTeE}&; zZ9CM&S&hL+xZIR))u>*i`d&}iIr`tYH^dFA#Rkwe)ty~;dj96Rd`9Ahn}1b{-?&P7 zLYsv!{uaTMcAvx{JaLnlnfAPh95%Z-E0Kb-b2U~?w0J$}7_`FD4(oTJeCG4Mddhth zZko&%;qYUst2^l&OD6u2PQBKeY7s>SaRe#2EJq}we^WlE@w84Q6n?NDS zspQTlPLJ73?gfF54IIY@eBMexrq_!1n9Xaw%Pc;I9maYKa(fz2&xkK_2S^pR&v~aE z!XpTFi-dYBSX8*LxNME9QE#OPFJi!KT?V{cCBt=4g8T+AE$bd^CWI~t23oIpit{j@=J9qH)gJ5m)3`>Kx3iF1ix!-qlVwcLV>dPI8F=jh= zMxUehy))5#i;}%hy8dfpp;ce+u z38yg>J~U^$PU-61XS?FtsMb3F^K>feFzN1W;S0>jRr<~1C81R6Xw-R{pc~a5s+^Iv zrw;e3eX0nm^2^o;Zt&Kfb#vPY&z>FF>^idLEW{JB~pOQxGGO~u0Z zAYNrk_`)mpL{WYzpKXQ0(wuP;JDvR6j6y{upBi3EOu-V)z9vG`qzis&>f?$TfA=Tj zkUN&m<+wK-DqpOhU3Ab;I$}&9YgR2zzKvu5Y8RKq5!+G}Uzkpv-|>pWvO1fzb(xoN zFko}a9Hl$`=b2t_gt$#4Ma`9Eq?K^EnXwYP;xWr=L-pM(e+NXZ@OsJqxon)yLJ|6b ze2GfbtqPH*dFxtJl~#t3%9o3$6=GX=hbqU+wY=(RrZ7udtj4EQWN6jej9gTn;#ycm zupwIRWqUY> zuDz~{QV5B-j*XNO->|+~$L1n_ZbQ}=rYTc#g%Q)@pdzc_Dt1vr-!Y0=nn?Clmd z);1+=L4v&~$v0&zKM#><_hrT;Z_d8g3tpYvh^KldShn)sXKoP`1lJHdUpNF z%vW@hx=YMbz+7|+j&$`aS3EU63XUKeFDtptZu$C`7VV)=yxd3WTxQqrv!lrFnt3`> zb|taaKYR9^8Ro(nnV^8qLnMo5wg%7CMqnS8U0shk0{_Leg@Br=^6u~UM1=b_{#Dr?9iqY@3LV{VftcdoITIAB zBPeUN8rB*2OVC0Jhj#+{{Jk)j-Ae?8Q@0snZ{X<0cjcEODAEvMUM6HB=T9fLJIlP3 zmw&bKOfnW(M+6pgi#Sg=Uq0zWNQ;cS$p$q#+MXvHR^1Xl)7Xa zq@Cx(lNbi9v3(1b7#c(pXGOnv7-e3qW?5LMdRS^EoglmKzCW!~JM#3Kbtzun zKCMwfO9|7#7N77$oIsPlGxGM~I2V$q{2RE=-?mGyX>{MFyuI(?J&!s?B+uy~(0Y!( z>Nkp%kERN5n(9rCCaqjQEHZF{kK5SA_ru$5Q@^mKV&;zBH{8LH)OXO|SKj8FgfC>o zh!=2?zc}s`5bjkL*KZ6UV4m6?B-o_2wLeJHY=Mnyew`6E(^_+SSkY@<&@%ku`1qKc z-)t$#(Xq(hYZ~8mG^xy}!2{+ zwfb&XkJu}7wV)7nk4IZMb5!TRc=sX1Cz zqYlZb5*5q4JUi}4yY!7uPn+|vJANM@yONsxEnB?eggfOjFZ5+ znBnWf3;_Xme{*dU@y54w!|aQx7mSCLy!Hoj8;(VJWYf*(DZ;0W6M_kEPrH2)$_ zAoIHQ#he1;OWRV5kHw3ja!n~=#0n!T?>v4|D}ATOYAYZ-{&^GkN>8{+xs5BBJK9R*?|ZR@QZb{p17UQ{odR4^4id0n!0mIX`Vi*fLMG zYEh(#MwHGsa;)kvbrlBw_gxJ9mdu`1KMMX&R=CV33V9_3h9-_RyvX3Y(xn?0PPS8`zSyW1^|N3?yh)BF5O`S!wQm~^A_ z{;_pj_Ev>L6yg0Tw0o~f**gNQt4Ps4>J-037`mX~P328;gI~@k_I5&SPUDC7+~QP3 zAb`btese*xvfl2>-ZDaH8c9_7oy?RfUGM-)`dgyPMc!)$_ji-)`N3N)OzHQrkSQp! za4Ut`aK+eanp=kX9`z_oQA#GM-uFm5DIupzJ9QtNlq{l*c~Rs|iHvm;MVXo}G11dp zLi)VxO`43V)Yk~A!%@ssYtDzy3GN9$x%ZI9nE;uZKxevsud|RScHKC*X%iTYY|39y zXIEqTsmO<67`MK^N$XI*^g+(1ZE+n4rR+E|)|Cr~bBB2r*Ws58L?HTQvAQNwn1{d) zC^8sXNJz_eH;nGXLQ|3B0>sniNlkVP_!XXHbVVl)e`Sw*9Z>i?Qy{sss8`N8hcw@L z-JozMm+I*!!>$^Q!tf$=@`DFfh&s|NpC|Q?cUUH`9+iq z+tKAf_dwDPvfdX5S*vsc~E8yA0p{qAax#L7;)H?SBcinKB)&JP4*Usmf62 zuVIb5sjRkru(%TAKAFrMFXLL8;9q@RSy^gD7xk z2Z7TKqxoOMR7c6vM)v2^?F7*IZpNez@5gZu-Jq6Y=jJG^P z{YeREjI%M*cWzM6u=dpEv3}6I1d;H$mwvM>yQ_$-B%St|wd*T-YNi1jb?tPt|LX*% zlDpx&ZwHyY-ppWWQe$dAm_|o__r2mr08XMUS?|6cxDW-_O7!X8qqyxWz0S z9G%G7{$171%*nwhOV0eqvQ&+N|I9zn~KgS zXcm%7eVrX|*XSB~iR>@&bG_AHsW`wmXYrc}WV;-hlF4N=^Bz^5iV-P{p;({1h8K>1 z!})f*p5x@MO69BSDvuIH5+2Xd^ew^`&IWb--5t=QbHpqa4`up3%K4-%);8q!~yaca5DLm zg;Cz(_|Sm+OF#(x4uFFuI1>YcnA(AtkQ;-v ziLIHFIq;f=YUTnRKn1QGv~wbdylxd4l`K3=fCJ*64pUb&F$EW;06!dXP0D}oH$y|? zasxxdOP|)5b-|1rI4lH&4Dz70dzi!nLUa=7Ur?S(8@@&KqYa{kdjjwKe#d~ksr4bc l{vCx6NWcHzSaftUaBy;SFfl~|Zf(G?3+34}Q8_V`{|E4*zq9}V diff --git a/cicecore/drivers/direct/hadgem3/CICE.F90 b/cicecore/drivers/direct/hadgem3/CICE.F90 index fe322a04d..fac02de9b 100644 --- a/cicecore/drivers/direct/hadgem3/CICE.F90 +++ b/cicecore/drivers/direct/hadgem3/CICE.F90 @@ -1,8 +1,8 @@ !======================================================================= -! Copyright (c) 2022, Triad National Security, LLC +! Copyright (c) 2023, Triad National Security, LLC ! All rights reserved. ! -! Copyright 2022. Triad National Security, LLC. This software was +! Copyright 2023. Triad National Security, LLC. This software was ! produced under U.S. Government contract DE-AC52-06NA25396 for Los ! Alamos National Laboratory (LANL), which is operated by Triad ! National Security, LLC for the U.S. Department of Energy. The U.S. diff --git a/cicecore/drivers/mct/cesm1/CICE_copyright.txt b/cicecore/drivers/mct/cesm1/CICE_copyright.txt index 14d97c481..af2afdf3d 100644 --- a/cicecore/drivers/mct/cesm1/CICE_copyright.txt +++ b/cicecore/drivers/mct/cesm1/CICE_copyright.txt @@ -1,7 +1,7 @@ -! Copyright (c) 2022, Triad National Security, LLC +! Copyright (c) 2023, Triad National Security, LLC ! All rights reserved. ! -! Copyright 2022. Triad National Security, LLC. This software was +! Copyright 2023. Triad National Security, LLC. This software was ! produced under U.S. Government contract DE-AC52-06NA25396 for Los ! Alamos National Laboratory (LANL), which is operated by Triad ! National Security, LLC for the U.S. Department of Energy. The U.S. diff --git a/cicecore/drivers/nuopc/cmeps/CICE_copyright.txt b/cicecore/drivers/nuopc/cmeps/CICE_copyright.txt index 14d97c481..af2afdf3d 100644 --- a/cicecore/drivers/nuopc/cmeps/CICE_copyright.txt +++ b/cicecore/drivers/nuopc/cmeps/CICE_copyright.txt @@ -1,7 +1,7 @@ -! Copyright (c) 2022, Triad National Security, LLC +! Copyright (c) 2023, Triad National Security, LLC ! All rights reserved. ! -! Copyright 2022. Triad National Security, LLC. This software was +! Copyright 2023. Triad National Security, LLC. This software was ! produced under U.S. Government contract DE-AC52-06NA25396 for Los ! Alamos National Laboratory (LANL), which is operated by Triad ! National Security, LLC for the U.S. Department of Energy. The U.S. diff --git a/cicecore/drivers/nuopc/dmi/CICE.F90 b/cicecore/drivers/nuopc/dmi/CICE.F90 index 79dd06fca..5ace27736 100644 --- a/cicecore/drivers/nuopc/dmi/CICE.F90 +++ b/cicecore/drivers/nuopc/dmi/CICE.F90 @@ -1,8 +1,8 @@ !======================================================================= -! Copyright (c) 2022, Triad National Security, LLC +! Copyright (c) 2023, Triad National Security, LLC ! All rights reserved. ! -! Copyright 2022. Triad National Security, LLC. This software was +! Copyright 2023. Triad National Security, LLC. This software was ! produced under U.S. Government contract DE-AC52-06NA25396 for Los ! Alamos National Laboratory (LANL), which is operated by Triad ! National Security, LLC for the U.S. Department of Energy. The U.S. diff --git a/cicecore/drivers/standalone/cice/CICE.F90 b/cicecore/drivers/standalone/cice/CICE.F90 index 79dd06fca..5ace27736 100644 --- a/cicecore/drivers/standalone/cice/CICE.F90 +++ b/cicecore/drivers/standalone/cice/CICE.F90 @@ -1,8 +1,8 @@ !======================================================================= -! Copyright (c) 2022, Triad National Security, LLC +! Copyright (c) 2023, Triad National Security, LLC ! All rights reserved. ! -! Copyright 2022. Triad National Security, LLC. This software was +! Copyright 2023. Triad National Security, LLC. This software was ! produced under U.S. Government contract DE-AC52-06NA25396 for Los ! Alamos National Laboratory (LANL), which is operated by Triad ! National Security, LLC for the U.S. Department of Energy. The U.S. diff --git a/cicecore/drivers/unittest/opticep/CICE.F90 b/cicecore/drivers/unittest/opticep/CICE.F90 index 79dd06fca..5ace27736 100644 --- a/cicecore/drivers/unittest/opticep/CICE.F90 +++ b/cicecore/drivers/unittest/opticep/CICE.F90 @@ -1,8 +1,8 @@ !======================================================================= -! Copyright (c) 2022, Triad National Security, LLC +! Copyright (c) 2023, Triad National Security, LLC ! All rights reserved. ! -! Copyright 2022. Triad National Security, LLC. This software was +! Copyright 2023. Triad National Security, LLC. This software was ! produced under U.S. Government contract DE-AC52-06NA25396 for Los ! Alamos National Laboratory (LANL), which is operated by Triad ! National Security, LLC for the U.S. Department of Energy. The U.S. diff --git a/cicecore/version.txt b/cicecore/version.txt index 953395fa1..6f8bbc127 100644 --- a/cicecore/version.txt +++ b/cicecore/version.txt @@ -1 +1 @@ -CICE 6.4.1 +CICE 6.4.2 diff --git a/doc/source/conf.py b/doc/source/conf.py index 7d79f7b43..7d078835c 100644 --- a/doc/source/conf.py +++ b/doc/source/conf.py @@ -57,7 +57,7 @@ # General information about the project. project = u'CICE' -copyright = u'2022, Triad National Security, LLC (code) and National Center for Atmospheric Research (documentation)' +copyright = u'2023, Triad National Security, LLC (code) and National Center for Atmospheric Research (documentation)' author = u'CICE-Consortium' # The version info for the project you're documenting, acts as replacement for @@ -65,9 +65,9 @@ # built documents. # # The short X.Y version. -version = u'6.4.1' +version = u'6.4.2' # The full version, including alpha/beta/rc tags. -version = u'6.4.1' +version = u'6.4.2' # The language for content autogenerated by Sphinx. Refer to documentation # for a list of supported languages. diff --git a/doc/source/intro/copyright.rst b/doc/source/intro/copyright.rst index 86b15b8d2..e477d9d57 100644 --- a/doc/source/intro/copyright.rst +++ b/doc/source/intro/copyright.rst @@ -5,7 +5,7 @@ Copyright ============================= -© Copyright 2022, Triad National Security LLC. All rights reserved. +© Copyright 2023, Triad National Security LLC. All rights reserved. This software was produced under U.S. Government contract 89233218CNA000001 for Los Alamos National Laboratory (LANL), which is operated by Triad National Security, LLC for the U.S. Department diff --git a/icepack b/icepack index 23b6c1272..b2bd1a4e6 160000 --- a/icepack +++ b/icepack @@ -1 +1 @@ -Subproject commit 23b6c1272b50d42cad7928ffe0005d6ee673dee9 +Subproject commit b2bd1a4e665e7f98f71c46c03903d60db14a59cb From 01ed4db7c4e5857768a37e8b1fd7472ab5121827 Mon Sep 17 00:00:00 2001 From: JFLemieux73 <31927797+JFLemieux73@users.noreply.github.com> Date: Fri, 15 Sep 2023 19:59:55 +0000 Subject: [PATCH 21/76] 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 --- .../cicedyn/dynamics/ice_transport_remap.F90 | 261 +++++++++++------- cicecore/cicedyn/infrastructure/ice_grid.F90 | 30 +- doc/source/science_guide/sg_horiztrans.rst | 13 +- 3 files changed, 190 insertions(+), 114 deletions(-) diff --git a/cicecore/cicedyn/dynamics/ice_transport_remap.F90 b/cicecore/cicedyn/dynamics/ice_transport_remap.F90 index eb0dd17cf..b397b94b7 100644 --- a/cicecore/cicedyn/dynamics/ice_transport_remap.F90 +++ b/cicecore/cicedyn/dynamics/ice_transport_remap.F90 @@ -317,7 +317,7 @@ subroutine init_remap !------------------------------------------------------------------- if (grid_ice == 'CD' .or. grid_ice == 'C') then - l_fixed_area = .false. !jlem temporary + l_fixed_area = .true. else l_fixed_area = .false. endif @@ -356,7 +356,7 @@ subroutine horizontal_remap (dt, ntrace, & use ice_domain, only: nblocks, blocks_ice, halo_info, maskhalo_remap use ice_blocks, only: block, get_block, nghost use ice_grid, only: HTE, HTN, dxu, dyu, & - tarear, hm, & + earea, narea, tarear, hm, & xav, yav, xxav, yyav ! xyav, xxxav, xxyav, xyyav, yyyav use ice_timers, only: ice_timer_start, ice_timer_stop, timer_bound @@ -727,6 +727,7 @@ subroutine horizontal_remap (dt, ntrace, & indxing(:,:), indxjng(:,:), & dpx (:,:,iblk), dpy(:,:,iblk), & dxu (:,:,iblk), dyu(:,:,iblk), & + earea (:,:,iblk), narea (:,:,iblk), & xp (:,:,:,:), yp (:,:,:,:), & iflux, jflux, & triarea, edgearea_e(:,:)) @@ -786,6 +787,7 @@ subroutine horizontal_remap (dt, ntrace, & indxing(:,:), indxjng(:,:), & dpx (:,:,iblk), dpy (:,:,iblk), & dxu (:,:,iblk), dyu (:,:,iblk), & + earea (:,:,iblk), narea (:,:,iblk), & xp (:,:,:,:), yp(:,:,:,:), & iflux, jflux, & triarea, edgearea_n(:,:)) @@ -1705,6 +1707,7 @@ subroutine locate_triangles (nx_block, ny_block, & indxi, indxj, & dpx, dpy, & dxu, dyu, & + earea, narea, & xp, yp, & iflux, jflux, & triarea, edgearea) @@ -1721,7 +1724,9 @@ subroutine locate_triangles (nx_block, ny_block, & dpx , & ! x coordinates of departure points at cell corners dpy , & ! y coordinates of departure points at cell corners dxu , & ! E-W dimension of U-cell (m) - dyu ! N-S dimension of U-cell (m) + dyu , & ! N-S dimension of U-cell (m) + earea , & ! area of E-cell + narea ! area of N-cell real (kind=dbl_kind), dimension (nx_block,ny_block,0:nvert,ngroups), intent(out) :: & xp, yp ! coordinates of triangle vertices @@ -1748,7 +1753,7 @@ subroutine locate_triangles (nx_block, ny_block, & integer (kind=int_kind) :: & i, j, ij, ic , & ! horizontal indices - ib, ie, jb, je , & ! limits for loops over edges + ib, jb , & ! limits for loops for bugcheck ng, nv , & ! triangle indices ishift , jshift , & ! differences between neighbor cells ishift_tl, jshift_tl , & ! i,j indices of TL cell relative to edge @@ -1756,7 +1761,13 @@ subroutine locate_triangles (nx_block, ny_block, & ishift_tr, jshift_tr , & ! i,j indices of TR cell relative to edge ishift_br, jshift_br , & ! i,j indices of BR cell relative to edge ishift_tc, jshift_tc , & ! i,j indices of TC cell relative to edge - ishift_bc, jshift_bc ! i,j indices of BC cell relative to edge + ishift_bc, jshift_bc , & ! i,j indices of BC cell relative to edge + is_l, js_l , & ! i,j shifts for TL1, BL2 for area consistency + is_r, js_r , & ! i,j shifts for TR1, BR2 for area consistency + ise_tl, jse_tl , & ! i,j of TL other edge relative to edge + ise_bl, jse_bl , & ! i,j of BL other edge relative to edge + ise_tr, jse_tr , & ! i,j of TR other edge relative to edge + ise_br, jse_br ! i,j of BR other edge relative to edge integer (kind=int_kind) :: & icellsd ! number of cells where departure area > 0. @@ -1767,9 +1778,8 @@ subroutine locate_triangles (nx_block, ny_block, & real (kind=dbl_kind), dimension(nx_block,ny_block) :: & dx, dy , & ! scaled departure points - areafac_c , & ! area scale factor at center of edge - areafac_l , & ! area scale factor at left corner - areafac_r ! area scale factor at right corner + areafac_c , & ! earea or narea + areafac_ce ! areafac_c on other edge (narea or earea) real (kind=dbl_kind) :: & xcl, ycl , & ! coordinates of left corner point @@ -1859,9 +1869,9 @@ subroutine locate_triangles (nx_block, ny_block, & if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & file=__FILE__, line=__LINE__) - areafac_c(:,:) = c0 - areafac_l(:,:) = c0 - areafac_r(:,:) = c0 + areafac_c(:,:) = c0 + areafac_ce(:,:) = c0 + do ng = 1, ngroups do j = 1, ny_block do i = 1, nx_block @@ -1883,13 +1893,6 @@ subroutine locate_triangles (nx_block, ny_block, & if (trim(edge) == 'north') then - ! loop size - - ib = ilo - ie = ihi - jb = jlo - nghost ! lowest j index is a ghost cell - je = jhi - ! index shifts for neighbor cells ishift_tl = -1 @@ -1905,24 +1908,42 @@ subroutine locate_triangles (nx_block, ny_block, & ishift_bc = 0 jshift_bc = 0 + ! index shifts for TL1, BL2, TR1 and BR2 for area consistency + + is_l = -1 + js_l = 0 + is_r = 1 + js_r = 0 + + ! index shifts for neighbor east edges + + ise_tl = -1 + jse_tl = 1 + ise_bl = -1 + jse_bl = 0 + ise_tr = 0 + jse_tr = 1 + ise_br = 0 + jse_br = 0 + ! area scale factor + ! earea, narea valid on halo - do j = jb, je - do i = ib, ie - areafac_l(i,j) = dxu(i-1,j)*dyu(i-1,j) - areafac_r(i,j) = dxu(i ,j)*dyu(i ,j) - areafac_c(i,j) = p5*(areafac_l(i,j) + areafac_r(i,j)) + do j = 1, ny_block + do i = 1, nx_block + areafac_c(i,j) = narea(i,j) enddo enddo - else ! east edge - - ! loop size + ! area scale factor for other edge (east) + + do j = 1, ny_block + do i = 1, nx_block + areafac_ce(i,j) = earea(i,j) + enddo + enddo - ib = ilo - nghost ! lowest i index is a ghost cell - ie = ihi - jb = jlo - je = jhi + else ! east edge ! index shifts for neighbor cells @@ -1939,13 +1960,38 @@ subroutine locate_triangles (nx_block, ny_block, & ishift_bc = 0 jshift_bc = 0 + ! index shifts for TL1, BL2, TR1 and BR2 for area consistency + + is_l = 0 + js_l = 1 + is_r = 0 + js_r = -1 + + ! index shifts for neighbor north edges + + ise_tl = 1 + jse_tl = 0 + ise_bl = 0 + jse_bl = 0 + ise_tr = 1 + jse_tr = -1 + ise_br = 0 + jse_br = -1 + ! area scale factors + ! earea, narea valid on halo + + do j = 1, ny_block + do i = 1, nx_block + areafac_c(i,j) = earea(i,j) + enddo + enddo - do j = jb, je - do i = ib, ie - areafac_l(i,j) = dxu(i,j )*dyu(i,j ) - areafac_r(i,j) = dxu(i,j-1)*dyu(i,j-1) - areafac_c(i,j) = p5 * (areafac_l(i,j) + areafac_r(i,j)) + ! area scale factor for other edge (north) + + do j = 1, ny_block + do i = 1, nx_block + areafac_ce(i,j) = narea(i,j) enddo enddo @@ -1957,8 +2003,8 @@ subroutine locate_triangles (nx_block, ny_block, & icellsd = 0 if (trim(edge) == 'north') then - do j = jb, je - do i = ib, ie + do j = jlo-1, jhi + do i = ilo, ihi if (dpx(i-1,j)/=c0 .or. dpy(i-1,j)/=c0 & .or. & dpx(i,j)/=c0 .or. dpy(i,j)/=c0) then @@ -1969,8 +2015,8 @@ subroutine locate_triangles (nx_block, ny_block, & enddo enddo else ! east edge - do j = jb, je - do i = ib, ie + do j = jlo, jhi + do i = ilo-1, ihi if (dpx(i,j-1)/=c0 .or. dpy(i,j-1)/=c0 & .or. & dpx(i,j)/=c0 .or. dpy(i,j)/=c0) then @@ -1986,8 +2032,8 @@ subroutine locate_triangles (nx_block, ny_block, & ! Scale the departure points !------------------------------------------------------------------- - do j = 1, je - do i = 1, ie + do j = 1, jhi + do i = 1, ihi dx(i,j) = dpx(i,j) / dxu(i,j) dy(i,j) = dpy(i,j) / dyu(i,j) enddo @@ -2055,6 +2101,13 @@ subroutine locate_triangles (nx_block, ny_block, & !------------------------------------------------------------------- ! Locate triangles in TL cell (NW for north edge, NE for east edge) ! and BL cell (W for north edge, N for east edge). + ! + ! areafact_c or areafac_ce (areafact_c for the other edge) are used + ! (with shifted indices) to make sure that a flux area on one edge + ! is consistent with the analogous area on the other edge and to + ! ensure that areas add up when using l_fixed_area = T. See PR #849 + ! for details. + ! !------------------------------------------------------------------- if (yil > c0 .and. xdl < xcl .and. ydl >= c0) then @@ -2070,7 +2123,7 @@ subroutine locate_triangles (nx_block, ny_block, & yp (i,j,3,ng) = ydl iflux (i,j,ng) = i + ishift_tl jflux (i,j,ng) = j + jshift_tl - areafact(i,j,ng) = -areafac_l(i,j) + areafact(i,j,ng) = -areafac_ce(i+ise_tl,j+jse_tl) elseif (yil < c0 .and. xdl < xcl .and. ydl < c0) then @@ -2085,7 +2138,7 @@ subroutine locate_triangles (nx_block, ny_block, & yp (i,j,3,ng) = yil iflux (i,j,ng) = i + ishift_bl jflux (i,j,ng) = j + jshift_bl - areafact(i,j,ng) = areafac_l(i,j) + areafact(i,j,ng) = areafac_ce(i+ise_bl,j+jse_bl) elseif (yil < c0 .and. xdl < xcl .and. ydl >= c0) then @@ -2100,7 +2153,7 @@ subroutine locate_triangles (nx_block, ny_block, & yp (i,j,3,ng) = yic iflux (i,j,ng) = i + ishift_tl jflux (i,j,ng) = j + jshift_tl - areafact(i,j,ng) = areafac_l(i,j) + areafact(i,j,ng) = areafac_c(i+is_l,j+js_l) ! BL1 (group 3) @@ -2113,7 +2166,7 @@ subroutine locate_triangles (nx_block, ny_block, & yp (i,j,3,ng) = yil iflux (i,j,ng) = i + ishift_bl jflux (i,j,ng) = j + jshift_bl - areafact(i,j,ng) = areafac_l(i,j) + areafact(i,j,ng) = areafac_ce(i+ise_bl,j+jse_bl) elseif (yil > c0 .and. xdl < xcl .and. ydl < c0) then @@ -2128,7 +2181,7 @@ subroutine locate_triangles (nx_block, ny_block, & yp (i,j,3,ng) = yic iflux (i,j,ng) = i + ishift_tl jflux (i,j,ng) = j + jshift_tl - areafact(i,j,ng) = -areafac_l(i,j) + areafact(i,j,ng) = -areafac_ce(i+ise_tl,j+jse_tl) ! BL2 (group 1) @@ -2141,7 +2194,7 @@ subroutine locate_triangles (nx_block, ny_block, & yp (i,j,3,ng) = ydl iflux (i,j,ng) = i + ishift_bl jflux (i,j,ng) = j + jshift_bl - areafact(i,j,ng) = -areafac_l(i,j) + areafact(i,j,ng) = -areafac_c(i+is_l,j+js_l) endif ! TL and BL triangles @@ -2163,7 +2216,7 @@ subroutine locate_triangles (nx_block, ny_block, & yp (i,j,3,ng) = yir iflux (i,j,ng) = i + ishift_tr jflux (i,j,ng) = j + jshift_tr - areafact(i,j,ng) = -areafac_r(i,j) + areafact(i,j,ng) = -areafac_ce(i+ise_tr,j+jse_tr) elseif (yir < c0 .and. xdr >= xcr .and. ydr < c0) then @@ -2178,7 +2231,7 @@ subroutine locate_triangles (nx_block, ny_block, & yp (i,j,3,ng) = ydr iflux (i,j,ng) = i + ishift_br jflux (i,j,ng) = j + jshift_br - areafact(i,j,ng) = areafac_r(i,j) + areafact(i,j,ng) = areafac_ce(i+ise_br,j+jse_br) elseif (yir < c0 .and. xdr >= xcr .and. ydr >= c0) then @@ -2193,7 +2246,7 @@ subroutine locate_triangles (nx_block, ny_block, & yp (i,j,3,ng) = ydr iflux (i,j,ng) = i + ishift_tr jflux (i,j,ng) = j + jshift_tr - areafact(i,j,ng) = areafac_r(i,j) + areafact(i,j,ng) = areafac_c(i+is_r,j+js_r) ! BR1 (group 3) @@ -2206,7 +2259,7 @@ subroutine locate_triangles (nx_block, ny_block, & yp (i,j,3,ng) = yic iflux (i,j,ng) = i + ishift_br jflux (i,j,ng) = j + jshift_br - areafact(i,j,ng) = areafac_r(i,j) + areafact(i,j,ng) = areafac_ce(i+ise_br,j+jse_br) elseif (yir > c0 .and. xdr >= xcr .and. ydr < c0) then @@ -2221,7 +2274,7 @@ subroutine locate_triangles (nx_block, ny_block, & yp (i,j,3,ng) = yir iflux (i,j,ng) = i + ishift_tr jflux (i,j,ng) = j + jshift_tr - areafact(i,j,ng) = -areafac_r(i,j) + areafact(i,j,ng) = -areafac_ce(i+ise_tr,j+jse_tr) ! BR2 (group 2) @@ -2234,7 +2287,7 @@ subroutine locate_triangles (nx_block, ny_block, & yp (i,j,3,ng) = yic iflux (i,j,ng) = i + ishift_br jflux (i,j,ng) = j + jshift_br - areafact(i,j,ng) = -areafac_r(i,j) + areafact(i,j,ng) = -areafac_c(i+is_r,j+js_r) endif ! TR and BR triangles @@ -2290,9 +2343,7 @@ subroutine locate_triangles (nx_block, ny_block, & ! region so that the sum of all triangle areas is equal to the ! prescribed value. ! If two triangles are in one grid cell and one is in the other, - ! then compute the area of the lone triangle using an area factor - ! corresponding to the adjacent corner. This is necessary to prevent - ! negative masses in some rare cases on curved grids. Then adjust + ! then compute the area of the lone triangle. Then adjust ! the area of the remaining two-triangle region so that the sum of ! all triangle areas has the prescribed value. !----------------------------------------------------------- @@ -2328,7 +2379,7 @@ subroutine locate_triangles (nx_block, ny_block, & endif yicr = c0 - elseif (xic < c0) then ! fix ICL = IC + elseif (xic < c0 .and. xic > xcl) then ! fix ICL = IC xicl = xic yicl = yic @@ -2337,8 +2388,8 @@ subroutine locate_triangles (nx_block, ny_block, & xdm = p5 * (xdr + xicl) ydm = p5 * ydr - ! compute area of triangle adjacent to left corner - area4 = p5 * (xcl - xic) * ydl * areafac_l(i,j) + ! compute area of (lone) triangle adjacent to left corner + area4 = p5 * (xcl - xic) * ydl * areafac_c(i,j) area_c = edgearea(i,j) - area1 - area2 - area3 - area4 ! shift midpoint so that area of remaining triangles = area_c @@ -2357,7 +2408,7 @@ subroutine locate_triangles (nx_block, ny_block, & endif yicr = c0 - elseif (xic >= c0) then ! fix ICR = IR + elseif (xic >= c0 .and. xic < xcr) then ! fix ICR = IR xicr = xic yicr = yic @@ -2366,7 +2417,8 @@ subroutine locate_triangles (nx_block, ny_block, & xdm = p5 * (xicr + xdl) ydm = p5 * ydl - area4 = p5 * (xic - xcr) * ydr * areafac_r(i,j) + ! compute area of (lone) triangle adjacent to right corner + area4 = p5 * (xic - xcr) * ydr * areafac_c(i,j) area_c = edgearea(i,j) - area1 - area2 - area3 - area4 ! shift midpoint so that area of remaining triangles = area_c @@ -2411,7 +2463,7 @@ subroutine locate_triangles (nx_block, ny_block, & iflux (i,j,ng) = i + ishift_tc jflux (i,j,ng) = j + jshift_tc areafact(i,j,ng) = -areafac_c(i,j) - + ! TC2a (group 5) ng = 5 @@ -2424,7 +2476,7 @@ subroutine locate_triangles (nx_block, ny_block, & iflux (i,j,ng) = i + ishift_tc jflux (i,j,ng) = j + jshift_tc areafact(i,j,ng) = -areafac_c(i,j) - + ! TC3a (group 6) ng = 6 @@ -2479,7 +2531,7 @@ subroutine locate_triangles (nx_block, ny_block, & jflux (i,j,ng) = j + jshift_bc areafact(i,j,ng) = areafac_c(i,j) - elseif (ydl < c0 .and. ydr < c0 .and. ydm < c0) then + elseif (ydl <= c0 .and. ydr <= c0 .and. ydm <= c0) then ! BC1a (group 4) @@ -2520,7 +2572,7 @@ subroutine locate_triangles (nx_block, ny_block, & jflux (i,j,ng) = j + jshift_bc areafact(i,j,ng) = areafac_c(i,j) - elseif (ydl < c0 .and. ydr < c0 .and. ydm >= c0) then ! rare + elseif (ydl <= c0 .and. ydr <= c0 .and. ydm > c0) then ! rare ! BC1b (group 4) @@ -2562,11 +2614,9 @@ subroutine locate_triangles (nx_block, ny_block, & areafact(i,j,ng) = -areafac_c(i,j) ! Now consider cases where the two DPs lie in different grid cells - ! For these cases, one triangle is given the area factor associated - ! with the adjacent corner, to avoid rare negative masses on curved grids. - elseif (ydl >= c0 .and. ydr < c0 .and. xic >= c0 & - .and. ydm >= c0) then + elseif (ydl > c0 .and. ydr < c0 .and. xic >= c0 & + .and. ydm >= c0) then ! TC1b (group 4) @@ -2581,7 +2631,7 @@ subroutine locate_triangles (nx_block, ny_block, & jflux (i,j,ng) = j + jshift_tc areafact(i,j,ng) = -areafac_c(i,j) - ! BC2b (group 5) + ! BC2b (group 5) lone triangle ng = 5 xp (i,j,1,ng) = xcr @@ -2592,7 +2642,7 @@ subroutine locate_triangles (nx_block, ny_block, & yp (i,j,3,ng) = ydr iflux (i,j,ng) = i + ishift_bc jflux (i,j,ng) = j + jshift_bc - areafact(i,j,ng) = areafac_r(i,j) + areafact(i,j,ng) = areafac_c(i,j) ! TC3b (group 6) @@ -2607,8 +2657,8 @@ subroutine locate_triangles (nx_block, ny_block, & jflux (i,j,ng) = j + jshift_tc areafact(i,j,ng) = -areafac_c(i,j) - elseif (ydl >= c0 .and. ydr < c0 .and. xic >= c0 & - .and. ydm < c0 ) then ! less common + elseif (ydl > c0 .and. ydr < c0 .and. xic >= c0 & + .and. ydm < c0 ) then ! less common ! TC1b (group 4) @@ -2623,7 +2673,7 @@ subroutine locate_triangles (nx_block, ny_block, & jflux (i,j,ng) = j + jshift_tc areafact(i,j,ng) = -areafac_c(i,j) - ! BC2b (group 5) + ! BC2b (group 5) lone triangle ng = 5 xp (i,j,1,ng) = xcr @@ -2634,7 +2684,7 @@ subroutine locate_triangles (nx_block, ny_block, & yp (i,j,3,ng) = ydr iflux (i,j,ng) = i + ishift_bc jflux (i,j,ng) = j + jshift_bc - areafact(i,j,ng) = areafac_r(i,j) + areafact(i,j,ng) = areafac_c(i,j) ! BC3b (group 6) @@ -2649,10 +2699,10 @@ subroutine locate_triangles (nx_block, ny_block, & jflux (i,j,ng) = j + jshift_bc areafact(i,j,ng) = areafac_c(i,j) - elseif (ydl >= c0 .and. ydr < c0 .and. xic < c0 & - .and. ydm < c0) then + elseif (ydl > c0 .and. ydr < c0 .and. xic < c0 & + .and. ydm < c0) then - ! TC1b (group 4) + ! TC1b (group 4) lone triangle ng = 4 xp (i,j,1,ng) = xcl @@ -2663,7 +2713,7 @@ subroutine locate_triangles (nx_block, ny_block, & yp (i,j,3,ng) = ydl iflux (i,j,ng) = i + ishift_tc jflux (i,j,ng) = j + jshift_tc - areafact(i,j,ng) = -areafac_l(i,j) + areafact(i,j,ng) = -areafac_c(i,j) ! BC2b (group 5) @@ -2691,10 +2741,10 @@ subroutine locate_triangles (nx_block, ny_block, & jflux (i,j,ng) = j + jshift_bc areafact(i,j,ng) = areafac_c(i,j) - elseif (ydl >= c0 .and. ydr < c0 .and. xic < c0 & - .and. ydm >= c0) then ! less common + elseif (ydl > c0 .and. ydr < c0 .and. xic < c0 & + .and. ydm >= c0) then ! less common - ! TC1b (group 4) + ! TC1b (group 4) lone triangle ng = 4 xp (i,j,1,ng) = xcl @@ -2705,7 +2755,7 @@ subroutine locate_triangles (nx_block, ny_block, & yp (i,j,3,ng) = ydl iflux (i,j,ng) = i + ishift_tc jflux (i,j,ng) = j + jshift_tc - areafact(i,j,ng) = -areafac_l(i,j) + areafact(i,j,ng) = -areafac_c(i,j) ! BC2b (group 5) @@ -2733,10 +2783,10 @@ subroutine locate_triangles (nx_block, ny_block, & jflux (i,j,ng) = j + jshift_tc areafact(i,j,ng) = -areafac_c(i,j) - elseif (ydl < c0 .and. ydr >= c0 .and. xic < c0 & - .and. ydm >= c0) then + elseif (ydl < c0 .and. ydr > c0 .and. xic < c0 & + .and. ydm >= c0) then - ! BC1b (group 4) + ! BC1b (group 4) lone triangle ng = 4 xp (i,j,1,ng) = xcl @@ -2747,7 +2797,7 @@ subroutine locate_triangles (nx_block, ny_block, & yp (i,j,3,ng) = yicl iflux (i,j,ng) = i + ishift_bc jflux (i,j,ng) = j + jshift_bc - areafact(i,j,ng) = areafac_l(i,j) + areafact(i,j,ng) = areafac_c(i,j) ! TC2b (group 5) @@ -2775,10 +2825,10 @@ subroutine locate_triangles (nx_block, ny_block, & jflux (i,j,ng) = j + jshift_tc areafact(i,j,ng) = -areafac_c(i,j) - elseif (ydl < c0 .and. ydr >= c0 .and. xic < c0 & - .and. ydm < c0) then ! less common + elseif (ydl < c0 .and. ydr > c0 .and. xic < c0 & + .and. ydm < c0) then ! less common - ! BC1b (group 4) + ! BC1b (group 4) lone triangle ng = 4 xp (i,j,1,ng) = xcl @@ -2789,7 +2839,7 @@ subroutine locate_triangles (nx_block, ny_block, & yp (i,j,3,ng) = yicl iflux (i,j,ng) = i + ishift_bc jflux (i,j,ng) = j + jshift_bc - areafact(i,j,ng) = areafac_l(i,j) + areafact(i,j,ng) = areafac_c(i,j) ! TC2b (group 5) @@ -2817,8 +2867,8 @@ subroutine locate_triangles (nx_block, ny_block, & jflux (i,j,ng) = j + jshift_bc areafact(i,j,ng) = areafac_c(i,j) - elseif (ydl < c0 .and. ydr >= c0 .and. xic >= c0 & - .and. ydm < c0) then + elseif (ydl < c0 .and. ydr > c0 .and. xic >= c0 & + .and. ydm < c0) then ! BC1b (group 4) @@ -2833,7 +2883,7 @@ subroutine locate_triangles (nx_block, ny_block, & jflux (i,j,ng) = j + jshift_bc areafact(i,j,ng) = areafac_c(i,j) - ! TC2b (group 5) + ! TC2b (group 5) lone triangle ng = 5 xp (i,j,1,ng) = xcr @@ -2844,7 +2894,7 @@ subroutine locate_triangles (nx_block, ny_block, & yp (i,j,3,ng) = yicr iflux (i,j,ng) = i + ishift_tc jflux (i,j,ng) = j + jshift_tc - areafact(i,j,ng) = -areafac_r(i,j) + areafact(i,j,ng) = -areafac_c(i,j) ! BC3b (group 6) @@ -2859,8 +2909,8 @@ subroutine locate_triangles (nx_block, ny_block, & jflux (i,j,ng) = j + jshift_bc areafact(i,j,ng) = areafac_c(i,j) - elseif (ydl < c0 .and. ydr >= c0 .and. xic >= c0 & - .and. ydm >= c0) then ! less common + elseif (ydl < c0 .and. ydr > c0 .and. xic >= c0 & + .and. ydm >= c0) then ! less common ! BC1b (group 4) @@ -2875,7 +2925,7 @@ subroutine locate_triangles (nx_block, ny_block, & jflux (i,j,ng) = j + jshift_bc areafact(i,j,ng) = areafac_c(i,j) - ! TC2b (group 5) + ! TC2b (group 5) lone triangle ng = 5 xp (i,j,1,ng) = xcr @@ -2886,7 +2936,7 @@ subroutine locate_triangles (nx_block, ny_block, & yp (i,j,3,ng) = yicr iflux (i,j,ng) = i + ishift_tc jflux (i,j,ng) = j + jshift_tc - areafact(i,j,ng) = -areafac_r(i,j) + areafact(i,j,ng) = -areafac_c(i,j) ! TC3b (group 6) @@ -2960,7 +3010,7 @@ subroutine locate_triangles (nx_block, ny_block, & do ij = 1, icellsd i = indxid(ij) j = indxjd(ij) - if (abs(areasum(i,j) - edgearea(i,j)) > eps13*areafac_c(i,j)) then + if ( abs(areasum(i,j) - edgearea(i,j)) > eps13*areafac_c(i,j) .and. abs(edgearea(i,j)) > c0 ) then write(nu_diag,*) '' write(nu_diag,*) 'Areas do not add up: m, i, j, edge =', & my_task, i, j, trim(edge) @@ -3022,10 +3072,17 @@ subroutine locate_triangles (nx_block, ny_block, & endif if (bugcheck) then + if (trim(edge) == 'north') then + ib = ilo + jb = jlo-1 + else ! east edge + ib = ilo-1 + jb = jlo + endif do ng = 1, ngroups do nv = 1, nvert - do j = jb, je - do i = ib, ie + do j = jb, jhi + do i = ib, ihi if (abs(triarea(i,j,ng)) > puny) then if (abs(xp(i,j,nv,ng)) > p5+puny) then write(nu_diag,*) '' diff --git a/cicecore/cicedyn/infrastructure/ice_grid.F90 b/cicecore/cicedyn/infrastructure/ice_grid.F90 index 770ee9ed9..160e3cc64 100644 --- a/cicecore/cicedyn/infrastructure/ice_grid.F90 +++ b/cicecore/cicedyn/infrastructure/ice_grid.F90 @@ -82,14 +82,14 @@ module ice_grid dyE , & ! height of E-cell through the middle (m) HTE , & ! length of eastern edge of T-cell (m) HTN , & ! length of northern edge of T-cell (m) - tarea , & ! area of T-cell (m^2) - uarea , & ! area of U-cell (m^2) - narea , & ! area of N-cell (m^2) - earea , & ! area of E-cell (m^2) - tarear , & ! 1/tarea - uarear , & ! 1/uarea - narear , & ! 1/narea - earear , & ! 1/earea + tarea , & ! area of T-cell (m^2), valid in halo + uarea , & ! area of U-cell (m^2), valid in halo + narea , & ! area of N-cell (m^2), valid in halo + earea , & ! area of E-cell (m^2), valid in halo + tarear , & ! 1/tarea, valid in halo + uarear , & ! 1/uarea, valid in halo + narear , & ! 1/narea, valid in halo + earear , & ! 1/earea, valid in halo tarean , & ! area of NH T-cells tareas , & ! area of SH T-cells ULON , & ! longitude of velocity pts, NE corner of T pts (radians) @@ -101,7 +101,7 @@ module ice_grid ELON , & ! longitude of center of east face of T pts (radians) ELAT , & ! latitude of center of east face of T pts (radians) ANGLE , & ! for conversions between POP grid and lat/lon - ANGLET , & ! ANGLE converted to T-cells + ANGLET , & ! ANGLE converted to T-cells, valid in halo bathymetry , & ! ocean depth, for grounding keels and bergs (m) ocn_gridcell_frac ! only relevant for lat-lon grids ! gridcell value of [1 - (land fraction)] (T-cell) @@ -635,12 +635,24 @@ subroutine init_grid2 call ice_HaloUpdate (uarea, halo_info, & field_loc_NEcorner, field_type_scalar, & fillValue=c1, tripoleOnly=.true.) + call ice_HaloUpdate (narea, halo_info, & + field_loc_Nface, field_type_scalar, & + fillValue=c1, tripoleOnly=.true.) + call ice_HaloUpdate (earea, halo_info, & + field_loc_Eface, field_type_scalar, & + fillValue=c1, tripoleOnly=.true.) call ice_HaloUpdate (tarear, halo_info, & field_loc_center, field_type_scalar, & fillValue=c1, tripoleOnly=.true.) call ice_HaloUpdate (uarear, halo_info, & field_loc_NEcorner, field_type_scalar, & fillValue=c1, tripoleOnly=.true.) + call ice_HaloUpdate (narear, halo_info, & + field_loc_Nface, field_type_scalar, & + fillValue=c1, tripoleOnly=.true.) + call ice_HaloUpdate (earear, halo_info, & + field_loc_Eface, field_type_scalar, & + fillValue=c1, tripoleOnly=.true.) call ice_timer_stop(timer_bound) diff --git a/doc/source/science_guide/sg_horiztrans.rst b/doc/source/science_guide/sg_horiztrans.rst index 10b668755..4ccf00e9b 100644 --- a/doc/source/science_guide/sg_horiztrans.rst +++ b/doc/source/science_guide/sg_horiztrans.rst @@ -477,9 +477,16 @@ Remote Sensing Center (Norway), who applied an earlier version of the CICE remapping scheme to an ocean model. The implementation in CICE is somewhat more general, allowing for departure regions lying on both sides of a cell edge. The extra triangle is constrained to lie in one -but not both of the grid cells that share the edge. Since this option -has yet to be fully tested in CICE, the current default is -`l\_fixed\_area` = false. +but not both of the grid cells that share the edge. + +The default value for the B grid is `l\_fixed\_area` = false. However, +idealized tests with the C grid have shown that prognostic fields such +as sea ice concentration exhibit a checkerboard pattern with +`l\_fixed\_area` = false. The logical `l\_fixed\_area` is therefore set +to true when using the C grid. The edge areas `edgearea\_e` and `edgearea\_n` +are in this case calculated with the C grid velocity components :math:`uvelE` +and :math:`vvelN`. + We made one other change in the scheme of :cite:`Dukowicz00` for locating triangles. In their paper, departure points are defined by From a5bb4f9a0c180e325e2a5480832f588dbfdd25ec Mon Sep 17 00:00:00 2001 From: Denise Worthen Date: Fri, 15 Sep 2023 16:01:00 -0400 Subject: [PATCH 22/76] switch to cesm-style field names (#869) --- .../drivers/nuopc/cmeps/ice_import_export.F90 | 262 +++++++++--------- 1 file changed, 131 insertions(+), 131 deletions(-) diff --git a/cicecore/drivers/nuopc/cmeps/ice_import_export.F90 b/cicecore/drivers/nuopc/cmeps/ice_import_export.F90 index 60059e39a..a932e0b2b 100644 --- a/cicecore/drivers/nuopc/cmeps/ice_import_export.F90 +++ b/cicecore/drivers/nuopc/cmeps/ice_import_export.F90 @@ -171,33 +171,33 @@ subroutine ice_advertise_fields(gcomp, importState, exportState, flds_scalar_nam call fldlist_add(fldsToIce_num, fldsToIce, trim(flds_scalar_name)) ! from ocean - call fldlist_add(fldsToIce_num, fldsToIce, 'sea_surface_slope_zonal' ) - call fldlist_add(fldsToIce_num, fldsToIce, 'sea_surface_slope_merid' ) - call fldlist_add(fldsToIce_num, fldsToIce, 'sea_surface_temperature' ) - call fldlist_add(fldsToIce_num, fldsToIce, 's_surf' ) - call fldlist_add(fldsToIce_num, fldsToIce, 'ocn_current_zonal' ) - call fldlist_add(fldsToIce_num, fldsToIce, 'ocn_current_merid' ) - call fldlist_add(fldsToIce_num, fldsToIce, 'freezing_melting_potential') + call fldlist_add(fldsToIce_num, fldsToIce, 'So_dhdx' ) + call fldlist_add(fldsToIce_num, fldsToIce, 'So_dhdy' ) + call fldlist_add(fldsToIce_num, fldsToIce, 'So_t' ) + call fldlist_add(fldsToIce_num, fldsToIce, 'So_s' ) + call fldlist_add(fldsToIce_num, fldsToIce, 'So_u' ) + call fldlist_add(fldsToIce_num, fldsToIce, 'So_v' ) + call fldlist_add(fldsToIce_num, fldsToIce, 'Fioo_q' ) if (flds_wiso) then call fldlist_add(fldsToIce_num, fldsToIce, 'So_roce_wiso', ungridded_lbound=1, ungridded_ubound=3) end if ! from atmosphere - call fldlist_add(fldsToIce_num, fldsToIce, 'inst_height_lowest' ) - call fldlist_add(fldsToIce_num, fldsToIce, 'inst_zonal_wind_height_lowest' ) - call fldlist_add(fldsToIce_num, fldsToIce, 'inst_merid_wind_height_lowest' ) - call fldlist_add(fldsToIce_num, fldsToIce, 'inst_spec_humid_height_lowest' ) - call fldlist_add(fldsToIce_num, fldsToIce, 'inst_temp_height_lowest' ) - call fldlist_add(fldsToIce_num, fldsToIce, 'inst_pres_height_lowest' ) - call fldlist_add(fldsToIce_num, fldsToIce, 'mean_down_sw_vis_dir_flx' ) - call fldlist_add(fldsToIce_num, fldsToIce, 'mean_down_sw_ir_dir_flx' ) - call fldlist_add(fldsToIce_num, fldsToIce, 'mean_down_sw_vis_dif_flx' ) - call fldlist_add(fldsToIce_num, fldsToIce, 'mean_down_sw_ir_dif_flx' ) - call fldlist_add(fldsToIce_num, fldsToIce, 'mean_down_lw_flx' ) - call fldlist_add(fldsToIce_num, fldsToIce, 'mean_prec_rate' ) - call fldlist_add(fldsToIce_num, fldsToIce, 'mean_fprec_rate' ) - call fldlist_add(fldsToIce_num, fldsToIce, 'Sa_ptem' ) !cesm - call fldlist_add(fldsToIce_num, fldsToIce, 'air_density_height_lowest' ) !cesm + call fldlist_add(fldsToIce_num, fldsToIce, 'Sa_z' ) + call fldlist_add(fldsToIce_num, fldsToIce, 'Sa_u' ) + call fldlist_add(fldsToIce_num, fldsToIce, 'Sa_v' ) + call fldlist_add(fldsToIce_num, fldsToIce, 'Sa_shum' ) + call fldlist_add(fldsToIce_num, fldsToIce, 'Sa_tbot' ) + call fldlist_add(fldsToIce_num, fldsToIce, 'Sa_pbot' ) + call fldlist_add(fldsToIce_num, fldsToIce, 'Faxa_swvdr' ) + call fldlist_add(fldsToIce_num, fldsToIce, 'Faxa_swvdf' ) + call fldlist_add(fldsToIce_num, fldsToIce, 'Faxa_swndr' ) + call fldlist_add(fldsToIce_num, fldsToIce, 'Faxa_swndf' ) + call fldlist_add(fldsToIce_num, fldsToIce, 'Faxa_lwdn' ) + call fldlist_add(fldsToIce_num, fldsToIce, 'Faxa_rain' ) + call fldlist_add(fldsToIce_num, fldsToIce, 'Faxa_snow' ) + call fldlist_add(fldsToIce_num, fldsToIce, 'Sa_ptem' ) !cesm + call fldlist_add(fldsToIce_num, fldsToIce, 'Sa_dens' ) !cesm ! the following are advertised but might not be connected if they are not present ! in the cmeps esmFldsExchange_xxx_mod.F90 that is model specific @@ -229,67 +229,67 @@ subroutine ice_advertise_fields(gcomp, importState, exportState, flds_scalar_nam call fldlist_add(fldsFrIce_num, fldsFrIce, trim(flds_scalar_name)) ! ice states - call fldlist_add(fldsFrIce_num, fldsFrIce, 'ice_mask' ) - call fldlist_add(fldsFrIce_num, fldsFrIce, 'ice_fraction' ) - call fldlist_add(fldsFrIce_num, fldsFrIce, 'sea_ice_surface_temperature' ) - call fldlist_add(fldsFrIce_num, fldsFrIce, 'mean_ice_volume' ) - call fldlist_add(fldsFrIce_num, fldsFrIce, 'mean_snow_volume' ) - call fldlist_add(fldsFrIce_num, fldsFrIce, 'Si_tref' ) - call fldlist_add(fldsFrIce_num, fldsFrIce, 'Si_qref' ) - call fldlist_add(fldsFrIce_num, fldsFrIce, 'Si_snowh' ) - call fldlist_add(fldsFrIce_num, fldsFrIce, 'Si_u10' ) - call fldlist_add(fldsFrIce_num, fldsFrIce, 'inst_ice_vis_dir_albedo' ) - call fldlist_add(fldsFrIce_num, fldsFrIce, 'inst_ice_ir_dir_albedo' ) - call fldlist_add(fldsFrIce_num, fldsFrIce, 'inst_ice_vis_dif_albedo' ) - call fldlist_add(fldsFrIce_num, fldsFrIce, 'inst_ice_ir_dif_albedo' ) + call fldlist_add(fldsFrIce_num, fldsFrIce, 'Si_imask' ) + call fldlist_add(fldsFrIce_num, fldsFrIce, 'Si_ifrac' ) + call fldlist_add(fldsFrIce_num, fldsFrIce, 'Si_t' ) + call fldlist_add(fldsFrIce_num, fldsFrIce, 'Si_vice' ) + call fldlist_add(fldsFrIce_num, fldsFrIce, 'Si_vsno' ) + call fldlist_add(fldsFrIce_num, fldsFrIce, 'Si_tref' ) + call fldlist_add(fldsFrIce_num, fldsFrIce, 'Si_qref' ) + call fldlist_add(fldsFrIce_num, fldsFrIce, 'Si_snowh' ) + call fldlist_add(fldsFrIce_num, fldsFrIce, 'Si_u10' ) + call fldlist_add(fldsFrIce_num, fldsFrIce, 'Si_avsdr' ) + call fldlist_add(fldsFrIce_num, fldsFrIce, 'Si_avsdf' ) + call fldlist_add(fldsFrIce_num, fldsFrIce, 'Si_anidr' ) + call fldlist_add(fldsFrIce_num, fldsFrIce, 'Si_anidf' ) ! the following are advertised but might not be connected if they are not present ! in the cmeps esmFldsExchange_xxx_mod.F90 that is model specific if (send_i2x_per_cat) then - call fldlist_add(fldsFrIce_num, fldsFrIce, 'ice_fraction_n', & + call fldlist_add(fldsFrIce_num, fldsFrIce, 'Si_ifrac_n', & ungridded_lbound=1, ungridded_ubound=ncat) end if if (flds_wave) then - call fldlist_add(fldsFrIce_num, fldsFrIce, 'Si_thick' ) - call fldlist_add(fldsFrIce_num, fldsFrIce, 'Si_floediam' ) + call fldlist_add(fldsFrIce_num, fldsFrIce, 'Si_thick' ) + call fldlist_add(fldsFrIce_num, fldsFrIce, 'Si_floediam' ) end if ! ice/atm fluxes computed by ice - call fldlist_add(fldsFrIce_num, fldsFrIce, 'stress_on_air_ice_zonal' ) - call fldlist_add(fldsFrIce_num, fldsFrIce, 'stress_on_air_ice_merid' ) - call fldlist_add(fldsFrIce_num, fldsFrIce, 'mean_laten_heat_flx_atm_into_ice' ) - call fldlist_add(fldsFrIce_num, fldsFrIce, 'mean_sensi_heat_flx_atm_into_ice' ) - call fldlist_add(fldsFrIce_num, fldsFrIce, 'mean_up_lw_flx_ice' ) - call fldlist_add(fldsFrIce_num, fldsFrIce, 'mean_evap_rate_atm_into_ice' ) - call fldlist_add(fldsFrIce_num, fldsFrIce, 'Faii_swnet' ) + call fldlist_add(fldsFrIce_num, fldsFrIce, 'Faii_taux' ) + call fldlist_add(fldsFrIce_num, fldsFrIce, 'Faii_tauy' ) + call fldlist_add(fldsFrIce_num, fldsFrIce, 'Faii_lat' ) + call fldlist_add(fldsFrIce_num, fldsFrIce, 'Faii_sen' ) + call fldlist_add(fldsFrIce_num, fldsFrIce, 'Faii_lwup' ) + call fldlist_add(fldsFrIce_num, fldsFrIce, 'Faii_evap' ) + call fldlist_add(fldsFrIce_num, fldsFrIce, 'Faii_swnet' ) ! ice/ocn fluxes computed by ice - call fldlist_add(fldsFrIce_num, fldsFrIce, 'net_heat_flx_to_ocn' ) - call fldlist_add(fldsFrIce_num, fldsFrIce, 'mean_sw_pen_to_ocn' ) - call fldlist_add(fldsFrIce_num, fldsFrIce, 'mean_sw_pen_to_ocn_vis_dir_flx' ) - call fldlist_add(fldsFrIce_num, fldsFrIce, 'mean_sw_pen_to_ocn_vis_dif_flx' ) - call fldlist_add(fldsFrIce_num, fldsFrIce, 'mean_sw_pen_to_ocn_ir_dir_flx' ) - call fldlist_add(fldsFrIce_num, fldsFrIce, 'mean_sw_pen_to_ocn_ir_dif_flx' ) + call fldlist_add(fldsFrIce_num, fldsFrIce, 'Fioi_melth' ) + call fldlist_add(fldsFrIce_num, fldsFrIce, 'Fioi_swpen' ) + call fldlist_add(fldsFrIce_num, fldsFrIce, 'Fioi_swpen_vdr' ) + call fldlist_add(fldsFrIce_num, fldsFrIce, 'Fioi_swpen_vdf' ) + call fldlist_add(fldsFrIce_num, fldsFrIce, 'Fioi_swpen_idr' ) + call fldlist_add(fldsFrIce_num, fldsFrIce, 'Fioi_swpen_idf' ) if (send_i2x_per_cat) then - call fldlist_add(fldsFrIce_num, fldsFrIce, 'mean_sw_pen_to_ocn_ifrac_n', & + call fldlist_add(fldsFrIce_num, fldsFrIce, 'Fioi_swpen_ifrac_n', & ungridded_lbound=1, ungridded_ubound=ncat) end if - call fldlist_add(fldsFrIce_num , fldsFrIce, 'mean_fresh_water_to_ocean_rate' ) - call fldlist_add(fldsFrIce_num , fldsFrIce, 'mean_salt_rate' ) - call fldlist_add(fldsFrIce_num , fldsFrIce, 'stress_on_ocn_ice_zonal' ) - call fldlist_add(fldsFrIce_num , fldsFrIce, 'stress_on_ocn_ice_merid' ) + call fldlist_add(fldsFrIce_num , fldsFrIce, 'Fioi_meltw' ) + call fldlist_add(fldsFrIce_num , fldsFrIce, 'Fioi_salt' ) + call fldlist_add(fldsFrIce_num , fldsFrIce, 'Fioi_taux' ) + call fldlist_add(fldsFrIce_num , fldsFrIce, 'Fioi_tauy' ) ! the following are advertised but might not be connected if they are not present ! in the cmeps esmFldsExchange_xxx_mod.F90 that is model specific - call fldlist_add(fldsFrIce_num , fldsFrIce, 'Fioi_bcpho' ) - call fldlist_add(fldsFrIce_num , fldsFrIce, 'Fioi_bcphi' ) - call fldlist_add(fldsFrIce_num , fldsFrIce, 'Fioi_flxdst' ) + call fldlist_add(fldsFrIce_num , fldsFrIce, 'Fioi_bcpho' ) + call fldlist_add(fldsFrIce_num , fldsFrIce, 'Fioi_bcphi' ) + call fldlist_add(fldsFrIce_num , fldsFrIce, 'Fioi_flxdst' ) if (flds_wiso) then - call fldlist_add(fldsFrIce_num, fldsFrIce, 'mean_fresh_water_to_ocean_rate_wiso', & + call fldlist_add(fldsFrIce_num, fldsFrIce, 'Fioi_meltw_wiso', & ungridded_lbound=1, ungridded_ubound=3) - call fldlist_add(fldsFrIce_num, fldsFrIce, 'mean_evap_rate_atm_into_ice_wiso', & + call fldlist_add(fldsFrIce_num, fldsFrIce, 'Faii_evap_wiso', & ungridded_lbound=1, ungridded_ubound=3) call fldlist_add(fldsFrIce_num, fldsFrIce, 'Si_qref_wiso', & ungridded_lbound=1, ungridded_ubound=3) @@ -488,69 +488,69 @@ subroutine ice_import( importState, rc ) ! import ocean states - call state_getimport(importState, 'sea_surface_temperature', output=aflds, index=1, rc=rc) + call state_getimport(importState, 'So_t', output=aflds, index=1, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport(importState, 's_surf', output=aflds, index=2, rc=rc) + call state_getimport(importState, 'So_s', output=aflds, index=2, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! import atm states - call state_getimport(importState, 'inst_height_lowest', output=aflds, index=3, rc=rc) + call state_getimport(importState, 'Sa_z', output=aflds, index=3, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (State_FldChk(importState, 'Sa_ptem') .and. State_fldchk(importState, 'air_density_height_lowest')) then + if (State_FldChk(importState, 'Sa_ptem') .and. State_fldchk(importState, 'Sa_dens')) then call state_getimport(importState, 'Sa_ptem', output=aflds, index=4, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport(importState, 'air_density_height_lowest', output=aflds, index=5, rc=rc) + call state_getimport(importState, 'Sa_dens', output=aflds, index=5, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - else if (State_FldChk(importState, 'inst_pres_height_lowest')) then - call state_getimport(importState, 'inst_pres_height_lowest', output=aflds, index=6, rc=rc) + else if (State_FldChk(importState, 'Sa_pbot')) then + call state_getimport(importState, 'Sa_pbot', output=aflds, index=6, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return else call abort_ice(trim(subname)//& - ": ERROR either Sa_ptem and air_density_height_lowest OR inst_pres_height_lowest must be in import state") + ": ERROR either Sa_ptem and Sa_dens OR Sa_pbot must be in import state") end if - call state_getimport(importState, 'inst_temp_height_lowest', output=aflds, index=7, rc=rc) + call state_getimport(importState, 'Sa_tbot', output=aflds, index=7, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport(importState, 'inst_spec_humid_height_lowest', output=aflds, index=8, rc=rc) + call state_getimport(importState, 'Sa_shum', output=aflds, index=8, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! import ocn/ice fluxes - call state_getimport(importState, 'freezing_melting_potential', output=aflds, index=9, & + call state_getimport(importState, 'Fioo_q', output=aflds, index=9, & areacor=med2mod_areacor, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! import atm fluxes - call state_getimport(importState, 'mean_down_sw_vis_dir_flx', output=aflds, index=10, & + call state_getimport(importState, 'Faxa_swvdr', output=aflds, index=10, & areacor=med2mod_areacor, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport(importState, 'mean_down_sw_ir_dir_flx', output=aflds, index=11, & + call state_getimport(importState, 'Faxa_swndr', output=aflds, index=11, & areacor=med2mod_areacor, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport(importState, 'mean_down_sw_vis_dif_flx', output=aflds, index=12, & + call state_getimport(importState, 'Faxa_swvdf', output=aflds, index=12, & areacor=med2mod_areacor, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport(importState, 'mean_down_sw_ir_dif_flx', output=aflds, index=13, & + call state_getimport(importState, 'Faxa_swndf', output=aflds, index=13, & areacor=med2mod_areacor, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport(importState, 'mean_down_lw_flx', output=aflds, index=14, & + call state_getimport(importState, 'Faxa_lwdn', output=aflds, index=14, & areacor=med2mod_areacor, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport(importState, 'mean_prec_rate', output=aflds, index=15, & + call state_getimport(importState, 'Faxa_rain', output=aflds, index=15, & areacor=med2mod_areacor, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport(importState, 'mean_fprec_rate', output=aflds, index=16, & + call state_getimport(importState, 'Faxa_snow', output=aflds, index=16, & areacor=med2mod_areacor, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -610,7 +610,7 @@ subroutine ice_import( importState, rc ) end do end if - if ( State_fldChk(importState, 'Sa_ptem') .and. State_fldchk(importState,'air_density_height_lowest')) then + if ( State_fldChk(importState, 'Sa_ptem') .and. State_fldchk(importState,'Sa_dens')) then !$OMP PARALLEL DO PRIVATE(iblk,i,j) do iblk = 1, nblocks do j = 1,ny_block @@ -621,7 +621,7 @@ subroutine ice_import( importState, rc ) end do end do !$OMP END PARALLEL DO - else if (State_fldChk(importState, 'inst_pres_height_lowest')) then + else if (State_fldChk(importState, 'Sa_pbot')) then !$OMP PARALLEL DO PRIVATE(iblk,i,j) do iblk = 1, nblocks do j = 1,ny_block @@ -650,19 +650,19 @@ subroutine ice_import( importState, rc ) ! Get velocity fields from ocean and atm and slope fields from ocean - call state_getimport(importState, 'ocn_current_zonal', output=aflds, index=1, rc=rc) + call state_getimport(importState, 'So_u', output=aflds, index=1, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport(importState, 'ocn_current_merid', output=aflds, index=2, rc=rc) + call state_getimport(importState, 'So_v', output=aflds, index=2, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport(importState, 'inst_zonal_wind_height_lowest', output=aflds, index=3, rc=rc) + call state_getimport(importState, 'Sa_u', output=aflds, index=3, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport(importState, 'inst_merid_wind_height_lowest', output=aflds, index=4, rc=rc) + call state_getimport(importState, 'Sa_v', output=aflds, index=4, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport(importState, 'sea_surface_slope_zonal', output=aflds, index=5, rc=rc) + call state_getimport(importState, 'So_dhdx', output=aflds, index=5, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport(importState, 'sea_surface_slope_merid', output=aflds, index=6, rc=rc) + call state_getimport(importState, 'So_dhdy', output=aflds, index=6, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -749,11 +749,11 @@ subroutine ice_import( importState, rc ) ! HDO => ungridded_index=3 if (State_FldChk(importState, 'shum_wiso')) then - call state_getimport(importState, 'inst_spec_humid_height_lowest_wiso', output=Qa_iso, index=1, ungridded_index=3, rc=rc) + call state_getimport(importState, 'Sa_shum_wiso', output=Qa_iso, index=1, ungridded_index=3, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport(importState, 'inst_spec_humid_height_lowest_wiso', output=Qa_iso, index=2, ungridded_index=1, rc=rc) + call state_getimport(importState, 'Sa_shum_wiso', output=Qa_iso, index=2, ungridded_index=1, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport(importState, 'inst_spec_humid_height_lowest_wiso', output=Qa_iso, index=3, ungridded_index=2, rc=rc) + call state_getimport(importState, 'Sa_shum_wiso', output=Qa_iso, index=3, ungridded_index=2, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! call state_getimport(importState, 'mean_prec_rate_wiso', output=fiso_rain, index=1, ungridded_index=3, & @@ -766,11 +766,11 @@ subroutine ice_import( importState, rc ) ! areacor=med2mod_areacor, rc=rc) ! if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport(importState, 'mean_fprec_rate_wiso', output=fiso_atm, index=1, ungridded_index=3, rc=rc) + call state_getimport(importState, 'Faxa_snow_wiso', output=fiso_atm, index=1, ungridded_index=3, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport(importState, 'mean_fprec_rate_wiso', output=fiso_atm, index=2, ungridded_index=1, rc=rc) + call state_getimport(importState, 'Faxa_snow_wiso', output=fiso_atm, index=2, ungridded_index=1, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport(importState, 'mean_fprec_rate_wiso', output=fiso_atm, index=3, ungridded_index=2, rc=rc) + call state_getimport(importState, 'Faxa_snow_wiso', output=fiso_atm, index=3, ungridded_index=2, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call state_getimport(importState, 'So_roce_wiso', output=HDO_ocn , ungridded_index=3, & @@ -1056,11 +1056,11 @@ subroutine ice_export( exportState, rc ) allocate(tempfld(nx_block,ny_block,nblocks)) ! Fractions and mask - call state_setexport(exportState, 'ice_fraction', input=ailohi, rc=rc) + call state_setexport(exportState, 'Si_ifrac', input=ailohi, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (trim(grid_format) == 'meshnc') then - call state_setexport(exportState, 'ice_mask', input=ocn_gridcell_frac, rc=rc) + call state_setexport(exportState, 'Si_imask', input=ocn_gridcell_frac, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return else do iblk = 1, nblocks @@ -1075,7 +1075,7 @@ subroutine ice_export( exportState, rc ) end do end do end do - call state_setexport(exportState, 'ice_mask', input=tempfld, rc=rc) + call state_setexport(exportState, 'Si_imask', input=tempfld, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if @@ -1084,23 +1084,23 @@ subroutine ice_export( exportState, rc ) ! ---- ! surface temperature of ice covered portion (degK) - call state_setexport(exportState, 'sea_ice_surface_temperature', input=Tsrf , lmask=tmask, ifrac=ailohi, rc=rc) + call state_setexport(exportState, 'Si_t', input=Tsrf , lmask=tmask, ifrac=ailohi, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! albedo vis dir - call state_setexport(exportState, 'inst_ice_vis_dir_albedo', input=alvdr, lmask=tmask, ifrac=ailohi, rc=rc) + call state_setexport(exportState, 'Si_avsdr', input=alvdr, lmask=tmask, ifrac=ailohi, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! albedo nir dir - call state_setexport(exportState, 'inst_ice_ir_dir_albedo', input=alidr, lmask=tmask, ifrac=ailohi, rc=rc) + call state_setexport(exportState, 'Si_anidr', input=alidr, lmask=tmask, ifrac=ailohi, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! albedo vis dif - call state_setexport(exportState, 'inst_ice_vis_dif_albedo', input=alvdf, lmask=tmask, ifrac=ailohi, rc=rc) + call state_setexport(exportState, 'Si_avsdf', input=alvdf, lmask=tmask, ifrac=ailohi, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! albedo nir dif - call state_setexport(exportState, 'inst_ice_ir_dif_albedo', input=alidf, lmask=tmask, ifrac=ailohi, rc=rc) + call state_setexport(exportState, 'Si_anidf', input=alidf, lmask=tmask, ifrac=ailohi, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! 10m atm reference wind speed (m/s) @@ -1116,11 +1116,11 @@ subroutine ice_export( exportState, rc ) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! Snow volume - call state_setexport(exportState, 'mean_snow_volume' , input=vsno , lmask=tmask, ifrac=ailohi, rc=rc) + call state_setexport(exportState, 'Si_vsno' , input=vsno , lmask=tmask, ifrac=ailohi, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! Ice volume - call state_setexport(exportState, 'mean_ice_volume' , input=vice , lmask=tmask, ifrac=ailohi, rc=rc) + call state_setexport(exportState, 'Si_vice' , input=vice , lmask=tmask, ifrac=ailohi, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! Snow height @@ -1162,32 +1162,32 @@ subroutine ice_export( exportState, rc ) ! ------ ! Zonal air/ice stress - call state_setexport(exportState, 'stress_on_air_ice_zonal' , input=tauxa, lmask=tmask, ifrac=ailohi, & + call state_setexport(exportState, 'Faii_taux' , input=tauxa, lmask=tmask, ifrac=ailohi, & areacor=mod2med_areacor, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! Meridional air/ice stress - call state_setexport(exportState, 'stress_on_air_ice_merid' , input=tauya, lmask=tmask, ifrac=ailohi, & + call state_setexport(exportState, 'Faii_tauy' , input=tauya, lmask=tmask, ifrac=ailohi, & areacor=mod2med_areacor, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! Latent heat flux (atm into ice) - call state_setexport(exportState, 'mean_laten_heat_flx_atm_into_ice' , input=flat, lmask=tmask, ifrac=ailohi, & + call state_setexport(exportState, 'Faii_lat' , input=flat, lmask=tmask, ifrac=ailohi, & areacor=mod2med_areacor, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! Sensible heat flux (atm into ice) - call state_setexport(exportState, 'mean_sensi_heat_flx_atm_into_ice' , input=fsens, lmask=tmask, ifrac=ailohi, & + call state_setexport(exportState, 'Faii_sen' , input=fsens, lmask=tmask, ifrac=ailohi, & areacor=mod2med_areacor, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! longwave outgoing (upward), average over ice fraction only - call state_setexport(exportState, 'mean_up_lw_flx_ice' , input=flwout, lmask=tmask, ifrac=ailohi, & + call state_setexport(exportState, 'Faii_lwup' , input=flwout, lmask=tmask, ifrac=ailohi, & areacor=mod2med_areacor, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! Evaporative water flux (kg/m^2/s) - call state_setexport(exportState, 'mean_evap_rate_atm_into_ice' , input=evap, lmask=tmask, ifrac=ailohi, & + call state_setexport(exportState, 'Faii_evap' , input=evap, lmask=tmask, ifrac=ailohi, & areacor=mod2med_areacor, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -1201,52 +1201,52 @@ subroutine ice_export( exportState, rc ) ! ------ ! flux of shortwave through ice to ocean - call state_setexport(exportState, 'mean_sw_pen_to_ocn' , input=fswthru, lmask=tmask, ifrac=ailohi, & + call state_setexport(exportState, 'Fioi_swpen' , input=fswthru, lmask=tmask, ifrac=ailohi, & areacor=mod2med_areacor, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! flux of vis dir shortwave through ice to ocean - call state_setexport(exportState, 'mean_sw_pen_to_ocn_vis_dir_flx' , input=fswthru_vdr, lmask=tmask, ifrac=ailohi, & + call state_setexport(exportState, 'Fioi_swpen_vdr' , input=fswthru_vdr, lmask=tmask, ifrac=ailohi, & areacor=mod2med_areacor, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! flux of vis dif shortwave through ice to ocean - call state_setexport(exportState, 'mean_sw_pen_to_ocn_vis_dif_flx' , input=fswthru_vdf, lmask=tmask, ifrac=ailohi, & + call state_setexport(exportState, 'Fioi_swpen_vdf' , input=fswthru_vdf, lmask=tmask, ifrac=ailohi, & areacor=mod2med_areacor, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! flux of ir dir shortwave through ice to ocean - call state_setexport(exportState, 'mean_sw_pen_to_ocn_ir_dir_flx' , input=fswthru_idr, lmask=tmask, ifrac=ailohi, & + call state_setexport(exportState, 'Fioi_swpen_idr' , input=fswthru_idr, lmask=tmask, ifrac=ailohi, & areacor=mod2med_areacor, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! flux of ir dif shortwave through ice to ocean - call state_setexport(exportState, 'mean_sw_pen_to_ocn_ir_dif_flx' , input=fswthru_idf, lmask=tmask, ifrac=ailohi, & + call state_setexport(exportState, 'Fioi_swpen_idf' , input=fswthru_idf, lmask=tmask, ifrac=ailohi, & areacor=mod2med_areacor, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! flux of heat exchange with ocean - call state_setexport(exportState, 'net_heat_flx_to_ocn' , input=fhocn, lmask=tmask, ifrac=ailohi, & + call state_setexport(exportState, 'Fioi_melth' , input=fhocn, lmask=tmask, ifrac=ailohi, & areacor=mod2med_areacor, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! flux fresh water to ocean (h2o flux from melting) - call state_setexport(exportState, 'mean_fresh_water_to_ocean_rate' , input=fresh, lmask=tmask, ifrac=ailohi, & + call state_setexport(exportState, 'Fioi_meltw' , input=fresh, lmask=tmask, ifrac=ailohi, & areacor=mod2med_areacor, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! flux of salt to ocean (salt flux from melting) - call state_setexport(exportState, 'mean_salt_rate' , input=fsalt, lmask=tmask, ifrac=ailohi, & + call state_setexport(exportState, 'Fioi_salt' , input=fsalt, lmask=tmask, ifrac=ailohi, & areacor=mod2med_areacor, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! stress n i/o zonal - call state_setexport(exportState, 'stress_on_ocn_ice_zonal' , input=tauxo, lmask=tmask, ifrac=ailohi, & + call state_setexport(exportState, 'Fioi_taux' , input=tauxo, lmask=tmask, ifrac=ailohi, & areacor=mod2med_areacor, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! stress n i/o meridional - call state_setexport(exportState, 'stress_on_ocn_ice_merid' , input=tauyo, lmask=tmask, ifrac=ailohi, & + call state_setexport(exportState, 'Fioi_tauy' , input=tauyo, lmask=tmask, ifrac=ailohi, & areacor=mod2med_areacor, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -1279,18 +1279,18 @@ subroutine ice_export( exportState, rc ) ! optional water isotope fluxes to ocean ! ------ - if (State_FldChk(exportState, 'mean_fresh_water_to_ocean_rate_wiso')) then + if (State_FldChk(exportState, 'Fioi_meltw_wiso')) then ! 16O => ungridded_index=1 ! 18O => ungridded_index=2 ! HDO => ungridded_index=3 - call state_setexport(exportState, 'mean_fresh_water_to_ocean_rate_wiso' , input=fiso_ocn, index=1, & + call state_setexport(exportState, 'Fioi_meltw_wiso' , input=fiso_ocn, index=1, & lmask=tmask, ifrac=ailohi, ungridded_index=3, areacor=mod2med_areacor, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_setexport(exportState, 'mean_fresh_water_to_ocean_rate_wiso' , input=fiso_ocn, index=2, & + call state_setexport(exportState, 'Fioi_meltw_wiso' , input=fiso_ocn, index=2, & lmask=tmask, ifrac=ailohi, ungridded_index=1, areacor=mod2med_areacor, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_setexport(exportState, 'mean_fresh_water_to_ocean_rate_wiso' , input=fiso_ocn, index=3, & + call state_setexport(exportState, 'Fioi_meltw_wiso' , input=fiso_ocn, index=3, & lmask=tmask, ifrac=ailohi, ungridded_index=2, areacor=mod2med_areacor, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if @@ -1299,15 +1299,15 @@ subroutine ice_export( exportState, rc ) ! optional water isotope fluxes to atmospehre ! ------ - if (State_FldChk(exportState, 'mean_evap_rate_atm_into_ice_wiso')) then + if (State_FldChk(exportState, 'Faii_evap_wiso')) then ! Isotope evap to atm - call state_setexport(exportState, 'mean_evap_rate_atm_into_ice_wiso' , input=fiso_evap, index=1, & + call state_setexport(exportState, 'Faii_evap_wiso' , input=fiso_evap, index=1, & lmask=tmask, ifrac=ailohi, ungridded_index=3, areacor=mod2med_areacor, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_setexport(exportState, 'mean_evap_rate_atm_into_ice_wiso' , input=fiso_evap, index=2, & + call state_setexport(exportState, 'Faii_evap_wiso' , input=fiso_evap, index=2, & lmask=tmask, ifrac=ailohi, ungridded_index=1, areacor=mod2med_areacor, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_setexport(exportState, 'mean_evap_rate_atm_into_ice_wiso' , input=fiso_evap, index=3, & + call state_setexport(exportState, 'Faii_evap_wiso' , input=fiso_evap, index=3, & lmask=tmask, ifrac=ailohi, ungridded_index=2, areacor=mod2med_areacor, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -1328,17 +1328,17 @@ subroutine ice_export( exportState, rc ) ! ------ ! ice fraction by category - if ( State_FldChk(exportState, 'ice_fraction_n') .and. & - State_FldChk(exportState, 'mean_sw_pen_to_ocn_ifrac_n')) then + if ( State_FldChk(exportState, 'Si_ifrac_n') .and. & + State_FldChk(exportState, 'Fioi_swpen_ifrac_n')) then do n = 1,ncat - call state_setexport(exportState, 'ice_fraction_n', input=aicen_init, index=n, & + call state_setexport(exportState, 'Si_ifrac_n', input=aicen_init, index=n, & ungridded_index=n, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! penetrative shortwave by category ! Note: no need zero out pass-through fields over land for benefit of x2oacc fields in cpl hist files since ! the export state has been zeroed out at the beginning - call state_setexport(exportState, 'mean_sw_pen_to_ocn_ifrac_n', input=fswthrun_ai, index=n, & + call state_setexport(exportState, 'Fioi_swpen_ifrac_n', input=fswthrun_ai, index=n, & lmask=tmask, ifrac=ailohi, ungridded_index=n, areacor=mod2med_areacor, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end do From 55342ca7cb4a1be511ade6249e349cb8a8095881 Mon Sep 17 00:00:00 2001 From: Dougie Squire <42455466+dougiesquire@users.noreply.github.com> Date: Tue, 26 Sep 2023 03:49:09 +1000 Subject: [PATCH 23/76] Fix mesh mask check in nuopc/cmeps cap (#873) --- cicecore/drivers/nuopc/cmeps/ice_mesh_mod.F90 | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/cicecore/drivers/nuopc/cmeps/ice_mesh_mod.F90 b/cicecore/drivers/nuopc/cmeps/ice_mesh_mod.F90 index 601e59c7c..9493add51 100644 --- a/cicecore/drivers/nuopc/cmeps/ice_mesh_mod.F90 +++ b/cicecore/drivers/nuopc/cmeps/ice_mesh_mod.F90 @@ -668,13 +668,13 @@ subroutine ice_mesh_check(gcomp, ice_mesh, rc) 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 - jlo = this_block%jlo - jhi = this_block%jhi do i = ilo, ihi - ilo = this_block%ilo - ihi = this_block%ihi - n = n+1 + n = n + 1 mask_internal = nint(hm(i,j,iblk),kind=dbl_kind) mask_file = model_mask(n) if (mask_internal /= mask_file) then From d466031001cf447bcd64220c842dcd2707f61e90 Mon Sep 17 00:00:00 2001 From: Tony Craig Date: Fri, 29 Sep 2023 12:08:53 -0700 Subject: [PATCH 24/76] 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 --- .../cicedyn/dynamics/ice_transport_remap.F90 | 15 ++++- cicecore/cicedyn/general/ice_init.F90 | 4 +- cicecore/cicedyn/infrastructure/ice_grid.F90 | 16 ++++++ .../scripts/options/set_nml.boxchan1e | 55 +++++++++++++++++++ .../scripts/options/set_nml.boxchan1n | 55 +++++++++++++++++++ configuration/scripts/tests/gridsys_suite.ts | 27 ++++++--- doc/source/cice_index.rst | 2 +- doc/source/user_guide/ug_case_settings.rst | 2 + doc/source/user_guide/ug_implementation.rst | 2 +- 9 files changed, 165 insertions(+), 13 deletions(-) create mode 100644 configuration/scripts/options/set_nml.boxchan1e create mode 100644 configuration/scripts/options/set_nml.boxchan1n diff --git a/cicecore/cicedyn/dynamics/ice_transport_remap.F90 b/cicecore/cicedyn/dynamics/ice_transport_remap.F90 index b397b94b7..5c33fea2b 100644 --- a/cicecore/cicedyn/dynamics/ice_transport_remap.F90 +++ b/cicecore/cicedyn/dynamics/ice_transport_remap.F90 @@ -1998,7 +1998,8 @@ subroutine locate_triangles (nx_block, ny_block, & endif !------------------------------------------------------------------- - ! Compute mask for edges with nonzero departure areas + ! Compute mask for edges with nonzero departure areas and for + ! one grid-cell wide channels !------------------------------------------------------------------- icellsd = 0 @@ -2011,6 +2012,12 @@ subroutine locate_triangles (nx_block, ny_block, & icellsd = icellsd + 1 indxid(icellsd) = i indxjd(icellsd) = j + else + if ( abs(edgearea(i,j)) > c0 ) then ! 1 grid-cell wide channel: dpx,y = 0, edgearea /= 0 + icellsd = icellsd + 1 + indxid(icellsd) = i + indxjd(icellsd) = j + endif endif enddo enddo @@ -2023,6 +2030,12 @@ subroutine locate_triangles (nx_block, ny_block, & icellsd = icellsd + 1 indxid(icellsd) = i indxjd(icellsd) = j + else + if ( abs(edgearea(i,j)) > c0 ) then ! 1 grid-cell wide channel: dpx,y = 0, edgearea /= 0 + icellsd = icellsd + 1 + indxid(icellsd) = i + indxjd(icellsd) = j + endif endif enddo enddo diff --git a/cicecore/cicedyn/general/ice_init.F90 b/cicecore/cicedyn/general/ice_init.F90 index 47fedf538..7435322bd 100644 --- a/cicecore/cicedyn/general/ice_init.F90 +++ b/cicecore/cicedyn/general/ice_init.F90 @@ -2446,6 +2446,8 @@ subroutine input_data if (kmt_type /= 'file' .and. & kmt_type /= 'channel' .and. & + kmt_type /= 'channel_oneeast' .and. & + kmt_type /= 'channel_onenorth' .and. & kmt_type /= 'wall' .and. & kmt_type /= 'default' .and. & kmt_type /= 'boxislands') then @@ -3135,7 +3137,7 @@ subroutine set_state_var (nx_block, ny_block, & enddo enddo - elseif (trim(ice_data_type) == 'channel') then + elseif (ice_data_type(1:7) == 'channel') then ! channel ice in center of domain in i direction icells = 0 do j = jlo, jhi diff --git a/cicecore/cicedyn/infrastructure/ice_grid.F90 b/cicecore/cicedyn/infrastructure/ice_grid.F90 index 160e3cc64..16dea4382 100644 --- a/cicecore/cicedyn/infrastructure/ice_grid.F90 +++ b/cicecore/cicedyn/infrastructure/ice_grid.F90 @@ -1489,6 +1489,22 @@ subroutine rectgrid enddo enddo + elseif (trim(kmt_type) == 'channel_oneeast') then + + do j = ny_global/2,ny_global/2 ! one channel wide + do i = 1,nx_global ! open sides + work_g1(i,j) = c1 ! NOTE nx_global > 5 + enddo + enddo + + elseif (trim(kmt_type) == 'channel_onenorth') then + + do j = 1,ny_global ! open sides + do i = nx_global/2,nx_global/2 ! one channel wide + work_g1(i,j) = c1 ! NOTE nx_global > 5 + enddo + enddo + elseif (trim(kmt_type) == 'wall') then do j = 1,ny_global ! open except diff --git a/configuration/scripts/options/set_nml.boxchan1e b/configuration/scripts/options/set_nml.boxchan1e new file mode 100644 index 000000000..9e21cdab7 --- /dev/null +++ b/configuration/scripts/options/set_nml.boxchan1e @@ -0,0 +1,55 @@ +days_per_year = 360 +use_leap_years = .false. +npt_unit = 'd' +npt = 5 +ice_ic = 'internal' +restart_ext = .true. +histfreq = 'd','1','x','x','x' +grid_type = 'rectangular' +kmt_type = 'channel_oneeast' +dxrect = 16.e5 +dyrect = 16.e5 +close_boundaries = .false. +ew_boundary_type = 'cyclic' +ns_boundary_type = 'open' +tr_iage = .false. +tr_FY = .false. +tr_lvl = .false. +tr_pond_lvl = .false. +ktherm = -1 +atmbndy = 'constant' +atm_data_type = 'uniform_east' +ocn_data_type = 'calm' +ice_data_type = 'block' +ice_data_conc = 'p5' +ice_data_dist = 'uniform' +calc_strair = .false. +rotate_wind = .false. +restore_ice = .false. +f_aice = 'd1' +f_hi = 'd1' +f_hs = 'd' +f_Tsfc = 'd' +f_uvel = 'd1' +f_vvel = 'd1' +f_uatm = 'd' +f_vatm = 'd' +f_uocn = 'd' +f_vocn = 'd' +f_strairx = 'd1' +f_strairy = 'd1' +f_strtltx = 'd1' +f_strtlty = 'd1' +f_strcorx = 'd1' +f_strcory = 'd1' +f_strocnx = 'd1' +f_strocny = 'd1' +f_strintx = 'd1' +f_strinty = 'd1' +f_taubx = 'd1' +f_tauby = 'd1' +f_divu = 'd1' +f_sig1 = 'd1' +f_sig2 = 'd1' +f_sigP = 'd1' +f_dvidtd = 'd1' diff --git a/configuration/scripts/options/set_nml.boxchan1n b/configuration/scripts/options/set_nml.boxchan1n new file mode 100644 index 000000000..f24fee5fa --- /dev/null +++ b/configuration/scripts/options/set_nml.boxchan1n @@ -0,0 +1,55 @@ +days_per_year = 360 +use_leap_years = .false. +npt_unit = 'd' +npt = 5 +ice_ic = 'internal' +restart_ext = .true. +histfreq = 'd','1','x','x','x' +grid_type = 'rectangular' +kmt_type = 'channel_onenorth' +dxrect = 16.e5 +dyrect = 16.e5 +close_boundaries = .false. +ew_boundary_type = 'open' +ns_boundary_type = 'cyclic' +tr_iage = .false. +tr_FY = .false. +tr_lvl = .false. +tr_pond_lvl = .false. +ktherm = -1 +atmbndy = 'constant' +atm_data_type = 'uniform_north' +ocn_data_type = 'calm' +ice_data_type = 'block' +ice_data_conc = 'p5' +ice_data_dist = 'uniform' +calc_strair = .false. +rotate_wind = .false. +restore_ice = .false. +f_aice = 'd1' +f_hi = 'd1' +f_hs = 'd' +f_Tsfc = 'd' +f_uvel = 'd1' +f_vvel = 'd1' +f_uatm = 'd' +f_vatm = 'd' +f_uocn = 'd' +f_vocn = 'd' +f_strairx = 'd1' +f_strairy = 'd1' +f_strtltx = 'd1' +f_strtlty = 'd1' +f_strcorx = 'd1' +f_strcory = 'd1' +f_strocnx = 'd1' +f_strocny = 'd1' +f_strintx = 'd1' +f_strinty = 'd1' +f_taubx = 'd1' +f_tauby = 'd1' +f_divu = 'd1' +f_sig1 = 'd1' +f_sig2 = 'd1' +f_sigP = 'd1' +f_dvidtd = 'd1' diff --git a/configuration/scripts/tests/gridsys_suite.ts b/configuration/scripts/tests/gridsys_suite.ts index faf01344a..c10465f4b 100644 --- a/configuration/scripts/tests/gridsys_suite.ts +++ b/configuration/scripts/tests/gridsys_suite.ts @@ -10,14 +10,17 @@ smoke gx3 8x2 diag1,run5day smoke gx3 8x4 diag1,run5day,debug restart gx3 4x2 debug,diag1 restart2 gx1 16x2 debug,diag1 +restart tx1 40x2 diag1 smoke gbox12 1x1x12x12x1 boxchan +smoke gbox80 4x2 boxchan1e +smoke gbox80 8x1 boxchan1n smoke gbox80 1x1 box2001 smoke gbox80 2x2 boxwallblock smoke gbox80 1x1 boxslotcyl smoke gbox80 2x4 boxnodyn -smoke gbox80 4x2 boxclosed,boxforcee,run1day -smoke gbox80 4x1 boxclosed,boxforcene,run1day,kmtislands -smoke gbox80 4x2 boxopen,kmtislands,boxforcee,run1day +smoke gbox80 4x2 boxclosed,boxforcee,run1day +smoke gbox80 4x1 boxclosed,boxforcene,run1day,kmtislands +smoke gbox80 4x2 boxopen,kmtislands,boxforcee,run1day smoke gbox80 2x2 boxclosed,boxforcen,run1day,vargrid smoke gx3 1x1x25x29x16 reprosum,run10day,dwblockall smoke_gx3_1x1x100x116x1_reprosum_run10day smoke gx3 1x1x5x4x580 reprosum,run10day,dwblockall smoke_gx3_1x1x100x116x1_reprosum_run10day @@ -30,14 +33,17 @@ smoke gx3 8x2 diag1,run5day,gridcd smoke gx3 8x4 diag1,run5day,debug,gridcd 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 8x1 boxchan1n,gridcd smoke gbox80 1x1 box2001,gridcd smoke gbox80 2x2 boxwallblock,gridcd smoke gbox80 1x1 boxslotcyl,gridcd smoke gbox80 2x4 boxnodyn,gridcd -smoke gbox80 4x2 boxclosed,boxforcee,run1day,gridcd -smoke gbox80 4x1 boxclosed,boxforcene,run1day,kmtislands,gridcd -smoke gbox80 4x2 boxopen,kmtislands,boxforcee,run1day,gridcd +smoke gbox80 4x2 boxclosed,boxforcee,run1day,gridcd +smoke gbox80 4x1 boxclosed,boxforcene,run1day,kmtislands,gridcd +smoke gbox80 4x2 boxopen,kmtislands,boxforcee,run1day,gridcd smoke gbox80 2x2 boxclosed,boxforcen,run1day,vargrid,gridcd smoke gx3 1x1x25x29x16 reprosum,run10day,dwblockall,gridcd smoke_gx3_1x1x100x116x1_gridcd_reprosum_run10day smoke gx3 1x1x5x4x580 reprosum,run10day,dwblockall,gridcd smoke_gx3_1x1x100x116x1_gridcd_reprosum_run10day @@ -50,14 +56,17 @@ smoke gx3 8x2 diag1,run5day,gridc smoke gx3 8x4 diag1,run5day,debug,gridc 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 8x1 boxchan1n,gridc smoke gbox80 1x1 box2001,gridc smoke gbox80 2x2 boxwallblock,gridc smoke gbox80 1x1 boxslotcyl,gridc smoke gbox80 2x4 boxnodyn,gridc -smoke gbox80 4x2 boxclosed,boxforcee,run1day,gridc -smoke gbox80 4x1 boxclosed,boxforcene,run1day,kmtislands,gridc -smoke gbox80 4x2 boxopen,kmtislands,boxforcee,run1day,gridc +smoke gbox80 4x2 boxclosed,boxforcee,run1day,gridc +smoke gbox80 4x1 boxclosed,boxforcene,run1day,kmtislands,gridc +smoke gbox80 4x2 boxopen,kmtislands,boxforcee,run1day,gridc smoke gbox80 2x2 boxclosed,boxforcen,run1day,vargrid,gridc smoke gx3 1x1x25x29x16 reprosum,run10day,dwblockall,gridc smoke_gx3_1x1x100x116x1_gridc_reprosum_run10day smoke gx3 1x1x5x4x580 reprosum,run10day,dwblockall,gridc smoke_gx3_1x1x100x116x1_gridc_reprosum_run10day diff --git a/doc/source/cice_index.rst b/doc/source/cice_index.rst index cf01323d8..d4e187510 100644 --- a/doc/source/cice_index.rst +++ b/doc/source/cice_index.rst @@ -384,7 +384,7 @@ either Celsius or Kelvin units). Deprecated parameters are listed at the end. "kice", "thermal conductivity of fresh ice (:cite:`Bitz99`)", "2.03 W/m/deg" "kitd", "type of itd conversions (0 = delta function, 1 = linear remap)", "1" "kmt_file", "input file for land mask info", "" - "kmt_type", "file, default or boxislands", "file" + "kmt_type", "file, default, channel, wall, or boxislands", "file" "krdg_partic", "ridging participation function", "1" "krdg_redist", "ridging redistribution function", "1" "krgdn", "mean ridge thickness per thickness of ridging ice", "" diff --git a/doc/source/user_guide/ug_case_settings.rst b/doc/source/user_guide/ug_case_settings.rst index ba596863c..2df45acb0 100644 --- a/doc/source/user_guide/ug_case_settings.rst +++ b/doc/source/user_guide/ug_case_settings.rst @@ -282,6 +282,8 @@ grid_nml "``kmt_file``", "string", "name of land mask file to be read", "``unknown_kmt_file``" "``kmt_type``", "boxislands", "ocean/land mask set internally, complex test geometory", "file" "", "channel", "ocean/land mask set internally as zonal channel", "" + "", "channel_oneeast", "ocean/land mask set internally as single gridcell east-west zonal channel", "" + "", "channel_onenorth", "ocean/land mask set internally as single gridcell north-south zonal channel", "" "", "default", "ocean/land mask set internally, land in upper left and lower right of domain, ", "" "", "file", "ocean/land mask setup read from file, see kmt_file", "" "", "wall", "ocean/land mask set at right edge of domain", "" diff --git a/doc/source/user_guide/ug_implementation.rst b/doc/source/user_guide/ug_implementation.rst index 8480eb9aa..b24d96909 100644 --- a/doc/source/user_guide/ug_implementation.rst +++ b/doc/source/user_guide/ug_implementation.rst @@ -379,7 +379,7 @@ Several predefined rectangular grids are available in CICE with where 12, 80, 128, and 180 are the number of gridcells in each direction. Several predefined options also exist, set with **cice.setup --set**, to establish varied idealized configurations of box tests including ``box2001``, -``boxadv``, ``boxchan``, ``boxnodyn``, ``boxrestore``, ``boxslotcyl``, and +``boxadv``, ``boxchan``, ``boxchan1e``, ``boxchan1n``, ``boxnodyn``, ``boxrestore``, ``boxslotcyl``, and ``boxopen``, ``boxclosed``, and ``boxforcee``. See **cice.setup --help** for a current list of supported settings. From deb247bcec381615d01006bfa15dddf3a4f068fd Mon Sep 17 00:00:00 2001 From: Tony Craig Date: Thu, 5 Oct 2023 12:50:32 -0700 Subject: [PATCH 25/76] 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 --- .gitmodules | 2 +- cice.setup | 2 +- .../cicedyn/dynamics/ice_transport_driver.F90 | 9 +- cicecore/cicedyn/general/ice_forcing_bgc.F90 | 215 +----------------- cicecore/cicedyn/general/ice_init.F90 | 76 ++++--- cicecore/cicedyn/general/ice_step_mod.F90 | 24 +- .../infrastructure/ice_restart_driver.F90 | 10 +- .../drivers/direct/hadgem3/CICE_InitMod.F90 | 13 +- .../direct/nemo_concepts/CICE_InitMod.F90 | 13 +- cicecore/drivers/mct/cesm1/CICE_InitMod.F90 | 12 +- .../drivers/mct/cesm1/ice_import_export.F90 | 6 +- .../drivers/mct/cesm1/ice_prescribed_mod.F90 | 3 +- cicecore/drivers/nuopc/cmeps/CICE_InitMod.F90 | 13 +- .../nuopc/cmeps/ice_prescribed_mod.F90 | 3 +- cicecore/drivers/nuopc/dmi/CICE_InitMod.F90 | 12 +- .../drivers/standalone/cice/CICE_InitMod.F90 | 12 +- .../unittest/gridavgchk/CICE_InitMod.F90 | 12 +- .../drivers/unittest/halochk/CICE_InitMod.F90 | 12 +- .../drivers/unittest/opticep/CICE_InitMod.F90 | 12 +- .../unittest/opticep/ice_init_column.F90 | 30 +-- .../drivers/unittest/opticep/ice_step_mod.F90 | 39 ++-- .../drivers/unittest/sumchk/CICE_InitMod.F90 | 12 +- cicecore/shared/ice_arrays_column.F90 | 33 +-- cicecore/shared/ice_init_column.F90 | 30 +-- configuration/scripts/cice.build | 3 + configuration/scripts/cice.settings | 1 + configuration/scripts/ice_in | 5 +- configuration/scripts/options/set_env.snicar | 1 + configuration/scripts/options/set_nml.alt01 | 2 +- configuration/scripts/options/set_nml.alt04 | 3 +- configuration/scripts/options/set_nml.alt06 | 2 +- configuration/scripts/options/set_nml.bgcskl | 2 + .../scripts/options/set_nml.bgcsklclim | 1 + configuration/scripts/options/set_nml.bgcz | 1 + .../scripts/options/set_nml.bgczclim | 1 + configuration/scripts/options/set_nml.bgczm | 1 + configuration/scripts/options/set_nml.boxadv | 2 +- .../scripts/options/set_nml.boxchan1e | 1 + .../scripts/options/set_nml.boxchan1n | 1 + .../scripts/options/set_nml.boxnodyn | 1 + configuration/scripts/options/set_nml.e3sm | 13 ++ configuration/scripts/options/set_nml.e3smbgc | 74 ++++++ configuration/scripts/options/set_nml.snicar | 3 + configuration/scripts/tests/e3sm_suite.ts | 6 + doc/source/cice_index.rst | 5 +- doc/source/user_guide/ug_case_settings.rst | 14 +- icepack | 2 +- 47 files changed, 305 insertions(+), 445 deletions(-) create mode 100644 configuration/scripts/options/set_env.snicar create mode 100644 configuration/scripts/options/set_nml.e3sm create mode 100644 configuration/scripts/options/set_nml.e3smbgc create mode 100644 configuration/scripts/options/set_nml.snicar create mode 100644 configuration/scripts/tests/e3sm_suite.ts diff --git a/.gitmodules b/.gitmodules index 22e452f35..f14869a27 100644 --- a/.gitmodules +++ b/.gitmodules @@ -1,3 +1,3 @@ [submodule "icepack"] path = icepack - url = https://github.com/cice-consortium/Icepack + url = https://github.com/cice-consortium/icepack diff --git a/cice.setup b/cice.setup index 30da0ed2e..4c7a222ff 100755 --- a/cice.setup +++ b/cice.setup @@ -1189,7 +1189,7 @@ source ./cice.settings set bldstat = 0 if (\${dobuild} == true) then if (\${doreuse} == true) then - set ciceexe = "../ciceexe.\${ICE_TARGET}.\${ICE_ENVNAME}.\${ICE_COMMDIR}.\${ICE_BLDDEBUG}.\${ICE_THREADED}.\${ICE_IOTYPE}" + set ciceexe = "../ciceexe.\${ICE_TARGET}.\${ICE_ENVNAME}.\${ICE_COMMDIR}.\${ICE_BLDDEBUG}.\${ICE_THREADED}.\${ICE_IOTYPE}.\${ICE_SNICARHC}" ./cice.build --exe \${ciceexe} set bldstat = \${status} if !(-e \${ciceexe}) cp -p \${ICE_RUNDIR}/cice \${ciceexe} diff --git a/cicecore/cicedyn/dynamics/ice_transport_driver.F90 b/cicecore/cicedyn/dynamics/ice_transport_driver.F90 index 8ff833086..fca964593 100644 --- a/cicecore/cicedyn/dynamics/ice_transport_driver.F90 +++ b/cicecore/cicedyn/dynamics/ice_transport_driver.F90 @@ -713,6 +713,7 @@ subroutine transport_upwind (dt) use ice_state, only: aice0, aicen, vicen, vsnon, trcrn, & uvel, vvel, trcr_depend, bound_state, trcr_base, & n_trcr_strata, nt_strata, uvelE, vvelN + use ice_flux, only: Tf use ice_grid, only: HTE, HTN, tarea, tmask, grid_ice use ice_timers, only: ice_timer_start, ice_timer_stop, & timer_bound, timer_advect @@ -838,7 +839,7 @@ subroutine transport_upwind (dt) ntrcr, narr, & trcr_depend(:), trcr_base(:,:), & n_trcr_strata(:), nt_strata(:,:), & - tmask(:,:, iblk), & + tmask(:,:, iblk), Tf (:,:,iblk), & aicen(:,:, :,iblk), trcrn (:,:,:,:,iblk), & vicen(:,:, :,iblk), vsnon (:,:, :,iblk), & aice0(:,:, iblk), works (:,:, :,iblk)) @@ -1643,7 +1644,7 @@ subroutine work_to_state (nx_block, ny_block, & trcr_base, & n_trcr_strata, & nt_strata, & - tmask, & + tmask, Tf, & aicen, trcrn, & vicen, vsnon, & aice0, works) @@ -1670,6 +1671,7 @@ subroutine work_to_state (nx_block, ny_block, & tmask (nx_block,ny_block) real (kind=dbl_kind), intent (in) :: & + Tf (nx_block,ny_block), & works (nx_block,ny_block,narr) real (kind=dbl_kind), dimension (nx_block,ny_block,ncat), intent(out) :: & @@ -1746,7 +1748,8 @@ subroutine work_to_state (nx_block, ny_block, & trcr_base = trcr_base(:,:), & n_trcr_strata = n_trcr_strata(:), & nt_strata = nt_strata(:,:), & - trcrn = trcrn(i,j,:,n)) + trcrn = trcrn(i,j,:,n), & + Tf = Tf(i,j)) ! tcraig, don't let land points get non-zero Tsfc if (.not.tmask(i,j)) then diff --git a/cicecore/cicedyn/general/ice_forcing_bgc.F90 b/cicecore/cicedyn/general/ice_forcing_bgc.F90 index 2f07d05f1..69c3ea311 100644 --- a/cicecore/cicedyn/general/ice_forcing_bgc.F90 +++ b/cicecore/cicedyn/general/ice_forcing_bgc.F90 @@ -17,13 +17,13 @@ module ice_forcing_bgc use ice_calendar, only: dt, istep, msec, mday, mmonth use ice_fileunits, only: nu_diag use ice_arrays_column, only: restore_bgc, & - bgc_data_dir, fe_data_type, optics_file, optics_file_fieldname + bgc_data_dir, fe_data_type use ice_constants, only: c0, p1 use ice_constants, only: field_loc_center, field_type_scalar use ice_exit, only: abort_ice use ice_forcing, only: bgc_data_type use icepack_intfc, only: icepack_warnings_flush, icepack_warnings_aborted - use icepack_intfc, only: icepack_nspint, icepack_max_aero, & + use icepack_intfc, only: icepack_nspint_3bd, icepack_max_aero, & icepack_max_algae, icepack_max_doc, icepack_max_dic use icepack_intfc, only: icepack_query_tracer_flags, & icepack_query_parameters, icepack_query_parameters, & @@ -32,8 +32,7 @@ module ice_forcing_bgc implicit none private public :: get_forcing_bgc, get_atm_bgc, fzaero_data, alloc_forcing_bgc, & - init_bgc_data, faero_data, faero_default, faero_optics, & - fiso_default + init_bgc_data, faero_data, faero_default, fiso_default integer (kind=int_kind) :: & bgcrecnum = 0 ! old record number (save between steps) @@ -840,214 +839,6 @@ subroutine init_bgc_data (fed1,fep1) end subroutine init_bgc_data -!======================================================================= -! -! Aerosol optical properties for bulk and modal aerosol formulation -! X_bc_tab properties are from snicar_optics_5bnd_mam_c140303 (Mark Flanner 2009) -! ==> "Mie optical parameters for CLM snowpack treatment" Includes -! ice (effective radii from 30-1500um), black carbon, organic carbon and dust -! -! authors: Elizabeth Hunke, LANL - - subroutine faero_optics - - use ice_broadcast, only: broadcast_array - use ice_read_write, only: ice_open_nc, ice_close_nc - use ice_communicate, only: my_task, master_task - use ice_arrays_column, only: & - kaer_tab, & ! aerosol mass extinction cross section (m2/kg) - waer_tab, & ! aerosol single scatter albedo (fraction) - gaer_tab, & ! aerosol asymmetry parameter (cos(theta)) - kaer_bc_tab, & ! BC mass extinction cross section (m2/kg) - waer_bc_tab, & ! BC single scatter albedo (fraction) - gaer_bc_tab, & ! BC aerosol asymmetry parameter (cos(theta)) - bcenh ! BC absorption enhancement factor - -#ifdef USE_NETCDF - use netcdf -#endif - - ! local parameters - - logical (kind=log_kind) :: modal_aero - - integer (kind=int_kind) :: & - varid , & ! variable id - status , & ! status output from netcdf routines - n, k ! index - - real (kind=dbl_kind) :: & - amin, amax, asum ! min, max values and sum of input array - - integer (kind=int_kind) :: & - fid ! file id for netCDF file - - character (char_len_long) :: & - fieldname ! field name in netcdf file - - character(len=*), parameter :: subname = '(faero_optics)' - - ! this data is used in bulk aerosol treatment in dEdd radiation - kaer_tab = reshape((/ & ! aerosol mass extinction cross section (m2/kg) -! 11580.61872, 5535.41835, 2793.79690, & -! 25798.96479, 11536.03871, 4688.24207, & -! 196.49772, 204.14078, 214.42287, & -! 2665.85867, 2256.71027, 820.36024, & -! 840.78295, 1028.24656, 1163.03298, & -! 387.51211, 414.68808, 450.29814/), & - 11580.61872_dbl_kind, 5535.41835_dbl_kind, 2793.79690_dbl_kind, & - 25798.96479_dbl_kind, 11536.03871_dbl_kind, 4688.24207_dbl_kind, & - 196.49772_dbl_kind, 204.14078_dbl_kind, 214.42287_dbl_kind, & - 2665.85867_dbl_kind, 2256.71027_dbl_kind, 820.36024_dbl_kind, & - 840.78295_dbl_kind, 1028.24656_dbl_kind, 1163.03298_dbl_kind, & - 387.51211_dbl_kind, 414.68808_dbl_kind, 450.29814_dbl_kind/), & - (/icepack_nspint,icepack_max_aero/)) - waer_tab = reshape((/ & ! aerosol single scatter albedo (fraction) -! 0.29003, 0.17349, 0.06613, & -! 0.51731, 0.41609, 0.21324, & -! 0.84467, 0.94216, 0.95666, & -! 0.97764, 0.99402, 0.98552, & -! 0.94146, 0.98527, 0.99093, & -! 0.90034, 0.96543, 0.97678/), & - 0.29003_dbl_kind, 0.17349_dbl_kind, 0.06613_dbl_kind, & - 0.51731_dbl_kind, 0.41609_dbl_kind, 0.21324_dbl_kind, & - 0.84467_dbl_kind, 0.94216_dbl_kind, 0.95666_dbl_kind, & - 0.97764_dbl_kind, 0.99402_dbl_kind, 0.98552_dbl_kind, & - 0.94146_dbl_kind, 0.98527_dbl_kind, 0.99093_dbl_kind, & - 0.90034_dbl_kind, 0.96543_dbl_kind, 0.97678_dbl_kind/), & - (/icepack_nspint,icepack_max_aero/)) - gaer_tab = reshape((/ & ! aerosol asymmetry parameter (cos(theta)) -! 0.35445, 0.19838, 0.08857, & -! 0.52581, 0.32384, 0.14970, & -! 0.83162, 0.78306, 0.74375, & -! 0.68861, 0.70836, 0.54171, & -! 0.70239, 0.66115, 0.71983, & -! 0.78734, 0.73580, 0.64411/), & - 0.35445_dbl_kind, 0.19838_dbl_kind, 0.08857_dbl_kind, & - 0.52581_dbl_kind, 0.32384_dbl_kind, 0.14970_dbl_kind, & - 0.83162_dbl_kind, 0.78306_dbl_kind, 0.74375_dbl_kind, & - 0.68861_dbl_kind, 0.70836_dbl_kind, 0.54171_dbl_kind, & - 0.70239_dbl_kind, 0.66115_dbl_kind, 0.71983_dbl_kind, & - 0.78734_dbl_kind, 0.73580_dbl_kind, 0.64411_dbl_kind/), & - (/icepack_nspint,icepack_max_aero/)) - - ! this data is used in MODAL AEROSOL treatment in dEdd radiation - kaer_bc_tab = reshape((/ & ! aerosol mass extinction cross section (m2/kg) -! 12955.44732, 5946.89461, 2772.33366, & -! 12085.30664, 7438.83131, 3657.13084, & -! 9753.99698, 7342.87139, 4187.79304, & -! 7815.74879, 6659.65096, 4337.98863, & -! 6381.28194, 5876.78408, 4254.65054, & -! 5326.93163, 5156.74532, 4053.66581, & -! 4538.09763, 4538.60875, 3804.10884, & -! 3934.17604, 4020.20799, 3543.27199, & -! 3461.20656, 3587.80962, 3289.98060, & -! 3083.03396, 3226.27231, 3052.91441/), & - 12955.4473151973_dbl_kind, 5946.89461205564_dbl_kind, 2772.33366387720_dbl_kind, & - 12085.3066388712_dbl_kind, 7438.83131367992_dbl_kind, 3657.13084442081_dbl_kind, & - 9753.99697536893_dbl_kind, 7342.87139082553_dbl_kind, 4187.79303607928_dbl_kind, & - 7815.74879345131_dbl_kind, 6659.65096365965_dbl_kind, 4337.98863414228_dbl_kind, & - 6381.28194381772_dbl_kind, 5876.78408231865_dbl_kind, 4254.65053724305_dbl_kind, & - 5326.93163497508_dbl_kind, 5156.74531505734_dbl_kind, 4053.66581550147_dbl_kind, & - 4538.09762614960_dbl_kind, 4538.60874501597_dbl_kind, 3804.10884202567_dbl_kind, & - 3934.17604000777_dbl_kind, 4020.20798667897_dbl_kind, 3543.27199302277_dbl_kind, & - 3461.20655708248_dbl_kind, 3587.80961820605_dbl_kind, 3289.98060303894_dbl_kind, & - 3083.03396032095_dbl_kind, 3226.27231329114_dbl_kind, 3052.91440681137_dbl_kind/), & - (/icepack_nspint,10/)) - - waer_bc_tab = reshape((/ & ! aerosol single scatter albedo (fraction) -! 0.26107, 0.15861, 0.06535, & -! 0.37559, 0.30318, 0.19483, & -! 0.42224, 0.36913, 0.27875, & -! 0.44777, 0.40503, 0.33026, & -! 0.46444, 0.42744, 0.36426, & -! 0.47667, 0.44285, 0.38827, & -! 0.48635, 0.45428, 0.40617, & -! 0.49440, 0.46328, 0.42008, & -! 0.50131, 0.47070, 0.43128, & -! 0.50736, 0.47704, 0.44056/), & - 0.261071919959011_dbl_kind, 0.158608047940651_dbl_kind, 0.0653546447770291_dbl_kind, & - 0.375593873543050_dbl_kind, 0.303181671502553_dbl_kind, 0.194832290545495_dbl_kind, & - 0.422240383488477_dbl_kind, 0.369134186611324_dbl_kind, 0.278752556671685_dbl_kind, & - 0.447772153910671_dbl_kind, 0.405033725319593_dbl_kind, 0.330260831965086_dbl_kind, & - 0.464443094570456_dbl_kind, 0.427439117980081_dbl_kind, 0.364256689383418_dbl_kind, & - 0.476668995985241_dbl_kind, 0.442854173154887_dbl_kind, 0.388270470928338_dbl_kind, & - 0.486347881475941_dbl_kind, 0.454284736567521_dbl_kind, 0.406167596922937_dbl_kind, & - 0.494397834153785_dbl_kind, 0.463279526357470_dbl_kind, 0.420084410794128_dbl_kind, & - 0.501307856563459_dbl_kind, 0.470696914968199_dbl_kind, 0.431284889617716_dbl_kind, & - 0.507362336297419_dbl_kind, 0.477038272961243_dbl_kind, 0.440559363958571_dbl_kind/), & - (/icepack_nspint,10/)) - - gaer_bc_tab = reshape((/ & ! aerosol asymmetry parameter (cos(theta)) -! 0.28328, 0.19644, 0.10498, & -! 0.44488, 0.32615, 0.19612, & -! 0.54724, 0.41611, 0.26390, & -! 0.61711, 0.48475, 0.31922, & -! 0.66673, 0.53923, 0.36632, & -! 0.70296, 0.58337, 0.40732, & -! 0.73002, 0.61960, 0.44344, & -! 0.75064, 0.64959, 0.47551, & -! 0.76663, 0.67461, 0.50415, & -! 0.77926, 0.69561, 0.52981/),& - 0.283282988564031_dbl_kind, 0.196444209821980_dbl_kind, 0.104976473902976_dbl_kind, & - 0.444877326083453_dbl_kind, 0.326147707342261_dbl_kind, 0.196121968923488_dbl_kind, & - 0.547243414035631_dbl_kind, 0.416106187964493_dbl_kind, 0.263903486903711_dbl_kind, & - 0.617111563012282_dbl_kind, 0.484745531707601_dbl_kind, 0.319218974395050_dbl_kind, & - 0.666728525631754_dbl_kind, 0.539228555802301_dbl_kind, 0.366323180358996_dbl_kind, & - 0.702956870835387_dbl_kind, 0.583372441336763_dbl_kind, 0.407316408184865_dbl_kind, & - 0.730016668453191_dbl_kind, 0.619595539349710_dbl_kind, 0.443436944107423_dbl_kind, & - 0.750635997128011_dbl_kind, 0.649589805870541_dbl_kind, 0.475512089138887_dbl_kind, & - 0.766634959089444_dbl_kind, 0.674609076223658_dbl_kind, 0.504145461809103_dbl_kind, & - 0.779256641759228_dbl_kind, 0.695614224933709_dbl_kind, 0.529805346632687_dbl_kind/), & - (/icepack_nspint,10/)) - - bcenh(:,:,:) = c0 - - call icepack_query_parameters(modal_aero_out=modal_aero) - call icepack_warnings_flush(nu_diag) - if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & - file=__FILE__, line=__LINE__) - - if (modal_aero) then -#ifdef USE_NETCDF - if (my_task == master_task) then - write (nu_diag,*) ' ' - write (nu_diag,*) 'Read optics for modal aerosol treament in' - write (nu_diag,*) trim(optics_file) - write (nu_diag,*) 'Read optics file field name = ',trim(optics_file_fieldname) - call ice_open_nc(optics_file,fid) - - fieldname=optics_file_fieldname - - status = nf90_inq_varid(fid, trim(fieldname), varid) - - if (status /= nf90_noerr) then - call abort_ice (subname//'ERROR: Cannot find variable '//trim(fieldname)) - endif - status = nf90_get_var( fid, varid, bcenh, & - start=(/1,1,1,1/), & - count=(/3,10,8,1/) ) - do n=1,10 - amin = minval(bcenh(:,n,:)) - amax = maxval(bcenh(:,n,:)) - asum = sum (bcenh(:,n,:)) - write(nu_diag,*) ' min, max, sum =', amin, amax, asum - enddo - call ice_close_nc(fid) - endif !master_task - do n=1,3 - do k=1,8 - call broadcast_array(bcenh(n,:,k), master_task) - enddo - enddo -#else - call abort_ice(subname//'ERROR: USE_NETCDF cpp not defined', & - file=__FILE__, line=__LINE__) -#endif - endif ! modal_aero - - end subroutine faero_optics - !======================================================================= end module ice_forcing_bgc diff --git a/cicecore/cicedyn/general/ice_init.F90 b/cicecore/cicedyn/general/ice_init.F90 index 7435322bd..ff952629e 100644 --- a/cicecore/cicedyn/general/ice_init.F90 +++ b/cicecore/cicedyn/general/ice_init.F90 @@ -14,7 +14,7 @@ module ice_init use ice_kinds_mod use ice_communicate, only: my_task, master_task, ice_barrier - use ice_constants, only: c0, c1, c2, c3, c5, c12, p2, p3, p5, p75, p166, & + use ice_constants, only: c0, c1, c2, c3, c5, c12, p01, p2, p3, p5, p75, p166, & cm_to_m use ice_exit, only: abort_ice use ice_fileunits, only: nu_nml, nu_diag, nml_filename, diag_type, & @@ -141,12 +141,12 @@ subroutine input_data #endif real (kind=dbl_kind) :: ustar_min, albicev, albicei, albsnowv, albsnowi, & - ahmax, R_ice, R_pnd, R_snw, dT_mlt, rsnw_mlt, emissivity, & + ahmax, R_ice, R_pnd, R_snw, dT_mlt, rsnw_mlt, emissivity, hi_min, & mu_rdg, hs0, dpscale, rfracmin, rfracmax, pndaspect, hs1, hp1, & a_rapid_mode, Rac_rapid_mode, aspect_rapid_mode, dSdt_slow_mode, & phi_c_slow_mode, phi_i_mushy, kalg, atmiter_conv, Pstar, Cstar, & sw_frac, sw_dtemp, floediam, hfrazilmin, iceruf, iceruf_ocn, & - rsnw_fall, rsnw_tmax, rhosnew, rhosmin, rhosmax, & + rsnw_fall, rsnw_tmax, rhosnew, rhosmin, rhosmax, Tliquidus_max, & windmin, drhosdwind, snwlvlfac integer (kind=int_kind) :: ktherm, kstrength, krdg_partic, krdg_redist, natmiter, & @@ -154,7 +154,7 @@ subroutine input_data character (len=char_len) :: shortwave, albedo_type, conduct, fbot_xfer_type, & tfrz_option, saltflux_option, frzpnd, atmbndy, wave_spec_type, snwredist, snw_aging_table, & - capping_method + capping_method, snw_ssp_table logical (kind=log_kind) :: calc_Tsfc, formdrag, highfreq, calc_strair, wave_spec, & sw_redist, calc_dragio, use_smliq_pnd, snwgrain @@ -165,7 +165,7 @@ subroutine input_data integer (kind=int_kind) :: numin, numax ! unit number limits integer (kind=int_kind) :: rplvl, rptopo - real (kind=dbl_kind) :: Cf, ksno, puny, ice_ref_salinity + real (kind=dbl_kind) :: Cf, ksno, puny, ice_ref_salinity, Tocnfrz character (len=char_len) :: abort_list character (len=char_len) :: nml_name ! namelist name @@ -222,7 +222,7 @@ subroutine input_data kitd, ktherm, conduct, ksno, & a_rapid_mode, Rac_rapid_mode, aspect_rapid_mode, & dSdt_slow_mode, phi_c_slow_mode, phi_i_mushy, & - floediam, hfrazilmin + floediam, hfrazilmin, Tliquidus_max, hi_min namelist /dynamics_nml/ & kdyn, ndte, revised_evp, yield_curve, & @@ -242,7 +242,7 @@ subroutine input_data Cf, Pstar, Cstar, Ktens namelist /shortwave_nml/ & - shortwave, albedo_type, & + shortwave, albedo_type, snw_ssp_table, & albicev, albicei, albsnowv, albsnowi, & ahmax, R_ice, R_pnd, R_snw, & sw_redist, sw_frac, sw_dtemp, & @@ -281,7 +281,7 @@ subroutine input_data abort_list = "" - call icepack_query_parameters(puny_out=puny) + call icepack_query_parameters(puny_out=puny,Tocnfrz_out=Tocnfrz) ! nu_diag not yet defined ! call icepack_warnings_flush(nu_diag) ! if (icepack_warnings_aborted()) call abort_ice(error_message=subname//'Icepack Abort0', & @@ -434,6 +434,7 @@ subroutine input_data advection = 'remap' ! incremental remapping transport scheme conserv_check = .false. ! tracer conservation check shortwave = 'ccsm3' ! 'ccsm3' or 'dEdd' (delta-Eddington) + snw_ssp_table = 'test' ! 'test' or 'snicar' dEdd_snicar_ad table data albedo_type = 'ccsm3' ! 'ccsm3' or 'constant' ktherm = 1 ! -1 = OFF, 1 = BL99, 2 = mushy thermo conduct = 'bubbly' ! 'MU71' or 'bubbly' (Pringle et al 2007) @@ -444,6 +445,7 @@ subroutine input_data calc_Tsfc = .true. ! calculate surface temperature update_ocn_f = .false. ! include fresh water and salt fluxes for frazil ustar_min = 0.005 ! minimum friction velocity for ocean heat flux (m/s) + hi_min = p01 ! minimum ice thickness allowed (m) iceruf = 0.0005_dbl_kind ! ice surface roughness at atmosphere interface (m) iceruf_ocn = 0.03_dbl_kind ! under-ice roughness (m) calc_dragio = .false. ! compute dragio from iceruf_ocn and thickness of first ocean level @@ -577,6 +579,7 @@ subroutine input_data dSdt_slow_mode = -1.5e-7_dbl_kind ! slow mode drainage strength (m s-1 K-1) phi_c_slow_mode = 0.05_dbl_kind ! critical liquid fraction porosity cutoff phi_i_mushy = 0.85_dbl_kind ! liquid fraction of congelation ice + Tliquidus_max = 0.00_dbl_kind ! maximum liquidus temperature of mush (C) floediam = 300.0_dbl_kind ! min thickness of new frazil ice (m) hfrazilmin = 0.05_dbl_kind ! effective floe diameter (m) @@ -987,6 +990,7 @@ subroutine input_data call broadcast_scalar(advection, master_task) call broadcast_scalar(conserv_check, master_task) call broadcast_scalar(shortwave, master_task) + call broadcast_scalar(snw_ssp_table, master_task) call broadcast_scalar(albedo_type, master_task) call broadcast_scalar(ktherm, master_task) call broadcast_scalar(coriolis, master_task) @@ -1069,6 +1073,7 @@ subroutine input_data call broadcast_scalar(update_ocn_f, master_task) call broadcast_scalar(l_mpond_fresh, master_task) call broadcast_scalar(ustar_min, master_task) + call broadcast_scalar(hi_min, master_task) call broadcast_scalar(iceruf, master_task) call broadcast_scalar(iceruf_ocn, master_task) call broadcast_scalar(calc_dragio, master_task) @@ -1143,6 +1148,7 @@ subroutine input_data call broadcast_scalar(dSdt_slow_mode, master_task) call broadcast_scalar(phi_c_slow_mode, master_task) call broadcast_scalar(phi_i_mushy, master_task) + call broadcast_scalar(Tliquidus_max, master_task) call broadcast_scalar(sw_redist, master_task) call broadcast_scalar(sw_frac, master_task) call broadcast_scalar(sw_dtemp, master_task) @@ -1269,7 +1275,7 @@ subroutine input_data write(nu_diag,*) subname//' ERROR: invalid seabed stress method' write(nu_diag,*) subname//' ERROR: seabed_stress_method should be LKD or probabilistic' endif - abort_list = trim(abort_list)//":34" + abort_list = trim(abort_list)//":48" endif endif @@ -1350,10 +1356,10 @@ subroutine input_data abort_list = trim(abort_list)//":7" endif - if (trim(shortwave) /= 'dEdd' .and. tr_pond .and. calc_tsfc) then + if (shortwave(1:4) /= 'dEdd' .and. tr_pond .and. calc_tsfc) then if (my_task == master_task) then write(nu_diag,*) subname//' ERROR: tr_pond=T, calc_tsfc=T, invalid shortwave' - write(nu_diag,*) subname//' ERROR: Must use shortwave=dEdd' + write(nu_diag,*) subname//' ERROR: Must use shortwave=dEdd or dEdd_snicar_ad' endif abort_list = trim(abort_list)//":8" endif @@ -1466,19 +1472,20 @@ subroutine input_data abort_list = trim(abort_list)//":36" endif - if (trim(shortwave) /= 'dEdd' .and. tr_aero) then + if (shortwave(1:4) /= 'dEdd' .and. tr_aero) then if (my_task == master_task) then write(nu_diag,*) subname//' ERROR: tr_aero=T, invalid shortwave' - write(nu_diag,*) subname//' ERROR: Must use shortwave=dEdd' + write(nu_diag,*) subname//' ERROR: Must use shortwave=dEdd or dEdd_snicar_ad' endif abort_list = trim(abort_list)//":10" endif - if (trim(shortwave) /= 'dEdd' .and. snwgrain) then + if (shortwave(1:4) /= 'dEdd' .and. snwgrain) then if (my_task == master_task) then - write (nu_diag,*) 'WARNING: snow grain radius activated but' - write (nu_diag,*) 'WARNING: dEdd shortwave is not.' + 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" endif if ((rfracmin < -puny .or. rfracmin > c1+puny) .or. & @@ -1505,13 +1512,13 @@ subroutine input_data ! tcraig, is it really OK for users to run inconsistently? ! ech: yes, for testing sensitivities. It's not recommended for science runs - if (ktherm == 1 .and. trim(tfrz_option) /= 'linear_salt') then + if (ktherm == 1 .and. trim(tfrz_option(1:11)) /= 'linear_salt') then if (my_task == master_task) then write(nu_diag,*) subname//' WARNING: ktherm = 1 and tfrz_option = ',trim(tfrz_option) write(nu_diag,*) subname//' WARNING: For consistency, set tfrz_option = linear_salt' endif endif - if (ktherm == 2 .and. trim(tfrz_option) /= 'mushy') then + if (ktherm == 2 .and. trim(tfrz_option(1:5)) /= 'mushy') then if (my_task == master_task) then write(nu_diag,*) subname//' WARNING: ktherm = 2 and tfrz_option = ',trim(tfrz_option) write(nu_diag,*) subname//' WARNING: For consistency, set tfrz_option = mushy' @@ -1764,7 +1771,7 @@ subroutine input_data write(nu_diag,1020) ' nilyr = ', nilyr, ' : number of ice layers (equal thickness)' write(nu_diag,1020) ' nslyr = ', nslyr, ' : number of snow layers (equal thickness)' write(nu_diag,1020) ' nblyr = ', nblyr, ' : number of bio layers (equal thickness)' - if (trim(shortwave) == 'dEdd') & + if (shortwave(1:4) == 'dEdd') & write(nu_diag,*) 'dEdd interior and sfc scattering layers are used in both ice, snow (unequal)' write(nu_diag,1020) ' ncat = ', ncat, ' : number of ice categories' if (kcatbound == 0) then @@ -2000,6 +2007,7 @@ subroutine input_data write(nu_diag,1009) ' dSdt_slow_mode = ', dSdt_slow_mode,' : drainage strength parameter' write(nu_diag,1002) ' phi_c_slow_mode = ', phi_c_slow_mode,' : critical liquid fraction' write(nu_diag,1002) ' phi_i_mushy = ', phi_i_mushy,' : solid fraction at lower boundary' + write(nu_diag,1002) ' Tliquidus_max = ', Tliquidus_max,' : max mush liquidus temperature' endif write(nu_diag,1002) ' hfrazilmin = ', hfrazilmin,' : minimum new frazil ice thickness' @@ -2008,19 +2016,24 @@ subroutine input_data write(nu_diag,*) '--------------------------------' if (trim(shortwave) == 'dEdd') then tmpstr2 = ' : delta-Eddington multiple-scattering method' + elseif (trim(shortwave) == 'dEdd_snicar_ad') then + tmpstr2 = ' : delta-Eddington multiple-scattering method with SNICAR AD' elseif (trim(shortwave) == 'ccsm3') then tmpstr2 = ' : NCAR CCSM3 distribution method' else tmpstr2 = ' : unknown value' endif write(nu_diag,1030) ' shortwave = ', trim(shortwave),trim(tmpstr2) - if (trim(shortwave) == 'dEdd') then + if (shortwave(1:4) == 'dEdd') then write(nu_diag,1002) ' R_ice = ', R_ice,' : tuning parameter for sea ice albedo' write(nu_diag,1002) ' R_pnd = ', R_pnd,' : tuning parameter for ponded sea ice albedo' write(nu_diag,1002) ' R_snw = ', R_snw,' : tuning parameter for snow broadband albedo' write(nu_diag,1002) ' dT_mlt = ', dT_mlt,' : change in temperature per change in snow grain radius' write(nu_diag,1002) ' rsnw_mlt = ', rsnw_mlt,' : maximum melting snow grain radius' write(nu_diag,1002) ' kalg = ', kalg,' : absorption coefficient for algae' + if (trim(shortwave) == 'dEdd_snicar_ad') then + write(nu_diag,1030) ' snw_ssp_table = ', trim(snw_ssp_table) + endif else if (trim(albedo_type) == 'ccsm3') then tmpstr2 = ' : NCAR CCSM3 albedos' @@ -2091,16 +2104,21 @@ subroutine input_data if (trim(saltflux_option) == 'constant') then write(nu_diag,1002) ' ice_ref_salinity = ',ice_ref_salinity endif - if (trim(tfrz_option) == 'minus1p8') then - tmpstr2 = ' : constant ocean freezing temperature (-1.8C)' - elseif (trim(tfrz_option) == 'linear_salt') then + if (trim(tfrz_option(1:8)) == 'constant') then + tmpstr2 = ' : constant ocean freezing temperature (Tocnfrz)' + elseif (trim(tfrz_option(1:8)) == 'minus1p8') then + tmpstr2 = ' : constant ocean freezing temperature (-1.8C) (to be deprecated)' + elseif (trim(tfrz_option(1:11)) == 'linear_salt') then tmpstr2 = ' : linear function of salinity (use with ktherm=1)' - elseif (trim(tfrz_option) == 'mushy') then + elseif (trim(tfrz_option(1:5)) == 'mushy') then tmpstr2 = ' : Assur (1958) as in mushy-layer thermo (ktherm=2)' else tmpstr2 = ' : unknown value' endif write(nu_diag,1030) ' tfrz_option = ', trim(tfrz_option),trim(tmpstr2) + if (trim(tfrz_option(1:8)) == 'constant') then + write(nu_diag,1002) ' Tocnfrz = ', Tocnfrz + endif if (update_ocn_f) then tmpstr2 = ' : frazil water/salt fluxes included in ocean fluxes' else @@ -2122,6 +2140,7 @@ subroutine input_data endif write(nu_diag,1030) ' fbot_xfer_type = ', trim(fbot_xfer_type),trim(tmpstr2) write(nu_diag,1000) ' ustar_min = ', ustar_min,' : minimum value of ocean friction velocity' + write(nu_diag,1000) ' hi_min = ', hi_min,' : minimum ice thickness allowed (m)' if (calc_dragio) then tmpstr2 = ' : dragio computed from iceruf_ocn' else @@ -2191,7 +2210,7 @@ subroutine input_data write(nu_diag,*) 'Using default dEdd melt pond scheme for testing only' endif - if (trim(shortwave) == 'dEdd') then + if (shortwave(1:4) == 'dEdd') then write(nu_diag,1002) ' hs0 = ', hs0,' : snow depth of transition to bare sea ice' endif @@ -2481,7 +2500,7 @@ subroutine input_data call icepack_init_parameters(ustar_min_in=ustar_min, albicev_in=albicev, albicei_in=albicei, & albsnowv_in=albsnowv, albsnowi_in=albsnowi, natmiter_in=natmiter, atmiter_conv_in=atmiter_conv, & - emissivity_in=emissivity, & + emissivity_in=emissivity, snw_ssp_table_in=snw_ssp_table, hi_min_in=hi_min, & ahmax_in=ahmax, shortwave_in=shortwave, albedo_type_in=albedo_type, R_ice_in=R_ice, R_pnd_in=R_pnd, & R_snw_in=R_snw, dT_mlt_in=dT_mlt, rsnw_mlt_in=rsnw_mlt, & kstrength_in=kstrength, krdg_partic_in=krdg_partic, krdg_redist_in=krdg_redist, mu_rdg_in=mu_rdg, & @@ -2490,7 +2509,7 @@ subroutine input_data rfracmin_in=rfracmin, rfracmax_in=rfracmax, pndaspect_in=pndaspect, hs1_in=hs1, hp1_in=hp1, & ktherm_in=ktherm, calc_Tsfc_in=calc_Tsfc, conduct_in=conduct, & a_rapid_mode_in=a_rapid_mode, Rac_rapid_mode_in=Rac_rapid_mode, & - floediam_in=floediam, hfrazilmin_in=hfrazilmin, & + floediam_in=floediam, hfrazilmin_in=hfrazilmin, Tliquidus_max_in=Tliquidus_max, & aspect_rapid_mode_in=aspect_rapid_mode, dSdt_slow_mode_in=dSdt_slow_mode, & phi_c_slow_mode_in=phi_c_slow_mode, phi_i_mushy_in=phi_i_mushy, conserv_check_in=conserv_check, & wave_spec_type_in = wave_spec_type, & @@ -2805,7 +2824,8 @@ subroutine init_state trcr_depend = trcr_depend(:), & trcr_base = trcr_base(:,:), & n_trcr_strata = n_trcr_strata(:), & - nt_strata = nt_strata(:,:)) + nt_strata = nt_strata(:,:), & + Tf = Tf(i,j,iblk)) aice_init(i,j,iblk) = aice(i,j,iblk) diff --git a/cicecore/cicedyn/general/ice_step_mod.F90 b/cicecore/cicedyn/general/ice_step_mod.F90 index 89dba3d12..552cde044 100644 --- a/cicecore/cicedyn/general/ice_step_mod.F90 +++ b/cicecore/cicedyn/general/ice_step_mod.F90 @@ -182,8 +182,7 @@ subroutine prep_radiation (iblk) alidr_init(i,j,iblk) = alidr_ai(i,j,iblk) alidf_init(i,j,iblk) = alidf_ai(i,j,iblk) - call icepack_prep_radiation (ncat=ncat, nilyr=nilyr, nslyr=nslyr, & - scale_factor=scale_factor(i,j,iblk), & + call icepack_prep_radiation (scale_factor=scale_factor(i,j,iblk), & aice = aice (i,j, iblk), aicen = aicen (i,j, :,iblk), & swvdr = swvdr (i,j, iblk), swvdf = swvdf (i,j, iblk), & swidr = swidr (i,j, iblk), swidf = swidf (i,j, iblk), & @@ -759,6 +758,7 @@ subroutine update_state (dt, daidt, dvidt, dagedt, offset) use ice_state, only: aicen, trcrn, vicen, vsnon, & aice, trcr, vice, vsno, aice0, trcr_depend, & bound_state, trcr_base, nt_strata, n_trcr_strata + use ice_flux, only: Tf use ice_timers, only: ice_timer_start, ice_timer_stop, timer_bound, timer_updstate real (kind=dbl_kind), intent(in) :: & @@ -825,7 +825,8 @@ subroutine update_state (dt, daidt, dvidt, dagedt, offset) trcr_depend = trcr_depend(:), & trcr_base = trcr_base(:,:), & n_trcr_strata = n_trcr_strata(:), & - nt_strata = nt_strata(:,:)) + nt_strata = nt_strata(:,:), & + Tf = Tf(i,j,iblk)) if (present(offset)) then @@ -1042,7 +1043,7 @@ subroutine step_dyn_ridge (dt, ndtd, iblk) rdg_conv, rdg_shear, dardg1dt, dardg2dt, & dvirdgdt, opening, fpond, fresh, fhocn, & aparticn, krdgn, aredistn, vredistn, dardg1ndt, dardg2ndt, & - dvirdgndt, araftn, vraftn, fsalt + dvirdgndt, araftn, vraftn, fsalt, Tf use ice_flux_bgc, only: flux_bio, faero_ocn, fiso_ocn use ice_grid, only: tmask use ice_state, only: trcrn, vsnon, aicen, vicen, & @@ -1133,7 +1134,8 @@ subroutine step_dyn_ridge (dt, ndtd, iblk) aice = aice (i,j, iblk), & fsalt = fsalt (i,j, iblk), & first_ice = first_ice(i,j,:,iblk), & - flux_bio = flux_bio (i,j,1:nbtrcr,iblk)) + flux_bio = flux_bio (i,j,1:nbtrcr,iblk), & + Tf = Tf(i,j,iblk)) endif ! tmask @@ -1272,8 +1274,7 @@ subroutine step_radiation (dt, iblk) fswthrun, fswthrun_vdr, fswthrun_vdf, fswthrun_idr, fswthrun_idf, & albicen, albsnon, albpndn, & alvdrn, alidrn, alvdfn, alidfn, apeffn, trcrn_sw, snowfracn, & - kaer_tab, waer_tab, gaer_tab, kaer_bc_tab, waer_bc_tab, & - gaer_bc_tab, bcenh, swgrid, igrid + swgrid, igrid use ice_calendar, only: calendar_type, days_per_year, nextsw_cday, yday, msec use ice_domain_size, only: ncat, n_aero, nilyr, nslyr, n_zaero, n_algae, nblyr use ice_flux, only: swvdr, swvdf, swidr, swidf, coszen, fsnow @@ -1380,9 +1381,7 @@ subroutine step_radiation (dt, iblk) if (tmask(i,j,iblk)) then - call icepack_step_radiation (dt=dt, ncat=ncat, & - nblyr=nblyr, nilyr=nilyr, nslyr=nslyr, & - dEdd_algae=dEdd_algae, & + call icepack_step_radiation (dt=dt, & swgrid=swgrid(:), igrid=igrid(:), & fbri=fbri(:), & aicen=aicen(i,j, :,iblk), & @@ -1402,11 +1401,6 @@ subroutine step_radiation (dt, iblk) days_per_year=days_per_year, & nextsw_cday=nextsw_cday, yday=yday, & sec=msec, & - kaer_tab=kaer_tab, kaer_bc_tab=kaer_bc_tab(:,:), & - waer_tab=waer_tab, waer_bc_tab=waer_bc_tab(:,:), & - gaer_tab=gaer_tab, gaer_bc_tab=gaer_bc_tab(:,:), & - bcenh=bcenh(:,:,:), & - modal_aero=modal_aero, & swvdr =swvdr (i,j ,iblk), swvdf =swvdf (i,j ,iblk), & swidr =swidr (i,j ,iblk), swidf =swidf (i,j ,iblk), & coszen =coszen (i,j ,iblk), fsnow =fsnow (i,j ,iblk), & diff --git a/cicecore/cicedyn/infrastructure/ice_restart_driver.F90 b/cicecore/cicedyn/infrastructure/ice_restart_driver.F90 index ffe9ec587..bde40dd14 100644 --- a/cicecore/cicedyn/infrastructure/ice_restart_driver.F90 +++ b/cicecore/cicedyn/infrastructure/ice_restart_driver.F90 @@ -292,7 +292,7 @@ subroutine restartfile (ice_ic) stress12_1, stress12_2, stress12_3, stress12_4, & stresspT, stressmT, stress12T, & stresspU, stressmU, stress12U - use ice_flux, only: coszen + use ice_flux, only: coszen, Tf use ice_grid, only: tmask, grid_type, grid_ice, grid_average_X2Y use ice_state, only: trcr_depend, aice, vice, vsno, trcr, & aice0, aicen, vicen, vsnon, trcrn, aice_init, uvel, vvel, & @@ -700,7 +700,8 @@ subroutine restartfile (ice_ic) trcr_depend = trcr_depend, & trcr_base = trcr_base, & n_trcr_strata = n_trcr_strata, & - nt_strata = nt_strata) + nt_strata = nt_strata, & + Tf = Tf(i,j,iblk)) aice_init(i,j,iblk) = aice(i,j,iblk) enddo @@ -736,7 +737,7 @@ subroutine restartfile_v4 (ice_ic) max_blocks use ice_dyn_shared, only: iceUmask use ice_flux, only: scale_factor, swvdr, swvdf, swidr, swidf, & - strocnxT_iavg, strocnyT_iavg, sst, frzmlt, & + strocnxT_iavg, strocnyT_iavg, sst, frzmlt, Tf, & stressp_1, stressp_2, stressp_3, stressp_4, & stressm_1, stressm_2, stressm_3, stressm_4, & stress12_1, stress12_2, stress12_3, stress12_4 @@ -1068,7 +1069,8 @@ subroutine restartfile_v4 (ice_ic) trcr_depend = trcr_depend, & trcr_base = trcr_base, & n_trcr_strata = n_trcr_strata, & - nt_strata = nt_strata) + nt_strata = nt_strata, & + Tf = Tf(i,j,iblk)) aice_init(i,j,iblk) = aice(i,j,iblk) enddo diff --git a/cicecore/drivers/direct/hadgem3/CICE_InitMod.F90 b/cicecore/drivers/direct/hadgem3/CICE_InitMod.F90 index 85050d8c9..4efb13c52 100644 --- a/cicecore/drivers/direct/hadgem3/CICE_InitMod.F90 +++ b/cicecore/drivers/direct/hadgem3/CICE_InitMod.F90 @@ -18,7 +18,7 @@ module CICE_InitMod use icepack_intfc, only: icepack_aggregate use icepack_intfc, only: icepack_init_itd, icepack_init_itd_hist use icepack_intfc, only: icepack_init_fsd_bounds, icepack_init_wave - use icepack_intfc, only: icepack_configure + use icepack_intfc, only: icepack_configure, icepack_init_radiation use icepack_intfc, only: icepack_warnings_flush, icepack_warnings_aborted use icepack_intfc, only: icepack_query_parameters, icepack_query_tracer_flags, & icepack_query_tracer_indices, icepack_query_tracer_sizes @@ -79,7 +79,7 @@ subroutine cice_init use ice_forcing, only: init_forcing_ocn, init_forcing_atmo, & get_forcing_atmo, get_forcing_ocn, alloc_forcing, get_wave_spec use ice_forcing_bgc, only: get_forcing_bgc, get_atm_bgc, & - faero_data, faero_default, faero_optics, alloc_forcing_bgc + faero_data, faero_default, alloc_forcing_bgc use ice_grid, only: init_grid1, init_grid2, alloc_grid use ice_history, only: init_hist, accum_hist use ice_restart_shared, only: restart, runid, runtype @@ -170,15 +170,13 @@ subroutine cice_init call init_history_therm ! initialize thermo history variables call init_history_dyn ! initialize dynamic history variables call calc_timesteps ! update timestep counter if not using npt_unit="1" + call icepack_init_radiation ! initialize icepack shortwave tables call icepack_query_tracer_flags(tr_aero_out=tr_aero, tr_zaero_out=tr_zaero) call icepack_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call abort_ice(subname, & file=__FILE__,line= __LINE__) - if (tr_aero .or. tr_zaero) call faero_optics !initialize aerosol optical - !property tables - ! Initialize shortwave components using swdn from previous timestep ! if restarting. These components will be scaled to current forcing ! in prep_radiation. @@ -231,7 +229,7 @@ subroutine init_restart use ice_domain_size, only: ncat, n_aero, nfsd use ice_dyn_eap, only: read_restart_eap use ice_dyn_shared, only: kdyn - use ice_flux, only: sss + use ice_flux, only: sss, Tf use ice_grid, only: tmask use ice_init, only: ice_ic use ice_init_column, only: init_age, init_FY, init_lvl, & @@ -427,7 +425,8 @@ subroutine init_restart trcr_depend = trcr_depend, & trcr_base = trcr_base, & n_trcr_strata = n_trcr_strata, & - nt_strata = nt_strata) + nt_strata = nt_strata, & + Tf = Tf(i,j,iblk)) else ! tcraig, reset all tracer values on land to zero trcrn(i,j,:,:,iblk) = c0 diff --git a/cicecore/drivers/direct/nemo_concepts/CICE_InitMod.F90 b/cicecore/drivers/direct/nemo_concepts/CICE_InitMod.F90 index 3a8f5e33d..69ecd4c91 100644 --- a/cicecore/drivers/direct/nemo_concepts/CICE_InitMod.F90 +++ b/cicecore/drivers/direct/nemo_concepts/CICE_InitMod.F90 @@ -18,7 +18,7 @@ module CICE_InitMod use icepack_intfc, only: icepack_aggregate use icepack_intfc, only: icepack_init_itd, icepack_init_itd_hist use icepack_intfc, only: icepack_init_fsd_bounds, icepack_init_wave - use icepack_intfc, only: icepack_configure + use icepack_intfc, only: icepack_configure, icepack_init_radiation use icepack_intfc, only: icepack_warnings_flush, icepack_warnings_aborted use icepack_intfc, only: icepack_query_parameters, icepack_query_tracer_flags, & icepack_query_tracer_indices, icepack_query_tracer_sizes @@ -79,7 +79,7 @@ subroutine cice_init use ice_forcing, only: init_forcing_ocn, init_forcing_atmo, & get_forcing_atmo, get_forcing_ocn, alloc_forcing, get_wave_spec use ice_forcing_bgc, only: get_forcing_bgc, get_atm_bgc, & - faero_data, faero_default, faero_optics, alloc_forcing_bgc + faero_data, faero_default, alloc_forcing_bgc use ice_grid, only: init_grid1, init_grid2, alloc_grid use ice_history, only: init_hist, accum_hist use ice_restart_shared, only: restart, runid, runtype @@ -170,15 +170,13 @@ subroutine cice_init call init_history_therm ! initialize thermo history variables call init_history_dyn ! initialize dynamic history variables call calc_timesteps ! update timestep counter if not using npt_unit="1" + call icepack_init_radiation ! initialize icepack shortwave tables call icepack_query_tracer_flags(tr_aero_out=tr_aero, tr_zaero_out=tr_zaero) call icepack_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call abort_ice(subname, & file=__FILE__,line= __LINE__) - if (tr_aero .or. tr_zaero) call faero_optics !initialize aerosol optical - !property tables - ! Initialize shortwave components using swdn from previous timestep ! if restarting. These components will be scaled to current forcing ! in prep_radiation. @@ -231,7 +229,7 @@ subroutine init_restart use ice_domain_size, only: ncat, n_aero, nfsd use ice_dyn_eap, only: read_restart_eap use ice_dyn_shared, only: kdyn - use ice_flux, only: sss + use ice_flux, only: sss, Tf use ice_grid, only: tmask use ice_init, only: ice_ic use ice_init_column, only: init_age, init_FY, init_lvl, & @@ -427,7 +425,8 @@ subroutine init_restart trcr_depend = trcr_depend, & trcr_base = trcr_base, & n_trcr_strata = n_trcr_strata, & - nt_strata = nt_strata) + nt_strata = nt_strata, & + Tf = Tf(i,j,iblk)) else ! tcraig, reset all tracer values on land to zero trcrn(i,j,:,:,iblk) = c0 diff --git a/cicecore/drivers/mct/cesm1/CICE_InitMod.F90 b/cicecore/drivers/mct/cesm1/CICE_InitMod.F90 index 5efa18a28..3c5907c54 100644 --- a/cicecore/drivers/mct/cesm1/CICE_InitMod.F90 +++ b/cicecore/drivers/mct/cesm1/CICE_InitMod.F90 @@ -19,7 +19,7 @@ module CICE_InitMod use icepack_intfc, only: icepack_aggregate use icepack_intfc, only: icepack_init_itd, icepack_init_itd_hist use icepack_intfc, only: icepack_init_fsd_bounds, icepack_init_wave - use icepack_intfc, only: icepack_init_snow + use icepack_intfc, only: icepack_init_snow, icepack_init_radiation use icepack_intfc, only: icepack_configure use icepack_intfc, only: icepack_warnings_flush, icepack_warnings_aborted use icepack_intfc, only: icepack_query_parameters, icepack_query_tracer_flags, & @@ -81,7 +81,7 @@ subroutine cice_init(mpicom_ice) use ice_forcing, only: init_forcing_ocn, init_forcing_atmo, & get_forcing_atmo, get_forcing_ocn, get_wave_spec, init_snowtable use ice_forcing_bgc, only: get_forcing_bgc, get_atm_bgc, & - faero_default, faero_optics, alloc_forcing_bgc, fiso_default + faero_default, alloc_forcing_bgc, fiso_default use ice_grid, only: init_grid1, init_grid2, alloc_grid use ice_history, only: init_hist, accum_hist use ice_restart_shared, only: restart, runtype @@ -186,6 +186,7 @@ subroutine cice_init(mpicom_ice) call init_history_therm ! initialize thermo history variables call init_history_dyn ! initialize dynamic history variables call calc_timesteps ! update timestep counter if not using npt_unit="1" + call icepack_init_radiation ! initialize icepack shortwave tables call icepack_query_tracer_flags(tr_aero_out=tr_aero, tr_zaero_out=tr_zaero) call icepack_query_tracer_flags(tr_iso_out=tr_iso, tr_snow_out=tr_snow) @@ -193,9 +194,6 @@ subroutine cice_init(mpicom_ice) if (icepack_warnings_aborted()) call abort_ice(trim(subname), & file=__FILE__,line= __LINE__) - if (tr_aero .or. tr_zaero) call faero_optics !initialize aerosol optical - !property tables - ! Initialize shortwave components using swdn from previous timestep ! if restarting. These components will be scaled to current forcing ! in prep_radiation. @@ -261,6 +259,7 @@ subroutine init_restart use ice_domain_size, only: ncat, n_iso, n_aero, nfsd, nslyr use ice_dyn_eap, only: read_restart_eap use ice_dyn_shared, only: kdyn + use ice_flux, only: Tf use ice_grid, only: tmask use ice_init, only: ice_ic use ice_init_column, only: init_age, init_FY, init_lvl, init_snowtracers, & @@ -492,7 +491,8 @@ subroutine init_restart trcr_depend = trcr_depend, & trcr_base = trcr_base, & n_trcr_strata = n_trcr_strata, & - nt_strata = nt_strata) + nt_strata = nt_strata, & + Tf = Tf(i,j,iblk)) else ! tcraig, reset all tracer values on land to zero trcrn(i,j,:,:,iblk) = c0 diff --git a/cicecore/drivers/mct/cesm1/ice_import_export.F90 b/cicecore/drivers/mct/cesm1/ice_import_export.F90 index 868ed42b4..110bcd39c 100644 --- a/cicecore/drivers/mct/cesm1/ice_import_export.F90 +++ b/cicecore/drivers/mct/cesm1/ice_import_export.F90 @@ -429,11 +429,11 @@ subroutine ice_import( x2i ) sss(i,j,iblk)=max(sss(i,j,iblk),c0) #endif - if (tfrz_option == 'minus1p8') then + if (tfrz_option(1:8) == 'minus1p8') then Tf (i,j,iblk) = -1.8_dbl_kind - elseif (tfrz_option == 'linear_salt') then + elseif (tfrz_option(1:11) == 'linear_salt') then Tf (i,j,iblk) = -0.0544_r8*sss(i,j,iblk) ! THIS IS THE ORIGINAL POP FORMULA - elseif (tfrz_option == 'mushy') then + elseif (tfrz_option(1:5) == 'mushy') then if (sss(i,j,iblk) > c0) then Tf (i,j,iblk) = sss(i,j,iblk) / (-18.48_dbl_kind & + ((18.48_dbl_kind*p001)*sss(i,j,iblk))) diff --git a/cicecore/drivers/mct/cesm1/ice_prescribed_mod.F90 b/cicecore/drivers/mct/cesm1/ice_prescribed_mod.F90 index 599249083..27bae6eb6 100644 --- a/cicecore/drivers/mct/cesm1/ice_prescribed_mod.F90 +++ b/cicecore/drivers/mct/cesm1/ice_prescribed_mod.F90 @@ -563,7 +563,8 @@ subroutine ice_prescribed_phys trcr_depend = trcr_depend(1:ntrcr), & trcr_base = trcr_base(1:ntrcr,:), & n_trcr_strata = n_trcr_strata(1:ntrcr), & - nt_strata = nt_strata(1:ntrcr,:)) + nt_strata = nt_strata(1:ntrcr,:), & + Tf = Tf(i,j,iblk)) enddo ! i enddo ! j diff --git a/cicecore/drivers/nuopc/cmeps/CICE_InitMod.F90 b/cicecore/drivers/nuopc/cmeps/CICE_InitMod.F90 index 270e7b371..2ebcc696a 100644 --- a/cicecore/drivers/nuopc/cmeps/CICE_InitMod.F90 +++ b/cicecore/drivers/nuopc/cmeps/CICE_InitMod.F90 @@ -8,7 +8,7 @@ module CICE_InitMod use icepack_intfc, only: icepack_aggregate use icepack_intfc, only: icepack_init_itd, icepack_init_itd_hist use icepack_intfc, only: icepack_init_fsd_bounds, icepack_init_wave - use icepack_intfc, only: icepack_init_snow + use icepack_intfc, only: icepack_init_snow, icepack_init_radiation use icepack_intfc, only: icepack_configure use icepack_intfc, only: icepack_warnings_flush, icepack_warnings_aborted use icepack_intfc, only: icepack_query_parameters, icepack_query_tracer_flags @@ -85,7 +85,7 @@ subroutine cice_init2() use ice_flux , only: init_history_dyn, init_flux_atm, init_flux_ocn use ice_forcing , only: init_snowtable use ice_forcing_bgc , only: get_forcing_bgc, get_atm_bgc - use ice_forcing_bgc , only: faero_default, faero_optics, alloc_forcing_bgc, fiso_default + use ice_forcing_bgc , only: faero_default, alloc_forcing_bgc, fiso_default use ice_history , only: init_hist, accum_hist use ice_restart_shared , only: restart, runtype use ice_init , only: input_data, init_state @@ -156,6 +156,7 @@ subroutine cice_init2() call init_diags ! initialize diagnostic output points call init_history_therm ! initialize thermo history variables call init_history_dyn ! initialize dynamic history variables + call icepack_init_radiation ! initialize icepack shortwave tables call icepack_query_tracer_flags(tr_aero_out=tr_aero, tr_zaero_out=tr_zaero) call icepack_query_tracer_flags(tr_iso_out=tr_iso, tr_snow_out=tr_snow) @@ -163,10 +164,6 @@ subroutine cice_init2() if (icepack_warnings_aborted()) call abort_ice(trim(subname), & file=__FILE__,line= __LINE__) - if (tr_aero .or. tr_zaero) then - call faero_optics !initialize aerosol optical property tables - end if - ! snow aging lookup table initialization if (tr_snow) then ! advanced snow physics call icepack_init_snow() @@ -218,6 +215,7 @@ subroutine init_restart() use ice_domain_size, only: ncat, n_iso, n_aero, nfsd, nslyr use ice_dyn_eap, only: read_restart_eap use ice_dyn_shared, only: kdyn + use ice_flux, only: Tf use ice_grid, only: tmask use ice_init, only: ice_ic use ice_init_column, only: init_age, init_FY, init_lvl, init_snowtracers, & @@ -445,7 +443,8 @@ subroutine init_restart() trcr_depend = trcr_depend, & trcr_base = trcr_base, & n_trcr_strata = n_trcr_strata, & - nt_strata = nt_strata) + nt_strata = nt_strata, & + Tf = Tf(i,j,iblk)) else ! tcraig, reset all tracer values on land to zero trcrn(i,j,:,:,iblk) = c0 diff --git a/cicecore/drivers/nuopc/cmeps/ice_prescribed_mod.F90 b/cicecore/drivers/nuopc/cmeps/ice_prescribed_mod.F90 index 06b090ece..0a11ee6ea 100644 --- a/cicecore/drivers/nuopc/cmeps/ice_prescribed_mod.F90 +++ b/cicecore/drivers/nuopc/cmeps/ice_prescribed_mod.F90 @@ -453,7 +453,8 @@ subroutine ice_prescribed_phys() trcr_depend = trcr_depend(1:ntrcr), & trcr_base = trcr_base(1:ntrcr,:), & n_trcr_strata = n_trcr_strata(1:ntrcr), & - nt_strata = nt_strata(1:ntrcr,:)) + nt_strata = nt_strata(1:ntrcr,:), & + Tf = Tf(i,j,iblk)) end if ! tmask enddo ! i diff --git a/cicecore/drivers/nuopc/dmi/CICE_InitMod.F90 b/cicecore/drivers/nuopc/dmi/CICE_InitMod.F90 index dc83c7703..147bdf7df 100644 --- a/cicecore/drivers/nuopc/dmi/CICE_InitMod.F90 +++ b/cicecore/drivers/nuopc/dmi/CICE_InitMod.F90 @@ -19,7 +19,7 @@ module CICE_InitMod use icepack_intfc, only: icepack_aggregate use icepack_intfc, only: icepack_init_itd, icepack_init_itd_hist use icepack_intfc, only: icepack_init_fsd_bounds, icepack_init_wave - use icepack_intfc, only: icepack_init_snow + use icepack_intfc, only: icepack_init_snow, icepack_init_radiation use icepack_intfc, only: icepack_configure use icepack_intfc, only: icepack_warnings_flush, icepack_warnings_aborted use icepack_intfc, only: icepack_query_parameters, icepack_query_tracer_flags, & @@ -86,7 +86,7 @@ subroutine cice_init(mpi_comm) use ice_forcing, only: init_forcing_ocn, init_forcing_atmo, & get_forcing_atmo, get_forcing_ocn, get_wave_spec, init_snowtable use ice_forcing_bgc, only: get_forcing_bgc, get_atm_bgc, & - faero_default, faero_optics, alloc_forcing_bgc, fiso_default + faero_default, alloc_forcing_bgc, fiso_default use ice_grid, only: init_grid1, init_grid2, alloc_grid use ice_history, only: init_hist, accum_hist use ice_restart_shared, only: restart, runtype @@ -196,6 +196,7 @@ subroutine cice_init(mpi_comm) call init_history_therm ! initialize thermo history variables call init_history_dyn ! initialize dynamic history variables call calc_timesteps ! update timestep counter if not using npt_unit="1" + call icepack_init_radiation ! initialize icepack shortwave tables call icepack_query_tracer_flags(tr_aero_out=tr_aero, tr_zaero_out=tr_zaero) call icepack_query_tracer_flags(tr_iso_out=tr_iso, tr_snow_out=tr_snow) @@ -203,9 +204,6 @@ subroutine cice_init(mpi_comm) if (icepack_warnings_aborted()) call abort_ice(trim(subname), & file=__FILE__,line= __LINE__) - if (tr_aero .or. tr_zaero) call faero_optics !initialize aerosol optical - !property tables - ! Initialize shortwave components using swdn from previous timestep ! if restarting. These components will be scaled to current forcing ! in prep_radiation. @@ -279,6 +277,7 @@ subroutine init_restart use ice_domain_size, only: ncat, n_iso, n_aero, nfsd, nslyr use ice_dyn_eap, only: read_restart_eap use ice_dyn_shared, only: kdyn + use ice_flux, only: Tf use ice_grid, only: tmask use ice_init, only: ice_ic use ice_init_column, only: init_age, init_FY, init_lvl, init_snowtracers, & @@ -510,7 +509,8 @@ subroutine init_restart trcr_depend = trcr_depend, & trcr_base = trcr_base, & n_trcr_strata = n_trcr_strata, & - nt_strata = nt_strata) + nt_strata = nt_strata, & + Tf = Tf(i,j,iblk)) else ! tcraig, reset all tracer values on land to zero trcrn(i,j,:,:,iblk) = c0 diff --git a/cicecore/drivers/standalone/cice/CICE_InitMod.F90 b/cicecore/drivers/standalone/cice/CICE_InitMod.F90 index dc9fece6e..38000446a 100644 --- a/cicecore/drivers/standalone/cice/CICE_InitMod.F90 +++ b/cicecore/drivers/standalone/cice/CICE_InitMod.F90 @@ -19,7 +19,7 @@ module CICE_InitMod use icepack_intfc, only: icepack_aggregate use icepack_intfc, only: icepack_init_itd, icepack_init_itd_hist use icepack_intfc, only: icepack_init_fsd_bounds, icepack_init_wave - use icepack_intfc, only: icepack_init_snow + use icepack_intfc, only: icepack_init_snow, icepack_init_radiation use icepack_intfc, only: icepack_configure use icepack_intfc, only: icepack_warnings_flush, icepack_warnings_aborted use icepack_intfc, only: icepack_query_parameters, icepack_query_tracer_flags, & @@ -81,7 +81,7 @@ subroutine cice_init use ice_forcing, only: init_forcing_ocn, init_forcing_atmo, & get_forcing_atmo, get_forcing_ocn, get_wave_spec, init_snowtable use ice_forcing_bgc, only: get_forcing_bgc, get_atm_bgc, & - faero_default, faero_optics, alloc_forcing_bgc, fiso_default + faero_default, alloc_forcing_bgc, fiso_default use ice_grid, only: init_grid1, init_grid2, alloc_grid use ice_history, only: init_hist, accum_hist use ice_restart_shared, only: restart, runtype @@ -183,6 +183,7 @@ subroutine cice_init call init_history_therm ! initialize thermo history variables call init_history_dyn ! initialize dynamic history variables call calc_timesteps ! update timestep counter if not using npt_unit="1" + call icepack_init_radiation ! initialize icepack shortwave tables call icepack_query_tracer_flags(tr_aero_out=tr_aero, tr_zaero_out=tr_zaero) call icepack_query_tracer_flags(tr_iso_out=tr_iso, tr_snow_out=tr_snow) @@ -190,9 +191,6 @@ subroutine cice_init if (icepack_warnings_aborted()) call abort_ice(trim(subname), & file=__FILE__,line= __LINE__) - if (tr_aero .or. tr_zaero) call faero_optics !initialize aerosol optical - !property tables - ! Initialize shortwave components using swdn from previous timestep ! if restarting. These components will be scaled to current forcing ! in prep_radiation. @@ -278,6 +276,7 @@ subroutine init_restart restart_aero, read_restart_aero, & restart_hbrine, read_restart_hbrine, & restart_bgc + use ice_flux, only: Tf use ice_restart_driver, only: restartfile use ice_restart_shared, only: runtype, restart use ice_state ! almost everything @@ -492,7 +491,8 @@ subroutine init_restart trcr_depend = trcr_depend, & trcr_base = trcr_base, & n_trcr_strata = n_trcr_strata, & - nt_strata = nt_strata) + nt_strata = nt_strata, & + Tf = Tf(i,j,iblk)) else ! tcraig, reset all tracer values on land to zero trcrn(i,j,:,:,iblk) = c0 diff --git a/cicecore/drivers/unittest/gridavgchk/CICE_InitMod.F90 b/cicecore/drivers/unittest/gridavgchk/CICE_InitMod.F90 index dc9fece6e..38000446a 100644 --- a/cicecore/drivers/unittest/gridavgchk/CICE_InitMod.F90 +++ b/cicecore/drivers/unittest/gridavgchk/CICE_InitMod.F90 @@ -19,7 +19,7 @@ module CICE_InitMod use icepack_intfc, only: icepack_aggregate use icepack_intfc, only: icepack_init_itd, icepack_init_itd_hist use icepack_intfc, only: icepack_init_fsd_bounds, icepack_init_wave - use icepack_intfc, only: icepack_init_snow + use icepack_intfc, only: icepack_init_snow, icepack_init_radiation use icepack_intfc, only: icepack_configure use icepack_intfc, only: icepack_warnings_flush, icepack_warnings_aborted use icepack_intfc, only: icepack_query_parameters, icepack_query_tracer_flags, & @@ -81,7 +81,7 @@ subroutine cice_init use ice_forcing, only: init_forcing_ocn, init_forcing_atmo, & get_forcing_atmo, get_forcing_ocn, get_wave_spec, init_snowtable use ice_forcing_bgc, only: get_forcing_bgc, get_atm_bgc, & - faero_default, faero_optics, alloc_forcing_bgc, fiso_default + faero_default, alloc_forcing_bgc, fiso_default use ice_grid, only: init_grid1, init_grid2, alloc_grid use ice_history, only: init_hist, accum_hist use ice_restart_shared, only: restart, runtype @@ -183,6 +183,7 @@ subroutine cice_init call init_history_therm ! initialize thermo history variables call init_history_dyn ! initialize dynamic history variables call calc_timesteps ! update timestep counter if not using npt_unit="1" + call icepack_init_radiation ! initialize icepack shortwave tables call icepack_query_tracer_flags(tr_aero_out=tr_aero, tr_zaero_out=tr_zaero) call icepack_query_tracer_flags(tr_iso_out=tr_iso, tr_snow_out=tr_snow) @@ -190,9 +191,6 @@ subroutine cice_init if (icepack_warnings_aborted()) call abort_ice(trim(subname), & file=__FILE__,line= __LINE__) - if (tr_aero .or. tr_zaero) call faero_optics !initialize aerosol optical - !property tables - ! Initialize shortwave components using swdn from previous timestep ! if restarting. These components will be scaled to current forcing ! in prep_radiation. @@ -278,6 +276,7 @@ subroutine init_restart restart_aero, read_restart_aero, & restart_hbrine, read_restart_hbrine, & restart_bgc + use ice_flux, only: Tf use ice_restart_driver, only: restartfile use ice_restart_shared, only: runtype, restart use ice_state ! almost everything @@ -492,7 +491,8 @@ subroutine init_restart trcr_depend = trcr_depend, & trcr_base = trcr_base, & n_trcr_strata = n_trcr_strata, & - nt_strata = nt_strata) + nt_strata = nt_strata, & + Tf = Tf(i,j,iblk)) else ! tcraig, reset all tracer values on land to zero trcrn(i,j,:,:,iblk) = c0 diff --git a/cicecore/drivers/unittest/halochk/CICE_InitMod.F90 b/cicecore/drivers/unittest/halochk/CICE_InitMod.F90 index dc9fece6e..38000446a 100644 --- a/cicecore/drivers/unittest/halochk/CICE_InitMod.F90 +++ b/cicecore/drivers/unittest/halochk/CICE_InitMod.F90 @@ -19,7 +19,7 @@ module CICE_InitMod use icepack_intfc, only: icepack_aggregate use icepack_intfc, only: icepack_init_itd, icepack_init_itd_hist use icepack_intfc, only: icepack_init_fsd_bounds, icepack_init_wave - use icepack_intfc, only: icepack_init_snow + use icepack_intfc, only: icepack_init_snow, icepack_init_radiation use icepack_intfc, only: icepack_configure use icepack_intfc, only: icepack_warnings_flush, icepack_warnings_aborted use icepack_intfc, only: icepack_query_parameters, icepack_query_tracer_flags, & @@ -81,7 +81,7 @@ subroutine cice_init use ice_forcing, only: init_forcing_ocn, init_forcing_atmo, & get_forcing_atmo, get_forcing_ocn, get_wave_spec, init_snowtable use ice_forcing_bgc, only: get_forcing_bgc, get_atm_bgc, & - faero_default, faero_optics, alloc_forcing_bgc, fiso_default + faero_default, alloc_forcing_bgc, fiso_default use ice_grid, only: init_grid1, init_grid2, alloc_grid use ice_history, only: init_hist, accum_hist use ice_restart_shared, only: restart, runtype @@ -183,6 +183,7 @@ subroutine cice_init call init_history_therm ! initialize thermo history variables call init_history_dyn ! initialize dynamic history variables call calc_timesteps ! update timestep counter if not using npt_unit="1" + call icepack_init_radiation ! initialize icepack shortwave tables call icepack_query_tracer_flags(tr_aero_out=tr_aero, tr_zaero_out=tr_zaero) call icepack_query_tracer_flags(tr_iso_out=tr_iso, tr_snow_out=tr_snow) @@ -190,9 +191,6 @@ subroutine cice_init if (icepack_warnings_aborted()) call abort_ice(trim(subname), & file=__FILE__,line= __LINE__) - if (tr_aero .or. tr_zaero) call faero_optics !initialize aerosol optical - !property tables - ! Initialize shortwave components using swdn from previous timestep ! if restarting. These components will be scaled to current forcing ! in prep_radiation. @@ -278,6 +276,7 @@ subroutine init_restart restart_aero, read_restart_aero, & restart_hbrine, read_restart_hbrine, & restart_bgc + use ice_flux, only: Tf use ice_restart_driver, only: restartfile use ice_restart_shared, only: runtype, restart use ice_state ! almost everything @@ -492,7 +491,8 @@ subroutine init_restart trcr_depend = trcr_depend, & trcr_base = trcr_base, & n_trcr_strata = n_trcr_strata, & - nt_strata = nt_strata) + nt_strata = nt_strata, & + Tf = Tf(i,j,iblk)) else ! tcraig, reset all tracer values on land to zero trcrn(i,j,:,:,iblk) = c0 diff --git a/cicecore/drivers/unittest/opticep/CICE_InitMod.F90 b/cicecore/drivers/unittest/opticep/CICE_InitMod.F90 index dc9fece6e..38000446a 100644 --- a/cicecore/drivers/unittest/opticep/CICE_InitMod.F90 +++ b/cicecore/drivers/unittest/opticep/CICE_InitMod.F90 @@ -19,7 +19,7 @@ module CICE_InitMod use icepack_intfc, only: icepack_aggregate use icepack_intfc, only: icepack_init_itd, icepack_init_itd_hist use icepack_intfc, only: icepack_init_fsd_bounds, icepack_init_wave - use icepack_intfc, only: icepack_init_snow + use icepack_intfc, only: icepack_init_snow, icepack_init_radiation use icepack_intfc, only: icepack_configure use icepack_intfc, only: icepack_warnings_flush, icepack_warnings_aborted use icepack_intfc, only: icepack_query_parameters, icepack_query_tracer_flags, & @@ -81,7 +81,7 @@ subroutine cice_init use ice_forcing, only: init_forcing_ocn, init_forcing_atmo, & get_forcing_atmo, get_forcing_ocn, get_wave_spec, init_snowtable use ice_forcing_bgc, only: get_forcing_bgc, get_atm_bgc, & - faero_default, faero_optics, alloc_forcing_bgc, fiso_default + faero_default, alloc_forcing_bgc, fiso_default use ice_grid, only: init_grid1, init_grid2, alloc_grid use ice_history, only: init_hist, accum_hist use ice_restart_shared, only: restart, runtype @@ -183,6 +183,7 @@ subroutine cice_init call init_history_therm ! initialize thermo history variables call init_history_dyn ! initialize dynamic history variables call calc_timesteps ! update timestep counter if not using npt_unit="1" + call icepack_init_radiation ! initialize icepack shortwave tables call icepack_query_tracer_flags(tr_aero_out=tr_aero, tr_zaero_out=tr_zaero) call icepack_query_tracer_flags(tr_iso_out=tr_iso, tr_snow_out=tr_snow) @@ -190,9 +191,6 @@ subroutine cice_init if (icepack_warnings_aborted()) call abort_ice(trim(subname), & file=__FILE__,line= __LINE__) - if (tr_aero .or. tr_zaero) call faero_optics !initialize aerosol optical - !property tables - ! Initialize shortwave components using swdn from previous timestep ! if restarting. These components will be scaled to current forcing ! in prep_radiation. @@ -278,6 +276,7 @@ subroutine init_restart restart_aero, read_restart_aero, & restart_hbrine, read_restart_hbrine, & restart_bgc + use ice_flux, only: Tf use ice_restart_driver, only: restartfile use ice_restart_shared, only: runtype, restart use ice_state ! almost everything @@ -492,7 +491,8 @@ subroutine init_restart trcr_depend = trcr_depend, & trcr_base = trcr_base, & n_trcr_strata = n_trcr_strata, & - nt_strata = nt_strata) + nt_strata = nt_strata, & + Tf = Tf(i,j,iblk)) else ! tcraig, reset all tracer values on land to zero trcrn(i,j,:,:,iblk) = c0 diff --git a/cicecore/drivers/unittest/opticep/ice_init_column.F90 b/cicecore/drivers/unittest/opticep/ice_init_column.F90 index 04749b98c..cb9b93df1 100644 --- a/cicecore/drivers/unittest/opticep/ice_init_column.F90 +++ b/cicecore/drivers/unittest/opticep/ice_init_column.F90 @@ -184,7 +184,6 @@ subroutine init_shortwave albsnon, alvdrn, alidrn, alvdfn, alidfn, fswsfcn, & fswthrun, fswthrun_vdr, fswthrun_vdf, fswthrun_idr, fswthrun_idf, & fswintn, albpndn, apeffn, trcrn_sw, dhsn, ffracn, snowfracn, & - kaer_tab, waer_tab, gaer_tab, kaer_bc_tab, waer_bc_tab, gaer_bc_tab, bcenh, & swgrid, igrid use ice_blocks, only: block, get_block use ice_calendar, only: dt, calendar_type, & @@ -320,7 +319,7 @@ subroutine init_shortwave do j = jlo, jhi do i = ilo, ihi - if (trim(shortwave) == 'dEdd') then ! delta Eddington + if (shortwave(1:4) == 'dEdd') then ! delta Eddington #ifndef CESMCOUPLED ! initialize orbital parameters @@ -345,9 +344,7 @@ subroutine init_shortwave enddo if (tmask(i,j,iblk)) then - call icepack_step_radiation (dt=dt, ncat=ncat, & - nblyr=nblyr, nilyr=nilyr, nslyr=nslyr, & - dEdd_algae=dEdd_algae, & + call icepack_step_radiation (dt=dt, & swgrid=swgrid(:), igrid=igrid(:), & fbri=fbri(:), & aicen=aicen(i,j,:,iblk), & @@ -367,11 +364,6 @@ subroutine init_shortwave days_per_year=days_per_year, & nextsw_cday=nextsw_cday, yday=yday, & sec=msec, & - kaer_tab=kaer_tab, kaer_bc_tab=kaer_bc_tab(:,:), & - waer_tab=waer_tab, waer_bc_tab=waer_bc_tab(:,:), & - gaer_tab=gaer_tab, gaer_bc_tab=gaer_bc_tab(:,:), & - bcenh=bcenh(:,:,:), & - modal_aero=modal_aero, & swvdr=swvdr(i,j,iblk), swvdf=swvdf(i,j,iblk),& swidr=swidr(i,j,iblk), swidf=swidf(i,j,iblk),& coszen=coszen(i,j,iblk), fsnow=fsnow(i,j,iblk),& @@ -965,7 +957,7 @@ end subroutine init_hbrine subroutine input_zbgc - use ice_arrays_column, only: restore_bgc, optics_file, optics_file_fieldname + use ice_arrays_column, only: restore_bgc use ice_broadcast, only: broadcast_scalar use ice_restart_column, only: restart_bgc, restart_hbrine use ice_restart_shared, only: restart @@ -1007,7 +999,7 @@ subroutine input_zbgc restore_bgc, restart_bgc, scale_bgc, solve_zsal, restart_zsal, & tr_bgc_Nit, tr_bgc_C, tr_bgc_chl, tr_bgc_Am, tr_bgc_Sil, & tr_bgc_DMS, tr_bgc_PON, tr_bgc_hum, tr_bgc_DON, tr_bgc_Fe, & - grid_o, grid_o_t, l_sk, grid_oS, optics_file, optics_file_fieldname, & + grid_o, grid_o_t, l_sk, grid_oS, & l_skS, phi_snow, initbio_frac, frazil_scav, & ratio_Si2N_diatoms , ratio_Si2N_sp , ratio_Si2N_phaeo , & ratio_S2N_diatoms , ratio_S2N_sp , ratio_S2N_phaeo , & @@ -1064,8 +1056,6 @@ subroutine input_zbgc tr_brine = .false. ! brine height differs from ice height tr_zaero = .false. ! z aerosol tracers modal_aero = .false. ! use modal aerosol treatment of aerosols - optics_file = 'unknown_optics_file' ! modal aerosol optics file - optics_file_fieldname = 'unknown_optics_fieldname' ! modal aerosol optics file fieldname restore_bgc = .false. ! restore bgc if true solve_zsal = .false. ! update salinity tracer profile from solve_S_dt restart_bgc = .false. ! biogeochemistry restart @@ -1283,8 +1273,6 @@ subroutine input_zbgc call broadcast_scalar(tr_zaero, master_task) call broadcast_scalar(dEdd_algae, master_task) call broadcast_scalar(modal_aero, master_task) - call broadcast_scalar(optics_file, master_task) - call broadcast_scalar(optics_file_fieldname, master_task) call broadcast_scalar(grid_o, master_task) call broadcast_scalar(grid_o_t, master_task) call broadcast_scalar(l_sk, master_task) @@ -1464,9 +1452,9 @@ subroutine input_zbgc abort_flag = 107 endif - if (dEdd_algae .AND. trim(shortwave) /= 'dEdd') then + if (dEdd_algae .AND. shortwave(1:4) /= 'dEdd') then if (my_task == master_task) then - write(nu_diag,*) subname,' ERROR: dEdd_algae = T but shortwave /= dEdd' + write(nu_diag,*) subname,' ERROR: dEdd_algae = T but shortwave /= dEdd or dEdd_snicar_ad' endif abort_flag = 108 endif @@ -1485,9 +1473,9 @@ subroutine input_zbgc abort_flag = 110 endif - if (modal_aero .AND. trim(shortwave) /= 'dEdd') then + if (modal_aero .AND. shortwave(1:4) /= 'dEdd') then if (my_task == master_task) then - write(nu_diag,*) subname,' ERROR: modal_aero = T but shortwave /= dEdd' + write(nu_diag,*) subname,' ERROR: modal_aero = T but shortwave /= dEdd or dEdd_snicar_ad' endif abort_flag = 111 endif @@ -1641,8 +1629,6 @@ subroutine input_zbgc write(nu_diag,1010) ' solve_zbgc = ', solve_zbgc write(nu_diag,1010) ' tr_zaero = ', tr_zaero write(nu_diag,1020) ' number of aerosols = ', n_zaero - write(nu_diag,1031) ' optics_file = ', trim(optics_file) - write(nu_diag,1031) ' optics_file_fieldname = ', trim(optics_file_fieldname) ! bio parameters write(nu_diag,1000) ' grid_o = ', grid_o write(nu_diag,1000) ' grid_o_t = ', grid_o_t diff --git a/cicecore/drivers/unittest/opticep/ice_step_mod.F90 b/cicecore/drivers/unittest/opticep/ice_step_mod.F90 index c291d8802..ba19436bd 100644 --- a/cicecore/drivers/unittest/opticep/ice_step_mod.F90 +++ b/cicecore/drivers/unittest/opticep/ice_step_mod.F90 @@ -182,8 +182,7 @@ subroutine prep_radiation (iblk) alidr_init(i,j,iblk) = alidr_ai(i,j,iblk) alidf_init(i,j,iblk) = alidf_ai(i,j,iblk) - call icepack_prep_radiation (ncat=ncat, nilyr=nilyr, nslyr=nslyr, & - scale_factor=scale_factor(i,j,iblk), & + call icepack_prep_radiation (scale_factor=scale_factor(i,j,iblk), & aice = aice (i,j, iblk), aicen = aicen (i,j, :,iblk), & swvdr = swvdr (i,j, iblk), swvdf = swvdf (i,j, iblk), & swidr = swidr (i,j, iblk), swidf = swidf (i,j, iblk), & @@ -275,7 +274,7 @@ subroutine step_therm1 (dt, iblk) logical (kind=log_kind) :: & tr_iage, tr_FY, tr_iso, tr_aero, tr_pond, & - tr_pond_lvl, tr_pond_topo, calc_Tsfc, highfreq, tr_snow + tr_pond_lvl, tr_pond_topo, calc_Tsfc, snwgrain real (kind=dbl_kind) :: & puny ! a very small number @@ -296,13 +295,12 @@ subroutine step_therm1 (dt, iblk) call icepack_query_parameters(puny_out=puny) call icepack_query_parameters(calc_Tsfc_out=calc_Tsfc) - call icepack_query_parameters(highfreq_out=highfreq) + call icepack_query_parameters(snwgrain_out=snwgrain) call icepack_query_tracer_sizes(ntrcr_out=ntrcr) call icepack_query_tracer_flags( & tr_iage_out=tr_iage, tr_FY_out=tr_FY, tr_iso_out=tr_iso, & tr_aero_out=tr_aero, tr_pond_out=tr_pond, & - tr_pond_lvl_out=tr_pond_lvl, tr_pond_topo_out=tr_pond_topo, & - tr_snow_out=tr_snow) + tr_pond_lvl_out=tr_pond_lvl, tr_pond_topo_out=tr_pond_topo) call icepack_query_tracer_indices( & nt_apnd_out=nt_apnd, nt_hpnd_out=nt_hpnd, nt_ipnd_out=nt_ipnd, & nt_alvl_out=nt_alvl, nt_vlvl_out=nt_vlvl, nt_Tsfc_out=nt_Tsfc, & @@ -357,7 +355,7 @@ subroutine step_therm1 (dt, iblk) do j = jlo, jhi do i = ilo, ihi - if (tr_snow) then + if (snwgrain) then do n = 1, ncat do k = 1, nslyr rsnwn (k,n) = trcrn(i,j,nt_rsnw +k-1,n,iblk) @@ -365,7 +363,7 @@ subroutine step_therm1 (dt, iblk) smliqn(k,n) = trcrn(i,j,nt_smliq+k-1,n,iblk) enddo enddo - endif ! tr_snow + endif ! snwgrain if (tr_iso) then ! trcrn(nt_iso*) has units kg/m^3 do n=1,ncat @@ -557,7 +555,7 @@ subroutine step_therm1 (dt, iblk) endif - if (tr_snow) then + if (snwgrain) then do n = 1, ncat do k = 1, nslyr trcrn(i,j,nt_rsnw +k-1,n,iblk) = rsnwn (k,n) @@ -565,7 +563,7 @@ subroutine step_therm1 (dt, iblk) trcrn(i,j,nt_smliq+k-1,n,iblk) = smliqn(k,n) enddo enddo - endif ! tr_snow + endif ! snwgrain if (tr_iso) then do n = 1, ncat @@ -762,6 +760,7 @@ subroutine update_state (dt, daidt, dvidt, dagedt, offset) use ice_state, only: aicen, trcrn, vicen, vsnon, & aice, trcr, vice, vsno, aice0, trcr_depend, & bound_state, trcr_base, nt_strata, n_trcr_strata + use ice_flux, only: Tf use ice_timers, only: ice_timer_start, ice_timer_stop, timer_bound, timer_updstate real (kind=dbl_kind), intent(in) :: & @@ -828,7 +827,8 @@ subroutine update_state (dt, daidt, dvidt, dagedt, offset) trcr_depend = trcr_depend(:), & trcr_base = trcr_base(:,:), & n_trcr_strata = n_trcr_strata(:), & - nt_strata = nt_strata(:,:)) + nt_strata = nt_strata(:,:), & + Tf = Tf(i,j,iblk)) if (present(offset)) then @@ -1045,7 +1045,7 @@ subroutine step_dyn_ridge (dt, ndtd, iblk) rdg_conv, rdg_shear, dardg1dt, dardg2dt, & dvirdgdt, opening, fpond, fresh, fhocn, & aparticn, krdgn, aredistn, vredistn, dardg1ndt, dardg2ndt, & - dvirdgndt, araftn, vraftn, fsalt + dvirdgndt, araftn, vraftn, fsalt, Tf use ice_flux_bgc, only: flux_bio, faero_ocn, fiso_ocn use ice_grid, only: tmask use ice_state, only: trcrn, vsnon, aicen, vicen, & @@ -1136,7 +1136,8 @@ subroutine step_dyn_ridge (dt, ndtd, iblk) aice = aice (i,j, iblk), & fsalt = fsalt (i,j, iblk), & first_ice = first_ice(i,j,:,iblk), & - flux_bio = flux_bio (i,j,1:nbtrcr,iblk)) + flux_bio = flux_bio (i,j,1:nbtrcr,iblk), & + Tf = Tf(i,j,iblk)) endif ! tmask @@ -1275,8 +1276,7 @@ subroutine step_radiation (dt, iblk) fswthrun, fswthrun_vdr, fswthrun_vdf, fswthrun_idr, fswthrun_idf, & albicen, albsnon, albpndn, & alvdrn, alidrn, alvdfn, alidfn, apeffn, trcrn_sw, snowfracn, & - kaer_tab, waer_tab, gaer_tab, kaer_bc_tab, waer_bc_tab, & - gaer_bc_tab, bcenh, swgrid, igrid + swgrid, igrid use ice_calendar, only: calendar_type, days_per_year, nextsw_cday, yday, msec use ice_domain_size, only: ncat, n_aero, nilyr, nslyr, n_zaero, n_algae, nblyr use ice_flux, only: swvdr, swvdf, swidr, swidf, coszen, fsnow @@ -1383,9 +1383,7 @@ subroutine step_radiation (dt, iblk) if (tmask(i,j,iblk)) then - call icepack_step_radiation (dt=dt, ncat=ncat, & - nblyr=nblyr, nilyr=nilyr, nslyr=nslyr, & - dEdd_algae=dEdd_algae, & + call icepack_step_radiation (dt=dt, & swgrid=swgrid(:), igrid=igrid(:), & fbri=fbri(:), & aicen=aicen(i,j, :,iblk), & @@ -1405,11 +1403,6 @@ subroutine step_radiation (dt, iblk) days_per_year=days_per_year, & nextsw_cday=nextsw_cday, yday=yday, & sec=msec, & - kaer_tab=kaer_tab, kaer_bc_tab=kaer_bc_tab(:,:), & - waer_tab=waer_tab, waer_bc_tab=waer_bc_tab(:,:), & - gaer_tab=gaer_tab, gaer_bc_tab=gaer_bc_tab(:,:), & - bcenh=bcenh(:,:,:), & - modal_aero=modal_aero, & swvdr =swvdr (i,j ,iblk), swvdf =swvdf (i,j ,iblk), & swidr =swidr (i,j ,iblk), swidf =swidf (i,j ,iblk), & coszen =coszen (i,j ,iblk), fsnow =fsnow (i,j ,iblk), & diff --git a/cicecore/drivers/unittest/sumchk/CICE_InitMod.F90 b/cicecore/drivers/unittest/sumchk/CICE_InitMod.F90 index dc9fece6e..38000446a 100644 --- a/cicecore/drivers/unittest/sumchk/CICE_InitMod.F90 +++ b/cicecore/drivers/unittest/sumchk/CICE_InitMod.F90 @@ -19,7 +19,7 @@ module CICE_InitMod use icepack_intfc, only: icepack_aggregate use icepack_intfc, only: icepack_init_itd, icepack_init_itd_hist use icepack_intfc, only: icepack_init_fsd_bounds, icepack_init_wave - use icepack_intfc, only: icepack_init_snow + use icepack_intfc, only: icepack_init_snow, icepack_init_radiation use icepack_intfc, only: icepack_configure use icepack_intfc, only: icepack_warnings_flush, icepack_warnings_aborted use icepack_intfc, only: icepack_query_parameters, icepack_query_tracer_flags, & @@ -81,7 +81,7 @@ subroutine cice_init use ice_forcing, only: init_forcing_ocn, init_forcing_atmo, & get_forcing_atmo, get_forcing_ocn, get_wave_spec, init_snowtable use ice_forcing_bgc, only: get_forcing_bgc, get_atm_bgc, & - faero_default, faero_optics, alloc_forcing_bgc, fiso_default + faero_default, alloc_forcing_bgc, fiso_default use ice_grid, only: init_grid1, init_grid2, alloc_grid use ice_history, only: init_hist, accum_hist use ice_restart_shared, only: restart, runtype @@ -183,6 +183,7 @@ subroutine cice_init call init_history_therm ! initialize thermo history variables call init_history_dyn ! initialize dynamic history variables call calc_timesteps ! update timestep counter if not using npt_unit="1" + call icepack_init_radiation ! initialize icepack shortwave tables call icepack_query_tracer_flags(tr_aero_out=tr_aero, tr_zaero_out=tr_zaero) call icepack_query_tracer_flags(tr_iso_out=tr_iso, tr_snow_out=tr_snow) @@ -190,9 +191,6 @@ subroutine cice_init if (icepack_warnings_aborted()) call abort_ice(trim(subname), & file=__FILE__,line= __LINE__) - if (tr_aero .or. tr_zaero) call faero_optics !initialize aerosol optical - !property tables - ! Initialize shortwave components using swdn from previous timestep ! if restarting. These components will be scaled to current forcing ! in prep_radiation. @@ -278,6 +276,7 @@ subroutine init_restart restart_aero, read_restart_aero, & restart_hbrine, read_restart_hbrine, & restart_bgc + use ice_flux, only: Tf use ice_restart_driver, only: restartfile use ice_restart_shared, only: runtype, restart use ice_state ! almost everything @@ -492,7 +491,8 @@ subroutine init_restart trcr_depend = trcr_depend, & trcr_base = trcr_base, & n_trcr_strata = n_trcr_strata, & - nt_strata = nt_strata) + nt_strata = nt_strata, & + Tf = Tf(i,j,iblk)) else ! tcraig, reset all tracer values on land to zero trcrn(i,j,:,:,iblk) = c0 diff --git a/cicecore/shared/ice_arrays_column.F90 b/cicecore/shared/ice_arrays_column.F90 index 66f1819fa..9480d79bc 100644 --- a/cicecore/shared/ice_arrays_column.F90 +++ b/cicecore/shared/ice_arrays_column.F90 @@ -13,7 +13,7 @@ module ice_arrays_column use ice_blocks, only: nx_block, ny_block use ice_domain_size, only: max_blocks, ncat, nilyr, nslyr, & nblyr, nfsd, nfreq - use icepack_intfc, only: icepack_nspint + use icepack_intfc, only: icepack_nspint_3bd use icepack_intfc, only: icepack_query_tracer_sizes, icepack_query_parameters, & icepack_query_tracer_flags, & icepack_warnings_flush, icepack_warnings_aborted, icepack_query_tracer_sizes @@ -117,22 +117,6 @@ module ice_arrays_column real (kind=dbl_kind), dimension (:,:,:,:,:), allocatable, public :: & fswpenln ! visible SW entering ice layers (W m-2) - ! aerosol optical properties -> band | - ! v aerosol - ! for combined dust category, use category 4 properties - real (kind=dbl_kind), dimension(:,:), allocatable, public :: & - kaer_tab, & ! aerosol mass extinction cross section (m2/kg) - waer_tab, & ! aerosol single scatter albedo (fraction) - gaer_tab ! aerosol asymmetry parameter (cos(theta)) - - real (kind=dbl_kind), dimension(:,:), allocatable, public :: & - kaer_bc_tab, & ! BC mass extinction cross section (m2/kg) - waer_bc_tab, & ! BC single scatter albedo (fraction) - gaer_bc_tab ! BC aerosol asymmetry parameter (cos(theta)) - - real (kind=dbl_kind), dimension(:,:,:), allocatable, public :: & - bcenh ! BC absorption enhancement factor - ! biogeochemistry components real (kind=dbl_kind), dimension (:), allocatable, public :: & @@ -244,10 +228,6 @@ module ice_arrays_column character(char_len_long), public :: & bgc_data_dir ! directory for biogeochemistry data - character(char_len_long), public :: & - optics_file, & ! modal aero optics file - optics_file_fieldname ! modal aero optics file fieldname - real (kind=dbl_kind), dimension(:), allocatable, public :: & R_C2N_DON ! carbon to nitrogen mole ratio of DON pool @@ -386,17 +366,6 @@ subroutine alloc_arrays_column stat=ierr) if (ierr/=0) call abort_ice(subname//' Out of Memory3') - allocate( & - kaer_tab(icepack_nspint,max_aero), & ! aerosol mass extinction cross section (m2/kg) - waer_tab(icepack_nspint,max_aero), & ! aerosol single scatter albedo (fraction) - gaer_tab(icepack_nspint,max_aero), & ! aerosol asymmetry parameter (cos(theta)) - kaer_bc_tab(icepack_nspint,nmodal1), & ! BC mass extinction cross section (m2/kg) - waer_bc_tab(icepack_nspint,nmodal1), & ! BC single scatter albedo (fraction) - gaer_bc_tab(icepack_nspint,nmodal1), & ! BC aerosol asymmetry parameter (cos(theta)) - bcenh(icepack_nspint,nmodal1,nmodal2), & ! BC absorption enhancement factor - stat=ierr) - if (ierr/=0) call abort_ice(subname//' Out of Memory4') - ! floe size distribution allocate( & floe_rad_l (nfsd) , & ! fsd size lower bound in m (radius) diff --git a/cicecore/shared/ice_init_column.F90 b/cicecore/shared/ice_init_column.F90 index 5b25dc165..22cd3184a 100644 --- a/cicecore/shared/ice_init_column.F90 +++ b/cicecore/shared/ice_init_column.F90 @@ -184,7 +184,6 @@ subroutine init_shortwave albsnon, alvdrn, alidrn, alvdfn, alidfn, fswsfcn, & fswthrun, fswthrun_vdr, fswthrun_vdf, fswthrun_idr, fswthrun_idf, & fswintn, albpndn, apeffn, trcrn_sw, dhsn, ffracn, snowfracn, & - kaer_tab, waer_tab, gaer_tab, kaer_bc_tab, waer_bc_tab, gaer_bc_tab, bcenh, & swgrid, igrid use ice_blocks, only: block, get_block use ice_calendar, only: dt, calendar_type, & @@ -320,7 +319,7 @@ subroutine init_shortwave do j = jlo, jhi do i = ilo, ihi - if (trim(shortwave) == 'dEdd') then ! delta Eddington + if (shortwave(1:4) == 'dEdd') then ! delta Eddington #ifndef CESMCOUPLED ! initialize orbital parameters @@ -345,9 +344,7 @@ subroutine init_shortwave enddo if (tmask(i,j,iblk)) then - call icepack_step_radiation (dt=dt, ncat=ncat, & - nblyr=nblyr, nilyr=nilyr, nslyr=nslyr, & - dEdd_algae=dEdd_algae, & + call icepack_step_radiation (dt=dt, & swgrid=swgrid(:), igrid=igrid(:), & fbri=fbri(:), & aicen=aicen(i,j,:,iblk), & @@ -367,11 +364,6 @@ subroutine init_shortwave days_per_year=days_per_year, & nextsw_cday=nextsw_cday, yday=yday, & sec=msec, & - kaer_tab=kaer_tab, kaer_bc_tab=kaer_bc_tab(:,:), & - waer_tab=waer_tab, waer_bc_tab=waer_bc_tab(:,:), & - gaer_tab=gaer_tab, gaer_bc_tab=gaer_bc_tab(:,:), & - bcenh=bcenh(:,:,:), & - modal_aero=modal_aero, & swvdr=swvdr(i,j,iblk), swvdf=swvdf(i,j,iblk),& swidr=swidr(i,j,iblk), swidf=swidf(i,j,iblk),& coszen=coszen(i,j,iblk), fsnow=fsnow(i,j,iblk),& @@ -965,7 +957,7 @@ end subroutine init_hbrine subroutine input_zbgc - use ice_arrays_column, only: restore_bgc, optics_file, optics_file_fieldname + use ice_arrays_column, only: restore_bgc use ice_broadcast, only: broadcast_scalar use ice_restart_column, only: restart_bgc, restart_hbrine use ice_restart_shared, only: restart @@ -1007,7 +999,7 @@ subroutine input_zbgc restore_bgc, restart_bgc, scale_bgc, solve_zsal, restart_zsal, & tr_bgc_Nit, tr_bgc_C, tr_bgc_chl, tr_bgc_Am, tr_bgc_Sil, & tr_bgc_DMS, tr_bgc_PON, tr_bgc_hum, tr_bgc_DON, tr_bgc_Fe, & - grid_o, grid_o_t, l_sk, grid_oS, optics_file, optics_file_fieldname, & + grid_o, grid_o_t, l_sk, grid_oS, & l_skS, phi_snow, initbio_frac, frazil_scav, & ratio_Si2N_diatoms , ratio_Si2N_sp , ratio_Si2N_phaeo , & ratio_S2N_diatoms , ratio_S2N_sp , ratio_S2N_phaeo , & @@ -1064,8 +1056,6 @@ subroutine input_zbgc tr_brine = .false. ! brine height differs from ice height tr_zaero = .false. ! z aerosol tracers modal_aero = .false. ! use modal aerosol treatment of aerosols - optics_file = 'unknown_optics_file' ! modal aerosol optics file - optics_file_fieldname = 'unknown_optics_fieldname' ! modal aerosol optics file fieldname restore_bgc = .false. ! restore bgc if true solve_zsal = .false. ! update salinity tracer profile from solve_S_dt restart_bgc = .false. ! biogeochemistry restart @@ -1283,8 +1273,6 @@ subroutine input_zbgc call broadcast_scalar(tr_zaero, master_task) call broadcast_scalar(dEdd_algae, master_task) call broadcast_scalar(modal_aero, master_task) - call broadcast_scalar(optics_file, master_task) - call broadcast_scalar(optics_file_fieldname, master_task) call broadcast_scalar(grid_o, master_task) call broadcast_scalar(grid_o_t, master_task) call broadcast_scalar(l_sk, master_task) @@ -1464,9 +1452,9 @@ subroutine input_zbgc abort_flag = 107 endif - if (dEdd_algae .AND. trim(shortwave) /= 'dEdd') then + if (dEdd_algae .AND. shortwave(1:4) /= 'dEdd') then if (my_task == master_task) then - write(nu_diag,*) subname,' ERROR: dEdd_algae = T but shortwave /= dEdd' + write(nu_diag,*) subname,' ERROR: dEdd_algae = T but shortwave /= dEdd or dEdd_snicar_ad' endif abort_flag = 108 endif @@ -1485,9 +1473,9 @@ subroutine input_zbgc abort_flag = 110 endif - if (modal_aero .AND. trim(shortwave) /= 'dEdd') then + if (modal_aero .AND. shortwave(1:4) /= 'dEdd') then if (my_task == master_task) then - write(nu_diag,*) subname,' ERROR: modal_aero = T but shortwave /= dEdd' + write(nu_diag,*) subname,' ERROR: modal_aero = T but shortwave /= dEdd or dEdd_snicar_ad' endif abort_flag = 111 endif @@ -1643,8 +1631,6 @@ subroutine input_zbgc write(nu_diag,1010) ' solve_zbgc = ', solve_zbgc write(nu_diag,1010) ' tr_zaero = ', tr_zaero write(nu_diag,1020) ' number of aerosols = ', n_zaero - write(nu_diag,1031) ' optics_file = ', trim(optics_file) - write(nu_diag,1031) ' optics_file_fieldname = ', trim(optics_file_fieldname) ! bio parameters write(nu_diag,1000) ' grid_o = ', grid_o write(nu_diag,1000) ' grid_o_t = ', grid_o_t diff --git a/configuration/scripts/cice.build b/configuration/scripts/cice.build index 66b7b1321..775b5a364 100755 --- a/configuration/scripts/cice.build +++ b/configuration/scripts/cice.build @@ -124,6 +124,9 @@ else if (${ICE_IOTYPE} =~ pio*) then else set IODIR = io_binary endif +if (${ICE_SNICARHC} == 'true') then + setenv ICE_CPPDEFS "${ICE_CPPDEFS} -DUSE_SNICARHC" +endif ### List of source code directories (in order of importance). cat >! Filepath << EOF diff --git a/configuration/scripts/cice.settings b/configuration/scripts/cice.settings index 76ae6ad9e..ee4709940 100644 --- a/configuration/scripts/cice.settings +++ b/configuration/scripts/cice.settings @@ -44,6 +44,7 @@ setenv ICE_COMMDIR mpi if (${ICE_NTASKS} == 1) setenv ICE_COMMDIR serial ### Specialty code +setenv ICE_SNICARHC false # compile with big hardcoded snicar table setenv ICE_BLDDEBUG false # build debug flags setenv ICE_COVERAGE false # build coverage flags diff --git a/configuration/scripts/ice_in b/configuration/scripts/ice_in index 8fff799dc..93db4efbe 100644 --- a/configuration/scripts/ice_in +++ b/configuration/scripts/ice_in @@ -125,12 +125,14 @@ ktherm = 2 conduct = 'bubbly' ksno = 0.3d0 + hi_min = 0.01d0 a_rapid_mode = 0.5e-3 Rac_rapid_mode = 10.0 aspect_rapid_mode = 1.0 dSdt_slow_mode = -5.0e-8 phi_c_slow_mode = 0.05 phi_i_mushy = 0.85 + Tliquidus_max = -0.1d0 hfrazilmin = 0.05d0 floediam = 300.0d0 / @@ -187,6 +189,7 @@ &shortwave_nml shortwave = 'dEdd' + snw_ssp_table = 'test' albedo_type = 'ccsm3' albicev = 0.78 albicei = 0.36 @@ -309,8 +312,6 @@ restart_hbrine = .false. tr_zaero = .false. modal_aero = .false. - optics_file = 'ICE_MACHINE_INPUTDATA/CICE_data/forcing/snicar_optics_5bnd_snow_and_aerosols.nc' - optics_file_fieldname = 'modalBCabsorptionParameter5band' skl_bgc = .false. z_tracers = .false. dEdd_algae = .false. diff --git a/configuration/scripts/options/set_env.snicar b/configuration/scripts/options/set_env.snicar new file mode 100644 index 000000000..91c70cb4b --- /dev/null +++ b/configuration/scripts/options/set_env.snicar @@ -0,0 +1 @@ +setenv ICE_SNICARHC true diff --git a/configuration/scripts/options/set_nml.alt01 b/configuration/scripts/options/set_nml.alt01 index 6c2bf2159..a4d934421 100644 --- a/configuration/scripts/options/set_nml.alt01 +++ b/configuration/scripts/options/set_nml.alt01 @@ -22,4 +22,4 @@ albedo_type = 'constant' calc_Tsfc = .true. atm_data_type = 'default' highfreq = .true. -tfrz_option = 'minus1p8' +tfrz_option = 'constant' diff --git a/configuration/scripts/options/set_nml.alt04 b/configuration/scripts/options/set_nml.alt04 index a07f70e66..f58c05312 100644 --- a/configuration/scripts/options/set_nml.alt04 +++ b/configuration/scripts/options/set_nml.alt04 @@ -10,6 +10,7 @@ tr_pond_topo = .false. tr_pond_lvl = .true. tr_aero = .true. kitd = 0 +hi_min = 0.1d0 ktherm = 1 sw_redist = .true. sw_frac = 0.9d0 @@ -26,4 +27,4 @@ krdg_partic = 0 krdg_redist = 0 frzpnd = 'ccsm' natmiter = 20 -tfrz_option = 'linear_salt' +tfrz_option = 'linear_salt_old' diff --git a/configuration/scripts/options/set_nml.alt06 b/configuration/scripts/options/set_nml.alt06 index 911acf8eb..02a594fe5 100644 --- a/configuration/scripts/options/set_nml.alt06 +++ b/configuration/scripts/options/set_nml.alt06 @@ -2,4 +2,4 @@ ncat = 7 kcatbound = 3 nslyr = 3 ice_ic = 'internal' - +tfrz_option = 'mushy_old' diff --git a/configuration/scripts/options/set_nml.bgcskl b/configuration/scripts/options/set_nml.bgcskl index 0a136cb53..770f53724 100644 --- a/configuration/scripts/options/set_nml.bgcskl +++ b/configuration/scripts/options/set_nml.bgcskl @@ -24,3 +24,5 @@ tr_bgc_PON = .true. tr_bgc_hum = .true. tr_bgc_DON = .true. tr_bgc_Fe = .true. +tfrz_option = 'mushy_old' + diff --git a/configuration/scripts/options/set_nml.bgcsklclim b/configuration/scripts/options/set_nml.bgcsklclim index 8d0816f41..e100d57ce 100644 --- a/configuration/scripts/options/set_nml.bgcsklclim +++ b/configuration/scripts/options/set_nml.bgcsklclim @@ -27,3 +27,4 @@ tr_bgc_PON = .true. tr_bgc_hum = .true. tr_bgc_DON = .true. tr_bgc_Fe = .true. +tfrz_option = "mushy_old" diff --git a/configuration/scripts/options/set_nml.bgcz b/configuration/scripts/options/set_nml.bgcz index 379a2fd63..6d5257d1b 100644 --- a/configuration/scripts/options/set_nml.bgcz +++ b/configuration/scripts/options/set_nml.bgcz @@ -28,3 +28,4 @@ tr_bgc_DON = .true. tr_bgc_Fe = .true. # modal_aero = .true. # dEdd_algae = .true. +tfrz_option = 'mushy_old' diff --git a/configuration/scripts/options/set_nml.bgczclim b/configuration/scripts/options/set_nml.bgczclim index 9f1a08fc4..c5bb2f198 100644 --- a/configuration/scripts/options/set_nml.bgczclim +++ b/configuration/scripts/options/set_nml.bgczclim @@ -29,5 +29,6 @@ tr_bgc_PON = .true. tr_bgc_hum = .true. tr_bgc_DON = .true. tr_bgc_Fe = .true. +tfrz_option = "mushy_old" diff --git a/configuration/scripts/options/set_nml.bgczm b/configuration/scripts/options/set_nml.bgczm index 2644576cd..a80c17033 100644 --- a/configuration/scripts/options/set_nml.bgczm +++ b/configuration/scripts/options/set_nml.bgczm @@ -28,3 +28,4 @@ tr_bgc_DON = .true. tr_bgc_Fe = .true. modal_aero = .true. # dEdd_algae = .true. +tfrz_option = 'mushy_old' diff --git a/configuration/scripts/options/set_nml.boxadv b/configuration/scripts/options/set_nml.boxadv index ca05970e3..434ced169 100644 --- a/configuration/scripts/options/set_nml.boxadv +++ b/configuration/scripts/options/set_nml.boxadv @@ -24,4 +24,4 @@ krdg_partic = 0 krdg_redist = 0 shortwave = 'ccsm3' albedo_type = 'constant' - +tfrz_option = 'mushy_old' diff --git a/configuration/scripts/options/set_nml.boxchan1e b/configuration/scripts/options/set_nml.boxchan1e index 9e21cdab7..ebfa5c535 100644 --- a/configuration/scripts/options/set_nml.boxchan1e +++ b/configuration/scripts/options/set_nml.boxchan1e @@ -26,6 +26,7 @@ ice_data_dist = 'uniform' calc_strair = .false. rotate_wind = .false. restore_ice = .false. +tfrz_option = 'mushy_old' f_aice = 'd1' f_hi = 'd1' f_hs = 'd' diff --git a/configuration/scripts/options/set_nml.boxchan1n b/configuration/scripts/options/set_nml.boxchan1n index f24fee5fa..6e3613547 100644 --- a/configuration/scripts/options/set_nml.boxchan1n +++ b/configuration/scripts/options/set_nml.boxchan1n @@ -26,6 +26,7 @@ ice_data_dist = 'uniform' calc_strair = .false. rotate_wind = .false. restore_ice = .false. +tfrz_option = 'mushy_old' f_aice = 'd1' f_hi = 'd1' f_hs = 'd' diff --git a/configuration/scripts/options/set_nml.boxnodyn b/configuration/scripts/options/set_nml.boxnodyn index 71abfdaea..61210b5e9 100644 --- a/configuration/scripts/options/set_nml.boxnodyn +++ b/configuration/scripts/options/set_nml.boxnodyn @@ -43,6 +43,7 @@ tr_pond_lvl = .false. tr_aero = .false. kitd = 0 ktherm = 1 +hi_min = 0.1d0 kdyn = 1 revised_evp = .false. kstrength = 1 diff --git a/configuration/scripts/options/set_nml.e3sm b/configuration/scripts/options/set_nml.e3sm new file mode 100644 index 000000000..11f05cbe0 --- /dev/null +++ b/configuration/scripts/options/set_nml.e3sm @@ -0,0 +1,13 @@ +ice_ic = 'default' +nslyr = 5 +highfreq = .true. +natmiter = 10 +oceanmixed_ice = .false. +kcatbound = 0 +tr_FY = .true. +tr_snow = .true. +use_smliq_pnd = .true. +snwgrain = .true. +snwredist = 'ITDrdg' +rsnw_fall = 54.526 +rsnw_tmax = 2800.0 diff --git a/configuration/scripts/options/set_nml.e3smbgc b/configuration/scripts/options/set_nml.e3smbgc new file mode 100644 index 000000000..1be753486 --- /dev/null +++ b/configuration/scripts/options/set_nml.e3smbgc @@ -0,0 +1,74 @@ +nslyr = 5 +nblyr = 7 +n_aero = 1 +n_zaero = 3 +n_algae = 2 +n_doc = 3 +n_dic = 1 +n_don = 1 +n_fed = 1 +n_fep = 1 +ice_ic = 'default' +highfreq = .true. +natmiter = 10 +oceanmixed_ice = .false. +kcatbound = 0 +tr_FY = .true. +tr_snow = .true. +use_smliq_pnd = .true. +snwgrain = .true. +snwredist = 'ITDrdg' +rsnw_fall = 54.526 +rsnw_tmax = 2800.0 +tr_brine = .true. +tr_bgc_Nit = .true. +tr_bgc_Am = .true. +tr_bgc_Sil = .true. +tr_bgc_DON = .true. +tr_bgc_Fe = .true. +l_sk = 20.0 +initbio_frac = 1.0 +tau_min = 3600.0 +tau_max = 7776000.0 +algal_vel = 0.0000001 +alpha2max_low_diatoms = 0.3 +alpha2max_low_sp = 0.2 +alpha2max_low_phaeo = 0.17 +beta2max_diatoms = 0.001 +beta2max_sp = 0.001 +beta2max_phaeo = 0.04 +mu_max_sp = 0.41 +mu_max_phaeo = 0.63 +grow_Tdep_diatoms = 0.063 +grow_Tdep_sp = 0.063 +grow_Tdep_phaeo = 0.063 +fr_graze_diatoms = 0.19 +fr_graze_sp = 0.19 +fr_graze_phaeo = 0.19 +kn_bac_protein = 0.2 +f_don_Am_protein = 1.0 +f_doc_s = 0.5 +f_doc_l = 0.5 +fr_mort2min = 0.9 +fr_dFe = 0.9 +k_nitrif = 0.046 +fr_resp_s = 0.9 +y_sk_DMS = 0.7 +t_sk_conv = 5.0 +t_sk_ox = 12.0 +algaltype_sp = 0.0 +ammoniumtype = 0.0 +dmspdtype = 0.0 +humtype = 0.0 +doctype_s = 0.0 +doctype_l = 0.0 +dontype_protein = 0.0 +fedtype_1 = 0.0 +zaerotype_bc1 = 0.0 +zaerotype_bc2 = 0.0 +zaerotype_dust1 = 0.0 +zaerotype_dust2 = 0.0 +zaerotype_dust3 = 0.0 +zaerotype_dust4 = 0.0 +ratio_C2N_proteins = 5.0 + diff --git a/configuration/scripts/options/set_nml.snicar b/configuration/scripts/options/set_nml.snicar new file mode 100644 index 000000000..5fab713c4 --- /dev/null +++ b/configuration/scripts/options/set_nml.snicar @@ -0,0 +1,3 @@ + shortwave = 'dEdd_snicar_ad' + snw_ssp_table = 'snicar' + diff --git a/configuration/scripts/tests/e3sm_suite.ts b/configuration/scripts/tests/e3sm_suite.ts new file mode 100644 index 000000000..8e4cd05d7 --- /dev/null +++ b/configuration/scripts/tests/e3sm_suite.ts @@ -0,0 +1,6 @@ +# Test Grid PEs Sets BFB-compare +smoke gx3 8x2 diag1,run5day,e3sm +smoke gx3 1x1 diag1,run1day,e3smbgc +restart gbox128 8x1 diag1,e3sm +restart gx3 4x2 debug,diag1,e3smbgc +smoke gx3 4x1 diag1,run5day,thread,e3sm smoke_gx3_8x2_diag1_run5day diff --git a/doc/source/cice_index.rst b/doc/source/cice_index.rst index d4e187510..4a48d2a62 100644 --- a/doc/source/cice_index.rst +++ b/doc/source/cice_index.rst @@ -504,8 +504,6 @@ either Celsius or Kelvin units). Deprecated parameters are listed at the end. "ocn_data_type", "source of surface temperature, salinity data", "" "omega", "angular velocity of Earth", "7.292\ :math:`\times`\ 10\ :math:`^{-5}` rad/s" "opening", "rate of ice opening due to divergence and shear", "1/s" - "optics_file", "optics filename associated with modal aerosols", "" - "optics_file_fieldname", "optics file fieldname that is read", "" "**P**", "", "" "p001", "1/1000", "" "p01", "1/100", "" @@ -620,7 +618,7 @@ either Celsius or Kelvin units). Deprecated parameters are listed at the end. "shcoef", "transfer coefficient for sensible heat", "" "shear", "strain rate II component", "1/s" "shlat", "southern latitude of artificial mask edge", "30\ :math:`^\circ`\ N" - "shortwave", "flag for shortwave parameterization (‘ccsm3’ or ‘dEdd’)", "" + "shortwave", "flag for shortwave parameterization (‘ccsm3’ or ‘dEdd’ or 'dEdd_snicar_ad')", "" "sig1(2)", "principal stress components :math:`\sigma_{n,1}`, :math:`\sigma_{n,2}` (diagnostic)", "" "sigP", "internal ice pressure", "N/m" "sil", "silicate concentration", "mmol/m\ :math:`^3`" @@ -690,6 +688,7 @@ either Celsius or Kelvin units). Deprecated parameters are listed at the end. "Timelt", "melting temperature of ice top surface", "0. C" "Tinz", "Internal ice temperature", "C" "TLAT", "latitude of cell center", "radians" + "Tliquidus_max", "maximum liquidus temperature of mush", "0. C" "TLON", "longitude of cell center", "radians" "tmask", "land/boundary mask, thickness (T-cell)", "" "tmass", "total mass of ice and snow", "kg/m\ :math:`^2`" diff --git a/doc/source/user_guide/ug_case_settings.rst b/doc/source/user_guide/ug_case_settings.rst index 2df45acb0..16f6ebe6f 100644 --- a/doc/source/user_guide/ug_case_settings.rst +++ b/doc/source/user_guide/ug_case_settings.rst @@ -37,6 +37,7 @@ 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``" "USE_NETCDF", "Turns on netcdf code. This is normally on and is needed for released configurations. An older value, ncdf, is still supported" + "USE_SNICARHC", "Includes compilation of large dEdd hardcoded (HC) SNICAR table in Icepack" "","" "**Application Macros**", "" "CESMCOUPLED", "Turns on code changes for the CESM coupled application " @@ -121,6 +122,7 @@ can be modified as needed. "ICE_QUEUE", "string", "batch queue name", "set by cice.setup or by default" "ICE_THREADED", "true, false", "force threading in compile, will always compile threaded if ICE_NTHRDS :math:`> 1`", "false" "ICE_COMMDIR", "mpi, serial", "specify infrastructure comm version", "set by ICE_NTASKS" + "ICE_SNICARHC", "true, false", "turn on hardcoded (HC) SNICAR tables in Icepack", "false" "ICE_BLDDEBUG", "true, false", "turn on compile debug flags", "false" "ICE_COVERAGE", "true, false", "turn on code coverage flags", "false" @@ -400,6 +402,7 @@ thermo_nml "``dSdt_slow_mode``", "real", "slow drainage strength parameter m/s/K", "-1.5e-7" "``floediam``", "real", "effective floe diameter for lateral melt in m", "300.0" "``hfrazilmin``", "real", "min thickness of new frazil ice in m", "0.05" + "``hi_min``", "real", "minimum ice thickness in m", "0.01" "``kitd``", "``0``", "delta function ITD approximation", "1" "", "``1``", "linear remapping ITD approximation", "" "``ksno``", "real", "snow thermal conductivity", "0.3" @@ -409,6 +412,7 @@ thermo_nml "``phi_c_slow_mode``", ":math:`0<\phi_c < 1`", "critical liquid fraction", "0.05" "``phi_i_mushy``", ":math:`0<\phi_i < 1`", "solid fraction at lower boundary", "0.85" "``Rac_rapid_mode``", "real", "critical Rayleigh number", "10.0" + "``Tliquidus_max``", "real", "maximum liquidus temperature of mush (C)", "0.0" "", "", "", "" @@ -525,7 +529,10 @@ shortwave_nml "``R_pnd``", "real", "tuning parameter for ponded sea ice albedo from Delta-Eddington shortwave", "0.0" "``R_snw``", "real", "tuning parameter for snow (broadband albedo) from Delta-Eddington shortwave", "1.5" "``shortwave``", "``ccsm3``", "NCAR CCSM3 shortwave distribution method", "``ccsm3``" - "", "``dEdd``", "Delta-Eddington method", "" + "", "``dEdd``", "Delta-Eddington method (3-band)", "" + "", "``dEdd_snicar_ad``", "Delta-Eddington method with 5 band snow", "" + "``snw_ssp_table``", "``snicar``", "lookup table for `dEdd_snicar_ad`", "``test``" + "", "``test``", "reduced lookup table for `dEdd_snicar_ad` testing", "" "``sw_dtemp``", "real", "temperature difference from melt to start redistributing", "0.02" "``sw_frac``", "real", "fraction redistributed", "0.9" "``sw_redist``", "logical", "redistribute internal shortwave to surface", "``.false.``" @@ -676,7 +683,8 @@ forcing_nml "``rotate_wind``", "logical", "rotate wind from east/north to computation grid", "``.true.``" "``saltflux_option``", "``constant``", "computed using ice_ref_salinity", "``constant``" "", "``prognostic``", "computed using prognostic salinity", "" - "``tfrz_option``", "``linear_salt``", "linear function of salinity (ktherm=1)", "``mushy``" + "``tfrz_option``","``constant``", "constant ocean freezing temperature (Tocnfrz)","``mushy``" + "", "``linear_salt``", "linear function of salinity (ktherm=1)", "", "``minus1p8``", "constant ocean freezing temperature (:math:`-1.8^{\circ} C`)", "" "", "``mushy``", "matches mushy-layer thermo (ktherm=2)", "" "``trestore``", "integer", "sst restoring time scale (days)", "90" @@ -786,8 +794,6 @@ zbgc_nml "``mu_max_phaeo``", "real", "maximum growth rate phaeocystis per day", "0.851" "``mu_max_sp``", "real", "maximum growth rate small plankton per day", "0.851" "``nitratetype``", "real", "mobility type between stationary and mobile nitrate", "-1.0" - "``optics_file``", "string", "optics file associated with modal aerosols", "unknown_optics_file" - "``optics_file_fieldname``", "string", "optics file fieldname to read", "unknown_optics_fieldname" "``op_dep_min``", "real", "light attenuates for optical depths exceeding min", "0.1" "``phi_snow``", "real", "snow porosity for brine height tracer", "0.5" "``ratio_chl2N_diatoms``", "real", "algal chl to N in mg/mmol diatoms", "2.1" diff --git a/icepack b/icepack index b2bd1a4e6..8fad768ce 160000 --- a/icepack +++ b/icepack @@ -1 +1 @@ -Subproject commit b2bd1a4e665e7f98f71c46c03903d60db14a59cb +Subproject commit 8fad768ce400536904f376376e91c698a82882ba From 276563041ea6a2b6b4c70cbfa5173fb85db7b47f Mon Sep 17 00:00:00 2001 From: Tony Craig Date: Thu, 12 Oct 2023 12:41:17 -0700 Subject: [PATCH 26/76] Add perlmutter gnu, intel, cray port (#882) --- configuration/scripts/cice.batch.csh | 17 ++++++ configuration/scripts/cice.launch.csh | 5 +- .../scripts/machines/Macros.perlmutter_cray | 56 ++++++++++++++++++ .../scripts/machines/Macros.perlmutter_gnu | 57 +++++++++++++++++++ .../scripts/machines/Macros.perlmutter_intel | 57 +++++++++++++++++++ .../scripts/machines/env.perlmutter_cray | 51 +++++++++++++++++ .../scripts/machines/env.perlmutter_gnu | 51 +++++++++++++++++ .../scripts/machines/env.perlmutter_intel | 51 +++++++++++++++++ 8 files changed, 343 insertions(+), 2 deletions(-) create mode 100644 configuration/scripts/machines/Macros.perlmutter_cray create mode 100644 configuration/scripts/machines/Macros.perlmutter_gnu create mode 100644 configuration/scripts/machines/Macros.perlmutter_intel create mode 100644 configuration/scripts/machines/env.perlmutter_cray create mode 100644 configuration/scripts/machines/env.perlmutter_gnu create mode 100644 configuration/scripts/machines/env.perlmutter_intel diff --git a/configuration/scripts/cice.batch.csh b/configuration/scripts/cice.batch.csh index 263b16d02..33b27cbf8 100755 --- a/configuration/scripts/cice.batch.csh +++ b/configuration/scripts/cice.batch.csh @@ -168,6 +168,23 @@ cat >> ${jobfile} << EOFB ###SBATCH --mail-user username@domain.com EOFB +else if (${ICE_MACHINE} =~ perlmutter*) then +@ nthrds2 = ${nthrds} * 2 +cat >> ${jobfile} << EOFB +#SBATCH -J ${ICE_CASENAME} +#SBATCH -A ${acct} +#SBATCH --qos=${queue} +#SBATCH --time=${batchtime} +#SBATCH --nodes=${nnodes} +#SBATCH --ntasks=${ntasks} +#SBATCH --cpus-per-task=${nthrds2} +#SBATCH --constraint cpu +###SBATCH -e filename +###SBATCH -o filename +###SBATCH --mail-type FAIL +###SBATCH --mail-user username@domain.com +EOFB + else if (${ICE_MACHINE} =~ compy*) then if (${runlength} <= 2) set queue = "short" cat >> ${jobfile} <&! \$ICE_RUNLO EOFR #======= -else if (${ICE_MACHCOMP} =~ cori*) then +else if (${ICE_MACHCOMP} =~ cori* || ${ICE_MACHCOMP} =~ perlmutter*) then if (${ICE_COMMDIR} =~ serial*) then cat >> ${jobfile} << EOFR -./cice >&! \$ICE_RUNLOG_FILE +#./cice >&! \$ICE_RUNLOG_FILE +srun --cpu-bind=cores ./cice >&! \$ICE_RUNLOG_FILE EOFR else cat >> ${jobfile} << EOFR diff --git a/configuration/scripts/machines/Macros.perlmutter_cray b/configuration/scripts/machines/Macros.perlmutter_cray new file mode 100644 index 000000000..cc4132fa9 --- /dev/null +++ b/configuration/scripts/machines/Macros.perlmutter_cray @@ -0,0 +1,56 @@ +#============================================================================== +# Macros file for NERSC perlmutter, cray compiler +#============================================================================== + +CPP := ftn -e P +CPPDEFS := -DFORTRANUNDERSCORE -DNO_R16 ${ICE_CPPDEFS} +CFLAGS := -c -O2 + +FIXEDFLAGS := -132 +FREEFLAGS := +FFLAGS := -hbyteswapio +FFLAGS_NOOPT:= -O0 +LDFLAGS := -hbyteswapio + +ifeq ($(ICE_BLDDEBUG), true) + FFLAGS += -O0 -hfp0 -g -Rbcdps -Ktrap=fp +else + FFLAGS += -O2 -hfp0 # -eo +endif + +SCC := cc +SFC := ftn +MPICC := cc +MPIFC := ftn + +ifeq ($(ICE_COMMDIR), mpi) + FC := $(MPIFC) + CC := $(MPICC) +else + FC := $(SFC) + CC := $(SCC) +endif +LD:= $(FC) + +# defined by module +#NETCDF_PATH := $(NETCDF) +#PNETCDF_PATH := $(PNETCDF) +#PNETCDF_PATH := /glade/apps/opt/pnetcdf/1.3.0/intel/default +#LAPACK_LIBDIR := /glade/apps/opt/lapack/3.4.2/intel/12.1.5/lib + +#PIO_CONFIG_OPTS:= --enable-filesystem-hints=gpfs + +INCLDIR := $(INCLDIR) +#INCLDIR += -I$(NETCDF_PATH)/include + +#LIB_NETCDF := $(NETCDF_PATH)/lib +#LIB_PNETCDF := $(PNETCDF_PATH)/lib +#LIB_MPI := $(IMPILIBDIR) +#SLIBS := -L$(LIB_NETCDF) -lnetcdf -lnetcdff + +ifeq ($(ICE_THREADED), true) + LDFLAGS += -fopenmp + CFLAGS += -fopenmp + FFLAGS += -fopenmp +endif + diff --git a/configuration/scripts/machines/Macros.perlmutter_gnu b/configuration/scripts/machines/Macros.perlmutter_gnu new file mode 100644 index 000000000..220d2dd80 --- /dev/null +++ b/configuration/scripts/machines/Macros.perlmutter_gnu @@ -0,0 +1,57 @@ +#============================================================================== +# Macros file for NERSC perlmutter, gnu compiler +#============================================================================== + +CPP := ftn -E +CPPDEFS := -DFORTRANUNDERSCORE ${ICE_CPPDEFS} +CFLAGS := -c + +FIXEDFLAGS := -ffixed-line-length-132 +FREEFLAGS := -ffree-form +FFLAGS := -fconvert=big-endian -fbacktrace -ffree-line-length-none -fallow-argument-mismatch +FFLAGS_NOOPT:= -O0 + +ifeq ($(ICE_BLDDEBUG), true) + FFLAGS += -O0 -g -fcheck=bounds -finit-real=nan -fimplicit-none -ffpe-trap=invalid,zero,overflow + CFLAGS += -O0 +else + FFLAGS += -O2 + CFLAGS += -O2 +endif + +SCC := cc +SFC := ftn +MPICC := cc +MPIFC := ftn + +ifeq ($(ICE_COMMDIR), mpi) + FC := $(MPIFC) + CC := $(MPICC) +else + FC := $(SFC) + CC := $(SCC) +endif +LD:= $(FC) + +# defined by module +#NETCDF_PATH := $(NETCDF) +#PNETCDF_PATH := $(PNETCDF) +#PNETCDF_PATH := /glade/apps/opt/pnetcdf/1.3.0/intel/default +#LAPACK_LIBDIR := /glade/apps/opt/lapack/3.4.2/intel/12.1.5/lib + +#PIO_CONFIG_OPTS:= --enable-filesystem-hints=gpfs + +INCLDIR := $(INCLDIR) +#INCLDIR += -I$(NETCDF_PATH)/include + +#LIB_NETCDF := $(NETCDF_PATH)/lib +#LIB_PNETCDF := $(PNETCDF_PATH)/lib +#LIB_MPI := $(IMPILIBDIR) +#SLIBS := -L$(LIB_NETCDF) -lnetcdf -lnetcdff + +ifeq ($(ICE_THREADED), true) + LDFLAGS += -fopenmp + CFLAGS += -fopenmp + FFLAGS += -fopenmp +endif + diff --git a/configuration/scripts/machines/Macros.perlmutter_intel b/configuration/scripts/machines/Macros.perlmutter_intel new file mode 100644 index 000000000..ce781be44 --- /dev/null +++ b/configuration/scripts/machines/Macros.perlmutter_intel @@ -0,0 +1,57 @@ +#============================================================================== +# Macros file for NERSC perlmutter, intel compiler +#============================================================================== + +CPP := fpp +CPPDEFS := -DFORTRANUNDERSCORE ${ICE_CPPDEFS} +CFLAGS := -c -O2 -fp-model precise -march=core-avx2 + +FIXEDFLAGS := -fixed -132 +FREEFLAGS := -free +FFLAGS := -fp-model precise -convert big_endian -assume byterecl -ftz -traceback -march=core-avx2 +FFLAGS_NOOPT:= -O0 + +ifeq ($(ICE_BLDDEBUG), true) + FFLAGS += -O0 -g -check uninit -check bounds -check pointers -fpe0 -check noarg_temp_created -link_mpi=dbg +# FFLAGS += -O0 -g -check all -fpe0 -ftrapuv -fp-model except -check noarg_temp_created -link_mpi=dbg -stand f08 +# FFLAGS += -O0 -g -check all -fpe0 -ftrapuv -fp-model except -check noarg_temp_created -init=snan,arrays -link_mpi=dbg +else + FFLAGS += -O2 +endif + +SCC := cc +SFC := ftn +MPICC := cc +MPIFC := ftn + +ifeq ($(ICE_COMMDIR), mpi) + FC := $(MPIFC) + CC := $(MPICC) +else + FC := $(SFC) + CC := $(SCC) +endif +LD:= $(FC) + +# defined by module +#NETCDF_PATH := $(NETCDF) +#PNETCDF_PATH := $(PNETCDF) +#PNETCDF_PATH := /glade/apps/opt/pnetcdf/1.3.0/intel/default +#LAPACK_LIBDIR := /glade/apps/opt/lapack/3.4.2/intel/12.1.5/lib + +#PIO_CONFIG_OPTS:= --enable-filesystem-hints=gpfs + +INCLDIR := $(INCLDIR) +#INCLDIR += -I$(NETCDF_PATH)/include + +#LIB_NETCDF := $(NETCDF_PATH)/lib +#LIB_PNETCDF := $(PNETCDF_PATH)/lib +#LIB_MPI := $(IMPILIBDIR) +#SLIBS := -L$(LIB_NETCDF) -lnetcdf -lnetcdff + +ifeq ($(ICE_THREADED), true) + LDFLAGS += -qopenmp + CFLAGS += -qopenmp + FFLAGS += -qopenmp +endif + diff --git a/configuration/scripts/machines/env.perlmutter_cray b/configuration/scripts/machines/env.perlmutter_cray new file mode 100644 index 000000000..04ee3ce94 --- /dev/null +++ b/configuration/scripts/machines/env.perlmutter_cray @@ -0,0 +1,51 @@ +#!/bin/csh -f + +set inp = "undefined" +if ($#argv == 1) then + set inp = $1 +endif + +if ("$inp" != "-nomodules") then + +source ${MODULESHOME}/init/csh + +#module unload PrgEnv-aocc +#module unload PrgEnv-cray +#module unload PrgEnv-gnu +#module unload PrgEnv-intel +#module unload PrgEnv-nvidia +#module unload gpu +module load cpu +module load PrgEnv-cray +module unload cce +module load cce/15.0.1 +module unload cray-mpich +module load cray-mpich/8.1.25 + +module unload cray-netcdf +module unload cray-hdf5 +module load cray-hdf5/1.12.2.3 +module load cray-netcdf/4.9.0.3 + +setenv NETCDF_PATH ${NETCDF_DIR} +limit coredumpsize unlimited +limit stacksize unlimited +setenv OMP_STACKSIZE 128M +setenv OMP_WAIT_POLICY PASSIVE + +endif + +setenv ICE_MACHINE_MACHNAME perlmutter +setenv ICE_MACHINE_MACHINFO "HPE Cray EX AMD EPYC 7763 Milan, Slingshot-11 Interconnect" +setenv ICE_MACHINE_ENVNAME cray +setenv ICE_MACHINE_ENVINFO "Cray clang/Fortran 15.0.1, cray-mpich/8.1.25, netcdf/4.9.0.3" +setenv ICE_MACHINE_MAKE gmake +setenv ICE_MACHINE_WKDIR $SCRATCH/CICE_RUNS +setenv ICE_MACHINE_INPUTDATA /global/cfs/cdirs/e3sm/tcraig/cice-consortium +setenv ICE_MACHINE_BASELINE $SCRATCH/CICE_BASELINE +setenv ICE_MACHINE_SUBMIT "sbatch" +setenv ICE_MACHINE_ACCT P00000000 +setenv ICE_MACHINE_QUEUE "regular" +setenv ICE_MACHINE_TPNODE 128 +setenv ICE_MACHINE_BLDTHRDS 8 +setenv ICE_MACHINE_QSTAT "squeue --jobs= " diff --git a/configuration/scripts/machines/env.perlmutter_gnu b/configuration/scripts/machines/env.perlmutter_gnu new file mode 100644 index 000000000..42e510e55 --- /dev/null +++ b/configuration/scripts/machines/env.perlmutter_gnu @@ -0,0 +1,51 @@ +#!/bin/csh -f + +set inp = "undefined" +if ($#argv == 1) then + set inp = $1 +endif + +if ("$inp" != "-nomodules") then + +source ${MODULESHOME}/init/csh + +#module unload PrgEnv-aocc +#module unload PrgEnv-cray +#module unload PrgEnv-gnu +#module unload PrgEnv-intel +#module unload PrgEnv-nvidia +#module unload gpu +module load cpu +module load PrgEnv-gnu +module unload gcc +module load gcc/11.2.0 +module unload cray-mpich +module load cray-mpich/8.1.25 + +module unload cray-netcdf +module unload cray-hdf5 +module load cray-hdf5/1.12.2.3 +module load cray-netcdf/4.9.0.3 + +setenv NETCDF_PATH ${NETCDF_DIR} +limit coredumpsize unlimited +limit stacksize unlimited +setenv OMP_STACKSIZE 128M +setenv OMP_WAIT_POLICY PASSIVE + +endif + +setenv ICE_MACHINE_MACHNAME perlmutter +setenv ICE_MACHINE_MACHINFO "HPE Cray EX AMD EPYC 7763 Milan, Slingshot-11 Interconnect" +setenv ICE_MACHINE_ENVNAME gnu +setenv ICE_MACHINE_ENVINFO "gnu c/fortran 11.2.0 20210728, cray-mpich/8.1.25, netcdf/4.9.0.3" +setenv ICE_MACHINE_MAKE gmake +setenv ICE_MACHINE_WKDIR $SCRATCH/CICE_RUNS +setenv ICE_MACHINE_INPUTDATA /global/cfs/cdirs/e3sm/tcraig/cice-consortium +setenv ICE_MACHINE_BASELINE $SCRATCH/CICE_BASELINE +setenv ICE_MACHINE_SUBMIT "sbatch" +setenv ICE_MACHINE_ACCT P00000000 +setenv ICE_MACHINE_QUEUE "regular" +setenv ICE_MACHINE_TPNODE 128 +setenv ICE_MACHINE_BLDTHRDS 8 +setenv ICE_MACHINE_QSTAT "squeue --jobs= " diff --git a/configuration/scripts/machines/env.perlmutter_intel b/configuration/scripts/machines/env.perlmutter_intel new file mode 100644 index 000000000..7ecdc0f96 --- /dev/null +++ b/configuration/scripts/machines/env.perlmutter_intel @@ -0,0 +1,51 @@ +#!/bin/csh -f + +set inp = "undefined" +if ($#argv == 1) then + set inp = $1 +endif + +if ("$inp" != "-nomodules") then + +source ${MODULESHOME}/init/csh + +#module unload PrgEnv-aocc +#module unload PrgEnv-cray +#module unload PrgEnv-gnu +#module unload PrgEnv-intel +#module unload PrgEnv-nvidia +#module unload gpu +module load cpu +module load PrgEnv-intel +module unload intel +module load intel/2023.1.0 +module unload cray-mpich +module load cray-mpich/8.1.25 + +module unload cray-netcdf +module unload cray-hdf5 +module load cray-hdf5/1.12.2.3 +module load cray-netcdf/4.9.0.3 + +setenv NETCDF_PATH ${NETCDF_DIR} +limit coredumpsize unlimited +limit stacksize unlimited +setenv OMP_STACKSIZE 128M +setenv OMP_WAIT_POLICY PASSIVE + +endif + +setenv ICE_MACHINE_MACHNAME perlmutter +setenv ICE_MACHINE_MACHINFO "HPE Cray EX AMD EPYC 7763 Milan, Slingshot-11 Interconnect" +setenv ICE_MACHINE_ENVNAME intel +setenv ICE_MACHINE_ENVINFO "ifort 2021.9.0 20230302, Intel oneAPI DPC++/C++ 2023.1.0 (2023.1.0.20230320), cray-mpich/8.1.25, netcdf/4.9.0.3" +setenv ICE_MACHINE_MAKE gmake +setenv ICE_MACHINE_WKDIR $SCRATCH/CICE_RUNS +setenv ICE_MACHINE_INPUTDATA /global/cfs/cdirs/e3sm/tcraig/cice-consortium +setenv ICE_MACHINE_BASELINE $SCRATCH/CICE_BASELINE +setenv ICE_MACHINE_SUBMIT "sbatch" +setenv ICE_MACHINE_ACCT P00000000 +setenv ICE_MACHINE_QUEUE "regular" +setenv ICE_MACHINE_TPNODE 128 +setenv ICE_MACHINE_BLDTHRDS 8 +setenv ICE_MACHINE_QSTAT "squeue --jobs= " From 48a92ef6dd6bf7884ec8a16b2c082345accae385 Mon Sep 17 00:00:00 2001 From: Tony Craig Date: Fri, 13 Oct 2023 14:22:03 -0700 Subject: [PATCH 27/76] 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. --- cicecore/cicedyn/general/ice_init.F90 | 18 ++++++++---------- configuration/scripts/options/set_nml.alt04 | 2 +- configuration/scripts/options/set_nml.alt06 | 2 +- configuration/scripts/options/set_nml.bgcskl | 2 +- .../scripts/options/set_nml.bgcsklclim | 2 +- configuration/scripts/options/set_nml.bgcz | 2 +- configuration/scripts/options/set_nml.bgczclim | 2 +- configuration/scripts/options/set_nml.bgczm | 2 +- configuration/scripts/options/set_nml.boxadv | 2 +- .../scripts/options/set_nml.boxchan1e | 2 +- .../scripts/options/set_nml.boxchan1n | 2 +- configuration/scripts/tests/baseline.script | 4 ++-- configuration/scripts/tests/omp_suite.ts | 2 -- 13 files changed, 20 insertions(+), 24 deletions(-) diff --git a/cicecore/cicedyn/general/ice_init.F90 b/cicecore/cicedyn/general/ice_init.F90 index ff952629e..9d21b84fc 100644 --- a/cicecore/cicedyn/general/ice_init.F90 +++ b/cicecore/cicedyn/general/ice_init.F90 @@ -1510,15 +1510,14 @@ subroutine input_data abort_list = trim(abort_list)//":13" endif -! tcraig, is it really OK for users to run inconsistently? -! ech: yes, for testing sensitivities. It's not recommended for science runs - if (ktherm == 1 .and. trim(tfrz_option(1:11)) /= 'linear_salt') then +! ech: allow inconsistency for testing sensitivities. It's not recommended for science runs + if (ktherm == 1 .and. trim(tfrz_option) /= 'linear_salt') then if (my_task == master_task) then write(nu_diag,*) subname//' WARNING: ktherm = 1 and tfrz_option = ',trim(tfrz_option) write(nu_diag,*) subname//' WARNING: For consistency, set tfrz_option = linear_salt' endif endif - if (ktherm == 2 .and. trim(tfrz_option(1:5)) /= 'mushy') then + if (ktherm == 2 .and. trim(tfrz_option) /= 'mushy') then if (my_task == master_task) then write(nu_diag,*) subname//' WARNING: ktherm = 2 and tfrz_option = ',trim(tfrz_option) write(nu_diag,*) subname//' WARNING: For consistency, set tfrz_option = mushy' @@ -1530,7 +1529,6 @@ subroutine input_data write(nu_diag,*) subname//' WARNING: For consistency, set saltflux_option = constant' endif endif -!tcraig if (ktherm == 1 .and. .not.sw_redist) then if (my_task == master_task) then write(nu_diag,*) subname//' WARNING: ktherm = 1 and sw_redist = ',sw_redist @@ -2104,19 +2102,19 @@ subroutine input_data if (trim(saltflux_option) == 'constant') then write(nu_diag,1002) ' ice_ref_salinity = ',ice_ref_salinity endif - if (trim(tfrz_option(1:8)) == 'constant') then + if (trim(tfrz_option) == 'constant') then tmpstr2 = ' : constant ocean freezing temperature (Tocnfrz)' - elseif (trim(tfrz_option(1:8)) == 'minus1p8') then + elseif (trim(tfrz_option) == 'minus1p8') then tmpstr2 = ' : constant ocean freezing temperature (-1.8C) (to be deprecated)' - elseif (trim(tfrz_option(1:11)) == 'linear_salt') then + elseif (trim(tfrz_option) == 'linear_salt') then tmpstr2 = ' : linear function of salinity (use with ktherm=1)' - elseif (trim(tfrz_option(1:5)) == 'mushy') then + elseif (trim(tfrz_option) == 'mushy') then tmpstr2 = ' : Assur (1958) as in mushy-layer thermo (ktherm=2)' else tmpstr2 = ' : unknown value' endif write(nu_diag,1030) ' tfrz_option = ', trim(tfrz_option),trim(tmpstr2) - if (trim(tfrz_option(1:8)) == 'constant') then + if (trim(tfrz_option) == 'constant') then write(nu_diag,1002) ' Tocnfrz = ', Tocnfrz endif if (update_ocn_f) then diff --git a/configuration/scripts/options/set_nml.alt04 b/configuration/scripts/options/set_nml.alt04 index f58c05312..273f7d87d 100644 --- a/configuration/scripts/options/set_nml.alt04 +++ b/configuration/scripts/options/set_nml.alt04 @@ -27,4 +27,4 @@ krdg_partic = 0 krdg_redist = 0 frzpnd = 'ccsm' natmiter = 20 -tfrz_option = 'linear_salt_old' +tfrz_option = 'linear_salt' diff --git a/configuration/scripts/options/set_nml.alt06 b/configuration/scripts/options/set_nml.alt06 index 02a594fe5..01657cede 100644 --- a/configuration/scripts/options/set_nml.alt06 +++ b/configuration/scripts/options/set_nml.alt06 @@ -2,4 +2,4 @@ ncat = 7 kcatbound = 3 nslyr = 3 ice_ic = 'internal' -tfrz_option = 'mushy_old' +tfrz_option = 'mushy' diff --git a/configuration/scripts/options/set_nml.bgcskl b/configuration/scripts/options/set_nml.bgcskl index 770f53724..91e0af6bd 100644 --- a/configuration/scripts/options/set_nml.bgcskl +++ b/configuration/scripts/options/set_nml.bgcskl @@ -24,5 +24,5 @@ tr_bgc_PON = .true. tr_bgc_hum = .true. tr_bgc_DON = .true. tr_bgc_Fe = .true. -tfrz_option = 'mushy_old' +tfrz_option = 'mushy' diff --git a/configuration/scripts/options/set_nml.bgcsklclim b/configuration/scripts/options/set_nml.bgcsklclim index e100d57ce..c71c7bca4 100644 --- a/configuration/scripts/options/set_nml.bgcsklclim +++ b/configuration/scripts/options/set_nml.bgcsklclim @@ -27,4 +27,4 @@ tr_bgc_PON = .true. tr_bgc_hum = .true. tr_bgc_DON = .true. tr_bgc_Fe = .true. -tfrz_option = "mushy_old" +tfrz_option = "mushy" diff --git a/configuration/scripts/options/set_nml.bgcz b/configuration/scripts/options/set_nml.bgcz index 6d5257d1b..46e4dee74 100644 --- a/configuration/scripts/options/set_nml.bgcz +++ b/configuration/scripts/options/set_nml.bgcz @@ -28,4 +28,4 @@ tr_bgc_DON = .true. tr_bgc_Fe = .true. # modal_aero = .true. # dEdd_algae = .true. -tfrz_option = 'mushy_old' +tfrz_option = 'mushy' diff --git a/configuration/scripts/options/set_nml.bgczclim b/configuration/scripts/options/set_nml.bgczclim index c5bb2f198..feb900ede 100644 --- a/configuration/scripts/options/set_nml.bgczclim +++ b/configuration/scripts/options/set_nml.bgczclim @@ -29,6 +29,6 @@ tr_bgc_PON = .true. tr_bgc_hum = .true. tr_bgc_DON = .true. tr_bgc_Fe = .true. -tfrz_option = "mushy_old" +tfrz_option = "mushy" diff --git a/configuration/scripts/options/set_nml.bgczm b/configuration/scripts/options/set_nml.bgczm index a80c17033..53513ca87 100644 --- a/configuration/scripts/options/set_nml.bgczm +++ b/configuration/scripts/options/set_nml.bgczm @@ -28,4 +28,4 @@ tr_bgc_DON = .true. tr_bgc_Fe = .true. modal_aero = .true. # dEdd_algae = .true. -tfrz_option = 'mushy_old' +tfrz_option = 'mushy' diff --git a/configuration/scripts/options/set_nml.boxadv b/configuration/scripts/options/set_nml.boxadv index 434ced169..933099029 100644 --- a/configuration/scripts/options/set_nml.boxadv +++ b/configuration/scripts/options/set_nml.boxadv @@ -24,4 +24,4 @@ krdg_partic = 0 krdg_redist = 0 shortwave = 'ccsm3' albedo_type = 'constant' -tfrz_option = 'mushy_old' +tfrz_option = 'mushy' diff --git a/configuration/scripts/options/set_nml.boxchan1e b/configuration/scripts/options/set_nml.boxchan1e index ebfa5c535..cf8b0d314 100644 --- a/configuration/scripts/options/set_nml.boxchan1e +++ b/configuration/scripts/options/set_nml.boxchan1e @@ -26,7 +26,7 @@ ice_data_dist = 'uniform' calc_strair = .false. rotate_wind = .false. restore_ice = .false. -tfrz_option = 'mushy_old' +tfrz_option = 'mushy' f_aice = 'd1' f_hi = 'd1' f_hs = 'd' diff --git a/configuration/scripts/options/set_nml.boxchan1n b/configuration/scripts/options/set_nml.boxchan1n index 6e3613547..f90d4da0c 100644 --- a/configuration/scripts/options/set_nml.boxchan1n +++ b/configuration/scripts/options/set_nml.boxchan1n @@ -26,7 +26,7 @@ ice_data_dist = 'uniform' calc_strair = .false. rotate_wind = .false. restore_ice = .false. -tfrz_option = 'mushy_old' +tfrz_option = 'mushy' f_aice = 'd1' f_hi = 'd1' f_hs = 'd' diff --git a/configuration/scripts/tests/baseline.script b/configuration/scripts/tests/baseline.script index a24236c9e..9fd2fe001 100644 --- a/configuration/scripts/tests/baseline.script +++ b/configuration/scripts/tests/baseline.script @@ -146,9 +146,9 @@ if (${ICE_BFBCOMP} != ${ICE_SPVAL}) then @ cnt = $cnt + 1 echo "Waiting for $job to complete $cnt" sleep 60 # Sleep for 1 minute, so as not to overwhelm the queue manager - if ($cnt > 100) then + if ($cnt > 30) then echo "No longer waiting for $job to complete" - set qstatjob = 0 # Abandon check after 100 sleep 60 checks + set qstatjob = 0 # Abandon check after cnt sleep 60 checks endif endif # echo $qstatjob diff --git a/configuration/scripts/tests/omp_suite.ts b/configuration/scripts/tests/omp_suite.ts index 62630e874..57effbe75 100644 --- a/configuration/scripts/tests/omp_suite.ts +++ b/configuration/scripts/tests/omp_suite.ts @@ -78,8 +78,6 @@ smoke gbox128 14x2 boxrestore,reprosum,run10day,gridcd smoke gbox80 4x5 box2001,reprosum,run10day,gridcd smoke gbox80 11x3 boxslotcyl,reprosum,run10day,gridcd -sleep 180 - #gridB smoke gx3 4x2 diag1,reprosum,run10day,cmplogrest smoke_gx3_8x4_diag1_reprosum_run10day From 96b43fb458fe00696d9532e547a3c5bff113f9f9 Mon Sep 17 00:00:00 2001 From: Tony Craig Date: Wed, 18 Oct 2023 10:46:25 -0700 Subject: [PATCH 28/76] Update Icepack CPP USE_SNICARHC to NO_SNICARHC and update logic (#886) Update Icepack to version #0c548120ce44382 Oct 16, 2023 includes NO_SNICARHC --- configuration/scripts/cice.build | 4 ++-- doc/source/user_guide/ug_case_settings.rst | 2 +- icepack | 2 +- 3 files changed, 4 insertions(+), 4 deletions(-) diff --git a/configuration/scripts/cice.build b/configuration/scripts/cice.build index 775b5a364..33411158b 100755 --- a/configuration/scripts/cice.build +++ b/configuration/scripts/cice.build @@ -124,8 +124,8 @@ else if (${ICE_IOTYPE} =~ pio*) then else set IODIR = io_binary endif -if (${ICE_SNICARHC} == 'true') then - setenv ICE_CPPDEFS "${ICE_CPPDEFS} -DUSE_SNICARHC" +if (${ICE_SNICARHC} == 'false') then + setenv ICE_CPPDEFS "${ICE_CPPDEFS} -DNO_SNICARHC" endif ### List of source code directories (in order of importance). diff --git a/doc/source/user_guide/ug_case_settings.rst b/doc/source/user_guide/ug_case_settings.rst index 16f6ebe6f..09145eeab 100644 --- a/doc/source/user_guide/ug_case_settings.rst +++ b/doc/source/user_guide/ug_case_settings.rst @@ -36,8 +36,8 @@ can be found in :ref:`cicecpps`. The following CPPs are available. "NO_F2003", "Turns off some Fortran 2003 features" "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_SNICARHC", "Includes compilation of large dEdd hardcoded (HC) SNICAR table in Icepack" "","" "**Application Macros**", "" "CESMCOUPLED", "Turns on code changes for the CESM coupled application " diff --git a/icepack b/icepack index 8fad768ce..0c548120c 160000 --- a/icepack +++ b/icepack @@ -1 +1 @@ -Subproject commit 8fad768ce400536904f376376e91c698a82882ba +Subproject commit 0c548120ce443824241051196f5ba508cb7ba7db From 5ddb74dfb8724ff90aa7e806d5bfcfb4a0990762 Mon Sep 17 00:00:00 2001 From: Tony Craig Date: Wed, 18 Oct 2023 10:46:40 -0700 Subject: [PATCH 29/76] Remove cicedynB link (#887) Update documentation --- cicecore/cicedynB | 1 - doc/source/user_guide/ug_troubleshooting.rst | 3 --- 2 files changed, 4 deletions(-) delete mode 120000 cicecore/cicedynB diff --git a/cicecore/cicedynB b/cicecore/cicedynB deleted file mode 120000 index 70695ca4b..000000000 --- a/cicecore/cicedynB +++ /dev/null @@ -1 +0,0 @@ -cicedyn \ No newline at end of file diff --git a/doc/source/user_guide/ug_troubleshooting.rst b/doc/source/user_guide/ug_troubleshooting.rst index 9d8c49a72..b5ed34bba 100644 --- a/doc/source/user_guide/ug_troubleshooting.rst +++ b/doc/source/user_guide/ug_troubleshooting.rst @@ -13,9 +13,6 @@ Directory Structure --------------------- In November, 2022, the cicedynB directory was renamed to cicedyn. -A soft link was temporarily added to preserve the ability to use -cicedynB as a path when compiling CICE in other build systems. This -soft link will be removed in the future. .. _setup: From a9d6dc75f47a2898f1800ad4ddd96c4992e3bed0 Mon Sep 17 00:00:00 2001 From: Tony Craig Date: Wed, 18 Oct 2023 10:47:01 -0700 Subject: [PATCH 30/76] Update input data area for Derecho, switch to campaign (#890) --- configuration/scripts/machines/env.derecho_cray | 2 +- configuration/scripts/machines/env.derecho_gnu | 2 +- configuration/scripts/machines/env.derecho_intel | 2 +- configuration/scripts/machines/env.derecho_intelclassic | 2 +- configuration/scripts/machines/env.derecho_inteloneapi | 2 +- configuration/scripts/machines/env.derecho_nvhpc | 2 +- 6 files changed, 6 insertions(+), 6 deletions(-) diff --git a/configuration/scripts/machines/env.derecho_cray b/configuration/scripts/machines/env.derecho_cray index 5c4542840..5294fbe95 100644 --- a/configuration/scripts/machines/env.derecho_cray +++ b/configuration/scripts/machines/env.derecho_cray @@ -62,7 +62,7 @@ setenv ICE_MACHINE_ENVNAME cray setenv ICE_MACHINE_ENVINFO "cce 15.0.1, cray-mpich 8.1.25, netcdf4.9.2, pnetcdf1.12.3, pio1.10.1, pio2.6.1" setenv ICE_MACHINE_MAKE gmake setenv ICE_MACHINE_WKDIR /glade/derecho/scratch/$user/CICE_RUNS -setenv ICE_MACHINE_INPUTDATA /glade/p/cesm/pcwg_dev +setenv ICE_MACHINE_INPUTDATA /glade/campaign/cesm/development/pcwg setenv ICE_MACHINE_BASELINE /glade/derecho/scratch/$user/CICE_BASELINE setenv ICE_MACHINE_SUBMIT "qsub" setenv ICE_MACHINE_ACCT P00000000 diff --git a/configuration/scripts/machines/env.derecho_gnu b/configuration/scripts/machines/env.derecho_gnu index d6378fa05..0f2d2ec87 100644 --- a/configuration/scripts/machines/env.derecho_gnu +++ b/configuration/scripts/machines/env.derecho_gnu @@ -62,7 +62,7 @@ setenv ICE_MACHINE_ENVNAME gnu setenv ICE_MACHINE_ENVINFO "gcc 12.2.0 20220819, cray-mpich 8.1.25, netcdf4.9.2, pnetcdf1.12.3, pio1.10.1, pio2.6.2" setenv ICE_MACHINE_MAKE gmake setenv ICE_MACHINE_WKDIR /glade/derecho/scratch/$user/CICE_RUNS -setenv ICE_MACHINE_INPUTDATA /glade/p/cesm/pcwg_dev +setenv ICE_MACHINE_INPUTDATA /glade/campaign/cesm/development/pcwg setenv ICE_MACHINE_BASELINE /glade/derecho/scratch/$user/CICE_BASELINE setenv ICE_MACHINE_SUBMIT "qsub" setenv ICE_MACHINE_ACCT P00000000 diff --git a/configuration/scripts/machines/env.derecho_intel b/configuration/scripts/machines/env.derecho_intel index 5c3e593d4..7c822c923 100644 --- a/configuration/scripts/machines/env.derecho_intel +++ b/configuration/scripts/machines/env.derecho_intel @@ -62,7 +62,7 @@ setenv ICE_MACHINE_ENVNAME intel setenv ICE_MACHINE_ENVINFO "ifort 2021.8.0 20221119, oneAPI DPC++/C++ 2023.0.0.20221201), cray-mpich 8.1.25, netcdf4.9.2, pnetcdf1.12.3, pio1.10.1, pio2.6.1" setenv ICE_MACHINE_MAKE gmake setenv ICE_MACHINE_WKDIR /glade/derecho/scratch/$user/CICE_RUNS -setenv ICE_MACHINE_INPUTDATA /glade/p/cesm/pcwg_dev +setenv ICE_MACHINE_INPUTDATA /glade/campaign/cesm/development/pcwg setenv ICE_MACHINE_BASELINE /glade/derecho/scratch/$user/CICE_BASELINE setenv ICE_MACHINE_SUBMIT "qsub" setenv ICE_MACHINE_ACCT P00000000 diff --git a/configuration/scripts/machines/env.derecho_intelclassic b/configuration/scripts/machines/env.derecho_intelclassic index 39b08e1bc..964f5e8bb 100644 --- a/configuration/scripts/machines/env.derecho_intelclassic +++ b/configuration/scripts/machines/env.derecho_intelclassic @@ -62,7 +62,7 @@ setenv ICE_MACHINE_ENVNAME intelclassic setenv ICE_MACHINE_ENVINFO "icc/ifort 2021.8.0 20221119, cray-mpich 8.1.25, netcdf4.9.2, pnetcdf1.12.3, pio1.10.1, pio2.6.2" setenv ICE_MACHINE_MAKE gmake setenv ICE_MACHINE_WKDIR /glade/derecho/scratch/$user/CICE_RUNS -setenv ICE_MACHINE_INPUTDATA /glade/p/cesm/pcwg_dev +setenv ICE_MACHINE_INPUTDATA /glade/campaign/cesm/development/pcwg setenv ICE_MACHINE_BASELINE /glade/derecho/scratch/$user/CICE_BASELINE setenv ICE_MACHINE_SUBMIT "qsub" setenv ICE_MACHINE_ACCT P00000000 diff --git a/configuration/scripts/machines/env.derecho_inteloneapi b/configuration/scripts/machines/env.derecho_inteloneapi index a4f173404..700830525 100644 --- a/configuration/scripts/machines/env.derecho_inteloneapi +++ b/configuration/scripts/machines/env.derecho_inteloneapi @@ -62,7 +62,7 @@ setenv ICE_MACHINE_ENVNAME inteloneapi setenv ICE_MACHINE_ENVINFO "ifx 2023.0.0 20221201, oneAPI DPC++/C++ 2023.0.0.20221201, cray-mpich 8.1.25, netcdf4.9.2, pnetcdf1.12.3, pio1.10.1, pio2.6.1" setenv ICE_MACHINE_MAKE gmake setenv ICE_MACHINE_WKDIR /glade/derecho/scratch/$user/CICE_RUNS -setenv ICE_MACHINE_INPUTDATA /glade/p/cesm/pcwg_dev +setenv ICE_MACHINE_INPUTDATA /glade/campaign/cesm/development/pcwg setenv ICE_MACHINE_BASELINE /glade/derecho/scratch/$user/CICE_BASELINE setenv ICE_MACHINE_SUBMIT "qsub" setenv ICE_MACHINE_ACCT P00000000 diff --git a/configuration/scripts/machines/env.derecho_nvhpc b/configuration/scripts/machines/env.derecho_nvhpc index 52702d4f7..f6bdf1138 100644 --- a/configuration/scripts/machines/env.derecho_nvhpc +++ b/configuration/scripts/machines/env.derecho_nvhpc @@ -62,7 +62,7 @@ setenv ICE_MACHINE_ENVNAME nvhpc setenv ICE_MACHINE_ENVINFO "nvc 23.5-0, cray-mpich 8.1.25, netcdf4.9.2, pnetcdf1.12.3, pio1.10.1, pio2.6.0" setenv ICE_MACHINE_MAKE gmake setenv ICE_MACHINE_WKDIR /glade/derecho/scratch/$user/CICE_RUNS -setenv ICE_MACHINE_INPUTDATA /glade/p/cesm/pcwg_dev +setenv ICE_MACHINE_INPUTDATA /glade/campaign/cesm/development/pcwg setenv ICE_MACHINE_BASELINE /glade/derecho/scratch/$user/CICE_BASELINE setenv ICE_MACHINE_SUBMIT "qsub" setenv ICE_MACHINE_ACCT P00000000 From 6ba070f7e7027f9fd2cc32f2dbe10c9854511d93 Mon Sep 17 00:00:00 2001 From: Tony Craig Date: Wed, 18 Oct 2023 12:35:08 -0700 Subject: [PATCH 31/76] Update Documentation to clarify Namelist Inputs (#888) * Update Documentation to clarify Namelist Inputs * Update documentation --- doc/source/cice_index.rst | 9 +++++---- doc/source/user_guide/ug_case_settings.rst | 6 +++--- 2 files changed, 8 insertions(+), 7 deletions(-) diff --git a/doc/source/cice_index.rst b/doc/source/cice_index.rst index 4a48d2a62..7878b2f5e 100644 --- a/doc/source/cice_index.rst +++ b/doc/source/cice_index.rst @@ -5,12 +5,13 @@ Index of primary variables and parameters ========================================== -This index defines many of the symbols used frequently in the CICE model -code. Namelist variables are partly included here but also documented -elsewhere, see Section :ref:`tabnamelist`. All -quantities in the code are expressed in MKS units (temperatures may take +This index defines many (but not all) of the symbols used frequently in the CICE model +code. All quantities in the code are expressed in MKS units (temperatures may take either Celsius or Kelvin units). Deprecated parameters are listed at the end. +Namelist variables are partly included here, but they are fully documented in +section :ref:`tabnamelist`. + .. csv-table:: *Alphabetical Index* :header: " ", " ", " " :widths: 15, 30, 15, 1 diff --git a/doc/source/user_guide/ug_case_settings.rst b/doc/source/user_guide/ug_case_settings.rst index 09145eeab..ebb33b65e 100644 --- a/doc/source/user_guide/ug_case_settings.rst +++ b/doc/source/user_guide/ug_case_settings.rst @@ -2,8 +2,8 @@ .. _case_settings: -Case Settings -===================== +Case Settings, Model Namelist, and CPPs +========================================== There are two important files that define the case, **cice.settings** and **ice_in**. **cice.settings** is a list of env variables that define many @@ -130,7 +130,7 @@ can be modified as needed. .. _tabnamelist: -Table of namelist options +Tables of Namelist Options ------------------------------- CICE reads a namelist input file, **ice_in**, consisting of several namelist groups. The tables below From 8916b9ff2c58a3a095235bb5b4ce7e8a68f76e87 Mon Sep 17 00:00:00 2001 From: Tony Craig Date: Wed, 18 Oct 2023 14:08:21 -0700 Subject: [PATCH 32/76] 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 --- cicecore/cicedyn/analysis/ice_diagnostics.F90 | 5 ++-- cicecore/cicedyn/analysis/ice_history.F90 | 28 +++++++++---------- cicecore/cicedyn/general/ice_flux.F90 | 6 ++-- cicecore/cicedyn/general/ice_init.F90 | 11 +++++--- cicecore/cicedyn/general/ice_step_mod.F90 | 3 +- doc/source/cice_index.rst | 1 + doc/source/user_guide/ug_case_settings.rst | 3 ++ 7 files changed, 32 insertions(+), 25 deletions(-) diff --git a/cicecore/cicedyn/analysis/ice_diagnostics.F90 b/cicecore/cicedyn/analysis/ice_diagnostics.F90 index 395cca98d..3a6ceb83d 100644 --- a/cicecore/cicedyn/analysis/ice_diagnostics.F90 +++ b/cicecore/cicedyn/analysis/ice_diagnostics.F90 @@ -123,7 +123,7 @@ subroutine runtime_diags (dt) use ice_flux, only: alvdr, alidr, alvdf, alidf, evap, fsnow, frazil, & fswabs, fswthru, flw, flwout, fsens, fsurf, flat, frzmlt_init, frain, fpond, & fhocn_ai, fsalt_ai, fresh_ai, frazil_diag, & - update_ocn_f, Tair, Qa, fsw, fcondtop, meltt, meltb, meltl, snoice, & + update_ocn_f, cpl_frazil, Tair, Qa, fsw, fcondtop, meltt, meltb, meltl, snoice, & dsnow, congel, sst, sss, Tf, fhocn, & swvdr, swvdf, swidr, swidf, & alvdr_init, alvdf_init, alidr_init, alidf_init @@ -722,8 +722,9 @@ subroutine runtime_diags (dt) ! frazil ice growth !! should not be multiplied by aice ! m/step->kg/m^2/s work1(:,:,:) = frazil(:,:,:)*rhoi/dt - if (ktherm == 2 .and. .not.update_ocn_f) & + if (.not. update_ocn_f .and. ktherm == 2 .and. cpl_frazil == 'fresh_ice_correction') then work1(:,:,:) = (frazil(:,:,:)-frazil_diag(:,:,:))*rhoi/dt + endif frzn = c0 frzs = c0 frzn = global_sum(work1, distrb_info, & diff --git a/cicecore/cicedyn/analysis/ice_history.F90 b/cicecore/cicedyn/analysis/ice_history.F90 index 80bce65b4..6c440cc86 100644 --- a/cicecore/cicedyn/analysis/ice_history.F90 +++ b/cicecore/cicedyn/analysis/ice_history.F90 @@ -2134,11 +2134,10 @@ subroutine accum_hist (dt) fcondtop, fcondbot, fsurfn, fcondtopn, flatn, fsensn, albcnt, snwcnt, & stressp_1, stressm_1, stress12_1, & stresspT, stressmT, stress12T, & - stressp_2, & - stressp_3, & - stressp_4, sig1, sig2, sigP, & + stressp_2, stressp_3, stressp_4, sig1, sig2, sigP, & mlt_onset, frz_onset, dagedtt, dagedtd, fswint_ai, keffn_top, & - snowfrac, alvdr_ai, alvdf_ai, alidr_ai, alidf_ai, update_ocn_f + snowfrac, alvdr_ai, alvdf_ai, alidr_ai, alidf_ai, update_ocn_f, & + cpl_frazil use ice_arrays_column, only: snowfracn, Cdn_atm use ice_history_shared ! almost everything use ice_history_write, only: ice_write_hist @@ -3238,11 +3237,11 @@ subroutine accum_hist (dt) if (aice(i,j,iblk) > puny) then ! Add in frazil flux if (.not. update_ocn_f) then - if ( ktherm == 2) then - dfresh = -rhoi*(frazil(i,j,iblk)-frazil_diag(i,j,iblk))/dt - else - dfresh = -rhoi*frazil(i,j,iblk)/dt - endif + if ( ktherm == 2 .and. cpl_frazil == 'fresh_ice_correction') then + dfresh = -rhoi*(frazil(i,j,iblk)-frazil_diag(i,j,iblk))/dt + else + dfresh = -rhoi*frazil(i,j,iblk)/dt + endif endif if (saltflux_option == 'prognostic') then sicen = c0 @@ -3266,14 +3265,13 @@ subroutine accum_hist (dt) do j = jlo, jhi do i = ilo, ihi if (aice(i,j,iblk) > puny) then -! Add in frazil flux ! Add in frazil flux if (.not. update_ocn_f) then - if ( ktherm == 2) then - dfresh = -rhoi*(frazil(i,j,iblk)-frazil_diag(i,j,iblk))/dt - else - dfresh = -rhoi*frazil(i,j,iblk)/dt - endif + if ( ktherm == 2 .and. cpl_frazil == 'fresh_ice_correction') then + dfresh = -rhoi*(frazil(i,j,iblk)-frazil_diag(i,j,iblk))/dt + else + dfresh = -rhoi*frazil(i,j,iblk)/dt + endif endif worka(i,j) = aice(i,j,iblk)*(fresh(i,j,iblk)+dfresh) endif diff --git a/cicecore/cicedyn/general/ice_flux.F90 b/cicecore/cicedyn/general/ice_flux.F90 index 29f5c489b..0fffa06b3 100644 --- a/cicecore/cicedyn/general/ice_flux.F90 +++ b/cicecore/cicedyn/general/ice_flux.F90 @@ -241,8 +241,7 @@ module ice_flux alvdf_init, & ! visible, diffuse (fraction) alidf_init ! near-ir, diffuse (fraction) - real (kind=dbl_kind), & - dimension(:,:,:,:), allocatable, public :: & + real (kind=dbl_kind), dimension(:,:,:,:), allocatable, public :: & albcnt ! counter for zenith angle ! out to ocean @@ -270,6 +269,9 @@ module ice_flux l_mpond_fresh ! if true, include freshwater feedback from meltponds ! when running in ice-ocean or coupled configuration + character (char_len), public :: & + cpl_frazil ! type of coupling for frazil ice, 'fresh_ice_correction','internal','external' + real (kind=dbl_kind), dimension (:,:,:,:), allocatable, public :: & meltsn , & ! snow melt in category n (m) melttn , & ! top melt in category n (m) diff --git a/cicecore/cicedyn/general/ice_init.F90 b/cicecore/cicedyn/general/ice_init.F90 index 9d21b84fc..dfe7f47f5 100644 --- a/cicecore/cicedyn/general/ice_init.F90 +++ b/cicecore/cicedyn/general/ice_init.F90 @@ -82,7 +82,7 @@ subroutine input_data use ice_history_shared, only: hist_avg, history_dir, history_file, & incond_dir, incond_file, version_name, & history_precision, history_format, hist_time_axis - use ice_flux, only: update_ocn_f, l_mpond_fresh + 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 use ice_forcing, only: & @@ -265,7 +265,7 @@ subroutine input_data highfreq, natmiter, atmiter_conv, calc_dragio, & ustar_min, emissivity, iceruf, iceruf_ocn, & fbot_xfer_type, update_ocn_f, l_mpond_fresh, tfrz_option, & - saltflux_option,ice_ref_salinity, & + saltflux_option,ice_ref_salinity,cpl_frazil, & oceanmixed_ice, restore_ice, restore_ocn, trestore, & precip_units, default_season, wave_spec_type,nfreq, & atm_data_type, ocn_data_type, bgc_data_type, fe_data_type, & @@ -444,6 +444,7 @@ subroutine input_data ktransport = 1 ! -1 = off, 1 = on calc_Tsfc = .true. ! calculate surface temperature update_ocn_f = .false. ! include fresh water and salt fluxes for frazil + cpl_frazil = 'fresh_ice_correction' ! type of coupling for frazil ice ustar_min = 0.005 ! minimum friction velocity for ocean heat flux (m/s) hi_min = p01 ! minimum ice thickness allowed (m) iceruf = 0.0005_dbl_kind ! ice surface roughness at atmosphere interface (m) @@ -1071,6 +1072,7 @@ subroutine input_data call broadcast_scalar(natmiter, master_task) call broadcast_scalar(atmiter_conv, master_task) call broadcast_scalar(update_ocn_f, master_task) + call broadcast_scalar(cpl_frazil, master_task) call broadcast_scalar(l_mpond_fresh, master_task) call broadcast_scalar(ustar_min, master_task) call broadcast_scalar(hi_min, master_task) @@ -2123,6 +2125,7 @@ subroutine input_data tmpstr2 = ' : frazil water/salt fluxes not included in ocean fluxes' endif write(nu_diag,1010) ' update_ocn_f = ', update_ocn_f,trim(tmpstr2) + write(nu_diag,1030) ' cpl_frazil = ', trim(cpl_frazil) if (l_mpond_fresh .and. tr_pond_topo) then tmpstr2 = ' : retain (topo) pond water until ponds drain' else @@ -2510,8 +2513,8 @@ subroutine input_data floediam_in=floediam, hfrazilmin_in=hfrazilmin, Tliquidus_max_in=Tliquidus_max, & aspect_rapid_mode_in=aspect_rapid_mode, dSdt_slow_mode_in=dSdt_slow_mode, & phi_c_slow_mode_in=phi_c_slow_mode, phi_i_mushy_in=phi_i_mushy, conserv_check_in=conserv_check, & - wave_spec_type_in = wave_spec_type, & - wave_spec_in=wave_spec, nfreq_in=nfreq, & + wave_spec_type_in = wave_spec_type, wave_spec_in=wave_spec, nfreq_in=nfreq, & + update_ocn_f_in=update_ocn_f, cpl_frazil_in=cpl_frazil, & tfrz_option_in=tfrz_option, kalg_in=kalg, fbot_xfer_type_in=fbot_xfer_type, & saltflux_option_in=saltflux_option, ice_ref_salinity_in=ice_ref_salinity, & Pstar_in=Pstar, Cstar_in=Cstar, iceruf_in=iceruf, iceruf_ocn_in=iceruf_ocn, calc_dragio_in=calc_dragio, & diff --git a/cicecore/cicedyn/general/ice_step_mod.F90 b/cicecore/cicedyn/general/ice_step_mod.F90 index 552cde044..8ea6aa90e 100644 --- a/cicecore/cicedyn/general/ice_step_mod.F90 +++ b/cicecore/cicedyn/general/ice_step_mod.F90 @@ -617,7 +617,7 @@ subroutine step_therm2 (dt, iblk) use ice_calendar, only: yday use ice_domain_size, only: ncat, nilyr, nslyr, nblyr, nfsd use ice_flux, only: fresh, frain, fpond, frzmlt, frazil, frz_onset, & - update_ocn_f, fsalt, Tf, sss, salinz, fhocn, rside, fside, wlat, & + fsalt, Tf, sss, salinz, fhocn, rside, fside, wlat, & meltl, frazil_diag use ice_flux_bgc, only: flux_bio, faero_ocn, & fiso_ocn, HDO_ocn, H2_16O_ocn, H2_18O_ocn @@ -708,7 +708,6 @@ subroutine step_therm2 (dt, iblk) fresh = fresh (i,j, iblk), & fsalt = fsalt (i,j, iblk), & fhocn = fhocn (i,j, iblk), & - update_ocn_f = update_ocn_f, & bgrid = bgrid, & cgrid = cgrid, & igrid = igrid, & diff --git a/doc/source/cice_index.rst b/doc/source/cice_index.rst index 7878b2f5e..bf5533d46 100644 --- a/doc/source/cice_index.rst +++ b/doc/source/cice_index.rst @@ -116,6 +116,7 @@ section :ref:`tabnamelist`. "cosw", "cosine of the turning angle in water", "1." "coszen", "cosine of the zenith angle", "" "Cp", "proportionality constant for potential energy", "kg/m\ :math:`^2`/s\ :math:`^2`" + "cpl_frazil", ":math:`\bullet` type of frazil ice coupling", "" "cp_air", "specific heat of air", "1005.0 J/kg/K" "cp_ice", "specific heat of fresh ice", "2106. J/kg/K" "cp_ocn", "specific heat of sea water", "4218. J/kg/K" diff --git a/doc/source/user_guide/ug_case_settings.rst b/doc/source/user_guide/ug_case_settings.rst index ebb33b65e..0ee1b36d7 100644 --- a/doc/source/user_guide/ug_case_settings.rst +++ b/doc/source/user_guide/ug_case_settings.rst @@ -629,6 +629,9 @@ forcing_nml "``calc_strair``", "``.false.``", "read wind stress and speed from files", "``.true.``" "", "``.true.``", "calculate wind stress and speed", "" "``calc_Tsfc``", "logical", "calculate surface temperature", "``.true.``" + "``cpl_frazil``", "``external``", "frazil water/salt fluxes are handled outside of Icepack", "``fresh_ice_correction``" + "", "``fresh_ice_correction``", "correct fresh-ice frazil water/salt fluxes for mushy physics", "" + "", "``internal``", "send full frazil water/salt fluxes for mushy physics", "" "``default_season``", "``summer``", "forcing initial summer values", "``winter``" "", "``winter``", "forcing initial winter values", "" "``emissivity``", "real", "emissivity of snow and ice", "0.985" From d3698fb46fc23a81b1df8dba676a5a74d7e96a39 Mon Sep 17 00:00:00 2001 From: daveh150 Date: Wed, 25 Oct 2023 16:34:35 -0500 Subject: [PATCH 33/76] 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 --- cicecore/cicedyn/general/ice_forcing.F90 | 63 +++++++++++-------- cicecore/cicedyn/general/ice_init.F90 | 8 ++- configuration/scripts/ice_in | 1 + configuration/scripts/options/set_nml.gx1 | 1 + configuration/scripts/options/set_nml.gx3 | 1 + configuration/scripts/options/set_nml.jra55 | 2 + configuration/scripts/options/set_nml.jra55do | 1 + configuration/scripts/options/set_nml.tx1 | 1 + doc/source/developer_guide/dg_forcing.rst | 10 +-- doc/source/user_guide/ug_case_settings.rst | 1 + 10 files changed, 57 insertions(+), 32 deletions(-) diff --git a/cicecore/cicedyn/general/ice_forcing.F90 b/cicecore/cicedyn/general/ice_forcing.F90 index 9002d0448..caf14a52b 100755 --- a/cicecore/cicedyn/general/ice_forcing.F90 +++ b/cicecore/cicedyn/general/ice_forcing.F90 @@ -120,18 +120,19 @@ module ice_forcing wave_spectrum_data ! field values at 2 temporal data points character(char_len), public :: & - atm_data_format, & ! 'bin'=binary or 'nc'=netcdf - ocn_data_format, & ! 'bin'=binary or 'nc'=netcdf - atm_data_type, & ! 'default', 'monthly', 'ncar', 'box2001' - ! 'hadgem', 'oned', 'calm', 'uniform' - ! 'JRA55' or 'JRA55do' - bgc_data_type, & ! 'default', 'clim' - ocn_data_type, & ! 'default', 'clim', 'ncar', 'oned', 'calm', 'box2001' - ! 'hadgem_sst' or 'hadgem_sst_uvocn', 'uniform' - ice_data_type, & ! 'latsst', 'box2001', 'boxslotcyl', etc - ice_data_conc, & ! 'p5','p8','p9','c1','parabolic', 'box2001', etc - ice_data_dist, & ! 'box2001','gauss', 'uniform', etc - precip_units ! 'mm_per_month', 'mm_per_sec', 'mks','m_per_sec' + atm_data_format , & ! 'bin'=binary or 'nc'=netcdf + ocn_data_format , & ! 'bin'=binary or 'nc'=netcdf + atm_data_type , & ! 'default', 'monthly', 'ncar', 'box2001' + ! 'hadgem', 'oned', 'calm', 'uniform' + ! 'JRA55' or 'JRA55do' + atm_data_version , & ! date of atm_forcing file creation + bgc_data_type , & ! 'default', 'clim' + ocn_data_type , & ! 'default', 'clim', 'ncar', 'oned', 'calm', 'box2001' + ! 'hadgem_sst' or 'hadgem_sst_uvocn', 'uniform' + ice_data_type , & ! 'latsst', 'box2001', 'boxslotcyl', etc + ice_data_conc , & ! 'p5','p8','p9','c1','parabolic', 'box2001', etc + ice_data_dist , & ! 'box2001','gauss', 'uniform', etc + precip_units ! 'mm_per_month', 'mm_per_sec', 'mks','m_per_sec' logical (kind=log_kind), public :: & rotate_wind ! rotate wind/stress to computational grid from true north directed @@ -2238,29 +2239,39 @@ subroutine JRA55_files(yr) exists = .false. cnt = 1 do while (.not.exists .and. cnt <= 6) - if (cnt == 1) uwind_file = trim(atm_data_dir)//'/'//trim(atm_data_type_prefix)// & - '/8XDAILY/'//trim(atm_data_type_prefix)//'_'//trim(grd)//'_03hr_forcing_2005.nc' - if (cnt == 2) uwind_file = trim(atm_data_dir)//'/'//trim(atm_data_type_prefix)// & - '/8XDAILY/'//trim(atm_data_type_prefix)//'_03hr_forcing_'//trim(grd)//'_2005.nc' + if (cnt == 1) uwind_file = trim(atm_data_dir)//'/'//trim(atm_data_type_prefix)// & + '/8XDAILY/'//trim(atm_data_type_prefix)//'_'//trim(grd)// & + '_03hr_forcing'//trim(atm_data_version)//'_2005.nc' - if (cnt == 3) uwind_file = trim(atm_data_dir)//'/'//trim(atm_data_type_prefix)// & - '/8XDAILY/'//trim(atm_data_type_prefix)// '_03hr_forcing_2005.nc' + if (cnt == 2) uwind_file = trim(atm_data_dir)//'/'//trim(atm_data_type_prefix)// & + '/8XDAILY/'//trim(atm_data_type_prefix)//'_03hr_forcing_'//trim(grd)// & + trim(atm_data_version)//'_2005.nc' - if (cnt == 4) uwind_file = trim(atm_data_dir)// & - '/8XDAILY/'//trim(atm_data_type_prefix)//'_'//trim(grd)//'_03hr_forcing_2005.nc' + if (cnt == 3) uwind_file = trim(atm_data_dir)//'/'//trim(atm_data_type_prefix)// & + '/8XDAILY/'//trim(atm_data_type_prefix)// & + '_03hr_forcing'//trim(atm_data_version)//'_2005.nc' + + if (cnt == 4) uwind_file = trim(atm_data_dir)// & + '/8XDAILY/'//trim(atm_data_type_prefix)//'_'//trim(grd)// & + '_03hr_forcing'//trim(atm_data_version)//'_2005.nc' - if (cnt == 5) uwind_file = trim(atm_data_dir)// & - '/8XDAILY/'//trim(atm_data_type_prefix)//'_03hr_forcing_'//trim(grd)//'_2005.nc' + if (cnt == 5) uwind_file = trim(atm_data_dir)// & + '/8XDAILY/'//trim(atm_data_type_prefix)//'_03hr_forcing_'//trim(grd)// & + trim(atm_data_version)//'_2005.nc' if (cnt == 6) uwind_file = trim(atm_data_dir)// & - '/8XDAILY/'//trim(atm_data_type_prefix)// '_03hr_forcing_2005.nc' + '/8XDAILY/'//trim(atm_data_type_prefix)// & + '_03hr_forcing'//trim(atm_data_version)//'_2005.nc' + call file_year(uwind_file,yr) INQUIRE(FILE=uwind_file,EXIST=exists) -! if (my_task == master_task) then -! write(nu_diag,*) subname,cnt,exists,trim(uwind_file) -! endif + + if (debug_forcing .and. (my_task == master_task)) then + write(nu_diag,*) subname,cnt,exists,trim(uwind_file) + endif + cnt = cnt + 1 enddo diff --git a/cicecore/cicedyn/general/ice_init.F90 b/cicecore/cicedyn/general/ice_init.F90 index dfe7f47f5..0e34338d9 100644 --- a/cicecore/cicedyn/general/ice_init.F90 +++ b/cicecore/cicedyn/general/ice_init.F90 @@ -88,7 +88,7 @@ subroutine input_data use ice_forcing, only: & ycycle, fyear_init, debug_forcing, & atm_data_type, atm_data_dir, precip_units, rotate_wind, & - atm_data_format, ocn_data_format, & + atm_data_format, ocn_data_format, atm_data_version, & bgc_data_type, & ocn_data_type, ocn_data_dir, wave_spec_file, & oceanmixed_file, restore_ocn, trestore, & @@ -273,7 +273,7 @@ subroutine input_data fyear_init, ycycle, wave_spec_file,restart_coszen, & atm_data_dir, ocn_data_dir, bgc_data_dir, & atm_data_format, ocn_data_format, rotate_wind, & - oceanmixed_file + oceanmixed_file, atm_data_version !----------------------------------------------------------------- ! default values @@ -501,6 +501,7 @@ subroutine input_data atm_data_format = 'bin' ! file format ('bin'=binary or 'nc'=netcdf) atm_data_type = 'default' atm_data_dir = ' ' + atm_data_version = '_undef' ! date atm_data_file was generated. rotate_wind = .true. ! rotate wind/stress composants to computational grid orientation calc_strair = .true. ! calculate wind stress formdrag = .false. ! calculate form drag @@ -1064,6 +1065,7 @@ subroutine input_data call broadcast_scalar(atm_data_format, master_task) call broadcast_scalar(atm_data_type, master_task) call broadcast_scalar(atm_data_dir, master_task) + call broadcast_scalar(atm_data_version, master_task) call broadcast_scalar(rotate_wind, master_task) call broadcast_scalar(calc_strair, master_task) call broadcast_scalar(calc_Tsfc, master_task) @@ -2380,6 +2382,8 @@ subroutine input_data write(nu_diag,1021) ' fyear_init = ', fyear_init write(nu_diag,1021) ' ycycle = ', ycycle write(nu_diag,1031) ' atm_data_type = ', trim(atm_data_type) + write(nu_diag,1031) ' atm_data_version = ', trim(atm_data_version) + 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) diff --git a/configuration/scripts/ice_in b/configuration/scripts/ice_in index 93db4efbe..a1bbea26a 100644 --- a/configuration/scripts/ice_in +++ b/configuration/scripts/ice_in @@ -271,6 +271,7 @@ precip_units = 'mm_per_month' default_season = 'winter' atm_data_type = 'ncar' + atm_data_version = '_undef' ocn_data_type = 'default' bgc_data_type = 'default' fe_data_type = 'default' diff --git a/configuration/scripts/options/set_nml.gx1 b/configuration/scripts/options/set_nml.gx1 index 781da3389..3c8deba21 100644 --- a/configuration/scripts/options/set_nml.gx1 +++ b/configuration/scripts/options/set_nml.gx1 @@ -15,6 +15,7 @@ maskhalo_bound = .true. fyear_init = 2005 atm_data_format = 'nc' atm_data_type = 'JRA55' +atm_data_version = '' atm_data_dir = 'ICE_MACHINE_INPUTDATA/CICE_data/forcing/gx1' precip_units = 'mks' ocn_data_dir = 'ICE_MACHINE_INPUTDATA/CICE_data/forcing/gx1/CESM/MONTHLY' diff --git a/configuration/scripts/options/set_nml.gx3 b/configuration/scripts/options/set_nml.gx3 index 3492509c6..bbed11131 100644 --- a/configuration/scripts/options/set_nml.gx3 +++ b/configuration/scripts/options/set_nml.gx3 @@ -12,6 +12,7 @@ bathymetry_file = 'ICE_MACHINE_INPUTDATA/CICE_data/grid/gx3/global_gx3.bathy.nc' fyear_init = 2005 atm_data_format = 'nc' atm_data_type = 'JRA55' +atm_data_version = '' atm_data_dir = 'ICE_MACHINE_INPUTDATA/CICE_data/forcing/gx3' precip_units = 'mks' ocn_data_format = 'bin' diff --git a/configuration/scripts/options/set_nml.jra55 b/configuration/scripts/options/set_nml.jra55 index 465152498..4c8d41bad 100644 --- a/configuration/scripts/options/set_nml.jra55 +++ b/configuration/scripts/options/set_nml.jra55 @@ -1,2 +1,4 @@ atm_data_format = 'nc' atm_data_type = 'JRA55' +atm_data_version = '' + diff --git a/configuration/scripts/options/set_nml.jra55do b/configuration/scripts/options/set_nml.jra55do index 5ca4cb397..5e7348c03 100644 --- a/configuration/scripts/options/set_nml.jra55do +++ b/configuration/scripts/options/set_nml.jra55do @@ -1,2 +1,3 @@ atm_data_format = 'nc' atm_data_type = 'JRA55do' +atm_data_version = '' diff --git a/configuration/scripts/options/set_nml.tx1 b/configuration/scripts/options/set_nml.tx1 index c21231a0f..8b10a6c62 100644 --- a/configuration/scripts/options/set_nml.tx1 +++ b/configuration/scripts/options/set_nml.tx1 @@ -9,5 +9,6 @@ kmt_file = 'ICE_MACHINE_INPUTDATA/CICE_data/grid/tx1/kmt_tx1.bin' atm_data_dir = 'ICE_MACHINE_INPUTDATA/CICE_data/forcing/tx1' atm_data_format = 'nc' atm_data_type = 'JRA55' +atm_data_version = '_20230919' year_init = 2005 fyear_init = 2005 diff --git a/doc/source/developer_guide/dg_forcing.rst b/doc/source/developer_guide/dg_forcing.rst index 8cf293843..e6dbe92f2 100644 --- a/doc/source/developer_guide/dg_forcing.rst +++ b/doc/source/developer_guide/dg_forcing.rst @@ -21,10 +21,12 @@ primitive, in part due to historical reasons and in part because standalone runs are discouraged for evaluating complex science. In general, most implementations use aspects of the following approach, -- Input files are organized by year. The underlying implementation provides for some flexibility and extensibility in filenames. For instance, JRA55 and JRA55do filenames can have syntax like ``[JRA55,JRA55do][_$grid,'']_03hr_forcing[_$grid,'']_$year.nc`` where $grid is optional or may be present at one of two locations within the filename. This implementation exists to support the current naming conventions within the gx1, gx3, and tx1 JRA55 and JRA55do CICE_DATA directory structure automatically. See **JRA55_files** in **ice_forcing.F90** for more details. -- Namelist inputs ``fyear`` and ``ycycle`` specify the forcing year dataset. -- The forcing year is computed on the fly and is assumed to be cyclical over the forcing dataset length defined by ``ycycle``. -- The namelist ``atm_data_dir`` specifies the path or partial path for the atmosphere input data files and the namelist ``atm_data_type`` defines the atmospheric forcing mode. ``atm_data_type`` values of ``JRA55``, ``JRA55do``, or ``ncar`` provide some flexibility for directory paths and filenames. Many details can be gleaned from the CICE_data directory structure and file names as well as from the implementation in **ice_forcing.F90**. But the main point is that atm_data_dir should be set to ${CICE_DATA_root}/forcing/$grid/[JRA55,JRA55do,NCAR_bulk,''] where [JRA55,JRA55do,NCAR_bulk] are optional but provided for backwards compatibility. grid is typically gx1, gx3, tx1, or similar. +- Input files are organized by year. The underlying implementation + provides for some flexibility and extensibility in filenames. For instance, JRA55 and JRA55do filenames can have syntax like [JRA55,JRA55do][_$grid]_03hr_forcing_$year.nc or [JRA55,JRA55do]_03hr_forcing[_$grid]_$year.nc, where [_$grid] is optional and may be present at one of two locations within the filename. This implementation exists to support the current naming conventions within the gx1, gx3, and tx1 JRA55 and JRA55do CICE_data directory structure automatically. See **JRA55_files** in **ice_forcing.F90** for more details.- Namelist inputs ``fyear`` and ``ycycle`` specify the forcing year dataset. +- The forcing year is computed on the fly and is assumed to be + cyclical over the forcing dataset length defined by ``ycycle``. +- The namelist ``atm_data_dir`` specifies the full or partial path for the atmosphere input data files, and the namelist ``atm_data_type`` defines the atmospheric forcing mode (see ``forcing_nml`` in + :ref:`tabnamelist`). Many of the forcing options are generated internally. For atmospheric forcing read from files, the directory structure and filenames depend on the grid and ``atm_data_type``. Many details can be gleaned from the CICE_data directory and filenames as well as from the implementation in **ice_forcing.F90**. The primary ``atm_data_type`` forcing for gx1, gx3, and tx1 test grids are ``JRA55`` and ``JRA55do``. For those configurations, the ``atm_data_dir`` should be set to ${CICE_data_root}/forcing/${grid}/[JRA55,JRA55do] and the filenames should be of the form [JRA55,JRA55do]_${grid}_03hr_forcing${atm_data_version}_yyyy.nc where yyyy is the forcing year. Those files should be placed under ``atm_data_dir/8XDAILY``. ``atm_data_version`` is a string defined in ``forcing_nml`` namelist that supports versioning of the forcing data. ``atm_data_version`` could be any string including the null string. It typically will be something like _yyyymmdd to indicate the date the forcing data was generated. - The namelist ``ocn_data_dir`` specifies the directory of the ocean input data files and the namelist ``ocn_data_type`` defines the ocean forcing mode. - The filenames follow a particular naming convention that is defined in the source code (ie. subroutine **JRA55_files**). The forcing year is typically found just before the **.nc** part of the filename and there are tools (subroutine **file_year**) to update the filename based on the model year and appropriate forcing year. - The input data time axis is generally NOT read by the forcing subroutine. The forcing frequency is hardwired into the model and the file record number is computed based on the forcing frequency and model time. Mixing leap year input data and noleap model calendars (and vice versa) is not handled particularly gracefully. The CICE model does not read or check against the input data time axis. diff --git a/doc/source/user_guide/ug_case_settings.rst b/doc/source/user_guide/ug_case_settings.rst index 0ee1b36d7..a3e6166aa 100644 --- a/doc/source/user_guide/ug_case_settings.rst +++ b/doc/source/user_guide/ug_case_settings.rst @@ -621,6 +621,7 @@ forcing_nml "", "``monthly``", "monthly forcing data", "" "", "``ncar``", "NCAR bulk forcing data", "" "", "``oned``", "column forcing data", "" + "``atm_data_version``","string", "date of atm data forcing file creation", "``_undef``" "``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", "" From 624c28b19b443c031ea862e3e5d2c16387777ddc Mon Sep 17 00:00:00 2001 From: Philippe Blain Date: Thu, 26 Oct 2023 11:52:26 -0400 Subject: [PATCH 34/76] 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 --- cicecore/cicedyn/dynamics/ice_dyn_evp.F90 | 6 ++++-- cicecore/cicedyn/dynamics/ice_dyn_shared.F90 | 2 +- 2 files changed, 5 insertions(+), 3 deletions(-) diff --git a/cicecore/cicedyn/dynamics/ice_dyn_evp.F90 b/cicecore/cicedyn/dynamics/ice_dyn_evp.F90 index cf111cccf..a24c8f57d 100644 --- a/cicecore/cicedyn/dynamics/ice_dyn_evp.F90 +++ b/cicecore/cicedyn/dynamics/ice_dyn_evp.F90 @@ -763,12 +763,14 @@ subroutine evp (dt) icellE (iblk), & indxEi (:,iblk), indxEj(:,iblk), & vice (:,:,iblk), aice(:,:,iblk), & - hwater(:,:,iblk), TbE (:,:,iblk)) + hwater(:,:,iblk), TbE (:,:,iblk), & + grid_location='E') call seabed_stress_factor_LKD (nx_block , ny_block, & icellN (iblk), & indxNi (:,iblk), indxNj(:,iblk), & vice (:,:,iblk), aice(:,:,iblk), & - hwater(:,:,iblk), TbN (:,:,iblk)) + hwater(:,:,iblk), TbN (:,:,iblk), & + grid_location='N') enddo !$OMP END PARALLEL DO diff --git a/cicecore/cicedyn/dynamics/ice_dyn_shared.F90 b/cicecore/cicedyn/dynamics/ice_dyn_shared.F90 index 50f1aae6e..69e552730 100644 --- a/cicecore/cicedyn/dynamics/ice_dyn_shared.F90 +++ b/cicecore/cicedyn/dynamics/ice_dyn_shared.F90 @@ -1289,7 +1289,7 @@ subroutine seabed_stress_factor_LKD (nx_block, ny_block, & real (kind=dbl_kind), dimension (nx_block,ny_block), intent(inout) :: & TbU ! seabed stress factor at 'grid_location' (N/m^2) - character(len=*), optional, intent(inout) :: & + character(len=*), optional, intent(in) :: & grid_location ! grid location (U, E, N), U assumed if not present real (kind=dbl_kind) :: & From b4abca479cd548c3e600a6c645447d5ba9464422 Mon Sep 17 00:00:00 2001 From: Tony Craig Date: Thu, 26 Oct 2023 08:54:40 -0700 Subject: [PATCH 35/76] Add 5-band dEdd shortwave tests (#896) --- configuration/scripts/tests/base_suite.ts | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/configuration/scripts/tests/base_suite.ts b/configuration/scripts/tests/base_suite.ts index 906aae08d..956925de9 100644 --- a/configuration/scripts/tests/base_suite.ts +++ b/configuration/scripts/tests/base_suite.ts @@ -23,6 +23,8 @@ restart gx3 4x4 alt04 restart gx3 4x4 alt05 restart gx3 8x2 alt06 restart gx3 8x3 alt07 +restart gx3 16x2 snicar +restart gx3 12x2 snicartest restart gx3 8x3 saltflux restart gx3 18x2 debug,maskhalo restart gx3 6x2 alt01,debug,short @@ -33,6 +35,8 @@ smoke gx3 4x4 alt04,debug,short smoke gx3 4x4 alt05,debug,short smoke gx3 8x2 alt06,debug,short smoke gx3 8x3 alt07,debug,short +smoke gx3 16x2 snicar,debug,short +smoke gx3 12x2 snicartest,debug,short smoke gx3 10x2 debug,diag1,run5day,gx3sep2 smoke gx3 7x2x5x29x12 diag1,bigdiag,run1day,debug restart gbox128 4x2 short From 2e13606558f7ce71633274bc38630caa23de3392 Mon Sep 17 00:00:00 2001 From: Philippe Blain Date: Thu, 26 Oct 2023 13:24:37 -0400 Subject: [PATCH 36/76] doc: update histfreq_base and hist_avg descriptions (#898) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * 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. --- doc/source/user_guide/ug_implementation.rst | 36 +++++++++++---------- 1 file changed, 19 insertions(+), 17 deletions(-) diff --git a/doc/source/user_guide/ug_implementation.rst b/doc/source/user_guide/ug_implementation.rst index b24d96909..ab1d2fcc3 100644 --- a/doc/source/user_guide/ug_implementation.rst +++ b/doc/source/user_guide/ug_implementation.rst @@ -1192,33 +1192,35 @@ The history modules allow output at different frequencies. Five output frequencies (``1``, ``h``, ``d``, ``m``, ``y``) are available simultaneously during a run. The same variable can be output at different frequencies (say daily and monthly) via its namelist flag, `f\_` :math:`\left<{var}\right>`, which -is now a character string corresponding to ``histfreq`` or ‘x’ for none. -(Grid variable flags are still logicals, since they are written to all +is a character string corresponding to ``histfreq`` or ‘x’ for none. +(Grid variable flags are logicals, since they are written to all files, no matter what the frequency is.) If there are no namelist flags with a given ``histfreq`` value, or if an element of ``histfreq_n`` is 0, then no file will be written at that frequency. The output period can be -discerned from the filenames. All history streams will be either instantaneous -or averaged as specified by the ``hist_avg`` namelist setting and the frequency -will be relative to a reference date specified by ``histfreq_base``. Also, some +discerned from the filenames. Each history stream will be either instantaneous +or averaged as specified by the corresponding entry in the ``hist_avg`` namelist array, and the frequency +will be relative to a reference date specified by the corresponding entry in ``histfreq_base``. +More information about how the frequency is +computed is found in :ref:`timemanager`. +Also, some Earth Sytem Models require the history file time axis to be centered in the averaging interval. The flag ``hist_time_axis`` will allow the user to chose ``begin``, ``middle``, -or ``end`` for the time stamp. More information about how the frequency is -computed is found in :ref:`timemanager`. +or ``end`` for the time stamp. For example, in the namelist: :: - histfreq = ’1’, ’h’, ’d’, ’m’, ’y’ - histfreq_n = 1, 6, 0, 1, 1 - histfreq_base = 'zero' - hist_avg = .true.,.true.,.true.,.true.,.true. - f_hi = ’1’ - f_hs = ’h’ - f_Tsfc = ’d’ - f_aice = ’m’ - f_meltb = ’mh’ - f_iage = ’x’ + histfreq = '1', 'h', 'd', 'm', 'y' + histfreq_n = 1 , 6 , 0 , 1 , 1 + histfreq_base = 'zero','zero','zero','zero','zero' + hist_avg = .true.,.true.,.true.,.true.,.true. + f_hi = '1' + f_hs = 'h' + f_Tsfc = 'd' + f_aice = 'm' + f_meltb = 'mh' + f_iage = 'x' Here, ``hi`` will be written to a file on every timestep, ``hs`` will be written once every 6 hours, ``aice`` once a month, ``meltb`` once a month AND From 0b5ca0911edaf6081ba891f4287af14ceb201c9f Mon Sep 17 00:00:00 2001 From: Tony Craig Date: Thu, 26 Oct 2023 19:33:19 -0700 Subject: [PATCH 37/76] Revert "Add 5-band dEdd shortwave tests (#896)" (#900) This reverts commit b4abca479cd548c3e600a6c645447d5ba9464422. --- configuration/scripts/tests/base_suite.ts | 4 ---- 1 file changed, 4 deletions(-) diff --git a/configuration/scripts/tests/base_suite.ts b/configuration/scripts/tests/base_suite.ts index 956925de9..906aae08d 100644 --- a/configuration/scripts/tests/base_suite.ts +++ b/configuration/scripts/tests/base_suite.ts @@ -23,8 +23,6 @@ restart gx3 4x4 alt04 restart gx3 4x4 alt05 restart gx3 8x2 alt06 restart gx3 8x3 alt07 -restart gx3 16x2 snicar -restart gx3 12x2 snicartest restart gx3 8x3 saltflux restart gx3 18x2 debug,maskhalo restart gx3 6x2 alt01,debug,short @@ -35,8 +33,6 @@ smoke gx3 4x4 alt04,debug,short smoke gx3 4x4 alt05,debug,short smoke gx3 8x2 alt06,debug,short smoke gx3 8x3 alt07,debug,short -smoke gx3 16x2 snicar,debug,short -smoke gx3 12x2 snicartest,debug,short smoke gx3 10x2 debug,diag1,run5day,gx3sep2 smoke gx3 7x2x5x29x12 diag1,bigdiag,run1day,debug restart gbox128 4x2 short From 0484dcd1410920f26375b7c280500a5bd16173e9 Mon Sep 17 00:00:00 2001 From: Tony Craig Date: Fri, 27 Oct 2023 09:24:52 -0700 Subject: [PATCH 38/76] 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). --- cicecore/cicedyn/infrastructure/ice_grid.F90 | 191 ++++++++++++------- configuration/scripts/options/set_nml.gx3nc | 3 + configuration/scripts/tests/base_suite.ts | 2 + 3 files changed, 129 insertions(+), 67 deletions(-) create mode 100644 configuration/scripts/options/set_nml.gx3nc diff --git a/cicecore/cicedyn/infrastructure/ice_grid.F90 b/cicecore/cicedyn/infrastructure/ice_grid.F90 index 16dea4382..5473ebeae 100644 --- a/cicecore/cicedyn/infrastructure/ice_grid.F90 +++ b/cicecore/cicedyn/infrastructure/ice_grid.F90 @@ -675,36 +675,37 @@ subroutine init_grid2 if (trim(grid_type) == 'cpom_grid') then ANGLET(:,:,:) = ANGLE(:,:,:) else if (.not. (l_readCenter)) then - ANGLET = c0 + ANGLET = c0 - !$OMP PARALLEL DO PRIVATE(iblk,i,j,ilo,ihi,jlo,jhi,this_block, & - !$OMP angle_0,angle_w,angle_s,angle_sw) - 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 + !$OMP PARALLEL DO PRIVATE(iblk,i,j,ilo,ihi,jlo,jhi,this_block, & + !$OMP angle_0,angle_w,angle_s,angle_sw) + 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 - angle_0 = ANGLE(i ,j ,iblk) ! w----0 - angle_w = ANGLE(i-1,j ,iblk) ! | | - angle_s = ANGLE(i, j-1,iblk) ! | | - angle_sw = ANGLE(i-1,j-1,iblk) ! sw---s - ANGLET(i,j,iblk) = atan2(p25*(sin(angle_0)+ & - sin(angle_w)+ & - sin(angle_s)+ & - sin(angle_sw)),& - p25*(cos(angle_0)+ & - cos(angle_w)+ & - cos(angle_s)+ & - cos(angle_sw))) - enddo + do j = jlo, jhi + do i = ilo, ihi + angle_0 = ANGLE(i ,j ,iblk) ! w----0 + angle_w = ANGLE(i-1,j ,iblk) ! | | + angle_s = ANGLE(i, j-1,iblk) ! | | + angle_sw = ANGLE(i-1,j-1,iblk) ! sw---s + ANGLET(i,j,iblk) = atan2(p25*(sin(angle_0)+ & + sin(angle_w)+ & + sin(angle_s)+ & + sin(angle_sw)),& + p25*(cos(angle_0)+ & + cos(angle_w)+ & + cos(angle_s)+ & + cos(angle_sw))) + enddo + enddo enddo - enddo - !$OMP END PARALLEL DO + !$OMP END PARALLEL DO endif ! cpom_grid + if (trim(grid_type) == 'regional' .and. & (.not. (l_readCenter))) then ! for W boundary extrapolate from interior @@ -734,8 +735,10 @@ subroutine init_grid2 call makemask ! velocity mask, hemisphere masks if (.not. (l_readCenter)) then - call Tlatlon ! get lat, lon on the T grid + call Tlatlon ! get lat, lon on the T grid endif + call NElatlon ! get lat, lon on the N, E grid + !----------------------------------------------------------------- ! bathymetry !----------------------------------------------------------------- @@ -1961,8 +1964,8 @@ subroutine cpomgrid close (nu_kmt) endif - write(nu_diag,*) "min/max HTN: ", minval(HTN), maxval(HTN) - write(nu_diag,*) "min/max HTE: ", minval(HTE), maxval(HTE) + write(nu_diag,*) subname," min/max HTN: ", minval(HTN), maxval(HTN) + write(nu_diag,*) subname," min/max HTE: ", minval(HTE), maxval(HTE) end subroutine cpomgrid @@ -2363,6 +2366,10 @@ subroutine Tlatlon character(len=*), parameter :: subname = '(Tlatlon)' + if (my_task==master_task) then + write(nu_diag,*) subname,' called' + endif + call icepack_query_parameters(rad_to_deg_out=rad_to_deg) call icepack_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & @@ -2370,10 +2377,6 @@ subroutine Tlatlon TLAT(:,:,:) = c0 TLON(:,:,:) = c0 - NLAT(:,:,:) = c0 - NLON(:,:,:) = c0 - ELAT(:,:,:) = c0 - ELON(:,:,:) = c0 !$OMP PARALLEL DO PRIVATE(iblk,i,j,ilo,ihi,jlo,jhi,this_block, & !$OMP x1,y1,z1,x2,y2,z2,x3,y3,z3,x4,y4,z4, & @@ -2426,15 +2429,87 @@ subroutine Tlatlon ! TLAT in radians North TLAT(i,j,iblk) = asin(tz) -! these two loops should be merged to save cos/sin calculations, -! but atan2 is not bit-for-bit. This suggests the result for atan2 depends on -! the prior atan2 call ??? not sure what's going on. -#if (1 == 1) enddo ! i enddo ! j enddo ! iblk !$OMP END PARALLEL DO + if (trim(grid_type) == 'regional') then + ! for W boundary extrapolate from interior + !$OMP PARALLEL DO PRIVATE(iblk,i,j,ilo,ihi,jlo,jhi,this_block) + 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 + + i = ilo + if (this_block%i_glob(i) == 1) then + do j = jlo, jhi + TLON(i,j,iblk) = c2*TLON(i+1,j,iblk) - & + TLON(i+2,j,iblk) + TLAT(i,j,iblk) = c2*TLAT(i+1,j,iblk) - & + TLAT(i+2,j,iblk) + enddo + endif + enddo + !$OMP END PARALLEL DO + endif ! regional + + call ice_timer_start(timer_bound) + call ice_HaloUpdate (TLON, halo_info, & + field_loc_center, field_type_scalar, & + fillValue=c1) + call ice_HaloUpdate (TLAT, halo_info, & + field_loc_center, field_type_scalar, & + fillValue=c1) + call ice_HaloExtrapolate(TLON, distrb_info, & + ew_boundary_type, ns_boundary_type) + call ice_HaloExtrapolate(TLAT, distrb_info, & + ew_boundary_type, ns_boundary_type) + + end subroutine Tlatlon + +!======================================================================= + +! Initializes latitude and longitude on N, E grid +! +! author: T. Craig from Tlatlon + + subroutine NElatlon + + use ice_constants, only: c0, c1, c1p5, c2, c4, p5, & + field_loc_center, field_loc_Nface, field_loc_Eface, & + field_type_scalar + + integer (kind=int_kind) :: & + i, j, iblk , & ! horizontal indices + ilo,ihi,jlo,jhi ! beginning and end of physical domain + + real (kind=dbl_kind) :: & + z1,x1,y1,z2,x2,y2,z3,x3,y3,z4,x4,y4,tx,ty,tz,da, & + rad_to_deg + + type (block) :: & + this_block ! block information for current block + + character(len=*), parameter :: subname = '(NElatlon)' + + if (my_task==master_task) then + write(nu_diag,*) subname,' called' + endif + + call icepack_query_parameters(rad_to_deg_out=rad_to_deg) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + + NLAT(:,:,:) = c0 + NLON(:,:,:) = c0 + ELAT(:,:,:) = c0 + ELON(:,:,:) = c0 + !$OMP PARALLEL DO PRIVATE(iblk,i,j,ilo,ihi,jlo,jhi,this_block, & !$OMP x1,y1,z1,x2,y2,z2,x3,y3,z3,x4,y4,z4, & !$OMP tx,ty,tz,da) @@ -2467,7 +2542,7 @@ subroutine Tlatlon x4 = cos(ULON(i,j,iblk))*z4 y4 = sin(ULON(i,j,iblk))*z4 z4 = sin(ULAT(i,j,iblk)) -#endif + ! --------- ! NLON/NLAT 2 pt computation (pts 3, 4) ! --------- @@ -2522,10 +2597,6 @@ subroutine Tlatlon i = ilo if (this_block%i_glob(i) == 1) then do j = jlo, jhi - TLON(i,j,iblk) = c2*TLON(i+1,j,iblk) - & - TLON(i+2,j,iblk) - TLAT(i,j,iblk) = c2*TLAT(i+1,j,iblk) - & - TLAT(i+2,j,iblk) NLON(i,j,iblk) = c1p5*TLON(i+1,j,iblk) - & p5*TLON(i+2,j,iblk) NLAT(i,j,iblk) = c1p5*TLAT(i+1,j,iblk) - & @@ -2537,12 +2608,6 @@ subroutine Tlatlon endif ! regional call ice_timer_start(timer_bound) - call ice_HaloUpdate (TLON, halo_info, & - field_loc_center, field_type_scalar, & - fillValue=c1) - call ice_HaloUpdate (TLAT, halo_info, & - field_loc_center, field_type_scalar, & - fillValue=c1) call ice_HaloUpdate (NLON, halo_info, & field_loc_Nface, field_type_scalar, & fillValue=c1) @@ -2555,10 +2620,6 @@ subroutine Tlatlon call ice_HaloUpdate (ELAT, halo_info, & field_loc_Eface, field_type_scalar, & fillValue=c1) - call ice_HaloExtrapolate(TLON, distrb_info, & - ew_boundary_type, ns_boundary_type) - call ice_HaloExtrapolate(TLAT, distrb_info, & - ew_boundary_type, ns_boundary_type) call ice_HaloExtrapolate(NLON, distrb_info, & ew_boundary_type, ns_boundary_type) call ice_HaloExtrapolate(NLAT, distrb_info, & @@ -2581,12 +2642,10 @@ subroutine Tlatlon if (my_task==master_task) then write(nu_diag,*) ' ' -! if (nx_block > 5+2*nghost .and. ny_block > 5+2*nghost) then - write(nu_diag,*) 'min/max ULON:', y1*rad_to_deg, y2*rad_to_deg - write(nu_diag,*) 'min/max ULAT:', y3*rad_to_deg, y4*rad_to_deg -! endif - write(nu_diag,*) 'min/max TLON:', x1*rad_to_deg, x2*rad_to_deg - write(nu_diag,*) 'min/max TLAT:', x3*rad_to_deg, x4*rad_to_deg + write(nu_diag,*) subname,' min/max ULON:', y1*rad_to_deg, y2*rad_to_deg + write(nu_diag,*) subname,' min/max ULAT:', y3*rad_to_deg, y4*rad_to_deg + write(nu_diag,*) subname,' min/max TLON:', x1*rad_to_deg, x2*rad_to_deg + write(nu_diag,*) subname,' min/max TLAT:', x3*rad_to_deg, x4*rad_to_deg endif ! my_task x1 = global_minval(NLON, distrb_info, nmask) @@ -2601,15 +2660,13 @@ subroutine Tlatlon if (my_task==master_task) then write(nu_diag,*) ' ' -! if (nx_block > 5+2*nghost .and. ny_block > 5+2*nghost) then - write(nu_diag,*) 'min/max NLON:', x1*rad_to_deg, x2*rad_to_deg - write(nu_diag,*) 'min/max NLAT:', x3*rad_to_deg, x4*rad_to_deg - write(nu_diag,*) 'min/max ELON:', y1*rad_to_deg, y2*rad_to_deg - write(nu_diag,*) 'min/max ELAT:', y3*rad_to_deg, y4*rad_to_deg -! endif + write(nu_diag,*) subname,' min/max NLON:', x1*rad_to_deg, x2*rad_to_deg + write(nu_diag,*) subname,' min/max NLAT:', x3*rad_to_deg, x4*rad_to_deg + write(nu_diag,*) subname,' min/max ELON:', y1*rad_to_deg, y2*rad_to_deg + write(nu_diag,*) subname,' min/max ELAT:', y3*rad_to_deg, y4*rad_to_deg endif ! my_task - end subroutine Tlatlon + end subroutine NElatlon !======================================================================= @@ -4677,7 +4734,7 @@ subroutine read_seabedstress_bathy fieldname='Bathymetry' if (my_task == master_task) then - write(nu_diag,*) 'reading ',TRIM(fieldname) + write(nu_diag,*) subname,' reading ',TRIM(fieldname) call icepack_warnings_flush(nu_diag) endif call ice_read_nc(fid_init,1,fieldname,bathymetry,diag, & @@ -4687,7 +4744,7 @@ subroutine read_seabedstress_bathy call ice_close_nc(fid_init) if (my_task == master_task) then - write(nu_diag,*) 'closing file ',TRIM(bathymetry_file) + write(nu_diag,*) subname,' closing file ',TRIM(bathymetry_file) call icepack_warnings_flush(nu_diag) endif diff --git a/configuration/scripts/options/set_nml.gx3nc b/configuration/scripts/options/set_nml.gx3nc new file mode 100644 index 000000000..1440fd676 --- /dev/null +++ b/configuration/scripts/options/set_nml.gx3nc @@ -0,0 +1,3 @@ +grid_format = 'nc' +grid_file = 'ICE_MACHINE_INPUTDATA/CICE_data/grid/gx3/grid_gx3t.nc' +kmt_file = 'ICE_MACHINE_INPUTDATA/CICE_data/grid/gx3/kmt_gx3t.nc' diff --git a/configuration/scripts/tests/base_suite.ts b/configuration/scripts/tests/base_suite.ts index 906aae08d..ce486b96a 100644 --- a/configuration/scripts/tests/base_suite.ts +++ b/configuration/scripts/tests/base_suite.ts @@ -4,6 +4,7 @@ smoke gx3 1x1 debug,diag1,run2day smoke gx3 1x4 debug,diag1,run2day smoke gx3 4x1 debug,diag1,run5day restart gx3 8x2 debug +restart gx3 8x2 debug,gx3nc smoke gx3 8x2 diag24,run1year,medium smoke gx3 7x2 diag1,bigdiag,run1day,diagpt1 decomp gx3 4x2x25x29x5 none @@ -14,6 +15,7 @@ restart gx1 40x4 droundrobin,medium restart tx1 40x4 dsectrobin,medium restart tx1 40x4 dsectrobin,medium,jra55do restart gx3 4x4 none +restart gx3 4x4 gx3nc restart gx3 10x4 maskhalo restart gx3 6x2 alt01 restart gx3 8x2 alt02 From 32f233d9728b4e453c0f02fb79a188517a8d5ed4 Mon Sep 17 00:00:00 2001 From: Tony Craig Date: Fri, 27 Oct 2023 16:27:01 -0700 Subject: [PATCH 39/76] Update Icepack, add snicar and snicartest tests (#902) --- configuration/scripts/options/set_nml.snicartest | 3 +++ configuration/scripts/tests/base_suite.ts | 4 ++++ icepack | 2 +- 3 files changed, 8 insertions(+), 1 deletion(-) create mode 100644 configuration/scripts/options/set_nml.snicartest diff --git a/configuration/scripts/options/set_nml.snicartest b/configuration/scripts/options/set_nml.snicartest new file mode 100644 index 000000000..2f94ce575 --- /dev/null +++ b/configuration/scripts/options/set_nml.snicartest @@ -0,0 +1,3 @@ + shortwave = 'dEdd_snicar_ad' + snw_ssp_table = 'test' + diff --git a/configuration/scripts/tests/base_suite.ts b/configuration/scripts/tests/base_suite.ts index ce486b96a..3a18d8548 100644 --- a/configuration/scripts/tests/base_suite.ts +++ b/configuration/scripts/tests/base_suite.ts @@ -25,6 +25,8 @@ restart gx3 4x4 alt04 restart gx3 4x4 alt05 restart gx3 8x2 alt06 restart gx3 8x3 alt07 +restart gx3 16x2 snicar +restart gx3 12x2 snicartest restart gx3 8x3 saltflux restart gx3 18x2 debug,maskhalo restart gx3 6x2 alt01,debug,short @@ -35,6 +37,8 @@ smoke gx3 4x4 alt04,debug,short smoke gx3 4x4 alt05,debug,short smoke gx3 8x2 alt06,debug,short smoke gx3 8x3 alt07,debug,short +smoke gx3 16x2 snicar,debug,short +smoke gx3 12x2 snicartest,debug,short smoke gx3 10x2 debug,diag1,run5day,gx3sep2 smoke gx3 7x2x5x29x12 diag1,bigdiag,run1day,debug restart gbox128 4x2 short diff --git a/icepack b/icepack index 0c548120c..84ff38867 160000 --- a/icepack +++ b/icepack @@ -1 +1 @@ -Subproject commit 0c548120ce443824241051196f5ba508cb7ba7db +Subproject commit 84ff38867dcf27eccaaf83a827195c45c84d73fe From ea241fa81a53b614f54cf5c2dad93bda20b72a78 Mon Sep 17 00:00:00 2001 From: Tony Craig Date: Fri, 27 Oct 2023 16:27:15 -0700 Subject: [PATCH 40/76] Update version, remove trailing blanks (#901) --- .../cicedyn/dynamics/ice_transport_remap.F90 | 36 +++++++++---------- cicecore/cicedyn/general/ice_forcing.F90 | 2 +- cicecore/cicedyn/general/ice_init.F90 | 4 +-- cicecore/cicedyn/general/ice_step_mod.F90 | 2 +- .../drivers/unittest/opticep/ice_step_mod.F90 | 2 +- cicecore/version.txt | 2 +- doc/source/conf.py | 4 +-- 7 files changed, 26 insertions(+), 26 deletions(-) diff --git a/cicecore/cicedyn/dynamics/ice_transport_remap.F90 b/cicecore/cicedyn/dynamics/ice_transport_remap.F90 index 5c33fea2b..ee0a3d083 100644 --- a/cicecore/cicedyn/dynamics/ice_transport_remap.F90 +++ b/cicecore/cicedyn/dynamics/ice_transport_remap.F90 @@ -308,12 +308,12 @@ subroutine init_remap ! regions are adjusted to obtain the desired area. ! If false, edgearea is computed in locate_triangles and passed out. ! - ! l_fixed_area = .false. has been the default approach in CICE. It is - ! used like this for the B-grid. However, idealized tests with the - ! C-grid have shown that l_fixed_area = .false. leads to a checkerboard - ! pattern in prognostic fields (e.g. aice). Using l_fixed_area = .true. + ! l_fixed_area = .false. has been the default approach in CICE. It is + ! used like this for the B-grid. However, idealized tests with the + ! C-grid have shown that l_fixed_area = .false. leads to a checkerboard + ! pattern in prognostic fields (e.g. aice). Using l_fixed_area = .true. ! eliminates the checkerboard pattern in C-grid simulations. - ! + ! !------------------------------------------------------------------- if (grid_ice == 'CD' .or. grid_ice == 'C') then @@ -1725,7 +1725,7 @@ subroutine locate_triangles (nx_block, ny_block, & dpy , & ! y coordinates of departure points at cell corners dxu , & ! E-W dimension of U-cell (m) dyu , & ! N-S dimension of U-cell (m) - earea , & ! area of E-cell + earea , & ! area of E-cell narea ! area of N-cell real (kind=dbl_kind), dimension (nx_block,ny_block,0:nvert,ngroups), intent(out) :: & @@ -1762,8 +1762,8 @@ subroutine locate_triangles (nx_block, ny_block, & ishift_br, jshift_br , & ! i,j indices of BR cell relative to edge ishift_tc, jshift_tc , & ! i,j indices of TC cell relative to edge ishift_bc, jshift_bc , & ! i,j indices of BC cell relative to edge - is_l, js_l , & ! i,j shifts for TL1, BL2 for area consistency - is_r, js_r , & ! i,j shifts for TR1, BR2 for area consistency + is_l, js_l , & ! i,j shifts for TL1, BL2 for area consistency + is_r, js_r , & ! i,j shifts for TR1, BR2 for area consistency ise_tl, jse_tl , & ! i,j of TL other edge relative to edge ise_bl, jse_bl , & ! i,j of BL other edge relative to edge ise_tr, jse_tr , & ! i,j of TR other edge relative to edge @@ -1871,7 +1871,7 @@ subroutine locate_triangles (nx_block, ny_block, & areafac_c(:,:) = c0 areafac_ce(:,:) = c0 - + do ng = 1, ngroups do j = 1, ny_block do i = 1, nx_block @@ -1908,7 +1908,7 @@ subroutine locate_triangles (nx_block, ny_block, & ishift_bc = 0 jshift_bc = 0 - ! index shifts for TL1, BL2, TR1 and BR2 for area consistency + ! index shifts for TL1, BL2, TR1 and BR2 for area consistency is_l = -1 js_l = 0 @@ -1936,7 +1936,7 @@ subroutine locate_triangles (nx_block, ny_block, & enddo ! area scale factor for other edge (east) - + do j = 1, ny_block do i = 1, nx_block areafac_ce(i,j) = earea(i,j) @@ -1960,7 +1960,7 @@ subroutine locate_triangles (nx_block, ny_block, & ishift_bc = 0 jshift_bc = 0 - ! index shifts for TL1, BL2, TR1 and BR2 for area consistency + ! index shifts for TL1, BL2, TR1 and BR2 for area consistency is_l = 0 js_l = 1 @@ -2114,11 +2114,11 @@ subroutine locate_triangles (nx_block, ny_block, & !------------------------------------------------------------------- ! Locate triangles in TL cell (NW for north edge, NE for east edge) ! and BL cell (W for north edge, N for east edge). - ! + ! ! areafact_c or areafac_ce (areafact_c for the other edge) are used - ! (with shifted indices) to make sure that a flux area on one edge - ! is consistent with the analogous area on the other edge and to - ! ensure that areas add up when using l_fixed_area = T. See PR #849 + ! (with shifted indices) to make sure that a flux area on one edge + ! is consistent with the analogous area on the other edge and to + ! ensure that areas add up when using l_fixed_area = T. See PR #849 ! for details. ! !------------------------------------------------------------------- @@ -2476,7 +2476,7 @@ subroutine locate_triangles (nx_block, ny_block, & iflux (i,j,ng) = i + ishift_tc jflux (i,j,ng) = j + jshift_tc areafact(i,j,ng) = -areafac_c(i,j) - + ! TC2a (group 5) ng = 5 @@ -2489,7 +2489,7 @@ subroutine locate_triangles (nx_block, ny_block, & iflux (i,j,ng) = i + ishift_tc jflux (i,j,ng) = j + jshift_tc areafact(i,j,ng) = -areafac_c(i,j) - + ! TC3a (group 6) ng = 6 diff --git a/cicecore/cicedyn/general/ice_forcing.F90 b/cicecore/cicedyn/general/ice_forcing.F90 index caf14a52b..496e342f1 100755 --- a/cicecore/cicedyn/general/ice_forcing.F90 +++ b/cicecore/cicedyn/general/ice_forcing.F90 @@ -2251,7 +2251,7 @@ subroutine JRA55_files(yr) if (cnt == 3) uwind_file = trim(atm_data_dir)//'/'//trim(atm_data_type_prefix)// & '/8XDAILY/'//trim(atm_data_type_prefix)// & '_03hr_forcing'//trim(atm_data_version)//'_2005.nc' - + if (cnt == 4) uwind_file = trim(atm_data_dir)// & '/8XDAILY/'//trim(atm_data_type_prefix)//'_'//trim(grd)// & '_03hr_forcing'//trim(atm_data_version)//'_2005.nc' diff --git a/cicecore/cicedyn/general/ice_init.F90 b/cicecore/cicedyn/general/ice_init.F90 index 0e34338d9..0dd2cb832 100644 --- a/cicecore/cicedyn/general/ice_init.F90 +++ b/cicecore/cicedyn/general/ice_init.F90 @@ -501,7 +501,7 @@ subroutine input_data atm_data_format = 'bin' ! file format ('bin'=binary or 'nc'=netcdf) atm_data_type = 'default' atm_data_dir = ' ' - atm_data_version = '_undef' ! date atm_data_file was generated. + atm_data_version = '_undef' ! date atm_data_file was generated. rotate_wind = .true. ! rotate wind/stress composants to computational grid orientation calc_strair = .true. ! calculate wind stress formdrag = .false. ! calculate form drag @@ -2383,7 +2383,7 @@ subroutine input_data write(nu_diag,1021) ' ycycle = ', ycycle write(nu_diag,1031) ' atm_data_type = ', trim(atm_data_type) write(nu_diag,1031) ' atm_data_version = ', trim(atm_data_version) - + 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) diff --git a/cicecore/cicedyn/general/ice_step_mod.F90 b/cicecore/cicedyn/general/ice_step_mod.F90 index 8ea6aa90e..b738e670b 100644 --- a/cicecore/cicedyn/general/ice_step_mod.F90 +++ b/cicecore/cicedyn/general/ice_step_mod.F90 @@ -757,7 +757,7 @@ subroutine update_state (dt, daidt, dvidt, dagedt, offset) use ice_state, only: aicen, trcrn, vicen, vsnon, & aice, trcr, vice, vsno, aice0, trcr_depend, & bound_state, trcr_base, nt_strata, n_trcr_strata - use ice_flux, only: Tf + use ice_flux, only: Tf use ice_timers, only: ice_timer_start, ice_timer_stop, timer_bound, timer_updstate real (kind=dbl_kind), intent(in) :: & diff --git a/cicecore/drivers/unittest/opticep/ice_step_mod.F90 b/cicecore/drivers/unittest/opticep/ice_step_mod.F90 index ba19436bd..5b85cb7bf 100644 --- a/cicecore/drivers/unittest/opticep/ice_step_mod.F90 +++ b/cicecore/drivers/unittest/opticep/ice_step_mod.F90 @@ -760,7 +760,7 @@ subroutine update_state (dt, daidt, dvidt, dagedt, offset) use ice_state, only: aicen, trcrn, vicen, vsnon, & aice, trcr, vice, vsno, aice0, trcr_depend, & bound_state, trcr_base, nt_strata, n_trcr_strata - use ice_flux, only: Tf + use ice_flux, only: Tf use ice_timers, only: ice_timer_start, ice_timer_stop, timer_bound, timer_updstate real (kind=dbl_kind), intent(in) :: & diff --git a/cicecore/version.txt b/cicecore/version.txt index 6f8bbc127..c908e44d9 100644 --- a/cicecore/version.txt +++ b/cicecore/version.txt @@ -1 +1 @@ -CICE 6.4.2 +CICE 6.5.0 diff --git a/doc/source/conf.py b/doc/source/conf.py index 7d078835c..0e7ce0886 100644 --- a/doc/source/conf.py +++ b/doc/source/conf.py @@ -65,9 +65,9 @@ # built documents. # # The short X.Y version. -version = u'6.4.2' +version = u'6.5.0' # The full version, including alpha/beta/rc tags. -version = u'6.4.2' +version = u'6.5.0' # The language for content autogenerated by Sphinx. Refer to documentation # for a list of supported languages. From 4450a3e8c64bc07d1173eb3e341cd8dea91d5068 Mon Sep 17 00:00:00 2001 From: Tony Craig Date: Fri, 27 Oct 2023 22:22:43 -0700 Subject: [PATCH 41/76] Update Icepack to latest version, does not affect CICE (#903) --- icepack | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/icepack b/icepack index 84ff38867..d1a42fb14 160000 --- a/icepack +++ b/icepack @@ -1 +1 @@ -Subproject commit 84ff38867dcf27eccaaf83a827195c45c84d73fe +Subproject commit d1a42fb142033ca8c82a3f440ed38c63d992a314 From 5d09123865b5e8b47ba9d3c389b23743d84908c1 Mon Sep 17 00:00:00 2001 From: Mads Hvid Ribergaard <38077893+mhrib@users.noreply.github.com> Date: Fri, 10 Nov 2023 01:17:24 +0100 Subject: [PATCH 42/76] Rename sum to asum, as "sum" is also a generic fortran function (#905) Co-authored-by: Mads Hvid Ribergaard --- cicecore/cicedyn/general/ice_init.F90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/cicecore/cicedyn/general/ice_init.F90 b/cicecore/cicedyn/general/ice_init.F90 index 0dd2cb832..4e1a50f44 100644 --- a/cicecore/cicedyn/general/ice_init.F90 +++ b/cicecore/cicedyn/general/ice_init.F90 @@ -2939,7 +2939,7 @@ subroutine set_state_var (nx_block, ny_block, & indxi, indxj ! compressed indices for cells with aicen > puny real (kind=dbl_kind) :: & - Tsfc, sum, hbar, abar, puny, rhos, Lfresh, rad_to_deg, rsnw_fall, dist_ratio, Tffresh + Tsfc, asum, hbar, abar, puny, rhos, Lfresh, rad_to_deg, rsnw_fall, dist_ratio, Tffresh real (kind=dbl_kind), dimension(ncat) :: & ainit, hinit ! initial area, thickness @@ -3075,7 +3075,7 @@ subroutine set_state_var (nx_block, ny_block, & ! Note: the resulting average ice thickness ! tends to be less than hbar due to the ! nonlinear distribution of ice thicknesses - sum = c0 + asum = c0 do n = 1, ncat if (n < ncat) then hinit(n) = p5*(hin_max(n-1) + hin_max(n)) ! m @@ -3084,10 +3084,10 @@ subroutine set_state_var (nx_block, ny_block, & endif ! parabola, max at h=hbar, zero at h=0, 2*hbar ainit(n) = max(c0, (c2*hbar*hinit(n) - hinit(n)**2)) - sum = sum + ainit(n) + asum = asum + ainit(n) enddo do n = 1, ncat - ainit(n) = ainit(n) / (sum + puny/ncat) ! normalize + ainit(n) = ainit(n) / (asum + puny/ncat) ! normalize enddo else From 8573ba8ab196c1e357a101462b16bd92128461b1 Mon Sep 17 00:00:00 2001 From: TRasmussen <33480590+TillRasmussen@users.noreply.github.com> Date: Thu, 16 Nov 2023 22:12:07 +0100 Subject: [PATCH 43/76] 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 --- cicecore/cicedyn/dynamics/ice_dyn_core1d.F90 | 671 ++++++ cicecore/cicedyn/dynamics/ice_dyn_evp.F90 | 794 ++++--- cicecore/cicedyn/dynamics/ice_dyn_evp1d.F90 | 1467 +++++++++++++ cicecore/cicedyn/dynamics/ice_dyn_evp_1d.F90 | 1921 ----------------- cicecore/cicedyn/dynamics/ice_dyn_shared.F90 | 15 +- cicecore/cicedyn/dynamics/ice_dyn_vp.F90 | 12 +- .../cicedyn/dynamics/ice_transport_remap.F90 | 13 +- cicecore/cicedyn/general/ice_init.F90 | 25 +- .../infrastructure/comm/mpi/ice_boundary.F90 | 131 +- .../infrastructure/comm/mpi/ice_timers.F90 | 52 +- .../comm/serial/ice_boundary.F90 | 130 +- .../infrastructure/comm/serial/ice_timers.F90 | 84 +- cicecore/cicedyn/infrastructure/ice_grid.F90 | 203 +- .../drivers/direct/hadgem3/CICE_InitMod.F90 | 3 +- .../direct/nemo_concepts/CICE_InitMod.F90 | 3 +- cicecore/drivers/mct/cesm1/CICE_InitMod.F90 | 3 +- cicecore/drivers/nuopc/cmeps/CICE_InitMod.F90 | 4 +- cicecore/drivers/nuopc/dmi/CICE_FinalMod.F90 | 14 +- cicecore/drivers/nuopc/dmi/CICE_InitMod.F90 | 15 +- cicecore/drivers/nuopc/dmi/CICE_RunMod.F90 | 51 +- .../drivers/standalone/cice/CICE_InitMod.F90 | 4 +- .../unittest/gridavgchk/CICE_InitMod.F90 | 3 +- .../drivers/unittest/halochk/CICE_InitMod.F90 | 3 +- .../drivers/unittest/opticep/CICE_InitMod.F90 | 3 +- .../drivers/unittest/sumchk/CICE_InitMod.F90 | 3 +- .../scripts/machines/Macros.freya_intel | 6 +- configuration/scripts/tests/omp_suite.ts | 4 - 27 files changed, 2799 insertions(+), 2838 deletions(-) create mode 100644 cicecore/cicedyn/dynamics/ice_dyn_core1d.F90 create mode 100644 cicecore/cicedyn/dynamics/ice_dyn_evp1d.F90 delete mode 100644 cicecore/cicedyn/dynamics/ice_dyn_evp_1d.F90 diff --git a/cicecore/cicedyn/dynamics/ice_dyn_core1d.F90 b/cicecore/cicedyn/dynamics/ice_dyn_core1d.F90 new file mode 100644 index 000000000..f3f71b490 --- /dev/null +++ b/cicecore/cicedyn/dynamics/ice_dyn_core1d.F90 @@ -0,0 +1,671 @@ +!=============================================================================== +! Copyright (C) 2023, Intel Corporation +! Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: +! 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. +! 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. +! 3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission. +! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS “AS IS” AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +!=============================================================================== + +!=============================================================================== +! +! Elastic-viscous-plastic sea ice dynamics model +! Computes ice velocity and deformation +! +! See: +! +! Hunke, E. C., and J. K. Dukowicz (1997). An elastic-viscous-plastic model +! for sea ice dynamics. J. Phys. Oceanogr., 27, 1849-1867. +! +! Hunke, E. C. (2001). Viscous-Plastic Sea Ice Dynamics with the EVP Model: +! Linearization Issues. J. Comput. Phys., 170, 18-38. +! +! Hunke, E. C., and J. K. Dukowicz (2002). The Elastic-Viscous-Plastic +! Sea Ice Dynamics Model in General Orthogonal Curvilinear Coordinates +! on a Sphere - Incorporation of Metric Terms. Mon. Weather Rev., +! 130, 1848-1865. +! +! Hunke, E. C., and J. K. Dukowicz (2003). The sea ice momentum +! equation in the free drift regime. Los Alamos Tech. Rep. LA-UR-03-2219. +! +! Hibler, W. D. (1979). A dynamic thermodynamic sea ice model. J. Phys. +! Oceanogr., 9, 817-846. +! +! Bouillon, S., T. Fichefet, V. Legat and G. Madec (2013). The +! elastic-viscous-plastic method revisited. Ocean Model., 71, 2-12. +! +! author: Elizabeth C. Hunke, LANL +! +! 2003: Vectorized by Clifford Chen (Fujitsu) and William Lipscomb (LANL) +! 2004: Block structure added by William Lipscomb +! 2005: Removed boundary calls for stress arrays (WHL) +! 2006: Streamlined for efficiency by Elizabeth Hunke +! Converted to free source form (F90) +!=============================================================================== +! 2023: Intel +! Refactored for SIMD code generation +! Refactored to reduce memory footprint +! Refactored to support explicit inlining +! Refactored the OpenMP parallelization (classic loop inlined w. scoping) +! Refactored to support OpenMP GPU offloading +! Refactored to allow private subroutines in stress to become pure +!=============================================================================== +!=============================================================================== +! 2023: DMI +! Updated to match requirements from CICE +!=============================================================================== +! module is based on benchmark test v2c + +module ice_dyn_core1d + + use ice_dyn_shared, only: e_factor, epp2i, capping + use ice_constants, only: c1 + + implicit none + private + + public :: stress_1d, stepu_1d, calc_diag_1d + contains + + ! arguments ------------------------------------------------------------------ + subroutine stress_1d (ee, ne, se, lb, ub, & + uvel, vvel, dxT, dyT, skipme, strength, & + hte, htn, htem1, htnm1, & + stressp_1, stressp_2, stressp_3, stressp_4, & + stressm_1, stressm_2, stressm_3, stressm_4, & + stress12_1, stress12_2, stress12_3, stress12_4, & + str1, str2, str3, str4, str5, str6, str7, str8) + + use ice_kinds_mod + use ice_constants , only: p027, p055, p111, p166, c1p5, & + p222, p25, p333, p5 + + use ice_dyn_shared, only: arlx1i, denom1, revp, & + deltaminEVP, visc_replpress + ! + implicit none + ! arguments ------------------------------------------------------------------ + integer (kind=int_kind), intent(in) :: lb,ub + integer (kind=int_kind), dimension(:), intent(in), contiguous :: ee,ne,se + logical (kind=log_kind), dimension(:), intent(in), contiguous :: skipme + real (kind=dbl_kind), dimension(:), intent(in), contiguous :: & + strength , & ! ice strength (N/m) + uvel , & ! x-component of velocity (m/s) + vvel , & ! y-component of velocity (m/s) + dxT , & ! width of T-cell through the middle (m) + dyT , & ! height of T-cell through the middle (m) + hte , & + htn , & + htem1 , & + htnm1 + + real (kind=dbl_kind), dimension(:), intent(inout), contiguous :: & + stressp_1, stressp_2, stressp_3, stressp_4 , & ! sigma11+sigma22 + stressm_1, stressm_2, stressm_3, stressm_4 , & ! sigma11-sigma22 + stress12_1,stress12_2,stress12_3,stress12_4 ! sigma12 + + real (kind=dbl_kind), dimension(:), intent(inout), contiguous :: & + str1,str2,str3,str4,str5,str6,str7,str8 + + ! local variables + integer (kind=int_kind) :: iw + + real (kind=dbl_kind) :: & + divune, divunw, divuse, divusw , & ! divergence + tensionne, tensionnw, tensionse, tensionsw, & ! tension + shearne, shearnw, shearse, shearsw , & ! shearing + Deltane, Deltanw, Deltase, Deltasw , & ! Delt + zetax2ne, zetax2nw, zetax2se, zetax2sw , & ! 2 x zeta (bulk visc) + etax2ne, etax2nw, etax2se, etax2sw , & ! 2 x eta (shear visc) + rep_prsne, rep_prsnw, rep_prsse, rep_prssw, & ! replacement pressure + ssigpn, ssigps, ssigpe, ssigpw , & + ssigmn, ssigms, ssigme, ssigmw , & + ssig12n, ssig12s, ssig12e, ssig12w , & + ssigp1, ssigp2, ssigm1, ssigm2, ssig121, ssig122, & + csigpne, csigpnw, csigpse, csigpsw , & + csigmne, csigmnw, csigmse, csigmsw , & + csig12ne, csig12nw, csig12se, csig12sw , & + str12ew, str12we, str12ns, str12sn , & + strp_tmp, strm_tmp + + real (kind=dbl_kind) :: & + tmp_uvel_ee, tmp_vvel_se, tmp_vvel_ee, & + tmp_vvel_ne, tmp_uvel_ne, tmp_uvel_se, & + tmp_uvel_cc, tmp_vvel_cc, tmp_dxT, tmp_dyT, & + tmp_cxp, tmp_cyp, tmp_cxm, tmp_cym, & + tmp_strength, tmp_DminTarea, tmparea, & + tmp_dxhy, tmp_dyhx + + character(len=*), parameter :: subname = '(stress_1d)' + +#ifdef _OPENMP_TARGET + !$omp target teams distribute parallel do +#else + !$omp parallel do schedule(runtime) & + !$omp default(none) & + !$omp private(iw, divune, divunw, divuse, divusw , & + !$omp tensionne, tensionnw, tensionse, tensionsw , & + !$omp shearne, shearnw, shearse, shearsw , & + !$omp Deltane, Deltanw, Deltase, Deltasw , & + !$omp zetax2ne, zetax2nw, zetax2se, zetax2sw , & + !$omp etax2ne, etax2nw, etax2se, etax2sw , & + !$omp rep_prsne, rep_prsnw, rep_prsse, rep_prssw , & + !$omp ssigpn, ssigps, ssigpe, ssigpw , & + !$omp ssigmn, ssigms, ssigme, ssigmw , & + !$omp ssig12n, ssig12s, ssig12e, ssig12w, ssigp1 , & + !$omp ssigp2, ssigm1, ssigm2, ssig121, ssig122 , & + !$omp csigpne, csigpnw, csigpse, csigpsw , & + !$omp csigmne, csigmnw, csigmse, csigmsw , & + !$omp csig12ne, csig12nw, csig12se, csig12sw , & + !$omp str12ew, str12we, str12ns, str12sn , & + !$omp strp_tmp, strm_tmp , & + !$omp tmp_uvel_ee, tmp_vvel_se, tmp_vvel_ee , & + !$omp tmp_vvel_ne, tmp_uvel_ne, tmp_uvel_se , & + !$omp tmp_uvel_cc, tmp_vvel_cc, tmp_dxT, tmp_dyT , & + !$omp tmp_cxp, tmp_cyp, tmp_cxm, tmp_cym , & + !$omp tmp_strength, tmp_DminTarea, tmparea , & + !$omp tmp_dxhy, tmp_dyhx) & + !$omp shared(uvel,vvel,dxT,dyT,htn,hte,htnm1,htem1 , & + !$omp str1,str2,str3,str4,str5,str6,str7,str8 , & + !$omp stressp_1,stressp_2,stressp_3,stressp_4 , & + !$omp stressm_1,stressm_2,stressm_3,stressm_4 , & + !$omp stress12_1,stress12_2,stress12_3,stress12_4, & + !$omp deltaminEVP, arlx1i, denom1, e_factor , & + !$omp epp2i, capping, & + !$omp skipme,strength,ee,se,ne,lb,ub,revp) +#endif + + do iw = lb, ub + if (skipme(iw)) cycle + ! divergence = e_11 + e_22 + tmp_uvel_cc = uvel(iw) + tmp_vvel_cc = vvel(iw) + tmp_uvel_ee = uvel(ee(iw)) + tmp_vvel_se = vvel(se(iw)) + tmp_vvel_ee = vvel(ee(iw)) + tmp_vvel_ne = vvel(ne(iw)) + tmp_uvel_ne = uvel(ne(iw)) + tmp_uvel_se = uvel(se(iw)) + tmp_dxT = dxT(iw) + tmp_dyT = dyT(iw) + tmp_cxp = c1p5 * htn(iw) - p5 * htnm1(iw) + tmp_cyp = c1p5 * hte(iw) - p5 * htem1(iw) + tmp_cxm = -(c1p5 * htnm1(iw) - p5 * htn(iw)) + tmp_cym = -(c1p5 * htem1(iw) - p5 * hte(iw)) + tmp_strength = strength(iw) + tmparea = dxT(iw) * dyT(iw) ! necessary to split calc of DminTarea. Otherwize not binary identical + tmp_DminTarea = deltaminEVP * tmparea + tmp_dxhy = p5 * (hte(iw) - htem1(iw)) + tmp_dyhx = p5 * (htn(iw) - htnm1(iw)) + + !-------------------------------------------------------------------------- + ! strain rates - NOTE these are actually strain rates * area (m^2/s) + !-------------------------------------------------------------------------- + call strain_rates_1d (tmp_uvel_cc, tmp_vvel_cc, & + tmp_uvel_ee, tmp_vvel_ee, & + tmp_uvel_se, tmp_vvel_se, & + tmp_uvel_ne, tmp_vvel_ne, & + tmp_dxT , tmp_dyT , & + tmp_cxp , tmp_cyp , & + tmp_cxm , tmp_cym , & + divune , divunw , & + divuse , divusw , & + tensionne , tensionnw , & + tensionse , tensionsw , & + shearne , shearnw , & + shearse, shearsw , & + Deltane, Deltanw , & + Deltase, Deltasw ) + + !-------------------------------------------------------------------------- + ! viscosities and replacement pressure + !-------------------------------------------------------------------------- + call visc_replpress (tmp_strength, tmp_DminTarea, Deltane, & + zetax2ne, etax2ne, rep_prsne) + + call visc_replpress (tmp_strength, tmp_DminTarea, Deltanw, & + zetax2nw, etax2nw, rep_prsnw) + + call visc_replpress (tmp_strength, tmp_DminTarea, Deltasw, & + zetax2sw, etax2sw, rep_prssw) + + call visc_replpress (tmp_strength, tmp_DminTarea, Deltase, & + zetax2se, etax2se, rep_prsse) + + !-------------------------------------------------------------------------- + ! the stresses ! kg/s^2 + ! (1) northeast, (2) northwest, (3) southwest, (4) southeast + !-------------------------------------------------------------------------- + ! NOTE: for comp. efficiency 2 x zeta and 2 x eta are used in the code + + stressp_1 (iw) = (stressp_1 (iw)*(c1-arlx1i*revp) & + + arlx1i*(zetax2ne*divune - rep_prsne)) * denom1 + stressp_2 (iw) = (stressp_2 (iw)*(c1-arlx1i*revp) & + + arlx1i*(zetax2nw*divunw - rep_prsnw)) * denom1 + stressp_3 (iw) = (stressp_3 (iw)*(c1-arlx1i*revp)& + + arlx1i*(zetax2sw*divusw - rep_prssw)) * denom1 + stressp_4 (iw) = (stressp_4 (iw)*(c1-arlx1i*revp) & + + arlx1i*(zetax2se*divuse - rep_prsse)) * denom1 + + stressm_1 (iw) = (stressm_1 (iw)*(c1-arlx1i*revp) & + + arlx1i*etax2ne*tensionne) * denom1 + stressm_2 (iw) = (stressm_2 (iw)*(c1-arlx1i*revp) & + + arlx1i*etax2nw*tensionnw) * denom1 + stressm_3 (iw) = (stressm_3 (iw)*(c1-arlx1i*revp) & + + arlx1i*etax2sw*tensionsw) * denom1 + stressm_4 (iw) = (stressm_4 (iw)*(c1-arlx1i*revp) & + + arlx1i*etax2se*tensionse) * denom1 + + stress12_1(iw) = (stress12_1(iw)*(c1-arlx1i*revp) & + + arlx1i*p5*etax2ne*shearne) * denom1 + stress12_2(iw) = (stress12_2(iw)*(c1-arlx1i*revp) & + + arlx1i*p5*etax2nw*shearnw) * denom1 + stress12_3(iw) = (stress12_3(iw)*(c1-arlx1i*revp) & + + arlx1i*p5*etax2sw*shearsw) * denom1 + stress12_4(iw) = (stress12_4(iw)*(c1-arlx1i*revp) & + + arlx1i*p5*etax2se*shearse) * denom1 + + !-------------------------------------------------------------------------- + ! combinations of the stresses for the momentum equation ! kg/s^2 + !-------------------------------------------------------------------------- + ssigpn = stressp_1(iw) + stressp_2(iw) + ssigps = stressp_3(iw) + stressp_4(iw) + ssigpe = stressp_1(iw) + stressp_4(iw) + ssigpw = stressp_2(iw) + stressp_3(iw) + ssigp1 =(stressp_1(iw) + stressp_3(iw))*p055 + ssigp2 =(stressp_2(iw) + stressp_4(iw))*p055 + + ssigmn = stressm_1(iw) + stressm_2(iw) + ssigms = stressm_3(iw) + stressm_4(iw) + ssigme = stressm_1(iw) + stressm_4(iw) + ssigmw = stressm_2(iw) + stressm_3(iw) + ssigm1 =(stressm_1(iw) + stressm_3(iw))*p055 + ssigm2 =(stressm_2(iw) + stressm_4(iw))*p055 + + ssig12n = stress12_1(iw) + stress12_2(iw) + ssig12s = stress12_3(iw) + stress12_4(iw) + ssig12e = stress12_1(iw) + stress12_4(iw) + ssig12w = stress12_2(iw) + stress12_3(iw) + ssig121 =(stress12_1(iw) + stress12_3(iw))*p111 + ssig122 =(stress12_2(iw) + stress12_4(iw))*p111 + + csigpne = p111*stressp_1(iw) + ssigp2 + p027*stressp_3(iw) + csigpnw = p111*stressp_2(iw) + ssigp1 + p027*stressp_4(iw) + csigpsw = p111*stressp_3(iw) + ssigp2 + p027*stressp_1(iw) + csigpse = p111*stressp_4(iw) + ssigp1 + p027*stressp_2(iw) + + csigmne = p111*stressm_1(iw) + ssigm2 + p027*stressm_3(iw) + csigmnw = p111*stressm_2(iw) + ssigm1 + p027*stressm_4(iw) + csigmsw = p111*stressm_3(iw) + ssigm2 + p027*stressm_1(iw) + csigmse = p111*stressm_4(iw) + ssigm1 + p027*stressm_2(iw) + + csig12ne = p222*stress12_1(iw) + ssig122 & + + p055*stress12_3(iw) + csig12nw = p222*stress12_2(iw) + ssig121 & + + p055*stress12_4(iw) + csig12sw = p222*stress12_3(iw) + ssig122 & + + p055*stress12_1(iw) + csig12se = p222*stress12_4(iw) + ssig121 & + + p055*stress12_2(iw) + + str12ew = p5*tmp_dxt*(p333*ssig12e + p166*ssig12w) + str12we = p5*tmp_dxt*(p333*ssig12w + p166*ssig12e) + str12ns = p5*tmp_dyt*(p333*ssig12n + p166*ssig12s) + str12sn = p5*tmp_dyt*(p333*ssig12s + p166*ssig12n) + + !-------------------------------------------------------------------------- + ! for dF/dx (u momentum) + !-------------------------------------------------------------------------- + strp_tmp = p25*tmp_dyT*(p333*ssigpn + p166*ssigps) + strm_tmp = p25*tmp_dyT*(p333*ssigmn + p166*ssigms) + + ! northeast (i,j) + str1(iw) = -strp_tmp - strm_tmp - str12ew & + +tmp_dxhy*(-csigpne + csigmne) + tmp_dyhx*csig12ne + + ! northwest (i+1,j) + str2(iw) = strp_tmp + strm_tmp - str12we & + +tmp_dxhy*(-csigpnw + csigmnw) + tmp_dyhx*csig12nw + + strp_tmp = p25*tmp_dyT*(p333*ssigps + p166*ssigpn) + strm_tmp = p25*tmp_dyT*(p333*ssigms + p166*ssigmn) + + ! southeast (i,j+1) + str3(iw) = -strp_tmp - strm_tmp + str12ew & + +tmp_dxhy*(-csigpse + csigmse) + tmp_dyhx*csig12se + + ! southwest (i+1,j+1) + str4(iw) = strp_tmp + strm_tmp + str12we & + +tmp_dxhy*(-csigpsw + csigmsw) + tmp_dyhx*csig12sw + + !-------------------------------------------------------------------------- + ! for dF/dy (v momentum) + !-------------------------------------------------------------------------- + strp_tmp = p25*tmp_dxT*(p333*ssigpe + p166*ssigpw) + strm_tmp = p25*tmp_dxT*(p333*ssigme + p166*ssigmw) + + ! northeast (i,j) + str5(iw) = -strp_tmp + strm_tmp - str12ns & + -tmp_dyhx*(csigpne + csigmne) + tmp_dxhy*csig12ne + + ! southeast (i,j+1) + str6(iw) = strp_tmp - strm_tmp - str12sn & + -tmp_dyhx*(csigpse + csigmse) + tmp_dxhy*csig12se + + strp_tmp = p25*tmp_dxT*(p333*ssigpw + p166*ssigpe) + strm_tmp = p25*tmp_dxT*(p333*ssigmw + p166*ssigme) + + ! northwest (i+1,j) + str7(iw) = -strp_tmp + strm_tmp + str12ns & + -tmp_dyhx*(csigpnw + csigmnw) + tmp_dxhy*csig12nw + + ! southwest (i+1,j+1) + str8(iw) = strp_tmp - strm_tmp + str12sn & + -tmp_dyhx*(csigpsw + csigmsw) + tmp_dxhy*csig12sw + enddo +#ifdef _OPENMP_TARGET + !$omp end target teams distribute parallel do +#else + !$omp end parallel do +#endif + end subroutine stress_1d + + !============================================================================= + ! Compute strain rates + ! + ! author: Elizabeth C. Hunke, LANL + ! + ! 2019: subroutine created by Philippe Blain, ECCC + subroutine strain_rates_1d (tmp_uvel_cc, tmp_vvel_cc, & + tmp_uvel_ee, tmp_vvel_ee, & + tmp_uvel_se, tmp_vvel_se, & + tmp_uvel_ne, tmp_vvel_ne, & + dxT , dyT , & + cxp , cyp , & + cxm , cym , & + divune , divunw , & + divuse , divusw , & + tensionne , tensionnw , & + tensionse , tensionsw , & + shearne , shearnw , & + shearse , shearsw , & + Deltane , Deltanw , & + Deltase , Deltasw ) + + use ice_kinds_mod + + real (kind=dbl_kind), intent(in) :: & + tmp_uvel_ee, tmp_vvel_ee, tmp_uvel_se, tmp_vvel_se, & + tmp_uvel_cc, tmp_vvel_cc, tmp_uvel_ne, tmp_vvel_ne + + real (kind=dbl_kind), intent(in) :: & + dxT , & ! width of T-cell through the middle (m) + dyT , & ! height of T-cell through the middle (m) + cyp , & ! 1.5*HTE - 0.5*HTW + cxp , & ! 1.5*HTN - 0.5*HTS + cym , & ! 0.5*HTE - 1.5*HTW + cxm ! 0.5*HTN - 1.5*HTS + + real (kind=dbl_kind), intent(out):: & ! at each corner : + divune, divunw, divuse, divusw , & ! divergence + tensionne, tensionnw, tensionse, tensionsw, & ! tension + shearne, shearnw, shearse, shearsw , & ! shearing + Deltane, Deltanw, Deltase, Deltasw ! Delta + + character(len=*), parameter :: subname = '(strain_rates_1d)' + + !----------------------------------------------------------------------------- + ! strain rates + ! NOTE these are actually strain rates * area (m^2/s) + !----------------------------------------------------------------------------- + + ! divergence = e_11 + e_22 + divune = cyp*tmp_uvel_cc - dyT*tmp_uvel_ee & + + cxp*tmp_vvel_cc - dxT*tmp_vvel_se + + divunw = cym*tmp_uvel_ee + dyT*tmp_uvel_cc & + + cxp*tmp_vvel_ee - dxT*tmp_vvel_ne + + divusw = cym*tmp_uvel_ne + dyT*tmp_uvel_se & + + cxm*tmp_vvel_ne + dxT*tmp_vvel_ee + + divuse = cyp*tmp_uvel_se - dyT*tmp_uvel_ne & + + cxm*tmp_vvel_se + dxT*tmp_vvel_cc + + ! tension strain rate = e_11 - e_22 + tensionne = -cym*tmp_uvel_cc - dyT*tmp_uvel_ee & + +cxm*tmp_vvel_cc + dxT*tmp_vvel_se + + tensionnw = -cyp*tmp_uvel_ee + dyT*tmp_uvel_cc& + +cxm*tmp_vvel_ee + dxT*tmp_vvel_ne + + tensionsw = -cyp*tmp_uvel_ne + dyT*tmp_uvel_se & + +cxp*tmp_vvel_ne - dxT*tmp_vvel_ee + + tensionse = -cym*tmp_uvel_se - dyT*tmp_uvel_ne & + +cxp*tmp_vvel_se - dxT*tmp_vvel_cc + + ! shearing strain rate = 2*e_12 + shearne = -cym*tmp_vvel_cc - dyT*tmp_vvel_ee & + -cxm*tmp_uvel_cc - dxT*tmp_uvel_se + + shearnw = -cyp*tmp_vvel_ee + dyT*tmp_vvel_cc & + -cxm*tmp_uvel_ee - dxT*tmp_uvel_ne + + shearsw = -cyp*tmp_vvel_ne + dyT*tmp_vvel_se & + -cxp*tmp_uvel_ne + dxT*tmp_uvel_ee + + shearse = -cym*tmp_vvel_se - dyT*tmp_vvel_ne & + -cxp*tmp_uvel_se + dxT*tmp_uvel_cc + + ! Delta (in the denominator of zeta, eta) + Deltane = sqrt(divune**2 + e_factor*(tensionne**2 + shearne**2)) + Deltanw = sqrt(divunw**2 + e_factor*(tensionnw**2 + shearnw**2)) + Deltasw = sqrt(divusw**2 + e_factor*(tensionsw**2 + shearsw**2)) + Deltase = sqrt(divuse**2 + e_factor*(tensionse**2 + shearse**2)) + + end subroutine strain_rates_1d + + !============================================================================= + ! Calculation of the surface stresses + ! Integration of the momentum equation to find velocity (u,v) + ! author: Elizabeth C. Hunke, LANL + subroutine stepu_1d (lb , ub , & + Cw , aiX , & + uocn , vocn , & + waterx , watery , & + forcex , forcey , & + umassdti , fm , & + uarear , & + uvel_init, vvel_init, & + uvel , vvel , & + str1 , str2 , & + str3 , str4 , & + str5 , str6 , & + str7 , str8 , & + nw , sw , & + sse , skipme , & + Tbu, Cb, rhow) + + use ice_kinds_mod + use ice_dyn_shared, only: brlx, revp, u0, cosw, sinw + implicit none + + ! arguments ------------------------------------------------------------------ + integer(kind=int_kind), intent(in) :: lb,ub + integer(kind=int_kind), intent(in), dimension(:), contiguous :: nw,sw,sse + logical(kind=log_kind), intent(in), dimension(:), contiguous :: skipme + real (kind=dbl_kind), intent(in), dimension(:), contiguous :: & + Tbu, & ! coefficient for basal stress (N/m^2) + uvel_init,& ! x-component of velocity (m/s), beginning of timestep + vvel_init,& ! y-component of velocity (m/s), beginning of timestep + aiX, & ! ice fraction on u-grid + waterx, & ! for ocean stress calculation, x (m/s) + watery, & ! for ocean stress calculation, y (m/s) + forcex, & ! work array: combined atm stress and ocn tilt, x + forcey, & ! work array: combined atm stress and ocn tilt, y + Umassdti, & ! mass of U-cell/dt (kg/m^2 s) + uocn, & ! ocean current, x-direction (m/s) + vocn, & ! ocean current, y-direction (m/s) + fm, & ! Coriolis param. * mass in U-cell (kg/s) + uarear, & ! 1/uarea + Cw + + real (kind=dbl_kind),dimension(:), intent(in), contiguous :: & + str1,str2,str3,str4,str5,str6,str7,str8 + real (kind=dbl_kind),dimension(:), intent(inout), contiguous :: & + uvel, vvel + ! basal stress coefficient + real (kind=dbl_kind),dimension(:), intent(out), contiguous :: Cb + + real (kind=dbl_kind), intent(in) :: rhow + + ! local variables + integer (kind=int_kind) :: iw + + real (kind=dbl_kind) ::& + uold, vold , & ! old-time uvel, vvel + vrel , & ! relative ice-ocean velocity + cca,ccb,ab2,cc1,cc2,& ! intermediate variables + taux, tauy, & ! part of ocean stress term + strintx, strinty ! internal strength, changed to scalar and calculated after + real (kind=dbl_kind) :: & + tmp_str2_nw,tmp_str3_sse,tmp_str4_sw, & + tmp_str6_sse,tmp_str7_nw,tmp_str8_sw + + character(len=*), parameter :: subname = '(stepu_1d)' + + !----------------------------------------------------------------------------- + ! integrate the momentum equation + !----------------------------------------------------------------------------- +#ifdef _OPENMP_TARGET + !$omp target teams distribute parallel do +#else + !$omp parallel do schedule(runtime) & + !$omp default(none) & + !$omp private(iw, tmp_str2_nw,tmp_str3_sse,tmp_str4_sw, & + !$omp tmp_str6_sse,tmp_str7_nw,tmp_str8_sw, & + !$omp vrel, uold, vold, taux, tauy, cca, ccb, ab2, & + !$omp cc1, cc2,strintx, strinty) & + !$omp shared(uvel,vvel,str1,str2,str3,str4,str5,str6,str7,str8, & + !$omp Cb,nw,sw,sse,skipme,Tbu,uvel_init,vvel_init, & + !$omp aiX,waterx,watery,forcex,forcey,Umassdti,uocn,vocn,fm,uarear, & + !$omp Cw,lb,ub,brlx, revp, rhow) +#endif + do iw = lb, ub + if (skipme(iw)) cycle + + uold = uvel(iw) + vold = vvel(iw) + + ! (magnitude of relative ocean current)*rhow*drag*aice + vrel = aiX(iw)*rhow*Cw(iw)*sqrt((uocn(iw)-uold)**2+(vocn(iw)-vold)**2) + ! ice/ocean stress + taux = vrel*waterx(iw) ! NOTE this is not the entire + tauy = vrel*watery(iw) ! ocn stress term + + Cb(iw) = Tbu(iw) / (sqrt(uold**2 + vold**2) + u0) ! for basal stress + + ! revp = 0 for classic evp, 1 for revised evp + cca = (brlx + revp)*umassdti(iw) + vrel * cosw + Cb(iw) ! kg/m^2 s + ccb = fm(iw) + sign(c1,fm(iw)) * vrel * sinw ! kg/m^2 s + + ab2 = cca**2 + ccb**2 + + tmp_str2_nw = str2(nw(iw)) + tmp_str3_sse = str3(sse(iw)) + tmp_str4_sw = str4(sw(iw)) + tmp_str6_sse = str6(sse(iw)) + tmp_str7_nw = str7(nw(iw)) + tmp_str8_sw = str8(sw(iw)) + + ! divergence of the internal stress tensor + strintx = uarear(iw)*(str1(iw)+tmp_str2_nw+tmp_str3_sse+tmp_str4_sw) + strinty = uarear(iw)*(str5(iw)+tmp_str6_sse+tmp_str7_nw+tmp_str8_sw) + + ! finally, the velocity components + cc1 = strintx + forcex(iw) + taux & + + umassdti(iw)*(brlx*uold + revp*uvel_init(iw)) + cc2 = strinty + forcey(iw) + tauy & + + umassdti(iw)*(brlx*vold + revp*vvel_init(iw)) + uvel(iw) = (cca*cc1 + ccb*cc2) / ab2 ! m/s + vvel(iw) = (cca*cc2 - ccb*cc1) / ab2 + + ! calculate seabed stress component for outputs + ! only needed on last iteration. + enddo + +#ifdef _OPENMP_TARGET + !$omp end target teams distribute parallel do +#else + !$omp end parallel do +#endif + end subroutine stepu_1d + + !============================================================================= + ! calculates strintx and strinty if needed + subroutine calc_diag_1d (lb , ub , & + uarear , skipme , & + str1 , str2 , & + str3 , str4 , & + str5 , str6 , & + str7 , str8 , & + nw , sw , & + sse , & + strintx, strinty) + + use ice_kinds_mod + + real (kind=dbl_kind),dimension(:), intent(in), contiguous :: & + str1,str2,str3,str4,str5,str6,str7,str8 + real (kind=dbl_kind),dimension(:), intent(inout), contiguous :: & + strintx, strinty + + integer(kind=int_kind), intent(in) :: lb,ub + integer(kind=int_kind), intent(in), dimension(:), contiguous :: nw,sw,sse + logical(kind=log_kind), intent(in), dimension(:), contiguous :: skipme + real (kind=dbl_kind), intent(in), dimension(:), contiguous :: uarear + + ! local variables + integer (kind=int_kind) :: iw + real (kind=dbl_kind) :: & + tmp_str2_nw,tmp_str3_sse,tmp_str4_sw, & + tmp_str6_sse,tmp_str7_nw,tmp_str8_sw + + character(len=*), parameter :: subname = '(calc_diag_1d)' + +#ifdef _OPENMP_TARGET + !$omp target teams distribute parallel do +#else + !$omp parallel do schedule(runtime) & + !$omp default(none) & + !$omp private(iw, tmp_str2_nw,tmp_str3_sse,tmp_str4_sw, & + !$omp tmp_str6_sse,tmp_str7_nw,tmp_str8_sw) & + !$omp shared(strintx,strinty,str1,str2,str3,str4,str5,str6,str7,str8, & + !$omp nw,sw,sse,skipme, uarear, lb,ub) +#endif + + do iw = lb, ub + if (skipme(iw)) cycle + + tmp_str2_nw = str2(nw(iw)) + tmp_str3_sse = str3(sse(iw)) + tmp_str4_sw = str4(sw(iw)) + tmp_str6_sse = str6(sse(iw)) + tmp_str7_nw = str7(nw(iw)) + tmp_str8_sw = str8(sw(iw)) + + ! divergence of the internal stress tensor + strintx(iw) = uarear(iw)*(str1(iw)+tmp_str2_nw+tmp_str3_sse+tmp_str4_sw) + strinty(iw) = uarear(iw)*(str5(iw)+tmp_str6_sse+tmp_str7_nw+tmp_str8_sw) + enddo + +#ifdef _OPENMP_TARGET + !$omp end target teams distribute parallel do +#else + !$omp end parallel do +#endif + + end subroutine calc_diag_1d + +end module ice_dyn_core1d diff --git a/cicecore/cicedyn/dynamics/ice_dyn_evp.F90 b/cicecore/cicedyn/dynamics/ice_dyn_evp.F90 index a24c8f57d..ee832e447 100644 --- a/cicecore/cicedyn/dynamics/ice_dyn_evp.F90 +++ b/cicecore/cicedyn/dynamics/ice_dyn_evp.F90 @@ -119,19 +119,24 @@ module ice_dyn_evp ! Elastic-viscous-plastic dynamics driver ! subroutine init_evp - use ice_blocks, only: nx_block, ny_block - use ice_domain_size, only: max_blocks - use ice_grid, only: grid_ice + use ice_blocks, only: nx_block, ny_block, nghost + use ice_domain_size, only: max_blocks, nx_global, ny_global + use ice_grid, only: grid_ice, dyT, dxT, uarear, tmask, G_HTE, G_HTN use ice_calendar, only: dt_dyn - use ice_dyn_shared, only: init_dyn_shared + use ice_dyn_shared, only: init_dyn_shared, evp_algorithm + use ice_dyn_evp1d, only: dyn_evp1d_init !allocate c and cd grid var. Follow structucre of eap integer (int_kind) :: ierr - character(len=*), parameter :: subname = '(alloc_dyn_evp)' + character(len=*), parameter :: subname = '(init_evp)' call init_dyn_shared(dt_dyn) + if (evp_algorithm == "shared_mem_1d" ) then + call dyn_evp1d_init + endif + allocate( uocnU (nx_block,ny_block,max_blocks), & ! i ocean current (m/s) vocnU (nx_block,ny_block,max_blocks), & ! j ocean current (m/s) ss_tltxU (nx_block,ny_block,max_blocks), & ! sea surface slope, x-direction (m/m) @@ -196,6 +201,7 @@ subroutine init_evp end subroutine init_evp +!======================================================================= #ifdef CICE_IN_NEMO ! Wind stress is set during this routine from the values supplied ! via NEMO (unless calc_strair is true). These values are supplied @@ -241,14 +247,13 @@ subroutine evp (dt) uvelE, vvelE, divu, shear, & aice_init, aice0, aicen, vicen, strength use ice_timers, only: timer_dynamics, timer_bound, & - ice_timer_start, ice_timer_stop, timer_evp_1d, timer_evp_2d - use ice_dyn_evp_1d, only: ice_dyn_evp_1d_copyin, ice_dyn_evp_1d_kernel, & - ice_dyn_evp_1d_copyout + ice_timer_start, ice_timer_stop, timer_evp use ice_dyn_shared, only: evp_algorithm, stack_fields, unstack_fields, & DminTarea, visc_method, deformations, deformationsC_T, deformationsCD_T, & strain_rates_U, & iceTmask, iceUmask, iceEmask, iceNmask, & dyn_haloUpdate, fld2, fld3, fld4 + use ice_dyn_evp1d, only: dyn_evp1d_run real (kind=dbl_kind), intent(in) :: & dt ! time step @@ -793,40 +798,23 @@ subroutine evp (dt) endif - if (evp_algorithm == "shared_mem_1d" ) then + call ice_timer_start(timer_evp) - if (trim(grid_type) == 'tripole') then - call abort_ice(trim(subname)//' & - & Kernel not tested on tripole grid. Set evp_algorithm=standard_2d') - endif + if (grid_ice == "B") then - call ice_timer_start(timer_evp_1d) - call ice_dyn_evp_1d_copyin( & - nx_block,ny_block,nblocks,nx_global+2*nghost,ny_global+2*nghost, & - iceTmask, iceUmask, & - cdn_ocnU,aiU,uocnU,vocnU,forcexU,forceyU,TbU, & - umassdti,fmU,uarear,tarear,strintxU,strintyU,uvel_init,vvel_init,& - strength,uvel,vvel,dxT,dyT, & - stressp_1 ,stressp_2, stressp_3, stressp_4, & - stressm_1 ,stressm_2, stressm_3, stressm_4, & - stress12_1,stress12_2,stress12_3,stress12_4 ) - call ice_dyn_evp_1d_kernel() - call ice_dyn_evp_1d_copyout( & - nx_block,ny_block,nblocks,nx_global+2*nghost,ny_global+2*nghost, & -!strocn uvel,vvel, strocnxU,strocnyU, strintxU,strintyU, & - uvel,vvel, strintxU,strintyU, & - stressp_1, stressp_2, stressp_3, stressp_4, & - stressm_1, stressm_2, stressm_3, stressm_4, & - stress12_1,stress12_2,stress12_3,stress12_4, & - divu,rdg_conv,rdg_shear,shear,taubxU,taubyU ) - call ice_timer_stop(timer_evp_1d) - - else ! evp_algorithm == standard_2d (Standard CICE) - - call ice_timer_start(timer_evp_2d) + if (evp_algorithm == "shared_mem_1d" ) then - if (grid_ice == "B") then + call dyn_evp1d_run(stressp_1 , stressp_2, stressp_3 , stressp_4 , & + stressm_1 , stressm_2 , stressm_3 , stressm_4 , & + stress12_1, stress12_2, stress12_3, stress12_4, & + strength , & + cdn_ocnU , aiu , uocnU , vocnU , & + waterxU , wateryU , forcexU , forceyU , & + umassdti , fmU , strintxU , strintyU , & + Tbu , taubxU , taubyU , uvel , & + vvel , icetmask , iceUmask) + else ! evp_algorithm == standard_2d (Standard CICE) do ksub = 1,ndte ! subcycling !$OMP PARALLEL DO PRIVATE(iblk,strtmp) SCHEDULE(runtime) @@ -851,7 +839,7 @@ subroutine evp (dt) stressm_3 (:,:,iblk), stressm_4 (:,:,iblk), & stress12_1(:,:,iblk), stress12_2(:,:,iblk), & stress12_3(:,:,iblk), stress12_4(:,:,iblk), & - strtmp (:,:,:) ) + strtmp (:,:,:)) !----------------------------------------------------------------- ! momentum equation @@ -881,406 +869,405 @@ subroutine evp (dt) uvel, vvel) enddo ! sub cycling + endif ! evp algorithm + + !----------------------------------------------------------------- + ! save quantities for mechanical redistribution + !----------------------------------------------------------------- + + !$OMP PARALLEL DO PRIVATE(iblk) SCHEDULE(runtime) + do iblk = 1, nblocks + call deformations (nx_block , ny_block , & + icellT (iblk), & + indxTi (:,iblk), indxTj (:,iblk), & + uvel (:,:,iblk), vvel (:,:,iblk), & + dxT (:,:,iblk), dyT (:,:,iblk), & + cxp (:,:,iblk), cyp (:,:,iblk), & + cxm (:,:,iblk), cym (:,:,iblk), & + tarear (:,:,iblk), & + shear (:,:,iblk), divu (:,:,iblk), & + rdg_conv(:,:,iblk), rdg_shear(:,:,iblk) ) + enddo + !$OMP END PARALLEL DO + + elseif (grid_ice == "C") then + + do ksub = 1,ndte ! subcycling + + !$OMP PARALLEL DO PRIVATE(iblk) + do iblk = 1, nblocks !----------------------------------------------------------------- - ! save quantities for mechanical redistribution + ! strain rates at U point + ! NOTE these are actually strain rates * area (m^2/s) !----------------------------------------------------------------- + call strain_rates_U (nx_block , ny_block , & + icellU (iblk), & + indxUi (:,iblk), indxUj (:,iblk), & + uvelE (:,:,iblk), vvelE (:,:,iblk), & + uvelN (:,:,iblk), vvelN (:,:,iblk), & + uvel (:,:,iblk), vvel (:,:,iblk), & + dxE (:,:,iblk), dyN (:,:,iblk), & + dxU (:,:,iblk), dyU (:,:,iblk), & + ratiodxN(:,:,iblk), ratiodxNr(:,:,iblk), & + ratiodyE(:,:,iblk), ratiodyEr(:,:,iblk), & + epm (:,:,iblk), npm (:,:,iblk), & + divergU (:,:,iblk), tensionU (:,:,iblk), & + shearU (:,:,iblk), deltaU (:,:,iblk) ) + + enddo ! iblk + !$OMP END PARALLEL DO - !$OMP PARALLEL DO PRIVATE(iblk) SCHEDULE(runtime) + ! calls ice_haloUpdate, controls bundles and masks + call dyn_haloUpdate (halo_info, halo_info_mask, & + field_loc_NEcorner, field_type_scalar, & + shearU) + + !$OMP PARALLEL DO PRIVATE(iblk) do iblk = 1, nblocks - call deformations (nx_block , ny_block , & - icellT (iblk), & - indxTi (:,iblk), indxTj (:,iblk), & - uvel (:,:,iblk), vvel (:,:,iblk), & - dxT (:,:,iblk), dyT (:,:,iblk), & - cxp (:,:,iblk), cyp (:,:,iblk), & - cxm (:,:,iblk), cym (:,:,iblk), & - tarear (:,:,iblk), & - shear (:,:,iblk), divu (:,:,iblk), & - rdg_conv(:,:,iblk), rdg_shear(:,:,iblk) ) + call stressC_T (nx_block , ny_block , & + icellT (iblk), & + indxTi (:,iblk), indxTj (:,iblk), & + uvelE (:,:,iblk), vvelE (:,:,iblk), & + uvelN (:,:,iblk), vvelN (:,:,iblk), & + dxN (:,:,iblk), dyE (:,:,iblk), & + dxT (:,:,iblk), dyT (:,:,iblk), & + uarea (:,:,iblk), DminTarea (:,:,iblk), & + strength (:,:,iblk), shearU (:,:,iblk), & + zetax2T (:,:,iblk), etax2T (:,:,iblk), & + stresspT (:,:,iblk), stressmT (:,:,iblk), & + stress12T (:,:,iblk)) + enddo !$OMP END PARALLEL DO + ! calls ice_haloUpdate, controls bundles and masks + call dyn_haloUpdate (halo_info, halo_info_mask, & + field_loc_center, field_type_scalar, & + zetax2T, etax2T, stresspT, stressmT) - elseif (grid_ice == "C") then - - do ksub = 1,ndte ! subcycling + if (visc_method == 'avg_strength') then + call grid_average_X2Y('S', strength, 'T', strengthU, 'U') + elseif (visc_method == 'avg_zeta') then + call grid_average_X2Y('S', etax2T , 'T', etax2U , 'U') + endif - !$OMP PARALLEL DO PRIVATE(iblk) - do iblk = 1, nblocks + !$OMP PARALLEL DO PRIVATE(iblk) + do iblk = 1, nblocks + call stressC_U (nx_block , ny_block , & + icellU (iblk), & + indxUi (:,iblk), indxUj (:,iblk), & + uarea (:,:,iblk), & + etax2U (:,:,iblk), deltaU (:,:,iblk), & + strengthU (:,:,iblk), shearU (:,:,iblk), & + stress12U (:,:,iblk)) + enddo + !$OMP END PARALLEL DO - !----------------------------------------------------------------- - ! strain rates at U point - ! NOTE these are actually strain rates * area (m^2/s) - !----------------------------------------------------------------- - call strain_rates_U (nx_block , ny_block , & - icellU (iblk), & - indxUi (:,iblk), indxUj (:,iblk), & - uvelE (:,:,iblk), vvelE (:,:,iblk), & - uvelN (:,:,iblk), vvelN (:,:,iblk), & - uvel (:,:,iblk), vvel (:,:,iblk), & - dxE (:,:,iblk), dyN (:,:,iblk), & - dxU (:,:,iblk), dyU (:,:,iblk), & - ratiodxN(:,:,iblk), ratiodxNr(:,:,iblk), & - ratiodyE(:,:,iblk), ratiodyEr(:,:,iblk), & - epm (:,:,iblk), npm (:,:,iblk), & - divergU (:,:,iblk), tensionU (:,:,iblk), & - shearU (:,:,iblk), deltaU (:,:,iblk) ) + ! calls ice_haloUpdate, controls bundles and masks + call dyn_haloUpdate (halo_info , halo_info_mask, & + field_loc_NEcorner, field_type_scalar, & + stress12U) - enddo ! iblk - !$OMP END PARALLEL DO + !$OMP PARALLEL DO PRIVATE(iblk) + do iblk = 1, nblocks - ! calls ice_haloUpdate, controls bundles and masks - call dyn_haloUpdate (halo_info, halo_info_mask, & - field_loc_NEcorner, field_type_scalar, & - shearU) + call div_stress_Ex (nx_block , ny_block , & + icellE (iblk), & + indxEi (:,iblk), indxEj (:,iblk), & + dxE (:,:,iblk), dyE (:,:,iblk), & + dxU (:,:,iblk), dyT (:,:,iblk), & + earear (:,:,iblk) , & + stresspT (:,:,iblk), stressmT (:,:,iblk), & + stress12U (:,:,iblk), strintxE (:,:,iblk) ) + + call div_stress_Ny (nx_block , ny_block , & + icellN (iblk), & + indxNi (:,iblk), indxNj (:,iblk), & + dxN (:,:,iblk), dyN (:,:,iblk), & + dxT (:,:,iblk), dyU (:,:,iblk), & + narear (:,:,iblk) , & + stresspT (:,:,iblk), stressmT (:,:,iblk), & + stress12U (:,:,iblk), strintyN (:,:,iblk) ) - !$OMP PARALLEL DO PRIVATE(iblk) - do iblk = 1, nblocks - call stressC_T (nx_block , ny_block , & - icellT (iblk), & - indxTi (:,iblk), indxTj (:,iblk), & - uvelE (:,:,iblk), vvelE (:,:,iblk), & - uvelN (:,:,iblk), vvelN (:,:,iblk), & - dxN (:,:,iblk), dyE (:,:,iblk), & - dxT (:,:,iblk), dyT (:,:,iblk), & - uarea (:,:,iblk), DminTarea (:,:,iblk), & - strength (:,:,iblk), shearU (:,:,iblk), & - zetax2T (:,:,iblk), etax2T (:,:,iblk), & - stresspT (:,:,iblk), stressmT (:,:,iblk), & - stress12T (:,:,iblk)) + enddo + !$OMP END PARALLEL DO - enddo - !$OMP END PARALLEL DO + !$OMP PARALLEL DO PRIVATE(iblk) + do iblk = 1, nblocks - ! calls ice_haloUpdate, controls bundles and masks - call dyn_haloUpdate (halo_info, halo_info_mask, & - field_loc_center, field_type_scalar, & - zetax2T, etax2T, stresspT, stressmT) - - if (visc_method == 'avg_strength') then - call grid_average_X2Y('S', strength, 'T', strengthU, 'U') - elseif (visc_method == 'avg_zeta') then - call grid_average_X2Y('S', etax2T , 'T', etax2U , 'U') - endif + call stepu_C (nx_block , ny_block , & ! u, E point + icellE (iblk), Cdn_ocnE (:,:,iblk), & + indxEi (:,iblk), indxEj (:,iblk), & + aiE (:,:,iblk), & + uocnE (:,:,iblk), vocnE (:,:,iblk), & + waterxE (:,:,iblk), forcexE (:,:,iblk), & + emassdti (:,:,iblk), fmE (:,:,iblk), & + strintxE (:,:,iblk), taubxE (:,:,iblk), & + uvelE_init(:,:,iblk), & + uvelE (:,:,iblk), vvelE (:,:,iblk), & + TbE (:,:,iblk)) - !$OMP PARALLEL DO PRIVATE(iblk) - do iblk = 1, nblocks - call stressC_U (nx_block , ny_block , & - icellU (iblk), & - indxUi (:,iblk), indxUj (:,iblk), & - uarea (:,:,iblk), & - etax2U (:,:,iblk), deltaU (:,:,iblk), & - strengthU (:,:,iblk), shearU (:,:,iblk), & - stress12U (:,:,iblk)) - enddo - !$OMP END PARALLEL DO + call stepv_C (nx_block, ny_block, & ! v, N point + icellN (iblk), Cdn_ocnN (:,:,iblk), & + indxNi (:,iblk), indxNj (:,iblk), & + aiN (:,:,iblk), & + uocnN (:,:,iblk), vocnN (:,:,iblk), & + wateryN (:,:,iblk), forceyN (:,:,iblk), & + nmassdti (:,:,iblk), fmN (:,:,iblk), & + strintyN (:,:,iblk), taubyN (:,:,iblk), & + vvelN_init(:,:,iblk), & + uvelN (:,:,iblk), vvelN (:,:,iblk), & + TbN (:,:,iblk)) + enddo + !$OMP END PARALLEL DO - ! calls ice_haloUpdate, controls bundles and masks - call dyn_haloUpdate (halo_info , halo_info_mask, & - field_loc_NEcorner, field_type_scalar, & - stress12U) + ! calls ice_haloUpdate, controls bundles and masks + call dyn_haloUpdate (halo_info, halo_info_mask, & + field_loc_Eface, field_type_vector, & + uvelE) + call dyn_haloUpdate (halo_info, halo_info_mask, & + field_loc_Nface, field_type_vector, & + vvelN) - !$OMP PARALLEL DO PRIVATE(iblk) - do iblk = 1, nblocks + call grid_average_X2Y('A', uvelE, 'E', uvelN, 'N') + call grid_average_X2Y('A', vvelN, 'N', vvelE, 'E') + uvelN(:,:,:) = uvelN(:,:,:)*npm(:,:,:) + vvelE(:,:,:) = vvelE(:,:,:)*epm(:,:,:) - call div_stress_Ex (nx_block , ny_block , & - icellE (iblk), & - indxEi (:,iblk), indxEj (:,iblk), & - dxE (:,:,iblk), dyE (:,:,iblk), & - dxU (:,:,iblk), dyT (:,:,iblk), & - earear (:,:,iblk) , & - stresspT (:,:,iblk), stressmT (:,:,iblk), & - stress12U (:,:,iblk), strintxE (:,:,iblk) ) - - call div_stress_Ny (nx_block , ny_block , & - icellN (iblk), & - indxNi (:,iblk), indxNj (:,iblk), & - dxN (:,:,iblk), dyN (:,:,iblk), & - dxT (:,:,iblk), dyU (:,:,iblk), & - narear (:,:,iblk) , & - stresspT (:,:,iblk), stressmT (:,:,iblk), & - stress12U (:,:,iblk), strintyN (:,:,iblk) ) + ! calls ice_haloUpdate, controls bundles and masks + call dyn_haloUpdate (halo_info, halo_info_mask, & + field_loc_Nface, field_type_vector, & + uvelN) + call dyn_haloUpdate (halo_info, halo_info_mask, & + field_loc_Eface, field_type_vector, & + vvelE) - enddo - !$OMP END PARALLEL DO + call grid_average_X2Y('S', uvelE, 'E', uvel, 'U') + call grid_average_X2Y('S', vvelN, 'N', vvel, 'U') - !$OMP PARALLEL DO PRIVATE(iblk) - do iblk = 1, nblocks + uvel(:,:,:) = uvel(:,:,:)*uvm(:,:,:) + vvel(:,:,:) = vvel(:,:,:)*uvm(:,:,:) + ! U fields at NE corner + ! calls ice_haloUpdate, controls bundles and masks + call dyn_haloUpdate (halo_info, halo_info_mask, & + field_loc_NEcorner, field_type_vector, & + uvel, vvel) - call stepu_C (nx_block , ny_block , & ! u, E point - icellE (iblk), Cdn_ocnE (:,:,iblk), & - indxEi (:,iblk), indxEj (:,iblk), & - aiE (:,:,iblk), & - uocnE (:,:,iblk), vocnE (:,:,iblk), & - waterxE (:,:,iblk), forcexE (:,:,iblk), & - emassdti (:,:,iblk), fmE (:,:,iblk), & - strintxE (:,:,iblk), taubxE (:,:,iblk), & - uvelE_init(:,:,iblk), & - uvelE (:,:,iblk), vvelE (:,:,iblk), & - TbE (:,:,iblk)) + enddo ! subcycling - call stepv_C (nx_block, ny_block, & ! v, N point - icellN (iblk), Cdn_ocnN (:,:,iblk), & - indxNi (:,iblk), indxNj (:,iblk), & - aiN (:,:,iblk), & - uocnN (:,:,iblk), vocnN (:,:,iblk), & - wateryN (:,:,iblk), forceyN (:,:,iblk), & - nmassdti (:,:,iblk), fmN (:,:,iblk), & - strintyN (:,:,iblk), taubyN (:,:,iblk), & - vvelN_init(:,:,iblk), & - uvelN (:,:,iblk), vvelN (:,:,iblk), & - TbN (:,:,iblk)) - enddo - !$OMP END PARALLEL DO - - ! calls ice_haloUpdate, controls bundles and masks - call dyn_haloUpdate (halo_info, halo_info_mask, & - field_loc_Eface, field_type_vector, & - uvelE) - call dyn_haloUpdate (halo_info, halo_info_mask, & - field_loc_Nface, field_type_vector, & - vvelN) - - call grid_average_X2Y('A', uvelE, 'E', uvelN, 'N') - call grid_average_X2Y('A', vvelN, 'N', vvelE, 'E') - uvelN(:,:,:) = uvelN(:,:,:)*npm(:,:,:) - vvelE(:,:,:) = vvelE(:,:,:)*epm(:,:,:) + !----------------------------------------------------------------- + ! save quantities for mechanical redistribution + !----------------------------------------------------------------- - ! calls ice_haloUpdate, controls bundles and masks - call dyn_haloUpdate (halo_info, halo_info_mask, & - field_loc_Nface, field_type_vector, & - uvelN) - call dyn_haloUpdate (halo_info, halo_info_mask, & - field_loc_Eface, field_type_vector, & - vvelE) - - call grid_average_X2Y('S', uvelE, 'E', uvel, 'U') - call grid_average_X2Y('S', vvelN, 'N', vvel, 'U') - - uvel(:,:,:) = uvel(:,:,:)*uvm(:,:,:) - vvel(:,:,:) = vvel(:,:,:)*uvm(:,:,:) - ! U fields at NE corner - ! calls ice_haloUpdate, controls bundles and masks - call dyn_haloUpdate (halo_info, halo_info_mask, & - field_loc_NEcorner, field_type_vector, & - uvel, vvel) + !$OMP PARALLEL DO PRIVATE(iblk) SCHEDULE(runtime) + do iblk = 1, nblocks + call deformationsC_T (nx_block , ny_block , & + icellT (iblk), & + indxTi (:,iblk), indxTj (:,iblk), & + uvelE (:,:,iblk), vvelE (:,:,iblk), & + uvelN (:,:,iblk), vvelN (:,:,iblk), & + dxN (:,:,iblk), dyE (:,:,iblk), & + dxT (:,:,iblk), dyT (:,:,iblk), & + tarear (:,:,iblk), uarea (:,:,iblk), & + shearU (:,:,iblk), & + shear (:,:,iblk), divu (:,:,iblk), & + rdg_conv(:,:,iblk), rdg_shear(:,:,iblk)) + enddo + !$OMP END PARALLEL DO - enddo ! subcycling + elseif (grid_ice == "CD") then - !----------------------------------------------------------------- - ! save quantities for mechanical redistribution - !----------------------------------------------------------------- + do ksub = 1,ndte ! subcycling - !$OMP PARALLEL DO PRIVATE(iblk) SCHEDULE(runtime) + !$OMP PARALLEL DO PRIVATE(iblk) do iblk = 1, nblocks - call deformationsC_T (nx_block , ny_block , & - icellT (iblk), & - indxTi (:,iblk), indxTj (:,iblk), & - uvelE (:,:,iblk), vvelE (:,:,iblk), & - uvelN (:,:,iblk), vvelN (:,:,iblk), & - dxN (:,:,iblk), dyE (:,:,iblk), & - dxT (:,:,iblk), dyT (:,:,iblk), & - tarear (:,:,iblk), uarea (:,:,iblk), & - shearU (:,:,iblk), & - shear (:,:,iblk), divu (:,:,iblk), & - rdg_conv(:,:,iblk), rdg_shear(:,:,iblk)) + call stressCD_T (nx_block , ny_block , & + icellT (iblk), & + indxTi (:,iblk), indxTj (:,iblk), & + uvelE (:,:,iblk), vvelE (:,:,iblk), & + uvelN (:,:,iblk), vvelN (:,:,iblk), & + dxN (:,:,iblk), dyE (:,:,iblk), & + dxT (:,:,iblk), dyT (:,:,iblk), & + DminTarea (:,:,iblk), & + strength (:,:,iblk), & + zetax2T (:,:,iblk), etax2T (:,:,iblk), & + stresspT (:,:,iblk), stressmT (:,:,iblk), & + stress12T (:,:,iblk) ) + enddo !$OMP END PARALLEL DO - elseif (grid_ice == "CD") then + ! calls ice_haloUpdate, controls bundles and masks + call dyn_haloUpdate (halo_info, halo_info_mask, & + field_loc_center, field_type_scalar, & + zetax2T, etax2T) - do ksub = 1,ndte ! subcycling + if (visc_method == 'avg_strength') then + call grid_average_X2Y('S', strength, 'T', strengthU, 'U') + elseif (visc_method == 'avg_zeta') then + call grid_average_X2Y('S', zetax2T , 'T', zetax2U , 'U') + call grid_average_X2Y('S', etax2T , 'T', etax2U , 'U') + endif - !$OMP PARALLEL DO PRIVATE(iblk) - do iblk = 1, nblocks - call stressCD_T (nx_block , ny_block , & - icellT (iblk), & - indxTi (:,iblk), indxTj (:,iblk), & - uvelE (:,:,iblk), vvelE (:,:,iblk), & - uvelN (:,:,iblk), vvelN (:,:,iblk), & - dxN (:,:,iblk), dyE (:,:,iblk), & - dxT (:,:,iblk), dyT (:,:,iblk), & - DminTarea (:,:,iblk), & - strength (:,:,iblk), & - zetax2T (:,:,iblk), etax2T (:,:,iblk), & - stresspT (:,:,iblk), stressmT (:,:,iblk), & - stress12T (:,:,iblk) ) + !$OMP PARALLEL DO PRIVATE(iblk) + do iblk = 1, nblocks + !----------------------------------------------------------------- + ! strain rates at U point + ! NOTE these are actually strain rates * area (m^2/s) + !----------------------------------------------------------------- + call strain_rates_U (nx_block , ny_block , & + icellU (iblk), & + indxUi (:,iblk), indxUj (:,iblk), & + uvelE (:,:,iblk), vvelE (:,:,iblk), & + uvelN (:,:,iblk), vvelN (:,:,iblk), & + uvel (:,:,iblk), vvel (:,:,iblk), & + dxE (:,:,iblk), dyN (:,:,iblk), & + dxU (:,:,iblk), dyU (:,:,iblk), & + ratiodxN (:,:,iblk), ratiodxNr(:,:,iblk), & + ratiodyE (:,:,iblk), ratiodyEr(:,:,iblk), & + epm (:,:,iblk), npm (:,:,iblk), & + divergU (:,:,iblk), tensionU (:,:,iblk), & + shearU (:,:,iblk), DeltaU (:,:,iblk) ) + + call stressCD_U (nx_block , ny_block , & + icellU (iblk), & + indxUi (:,iblk), indxUj (:,iblk), & + uarea (:,:,iblk), & + zetax2U (:,:,iblk), etax2U (:,:,iblk), & + strengthU(:,:,iblk), & + divergU (:,:,iblk), tensionU (:,:,iblk), & + shearU (:,:,iblk), DeltaU (:,:,iblk), & + stresspU (:,:,iblk), stressmU (:,:,iblk), & + stress12U(:,:,iblk)) + enddo + !$OMP END PARALLEL DO - enddo - !$OMP END PARALLEL DO + ! calls ice_haloUpdate, controls bundles and masks + call dyn_haloUpdate (halo_info, halo_info_mask, & + field_loc_center, field_type_scalar, & + stresspT, stressmT, stress12T) + call dyn_haloUpdate (halo_info, halo_info_mask, & + field_loc_NEcorner,field_type_scalar, & + stresspU, stressmU, stress12U) - ! calls ice_haloUpdate, controls bundles and masks - call dyn_haloUpdate (halo_info, halo_info_mask, & - field_loc_center, field_type_scalar, & - zetax2T, etax2T) - - if (visc_method == 'avg_strength') then - call grid_average_X2Y('S', strength, 'T', strengthU, 'U') - elseif (visc_method == 'avg_zeta') then - call grid_average_X2Y('S', zetax2T , 'T', zetax2U , 'U') - call grid_average_X2Y('S', etax2T , 'T', etax2U , 'U') - endif + !$OMP PARALLEL DO PRIVATE(iblk) + do iblk = 1, nblocks - !$OMP PARALLEL DO PRIVATE(iblk) - do iblk = 1, nblocks - !----------------------------------------------------------------- - ! strain rates at U point - ! NOTE these are actually strain rates * area (m^2/s) - !----------------------------------------------------------------- - call strain_rates_U (nx_block , ny_block , & - icellU (iblk), & - indxUi (:,iblk), indxUj (:,iblk), & - uvelE (:,:,iblk), vvelE (:,:,iblk), & - uvelN (:,:,iblk), vvelN (:,:,iblk), & - uvel (:,:,iblk), vvel (:,:,iblk), & - dxE (:,:,iblk), dyN (:,:,iblk), & - dxU (:,:,iblk), dyU (:,:,iblk), & - ratiodxN (:,:,iblk), ratiodxNr(:,:,iblk), & - ratiodyE (:,:,iblk), ratiodyEr(:,:,iblk), & - epm (:,:,iblk), npm (:,:,iblk), & - divergU (:,:,iblk), tensionU (:,:,iblk), & - shearU (:,:,iblk), DeltaU (:,:,iblk) ) - - call stressCD_U (nx_block , ny_block , & - icellU (iblk), & - indxUi (:,iblk), indxUj (:,iblk), & - uarea (:,:,iblk), & - zetax2U (:,:,iblk), etax2U (:,:,iblk), & - strengthU(:,:,iblk), & - divergU (:,:,iblk), tensionU (:,:,iblk), & - shearU (:,:,iblk), DeltaU (:,:,iblk), & - stresspU (:,:,iblk), stressmU (:,:,iblk), & - stress12U(:,:,iblk)) - enddo - !$OMP END PARALLEL DO + call div_stress_Ex (nx_block , ny_block , & + icellE (iblk), & + indxEi (:,iblk), indxEj (:,iblk), & + dxE (:,:,iblk), dyE (:,:,iblk), & + dxU (:,:,iblk), dyT (:,:,iblk), & + earear (:,:,iblk) , & + stresspT (:,:,iblk), stressmT (:,:,iblk), & + stress12U (:,:,iblk), strintxE (:,:,iblk) ) + + call div_stress_Ey (nx_block , ny_block , & + icellE (iblk), & + indxEi (:,iblk), indxEj (:,iblk), & + dxE (:,:,iblk), dyE (:,:,iblk), & + dxU (:,:,iblk), dyT (:,:,iblk), & + earear (:,:,iblk) , & + stresspU (:,:,iblk), stressmU (:,:,iblk), & + stress12T (:,:,iblk), strintyE (:,:,iblk) ) + + call div_stress_Nx (nx_block , ny_block , & + icellN (iblk), & + indxNi (:,iblk), indxNj (:,iblk), & + dxN (:,:,iblk), dyN (:,:,iblk), & + dxT (:,:,iblk), dyU (:,:,iblk), & + narear (:,:,iblk) , & + stresspU (:,:,iblk), stressmU (:,:,iblk), & + stress12T (:,:,iblk), strintxN (:,:,iblk) ) + + call div_stress_Ny (nx_block , ny_block , & + icellN (iblk), & + indxNi (:,iblk), indxNj (:,iblk), & + dxN (:,:,iblk), dyN (:,:,iblk), & + dxT (:,:,iblk), dyU (:,:,iblk), & + narear (:,:,iblk) , & + stresspT (:,:,iblk), stressmT (:,:,iblk), & + stress12U (:,:,iblk), strintyN (:,:,iblk) ) - ! calls ice_haloUpdate, controls bundles and masks - call dyn_haloUpdate (halo_info, halo_info_mask, & - field_loc_center, field_type_scalar, & - stresspT, stressmT, stress12T) - call dyn_haloUpdate (halo_info, halo_info_mask, & - field_loc_NEcorner,field_type_scalar, & - stresspU, stressmU, stress12U) - - !$OMP PARALLEL DO PRIVATE(iblk) - do iblk = 1, nblocks + enddo + !$OMP END PARALLEL DO - call div_stress_Ex (nx_block , ny_block , & - icellE (iblk), & - indxEi (:,iblk), indxEj (:,iblk), & - dxE (:,:,iblk), dyE (:,:,iblk), & - dxU (:,:,iblk), dyT (:,:,iblk), & - earear (:,:,iblk) , & - stresspT (:,:,iblk), stressmT (:,:,iblk), & - stress12U (:,:,iblk), strintxE (:,:,iblk) ) - - call div_stress_Ey (nx_block , ny_block , & - icellE (iblk), & - indxEi (:,iblk), indxEj (:,iblk), & - dxE (:,:,iblk), dyE (:,:,iblk), & - dxU (:,:,iblk), dyT (:,:,iblk), & - earear (:,:,iblk) , & - stresspU (:,:,iblk), stressmU (:,:,iblk), & - stress12T (:,:,iblk), strintyE (:,:,iblk) ) - - call div_stress_Nx (nx_block , ny_block , & - icellN (iblk), & - indxNi (:,iblk), indxNj (:,iblk), & - dxN (:,:,iblk), dyN (:,:,iblk), & - dxT (:,:,iblk), dyU (:,:,iblk), & - narear (:,:,iblk) , & - stresspU (:,:,iblk), stressmU (:,:,iblk), & - stress12T (:,:,iblk), strintxN (:,:,iblk) ) - - call div_stress_Ny (nx_block , ny_block , & - icellN (iblk), & - indxNi (:,iblk), indxNj (:,iblk), & - dxN (:,:,iblk), dyN (:,:,iblk), & - dxT (:,:,iblk), dyU (:,:,iblk), & - narear (:,:,iblk) , & - stresspT (:,:,iblk), stressmT (:,:,iblk), & - stress12U (:,:,iblk), strintyN (:,:,iblk) ) + !$OMP PARALLEL DO PRIVATE(iblk) + do iblk = 1, nblocks - enddo - !$OMP END PARALLEL DO + call stepuv_CD (nx_block , ny_block , & ! E point + icellE (iblk), Cdn_ocnE (:,:,iblk), & + indxEi (:,iblk), indxEj (:,iblk), & + aiE (:,:,iblk), & + uocnE (:,:,iblk), vocnE (:,:,iblk), & + waterxE (:,:,iblk), wateryE (:,:,iblk), & + forcexE (:,:,iblk), forceyE (:,:,iblk), & + emassdti (:,:,iblk), fmE (:,:,iblk), & + strintxE (:,:,iblk), strintyE (:,:,iblk), & + taubxE (:,:,iblk), taubyE (:,:,iblk), & + uvelE_init(:,:,iblk), vvelE_init(:,:,iblk), & + uvelE (:,:,iblk), vvelE (:,:,iblk), & + TbE (:,:,iblk)) + + call stepuv_CD (nx_block , ny_block , & ! N point + icellN (iblk), Cdn_ocnN (:,:,iblk), & + indxNi (:,iblk), indxNj (:,iblk), & + aiN (:,:,iblk), & + uocnN (:,:,iblk), vocnN (:,:,iblk), & + waterxN (:,:,iblk), wateryN (:,:,iblk), & + forcexN (:,:,iblk), forceyN (:,:,iblk), & + nmassdti (:,:,iblk), fmN (:,:,iblk), & + strintxN (:,:,iblk), strintyN (:,:,iblk), & + taubxN (:,:,iblk), taubyN (:,:,iblk), & + uvelN_init(:,:,iblk), vvelN_init(:,:,iblk), & + uvelN (:,:,iblk), vvelN (:,:,iblk), & + TbN (:,:,iblk)) + enddo + !$OMP END PARALLEL DO - !$OMP PARALLEL DO PRIVATE(iblk) - do iblk = 1, nblocks + ! calls ice_haloUpdate, controls bundles and masks + call dyn_haloUpdate (halo_info, halo_info_mask, & + field_loc_Eface, field_type_vector, & + uvelE, vvelE) + call dyn_haloUpdate (halo_info, halo_info_mask, & + field_loc_Nface, field_type_vector, & + uvelN, vvelN) - call stepuv_CD (nx_block , ny_block , & ! E point - icellE (iblk), Cdn_ocnE (:,:,iblk), & - indxEi (:,iblk), indxEj (:,iblk), & - aiE (:,:,iblk), & - uocnE (:,:,iblk), vocnE (:,:,iblk), & - waterxE (:,:,iblk), wateryE (:,:,iblk), & - forcexE (:,:,iblk), forceyE (:,:,iblk), & - emassdti (:,:,iblk), fmE (:,:,iblk), & - strintxE (:,:,iblk), strintyE (:,:,iblk), & - taubxE (:,:,iblk), taubyE (:,:,iblk), & - uvelE_init(:,:,iblk), vvelE_init(:,:,iblk), & - uvelE (:,:,iblk), vvelE (:,:,iblk), & - TbE (:,:,iblk)) - - call stepuv_CD (nx_block , ny_block , & ! N point - icellN (iblk), Cdn_ocnN (:,:,iblk), & - indxNi (:,iblk), indxNj (:,iblk), & - aiN (:,:,iblk), & - uocnN (:,:,iblk), vocnN (:,:,iblk), & - waterxN (:,:,iblk), wateryN (:,:,iblk), & - forcexN (:,:,iblk), forceyN (:,:,iblk), & - nmassdti (:,:,iblk), fmN (:,:,iblk), & - strintxN (:,:,iblk), strintyN (:,:,iblk), & - taubxN (:,:,iblk), taubyN (:,:,iblk), & - uvelN_init(:,:,iblk), vvelN_init(:,:,iblk), & - uvelN (:,:,iblk), vvelN (:,:,iblk), & - TbN (:,:,iblk)) - enddo - !$OMP END PARALLEL DO + call grid_average_X2Y('S', uvelE, 'E', uvel, 'U') + call grid_average_X2Y('S', vvelN, 'N', vvel, 'U') - ! calls ice_haloUpdate, controls bundles and masks - call dyn_haloUpdate (halo_info, halo_info_mask, & - field_loc_Eface, field_type_vector, & - uvelE, vvelE) - call dyn_haloUpdate (halo_info, halo_info_mask, & - field_loc_Nface, field_type_vector, & - uvelN, vvelN) - - call grid_average_X2Y('S', uvelE, 'E', uvel, 'U') - call grid_average_X2Y('S', vvelN, 'N', vvel, 'U') - - uvel(:,:,:) = uvel(:,:,:)*uvm(:,:,:) - vvel(:,:,:) = vvel(:,:,:)*uvm(:,:,:) + uvel(:,:,:) = uvel(:,:,:)*uvm(:,:,:) + vvel(:,:,:) = vvel(:,:,:)*uvm(:,:,:) ! U fields at NE corner ! calls ice_haloUpdate, controls bundles and masks - call dyn_haloUpdate (halo_info, halo_info_mask, & - field_loc_NEcorner, field_type_vector, & - uvel, vvel) + call dyn_haloUpdate (halo_info, halo_info_mask, & + field_loc_NEcorner, field_type_vector, & + uvel, vvel) - enddo ! subcycling + enddo ! subcycling - !----------------------------------------------------------------- - ! save quantities for mechanical redistribution - !----------------------------------------------------------------- + !----------------------------------------------------------------- + ! save quantities for mechanical redistribution + !----------------------------------------------------------------- - !$OMP PARALLEL DO PRIVATE(iblk) - do iblk = 1, nblocks - call deformationsCD_T (nx_block , ny_block , & - icellT (iblk), & - indxTi (:,iblk), indxTj (:,iblk), & - uvelE (:,:,iblk), vvelE (:,:,iblk), & - uvelN (:,:,iblk), vvelN (:,:,iblk), & - dxN (:,:,iblk), dyE (:,:,iblk), & - dxT (:,:,iblk), dyT (:,:,iblk), & - tarear (:,:,iblk), & - shear (:,:,iblk), divu (:,:,iblk), & - rdg_conv(:,:,iblk), rdg_shear(:,:,iblk)) - enddo - !$OMP END PARALLEL DO - endif ! grid_ice + !$OMP PARALLEL DO PRIVATE(iblk) + do iblk = 1, nblocks + call deformationsCD_T (nx_block , ny_block , & + icellT (iblk), & + indxTi (:,iblk), indxTj (:,iblk), & + uvelE (:,:,iblk), vvelE (:,:,iblk), & + uvelN (:,:,iblk), vvelN (:,:,iblk), & + dxN (:,:,iblk), dyE (:,:,iblk), & + dxT (:,:,iblk), dyT (:,:,iblk), & + tarear (:,:,iblk), & + shear (:,:,iblk), divu (:,:,iblk), & + rdg_conv(:,:,iblk), rdg_shear(:,:,iblk)) + enddo + !$OMP END PARALLEL DO + endif ! grid_ice - call ice_timer_stop(timer_evp_2d) - endif ! evp_algorithm + call ice_timer_stop(timer_evp) if (maskhalo_dyn) then call ice_HaloDestroy(halo_info_mask) @@ -1439,7 +1426,7 @@ subroutine stress (nx_block, ny_block, & stress12_3, stress12_4, & str ) - use ice_dyn_shared, only: strain_rates, visc_replpress, capping + use ice_dyn_shared, only: strain_rates, visc_replpress integer (kind=int_kind), intent(in) :: & nx_block, ny_block, & ! block dimensions @@ -1532,16 +1519,16 @@ subroutine stress (nx_block, ny_block, & !----------------------------------------------------------------- call visc_replpress (strength(i,j), DminTarea(i,j), Deltane, & - zetax2ne, etax2ne, rep_prsne, capping) + zetax2ne, etax2ne, rep_prsne) call visc_replpress (strength(i,j), DminTarea(i,j), Deltanw, & - zetax2nw, etax2nw, rep_prsnw, capping) + zetax2nw, etax2nw, rep_prsnw) call visc_replpress (strength(i,j), DminTarea(i,j), Deltasw, & - zetax2sw, etax2sw, rep_prssw, capping) + zetax2sw, etax2sw, rep_prssw) call visc_replpress (strength(i,j), DminTarea(i,j), Deltase, & - zetax2se, etax2se, rep_prsse, capping) + zetax2se, etax2se, rep_prsse) !----------------------------------------------------------------- ! the stresses ! kg/s^2 @@ -1549,7 +1536,6 @@ subroutine stress (nx_block, ny_block, & !----------------------------------------------------------------- ! NOTE: for comp. efficiency 2 x zeta and 2 x eta are used in the code - stressp_1 (i,j) = (stressp_1 (i,j)*(c1-arlx1i*revp) & + arlx1i*(zetax2ne*divune - rep_prsne)) * denom1 stressp_2 (i,j) = (stressp_2 (i,j)*(c1-arlx1i*revp) & @@ -1736,7 +1722,7 @@ subroutine stressC_T (nx_block, ny_block , & stresspT , stressmT , & stress12T) - use ice_dyn_shared, only: strain_rates_T, capping, & + use ice_dyn_shared, only: strain_rates_T, & visc_replpress, e_factor integer (kind=int_kind), intent(in) :: & @@ -1829,7 +1815,7 @@ subroutine stressC_T (nx_block, ny_block , & !----------------------------------------------------------------- call visc_replpress (strength(i,j), DminTarea(i,j), DeltaT, & - zetax2T (i,j), etax2T(i,j), rep_prsT, capping) + zetax2T (i,j), etax2T(i,j), rep_prsT) !----------------------------------------------------------------- ! the stresses ! kg/s^2 @@ -1872,7 +1858,7 @@ subroutine stressC_U (nx_block , ny_block ,& stress12U) use ice_dyn_shared, only: visc_replpress, & - visc_method, deltaminEVP, capping + visc_method, deltaminEVP integer (kind=int_kind), intent(in) :: & nx_block, ny_block, & ! block dimensions @@ -1928,7 +1914,7 @@ subroutine stressC_U (nx_block , ny_block ,& ! only need etax2U here, but other terms are calculated with etax2U ! minimal extra calculations here even though it seems like there is call visc_replpress (strengthU(i,j), DminUarea, deltaU(i,j), & - lzetax2U , letax2U , lrep_prsU , capping) + lzetax2U , letax2U , lrep_prsU) stress12U(i,j) = (stress12U(i,j)*(c1-arlx1i*revp) & + arlx1i*p5*letax2U*shearU(i,j)) * denom1 enddo @@ -1956,7 +1942,7 @@ subroutine stressCD_T (nx_block, ny_block , & stresspT, stressmT , & stress12T) - use ice_dyn_shared, only: strain_rates_T, capping, & + use ice_dyn_shared, only: strain_rates_T, & visc_replpress integer (kind=int_kind), intent(in) :: & @@ -2026,7 +2012,7 @@ subroutine stressCD_T (nx_block, ny_block , & !----------------------------------------------------------------- call visc_replpress (strength(i,j), DminTarea(i,j), DeltaT(i,j), & - zetax2T (i,j), etax2T(i,j), rep_prsT , capping) + zetax2T (i,j), etax2T(i,j), rep_prsT) !----------------------------------------------------------------- ! the stresses ! kg/s^2 @@ -2065,7 +2051,7 @@ subroutine stressCD_U (nx_block, ny_block, & stress12U) use ice_dyn_shared, only: visc_replpress, & - visc_method, deltaminEVP, capping + visc_method, deltaminEVP integer (kind=int_kind), intent(in) :: & nx_block, ny_block, & ! block dimensions @@ -2123,7 +2109,7 @@ subroutine stressCD_U (nx_block, ny_block, & ! only need etax2U here, but other terms are calculated with etax2U ! minimal extra calculations here even though it seems like there is call visc_replpress (strengthU(i,j), DminUarea, deltaU(i,j), & - lzetax2U , letax2U , lrep_prsU , capping) + lzetax2U , letax2U , lrep_prsU ) endif !----------------------------------------------------------------- diff --git a/cicecore/cicedyn/dynamics/ice_dyn_evp1d.F90 b/cicecore/cicedyn/dynamics/ice_dyn_evp1d.F90 new file mode 100644 index 000000000..223ef2849 --- /dev/null +++ b/cicecore/cicedyn/dynamics/ice_dyn_evp1d.F90 @@ -0,0 +1,1467 @@ +! Module for 1d evp dynamics +! Mimics the 2d B grid solver +! functions in this module includes conversion from 1d to 2d and vice versa. +! cpp flag _OPENMP_TARGET is for gpu. Otherwize optimized for cpu +! FIXME: For now it allocates all water point, which in most cases could be avoided. +!=============================================================================== +! Created by Till Rasmussen (DMI), Mads Hvid Ribergaard (DMI), and Jacob W. Poulsen, Intel + +module ice_dyn_evp1d + + !- modules ------------------------------------------------------------------- + use ice_kinds_mod + use ice_blocks, only: nx_block, ny_block, nghost + use ice_constants + use ice_communicate, only: my_task, master_task + use ice_domain_size, only: max_blocks, nx_global, ny_global + use ice_fileunits, only: nu_diag + use ice_exit, only: abort_ice + + !- directives ---------------------------------------------------------------- + implicit none + private + + !- public routines ----------------------------------------------------------- + public :: dyn_evp1d_init, dyn_evp1d_run, dyn_evp1d_finalize + + !- private routines ---------------------------------------------------------- + + !- private vars -------------------------------------------------------------- + ! nx and ny are module variables for arrays after gather (G_*) Dimension according to CICE is + ! nx_global+2*nghost, ny_global+2*nghost + ! nactive are number of active points (both t and u). navel is number of active + integer(kind=int_kind), save :: nx, ny, nActive, navel, nallocated + + ! indexes + integer(kind=int_kind), allocatable, dimension(:,:) :: iwidx + logical(kind=log_kind), allocatable, dimension(:) :: skipTcell,skipUcell + integer(kind=int_kind), allocatable, dimension(:) :: ee,ne,se,nw,sw,sse ! arrays for neighbour points + integer(kind=int_kind), allocatable, dimension(:) :: indxti, indxtj, indxTij + + ! 1D arrays to allocate + + ! Grid + real (kind=dbl_kind), allocatable, dimension(:) :: & + HTE_1d,HTN_1d, HTEm1_1d,HTNm1_1d, dxT_1d, dyT_1d, uarear_1d + + ! time varying + real(kind=dbl_kind) , allocatable, dimension(:) :: & + cdn_ocn,aiu,uocn,vocn,waterxU,wateryU,forcexU,forceyU,umassdti,fmU, & + strintxU,strintyU,uvel_init,vvel_init, strength, uvel, vvel, & + stressp_1, stressp_2, stressp_3, stressp_4, stressm_1, stressm_2, & + stressm_3, stressm_4, stress12_1, stress12_2, stress12_3, stress12_4, & + str1, str2, str3, str4, str5, str6, str7, str8, Tbu, Cb + + ! halo updates for circular domains + integer(kind=int_kind), allocatable, dimension(:) :: & + halo_parent_outer_east , halo_parent_outer_west , & + halo_parent_outer_north, halo_parent_outer_south, & + halo_inner_east , halo_inner_west , & + halo_inner_north , halo_inner_south + + ! number of halo points (same for inner and outer) + integer(kind=int_kind) :: & + n_inner_east, n_inner_west, n_inner_north, n_inner_south + +!============================================================================= + contains +!============================================================================= +! module public subroutines +! In addition all water points are assumed to be active and allocated thereafter. +!============================================================================= + + subroutine dyn_evp1d_init + + use ice_grid, only: G_HTE, G_HTN + + implicit none + + ! local variables + + real(kind=dbl_kind) , allocatable, dimension(:,:) :: G_dyT, G_dxT, G_uarear + logical(kind=log_kind), allocatable, dimension(:,:) :: G_tmask + + integer(kind=int_kind) :: ios, ierr + + character(len=*), parameter :: subname = '(dyn_evp1d_init)' + + nx=nx_global+2*nghost + ny=ny_global+2*nghost + + allocate(G_dyT(nx,ny),G_dxT(nx,ny),G_uarear(nx,ny),G_tmask(nx,ny),stat=ierr) + if (ierr/=0) then + call abort_ice(subname//' ERROR: allocating', file=__FILE__, line=__LINE__) + endif + + ! gather from blks to global + call gather_static(G_uarear, G_dxT, G_dyT, G_tmask) + + ! calculate number of water points (T and U). Only needed for the static version + ! tmask in ocean/ice + if (my_task == master_task) then + call calc_nActiveTU(G_tmask,nActive) + call evp1d_alloc_static_na(nActive) + call calc_2d_indices_init(nActive, G_tmask) + call calc_navel(nActive, navel) + call evp1d_alloc_static_navel(navel) + call numainit(1,nActive,navel) + call convert_2d_1d_init(nActive,G_HTE, G_HTN, G_uarear, G_dxT, G_dyT) + call evp1d_alloc_static_halo() + endif + + deallocate(G_dyT,G_dxT,G_uarear,G_tmask,stat=ierr) + if (ierr/=0) then + call abort_ice(subname//' ERROR: deallocating', file=__FILE__, line=__LINE__) + endif + + end subroutine dyn_evp1d_init + +!============================================================================= + + subroutine dyn_evp1d_run(L_stressp_1 , L_stressp_2 , L_stressp_3 , L_stressp_4 , & + L_stressm_1 , L_stressm_2 , L_stressm_3 , L_stressm_4 , & + L_stress12_1, L_stress12_2, L_stress12_3, L_stress12_4, & + L_strength, & + L_cdn_ocn , L_aiu , L_uocn , L_vocn , & + L_waterxU , L_wateryU , L_forcexU , L_forceyU , & + L_umassdti , L_fmU , L_strintxU , L_strintyU , & + L_Tbu , L_taubxU , L_taubyU , L_uvel , & + L_vvel , L_icetmask , L_iceUmask) + + use ice_dyn_shared, only : ndte + use ice_dyn_core1d, only : stress_1d, stepu_1d, calc_diag_1d + use ice_timers , only : ice_timer_start, ice_timer_stop, timer_evp1dcore + + use icepack_intfc , only : icepack_query_parameters, icepack_warnings_flush, & + icepack_warnings_aborted + + implicit none + + ! nx_block, ny_block, max_blocks + real(kind=dbl_kind) , dimension(:,:,:), intent(inout) :: & + L_stressp_1 , L_stressp_2 , L_stressp_3 , L_stressp_4 , & + L_stressm_1 , L_stressm_2 , L_stressm_3 , L_stressm_4 , & + L_stress12_1, L_stress12_2, L_stress12_3, L_stress12_4, & + L_strintxU , L_strintyU , L_uvel , L_vvel , & + L_taubxU , L_taubyU + real(kind=dbl_kind) , dimension(:,:,:), intent(in) :: & + L_strength , & + L_cdn_ocn , L_aiu , L_uocn , L_vocn , & + L_waterxU , L_wateryU , L_forcexU , L_forceyU, & + L_umassdti , L_fmU , L_Tbu + logical(kind=log_kind), dimension(:,:,:), intent(in) :: & + L_iceUmask , L_iceTmask + + ! local variables + + ! nx, ny + real(kind=dbl_kind), dimension(nx,ny) :: & + G_stressp_1 , G_stressp_2 , G_stressp_3 , G_stressp_4 , & + G_stressm_1 , G_stressm_2 , G_stressm_3 , G_stressm_4 , & + G_stress12_1, G_stress12_2, G_stress12_3, G_stress12_4, & + G_strength, & + G_cdn_ocn , G_aiu , G_uocn , G_vocn , & + G_waterxU , G_wateryU , G_forcexU , G_forceyU , & + G_umassdti , G_fmU , G_strintxU , G_strintyU , & + G_Tbu , G_uvel , G_vvel , G_taubxU , & + G_taubyU ! G_taubxU and G_taubyU are post processed from Cb + logical(kind=log_kind), dimension (nx,ny) :: & + G_iceUmask , G_iceTmask + + character(len=*), parameter :: subname = '(dyn_evp1d_run)' + + integer(kind=int_kind) :: ksub + + real (kind=dbl_kind) :: rhow + + ! From 3d to 2d on master task + call gather_dyn(L_stressp_1 , L_stressp_2 , L_stressp_3 , L_stressp_4 , & + L_stressm_1 , L_stressm_2 , L_stressm_3 , L_stressm_4 , & + L_stress12_1, L_stress12_2, L_stress12_3, L_stress12_4, & + L_strength, & + L_cdn_ocn , L_aiu , L_uocn , L_vocn , & + L_waterxU , L_wateryU , L_forcexU , L_forceyU , & + L_umassdti , L_fmU , & + L_Tbu , L_uvel , L_vvel , & + L_icetmask , L_iceUmask , & + G_stressp_1 , G_stressp_2 , G_stressp_3 , G_stressp_4 , & + G_stressm_1 , G_stressm_2 , G_stressm_3 , G_stressm_4 , & + G_stress12_1, G_stress12_2, G_stress12_3, G_stress12_4, & + G_strength , & + G_cdn_ocn , G_aiu , G_uocn , G_vocn , & + G_waterxU , G_wateryU , G_forcexU , G_forceyU , & + G_umassdti , G_fmU , & + G_Tbu , G_uvel , G_vvel , & + G_iceTmask, G_iceUmask) + + if (my_task == master_task) then + call set_skipMe(G_iceTmask, G_iceUmask,nActive) + ! Map from 2d to 1d + call convert_2d_1d_dyn(nActive, & + G_stressp_1 , G_stressp_2 , G_stressp_3 , G_stressp_4, & + G_stressm_1 , G_stressm_2 , G_stressm_3 , G_stressm_4, & + G_stress12_1, G_stress12_2, G_stress12_3, G_stress12_4, & + G_strength, & + G_cdn_ocn , G_aiu , G_uocn , G_vocn , & + G_waterxU , G_wateryU , G_forcexU , G_forceyU , & + G_umassdti , G_fmU , & + G_Tbu , G_uvel , G_vvel) + + call calc_halo_parent(Nactive,navel) + + ! map from cpu to gpu (to) and back. + ! This could be optimized considering which variables change from time step to time step + ! and which are constant. + ! in addition initialization of Cb and str1, str2, str3, str4, str5, str6, str7, str8 + call icepack_query_parameters(rhow_out=rhow) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + + call ice_timer_start(timer_evp1dcore) +#ifdef _OPENMP_TARGET + !$omp target data map(to: ee, ne, se, nw, sw, sse, skipUcell, skipTcell,& + !$omp strength, dxT_1d, dyT_1d, HTE_1d,HTN_1d,HTEm1_1d, & + !$omp HTNm1_1d,forcexU, forceyU, umassdti, fmU, & + !$omp uarear_1d,uvel_init, vvel_init, Tbu, Cb, & + !$omp str1, str2, str3, str4, str5, str6, str7, str8, & + !$omp cdn_ocn, aiu, uocn, vocn, waterxU, wateryU, rhow & + !$omp map(tofrom: uvel,vvel, & + !$omp stressp_1, stressp_2, stressp_3, stressp_4, & + !$omp stressm_1, stressm_2, stressm_3, stressm_4, & + !$omp stress12_1,stress12_2,stress12_3,stress12_4) + !$omp target update to(arlx1i,denom1,capping,deltaminEVP,e_factor,epp2i,brlx) +#endif + ! initialization of str? in order to avoid influence from old time steps + str1(1:navel)=c0 + str2(1:navel)=c0 + str3(1:navel)=c0 + str4(1:navel)=c0 + str5(1:navel)=c0 + str6(1:navel)=c0 + str7(1:navel)=c0 + str8(1:navel)=c0 + + do ksub = 1,ndte ! subcycling + call stress_1d (ee, ne, se, 1, nActive, & + uvel, vvel, dxT_1d, dyT_1d, skipTcell, strength, & + HTE_1d, HTN_1d, HTEm1_1d, HTNm1_1d, & + stressp_1, stressp_2, stressp_3, stressp_4, & + stressm_1, stressm_2, stressm_3, stressm_4, & + stress12_1, stress12_2, stress12_3, stress12_4, & + str1, str2, str3, str4, str5, str6, str7, str8) + + call stepu_1d (1, nActive, cdn_ocn, aiu, uocn, vocn, & + waterxU, wateryU, forcexU, forceyU, umassdti, fmU, uarear_1d, & + uvel_init, vvel_init, uvel, vvel, & + str1, str2, str3, str4, str5, str6, str7, str8, & + nw, sw, sse, skipUcell, Tbu, Cb, rhow) + call evp1d_halo_update() + enddo + ! This can be skipped if diagnostics of strintx and strinty is not needed + ! They will either both be calculated or not. + call calc_diag_1d(1 , nActive , & + uarear_1d, skipUcell, & + str1 , str2 , & + str3 , str4 , & + str5 , str6 , & + str7 , str8 , & + nw , sw , & + sse , & + strintxU, strintyU) + + call ice_timer_stop(timer_evp1dcore) + +#ifdef _OPENMP_TARGET + !$omp end target data +#endif + ! Map results back to 2d + call convert_1d_2d_dyn(nActive, navel, & + G_stressp_1 , G_stressp_2 , G_stressp_3 , G_stressp_4 , & + G_stressm_1 , G_stressm_2 , G_stressm_3 , G_stressm_4 , & + G_stress12_1, G_stress12_2, G_stress12_3, G_stress12_4, & + G_strength , & + G_cdn_ocn , G_aiu , G_uocn , G_vocn , & + G_waterxU , G_wateryU , G_forcexU , G_forceyU , & + G_umassdti , G_fmU , G_strintxU , G_strintyU , & + G_Tbu , G_uvel , G_vvel , G_taubxU , & + G_taubyU) + + endif ! master_task + + call scatter_dyn(L_stressp_1 , L_stressp_2 , L_stressp_3 , L_stressp_4 , & + L_stressm_1 , L_stressm_2 , L_stressm_3 , L_stressm_4 , & + L_stress12_1, L_stress12_2, L_stress12_3, L_stress12_4, & + L_strintxU , L_strintyU , L_uvel , L_vvel , & + L_taubxU , L_taubyU , & + G_stressp_1 , G_stressp_2 , G_stressp_3 , G_stressp_4 , & + G_stressm_1 , G_stressm_2 , G_stressm_3 , G_stressm_4 , & + G_stress12_1, G_stress12_2, G_stress12_3, G_stress12_4, & + G_strintxU , G_strintyU , G_uvel , G_vvel , & + G_taubxU , G_taubyU) + ! calculate number of active points. allocate if initial or if array size should increase + ! call calc_nActiveTU(iceTmask_log,nActive, iceUmask) + ! if (nActiveold ==0) then ! first + ! call evp_1d_alloc(nActive, nActive,nx,ny) + ! nactiveold=nActive+buf1d ! allocate + ! call init_unionTU(nx, ny, iceTmask_log,iceUmask) + ! else if (nactiveold < nActive) then + ! write(nu_diag,*) 'Warning nActive is bigger than old allocation. Need to re allocate' + ! call evp_1d_dealloc() ! only deallocate if not first time step + ! call evp_1d_alloc(nActive, nActive,nx,ny) + ! nactiveold=nActive+buf1d ! allocate + ! call init_unionTU(nx, ny, iceTmask_log,iceUmask) + ! endif + ! call cp_2dto1d(nActive) + ! FIXME THIS IS THE LOGIC FOR RE ALLOCATION IF NEEDED + ! call add_1d(nx, ny, natmp, iceTmask_log, iceUmask, ts) + + end subroutine dyn_evp1d_run + +!============================================================================= + + subroutine dyn_evp1d_finalize() + implicit none + + character(len=*), parameter :: subname = '(dyn_evp1d_finalize)' + + if (my_task == master_task) then + write(nu_diag,*) 'Close evp 1d log' + endif + + end subroutine dyn_evp1d_finalize + +!============================================================================= + + subroutine evp1d_alloc_static_na(na0) + implicit none + + integer(kind=int_kind), intent(in) :: na0 + integer(kind=int_kind) :: ierr + character(len=*), parameter :: subname = '(evp1d_alloc_static_na)' + + allocate(skipTcell(1:na0), & + skipUcell(1:na0), & + iwidx(1:nx,1:ny), & + stat=ierr) + + if (ierr/=0) then + call abort_ice(subname//' ERROR: allocating', file=__FILE__, line=__LINE__) + endif + + + allocate(indxTi(1:na0), & + indxTj(1:na0), & + stat=ierr) + + if (ierr/=0) then + call abort_ice(subname//' ERROR: allocating', file=__FILE__, line=__LINE__) + endif + + allocate(ee(1:na0) , & + ne(1:na0) , & + se(1:na0) , & + nw(1:na0) , & + sw(1:na0) , & + sse(1:na0), & + stat=ierr) + + if (ierr/=0) then + call abort_ice(subname//' ERROR: allocating', file=__FILE__, line=__LINE__) + endif + + allocate( HTE_1d (1:na0), & + HTN_1d (1:na0), & + HTEm1_1d (1:na0), & + HTNm1_1d (1:na0), & + dxT_1d (1:na0), & + dyT_1d (1:na0), & + strength (1:na0), & + stressp_1 (1:na0), & + stressp_2 (1:na0), & + stressp_3 (1:na0), & + stressp_4 (1:na0), & + stressm_1 (1:na0), & + stressm_2 (1:na0), & + stressm_3 (1:na0), & + stressm_4 (1:na0), & + stress12_1(1:na0), & + stress12_2(1:na0), & + stress12_3(1:na0), & + stress12_4(1:na0), & + stat=ierr) + + if (ierr/=0) then + call abort_ice(subname//' ERROR: allocating', file=__FILE__, line=__LINE__) + endif + + allocate(cdn_ocn (1:na0), aiu (1:na0), & + uocn (1:na0), vocn (1:na0), & + waterxU (1:na0), wateryU (1:na0), & + forcexU (1:na0), forceyU (1:na0), & + umassdti (1:na0), fmU (1:na0), & + uarear_1d(1:na0), & + strintxU (1:na0), strintyU (1:na0), & + Tbu (1:na0), Cb (1:na0), & + uvel_init(1:na0), vvel_init(1:na0), & + stat=ierr) + + if (ierr/=0) then + call abort_ice(subname//' ERROR: allocating', file=__FILE__, line=__LINE__) + endif + + end subroutine evp1d_alloc_static_na + +!============================================================================= + + subroutine evp1d_alloc_static_navel(navel0) + implicit none + + integer(kind=int_kind), intent(in) :: navel0 + integer(kind=int_kind) :: ierr + character(len=*), parameter :: subname = '(evp1d_alloc_static_na)' + + allocate(str1(1:navel0) , str2(1:navel0), str3(1:navel0), & + str4(1:navel0) , str5(1:navel0), str6(1:navel0), & + str7(1:navel0) , str8(1:navel0), & + indxTij(1:navel0), uvel(1:navel0), vvel(1:navel0), & + stat=ierr) + + if (ierr/=0) then + call abort_ice(subname//' ERROR: allocating', file=__FILE__, line=__LINE__) + endif + + end subroutine evp1d_alloc_static_navel + +!============================================================================= + + subroutine evp1d_alloc_static_halo() + + implicit none + integer(kind=int_kind) :: ierr + character(len=*), parameter :: subname = '(evp1d_alloc_static_halo)' + + ! allocation of arrays to use for halo + ! These are the size of one of the dimensions of the global grid but they could be + ! reduced in size as only the number of active U points are used. + ! Points to send data from are in the "inner" vectors. Data in outer points are named "outer" + + allocate(halo_inner_east (ny), halo_inner_west (ny), & + halo_inner_north(nx), halo_inner_south(nx), & + stat=ierr) + + if (ierr/=0) then + call abort_ice(subname//' ERROR: allocating', file=__FILE__, line=__LINE__) + endif + + allocate(halo_parent_outer_east (ny), halo_parent_outer_west (ny), & + halo_parent_outer_north(nx), halo_parent_outer_south(nx), & + stat=ierr) + + if (ierr/=0) then + call abort_ice(subname//' ERROR: allocating', file=__FILE__, line=__LINE__) + endif + + end subroutine evp1d_alloc_static_halo + +!============================================================================= + + subroutine calc_nActiveTU(Tmask,na0, Umask) + + ! Calculate number of active points with a given mask. + + implicit none + logical(kind=log_kind), intent(in) :: Tmask(:,:) + logical(kind=log_kind), optional, intent(in) :: Umask(:,:) + integer(kind=int_kind), intent(out) :: na0 + integer(kind=int_kind) :: i,j + character(len=*), parameter :: subname = '(calc_nActivceTU)' + + na0=0 + if (present(Umask)) then + do i=1+nghost,nx + do j=1+nghost,ny + if ((Tmask(i,j)) .or. (Umask(i,j))) then + na0=na0+1 + endif + enddo + enddo + else + do i=1+nghost,nx + do j=1+nghost,ny + if (Tmask(i,j)) then + na0=na0+1 + endif + enddo + enddo + endif + + end subroutine calc_nActiveTU + +!============================================================================= + + subroutine set_skipMe(iceTmask, iceUmask,na0) + + implicit none + + logical(kind=log_kind), intent(in) :: iceTmask(:,:), iceUmask(:,:) + integer(kind=int_kind), intent(in) :: na0 + integer(kind=int_kind) :: iw, i, j, niw + character(len=*), parameter :: subname = '(set_skipMe)' + + skipUcell=.false. + skipTcell=.false. + niw=0 + ! first count + do iw=1, na0 + i = indxti(iw) + j = indxtj(iw) + if ( iceTmask(i,j) .or. iceUmask(i,j)) then + niw=niw+1 + endif + if (.not. (iceTmask(i,j))) skipTcell(iw)=.true. + if (.not. (iceUmask(i,j))) skipUcell(iw)=.true. + if (i == nx) skipUcell(iw)=.true. + if (j == ny) skipUcell(iw)=.true. + enddo + ! write(nu_diag,*) 'number of points and Active points', na0, niw + + end subroutine set_skipMe + +!============================================================================= + + subroutine calc_2d_indices_init(na0, Tmask) + ! All points are active. Need to find neighbors. + ! This should include de selection of u points. + + implicit none + + integer(kind=int_kind), intent(in) :: na0 + ! nx, ny + logical(kind=log_kind), dimension(:,:), intent(in) :: Tmask + + ! local variables + + integer(kind=int_kind) :: i, j, Nmaskt + character(len=*), parameter :: subname = '(calc_2d_indices_init)' + + indxti(:) = 0 + indxtj(:) = 0 + Nmaskt = 0 + ! NOTE: T mask includes northern and eastern ghost cells + do j = 1 + nghost, ny + do i = 1 + nghost, nx + if (Tmask(i,j)) then + Nmaskt = Nmaskt + 1 + indxti(Nmaskt) = i + indxtj(Nmaskt) = j + end if + end do + end do + + end subroutine calc_2d_indices_init + +!============================================================================= + + subroutine union(x, y, xdim, ydim, xy, nxy) + + ! Find union (xy) of two sorted integer vectors (x and y), i.e. + ! combined values of the two vectors with no repetitions + implicit none + integer(kind=int_kind), intent(in) :: xdim, ydim + integer(kind=int_kind), intent(in) :: x(1:xdim), y(1:ydim) + integer(kind=int_kind), intent(out) :: xy(1:xdim + ydim) + integer(kind=int_kind), intent(out) :: nxy + + ! local variables + + integer(kind=int_kind) :: i, j, k + character(len=*), parameter :: subname = '(union)' + + i = 1 + j = 1 + k = 1 + do while (i <= xdim .and. j <= ydim) + if (x(i) < y(j)) then + xy(k) = x(i) + i = i + 1 + else if (x(i) > y(j)) then + xy(k) = y(j) + j = j + 1 + else + xy(k) = x(i) + i = i + 1 + j = j + 1 + endif + k = k + 1 + enddo + + ! the rest + do while (i <= xdim) + xy(k) = x(i) + i = i + 1 + k = k + 1 + enddo + do while (j <= ydim) + xy(k) = y(j) + j = j + 1 + k = k + 1 + enddo + nxy = k - 1 + + end subroutine union + +!============================================================================= + + subroutine gather_static(G_uarear, G_dxT, G_dyT, G_Tmask) + + ! In standalone distrb_info is an integer. Not needed anyway + use ice_communicate, only : master_task + use ice_gather_scatter, only : gather_global_ext + use ice_domain, only : distrb_info + use ice_grid, only: dyT, dxT, uarear, tmask + implicit none + + ! nx, ny + real(kind=dbl_kind) , dimension(:,:), intent(out) :: G_uarear, G_dxT, G_dyT + logical(kind=log_kind), dimension(:,:), intent(out) :: G_Tmask + + character(len=*), parameter :: subname = '(gather_static)' + + ! copy from distributed I_* to G_* + call gather_global_ext(G_uarear, uarear, master_task, distrb_info) + call gather_global_ext(G_dxT , dxT , master_task, distrb_info) + call gather_global_ext(G_dyT , dyT , master_task, distrb_info) + call gather_global_ext(G_Tmask , Tmask , master_task, distrb_info) + + end subroutine gather_static + +!============================================================================= + + subroutine gather_dyn(L_stressp_1 , L_stressp_2 , L_stressp_3 , L_stressp_4 , & + L_stressm_1 , L_stressm_2 , L_stressm_3 , L_stressm_4 , & + L_stress12_1, L_stress12_2, L_stress12_3,L_stress12_4 , & + L_strength , & + L_cdn_ocn , L_aiu , L_uocn , L_vocn , & + L_waterxU , L_wateryU , L_forcexU , L_forceyU , & + L_umassdti , L_fmU , & + L_Tbu , L_uvel , L_vvel , & + L_icetmask , L_iceUmask , & + G_stressp_1 , G_stressp_2 , G_stressp_3 , G_stressp_4 , & + G_stressm_1 , G_stressm_2 , G_stressm_3 , G_stressm_4 , & + G_stress12_1, G_stress12_2, G_stress12_3, G_stress12_4, & + G_strength, & + G_cdn_ocn , G_aiu , G_uocn , G_vocn , & + G_waterxU , G_wateryU , G_forcexU , G_forceyU , & + G_umassdti , G_fmU , & + G_Tbu , G_uvel , G_vvel , & + G_iceTmask, G_iceUmask) + + use ice_communicate, only : master_task + use ice_gather_scatter, only : gather_global_ext + use ice_domain, only : distrb_info + implicit none + + ! nx_block, ny_block, max_blocks + real(kind=dbl_kind) , dimension(:,:,:), intent(in) :: & + L_stressp_1 , L_stressp_2 , L_stressp_3 , L_stressp_4 , & + L_stressm_1 , L_stressm_2 , L_stressm_3 , L_stressm_4 , & + L_stress12_1, L_stress12_2, L_stress12_3, L_stress12_4, & + L_strength , & + L_cdn_ocn , L_aiu , L_uocn , L_vocn , & + L_waterxU , L_wateryU , L_forcexU , L_forceyU , & + L_umassdti , L_fmU , & + L_Tbu , L_uvel , L_vvel + logical(kind=log_kind), dimension(:,:,:), intent(in) :: & + L_iceUmask , L_iceTmask + + ! nx, ny + real(kind=dbl_kind) , dimension(:,:), intent(out) :: & + G_stressp_1 , G_stressp_2 , G_stressp_3 , G_stressp_4 , & + G_stressm_1 , G_stressm_2 , G_stressm_3 , G_stressm_4 , & + G_stress12_1, G_stress12_2, G_stress12_3, G_stress12_4, & + G_strength, & + G_cdn_ocn , G_aiu , G_uocn , G_vocn , & + G_waterxU , G_wateryU , G_forcexU , G_forceyU , & + G_umassdti , G_fmU , & + G_Tbu , G_uvel , G_vvel + logical(kind=log_kind), dimension(:,:), intent(out) :: & + G_iceUmask , G_iceTmask + + character(len=*), parameter :: subname = '(gather_dyn)' + + ! copy from distributed I_* to G_* + call gather_global_ext(G_stressp_1 , L_stressp_1, master_task, distrb_info,c0) + call gather_global_ext(G_stressp_2 , L_stressp_2, master_task, distrb_info,c0) + call gather_global_ext(G_stressp_3 , L_stressp_3, master_task, distrb_info,c0) + call gather_global_ext(G_stressp_4 , L_stressp_4, master_task, distrb_info,c0) + + call gather_global_ext(G_stressm_1 , L_stressm_1, master_task, distrb_info,c0) + call gather_global_ext(G_stressm_2 , L_stressm_2, master_task, distrb_info,c0) + call gather_global_ext(G_stressm_3 , L_stressm_3, master_task, distrb_info,c0) + call gather_global_ext(G_stressm_4 , L_stressm_4, master_task, distrb_info,c0) + + call gather_global_ext(G_stress12_1, L_stress12_1, master_task, distrb_info,c0) + call gather_global_ext(G_stress12_2, L_stress12_2, master_task, distrb_info,c0) + call gather_global_ext(G_stress12_3, L_stress12_3, master_task, distrb_info,c0) + call gather_global_ext(G_stress12_4, L_stress12_4, master_task, distrb_info,c0) + call gather_global_ext(G_strength , L_strength , master_task, distrb_info,c0) + + call gather_global_ext(G_cdn_ocn , L_cdn_ocn , master_task, distrb_info) + call gather_global_ext(G_aiu , L_aiu , master_task, distrb_info) + call gather_global_ext(G_uocn , L_uocn , master_task, distrb_info) + call gather_global_ext(G_vocn , L_vocn , master_task, distrb_info) + + call gather_global_ext(G_waterxU , L_waterxU , master_task, distrb_info) + call gather_global_ext(G_wateryU , L_wateryU , master_task, distrb_info) + call gather_global_ext(G_forcexU , L_forcexU , master_task, distrb_info) + call gather_global_ext(G_forceyU , L_forceyU , master_task, distrb_info) + + call gather_global_ext(G_umassdti , L_umassdti , master_task, distrb_info) + call gather_global_ext(G_fmU , L_fmU , master_task, distrb_info) + + call gather_global_ext(G_Tbu , L_Tbu , master_task, distrb_info) + call gather_global_ext(G_uvel , L_uvel , master_task, distrb_info,c0) + call gather_global_ext(G_vvel , L_vvel , master_task, distrb_info,c0) + call gather_global_ext(G_iceTmask , L_iceTmask , master_task, distrb_info) + call gather_global_ext(G_iceUmask , L_iceUmask , master_task, distrb_info) + + end subroutine gather_dyn + +!============================================================================= + + subroutine scatter_dyn(L_stressp_1 , L_stressp_2 , L_stressp_3 , L_stressp_4 , & + L_stressm_1 , L_stressm_2 , L_stressm_3 , L_stressm_4 , & + L_stress12_1, L_stress12_2, L_stress12_3, L_stress12_4, & + L_strintxU , L_strintyU , L_uvel , L_vvel , & + L_taubxU , L_taubyU , & + G_stressp_1 , G_stressp_2 , G_stressp_3 , G_stressp_4, & + G_stressm_1 , G_stressm_2 , G_stressm_3 , G_stressm_4, & + G_stress12_1, G_stress12_2, G_stress12_3, G_stress12_4, & + G_strintxU , G_strintyU , G_uvel , G_vvel , & + G_taubxU , G_taubyU ) + + use ice_communicate, only : master_task + use ice_gather_scatter, only : scatter_global_ext + use ice_domain, only : distrb_info + implicit none + + ! nx_block, ny_block, max_blocks + real(kind=dbl_kind), dimension(:,:,:), intent(out) :: & + L_stressp_1 , L_stressp_2 , L_stressp_3 , L_stressp_4 , & + L_stressm_1 , L_stressm_2 , L_stressm_3 , L_stressm_4 , & + L_stress12_1, L_stress12_2, L_stress12_3, L_stress12_4, & + L_strintxU , L_strintyU , L_uvel , L_vvel , & + L_taubxU , L_taubyU + + ! nx, ny + real(kind=dbl_kind), dimension(:,:), intent(in) :: & + G_stressp_1 , G_stressp_2 , G_stressp_3 , G_stressp_4 , & + G_stressm_1 , G_stressm_2 , G_stressm_3 , G_stressm_4 , & + G_stress12_1, G_stress12_2, G_stress12_3, G_stress12_4, & + G_strintxU , G_strintyU , G_uvel , G_vvel , & + G_taubxU , G_taubyU + + character(len=*), parameter :: subname = '(scatter_dyn)' + + call scatter_global_ext(L_stressp_1, G_stressp_1, master_task, distrb_info) + call scatter_global_ext(L_stressp_2, G_stressp_2, master_task, distrb_info) + call scatter_global_ext(L_stressp_3, G_stressp_3, master_task, distrb_info) + call scatter_global_ext(L_stressp_4, G_stressp_4, master_task, distrb_info) + + call scatter_global_ext(L_stressm_1, G_stressm_1, master_task, distrb_info) + call scatter_global_ext(L_stressm_2, G_stressm_2, master_task, distrb_info) + call scatter_global_ext(L_stressm_3, G_stressm_3, master_task, distrb_info) + call scatter_global_ext(L_stressm_4, G_stressm_4, master_task, distrb_info) + + call scatter_global_ext(L_stress12_1, G_stress12_1, master_task, distrb_info) + call scatter_global_ext(L_stress12_2, G_stress12_2, master_task, distrb_info) + call scatter_global_ext(L_stress12_3, G_stress12_3, master_task, distrb_info) + call scatter_global_ext(L_stress12_4, G_stress12_4, master_task, distrb_info) + + call scatter_global_ext(L_strintxU , G_strintxU , master_task, distrb_info) + call scatter_global_ext(L_strintyU , G_strintyU , master_task, distrb_info) + call scatter_global_ext(L_uvel , G_uvel , master_task, distrb_info) + call scatter_global_ext(L_vvel , G_vvel , master_task, distrb_info) + call scatter_global_ext(L_taubxU , G_taubxU , master_task, distrb_info) + call scatter_global_ext(L_taubyU , G_taubyU , master_task, distrb_info) + + end subroutine scatter_dyn + +!============================================================================= + + subroutine convert_2d_1d_init(na0, G_HTE, G_HTN, G_uarear, G_dxT, G_dyT) + + implicit none + + integer(kind=int_kind), intent(in) :: na0 + real (kind=dbl_kind), dimension(:, :), intent(in) :: G_HTE, G_HTN, G_uarear, G_dxT, G_dyT + + ! local variables + + integer(kind=int_kind) :: iw, lo, up, j, i + integer(kind=int_kind), dimension(1:na0) :: & + Iin, Iee, Ine, Ise, Inw, Isw, Isse + + integer(kind=int_kind), dimension(1:7 * na0) :: util1, util2 + + character(len=*), parameter :: subname = '(convert_2d_1d_init)' + + ! calculate additional 1D indices used for finite differences + do iw = 1, na0 + ! get 2D indices + i = indxti(iw) + j = indxtj(iw) + ! calculate 1D indices + Iin(iw) = i + (j - 1) * nx ! ( 0, 0) target point + Iee(iw) = i - 1 + (j - 1) * nx ! (-1, 0) + Ine(iw) = i - 1 + (j - 2) * nx ! (-1,-1) + Ise(iw) = i + (j - 2) * nx ! ( 0,-1) + Inw(iw) = i + 1 + (j - 1) * nx ! (+1, 0) + Isw(iw) = i + 1 + (j - 0) * nx ! (+1,+1) + Isse(iw) = i + (j - 0) * nx ! ( 0,+1) + end do + + ! find number of points needed for finite difference calculations + call union(Iin, Iee, na0, na0, util1,i ) + call union(util1, Ine, i, na0, util2, j ) + call union(util2, Ise, j, na0, util1, i ) + call union(util1, Inw, i, na0, util2, j ) + call union(util2, Isw, j, na0, util1, i ) + call union(util1, Isse, i, na0, util2, navel) + + ! index vector with sorted target points + do iw = 1, na0 + indxTij(iw) = Iin(iw) + end do + ! sorted additional points + call setdiff(util2, Iin, navel, na0, util1, j) + do iw = na0 + 1, navel + indxTij(iw) = util1(iw - na0) + end do + + ! indices for additional points needed for uvel and vvel + call findXinY(Iee, indxTij, na0, navel, ee) + call findXinY(Ine, indxTij, na0, navel, ne) + call findXinY(Ise, indxTij, na0, navel, se) + call findXinY(Inw, indxTij, na0, navel, nw) + call findXinY(Isw, indxTij, na0, navel, sw) + call findXinY(Isse, indxTij, na0, navel, sse) + !tar i$OMP PARALLEL PRIVATE(iw, lo, up, j, i) + ! write 1D arrays from 2D arrays (target points) + !tar call domp_get_domain(1, na0, lo, up) + lo=1 + up=na0 + do iw = 1, na0 + ! get 2D indices + i = indxti(iw) + j = indxtj(iw) + ! map + uarear_1d(iw) = G_uarear(i, j) + dxT_1d(iw) = G_dxT(i, j) + dyT_1d(iw) = G_dyT(i, j) + HTE_1d(iw) = G_HTE(i, j) + HTN_1d(iw) = G_HTN(i, j) + HTEm1_1d(iw) = G_HTE(i - 1, j) + HTNm1_1d(iw) = G_HTN(i, j - 1) + end do + + end subroutine convert_2d_1d_init + +!============================================================================= + + subroutine convert_2d_1d_dyn(na0 , & + G_stressp_1 , G_stressp_2 , G_stressp_3 , G_stressp_4 , & + G_stressm_1 , G_stressm_2 , G_stressm_3 , G_stressm_4 , & + G_stress12_1, G_stress12_2, G_stress12_3, G_stress12_4, & + G_strength , G_cdn_ocn , G_aiu , G_uocn , & + G_vocn , G_waterxU , G_wateryU , G_forcexU , & + G_forceyU , G_umassdti , G_fmU , G_Tbu , & + G_uvel , G_vvel ) + + implicit none + + integer(kind=int_kind), intent(in) :: na0 + + ! nx, ny + real(kind=dbl_kind), dimension(:, :), intent(in) :: & + G_stressp_1 , G_stressp_2 , G_stressp_3 , G_stressp_4, & + G_stressm_1 , G_stressm_2 , G_stressm_3 , G_stressm_4, & + G_stress12_1, G_stress12_2, G_stress12_3,G_stress12_4, & + G_strength , G_cdn_ocn , G_aiu , G_uocn , & + G_vocn , G_waterxU , G_wateryU , G_forcexU , & + G_forceyU , G_umassdti , G_fmU , G_Tbu , & + G_uvel , G_vvel + + integer(kind=int_kind) :: lo, up, iw, i, j + character(len=*), parameter :: subname = '(convert_2d_1d_dyn)' + + lo=1 + up=na0 + do iw = 1, na0 + ! get 2D indices + i = indxti(iw) + j = indxtj(iw) + ! map + stressp_1(iw) = G_stressp_1(i, j) + stressp_2(iw) = G_stressp_2(i, j) + stressp_3(iw) = G_stressp_3(i, j) + stressp_4(iw) = G_stressp_4(i, j) + stressm_1(iw) = G_stressm_1(i, j) + stressm_2(iw) = G_stressm_2(i, j) + stressm_3(iw) = G_stressm_3(i, j) + stressm_4(iw) = G_stressm_4(i, j) + stress12_1(iw) = G_stress12_1(i, j) + stress12_2(iw) = G_stress12_2(i, j) + stress12_3(iw) = G_stress12_3(i, j) + stress12_4(iw) = G_stress12_4(i, j) + strength(iw) = G_strength(i,j) + cdn_ocn(iw) = G_cdn_ocn(i, j) + aiu(iw) = G_aiu(i, j) + uocn(iw) = G_uocn(i, j) + vocn(iw) = G_vocn(i, j) + waterxU(iw) = G_waterxU(i, j) + wateryU(iw) = G_wateryU(i, j) + forcexU(iw) = G_forcexU(i, j) + forceyU(iw) = G_forceyU(i, j) + umassdti(iw) = G_umassdti(i, j) + fmU(iw) = G_fmU(i, j) + strintxU(iw) = C0 + strintyU(iw) = C0 + Tbu(iw) = G_Tbu(i, j) + Cb(iw) = c0 + uvel(iw) = G_uvel(i,j) + vvel(iw) = G_vvel(i,j) + uvel_init(iw) = G_uvel(i,j) + vvel_init(iw) = G_vvel(i,j) + end do + + ! Halos can potentially have values of u and v + do iw=na0+1,navel + j = int((indxTij(iw) - 1) / (nx)) + 1 + i = indxTij(iw) - (j - 1) * nx + uvel(iw)=G_uvel(i,j) + vvel(iw)=G_vvel(i,j) + end do + + end subroutine convert_2d_1d_dyn + +!============================================================================= + + subroutine convert_1d_2d_dyn(na0 , navel0 , & + G_stressp_1 , G_stressp_2 , G_stressp_3 , G_stressp_4 , & + G_stressm_1 , G_stressm_2 , G_stressm_3 , G_stressm_4 , & + G_stress12_1, G_stress12_2, G_stress12_3, G_stress12_4, & + G_strength, & + G_cdn_ocn , G_aiu , G_uocn , G_vocn , & + G_waterxU , G_wateryU , G_forcexU , G_forceyU , & + G_umassdti , G_fmU , G_strintxU , G_strintyU , & + G_Tbu , G_uvel , G_vvel , G_taubxU , & + G_taubyU) + + implicit none + + integer(kind=int_kind), intent(in) :: na0, navel0 + ! nx, ny + real(kind=dbl_kind), dimension(:, :), intent(inout) :: & + G_stressp_1 , G_stressp_2 , G_stressp_3 , G_stressp_4 , & + G_stressm_1 , G_stressm_2 , G_stressm_3 , G_stressm_4 , & + G_stress12_1, G_stress12_2, G_stress12_3, G_stress12_4, & + G_strength, & + G_cdn_ocn , G_aiu , G_uocn , G_vocn , & + G_waterxU , G_wateryU , G_forcexU , G_forceyU , & + G_umassdti , G_fmU , G_strintxU , G_strintyU , & + G_Tbu , G_uvel , G_vvel , G_taubxU , & + G_taubyU + + integer(kind=int_kind) :: lo, up, iw, i, j + character(len=*), parameter :: subname = '(convert_1d_2d_dyn)' + + lo=1 + up=na0 + do iw = lo, up + ! get 2D indices + i = indxti(iw) + j = indxtj(iw) + ! map to 2d + G_stressp_1 (i,j) = stressp_1(iw) + G_stressp_2 (i,j) = stressp_2(iw) + G_stressp_3 (i,j) = stressp_3(iw) + G_stressp_4 (i,j) = stressp_4(iw) + G_stressm_1 (i,j) = stressm_1(iw) + G_stressm_2 (i,j) = stressm_2(iw) + G_stressm_3 (i,j) = stressm_3(iw) + G_stressm_4 (i,j) = stressm_4(iw) + G_stress12_1(i,j) = stress12_1(iw) + G_stress12_2(i,j) = stress12_2(iw) + G_stress12_3(i,j) = stress12_3(iw) + G_stress12_4(i,j) = stress12_4(iw) + G_strintxU(i,j) = strintxU(iw) + G_strintyU(i,j) = strintyU (iw) + G_taubxU(i,j) = -uvel(iw)*Cb(iw) + G_taubyU(i,j) = -vvel(iw)*Cb(iw) + G_uvel(i,j) = uvel(iw) + G_vvel(i,j) = vvel(iw) + end do + + do iw=na0+1,navel0 + j = int((indxTij(iw) - 1) / (nx)) + 1 + i = indxTij(iw) - (j - 1) * nx + G_uvel(i,j) = uvel(iw) + G_vvel(i,j) = vvel(iw) + end do + + end subroutine convert_1d_2d_dyn + +!======================================================================= + + subroutine setdiff(x, y, lvecx, lvecy,xy, nxy) + ! Find element (xy) of two sorted integer vectors (x and y) that + ! are in x, but not in y, or in y, but not in x + + implicit none + + integer(kind=int_kind), intent(in) :: lvecx,lvecy + integer(kind=int_kind), intent(in) :: x(1:lvecx), y(1:lvecy) + integer(kind=int_kind), intent(out) :: xy(1:lvecx + lvecy) + integer(kind=int_kind), intent(out) :: nxy + + ! local variables + + integer(kind=int_kind) :: i, j, k + + character(len=*), parameter :: subname = '(setdiff)' + + i = 1 + j = 1 + k = 1 + do while (i <= lvecx .and. j <= lvecy) + if (x(i) < y(j)) then + xy(k) = x(i) + i = i + 1 + k = k + 1 + else if (x(i) > y(j)) then + xy(k) = y(j) + j = j + 1 + k = k + 1 + else + i = i + 1 + j = j + 1 + end if + end do + + ! the rest + do while (i <= lvecx) + xy(k) = x(i) + i = i + 1 + k = k + 1 + end do + do while (j <= lvecy) + xy(k) = y(j) + j = j + 1 + k = k + 1 + end do + nxy = k - 1 + + end subroutine setdiff + +!======================================================================= + + subroutine findXinY(x, y, lvecx, lvecy, indx) + ! Find indx vector so that x(1:na) = y(indx(1:na)) + ! + ! Conditions: + ! * EVERY item in x is found in y + ! * x(1:lvecx) is a sorted integer vector + ! * y(1:lvecy) consists of two sorted integer vectors: + ! [y(1:lvecx); y(lvecy + 1:lvecx)] + ! * lvecy >= lvecx + + implicit none + + integer (kind=int_kind), intent(in) :: lvecx, lvecy + integer (kind=int_kind), intent(in) :: x(1:lvecx), y(1:lvecy) + integer (kind=int_kind), intent(out) :: indx(1:lvecx) + + ! local variables + + integer (kind=int_kind) :: i, j1, j2 + + character(len=*), parameter :: subname = '(findXinY)' + + i = 1 + j1 = 1 + j2 = lvecx + 1 + do while (i <= lvecx) + if (x(i) == y(j1)) then + indx(i) = j1 + i = i + 1 + j1 = j1 + 1 + else if (x(i) == y(j2)) then + indx(i) = j2 + i = i + 1 + j2 = j2 + 1 + else if (x(i) > y(j1)) then + j1 = j1 + 1 + else if (x(i) > y(j2)) then + j2 = j2 + 1 + else + stop + end if + end do + + end subroutine findXinY + +!======================================================================= + + subroutine calc_navel(na0, navel0) + ! Calculate number of active points, including halo points + + implicit none + + integer(kind=int_kind), intent(in) :: na0 + integer(kind=int_kind), intent(out) :: navel0 + + ! local variables + + integer(kind=int_kind) :: iw, i, j + integer(kind=int_kind), dimension(1:na0) :: & + Iin, Iee, Ine, Ise, Inw, Isw, Isse, indi, indj + + integer(kind=int_kind), dimension(1:7 * na0) :: util1, util2 + + character(len=*), parameter :: subname = '(calc_navel)' + + ! calculate additional 1D indices used for finite differences + do iw = 1, na0 + ! get 2D indices + i = indxti(iw) + j = indxtj(iw) + + ! calculate 1D indices + Iin(iw) = i + (j - 1) * nx ! ( 0, 0) target point + Iee(iw) = i - 1 + (j - 1) * nx ! (-1, 0) + Ine(iw) = i - 1 + (j - 2) * nx ! (-1, -1) + Ise(iw) = i + (j - 2) * nx ! ( 0, -1) + Inw(iw) = i + 1 + (j - 1) * nx ! (+1, 0) + Isw(iw) = i + 1 + (j - 0) * nx ! (+1, +1) + Isse(iw) = i + (j - 0) * nx ! ( 0, +1) + end do + + ! find number of points needed for finite difference calculations + call union(Iin , Iee , na0, na0, util1, i ) + call union(util1, Ine , i , na0, util2, j ) + call union(util2, Ise , j , na0, util1, i ) + call union(util1, Inw , i , na0, util2, j ) + call union(util2, Isw , j , na0, util1, i ) + call union(util1, Isse, i , na0, util2, navel0) + + end subroutine calc_navel + +!======================================================================= + + subroutine numainit(lo,up,uu) + + implicit none + integer(kind=int_kind),intent(in) :: lo,up,uu + integer(kind=int_kind) :: iw + character(len=*), parameter :: subname = '(numainit)' + + !$omp parallel do schedule(runtime) private(iw) + do iw = lo,up + skipTcell(iw)=.false. + skipUcell(iw)=.false. + ee(iw)=0 + ne(iw)=0 + se(iw)=0 + nw(iw)=0 + sw(iw)=0 + sse(iw)=0 + aiu(iw)=c0 + Cb(iw)=c0 + cdn_ocn(iw)=c0 + dxT_1d(iw)=c0 + dyT_1d(iw)=c0 + fmU(iw)=c0 + forcexU(iw)=c0 + forceyU(iw)=c0 + HTE_1d(iw)=c0 + HTEm1_1d(iw)=c0 + HTN_1d(iw)=c0 + HTNm1_1d(iw)=c0 + strength(iw)= c0 + stress12_1(iw)=c0 + stress12_2(iw)=c0 + stress12_3(iw)=c0 + stress12_4(iw)=c0 + stressm_1(iw)=c0 + stressm_2(iw)=c0 + stressm_3(iw)=c0 + stressm_4(iw)=c0 + stressp_1(iw)=c0 + stressp_2(iw)=c0 + stressp_3(iw)=c0 + stressp_4(iw)=c0 + strintxU(iw)= c0 + strintyU(iw)= c0 + Tbu(iw)=c0 + uarear_1d(iw)=c0 + umassdti(iw)=c0 + uocn(iw)=c0 + uvel_init(iw)=c0 + uvel(iw)=c0 + vocn(iw)=c0 + vvel_init(iw)=c0 + vvel(iw)=c0 + waterxU(iw)=c0 + wateryU(iw)=c0 + enddo + !$omp end parallel do + !$omp parallel do schedule(runtime) private(iw) + do iw = lo,uu + uvel(iw)=c0 + vvel(iw)=c0 + str1(iw)=c0 + str2(iw)=c0 + str3(iw)=c0 + str4(iw)=c0 + str5(iw)=c0 + str6(iw)=c0 + str7(iw)=c0 + str8(iw)=c0 + enddo + !$omp end parallel do + + end subroutine numainit + +!======================================================================= + + subroutine evp1d_halo_update() + + implicit none + integer(kind=int_kind) :: iw + + character(len=*), parameter :: subname = '(evp1d_halo_update)' + +!TILL !$omp parallel do schedule(runtime) private(iw) + do iw = 1, n_inner_east + uvel(halo_parent_outer_east(iw)) = uvel(halo_inner_east(iw)) + vvel(halo_parent_outer_east(iw)) = vvel(halo_inner_east(iw)) + end do +! western halo + do iw = 1, n_inner_west + uvel(halo_parent_outer_west(iw)) = uvel(halo_inner_west(iw)) + vvel(halo_parent_outer_west(iw)) = vvel(halo_inner_west(iw)) + end do + do iw = 1, n_inner_south + uvel(halo_parent_outer_south(iw)) = uvel(halo_inner_south(iw)) + vvel(halo_parent_outer_south(iw)) = vvel(halo_inner_south(iw)) + end do +! western halo + do iw = 1, n_inner_north + uvel(halo_parent_outer_north(iw)) = uvel(halo_inner_north(iw)) + vvel(halo_parent_outer_north(iw)) = vvel(halo_inner_north(iw)) + end do + + end subroutine evp1d_halo_update + +!======================================================================= + + subroutine calc_halo_parent(na0,navel0) + ! splits the global domain in east and west boundary and find the inner (within) the domain and the outer (outside the domain) + ! Implementation for circular boundaries. This means that mathes between the opposite directions must be found + ! E.g. inner_west and outer_east + ! Till Rasmussen, DMI 2023 + + use ice_domain, only: ew_boundary_type, ns_boundary_type + implicit none + + integer(kind=int_kind), intent(in) :: na0, navel0 + + ! local variables + + ! Indexes, Directions are east, weast, north and south + ! This is done to reduce the search windows. + ! Iw runs from 1 to navel and the one to keep in the end + ! Iw_inner_{direction} contains the indexes for + + integer(kind=int_kind) :: & + iw, n_outer_east, n_outer_west, n_outer_south, n_outer_north + + integer(kind=int_kind) :: i, j, ifind, jfind ! 2d index. ifind and jfind are points on the boundary + + integer(kind=int_kind), dimension(ny) :: & + halo_outer_east, halo_outer_west, & + ind_inner_west , ind_inner_east + + integer(kind=int_kind), dimension(nx) :: & + halo_outer_south, halo_outer_north, & + ind_inner_south , ind_inner_north + + character(len=*), parameter :: subname = '(calc_halo_parent)' + + !----------------------------------------------------------------- + ! Indices for halo update: + ! 0: no halo point + ! >0: index for halo point parent, related to indij vector + ! + ! TODO: Implement for nghost > 1 + ! TODO: Implement for tripole grids + !----------------------------------------------------------------- + halo_inner_west(:) = 0 + halo_inner_east(:) = 0 + halo_inner_south(:) = 0 + halo_inner_north(:) = 0 + + halo_outer_west(:) = 0 + halo_outer_east(:) = 0 + halo_outer_south(:) = 0 + halo_outer_north(:) = 0 + + ind_inner_west(:) = 0 + ind_inner_east(:) = 0 + ind_inner_south(:) = 0 + ind_inner_north(:) = 0 + + halo_parent_outer_east(:)=0 + halo_parent_outer_west(:)=0 + halo_parent_outer_north(:)=0 + halo_parent_outer_south(:)=0 + ! Index inner boundary + n_inner_north=0 + n_inner_south=0 + n_inner_east=0 + n_inner_west=0 + ! Index outer boundary + n_outer_east=0 + n_outer_west=0 + n_outer_north=0 + n_outer_south=0 + !TILL SHOULD CHANGE TO 1D + do iw = 1, na0 + j = int((indxTij(iw) - 1) / (nx)) + 1 + i = indxTij(iw) - (j - 1) * nx + ! All four boundaries find points internally that are within the domain and next to the boundary + ! This can in principle be moved to previos loops that connects i and j to 1d index. + ! ifind is i value on the halo to find. + ! Some parts assume nghost = 1 + ! INNER EAST + if (trim(ew_boundary_type) == 'cyclic') then + if ((.not. skipUcell(iw)) .and. (i==nx-nghost)) then + n_inner_east=n_inner_east+1 + ifind = 1 + ind_inner_east(n_inner_east) = ifind + (j - 1) * nx + halo_inner_east(n_inner_east) = iw + else if ((.not. skipUcell(iw)) .and. (i==1+nghost)) then + n_inner_west=n_inner_west+1 + ifind = nx + ind_inner_west(n_inner_west) = ifind + (j - 1) * nx + halo_inner_west(n_inner_west) = iw + endif + endif + if (trim(ns_boundary_type) == 'cyclic') then + if ((.not. skipUcell(iw)) .and. (j==1+nghost)) then + n_inner_south=n_inner_south+1 + jfind = ny + ind_inner_south(n_inner_south) = i + (jfind - 1) * nx + halo_inner_south(n_inner_south) = iw + else if ((.not. skipUcell(iw)) .and. (j==ny-nghost)) then + n_inner_north=n_inner_north+1 + jfind = 1 + ind_inner_north(n_inner_north) = i + (jfind - 1) * nx + halo_inner_north(n_inner_north) = iw + endif + endif + ! Finds all halos points on western halo WEST + if (i == 1) then + n_outer_west=n_outer_west+1 + halo_outer_west(n_outer_west)= iw + endif + ! Simiilar on East + if (i == nx ) then + n_outer_east=n_outer_east+1 + halo_outer_east(n_outer_east)=iw + endif + ! Finds all halos points on western halo WEST + if (j == 1) then + n_outer_south=n_outer_south+1 + halo_outer_south(n_outer_south)= iw + endif + ! Simiilar on East + if (j == ny ) then + n_outer_north=n_outer_north+1 + halo_outer_north(n_outer_north)=iw + endif + end do + + ! outer halo also needs points that are not active + do iw = na0+1, navel0 + j = int((indxTij(iw) - 1) / (nx)) + 1 + i = indxTij(iw) - (j - 1) * nx + ! outer halo west + if (i == 1) then + n_outer_west=n_outer_west+1 + halo_outer_west(n_outer_west)= iw + endif + ! outer halo east + if (i == nx ) then + n_outer_east=n_outer_east+1 + halo_outer_east(n_outer_east)=iw + endif + ! outer halo south + if (j == 1) then + n_outer_south=n_outer_south+1 + halo_outer_south(n_outer_south)= iw + endif + ! outer halo north + if (j == ny ) then + n_outer_north=n_outer_north+1 + halo_outer_north(n_outer_north)=iw + endif + end do + ! Search is now reduced to a search between two reduced vectors for each boundary + ! This runs through each boundary and matches + ! number of active points for halo east and west (count of active u cells within the domain. + ! reduce outer array to only match inner arrays + ! East West + if (trim(ew_boundary_type) == 'cyclic') then + do i=1,n_inner_west + do j=1,n_outer_east + if (ind_inner_west(i) == indxTij(halo_outer_east(j))) then + halo_parent_outer_west(i)=halo_outer_east(j) + endif + end do + end do + + do i=1,n_inner_east + do j=1,n_outer_west + if (ind_inner_east(i) == indxTij(halo_outer_west(j))) then + halo_parent_outer_east(i)=halo_outer_west(j) + endif + end do + end do + endif + if (trim(ns_boundary_type) == 'cyclic') then + do i=1,n_inner_south + do j=1,n_outer_north + if (ind_inner_south(i) == indxTij(halo_outer_north(j))) then + halo_parent_outer_south(i)=halo_outer_north(j) + endif + end do + end do + + do i=1,n_inner_north + do j=1,n_outer_south + if (ind_inner_north(i) == indxTij(halo_outer_south(j))) then + halo_parent_outer_north(i)=halo_outer_south(j) + endif + end do + end do + endif + + end subroutine calc_halo_parent + +!======================================================================= + +end module ice_dyn_evp1d + diff --git a/cicecore/cicedyn/dynamics/ice_dyn_evp_1d.F90 b/cicecore/cicedyn/dynamics/ice_dyn_evp_1d.F90 deleted file mode 100644 index b7daab0a0..000000000 --- a/cicecore/cicedyn/dynamics/ice_dyn_evp_1d.F90 +++ /dev/null @@ -1,1921 +0,0 @@ -!======================================================================= -! -! Elastic-viscous-plastic sea ice dynamics model (1D implementations) -! Computes ice velocity and deformation -! -! authors: Jacob Weismann Poulsen, DMI -! Mads Hvid Ribergaard, DMI - -module ice_dyn_evp_1d - - use ice_kinds_mod - use ice_fileunits, only : nu_diag - use ice_exit, only : abort_ice - use icepack_intfc, only : icepack_query_parameters - use icepack_intfc, only : icepack_warnings_flush, & - icepack_warnings_aborted - - implicit none - private - public :: ice_dyn_evp_1d_copyin, ice_dyn_evp_1d_copyout, & - ice_dyn_evp_1d_kernel - - integer(kind=int_kind) :: NA_len, NAVEL_len, domp_iam, domp_nt -#if defined (_OPENMP) - real(kind=dbl_kind) :: rdomp_iam, rdomp_nt - !$OMP THREADPRIVATE(domp_iam, domp_nt, rdomp_iam, rdomp_nt) -#endif - logical(kind=log_kind), dimension(:), allocatable :: skiptcell, skipucell - integer(kind=int_kind), dimension(:), allocatable :: ee, ne, se, & - nw, sw, sse, indi, indj, indij, halo_parent - real(kind=dbl_kind), dimension(:), allocatable :: cdn_ocn, aiu, & - uocn, vocn, forcex, forcey, Tbu, tarear, umassdti, fm, uarear, & - strintx, strinty, uvel_init, vvel_init, strength, uvel, vvel, & - dxT, dyT, stressp_1, stressp_2, stressp_3, stressp_4, stressm_1, & - stressm_2, stressm_3, stressm_4, stress12_1, stress12_2, & - stress12_3, stress12_4, divu, rdg_conv, rdg_shear, shear, taubx, & - tauby, str1, str2, str3, str4, str5, str6, str7, str8, HTE, HTN, & - HTEm1, HTNm1 - integer, parameter :: JPIM = selected_int_kind(9) - - interface evp1d_stress - module procedure stress_iter - module procedure stress_last - end interface - - interface evp1d_stepu - module procedure stepu_iter - module procedure stepu_last - end interface - -!======================================================================= - -contains - -!======================================================================= - - subroutine domp_init -#if defined (_OPENMP) - - use omp_lib, only : omp_get_thread_num, omp_get_num_threads -#endif - - implicit none - - character(len=*), parameter :: subname = '(domp_init)' - - !$OMP PARALLEL DEFAULT(none) -#if defined (_OPENMP) - domp_iam = omp_get_thread_num() - rdomp_iam = real(domp_iam, dbl_kind) - domp_nt = omp_get_num_threads() - rdomp_nt = real(domp_nt, dbl_kind) -#else - domp_iam = 0 - domp_nt = 1 -#endif - !$OMP END PARALLEL - - end subroutine domp_init - -!======================================================================= - - subroutine domp_get_domain(lower, upper, d_lower, d_upper) -#if defined (_OPENMP) - - use omp_lib, only : omp_in_parallel - use ice_constants, only : p5 -#endif - - implicit none - - integer(kind=JPIM), intent(in) :: lower, upper - integer(kind=JPIM), intent(out) :: d_lower, d_upper - - ! local variables -#if defined (_OPENMP) - - real(kind=dbl_kind) :: dlen -#endif - - character(len=*), parameter :: subname = '(domp_get_domain)' - - ! proper action in "null" case - if (upper <= 0 .or. upper < lower) then - d_lower = 0 - d_upper = -1 - return - end if - - ! proper action in serial case - d_lower = lower - d_upper = upper -#if defined (_OPENMP) - - if (omp_in_parallel()) then - dlen = real((upper - lower + 1), dbl_kind) - d_lower = lower + floor(((rdomp_iam * dlen + p5) / rdomp_nt), JPIM) - d_upper = lower - 1 + floor(((rdomp_iam * dlen + dlen + p5) / rdomp_nt), JPIM) - end if -#endif - - end subroutine domp_get_domain - -!======================================================================= - - subroutine stress_iter(NA_len, ee, ne, se, lb, ub, uvel, vvel, dxT, & - dyT, hte, htn, htem1, htnm1, strength, stressp_1, stressp_2, & - stressp_3, stressp_4, stressm_1, stressm_2, stressm_3, & - stressm_4, stress12_1, stress12_2, stress12_3, stress12_4, str1, & - str2, str3, str4, str5, str6, str7, str8, skiptcell) - - use ice_kinds_mod - use ice_constants, only : p027, p055, p111, p166, p222, p25, & - p333, p5, c1p5, c1 - use ice_dyn_shared, only : ecci, denom1, arlx1i, Ktens, revp, & - deltaminEVP - - implicit none - - integer(kind=int_kind), intent(in) :: NA_len, lb, ub - integer(kind=int_kind), dimension(:), intent(in), contiguous :: & - ee, ne, se - real(kind=dbl_kind), dimension(:), intent(in), contiguous :: & - strength, uvel, vvel, dxT, dyT, hte, htn, htem1, htnm1 - logical(kind=log_kind), intent(in), dimension(:) :: skiptcell - real(kind=dbl_kind), dimension(:), intent(inout), contiguous :: & - stressp_1, stressp_2, stressp_3, stressp_4, stressm_1, & - stressm_2, stressm_3, stressm_4, stress12_1, stress12_2, & - stress12_3, stress12_4 - real(kind=dbl_kind), dimension(:), intent(out), contiguous :: & - str1, str2, str3, str4, str5, str6, str7, str8 - - ! local variables - - integer(kind=int_kind) :: iw, il, iu - real(kind=dbl_kind) :: divune, divunw, divuse, divusw, & - tensionne, tensionnw, tensionse, tensionsw, shearne, shearnw, & - shearse, shearsw, Deltane, Deltanw, Deltase, Deltasw, c0ne, & - c0nw, c0se, c0sw, c1ne, c1nw, c1se, c1sw, ssigpn, ssigps, & - ssigpe, ssigpw, ssigmn, ssigms, ssigme, ssigmw, ssig12n, & - ssig12s, ssig12e, ssig12w, ssigp1, ssigp2, ssigm1, ssigm2, & - ssig121, ssig122, csigpne, csigpnw, csigpse, csigpsw, & - csigmne, csigmnw, csigmse, csigmsw, csig12ne, csig12nw, & - csig12se, csig12sw, str12ew, str12we, str12ns, str12sn, & - strp_tmp, strm_tmp, tmp_uvel_ee, tmp_vvel_se, tmp_vvel_ee, & - tmp_vvel_ne, tmp_uvel_ne, tmp_uvel_se, dxhy, dyhx, cxp, cyp, & - cxm, cym, tmparea, DminTarea - - character(len=*), parameter :: subname = '(stress_iter)' - -#ifdef _OPENACC - !$acc parallel & - !$acc present(ee, ne, se, strength, uvel, vvel, dxT, dyT, hte, & - !$acc htn, htem1, htnm1, str1, str2, str3, str4, str5, str6, & - !$acc str7, str8, stressp_1, stressp_2, stressp_3, stressp_4, & - !$acc stressm_1, stressm_2, stressm_3, stressm_4, stress12_1, & - !$acc stress12_2, stress12_3, stress12_4, skiptcell) - !$acc loop - do iw = 1, NA_len -#else - call domp_get_domain(lb, ub, il, iu) - do iw = il, iu -#endif - - if (skiptcell(iw)) cycle - - tmparea = dxT(iw) * dyT(iw) ! necessary to split calc of DminTarea. Otherwize not binary identical - DminTarea = deltaminEVP * tmparea - dxhy = p5 * (hte(iw) - htem1(iw)) - dyhx = p5 * (htn(iw) - htnm1(iw)) - cxp = c1p5 * htn(iw) - p5 * htnm1(iw) - cyp = c1p5 * hte(iw) - p5 * htem1(iw) - cxm = -(c1p5 * htnm1(iw) - p5 * htn(iw)) - cym = -(c1p5 * htem1(iw) - p5 * hte(iw)) - - !-------------------------------------------------------------- - ! strain rates - ! NOTE: these are actually strain rates * area (m^2/s) - !-------------------------------------------------------------- - - tmp_uvel_ne = uvel(ne(iw)) - tmp_uvel_se = uvel(se(iw)) - tmp_uvel_ee = uvel(ee(iw)) - - tmp_vvel_ee = vvel(ee(iw)) - tmp_vvel_se = vvel(se(iw)) - tmp_vvel_ne = vvel(ne(iw)) - ! divergence = e_11 + e_22 - divune = cyp * uvel(iw) - dyT(iw) * tmp_uvel_ee & - + cxp * vvel(iw) - dxT(iw) * tmp_vvel_se - divunw = cym * tmp_uvel_ee + dyT(iw) * uvel(iw) & - + cxp * tmp_vvel_ee - dxT(iw) * tmp_vvel_ne - divusw = cym * tmp_uvel_ne + dyT(iw) * tmp_uvel_se & - + cxm * tmp_vvel_ne + dxT(iw) * tmp_vvel_ee - divuse = cyp * tmp_uvel_se - dyT(iw) * tmp_uvel_ne & - + cxm * tmp_vvel_se + dxT(iw) * vvel(iw) - - ! tension strain rate = e_11 - e_22 - tensionne = -cym * uvel(iw) - dyT(iw) * tmp_uvel_ee & - + cxm * vvel(iw) + dxT(iw) * tmp_vvel_se - tensionnw = -cyp * tmp_uvel_ee + dyT(iw) * uvel(iw) & - + cxm * tmp_vvel_ee + dxT(iw) * tmp_vvel_ne - tensionsw = -cyp * tmp_uvel_ne + dyT(iw) * tmp_uvel_se & - + cxp * tmp_vvel_ne - dxT(iw) * tmp_vvel_ee - tensionse = -cym * tmp_uvel_se - dyT(iw) * tmp_uvel_ne & - + cxp * tmp_vvel_se - dxT(iw) * vvel(iw) - - ! shearing strain rate = 2 * e_12 - shearne = -cym * vvel(iw) - dyT(iw) * tmp_vvel_ee & - - cxm * uvel(iw) - dxT(iw) * tmp_uvel_se - shearnw = -cyp * tmp_vvel_ee + dyT(iw) * vvel(iw) & - - cxm * tmp_uvel_ee - dxT(iw) * tmp_uvel_ne - shearsw = -cyp * tmp_vvel_ne + dyT(iw) * tmp_vvel_se & - - cxp * tmp_uvel_ne + dxT(iw) * tmp_uvel_ee - shearse = -cym * tmp_vvel_se - dyT(iw) * tmp_vvel_ne & - - cxp * tmp_uvel_se + dxT(iw) * uvel(iw) - - ! Delta (in the denominator of zeta and eta) - Deltane = sqrt(divune**2 + ecci * (tensionne**2 + shearne**2)) - Deltanw = sqrt(divunw**2 + ecci * (tensionnw**2 + shearnw**2)) - Deltasw = sqrt(divusw**2 + ecci * (tensionsw**2 + shearsw**2)) - Deltase = sqrt(divuse**2 + ecci * (tensionse**2 + shearse**2)) - - !-------------------------------------------------------------- - ! replacement pressure/Delta (kg/s) - ! save replacement pressure for principal stress calculation - !-------------------------------------------------------------- - - c0ne = strength(iw) / max(Deltane, DminTarea) - c0nw = strength(iw) / max(Deltanw, DminTarea) - c0sw = strength(iw) / max(Deltasw, DminTarea) - c0se = strength(iw) / max(Deltase, DminTarea) - - c1ne = c0ne * arlx1i - c1nw = c0nw * arlx1i - c1sw = c0sw * arlx1i - c1se = c0se * arlx1i - - c0ne = c1ne * ecci - c0nw = c1nw * ecci - c0sw = c1sw * ecci - c0se = c1se * ecci - - !-------------------------------------------------------------- - ! the stresses (kg/s^2) - ! (1) northeast, (2) northwest, (3) southwest, (4) southeast - !-------------------------------------------------------------- - - stressp_1(iw) = (stressp_1(iw) * (c1 - arlx1i * revp) & - + c1ne * (divune * (c1 + Ktens) - Deltane * (c1 - Ktens))) * denom1 - stressp_2(iw) = (stressp_2(iw) * (c1 - arlx1i * revp) & - + c1nw * (divunw * (c1 + Ktens) - Deltanw * (c1 - Ktens))) * denom1 - stressp_3(iw) = (stressp_3(iw) * (c1 - arlx1i * revp) & - + c1sw * (divusw * (c1 + Ktens) - Deltasw * (c1 - Ktens))) * denom1 - stressp_4(iw) = (stressp_4(iw) * (c1 - arlx1i * revp) & - + c1se * (divuse * (c1 + Ktens) - Deltase * (c1 - Ktens))) * denom1 - - stressm_1(iw) = (stressm_1(iw) * (c1 - arlx1i * revp) + c0ne * tensionne * (c1 + Ktens)) * denom1 - stressm_2(iw) = (stressm_2(iw) * (c1 - arlx1i * revp) + c0nw * tensionnw * (c1 + Ktens)) * denom1 - stressm_3(iw) = (stressm_3(iw) * (c1 - arlx1i * revp) + c0sw * tensionsw * (c1 + Ktens)) * denom1 - stressm_4(iw) = (stressm_4(iw) * (c1 - arlx1i * revp) + c0se * tensionse * (c1 + Ktens)) * denom1 - - stress12_1(iw) = (stress12_1(iw) * (c1 - arlx1i * revp) + c0ne * shearne * p5 * (c1 + Ktens)) * denom1 - stress12_2(iw) = (stress12_2(iw) * (c1 - arlx1i * revp) + c0nw * shearnw * p5 * (c1 + Ktens)) * denom1 - stress12_3(iw) = (stress12_3(iw) * (c1 - arlx1i * revp) + c0sw * shearsw * p5 * (c1 + Ktens)) * denom1 - stress12_4(iw) = (stress12_4(iw) * (c1 - arlx1i * revp) + c0se * shearse * p5 * (c1 + Ktens)) * denom1 - - !-------------------------------------------------------------- - ! combinations of the stresses for the momentum equation - ! (kg/s^2) - !-------------------------------------------------------------- - - ssigpn = stressp_1(iw) + stressp_2(iw) - ssigps = stressp_3(iw) + stressp_4(iw) - ssigpe = stressp_1(iw) + stressp_4(iw) - ssigpw = stressp_2(iw) + stressp_3(iw) - ssigp1 = (stressp_1(iw) + stressp_3(iw)) * p055 - ssigp2 = (stressp_2(iw) + stressp_4(iw)) * p055 - - ssigmn = stressm_1(iw) + stressm_2(iw) - ssigms = stressm_3(iw) + stressm_4(iw) - ssigme = stressm_1(iw) + stressm_4(iw) - ssigmw = stressm_2(iw) + stressm_3(iw) - ssigm1 = (stressm_1(iw) + stressm_3(iw)) * p055 - ssigm2 = (stressm_2(iw) + stressm_4(iw)) * p055 - - ssig12n = stress12_1(iw) + stress12_2(iw) - ssig12s = stress12_3(iw) + stress12_4(iw) - ssig12e = stress12_1(iw) + stress12_4(iw) - ssig12w = stress12_2(iw) + stress12_3(iw) - ssig121 = (stress12_1(iw) + stress12_3(iw)) * p111 - ssig122 = (stress12_2(iw) + stress12_4(iw)) * p111 - - csigpne = p111 * stressp_1(iw) + ssigp2 + p027 * stressp_3(iw) - csigpnw = p111 * stressp_2(iw) + ssigp1 + p027 * stressp_4(iw) - csigpsw = p111 * stressp_3(iw) + ssigp2 + p027 * stressp_1(iw) - csigpse = p111 * stressp_4(iw) + ssigp1 + p027 * stressp_2(iw) - - csigmne = p111 * stressm_1(iw) + ssigm2 + p027 * stressm_3(iw) - csigmnw = p111 * stressm_2(iw) + ssigm1 + p027 * stressm_4(iw) - csigmsw = p111 * stressm_3(iw) + ssigm2 + p027 * stressm_1(iw) - csigmse = p111 * stressm_4(iw) + ssigm1 + p027 * stressm_2(iw) - - csig12ne = p222 * stress12_1(iw) + ssig122 + p055 * stress12_3(iw) - csig12nw = p222 * stress12_2(iw) + ssig121 + p055 * stress12_4(iw) - csig12sw = p222 * stress12_3(iw) + ssig122 + p055 * stress12_1(iw) - csig12se = p222 * stress12_4(iw) + ssig121 + p055 * stress12_2(iw) - - str12ew = p5 * dxT(iw) * (p333 * ssig12e + p166 * ssig12w) - str12we = p5 * dxT(iw) * (p333 * ssig12w + p166 * ssig12e) - str12ns = p5 * dyT(iw) * (p333 * ssig12n + p166 * ssig12s) - str12sn = p5 * dyT(iw) * (p333 * ssig12s + p166 * ssig12n) - - !-------------------------------------------------------------- - ! for dF/dx (u momentum) - !-------------------------------------------------------------- - - strp_tmp = p25 * dyT(iw) * (p333 * ssigpn + p166 * ssigps) - strm_tmp = p25 * dyT(iw) * (p333 * ssigmn + p166 * ssigms) - - ! northeast (i,j) - str1(iw) = -strp_tmp - strm_tmp - str12ew & - + dxhy * (-csigpne + csigmne) + dyhx * csig12ne - - ! northwest (i+1,j) - str2(iw) = strp_tmp + strm_tmp - str12we & - + dxhy * (-csigpnw + csigmnw) + dyhx * csig12nw - - strp_tmp = p25 * dyT(iw) * (p333 * ssigps + p166 * ssigpn) - strm_tmp = p25 * dyT(iw) * (p333 * ssigms + p166 * ssigmn) - - ! southeast (i,j+1) - str3(iw) = -strp_tmp - strm_tmp + str12ew & - + dxhy * (-csigpse + csigmse) + dyhx * csig12se - - ! southwest (i+1,j+1) - str4(iw) = strp_tmp + strm_tmp + str12we & - + dxhy * (-csigpsw + csigmsw) + dyhx * csig12sw - - !-------------------------------------------------------------- - ! for dF/dy (v momentum) - !-------------------------------------------------------------- - - strp_tmp = p25 * dxT(iw) * (p333 * ssigpe + p166 * ssigpw) - strm_tmp = p25 * dxT(iw) * (p333 * ssigme + p166 * ssigmw) - - ! northeast (i,j) - str5(iw) = -strp_tmp + strm_tmp - str12ns & - - dyhx * (csigpne + csigmne) + dxhy * csig12ne - - ! southeast (i,j+1) - str6(iw) = strp_tmp - strm_tmp - str12sn & - - dyhx * (csigpse + csigmse) + dxhy * csig12se - - strp_tmp = p25 * dxT(iw) * (p333 * ssigpw + p166 * ssigpe) - strm_tmp = p25 * dxT(iw) * (p333 * ssigmw + p166 * ssigme) - - ! northwest (i+1,j) - str7(iw) = -strp_tmp + strm_tmp + str12ns & - - dyhx * (csigpnw + csigmnw) + dxhy * csig12nw - - ! southwest (i+1,j+1) - str8(iw) = strp_tmp - strm_tmp + str12sn & - - dyhx * (csigpsw + csigmsw) + dxhy * csig12sw - - end do -#ifdef _OPENACC - !$acc end parallel -#endif - - end subroutine stress_iter - -!======================================================================= - - subroutine stress_last(NA_len, ee, ne, se, lb, ub, uvel, vvel, dxT, & - dyT, hte, htn, htem1, htnm1, strength, stressp_1, stressp_2, & - stressp_3, stressp_4, stressm_1, stressm_2, stressm_3, & - stressm_4, stress12_1, stress12_2, stress12_3, stress12_4, str1, & - str2, str3, str4, str5, str6, str7, str8, skiptcell, tarear, divu, & - rdg_conv, rdg_shear, shear) - - use ice_kinds_mod - use ice_constants, only : p027, p055, p111, p166, p222, p25, & - p333, p5, c1p5, c1, c0 - use ice_dyn_shared, only : ecci, denom1, arlx1i, Ktens, revp,& - deltaminEVP - - implicit none - - integer(kind=int_kind), intent(in) :: NA_len, lb, ub - integer(kind=int_kind), dimension(:), intent(in), contiguous :: & - ee, ne, se - real(kind=dbl_kind), dimension(:), intent(in), contiguous :: & - strength, uvel, vvel, dxT, dyT, hte, htn, htem1, htnm1, tarear - logical(kind=log_kind), intent(in), dimension(:) :: skiptcell - real(kind=dbl_kind), dimension(:), intent(inout), contiguous :: & - stressp_1, stressp_2, stressp_3, stressp_4, stressm_1, & - stressm_2, stressm_3, stressm_4, stress12_1, stress12_2, & - stress12_3, stress12_4 - real(kind=dbl_kind), dimension(:), intent(out), contiguous :: & - str1, str2, str3, str4, str5, str6, str7, str8, divu, & - rdg_conv, rdg_shear, shear - - ! local variables - - integer(kind=int_kind) :: iw, il, iu - real(kind=dbl_kind) :: divune, divunw, divuse, divusw, & - tensionne, tensionnw, tensionse, tensionsw, shearne, shearnw, & - shearse, shearsw, Deltane, Deltanw, Deltase, Deltasw, c0ne, & - c0nw, c0se, c0sw, c1ne, c1nw, c1se, c1sw, ssigpn, ssigps, & - ssigpe, ssigpw, ssigmn, ssigms, ssigme, ssigmw, ssig12n, & - ssig12s, ssig12e, ssig12w, ssigp1, ssigp2, ssigm1, ssigm2, & - ssig121, ssig122, csigpne, csigpnw, csigpse, csigpsw, & - csigmne, csigmnw, csigmse, csigmsw, csig12ne, csig12nw, & - csig12se, csig12sw, str12ew, str12we, str12ns, str12sn, & - strp_tmp, strm_tmp, tmp_uvel_ee, tmp_vvel_se, tmp_vvel_ee, & - tmp_vvel_ne, tmp_uvel_ne, tmp_uvel_se, dxhy, dyhx, cxp, cyp, & - cxm, cym, tmparea, DminTarea - - character(len=*), parameter :: subname = '(stress_last)' - -#ifdef _OPENACC - !$acc parallel & - !$acc present(ee, ne, se, strength, uvel, vvel, dxT, dyT, hte, & - !$acc htn, htem1, htnm1, str1, str2, str3, str4, str5, str6, & - !$acc str7, str8, stressp_1, stressp_2, stressp_3, stressp_4, & - !$acc stressm_1, stressm_2, stressm_3, stressm_4, stress12_1, & - !$acc stress12_2, stress12_3, stress12_4, tarear, divu, & - !$acc rdg_conv, rdg_shear, shear, skiptcell) - !$acc loop - do iw = 1, NA_len -#else - call domp_get_domain(lb, ub, il, iu) - do iw = il, iu -#endif - - if (skiptcell(iw)) cycle - - tmparea = dxT(iw) * dyT(iw) ! necessary to split calc of DminTarea. Otherwize not binary identical - DminTarea = deltaminEVP * tmparea - dxhy = p5 * (hte(iw) - htem1(iw)) - dyhx = p5 * (htn(iw) - htnm1(iw)) - cxp = c1p5 * htn(iw) - p5 * htnm1(iw) - cyp = c1p5 * hte(iw) - p5 * htem1(iw) - cxm = -(c1p5 * htnm1(iw) - p5 * htn(iw)) - cym = -(c1p5 * htem1(iw) - p5 * hte(iw)) - - !-------------------------------------------------------------- - ! strain rates - ! NOTE: these are actually strain rates * area (m^2/s) - !-------------------------------------------------------------- - - tmp_uvel_ne = uvel(ne(iw)) - tmp_uvel_se = uvel(se(iw)) - tmp_uvel_ee = uvel(ee(iw)) - - tmp_vvel_ee = vvel(ee(iw)) - tmp_vvel_se = vvel(se(iw)) - tmp_vvel_ne = vvel(ne(iw)) - - ! divergence = e_11 + e_22 - divune = cyp * uvel(iw) - dyT(iw) * tmp_uvel_ee & - + cxp * vvel(iw) - dxT(iw) * tmp_vvel_se - divunw = cym * tmp_uvel_ee + dyT(iw) * uvel(iw) & - + cxp * tmp_vvel_ee - dxT(iw) * tmp_vvel_ne - divusw = cym * tmp_uvel_ne + dyT(iw) * tmp_uvel_se & - + cxm * tmp_vvel_ne + dxT(iw) * tmp_vvel_ee - divuse = cyp * tmp_uvel_se - dyT(iw) * tmp_uvel_ne & - + cxm * tmp_vvel_se + dxT(iw) * vvel(iw) - - ! tension strain rate = e_11 - e_22 - tensionne = -cym * uvel(iw) - dyT(iw) * tmp_uvel_ee & - + cxm * vvel(iw) + dxT(iw) * tmp_vvel_se - tensionnw = -cyp * tmp_uvel_ee + dyT(iw) * uvel(iw) & - + cxm * tmp_vvel_ee + dxT(iw) * tmp_vvel_ne - tensionsw = -cyp * tmp_uvel_ne + dyT(iw) * tmp_uvel_se & - + cxp * tmp_vvel_ne - dxT(iw) * tmp_vvel_ee - tensionse = -cym * tmp_uvel_se - dyT(iw) * tmp_uvel_ne & - + cxp * tmp_vvel_se - dxT(iw) * vvel(iw) - - ! shearing strain rate = 2 * e_12 - shearne = -cym * vvel(iw) - dyT(iw) * tmp_vvel_ee & - - cxm * uvel(iw) - dxT(iw) * tmp_uvel_se - shearnw = -cyp * tmp_vvel_ee + dyT(iw) * vvel(iw) & - - cxm * tmp_uvel_ee - dxT(iw) * tmp_uvel_ne - shearsw = -cyp * tmp_vvel_ne + dyT(iw) * tmp_vvel_se & - - cxp * tmp_uvel_ne + dxT(iw) * tmp_uvel_ee - shearse = -cym * tmp_vvel_se - dyT(iw) * tmp_vvel_ne & - - cxp * tmp_uvel_se + dxT(iw) * uvel(iw) - - ! Delta (in the denominator of zeta and eta) - Deltane = sqrt(divune**2 + ecci * (tensionne**2 + shearne**2)) - Deltanw = sqrt(divunw**2 + ecci * (tensionnw**2 + shearnw**2)) - Deltasw = sqrt(divusw**2 + ecci * (tensionsw**2 + shearsw**2)) - Deltase = sqrt(divuse**2 + ecci * (tensionse**2 + shearse**2)) - - !-------------------------------------------------------------- - ! on last subcycle, save quantities for mechanical - ! redistribution - !-------------------------------------------------------------- - - divu(iw) = p25 * (divune + divunw + divuse + divusw) * tarear(iw) - rdg_conv(iw) = -min(divu(iw), c0) ! TODO: Could move outside the entire kernel - rdg_shear(iw) = p5 * (p25 * (Deltane + Deltanw + Deltase + Deltasw) * tarear(iw) - abs(divu(iw))) - - ! diagnostic only - ! shear = sqrt(tension**2 + shearing**2) - shear(iw) = p25 * tarear(iw) * sqrt((tensionne + tensionnw + tensionse + tensionsw)**2 & - + (shearne + shearnw + shearse + shearsw)**2) - - !-------------------------------------------------------------- - ! replacement pressure/Delta (kg/s) - ! save replacement pressure for principal stress calculation - !-------------------------------------------------------------- - - c0ne = strength(iw) / max(Deltane, DminTarea) - c0nw = strength(iw) / max(Deltanw, DminTarea) - c0sw = strength(iw) / max(Deltasw, DminTarea) - c0se = strength(iw) / max(Deltase, DminTarea) - - c1ne = c0ne * arlx1i - c1nw = c0nw * arlx1i - c1sw = c0sw * arlx1i - c1se = c0se * arlx1i - - c0ne = c1ne * ecci - c0nw = c1nw * ecci - c0sw = c1sw * ecci - c0se = c1se * ecci - - !-------------------------------------------------------------- - ! the stresses (kg/s^2) - ! (1) northeast, (2) northwest, (3) southwest, (4) southeast - !-------------------------------------------------------------- - - stressp_1(iw) = (stressp_1(iw) * (c1 - arlx1i * revp) & - + c1ne * (divune * (c1 + Ktens) - Deltane * (c1 - Ktens))) * denom1 - stressp_2(iw) = (stressp_2(iw) * (c1 - arlx1i * revp) & - + c1nw * (divunw * (c1 + Ktens) - Deltanw * (c1 - Ktens))) * denom1 - stressp_3(iw) = (stressp_3(iw) * (c1 - arlx1i * revp) & - + c1sw * (divusw * (c1 + Ktens) - Deltasw * (c1 - Ktens))) * denom1 - stressp_4(iw) = (stressp_4(iw) * (c1 - arlx1i * revp) & - + c1se * (divuse * (c1 + Ktens) - Deltase * (c1 - Ktens))) * denom1 - - stressm_1(iw) = (stressm_1(iw) * (c1 - arlx1i * revp) + c0ne * tensionne * (c1 + Ktens)) * denom1 - stressm_2(iw) = (stressm_2(iw) * (c1 - arlx1i * revp) + c0nw * tensionnw * (c1 + Ktens)) * denom1 - stressm_3(iw) = (stressm_3(iw) * (c1 - arlx1i * revp) + c0sw * tensionsw * (c1 + Ktens)) * denom1 - stressm_4(iw) = (stressm_4(iw) * (c1 - arlx1i * revp) + c0se * tensionse * (c1 + Ktens)) * denom1 - - stress12_1(iw) = (stress12_1(iw) * (c1 - arlx1i * revp) + c0ne * shearne * p5 * (c1 + Ktens)) * denom1 - stress12_2(iw) = (stress12_2(iw) * (c1 - arlx1i * revp) + c0nw * shearnw * p5 * (c1 + Ktens)) * denom1 - stress12_3(iw) = (stress12_3(iw) * (c1 - arlx1i * revp) + c0sw * shearsw * p5 * (c1 + Ktens)) * denom1 - stress12_4(iw) = (stress12_4(iw) * (c1 - arlx1i * revp) + c0se * shearse * p5 * (c1 + Ktens)) * denom1 - - !-------------------------------------------------------------- - ! combinations of the stresses for the momentum equation - ! (kg/s^2) - !-------------------------------------------------------------- - - ssigpn = stressp_1(iw) + stressp_2(iw) - ssigps = stressp_3(iw) + stressp_4(iw) - ssigpe = stressp_1(iw) + stressp_4(iw) - ssigpw = stressp_2(iw) + stressp_3(iw) - ssigp1 = (stressp_1(iw) + stressp_3(iw)) * p055 - ssigp2 = (stressp_2(iw) + stressp_4(iw)) * p055 - - ssigmn = stressm_1(iw) + stressm_2(iw) - ssigms = stressm_3(iw) + stressm_4(iw) - ssigme = stressm_1(iw) + stressm_4(iw) - ssigmw = stressm_2(iw) + stressm_3(iw) - ssigm1 = (stressm_1(iw) + stressm_3(iw)) * p055 - ssigm2 = (stressm_2(iw) + stressm_4(iw)) * p055 - - ssig12n = stress12_1(iw) + stress12_2(iw) - ssig12s = stress12_3(iw) + stress12_4(iw) - ssig12e = stress12_1(iw) + stress12_4(iw) - ssig12w = stress12_2(iw) + stress12_3(iw) - ssig121 = (stress12_1(iw) + stress12_3(iw)) * p111 - ssig122 = (stress12_2(iw) + stress12_4(iw)) * p111 - - csigpne = p111 * stressp_1(iw) + ssigp2 + p027 * stressp_3(iw) - csigpnw = p111 * stressp_2(iw) + ssigp1 + p027 * stressp_4(iw) - csigpsw = p111 * stressp_3(iw) + ssigp2 + p027 * stressp_1(iw) - csigpse = p111 * stressp_4(iw) + ssigp1 + p027 * stressp_2(iw) - - csigmne = p111 * stressm_1(iw) + ssigm2 + p027 * stressm_3(iw) - csigmnw = p111 * stressm_2(iw) + ssigm1 + p027 * stressm_4(iw) - csigmsw = p111 * stressm_3(iw) + ssigm2 + p027 * stressm_1(iw) - csigmse = p111 * stressm_4(iw) + ssigm1 + p027 * stressm_2(iw) - - csig12ne = p222 * stress12_1(iw) + ssig122 + p055 * stress12_3(iw) - csig12nw = p222 * stress12_2(iw) + ssig121 + p055 * stress12_4(iw) - csig12sw = p222 * stress12_3(iw) + ssig122 + p055 * stress12_1(iw) - csig12se = p222 * stress12_4(iw) + ssig121 + p055 * stress12_2(iw) - - str12ew = p5 * dxT(iw) * (p333 * ssig12e + p166 * ssig12w) - str12we = p5 * dxT(iw) * (p333 * ssig12w + p166 * ssig12e) - str12ns = p5 * dyT(iw) * (p333 * ssig12n + p166 * ssig12s) - str12sn = p5 * dyT(iw) * (p333 * ssig12s + p166 * ssig12n) - - !-------------------------------------------------------------- - ! for dF/dx (u momentum) - !-------------------------------------------------------------- - - strp_tmp = p25 * dyT(iw) * (p333 * ssigpn + p166 * ssigps) - strm_tmp = p25 * dyT(iw) * (p333 * ssigmn + p166 * ssigms) - - ! northeast (i,j) - str1(iw) = -strp_tmp - strm_tmp - str12ew & - + dxhy * (-csigpne + csigmne) + dyhx * csig12ne - - ! northwest (i+1,j) - str2(iw) = strp_tmp + strm_tmp - str12we & - + dxhy * (-csigpnw + csigmnw) + dyhx * csig12nw - - strp_tmp = p25 * dyT(iw) * (p333 * ssigps + p166 * ssigpn) - strm_tmp = p25 * dyT(iw) * (p333 * ssigms + p166 * ssigmn) - - ! southeast (i,j+1) - str3(iw) = -strp_tmp - strm_tmp + str12ew & - + dxhy * (-csigpse + csigmse) + dyhx * csig12se - - ! southwest (i+1,j+1) - str4(iw) = strp_tmp + strm_tmp + str12we & - + dxhy * (-csigpsw + csigmsw) + dyhx * csig12sw - - !-------------------------------------------------------------- - ! for dF/dy (v momentum) - !-------------------------------------------------------------- - - strp_tmp = p25 * dxT(iw) * (p333 * ssigpe + p166 * ssigpw) - strm_tmp = p25 * dxT(iw) * (p333 * ssigme + p166 * ssigmw) - - ! northeast (i,j) - str5(iw) = -strp_tmp + strm_tmp - str12ns & - - dyhx * (csigpne + csigmne) + dxhy * csig12ne - - ! southeast (i,j+1) - str6(iw) = strp_tmp - strm_tmp - str12sn & - - dyhx * (csigpse + csigmse) + dxhy * csig12se - - strp_tmp = p25 * dxT(iw) * (p333 * ssigpw + p166 * ssigpe) - strm_tmp = p25 * dxT(iw) * (p333 * ssigmw + p166 * ssigme) - - ! northwest (i+1,j) - str7(iw) = -strp_tmp + strm_tmp + str12ns & - - dyhx * (csigpnw + csigmnw) + dxhy * csig12nw - - ! southwest (i+1,j+1) - str8(iw) = strp_tmp - strm_tmp + str12sn & - - dyhx * (csigpsw + csigmsw) + dxhy * csig12sw - - end do -#ifdef _OPENACC - !$acc end parallel -#endif - - end subroutine stress_last - -!======================================================================= - - subroutine stepu_iter(NA_len, rhow, lb, ub, Cw, aiu, uocn, vocn, & - forcex, forcey, umassdti, fm, uarear, Tbu, uvel_init, vvel_init, & - uvel, vvel, str1, str2, str3, str4, str5, str6, str7, str8, nw, & - sw, sse, skipucell) - - use ice_kinds_mod - use ice_constants, only : c0, c1 - use ice_dyn_shared, only : brlx, revp, u0, cosw, sinw - - implicit none - - integer(kind=int_kind), intent(in) :: NA_len, lb, ub - real(kind=dbl_kind), intent(in) :: rhow - logical(kind=log_kind), intent(in), dimension(:) :: skipucell - integer(kind=int_kind), dimension(:), intent(in), contiguous :: & - nw, sw, sse - real(kind=dbl_kind), dimension(:), intent(in), contiguous :: & - uvel_init, vvel_init, aiu, forcex, forcey, umassdti, Tbu, & - uocn, vocn, fm, uarear, Cw, str1, str2, str3, str4, str5, & - str6, str7, str8 - real(kind=dbl_kind), dimension(:), intent(inout), contiguous :: & - uvel, vvel - - ! local variables - - integer(kind=int_kind) :: iw, il, iu - real(kind=dbl_kind) :: uold, vold, vrel, cca, ccb, ab2, cc1, & - cc2, taux, tauy, Cb, tmp_str2_nw, tmp_str3_sse, tmp_str4_sw, & - tmp_str6_sse, tmp_str7_nw, tmp_str8_sw, waterx, watery, & - tmp_strintx, tmp_strinty - - character(len=*), parameter :: subname = '(stepu_iter)' - -#ifdef _OPENACC - !$acc parallel & - !$acc present(Cw, aiu, uocn, vocn, forcex, forcey, umassdti, fm, & - !$acc uarear, Tbu, uvel_init, vvel_init, nw, sw, sse, skipucell, & - !$acc str1, str2, str3, str4, str5, str6, str7, str8, uvel, & - !$acc vvel) - !$acc loop - do iw = 1, NA_len -#else - call domp_get_domain(lb, ub, il, iu) - do iw = il, iu -#endif - - if (skipucell(iw)) cycle - - uold = uvel(iw) - vold = vvel(iw) - - vrel = aiu(iw) * rhow * Cw(iw) * sqrt((uocn(iw) - uold)**2 + (vocn(iw) - vold)**2) - - waterx = uocn(iw) * cosw - vocn(iw) * sinw * sign(c1, fm(iw)) - watery = vocn(iw) * cosw + uocn(iw) * sinw * sign(c1, fm(iw)) - - taux = vrel * waterx - tauy = vrel * watery - - Cb = Tbu(iw) / (sqrt(uold**2 + vold**2) + u0) - - cca = (brlx + revp) * umassdti(iw) + vrel * cosw + Cb - ccb = fm(iw) + sign(c1, fm(iw)) * vrel * sinw - - ab2 = cca**2 + ccb**2 - - tmp_str2_nw = str2(nw(iw)) - tmp_str3_sse = str3(sse(iw)) - tmp_str4_sw = str4(sw(iw)) - tmp_str6_sse = str6(sse(iw)) - tmp_str7_nw = str7(nw(iw)) - tmp_str8_sw = str8(sw(iw)) - - tmp_strintx = uarear(iw) * (str1(iw) + tmp_str2_nw + tmp_str3_sse + tmp_str4_sw) - tmp_strinty = uarear(iw) * (str5(iw) + tmp_str6_sse + tmp_str7_nw + tmp_str8_sw) - - cc1 = tmp_strintx + forcex(iw) + taux & - + umassdti(iw) * (brlx * uold + revp * uvel_init(iw)) - cc2 = tmp_strinty + forcey(iw) + tauy & - + umassdti(iw) * (brlx * vold + revp * vvel_init(iw)) - - uvel(iw) = (cca * cc1 + ccb * cc2) / ab2 - vvel(iw) = (cca * cc2 - ccb * cc1) / ab2 - - end do -#ifdef _OPENACC - !$acc end parallel -#endif - - end subroutine stepu_iter - -!======================================================================= - - subroutine stepu_last(NA_len, rhow, lb, ub, Cw, aiu, uocn, vocn, & - forcex, forcey, umassdti, fm, uarear, Tbu, uvel_init, vvel_init, & - uvel, vvel, str1, str2, str3, str4, str5, str6, str7, str8, nw, & - sw, sse, skipucell, strintx, strinty, taubx, tauby) - - use ice_kinds_mod - use ice_constants, only : c0, c1 - use ice_dyn_shared, only : brlx, revp, u0, cosw, sinw - - implicit none - - integer(kind=int_kind), intent(in) :: NA_len, lb, ub - real(kind=dbl_kind), intent(in) :: rhow - logical(kind=log_kind), intent(in), dimension(:) :: skipucell - integer(kind=int_kind), dimension(:), intent(in), contiguous :: & - nw, sw, sse - real(kind=dbl_kind), dimension(:), intent(in), contiguous :: & - uvel_init, vvel_init, aiu, forcex, forcey, umassdti, Tbu, & - uocn, vocn, fm, uarear, Cw, str1, str2, str3, str4, str5, & - str6, str7, str8 - real(kind=dbl_kind), dimension(:), intent(inout), contiguous :: & - uvel, vvel, strintx, strinty, taubx, tauby - - ! local variables - - integer(kind=int_kind) :: iw, il, iu - real(kind=dbl_kind) :: uold, vold, vrel, cca, ccb, ab2, cc1, & - cc2, taux, tauy, Cb, tmp_str2_nw, tmp_str3_sse, tmp_str4_sw, & - tmp_str6_sse, tmp_str7_nw, tmp_str8_sw, waterx, watery - - character(len=*), parameter :: subname = '(stepu_last)' - -#ifdef _OPENACC - !$acc parallel & - !$acc present(Cw, aiu, uocn, vocn, forcex, forcey, umassdti, fm, & - !$acc uarear, Tbu, uvel_init, vvel_init, nw, sw, sse, skipucell, & - !$acc str1, str2, str3, str4, str5, str6, str7, str8, uvel, & - !$acc vvel, strintx, strinty, taubx, tauby) - !$acc loop - do iw = 1, NA_len -#else - call domp_get_domain(lb, ub, il, iu) - do iw = il, iu -#endif - - if (skipucell(iw)) cycle - - uold = uvel(iw) - vold = vvel(iw) - - vrel = aiu(iw) * rhow * Cw(iw) * sqrt((uocn(iw) - uold)**2 + (vocn(iw) - vold)**2) - - waterx = uocn(iw) * cosw - vocn(iw) * sinw * sign(c1, fm(iw)) - watery = vocn(iw) * cosw + uocn(iw) * sinw * sign(c1, fm(iw)) - - taux = vrel * waterx - tauy = vrel * watery - - Cb = Tbu(iw) / (sqrt(uold**2 + vold**2) + u0) - - cca = (brlx + revp) * umassdti(iw) + vrel * cosw + Cb - ccb = fm(iw) + sign(c1, fm(iw)) * vrel * sinw - - ab2 = cca**2 + ccb**2 - - tmp_str2_nw = str2(nw(iw)) - tmp_str3_sse = str3(sse(iw)) - tmp_str4_sw = str4(sw(iw)) - tmp_str6_sse = str6(sse(iw)) - tmp_str7_nw = str7(nw(iw)) - tmp_str8_sw = str8(sw(iw)) - - strintx(iw) = uarear(iw) * (str1(iw) + tmp_str2_nw + tmp_str3_sse + tmp_str4_sw) - strinty(iw) = uarear(iw) * (str5(iw) + tmp_str6_sse + tmp_str7_nw + tmp_str8_sw) - - cc1 = strintx(iw) + forcex(iw) + taux & - + umassdti(iw) * (brlx * uold + revp * uvel_init(iw)) - cc2 = strinty(iw) + forcey(iw) + tauy & - + umassdti(iw) * (brlx * vold + revp * vvel_init(iw)) - - uvel(iw) = (cca * cc1 + ccb * cc2) / ab2 - vvel(iw) = (cca * cc2 - ccb * cc1) / ab2 - - ! calculate seabed stress component for outputs - taubx(iw) = -uvel(iw) * Tbu(iw) / (sqrt(uold**2 + vold**2) + u0) - tauby(iw) = -vvel(iw) * Tbu(iw) / (sqrt(uold**2 + vold**2) + u0) - - end do -#ifdef _OPENACC - !$acc end parallel -#endif - - end subroutine stepu_last - -!======================================================================= - - subroutine evp1d_halo_update(NAVEL_len, lb, ub, uvel, vvel, & - halo_parent) - - use ice_kinds_mod - - implicit none - - integer(kind=int_kind), intent(in) :: NAVEL_len, lb, ub - integer(kind=int_kind), dimension(:), intent(in), contiguous :: & - halo_parent - real(kind=dbl_kind), dimension(:), intent(inout), contiguous :: & - uvel, vvel - - ! local variables - - integer (kind=int_kind) :: iw, il, iu - - character(len=*), parameter :: subname = '(evp1d_halo_update)' - -#ifdef _OPENACC - !$acc parallel & - !$acc present(uvel, vvel) - !$acc loop - do iw = 1, NAVEL_len - if (halo_parent(iw) == 0) cycle - uvel(iw) = uvel(halo_parent(iw)) - vvel(iw) = vvel(halo_parent(iw)) - end do - !$acc end parallel -#else - call domp_get_domain(lb, ub, il, iu) - do iw = il, iu - if (halo_parent(iw) == 0) cycle - uvel(iw) = uvel(halo_parent(iw)) - vvel(iw) = vvel(halo_parent(iw)) - end do - call domp_get_domain(ub + 1, NAVEL_len, il, iu) - do iw = il, iu - if (halo_parent(iw) == 0) cycle - uvel(iw) = uvel(halo_parent(iw)) - vvel(iw) = vvel(halo_parent(iw)) - end do -#endif - - end subroutine evp1d_halo_update - -!======================================================================= - - subroutine alloc1d(na) - - implicit none - - integer(kind=int_kind), intent(in) :: na - - ! local variables - - integer(kind=int_kind) :: ierr - - character(len=*), parameter :: subname = '(alloc1d)' - - allocate( & - ! helper indices for neighbours - indj(1:na), indi(1:na), ee(1:na), ne(1:na), se(1:na), & - nw(1:na), sw(1:na), sse(1:na), skipucell(1:na), & - skiptcell(1:na), & - ! grid distances and their "-1 neighbours" - HTE(1:na), HTN(1:na), HTEm1(1:na), HTNm1(1:na), & - ! T cells - strength(1:na), dxT(1:na), dyT(1:na), tarear(1:na), & - stressp_1(1:na), stressp_2(1:na), stressp_3(1:na), & - stressp_4(1:na), stressm_1(1:na), stressm_2(1:na), & - stressm_3(1:na), stressm_4(1:na), stress12_1(1:na), & - stress12_2(1:na), stress12_3(1:na), stress12_4(1:na), & - divu(1:na), rdg_conv(1:na), rdg_shear(1:na), shear(1:na), & - ! U cells - cdn_ocn(1:na), aiu(1:na), uocn(1:na), vocn(1:na), & - forcex(1:na), forcey(1:na), Tbu(1:na), umassdti(1:na), & - fm(1:na), uarear(1:na), strintx(1:na), strinty(1:na), & - uvel_init(1:na), vvel_init(1:na), taubx(1:na), tauby(1:na), & - ! error handling - stat=ierr) - - if (ierr /= 0) call abort_ice(subname & - // ' ERROR: could not allocate 1D arrays') - - end subroutine alloc1d - -!======================================================================= - - subroutine alloc1d_navel(navel) - - implicit none - - integer(kind=int_kind), intent(in) :: navel - - ! local variables - - integer(kind=int_kind) :: ierr - - character(len=*), parameter :: subname = '(alloc1d_navel)' - - allocate(uvel(1:navel), vvel(1:navel), indij(1:navel), & - halo_parent(1:navel), str1(1:navel), str2(1:navel), & - str3(1:navel), str4(1:navel), str5(1:navel), str6(1:navel), & - str7(1:navel), str8(1:navel), stat=ierr) - - if (ierr /= 0) call abort_ice(subname & - // ' ERROR: could not allocate 1D arrays') - - end subroutine alloc1d_navel - -!======================================================================= - - subroutine dealloc1d - - implicit none - - ! local variables - - integer(kind=int_kind) :: ierr - - character(len=*), parameter :: subname = '(dealloc1d)' - - deallocate( & - ! helper indices for neighbours - indj, indi, ee, ne, se, nw, sw, sse, skipucell, skiptcell, & - ! grid distances and their "-1 neighbours" - HTE, HTN, HTEm1, HTNm1, & - ! T cells - strength, dxT, dyT, tarear, stressp_1, stressp_2, stressp_3, & - stressp_4, stressm_1, stressm_2, stressm_3, stressm_4, & - stress12_1, stress12_2, stress12_3, stress12_4, str1, str2, & - str3, str4, str5, str6, str7, str8, divu, rdg_conv, & - rdg_shear, shear, & - ! U cells - cdn_ocn, aiu, uocn, vocn, forcex, forcey, Tbu, umassdti, fm, & - uarear, strintx, strinty, uvel_init, vvel_init, taubx, tauby, & - uvel, vvel, indij, halo_parent, & - ! error handling - stat=ierr) - - if (ierr /= 0) call abort_ice(subname & - // ' ERROR: could not deallocate 1D arrays') - - end subroutine dealloc1d - -!======================================================================= - - subroutine ice_dyn_evp_1d_copyin(nx, ny, nblk, nx_glob, ny_glob, & - I_iceTmask, I_iceUmask, I_cdn_ocn, I_aiu, I_uocn, I_vocn, & - I_forcex, I_forcey, I_Tbu, I_umassdti, I_fm, I_uarear, I_tarear, & - I_strintx, I_strinty, I_uvel_init, I_vvel_init, I_strength, & - I_uvel, I_vvel, I_dxT, I_dyT, I_stressp_1, I_stressp_2, & - I_stressp_3, I_stressp_4, I_stressm_1, I_stressm_2, I_stressm_3, & - I_stressm_4, I_stress12_1, I_stress12_2, I_stress12_3, & - I_stress12_4) - - use ice_gather_scatter, only : gather_global_ext - use ice_domain, only : distrb_info - use ice_communicate, only : my_task, master_task - use ice_grid, only : G_HTE, G_HTN - use ice_constants, only : c0 - - implicit none - - integer(int_kind), intent(in) :: nx, ny, nblk, nx_glob, ny_glob - logical(kind=log_kind), dimension(nx, ny, nblk), intent(in) :: & - I_iceTmask, I_iceUmask - real(kind=dbl_kind), dimension(nx, ny, nblk), intent(in) :: & - I_cdn_ocn, I_aiu, I_uocn, I_vocn, I_forcex, I_forcey, I_Tbu, & - I_umassdti, I_fm, I_uarear, I_tarear, I_strintx, I_strinty, & - I_uvel_init, I_vvel_init, I_strength, I_uvel, I_vvel, I_dxT, & - I_dyT, I_stressp_1, I_stressp_2, I_stressp_3, I_stressp_4, & - I_stressm_1, I_stressm_2, I_stressm_3, I_stressm_4, & - I_stress12_1, I_stress12_2, I_stress12_3, I_stress12_4 - - ! local variables - - logical(kind=log_kind), dimension(nx_glob, ny_glob) :: & - G_iceTmask, G_iceUmask - real(kind=dbl_kind), dimension(nx_glob, ny_glob) :: & - G_cdn_ocn, G_aiu, G_uocn, G_vocn, G_forcex, G_forcey, G_Tbu, & - G_umassdti, G_fm, G_uarear, G_tarear, G_strintx, G_strinty, & - G_uvel_init, G_vvel_init, G_strength, G_uvel, G_vvel, G_dxT, & - G_dyT, G_stressp_1, G_stressp_2, G_stressp_3, G_stressp_4, & - G_stressm_1, G_stressm_2, G_stressm_3, G_stressm_4, & - G_stress12_1, G_stress12_2, G_stress12_3, G_stress12_4 - - character(len=*), parameter :: & - subname = '(ice_dyn_evp_1d_copyin)' - - call gather_global_ext(G_iceTmask, I_iceTmask, master_task, distrb_info ) - call gather_global_ext(G_iceUmask, I_iceUmask, master_task, distrb_info ) - call gather_global_ext(G_cdn_ocn, I_cdn_ocn, master_task, distrb_info ) - call gather_global_ext(G_aiu, I_aiu, master_task, distrb_info ) - call gather_global_ext(G_uocn, I_uocn, master_task, distrb_info ) - call gather_global_ext(G_vocn, I_vocn, master_task, distrb_info ) - call gather_global_ext(G_forcex, I_forcex, master_task, distrb_info ) - call gather_global_ext(G_forcey, I_forcey, master_task, distrb_info ) - call gather_global_ext(G_Tbu, I_Tbu, master_task, distrb_info ) - call gather_global_ext(G_umassdti, I_umassdti, master_task, distrb_info ) - call gather_global_ext(G_fm, I_fm, master_task, distrb_info ) - call gather_global_ext(G_uarear, I_uarear, master_task, distrb_info ) - call gather_global_ext(G_tarear, I_tarear, master_task, distrb_info ) - call gather_global_ext(G_strintx, I_strintx, master_task, distrb_info ) - call gather_global_ext(G_strinty, I_strinty, master_task, distrb_info ) - call gather_global_ext(G_uvel_init, I_uvel_init, master_task, distrb_info ) - call gather_global_ext(G_vvel_init, I_vvel_init, master_task, distrb_info ) - call gather_global_ext(G_strength, I_strength, master_task, distrb_info ) - call gather_global_ext(G_uvel, I_uvel, master_task, distrb_info, c0) - call gather_global_ext(G_vvel, I_vvel, master_task, distrb_info, c0) - call gather_global_ext(G_dxT, I_dxT, master_task, distrb_info ) - call gather_global_ext(G_dyT, I_dyT, master_task, distrb_info ) - call gather_global_ext(G_stressp_1, I_stressp_1, master_task, distrb_info ) - call gather_global_ext(G_stressp_2, I_stressp_2, master_task, distrb_info ) - call gather_global_ext(G_stressp_3, I_stressp_3, master_task, distrb_info ) - call gather_global_ext(G_stressp_4, I_stressp_4, master_task, distrb_info ) - call gather_global_ext(G_stressm_1, I_stressm_1, master_task, distrb_info ) - call gather_global_ext(G_stressm_2, I_stressm_2, master_task, distrb_info ) - call gather_global_ext(G_stressm_3, I_stressm_3, master_task, distrb_info ) - call gather_global_ext(G_stressm_4, I_stressm_4, master_task, distrb_info ) - call gather_global_ext(G_stress12_1, I_stress12_1, master_task, distrb_info ) - call gather_global_ext(G_stress12_2, I_stress12_2, master_task, distrb_info ) - call gather_global_ext(G_stress12_3, I_stress12_3, master_task, distrb_info ) - call gather_global_ext(G_stress12_4, I_stress12_4, master_task, distrb_info ) - - ! all calculations id done on master task - if (my_task == master_task) then - ! find number of active points and allocate 1D vectors - call calc_na(nx_glob, ny_glob, NA_len, G_iceTmask, G_iceUmask) - call alloc1d(NA_len) - call calc_2d_indices(nx_glob, ny_glob, NA_len, G_iceTmask, G_iceUmask) - call calc_navel(nx_glob, ny_glob, NA_len, NAVEL_len) - call alloc1d_navel(NAVEL_len) - ! initialize OpenMP. FIXME: ought to be called from main - call domp_init() - !$OMP PARALLEL DEFAULT(shared) - call numainit(1, NA_len, NAVEL_len) - !$OMP END PARALLEL - ! map 2D arrays to 1D arrays - call convert_2d_1d(nx_glob, ny_glob, NA_len, NAVEL_len, & - G_HTE, G_HTN, G_cdn_ocn, G_aiu, G_uocn, G_vocn, G_forcex, & - G_forcey, G_Tbu, G_umassdti, G_fm, G_uarear, G_tarear, & - G_strintx, G_strinty, G_uvel_init, G_vvel_init, & - G_strength, G_uvel, G_vvel, G_dxT, G_dyT, G_stressp_1, & - G_stressp_2, G_stressp_3, G_stressp_4, G_stressm_1, & - G_stressm_2, G_stressm_3, G_stressm_4, G_stress12_1, & - G_stress12_2, G_stress12_3, G_stress12_4) - call calc_halo_parent(nx_glob, ny_glob, NA_len, NAVEL_len, G_iceTmask) - end if - - end subroutine ice_dyn_evp_1d_copyin - -!======================================================================= - - subroutine ice_dyn_evp_1d_copyout(nx, ny, nblk, nx_glob, ny_glob, & - I_uvel, I_vvel, I_strintx, I_strinty, I_stressp_1, I_stressp_2, & - I_stressp_3, I_stressp_4, I_stressm_1, I_stressm_2, I_stressm_3, & - I_stressm_4, I_stress12_1, I_stress12_2, I_stress12_3, & - I_stress12_4, I_divu, I_rdg_conv, I_rdg_shear, I_shear, I_taubx, & - I_tauby) - - use ice_constants, only : c0 - use ice_gather_scatter, only : scatter_global_ext - use ice_domain, only : distrb_info - use ice_communicate, only : my_task, master_task - - implicit none - - integer(int_kind), intent(in) :: nx, ny, nblk, nx_glob, ny_glob - real(dbl_kind), dimension(nx, ny, nblk), intent(out) :: I_uvel, & - I_vvel, I_strintx, I_strinty, I_stressp_1, I_stressp_2, & - I_stressp_3, I_stressp_4, I_stressm_1, I_stressm_2, & - I_stressm_3, I_stressm_4, I_stress12_1, I_stress12_2, & - I_stress12_3, I_stress12_4, I_divu, I_rdg_conv, I_rdg_shear, & - I_shear, I_taubx, I_tauby - - ! local variables - - integer(int_kind) :: iw, lo, up, j, i - real(dbl_kind), dimension(nx_glob, ny_glob) :: G_uvel, G_vvel, & - G_strintx, G_strinty, G_stressp_1, G_stressp_2, G_stressp_3, & - G_stressp_4, G_stressm_1, G_stressm_2, G_stressm_3, & - G_stressm_4, G_stress12_1, G_stress12_2, G_stress12_3, & - G_stress12_4, G_divu, G_rdg_conv, G_rdg_shear, G_shear, & - G_taubx, G_tauby - - character(len=*), parameter :: & - subname = '(ice_dyn_evp_1d_copyout)' - - ! remap 1D arrays into 2D arrays - if (my_task == master_task) then - - G_uvel = c0 - G_vvel = c0 - G_strintx = c0 - G_strinty = c0 - G_stressp_1 = c0 - G_stressp_2 = c0 - G_stressp_3 = c0 - G_stressp_4 = c0 - G_stressm_1 = c0 - G_stressm_2 = c0 - G_stressm_3 = c0 - G_stressm_4 = c0 - G_stress12_1 = c0 - G_stress12_2 = c0 - G_stress12_3 = c0 - G_stress12_4 = c0 - G_divu = c0 - G_rdg_conv = c0 - G_rdg_shear = c0 - G_shear = c0 - G_taubx = c0 - G_tauby = c0 - - !$OMP PARALLEL PRIVATE(iw, lo, up, j, i) - call domp_get_domain(1, NA_len, lo, up) - do iw = lo, up - ! get 2D indices - i = indi(iw) - j = indj(iw) - ! remap - G_strintx(i, j) = strintx(iw) - G_strinty(i, j) = strinty(iw) - G_stressp_1(i, j) = stressp_1(iw) - G_stressp_2(i, j) = stressp_2(iw) - G_stressp_3(i, j) = stressp_3(iw) - G_stressp_4(i, j) = stressp_4(iw) - G_stressm_1(i, j) = stressm_1(iw) - G_stressm_2(i, j) = stressm_2(iw) - G_stressm_3(i, j) = stressm_3(iw) - G_stressm_4(i, j) = stressm_4(iw) - G_stress12_1(i, j) = stress12_1(iw) - G_stress12_2(i, j) = stress12_2(iw) - G_stress12_3(i, j) = stress12_3(iw) - G_stress12_4(i, j) = stress12_4(iw) - G_divu(i, j) = divu(iw) - G_rdg_conv(i, j) = rdg_conv(iw) - G_rdg_shear(i, j) = rdg_shear(iw) - G_shear(i, j) = shear(iw) - G_taubx(i, j) = taubx(iw) - G_tauby(i, j) = tauby(iw) - G_uvel(i, j) = uvel(iw) - G_vvel(i, j) = vvel(iw) - end do - call domp_get_domain(NA_len + 1, NAVEL_len, lo, up) - do iw = lo, up - ! get 2D indices - j = int((indij(iw) - 1) / (nx_glob)) + 1 - i = indij(iw) - (j - 1) * nx_glob - ! remap - G_uvel(i, j) = uvel(iw) - G_vvel(i, j) = vvel(iw) - end do - !$OMP END PARALLEL - - call dealloc1d() - - end if - - ! scatter data on all tasks - call scatter_global_ext(I_uvel, G_uvel, master_task, distrb_info) - call scatter_global_ext(I_vvel, G_vvel, master_task, distrb_info) - call scatter_global_ext(I_strintx, G_strintx, master_task, distrb_info) - call scatter_global_ext(I_strinty, G_strinty, master_task, distrb_info) - call scatter_global_ext(I_stressp_1, G_stressp_1, master_task, distrb_info) - call scatter_global_ext(I_stressp_2, G_stressp_2, master_task, distrb_info) - call scatter_global_ext(I_stressp_3, G_stressp_3, master_task, distrb_info) - call scatter_global_ext(I_stressp_4, G_stressp_4, master_task, distrb_info) - call scatter_global_ext(I_stressm_1, G_stressm_1, master_task, distrb_info) - call scatter_global_ext(I_stressm_2, G_stressm_2, master_task, distrb_info) - call scatter_global_ext(I_stressm_3, G_stressm_3, master_task, distrb_info) - call scatter_global_ext(I_stressm_4, G_stressm_4, master_task, distrb_info) - call scatter_global_ext(I_stress12_1, G_stress12_1, master_task, distrb_info) - call scatter_global_ext(I_stress12_2, G_stress12_2, master_task, distrb_info) - call scatter_global_ext(I_stress12_3, G_stress12_3, master_task, distrb_info) - call scatter_global_ext(I_stress12_4, G_stress12_4, master_task, distrb_info) - call scatter_global_ext(I_divu, G_divu, master_task, distrb_info) - call scatter_global_ext(I_rdg_conv, G_rdg_conv, master_task, distrb_info) - call scatter_global_ext(I_rdg_shear, G_rdg_shear, master_task, distrb_info) - call scatter_global_ext(I_shear, G_shear, master_task, distrb_info) - call scatter_global_ext(I_taubx, G_taubx, master_task, distrb_info) - call scatter_global_ext(I_tauby, G_tauby, master_task, distrb_info) - - end subroutine ice_dyn_evp_1d_copyout - -!======================================================================= - - subroutine ice_dyn_evp_1d_kernel - - use ice_constants, only : c0 - use ice_dyn_shared, only : ndte - use ice_communicate, only : my_task, master_task - - implicit none - - ! local variables - - real(kind=dbl_kind) :: rhow - integer(kind=int_kind) :: ksub - - character(len=*), parameter :: & - subname = '(ice_dyn_evp_1d_kernel)' - - ! all calculations is done on master task - if (my_task == master_task) then - - ! read constants - call icepack_query_parameters(rhow_out = rhow) - call icepack_warnings_flush(nu_diag) - if (icepack_warnings_aborted()) then - call abort_ice(error_message=subname, file=__FILE__, & - line=__LINE__) - end if - - if (ndte < 2) call abort_ice(subname & - // ' ERROR: ndte must be 2 or higher for this kernel') - - ! tcraig, turn off the OMP directives here, Jan, 2022 - ! This produces non bit-for-bit results with different thread counts. - ! Seems like there isn't an opportunity for safe threading here ??? - !$XXXOMP PARALLEL PRIVATE(ksub) - do ksub = 1, ndte - 1 - call evp1d_stress(NA_len, ee, ne, se, 1, NA_len, uvel, & - vvel, dxT, dyT, hte, htn, htem1, htnm1, strength, & - stressp_1, stressp_2, stressp_3, stressp_4, stressm_1, & - stressm_2, stressm_3, stressm_4, stress12_1, & - stress12_2, stress12_3, stress12_4, str1, str2, str3, & - str4, str5, str6, str7, str8, skiptcell) - !$XXXOMP BARRIER - call evp1d_stepu(NA_len, rhow, 1, NA_len, cdn_ocn, aiu, & - uocn, vocn, forcex, forcey, umassdti, fm, uarear, Tbu, & - uvel_init, vvel_init, uvel, vvel, str1, str2, str3, & - str4, str5, str6, str7, str8, nw, sw, sse, skipucell) - !$XXXOMP BARRIER - call evp1d_halo_update(NAVEL_len, 1, NA_len, uvel, vvel, & - halo_parent) - !$XXXOMP BARRIER - end do - - call evp1d_stress(NA_len, ee, ne, se, 1, NA_len, uvel, vvel, & - dxT, dyT, hte, htn, htem1, htnm1, strength, stressp_1, & - stressp_2, stressp_3, stressp_4, stressm_1, stressm_2, & - stressm_3, stressm_4, stress12_1, stress12_2, stress12_3, & - stress12_4, str1, str2, str3, str4, str5, str6, str7, & - str8, skiptcell, tarear, divu, rdg_conv, rdg_shear, shear) - !$XXXOMP BARRIER - call evp1d_stepu(NA_len, rhow, 1, NA_len, cdn_ocn, aiu, uocn, & - vocn, forcex, forcey, umassdti, fm, uarear, Tbu, & - uvel_init, vvel_init, uvel, vvel, str1, str2, str3, str4, & - str5, str6, str7, str8, nw, sw, sse, skipucell, strintx, & - strinty, taubx, tauby) - !$XXXOMP BARRIER - call evp1d_halo_update(NAVEL_len, 1, NA_len, uvel, vvel, & - halo_parent) - !$XXXOMP END PARALLEL - - end if ! master task - - end subroutine ice_dyn_evp_1d_kernel - -!======================================================================= - - subroutine calc_na(nx, ny, na, iceTmask, iceUmask) - ! Calculate number of active points - - use ice_blocks, only : nghost - - implicit none - - integer(kind=int_kind), intent(in) :: nx, ny - logical(kind=log_kind), dimension(nx, ny), intent(in) :: & - iceTmask, iceUmask - integer(kind=int_kind), intent(out) :: na - - ! local variables - - integer(kind=int_kind) :: i, j - - character(len=*), parameter :: subname = '(calc_na)' - - na = 0 - ! NOTE: T mask includes northern and eastern ghost cells - do j = 1 + nghost, ny - do i = 1 + nghost, nx - if (iceTmask(i,j) .or. iceUmask(i,j)) na = na + 1 - end do - end do - - end subroutine calc_na - -!======================================================================= - - subroutine calc_2d_indices(nx, ny, na, iceTmask, iceUmask) - - use ice_blocks, only : nghost - - implicit none - - integer(kind=int_kind), intent(in) :: nx, ny, na - logical(kind=log_kind), dimension(nx, ny), intent(in) :: & - iceTmask, iceUmask - - ! local variables - - integer(kind=int_kind) :: i, j, Nmaskt - - character(len=*), parameter :: subname = '(calc_2d_indices)' - - skipucell(:) = .false. - skiptcell(:) = .false. - indi = 0 - indj = 0 - Nmaskt = 0 - ! NOTE: T mask includes northern and eastern ghost cells - do j = 1 + nghost, ny - do i = 1 + nghost, nx - if (iceTmask(i,j) .or. iceUmask(i,j)) then - Nmaskt = Nmaskt + 1 - indi(Nmaskt) = i - indj(Nmaskt) = j - if (.not. iceTmask(i,j)) skiptcell(Nmaskt) = .true. - if (.not. iceUmask(i,j)) skipucell(Nmaskt) = .true. - ! NOTE: U mask does not include northern and eastern - ! ghost cells. Skip northern and eastern ghost cells - if (i == nx) skipucell(Nmaskt) = .true. - if (j == ny) skipucell(Nmaskt) = .true. - end if - end do - end do - - end subroutine calc_2d_indices - -!======================================================================= - - subroutine calc_navel(nx_block, ny_block, na, navel) - ! Calculate number of active points, including halo points - - implicit none - - integer(kind=int_kind), intent(in) :: nx_block, ny_block, na - integer(kind=int_kind), intent(out) :: navel - - ! local variables - - integer(kind=int_kind) :: iw, i, j - integer(kind=int_kind), dimension(1:na) :: Iin, Iee, Ine, Ise, & - Inw, Isw, Isse - integer(kind=int_kind), dimension(1:7 * na) :: util1, util2 - - character(len=*), parameter :: subname = '(calc_navel)' - - ! calculate additional 1D indices used for finite differences - do iw = 1, na - ! get 2D indices - i = indi(iw) - j = indj(iw) - ! calculate 1D indices - Iin(iw) = i + (j - 1) * nx_block ! ( 0, 0) target point - Iee(iw) = i - 1 + (j - 1) * nx_block ! (-1, 0) - Ine(iw) = i - 1 + (j - 2) * nx_block ! (-1, -1) - Ise(iw) = i + (j - 2) * nx_block ! ( 0, -1) - Inw(iw) = i + 1 + (j - 1) * nx_block ! (+1, 0) - Isw(iw) = i + 1 + (j - 0) * nx_block ! (+1, +1) - Isse(iw) = i + (j - 0) * nx_block ! ( 0, +1) - end do - - ! find number of points needed for finite difference calculations - call union(Iin, Iee, na, na, util1, i ) - call union(util1, Ine, i, na, util2, j ) - call union(util2, Ise, j, na, util1, i ) - call union(util1, Inw, i, na, util2, j ) - call union(util2, Isw, j, na, util1, i ) - call union(util1, Isse, i, na, util2, navel) - - end subroutine calc_navel - -!======================================================================= - - subroutine convert_2d_1d(nx, ny, na, navel, I_HTE, I_HTN, & - I_cdn_ocn, I_aiu, I_uocn, I_vocn, I_forcex, I_forcey, I_Tbu, & - I_umassdti, I_fm, I_uarear, I_tarear, I_strintx, I_strinty, & - I_uvel_init, I_vvel_init, I_strength, I_uvel, I_vvel, I_dxT, & - I_dyT, I_stressp_1, I_stressp_2, I_stressp_3, I_stressp_4, & - I_stressm_1, I_stressm_2, I_stressm_3, I_stressm_4, & - I_stress12_1, I_stress12_2, I_stress12_3, I_stress12_4) - - implicit none - - integer(kind=int_kind), intent(in) :: nx, ny, na, navel - real (kind=dbl_kind), dimension(nx, ny), intent(in) :: I_HTE, & - I_HTN, I_cdn_ocn, I_aiu, I_uocn, I_vocn, I_forcex, I_forcey, & - I_Tbu, I_umassdti, I_fm, I_uarear, I_tarear, I_strintx, & - I_strinty, I_uvel_init, I_vvel_init, I_strength, I_uvel, & - I_vvel, I_dxT, I_dyT, I_stressp_1, I_stressp_2, I_stressp_3, & - I_stressp_4, I_stressm_1, I_stressm_2, I_stressm_3, & - I_stressm_4, I_stress12_1, I_stress12_2, I_stress12_3, & - I_stress12_4 - - ! local variables - - integer(kind=int_kind) :: iw, lo, up, j, i, nachk - integer(kind=int_kind), dimension(1:na) :: Iin, Iee, Ine, Ise, & - Inw, Isw, Isse - integer(kind=int_kind), dimension(1:7 * na) :: util1, util2 - - character(len=*), parameter :: subname = '(convert_2d_1d)' - - ! calculate additional 1D indices used for finite differences - do iw = 1, na - ! get 2D indices - i = indi(iw) - j = indj(iw) - ! calculate 1D indices - Iin(iw) = i + (j - 1) * nx ! ( 0, 0) target point - Iee(iw) = i - 1 + (j - 1) * nx ! (-1, 0) - Ine(iw) = i - 1 + (j - 2) * nx ! (-1,-1) - Ise(iw) = i + (j - 2) * nx ! ( 0,-1) - Inw(iw) = i + 1 + (j - 1) * nx ! (+1, 0) - Isw(iw) = i + 1 + (j - 0) * nx ! (+1,+1) - Isse(iw) = i + (j - 0) * nx ! ( 0,+1) - end do - - ! find number of points needed for finite difference calculations - call union(Iin, Iee, na, na, util1, i ) - call union(util1, Ine, i, na, util2, j ) - call union(util2, Ise, j, na, util1, i ) - call union(util1, Inw, i, na, util2, j ) - call union(util2, Isw, j, na, util1, i ) - call union(util1, Isse, i, na, util2, nachk) - - ! index vector with sorted target points - do iw = 1, na - indij(iw) = Iin(iw) - end do - - ! sorted additional points - call setdiff(util2, Iin, navel, na, util1, j) - do iw = na + 1, navel - indij(iw) = util1(iw - na) - end do - - ! indices for additional points needed for uvel and vvel - call findXinY(Iee, indij, na, navel, ee) - call findXinY(Ine, indij, na, navel, ne) - call findXinY(Ise, indij, na, navel, se) - call findXinY(Inw, indij, na, navel, nw) - call findXinY(Isw, indij, na, navel, sw) - call findXinY(Isse, indij, na, navel, sse) - - !$OMP PARALLEL PRIVATE(iw, lo, up, j, i) - ! write 1D arrays from 2D arrays (target points) - call domp_get_domain(1, na, lo, up) - do iw = lo, up - ! get 2D indices - i = indi(iw) - j = indj(iw) - ! map - uvel(iw) = I_uvel(i, j) - vvel(iw) = I_vvel(i, j) - cdn_ocn(iw) = I_cdn_ocn(i, j) - aiu(iw) = I_aiu(i, j) - uocn(iw) = I_uocn(i, j) - vocn(iw) = I_vocn(i, j) - forcex(iw) = I_forcex(i, j) - forcey(iw) = I_forcey(i, j) - Tbu(iw) = I_Tbu(i, j) - umassdti(iw) = I_umassdti(i, j) - fm(iw) = I_fm(i, j) - tarear(iw) = I_tarear(i, j) - uarear(iw) = I_uarear(i, j) - strintx(iw) = I_strintx(i, j) - strinty(iw) = I_strinty(i, j) - uvel_init(iw) = I_uvel_init(i, j) - vvel_init(iw) = I_vvel_init(i, j) - strength(iw) = I_strength(i, j) - dxT(iw) = I_dxT(i, j) - dyT(iw) = I_dyT(i, j) - stressp_1(iw) = I_stressp_1(i, j) - stressp_2(iw) = I_stressp_2(i, j) - stressp_3(iw) = I_stressp_3(i, j) - stressp_4(iw) = I_stressp_4(i, j) - stressm_1(iw) = I_stressm_1(i, j) - stressm_2(iw) = I_stressm_2(i, j) - stressm_3(iw) = I_stressm_3(i, j) - stressm_4(iw) = I_stressm_4(i, j) - stress12_1(iw) = I_stress12_1(i, j) - stress12_2(iw) = I_stress12_2(i, j) - stress12_3(iw) = I_stress12_3(i, j) - stress12_4(iw) = I_stress12_4(i, j) - HTE(iw) = I_HTE(i, j) - HTN(iw) = I_HTN(i, j) - HTEm1(iw) = I_HTE(i - 1, j) - HTNm1(iw) = I_HTN(i, j - 1) - end do - ! write 1D arrays from 2D arrays (additional points) - call domp_get_domain(na + 1, navel, lo, up) - do iw = lo, up - ! get 2D indices - j = int((indij(iw) - 1) / (nx)) + 1 - i = indij(iw) - (j - 1) * nx - ! map - uvel(iw) = I_uvel(i, j) - vvel(iw) = I_vvel(i, j) - end do - !$OMP END PARALLEL - - end subroutine convert_2d_1d - -!======================================================================= - - subroutine calc_halo_parent(nx, ny, na, navel, I_iceTmask) - - implicit none - - integer(kind=int_kind), intent(in) :: nx, ny, na, navel - logical(kind=log_kind), dimension(nx, ny), intent(in) :: & - I_iceTmask - - ! local variables - - integer(kind=int_kind) :: iw, i, j - integer(kind=int_kind), dimension(1:navel) :: Ihalo - - character(len=*), parameter :: subname = '(calc_halo_parent)' - - !----------------------------------------------------------------- - ! Indices for halo update: - ! 0: no halo point - ! >0: index for halo point parent, related to indij vector - ! - ! TODO: Implement for nghost > 1 - ! TODO: Implement for tripole grids - !----------------------------------------------------------------- - - Ihalo(:) = 0 - halo_parent(:) = 0 - - do iw = 1, navel - j = int((indij(iw) - 1) / (nx)) + 1 - i = indij(iw) - (j - 1) * nx - ! if within ghost zone - if (i == nx .and. I_iceTmask(2, j) ) Ihalo(iw) = 2 + (j - 1) * nx - if (i == 1 .and. I_iceTmask(nx - 1, j) ) Ihalo(iw) = (nx - 1) + (j - 1) * nx - if (j == ny .and. I_iceTmask(i, 2) ) Ihalo(iw) = i + nx - if (j == 1 .and. I_iceTmask(i, ny - 1) ) Ihalo(iw) = i + (ny - 2) * nx - end do - - ! relate halo indices to indij vector - call findXinY_halo(Ihalo, indij, navel, navel, halo_parent) - - end subroutine calc_halo_parent - -!======================================================================= - - subroutine union(x, y, nx, ny, xy, nxy) - ! Find union (xy) of two sorted integer vectors (x and y), i.e. - ! combined values of the two vectors with no repetitions - - implicit none - - integer(int_kind), intent(in) :: nx, ny - integer(int_kind), intent(in) :: x(1:nx), y(1:ny) - integer(int_kind), intent(out) :: xy(1:nx + ny) - integer(int_kind), intent(out) :: nxy - - ! local variables - - integer(int_kind) :: i, j, k - - character(len=*), parameter :: subname = '(union)' - - i = 1 - j = 1 - k = 1 - do while (i <= nx .and. j <= ny) - if (x(i) < y(j)) then - xy(k) = x(i) - i = i + 1 - else if (x(i) > y(j)) then - xy(k) = y(j) - j = j + 1 - else - xy(k) = x(i) - i = i + 1 - j = j + 1 - end if - k = k + 1 - end do - - ! the rest - do while (i <= nx) - xy(k) = x(i) - i = i + 1 - k = k + 1 - end do - do while (j <= ny) - xy(k) = y(j) - j = j + 1 - k = k + 1 - end do - nxy = k - 1 - - end subroutine union - -!======================================================================= - - subroutine setdiff(x, y, nx, ny, xy, nxy) - ! Find element (xy) of two sorted integer vectors (x and y) that - ! are in x, but not in y, or in y, but not in x - - implicit none - - integer(kind=int_kind), intent(in) :: nx, ny - integer(kind=int_kind), intent(in) :: x(1:nx), y(1:ny) - integer(kind=int_kind), intent(out) :: xy(1:nx + ny) - integer(kind=int_kind), intent(out) :: nxy - - ! local variables - - integer(kind=int_kind) :: i, j, k - - character(len=*), parameter :: subname = '(setdiff)' - - i = 1 - j = 1 - k = 1 - do while (i <= nx .and. j <= ny) - if (x(i) < y(j)) then - xy(k) = x(i) - i = i + 1 - k = k + 1 - else if (x(i) > y(j)) then - xy(k) = y(j) - j = j + 1 - k = k + 1 - else - i = i + 1 - j = j + 1 - end if - end do - - ! the rest - do while (i <= nx) - xy(k) = x(i) - i = i + 1 - k = k + 1 - end do - do while (j <= ny) - xy(k) = y(j) - j = j + 1 - k = k + 1 - end do - nxy = k - 1 - - end subroutine setdiff - -!======================================================================== - - subroutine findXinY(x, y, nx, ny, indx) - ! Find indx vector so that x(1:na) = y(indx(1:na)) - ! - ! Conditions: - ! * EVERY item in x is found in y - ! * x(1:nx) is a sorted integer vector - ! * y(1:ny) consists of two sorted integer vectors: - ! [y(1:nx); y(nx + 1:ny)] - ! * ny >= nx - ! - ! Return: indx(1:na) - - implicit none - - integer (kind=int_kind), intent(in) :: nx, ny - integer (kind=int_kind), intent(in) :: x(1:nx), y(1:ny) - integer (kind=int_kind), intent(out) :: indx(1:nx) - - ! local variables - - integer (kind=int_kind) :: i, j1, j2 - - character(len=*), parameter :: subname = '(findXinY)' - - i = 1 - j1 = 1 - j2 = nx + 1 - do while (i <= nx) - if (x(i) == y(j1)) then - indx(i) = j1 - i = i + 1 - j1 = j1 + 1 - else if (x(i) == y(j2)) then - indx(i) = j2 - i = i + 1 - j2 = j2 + 1 - else if (x(i) > y(j1)) then - j1 = j1 + 1 - else if (x(i) > y(j2)) then - j2 = j2 + 1 - else - call abort_ice(subname & - // ': ERROR: conditions not met') - end if - end do - - end subroutine findXinY - -!======================================================================= - - subroutine findXinY_halo(x, y, nx, ny, indx) - ! Find indx vector so that x(1:na) = y(indx(1:na)) - ! - ! Conditions: - ! * EVERY item in x is found in y, - ! except for x == 0, where indx = 0 is returned - ! * x(1:nx) is a non-sorted integer vector - ! * y(1:ny) is a sorted integer vector - ! * ny >= nx - ! - ! Return: indx(1:na) - - implicit none - - integer (kind=int_kind), intent(in) :: nx, ny - integer (kind=int_kind), intent(in) :: x(1:nx), y(1:ny) - integer (kind=int_kind), intent(out) :: indx(1:nx) - - ! local variables - - integer (kind=int_kind) :: i, j1, nloop - - character(len=*), parameter :: subname = '(findXinY_halo)' - - nloop = 1 - i = 1 - j1 = int((ny + 1) / 2) ! initial guess in the middle - do while (i <= nx) - if (x(i) == 0) then - indx(i) = 0 - i = i + 1 - nloop = 1 - else if (x(i) == y(j1)) then - indx(i) = j1 - i = i + 1 - j1 = j1 + 1 - ! initial guess in the middle - if (j1 > ny) j1 = int((ny + 1) / 2) - nloop = 1 - else if (x(i) < y(j1)) then - j1 = 1 - else if (x(i) > y(j1)) then - j1 = j1 + 1 - if (j1 > ny) then - j1 = 1 - nloop = nloop + 1 - if (nloop > 2) then - ! stop for infinite loop. This check should not be - ! necessary for halo - call abort_ice(subname // ' ERROR: too many loops') - end if - end if - end if - end do - - end subroutine findXinY_halo - -!======================================================================= - - subroutine numainit(l, u, uu) - - use ice_constants, only : c0 - - implicit none - - integer(kind=int_kind), intent(in) :: l, u, uu - - ! local variables - - integer(kind=int_kind) :: lo, up - - character(len=*), parameter :: subname = '(numainit)' - - call domp_get_domain(l, u, lo, up) - ee(lo:up) = 0 - ne(lo:up) = 0 - se(lo:up) = 0 - sse(lo:up) = 0 - nw(lo:up) = 0 - sw(lo:up) = 0 - halo_parent(lo:up) = 0 - strength(lo:up) = c0 - uvel(lo:up) = c0 - vvel(lo:up) = c0 - uvel_init(lo:up) = c0 - vvel_init(lo:up) = c0 - uocn(lo:up) = c0 - vocn(lo:up) = c0 - dxT(lo:up) = c0 - dyT(lo:up) = c0 - HTE(lo:up) = c0 - HTN(lo:up) = c0 - HTEm1(lo:up) = c0 - HTNm1(lo:up) = c0 - stressp_1(lo:up) = c0 - stressp_2(lo:up) = c0 - stressp_3(lo:up) = c0 - stressp_4(lo:up) = c0 - stressm_1(lo:up) = c0 - stressm_2(lo:up) = c0 - stressm_3(lo:up) = c0 - stressm_4(lo:up) = c0 - stress12_1(lo:up) = c0 - stress12_2(lo:up) = c0 - stress12_3(lo:up) = c0 - stress12_4(lo:up) = c0 - tarear(lo:up) = c0 - Tbu(lo:up) = c0 - taubx(lo:up) = c0 - tauby(lo:up) = c0 - divu(lo:up) = c0 - rdg_conv(lo:up) = c0 - rdg_shear(lo:up) = c0 - shear(lo:up) = c0 - str1(lo:up) = c0 - str2(lo:up) = c0 - str3(lo:up) = c0 - str4(lo:up) = c0 - str5(lo:up) = c0 - str6(lo:up) = c0 - str7(lo:up) = c0 - str8(lo:up) = c0 - - call domp_get_domain(u + 1, uu, lo, up) - halo_parent(lo:up) = 0 - uvel(lo:up) = c0 - vvel(lo:up) = c0 - str1(lo:up) = c0 - str2(lo:up) = c0 - str3(lo:up) = c0 - str4(lo:up) = c0 - str5(lo:up) = c0 - str6(lo:up) = c0 - str7(lo:up) = c0 - str8(lo:up) = c0 - - end subroutine numainit - -!======================================================================= - -end module ice_dyn_evp_1d diff --git a/cicecore/cicedyn/dynamics/ice_dyn_shared.F90 b/cicecore/cicedyn/dynamics/ice_dyn_shared.F90 index 69e552730..9dbeaf1a7 100644 --- a/cicecore/cicedyn/dynamics/ice_dyn_shared.F90 +++ b/cicecore/cicedyn/dynamics/ice_dyn_shared.F90 @@ -1451,10 +1451,10 @@ subroutine seabed_stress_factor_prob (nx_block, ny_block, & character(len=*), parameter :: subname = '(seabed_stress_factor_prob)' - call icepack_query_parameters(rhow_out=rhow, rhoi_out=rhoi) - call icepack_query_parameters(gravit_out=gravit) - call icepack_query_parameters(pi_out=pi) - call icepack_query_parameters(puny_out=puny) + call icepack_query_parameters(rhow_out=rhow, rhoi_out=rhoi,gravit_out=gravit,pi_out=pi,puny_out=puny) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) Tbt=c0 @@ -2302,16 +2302,15 @@ end subroutine strain_rates_U ! by combining tensile strength and a parameterization for grounded ridges. ! J. Geophys. Res. Oceans, 121, 7354-7368. - subroutine visc_replpress(strength, DminArea, Delta, & - zetax2, etax2, rep_prs, capping) + subroutine visc_replpress(strength, DminArea, Delta, & + zetax2, etax2, rep_prs) real (kind=dbl_kind), intent(in):: & strength, & ! DminArea ! real (kind=dbl_kind), intent(in):: & - Delta , & ! - capping ! + Delta real (kind=dbl_kind), intent(out):: & zetax2 , & ! bulk viscosity diff --git a/cicecore/cicedyn/dynamics/ice_dyn_vp.F90 b/cicecore/cicedyn/dynamics/ice_dyn_vp.F90 index 32971c5b6..58589f8d7 100644 --- a/cicecore/cicedyn/dynamics/ice_dyn_vp.F90 +++ b/cicecore/cicedyn/dynamics/ice_dyn_vp.F90 @@ -1221,20 +1221,16 @@ subroutine calc_zeta_dPr (nx_block, ny_block, & call visc_replpress (strength(i,j) , DminTarea(i,j) , & Deltane , zetax2 (i,j,1), & - etax2 (i,j,1), rep_prs (i,j,1), & - capping) + etax2 (i,j,1), rep_prs (i,j,1)) call visc_replpress (strength(i,j) , DminTarea(i,j) , & Deltanw , zetax2 (i,j,2), & - etax2 (i,j,2), rep_prs (i,j,2), & - capping) + etax2 (i,j,2), rep_prs (i,j,2)) call visc_replpress (strength(i,j) , DminTarea(i,j) , & Deltasw , zetax2 (i,j,3), & - etax2 (i,j,3), rep_prs (i,j,3), & - capping) + etax2 (i,j,3), rep_prs (i,j,3)) call visc_replpress (strength(i,j) , DminTarea(i,j) , & Deltase , zetax2 (i,j,4), & - etax2 (i,j,4), rep_prs (i,j,4), & - capping) + etax2 (i,j,4), rep_prs (i,j,4)) !----------------------------------------------------------------- ! the stresses ! kg/s^2 diff --git a/cicecore/cicedyn/dynamics/ice_transport_remap.F90 b/cicecore/cicedyn/dynamics/ice_transport_remap.F90 index ee0a3d083..dd59efc87 100644 --- a/cicecore/cicedyn/dynamics/ice_transport_remap.F90 +++ b/cicecore/cicedyn/dynamics/ice_transport_remap.F90 @@ -647,11 +647,12 @@ subroutine horizontal_remap (dt, ntrace, & endif ! nghost ! tcraig, this OMP loop sometimes fails with cce/14.0.3, compiler bug?? - !$OMP PARALLEL DO PRIVATE(iblk,i,j,ilo,ihi,jlo,jhi,this_block,n, & - !$OMP edgearea_e,edgearea_n,edge,iflux,jflux, & - !$OMP xp,yp,indxing,indxjng,mflxe,mflxn, & - !$OMP mtflxe,mtflxn,triarea,istop,jstop,l_stop) & - !$OMP SCHEDULE(runtime) + ! TILL I can trigger the same with ifort (IFORT) 18.0.0 20170811 +!TILL !$OMP PARALLEL DO PRIVATE(iblk,i,j,ilo,ihi,jlo,jhi,this_block,n, & +!TILL !$OMP edgearea_e,edgearea_n,edge,iflux,jflux, & +!TILL !$OMP xp,yp,indxing,indxjng,mflxe,mflxn, & +!TILL !$OMP mtflxe,mtflxn,triarea,istop,jstop,l_stop) & +!TILL !$OMP SCHEDULE(runtime) do iblk = 1, nblocks l_stop = .false. @@ -865,7 +866,7 @@ subroutine horizontal_remap (dt, ntrace, & enddo ! n enddo ! iblk - !$OMP END PARALLEL DO +!TILL !$OMP END PARALLEL DO end subroutine horizontal_remap diff --git a/cicecore/cicedyn/general/ice_init.F90 b/cicecore/cicedyn/general/ice_init.F90 index 4e1a50f44..75c5a03cf 100644 --- a/cicecore/cicedyn/general/ice_init.F90 +++ b/cicecore/cicedyn/general/ice_init.F90 @@ -105,7 +105,7 @@ subroutine input_data 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, pgl_global_ext + 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, & @@ -375,7 +375,7 @@ subroutine input_data ndte = 120 ! subcycles per dynamics timestep: ndte=dt_dyn/dte evp_algorithm = 'standard_2d' ! EVP kernel (standard_2d=standard cice evp; shared_mem_1d=1d shared memory and no mpi elasticDamp = 0.36_dbl_kind ! coefficient for calculating the parameter E - pgl_global_ext = .false. ! if true, init primary grid lengths (global ext.) + save_ghte_ghtn = .false. ! if true, save global hte and htn (global ext.) brlx = 300.0_dbl_kind ! revised_evp values. Otherwise overwritten in ice_dyn_shared arlx = 300.0_dbl_kind ! revised_evp values. Otherwise overwritten in ice_dyn_shared revised_evp = .false. ! if true, use revised procedure for evp dynamics @@ -963,7 +963,6 @@ subroutine input_data call broadcast_scalar(ndte, master_task) call broadcast_scalar(evp_algorithm, master_task) call broadcast_scalar(elasticDamp, master_task) - call broadcast_scalar(pgl_global_ext, master_task) call broadcast_scalar(brlx, master_task) call broadcast_scalar(arlx, master_task) call broadcast_scalar(revised_evp, master_task) @@ -1258,6 +1257,10 @@ subroutine input_data abort_list = trim(abort_list)//":5" endif + if (kdyn == 1 .and. evp_algorithm == 'shared_mem_1d') then + save_ghte_ghtn = .true. + endif + if (kdyn == 2 .and. revised_evp) then if (my_task == master_task) then write(nu_diag,*) subname//' WARNING: revised_evp = T with EAP dynamics' @@ -1296,10 +1299,10 @@ subroutine input_data endif if (grid_ice == 'C' .or. grid_ice == 'CD') then - if (kdyn > 1) then + if (kdyn > 1 .or. (kdyn == 1 .and. evp_algorithm /= 'standard_2d')) then if (my_task == master_task) then - write(nu_diag,*) subname//' ERROR: grid_ice = C | CD only supported with kdyn<=1 (evp or off)' - write(nu_diag,*) subname//' ERROR: kdyn and grid_ice inconsistency' + write(nu_diag,*) subname//' ERROR: grid_ice = C | CD only supported with kdyn=1 and evp_algorithm=standard_2d' + write(nu_diag,*) subname//' ERROR: kdyn and/or evp_algorithm and grid_ice inconsistency' endif abort_list = trim(abort_list)//":46" endif @@ -1312,6 +1315,15 @@ subroutine input_data endif endif + if (evp_algorithm == 'shared_mem_1d' .and. & + grid_type == 'tripole') then + if (my_task == master_task) then + write(nu_diag,*) subname//' ERROR: evp_algorithm=shared_mem_1d is not tested for gridtype=tripole' + write(nu_diag,*) subname//' ERROR: change evp_algorithm to standard_2d' + endif + abort_list = trim(abort_list)//":49" + endif + capping = -9.99e30 if (kdyn == 1 .or. kdyn == 3) then if (capping_method == 'max') then @@ -1833,7 +1845,6 @@ subroutine input_data tmpstr2 = ' : standard 2d EVP solver' elseif (evp_algorithm == 'shared_mem_1d') then tmpstr2 = ' : vectorized 1d EVP solver' - pgl_global_ext = .true. else tmpstr2 = ' : unknown value' endif diff --git a/cicecore/cicedyn/infrastructure/comm/mpi/ice_boundary.F90 b/cicecore/cicedyn/infrastructure/comm/mpi/ice_boundary.F90 index 2a7d68c11..a33e050b9 100644 --- a/cicecore/cicedyn/infrastructure/comm/mpi/ice_boundary.F90 +++ b/cicecore/cicedyn/infrastructure/comm/mpi/ice_boundary.F90 @@ -113,8 +113,7 @@ module ice_boundary ice_HaloUpdate, & ice_HaloUpdate_stress, & ice_HaloExtrapolate, & - ice_HaloDestroy, & - primary_grid_lengths_global_ext + ice_HaloDestroy interface ice_HaloUpdate ! generic interface module procedure ice_HaloUpdate2DR8, & @@ -7164,134 +7163,8 @@ subroutine ice_HaloDestroy(halo) call abort_ice(subname,' ERROR: deallocating') return endif -end subroutine ice_HaloDestroy - -!*********************************************************************** - - subroutine primary_grid_lengths_global_ext( & - ARRAY_O, ARRAY_I, ew_boundary_type, ns_boundary_type) - -! This subroutine adds ghost cells to global primary grid lengths array -! ARRAY_I and outputs result to array ARRAY_O - - use ice_constants, only: c0 - use ice_domain_size, only: nx_global, ny_global - - real (kind=dbl_kind), dimension(:,:), intent(in) :: & - ARRAY_I - - character (*), intent(in) :: & - ew_boundary_type, ns_boundary_type - - real (kind=dbl_kind), dimension(:,:), intent(out) :: & - ARRAY_O - -!----------------------------------------------------------------------- -! -! local variables -! -!----------------------------------------------------------------------- - - integer (kind=int_kind) :: & - ii, io, ji, jo - - character(len=*), parameter :: & - subname = '(primary_grid_lengths_global_ext)' - -!----------------------------------------------------------------------- -! -! add ghost cells to global primary grid lengths array -! -!----------------------------------------------------------------------- - - if (trim(ns_boundary_type) == 'tripole' .or. & - trim(ns_boundary_type) == 'tripoleT') then - call abort_ice(subname//' ERROR: '//ns_boundary_type & - //' boundary type not implemented for configuration') - endif - - do jo = 1,ny_global+2*nghost - ji = -nghost + jo - - !*** Southern ghost cells - - if (ji < 1) then - select case (trim(ns_boundary_type)) - case ('cyclic') - ji = ji + ny_global - case ('open') - ji = nghost - jo + 1 - case ('closed') - ji = 0 - case default - call abort_ice( & - subname//' ERROR: unknown north-south boundary type') - end select - endif - !*** Northern ghost cells - - if (ji > ny_global) then - select case (trim(ns_boundary_type)) - case ('cyclic') - ji = ji - ny_global - case ('open') - ji = 2 * ny_global - ji + 1 - case ('closed') - ji = 0 - case default - call abort_ice( & - subname//' ERROR: unknown north-south boundary type') - end select - endif - - do io = 1,nx_global+2*nghost - ii = -nghost + io - - !*** Western ghost cells - - if (ii < 1) then - select case (trim(ew_boundary_type)) - case ('cyclic') - ii = ii + nx_global - case ('open') - ii = nghost - io + 1 - case ('closed') - ii = 0 - case default - call abort_ice( & - subname//' ERROR: unknown east-west boundary type') - end select - endif - - !*** Eastern ghost cells - - if (ii > nx_global) then - select case (trim(ew_boundary_type)) - case ('cyclic') - ii = ii - nx_global - case ('open') - ii = 2 * nx_global - ii + 1 - case ('closed') - ii = 0 - case default - call abort_ice( & - subname//' ERROR: unknown east-west boundary type') - end select - endif - - if (ii == 0 .or. ji == 0) then - ARRAY_O(io, jo) = c0 - else - ARRAY_O(io, jo) = ARRAY_I(ii, ji) - endif - - enddo - enddo - -!----------------------------------------------------------------------- - - end subroutine primary_grid_lengths_global_ext +end subroutine ice_HaloDestroy !*********************************************************************** diff --git a/cicecore/cicedyn/infrastructure/comm/mpi/ice_timers.F90 b/cicecore/cicedyn/infrastructure/comm/mpi/ice_timers.F90 index baab6f49b..23968f39a 100644 --- a/cicecore/cicedyn/infrastructure/comm/mpi/ice_timers.F90 +++ b/cicecore/cicedyn/infrastructure/comm/mpi/ice_timers.F90 @@ -65,8 +65,8 @@ module ice_timers timer_bundbound, &! boundary updates bundling timer_bgc, &! biogeochemistry timer_forcing, &! forcing - timer_evp_1d, &! timer only loop - timer_evp_2d, &! timer including conversion 1d/2d + timer_evp1dcore, &! timer only loop + timer_evp, &! timer including conversion 1d/2d timer_updstate ! update state ! timer_updstate, &! update state ! timer_tmp1, &! for temporary timings @@ -177,34 +177,34 @@ subroutine init_ice_timers nullify(all_timers(n)%block_accum_time) end do - call get_ice_timer(timer_total, 'Total', nblocks,distrb_info%nprocs) - call get_ice_timer(timer_step, 'TimeLoop', nblocks,distrb_info%nprocs) - call get_ice_timer(timer_dynamics, 'Dynamics', nblocks,distrb_info%nprocs) - call get_ice_timer(timer_advect, 'Advection',nblocks,distrb_info%nprocs) - call get_ice_timer(timer_column, 'Column', nblocks,distrb_info%nprocs) - call get_ice_timer(timer_thermo, 'Thermo', nblocks,distrb_info%nprocs) - call get_ice_timer(timer_sw, 'Shortwave',nblocks,distrb_info%nprocs) + call get_ice_timer(timer_total , 'Total' ,nblocks,distrb_info%nprocs) + call get_ice_timer(timer_step , 'TimeLoop' ,nblocks,distrb_info%nprocs) + call get_ice_timer(timer_dynamics , 'Dynamics' ,nblocks,distrb_info%nprocs) + call get_ice_timer(timer_advect , 'Advection' ,nblocks,distrb_info%nprocs) + call get_ice_timer(timer_column , 'Column' ,nblocks,distrb_info%nprocs) + call get_ice_timer(timer_thermo , 'Thermo' ,nblocks,distrb_info%nprocs) + call get_ice_timer(timer_sw , 'Shortwave' ,nblocks,distrb_info%nprocs) ! call get_ice_timer(timer_ponds, 'Meltponds',nblocks,distrb_info%nprocs) - call get_ice_timer(timer_ridge, 'Ridging', nblocks,distrb_info%nprocs) + call get_ice_timer(timer_ridge , 'Ridging' ,nblocks,distrb_info%nprocs) ! call get_ice_timer(timer_catconv, 'Cat Conv', nblocks,distrb_info%nprocs) - call get_ice_timer(timer_fsd, 'FloeSize', nblocks,distrb_info%nprocs) - call get_ice_timer(timer_couple, 'Coupling', nblocks,distrb_info%nprocs) - call get_ice_timer(timer_readwrite,'ReadWrite',nblocks,distrb_info%nprocs) - call get_ice_timer(timer_diags, 'Diags ',nblocks,distrb_info%nprocs) - call get_ice_timer(timer_hist, 'History ',nblocks,distrb_info%nprocs) - call get_ice_timer(timer_bound, 'Bound', nblocks,distrb_info%nprocs) - call get_ice_timer(timer_bundbound,'Bundbound',nblocks,distrb_info%nprocs) - call get_ice_timer(timer_bgc, 'BGC', nblocks,distrb_info%nprocs) - call get_ice_timer(timer_forcing, 'Forcing', nblocks,distrb_info%nprocs) + call get_ice_timer(timer_fsd , 'FloeSize' ,nblocks,distrb_info%nprocs) + call get_ice_timer(timer_couple , 'Coupling' ,nblocks,distrb_info%nprocs) + call get_ice_timer(timer_readwrite , 'ReadWrite' ,nblocks,distrb_info%nprocs) + call get_ice_timer(timer_diags , 'Diags ' ,nblocks,distrb_info%nprocs) + call get_ice_timer(timer_hist , 'History ' ,nblocks,distrb_info%nprocs) + call get_ice_timer(timer_bound , 'Bound' ,nblocks,distrb_info%nprocs) + call get_ice_timer(timer_bundbound , 'Bundbound' ,nblocks,distrb_info%nprocs) + call get_ice_timer(timer_bgc , 'BGC' ,nblocks,distrb_info%nprocs) + call get_ice_timer(timer_forcing , 'Forcing' ,nblocks,distrb_info%nprocs) #if (defined CESMCOUPLED) - call get_ice_timer(timer_cplrecv, 'Cpl-recv', nblocks,distrb_info%nprocs) - call get_ice_timer(timer_rcvsnd, 'Rcv->Snd', nblocks,distrb_info%nprocs) - call get_ice_timer(timer_cplsend, 'Cpl-Send', nblocks,distrb_info%nprocs) - call get_ice_timer(timer_sndrcv, 'Snd->Rcv', nblocks,distrb_info%nprocs) + call get_ice_timer(timer_cplrecv , 'Cpl-recv' ,nblocks,distrb_info%nprocs) + call get_ice_timer(timer_rcvsnd , 'Rcv->Snd' ,nblocks,distrb_info%nprocs) + call get_ice_timer(timer_cplsend , 'Cpl-Send' ,nblocks,distrb_info%nprocs) + call get_ice_timer(timer_sndrcv , 'Snd->Rcv' ,nblocks,distrb_info%nprocs) #endif - call get_ice_timer(timer_evp_1d, '1d-evp', nblocks,distrb_info%nprocs) - call get_ice_timer(timer_evp_2d, '2d-evp', nblocks,distrb_info%nprocs) - call get_ice_timer(timer_updstate, 'UpdState', nblocks,distrb_info%nprocs) + call get_ice_timer(timer_evp1dcore , 'evp1dcore' ,nblocks,distrb_info%nprocs) + call get_ice_timer(timer_evp , 'evp' ,nblocks,distrb_info%nprocs) + call get_ice_timer(timer_updstate , 'UpdState' ,nblocks,distrb_info%nprocs) ! call get_ice_timer(timer_tmp1, 'tmp1', nblocks,distrb_info%nprocs) ! call get_ice_timer(timer_tmp2, 'tmp2', nblocks,distrb_info%nprocs) ! call get_ice_timer(timer_tmp3, 'tmp3', nblocks,distrb_info%nprocs) diff --git a/cicecore/cicedyn/infrastructure/comm/serial/ice_boundary.F90 b/cicecore/cicedyn/infrastructure/comm/serial/ice_boundary.F90 index faeaf3227..b9ac8fe33 100644 --- a/cicecore/cicedyn/infrastructure/comm/serial/ice_boundary.F90 +++ b/cicecore/cicedyn/infrastructure/comm/serial/ice_boundary.F90 @@ -68,8 +68,7 @@ module ice_boundary ice_HaloUpdate, & ice_HaloUpdate_stress, & ice_HaloExtrapolate, & - ice_HaloDestroy, & - primary_grid_lengths_global_ext + ice_HaloDestroy interface ice_HaloUpdate ! generic interface module procedure ice_HaloUpdate2DR8, & @@ -4912,133 +4911,6 @@ subroutine ice_HaloDestroy(halo) end subroutine ice_HaloDestroy -!*********************************************************************** - - subroutine primary_grid_lengths_global_ext( & - ARRAY_O, ARRAY_I, ew_boundary_type, ns_boundary_type) - -! This subroutine adds ghost cells to global primary grid lengths array -! ARRAY_I and outputs result to array ARRAY_O - - use ice_constants, only: c0 - use ice_domain_size, only: nx_global, ny_global - - real (kind=dbl_kind), dimension(:,:), intent(in) :: & - ARRAY_I - - character (*), intent(in) :: & - ew_boundary_type, ns_boundary_type - - real (kind=dbl_kind), dimension(:,:), intent(out) :: & - ARRAY_O - -!----------------------------------------------------------------------- -! -! local variables -! -!----------------------------------------------------------------------- - - integer (kind=int_kind) :: & - ii, io, ji, jo - - character(len=*), parameter :: & - subname = '(primary_grid_lengths_global_ext)' - -!----------------------------------------------------------------------- -! -! add ghost cells to global primary grid lengths array -! -!----------------------------------------------------------------------- - - if (trim(ns_boundary_type) == 'tripole' .or. & - trim(ns_boundary_type) == 'tripoleT') then - call abort_ice(subname//' ERROR: '//ns_boundary_type & - //' boundary type not implemented for configuration') - endif - - do jo = 1,ny_global+2*nghost - ji = -nghost + jo - - !*** Southern ghost cells - - if (ji < 1) then - select case (trim(ns_boundary_type)) - case ('cyclic') - ji = ji + ny_global - case ('open') - ji = nghost - jo + 1 - case ('closed') - ji = 0 - case default - call abort_ice( & - subname//' ERROR: unknown north-south boundary type') - end select - endif - - !*** Northern ghost cells - - if (ji > ny_global) then - select case (trim(ns_boundary_type)) - case ('cyclic') - ji = ji - ny_global - case ('open') - ji = 2 * ny_global - ji + 1 - case ('closed') - ji = 0 - case default - call abort_ice( & - subname//' ERROR: unknown north-south boundary type') - end select - endif - - do io = 1,nx_global+2*nghost - ii = -nghost + io - - !*** Western ghost cells - - if (ii < 1) then - select case (trim(ew_boundary_type)) - case ('cyclic') - ii = ii + nx_global - case ('open') - ii = nghost - io + 1 - case ('closed') - ii = 0 - case default - call abort_ice( & - subname//' ERROR: unknown east-west boundary type') - end select - endif - - !*** Eastern ghost cells - - if (ii > nx_global) then - select case (trim(ew_boundary_type)) - case ('cyclic') - ii = ii - nx_global - case ('open') - ii = 2 * nx_global - ii + 1 - case ('closed') - ii = 0 - case default - call abort_ice( & - subname//' ERROR: unknown east-west boundary type') - end select - endif - - if (ii == 0 .or. ji == 0) then - ARRAY_O(io, jo) = c0 - else - ARRAY_O(io, jo) = ARRAY_I(ii, ji) - endif - - enddo - enddo - -!----------------------------------------------------------------------- - - end subroutine primary_grid_lengths_global_ext - !*********************************************************************** end module ice_boundary diff --git a/cicecore/cicedyn/infrastructure/comm/serial/ice_timers.F90 b/cicecore/cicedyn/infrastructure/comm/serial/ice_timers.F90 index bbe2fd4d1..690030201 100644 --- a/cicecore/cicedyn/infrastructure/comm/serial/ice_timers.F90 +++ b/cicecore/cicedyn/infrastructure/comm/serial/ice_timers.F90 @@ -37,28 +37,28 @@ module ice_timers ! public timers !----------------------------------------------------------------------- - integer (int_kind), public :: & - timer_total, &! total time - timer_step, &! time stepping - timer_dynamics, &! dynamics - timer_advect, &! horizontal advection - timer_column, &! column - timer_thermo, &! thermodynamics - timer_sw, &! radiative transfer - timer_ponds, &! melt ponds - timer_ridge, &! ridging - timer_catconv, &! category conversions - timer_fsd, &! floe size distribution - timer_couple, &! coupling - timer_readwrite, &! read/write - timer_diags, &! diagnostics/history - timer_hist, &! diagnostics/history - timer_bound, &! boundary updates - timer_bundbound, &! boundary updates - timer_bgc, &! biogeochemistry - timer_forcing, &! forcing - timer_evp_1d, &! timer only loop - timer_evp_2d, &! timer including conversion 1d/2d + integer (int_kind), public :: & + timer_total , &! total time + timer_step , &! time stepping + timer_dynamics , &! dynamics + timer_advect , &! horizontal advection + timer_column , &! column + timer_thermo , &! thermodynamics + timer_sw , &! radiative transfer + timer_ponds , &! melt ponds + timer_ridge , &! ridging + timer_catconv , &! category conversions + timer_fsd , &! floe size distribution + timer_couple , &! coupling + timer_readwrite , &! read/write + timer_diags , &! diagnostics/history + timer_hist , &! diagnostics/history + timer_bound , &! boundary updates + timer_bundbound , &! boundary updates + timer_bgc , &! biogeochemistry + timer_forcing , &! forcing + timer_evp1dcore , &! timer only loop + timer_evp , &! timer including conversion 1d/2d timer_updstate ! update state ! timer_updstate, &! update state ! timer_tmp1, &! for temporary timings @@ -191,28 +191,28 @@ subroutine init_ice_timers nullify(all_timers(n)%block_accum_time) end do - call get_ice_timer(timer_total, 'Total', nblocks,distrb_info%nprocs) - call get_ice_timer(timer_step, 'TimeLoop', nblocks,distrb_info%nprocs) - call get_ice_timer(timer_dynamics, 'Dynamics', nblocks,distrb_info%nprocs) - call get_ice_timer(timer_advect, 'Advection',nblocks,distrb_info%nprocs) - call get_ice_timer(timer_column, 'Column', nblocks,distrb_info%nprocs) - call get_ice_timer(timer_thermo, 'Thermo', nblocks,distrb_info%nprocs) - call get_ice_timer(timer_sw, 'Shortwave',nblocks,distrb_info%nprocs) + call get_ice_timer(timer_total , 'Total' ,nblocks,distrb_info%nprocs) + call get_ice_timer(timer_step , 'TimeLoop' ,nblocks,distrb_info%nprocs) + call get_ice_timer(timer_dynamics , 'Dynamics' ,nblocks,distrb_info%nprocs) + call get_ice_timer(timer_advect , 'Advection' ,nblocks,distrb_info%nprocs) + call get_ice_timer(timer_column , 'Column' ,nblocks,distrb_info%nprocs) + call get_ice_timer(timer_thermo , 'Thermo' ,nblocks,distrb_info%nprocs) + call get_ice_timer(timer_sw , 'Shortwave' ,nblocks,distrb_info%nprocs) ! call get_ice_timer(timer_ponds, 'Meltponds',nblocks,distrb_info%nprocs) - call get_ice_timer(timer_ridge, 'Ridging', nblocks,distrb_info%nprocs) + call get_ice_timer(timer_ridge , 'Ridging' ,nblocks,distrb_info%nprocs) ! call get_ice_timer(timer_catconv, 'Cat Conv', nblocks,distrb_info%nprocs) - call get_ice_timer(timer_fsd, 'FloeSize', nblocks,distrb_info%nprocs) - call get_ice_timer(timer_couple, 'Coupling', nblocks,distrb_info%nprocs) - call get_ice_timer(timer_readwrite,'ReadWrite',nblocks,distrb_info%nprocs) - call get_ice_timer(timer_diags, 'Diags ',nblocks,distrb_info%nprocs) - call get_ice_timer(timer_hist, 'History ',nblocks,distrb_info%nprocs) - call get_ice_timer(timer_bound, 'Bound', nblocks,distrb_info%nprocs) - call get_ice_timer(timer_bundbound,'Bundbound',nblocks,distrb_info%nprocs) - call get_ice_timer(timer_bgc, 'BGC', nblocks,distrb_info%nprocs) - call get_ice_timer(timer_forcing, 'Forcing', nblocks,distrb_info%nprocs) - call get_ice_timer(timer_evp_1d, '1d-evp', nblocks,distrb_info%nprocs) - call get_ice_timer(timer_evp_2d, '2d-evp', nblocks,distrb_info%nprocs) - call get_ice_timer(timer_updstate, 'UpdState', nblocks,distrb_info%nprocs) + call get_ice_timer(timer_fsd , 'FloeSize' ,nblocks,distrb_info%nprocs) + call get_ice_timer(timer_couple , 'Coupling' ,nblocks,distrb_info%nprocs) + call get_ice_timer(timer_readwrite , 'ReadWrite' ,nblocks,distrb_info%nprocs) + call get_ice_timer(timer_diags , 'Diags ' ,nblocks,distrb_info%nprocs) + call get_ice_timer(timer_hist , 'History ' ,nblocks,distrb_info%nprocs) + call get_ice_timer(timer_bound , 'Bound' ,nblocks,distrb_info%nprocs) + call get_ice_timer(timer_bundbound , 'Bundbound' ,nblocks,distrb_info%nprocs) + call get_ice_timer(timer_bgc , 'BGC' ,nblocks,distrb_info%nprocs) + call get_ice_timer(timer_forcing , 'Forcing' ,nblocks,distrb_info%nprocs) + call get_ice_timer(timer_evp1dcore , 'evp1dcore' ,nblocks,distrb_info%nprocs) + call get_ice_timer(timer_evp , 'evp' ,nblocks,distrb_info%nprocs) + call get_ice_timer(timer_updstate , 'UpdState' ,nblocks,distrb_info%nprocs) ! call get_ice_timer(timer_tmp1, 'tmp1', nblocks,distrb_info%nprocs) ! call get_ice_timer(timer_tmp2, 'tmp2', nblocks,distrb_info%nprocs) ! call get_ice_timer(timer_tmp3, 'tmp3', nblocks,distrb_info%nprocs) diff --git a/cicecore/cicedyn/infrastructure/ice_grid.F90 b/cicecore/cicedyn/infrastructure/ice_grid.F90 index 5473ebeae..ef2db8a11 100644 --- a/cicecore/cicedyn/infrastructure/ice_grid.F90 +++ b/cicecore/cicedyn/infrastructure/ice_grid.F90 @@ -24,13 +24,17 @@ module ice_grid use ice_kinds_mod use ice_broadcast, only: broadcast_scalar, broadcast_array - use ice_boundary, only: ice_HaloUpdate, ice_HaloExtrapolate, & - primary_grid_lengths_global_ext + use ice_boundary, only: ice_HaloUpdate, ice_HaloExtrapolate + use ice_constants, only: c0, c1, c1p5, c2, c4, c20, c360, & + p5, p25, radius, cm_to_m, m_to_cm, & + field_loc_center, field_loc_NEcorner, field_loc_Nface, field_loc_Eface, & + field_type_scalar, field_type_vector, field_type_angle use ice_communicate, only: my_task, master_task use ice_blocks, only: block, get_block, nx_block, ny_block, nghost use ice_domain_size, only: nx_global, ny_global, max_blocks use ice_domain, only: blocks_ice, nblocks, halo_info, distrb_info, & - ew_boundary_type, ns_boundary_type, init_domain_distribution + ew_boundary_type, ns_boundary_type, init_domain_distribution, & + close_boundaries use ice_fileunits, only: nu_diag, nu_grid, nu_kmt, & get_fileunit, release_fileunit, flush_fileunit use ice_gather_scatter, only: gather_global, scatter_global @@ -44,8 +48,9 @@ module ice_grid implicit none private - public :: init_grid1, init_grid2, grid_average_X2Y, & - alloc_grid, makemask, grid_neighbor_min, grid_neighbor_max + public :: init_grid1, init_grid2, grid_average_X2Y, makemask, & + alloc_grid, dealloc_grid, & + grid_neighbor_min, grid_neighbor_max character (len=char_len_long), public :: & grid_format , & ! file format ('bin'=binary or 'nc'=netcdf) @@ -180,7 +185,7 @@ module ice_grid logical (kind=log_kind), public :: & use_bathymetry, & ! flag for reading in bathymetry_file - pgl_global_ext, & ! flag for init primary grid lengths (global ext.) + save_ghte_ghtn, & ! flag for saving global hte and htn during initialization scale_dxdy ! flag to apply scale factor to vary dx/dy in rectgrid logical (kind=log_kind), dimension (:,:,:), allocatable, public :: & @@ -288,7 +293,7 @@ subroutine alloc_grid 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 memory') + if (ierr/=0) call abort_ice(subname//'ERROR: Out of memory1') if (grid_ice == 'CD' .or. grid_ice == 'C') then allocate( & @@ -297,21 +302,46 @@ subroutine alloc_grid 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 memory') + if (ierr/=0) call abort_ice(subname//'ERROR: Out of memory2') endif - if (pgl_global_ext) then - allocate( & - G_HTE(nx_global+2*nghost, ny_global+2*nghost), & ! length of eastern edge of T-cell (global ext.) - G_HTN(nx_global+2*nghost, ny_global+2*nghost), & ! length of northern edge of T-cell (global ext.) - stat=ierr) - if (ierr/=0) call abort_ice(subname//'ERROR: Out of memory') + if (save_ghte_ghtn) then + if (my_task == master_task) then + allocate( & + G_HTE(nx_global+2*nghost, ny_global+2*nghost), & ! length of eastern edge of T-cell (global ext.) + G_HTN(nx_global+2*nghost, ny_global+2*nghost), & ! length of northern edge of T-cell (global ext.) + stat=ierr) + else + allocate( & + G_HTE(1,1), & ! needed for debug checks + G_HTN(1,1), & ! never used in code + stat=ierr) + endif + if (ierr/=0) call abort_ice(subname//'ERROR: Out of memory3') endif end subroutine alloc_grid !======================================================================= +! +! DeAllocate space for variables no longer needed after initialization +! + subroutine dealloc_grid + + integer (int_kind) :: ierr + + character(len=*), parameter :: subname = '(dealloc_grid)' + + if (save_ghte_ghtn) then + deallocate(G_HTE, G_HTN, stat=ierr) + if (ierr/=0) call abort_ice(subname//'ERROR: Dealloc error1') + endif + + end subroutine dealloc_grid + +!======================================================================= + ! Distribute blocks across processors. The distribution is optimized ! based on latitude and topography, contained in the ULAT and KMT arrays. ! @@ -319,10 +349,6 @@ end subroutine alloc_grid subroutine init_grid1 - use ice_blocks, only: nx_block, ny_block - use ice_broadcast, only: broadcast_array - use ice_constants, only: c1 - integer (kind=int_kind) :: & fid_grid, & ! file id for netCDF grid file fid_kmt ! file id for netCDF kmt file @@ -445,11 +471,6 @@ end subroutine init_grid1 subroutine init_grid2 - use ice_blocks, only: get_block, block, nx_block, ny_block - use ice_constants, only: c0, c1, c2, p5, p25, c1p5, & - field_loc_center, field_loc_NEcorner, field_loc_Nface, field_loc_Eface, & - field_type_scalar, field_type_vector, field_type_angle - use ice_domain_size, only: max_blocks #if defined (_OPENMP) use OMP_LIB #endif @@ -800,12 +821,6 @@ end subroutine init_grid2 subroutine popgrid - use ice_blocks, only: nx_block, ny_block - use ice_constants, only: c0, c1, p5, & - field_loc_center, field_loc_NEcorner, & - field_type_scalar, field_type_angle - use ice_domain_size, only: max_blocks - integer (kind=int_kind) :: & i, j, iblk, & ilo,ihi,jlo,jhi ! beginning and end of physical domain @@ -919,11 +934,6 @@ end subroutine popgrid subroutine popgrid_nc - use ice_blocks, only: nx_block, ny_block - use ice_constants, only: c0, c1, & - field_loc_center, field_loc_NEcorner, & - field_type_scalar, field_type_angle - use ice_domain_size, only: max_blocks #ifdef USE_NETCDF use netcdf #endif @@ -1090,11 +1100,7 @@ end subroutine popgrid_nc subroutine latlongrid -! use ice_boundary - use ice_domain_size use ice_scam, only : scmlat, scmlon, single_column - use ice_constants, only: c0, c1, p5, p25, & - field_loc_center, field_type_scalar, radius #ifdef USE_NETCDF use netcdf #endif @@ -1374,10 +1380,6 @@ end subroutine latlongrid subroutine rectgrid - use ice_constants, only: c0, c1, c2, radius, cm_to_m, & - field_loc_center, field_loc_NEcorner, field_type_scalar - use ice_domain, only: close_boundaries - integer (kind=int_kind) :: & i, j, & imid, jmid @@ -1573,8 +1575,6 @@ subroutine rectgrid_scale_dxdy ! generate a variable spaced rectangluar grid. ! extend spacing from center of grid outward. - use ice_constants, only: c0, c1, c2, radius, cm_to_m, & - field_loc_center, field_loc_NEcorner, field_type_scalar integer (kind=int_kind) :: & i, j, iblk, & @@ -1738,8 +1738,6 @@ end subroutine rectgrid_scale_dxdy subroutine grid_boxislands_kmt (work) - use ice_constants, only: c0, c1, c20 - real (kind=dbl_kind), dimension(:,:), intent(inout) :: work integer (kind=int_kind) :: & @@ -1873,11 +1871,6 @@ end subroutine grid_boxislands_kmt subroutine cpomgrid - use ice_blocks, only: nx_block, ny_block - use ice_constants, only: c0, c1, m_to_cm, & - field_loc_NEcorner, field_type_scalar - use ice_domain_size, only: max_blocks - integer (kind=int_kind) :: & i, j, iblk, & ilo,ihi,jlo,jhi ! beginning and end of physical domain @@ -1979,10 +1972,6 @@ end subroutine cpomgrid subroutine primary_grid_lengths_HTN(work_g) - use ice_constants, only: p25, p5, c2, cm_to_m, & - field_loc_center, field_loc_NEcorner, & - field_loc_Nface, field_type_scalar - real (kind=dbl_kind), dimension(:,:) :: work_g ! global array holding HTN ! local variables @@ -2018,10 +2007,14 @@ subroutine primary_grid_lengths_HTN(work_g) work_g2(i,j) = p5*(work_g(i,j) + work_g(ip1,j)) ! dxU enddo enddo - endif - if (pgl_global_ext) then - call primary_grid_lengths_global_ext( & - G_HTN, work_g, ew_boundary_type, ns_boundary_type) + if (save_ghte_ghtn) then + do j = 1, ny_global + do i = 1,nx_global + G_HTN(i+nghost,j+nghost) = work_g(i,j) + enddo + enddo + call global_ext_halo(G_HTN) + endif endif call scatter_global(HTN, work_g, master_task, distrb_info, & field_loc_Nface, field_type_scalar) @@ -2084,10 +2077,6 @@ end subroutine primary_grid_lengths_HTN subroutine primary_grid_lengths_HTE(work_g) - use ice_constants, only: p25, p5, c2, cm_to_m, & - field_loc_center, field_loc_NEcorner, & - field_loc_Eface, field_type_scalar - real (kind=dbl_kind), dimension(:,:) :: work_g ! global array holding HTE ! local variables @@ -2126,10 +2115,14 @@ subroutine primary_grid_lengths_HTE(work_g) work_g2(i,ny_global) = c2*work_g(i,ny_global-1) - work_g(i,ny_global-2) ! dyU enddo endif - endif - if (pgl_global_ext) then - call primary_grid_lengths_global_ext( & - G_HTE, work_g, ew_boundary_type, ns_boundary_type) + if (save_ghte_ghtn) then + do j = 1, ny_global + do i = 1, nx_global + G_HTE(i+nghost,j+nghost) = work_g(i,j) + enddo + enddo + call global_ext_halo(G_HTE) + endif endif call scatter_global(HTE, work_g, master_task, distrb_info, & field_loc_Eface, field_type_scalar) @@ -2186,6 +2179,48 @@ end subroutine primary_grid_lengths_HTE !======================================================================= +! This subroutine fills ghost cells in global extended grid + + subroutine global_ext_halo(array) + + real (kind=dbl_kind), dimension(:,:), intent(inout) :: & + array ! extended global grid size nx+2*nghost, ny+2*nghost + ! nghost+1:nghost+nx_global and nghost+1:nghost+ny_global filled on entry + + integer (kind=int_kind) :: n + + character(len=*), parameter :: subname = '(global_ext_halo)' + + do n = 1,nghost + if (ns_boundary_type =='cyclic') then + array(:,n) = array(:,ny_global+n) + array(:,ny_global+nghost+n) = array(:,nghost+n) + elseif (ns_boundary_type == 'open') then + array(:,n) = array(:,nghost+1) + array(:,ny_global+nghost+n) = array(:,ny_global+nghost) + else + array(:,n) = c0 + array(:,ny_global+nghost+n) = c0 + endif + enddo + + do n = 1,nghost + if (ew_boundary_type =='cyclic') then + array(n ,:) = array(nx_global+n,:) + array(nx_global+nghost+n,:) = array(nghost+n ,:) + elseif (ew_boundary_type == 'open') then + array(n ,:) = array(nghost+1 ,:) + array(nx_global+nghost+n,:) = array(nx_global+nghost,:) + else + array(n ,:) = c0 + array(nx_global+nghost+n,:) = c0 + endif + enddo + + end subroutine global_ext_halo + +!======================================================================= + ! Sets the boundary values for the T cell land mask (hm) and ! makes the logical land masks for T and U cells (tmask, umask) ! and N and E cells (nmask, emask). @@ -2195,10 +2230,6 @@ end subroutine primary_grid_lengths_HTE subroutine makemask - use ice_constants, only: c0, p5, c1p5, & - field_loc_center, field_loc_NEcorner, field_type_scalar, & - field_loc_Nface, field_loc_Eface - integer (kind=int_kind) :: & i, j, iblk, & ilo,ihi,jlo,jhi ! beginning and end of physical domain @@ -2349,10 +2380,6 @@ end subroutine makemask subroutine Tlatlon - use ice_constants, only: c0, c1, c1p5, c2, c4, p5, & - field_loc_center, field_loc_Nface, field_loc_Eface, & - field_type_scalar - integer (kind=int_kind) :: & i, j, iblk , & ! horizontal indices ilo,ihi,jlo,jhi ! beginning and end of physical domain @@ -3025,8 +3052,6 @@ end subroutine grid_average_X2Y_1f subroutine grid_average_X2YS(dir,work1,wght1,mask1,work2) - use ice_constants, only: c0 - character(len=*) , intent(in) :: & dir @@ -3256,8 +3281,6 @@ end subroutine grid_average_X2YS subroutine grid_average_X2YA(dir,work1,wght1,work2) - use ice_constants, only: c0 - character(len=*) , intent(in) :: & dir @@ -3486,8 +3509,6 @@ end subroutine grid_average_X2YA subroutine grid_average_X2YF(dir,work1,wght1,work2,wght2) - use ice_constants, only: c0, p25, p5 - character(len=*) , intent(in) :: & dir @@ -3690,8 +3711,6 @@ end subroutine grid_average_X2YF subroutine grid_average_X2Y_2(dir,work1a,wght1a,mask1a,work1b,wght1b,mask1b,work2) - use ice_constants, only: c0 - character(len=*) , intent(in) :: & dir @@ -3902,11 +3921,6 @@ end function grid_neighbor_max subroutine gridbox_corners - use ice_blocks, only: nx_block, ny_block - use ice_constants, only: c0, c2, c360, & - field_loc_NEcorner, field_type_scalar - use ice_domain_size, only: max_blocks - integer (kind=int_kind) :: & i,j,iblk,icorner,& ! index counters ilo,ihi,jlo,jhi ! beginning and end of physical domain @@ -4098,11 +4112,6 @@ end subroutine gridbox_corners subroutine gridbox_edges - use ice_blocks, only: nx_block, ny_block - use ice_constants, only: c0, c2, c360, & - field_loc_NEcorner, field_type_scalar - use ice_domain_size, only: max_blocks - integer (kind=int_kind) :: & i,j,iblk,icorner,& ! index counters ilo,ihi,jlo,jhi ! beginning and end of physical domain @@ -4398,11 +4407,6 @@ end subroutine gridbox_edges subroutine gridbox_verts(work_g,vbounds) - use ice_blocks, only: nx_block, ny_block - use ice_constants, only: c0, c2, & - field_loc_NEcorner, field_type_scalar - use ice_domain_size, only: max_blocks - real (kind=dbl_kind), dimension(:,:), intent(in) :: & work_g @@ -4517,8 +4521,6 @@ end subroutine gridbox_verts subroutine get_bathymetry - use ice_constants, only: c0 - integer (kind=int_kind) :: & i, j, k, iblk ! loop indices @@ -4710,7 +4712,6 @@ subroutine read_seabedstress_bathy ! use module use ice_read_write - use ice_constants, only: field_loc_center, field_type_scalar ! local variables integer (kind=int_kind) :: & diff --git a/cicecore/drivers/direct/hadgem3/CICE_InitMod.F90 b/cicecore/drivers/direct/hadgem3/CICE_InitMod.F90 index 4efb13c52..3f87f2ca8 100644 --- a/cicecore/drivers/direct/hadgem3/CICE_InitMod.F90 +++ b/cicecore/drivers/direct/hadgem3/CICE_InitMod.F90 @@ -80,7 +80,7 @@ subroutine cice_init get_forcing_atmo, get_forcing_ocn, alloc_forcing, get_wave_spec use ice_forcing_bgc, only: get_forcing_bgc, get_atm_bgc, & faero_data, faero_default, alloc_forcing_bgc - use ice_grid, only: init_grid1, init_grid2, alloc_grid + use ice_grid, only: init_grid1, init_grid2, alloc_grid, dealloc_grid use ice_history, only: init_hist, accum_hist use ice_restart_shared, only: restart, runid, runtype use ice_init, only: input_data, init_state @@ -213,6 +213,7 @@ subroutine cice_init call init_flux_atm ! initialize atmosphere fluxes sent to coupler call init_flux_ocn ! initialize ocean fluxes sent to coupler + call dealloc_grid ! deallocate temporary grid arrays if (write_ic) call accum_hist(dt) ! write initial conditions end subroutine cice_init diff --git a/cicecore/drivers/direct/nemo_concepts/CICE_InitMod.F90 b/cicecore/drivers/direct/nemo_concepts/CICE_InitMod.F90 index 69ecd4c91..7e2308f20 100644 --- a/cicecore/drivers/direct/nemo_concepts/CICE_InitMod.F90 +++ b/cicecore/drivers/direct/nemo_concepts/CICE_InitMod.F90 @@ -80,7 +80,7 @@ subroutine cice_init get_forcing_atmo, get_forcing_ocn, alloc_forcing, get_wave_spec use ice_forcing_bgc, only: get_forcing_bgc, get_atm_bgc, & faero_data, faero_default, alloc_forcing_bgc - use ice_grid, only: init_grid1, init_grid2, alloc_grid + use ice_grid, only: init_grid1, init_grid2, alloc_grid, dealloc_grid use ice_history, only: init_hist, accum_hist use ice_restart_shared, only: restart, runid, runtype use ice_init, only: input_data, init_state @@ -215,6 +215,7 @@ subroutine cice_init call init_flux_atm ! initialize atmosphere fluxes sent to coupler call init_flux_ocn ! initialize ocean fluxes sent to coupler + call dealloc_grid ! deallocate temporary grid arrays end subroutine cice_init !======================================================================= diff --git a/cicecore/drivers/mct/cesm1/CICE_InitMod.F90 b/cicecore/drivers/mct/cesm1/CICE_InitMod.F90 index 3c5907c54..419dbacc9 100644 --- a/cicecore/drivers/mct/cesm1/CICE_InitMod.F90 +++ b/cicecore/drivers/mct/cesm1/CICE_InitMod.F90 @@ -82,7 +82,7 @@ subroutine cice_init(mpicom_ice) get_forcing_atmo, get_forcing_ocn, get_wave_spec, init_snowtable use ice_forcing_bgc, only: get_forcing_bgc, get_atm_bgc, & faero_default, alloc_forcing_bgc, fiso_default - use ice_grid, only: init_grid1, init_grid2, alloc_grid + use ice_grid, only: init_grid1, init_grid2, alloc_grid, dealloc_grid use ice_history, only: init_hist, accum_hist use ice_restart_shared, only: restart, runtype use ice_init, only: input_data, init_state @@ -241,6 +241,7 @@ subroutine cice_init(mpicom_ice) if (write_ic) call accum_hist(dt) ! write initial conditions + call dealloc_grid ! deallocate temporary grid arrays if (my_task == master_task) then call ice_memusage_print(nu_diag,subname//':end') endif diff --git a/cicecore/drivers/nuopc/cmeps/CICE_InitMod.F90 b/cicecore/drivers/nuopc/cmeps/CICE_InitMod.F90 index 2ebcc696a..0c6bc9949 100644 --- a/cicecore/drivers/nuopc/cmeps/CICE_InitMod.F90 +++ b/cicecore/drivers/nuopc/cmeps/CICE_InitMod.F90 @@ -32,7 +32,7 @@ subroutine cice_init1() use ice_init , only: input_data use ice_init_column , only: input_zbgc, count_tracers - use ice_grid , only: init_grid1, alloc_grid + use ice_grid , only: init_grid1, alloc_grid, dealloc_grid use ice_domain , only: init_domain_blocks use ice_arrays_column , only: alloc_arrays_column use ice_state , only: alloc_state @@ -201,6 +201,8 @@ subroutine cice_init2() call init_flux_atm ! initialize atmosphere fluxes sent to coupler call init_flux_ocn ! initialize ocean fluxes sent to coupler + call dealloc_grid ! deallocate temporary grid arrays + end subroutine cice_init2 !======================================================================= diff --git a/cicecore/drivers/nuopc/dmi/CICE_FinalMod.F90 b/cicecore/drivers/nuopc/dmi/CICE_FinalMod.F90 index 9f32875e1..27d01f110 100644 --- a/cicecore/drivers/nuopc/dmi/CICE_FinalMod.F90 +++ b/cicecore/drivers/nuopc/dmi/CICE_FinalMod.F90 @@ -35,12 +35,12 @@ subroutine CICE_Finalize character(len=*), parameter :: subname = '(CICE_Finalize)' - !------------------------------------------------------------------- - ! stop timers and print timer info - !------------------------------------------------------------------- + !------------------------------------------------------------------- + ! stop timers and print timer info + !------------------------------------------------------------------- call ice_timer_stop(timer_total) ! stop timing entire run - call ice_timer_print_all(stats=.false.) ! print timing information + call ice_timer_print_all(stats=timer_stats) ! print timing information call icepack_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & @@ -55,9 +55,9 @@ subroutine CICE_Finalize !echmod if (nu_diag /= 6) close (nu_diag) ! diagnostic output call release_all_fileunits - !------------------------------------------------------------------- - ! quit MPI - !------------------------------------------------------------------- + !------------------------------------------------------------------- + ! quit MPI + !------------------------------------------------------------------- #ifndef coupled #ifndef CICE_DMI diff --git a/cicecore/drivers/nuopc/dmi/CICE_InitMod.F90 b/cicecore/drivers/nuopc/dmi/CICE_InitMod.F90 index 147bdf7df..4577113f1 100644 --- a/cicecore/drivers/nuopc/dmi/CICE_InitMod.F90 +++ b/cicecore/drivers/nuopc/dmi/CICE_InitMod.F90 @@ -87,7 +87,7 @@ subroutine cice_init(mpi_comm) get_forcing_atmo, get_forcing_ocn, get_wave_spec, init_snowtable use ice_forcing_bgc, only: get_forcing_bgc, get_atm_bgc, & faero_default, alloc_forcing_bgc, fiso_default - use ice_grid, only: init_grid1, init_grid2, alloc_grid + use ice_grid, only: init_grid1, init_grid2, alloc_grid, dealloc_grid use ice_history, only: init_hist, accum_hist use ice_restart_shared, only: restart, runtype use ice_init, only: input_data, init_state @@ -259,6 +259,7 @@ subroutine cice_init(mpi_comm) if (write_ic) call accum_hist(dt) ! write initial conditions + call dealloc_grid ! deallocate temporary grid arrays if (my_task == master_task) then call ice_memusage_print(nu_diag,subname//':end') endif @@ -277,7 +278,6 @@ subroutine init_restart use ice_domain_size, only: ncat, n_iso, n_aero, nfsd, nslyr use ice_dyn_eap, only: read_restart_eap use ice_dyn_shared, only: kdyn - use ice_flux, only: Tf use ice_grid, only: tmask use ice_init, only: ice_ic use ice_init_column, only: init_age, init_FY, init_lvl, init_snowtracers, & @@ -292,7 +292,8 @@ subroutine init_restart restart_iso, read_restart_iso, & restart_aero, read_restart_aero, & restart_hbrine, read_restart_hbrine, & - restart_zsal, restart_bgc + restart_bgc + use ice_flux, only: Tf use ice_restart_driver, only: restartfile use ice_restart_shared, only: runtype, restart use ice_state ! almost everything @@ -303,7 +304,7 @@ subroutine init_restart logical(kind=log_kind) :: & tr_iage, tr_FY, tr_lvl, tr_pond_lvl, & tr_pond_topo, tr_snow, tr_fsd, tr_iso, tr_aero, tr_brine, & - skl_bgc, z_tracers, solve_zsal + skl_bgc, z_tracers integer(kind=int_kind) :: & ntrcr integer(kind=int_kind) :: & @@ -319,7 +320,7 @@ subroutine init_restart file=__FILE__, line=__LINE__) call icepack_query_parameters(skl_bgc_out=skl_bgc, & - z_tracers_out=z_tracers, solve_zsal_out=solve_zsal) + z_tracers_out=z_tracers) call icepack_query_tracer_flags(tr_iage_out=tr_iage, tr_FY_out=tr_FY, & tr_lvl_out=tr_lvl, tr_pond_lvl_out=tr_pond_lvl, & tr_pond_topo_out=tr_pond_topo, tr_aero_out=tr_aero, tr_brine_out=tr_brine, & @@ -465,8 +466,6 @@ subroutine init_restart if (trim(runtype) == 'continue') then if (tr_brine) & restart_hbrine = .true. - if (solve_zsal) & - restart_zsal = .true. if (skl_bgc .or. z_tracers) & restart_bgc = .true. endif @@ -476,7 +475,7 @@ subroutine init_restart if (tr_brine .and. restart_hbrine) call read_restart_hbrine endif - if (solve_zsal .or. skl_bgc .or. z_tracers) then ! biogeochemistry + if (skl_bgc .or. z_tracers) then ! biogeochemistry if (tr_fsd) then write (nu_diag,*) 'FSD implementation incomplete for use with BGC' call icepack_warnings_flush(nu_diag) diff --git a/cicecore/drivers/nuopc/dmi/CICE_RunMod.F90 b/cicecore/drivers/nuopc/dmi/CICE_RunMod.F90 index 77bb7738e..897f62eea 100644 --- a/cicecore/drivers/nuopc/dmi/CICE_RunMod.F90 +++ b/cicecore/drivers/nuopc/dmi/CICE_RunMod.F90 @@ -15,11 +15,13 @@ module CICE_RunMod use ice_kinds_mod + use ice_communicate, only: my_task, master_task use ice_fileunits, only: nu_diag use ice_arrays_column, only: oceanmixed_ice use ice_constants, only: c0, c1 use ice_constants, only: field_loc_center, field_type_scalar use ice_exit, only: abort_ice + use ice_memusage, only: ice_memusage_print use icepack_intfc, only: icepack_warnings_flush, icepack_warnings_aborted use icepack_intfc, only: icepack_max_iso, icepack_max_aero use icepack_intfc, only: icepack_query_parameters @@ -43,7 +45,7 @@ module CICE_RunMod subroutine CICE_Run(stop_now_cpl) - use ice_calendar, only: istep, istep1, dt, stop_now, advance_timestep + use ice_calendar, only: dt, stop_now, advance_timestep use ice_forcing, only: get_forcing_atmo, get_forcing_ocn, & get_wave_spec use ice_forcing_bgc, only: get_forcing_bgc, get_atm_bgc, & @@ -74,9 +76,9 @@ subroutine CICE_Run(stop_now_cpl) file=__FILE__, line=__LINE__) #ifndef CICE_IN_NEMO - !-------------------------------------------------------------------- - ! timestep loop - !-------------------------------------------------------------------- + !-------------------------------------------------------------------- + ! timestep loop + !-------------------------------------------------------------------- #ifndef CICE_DMI timeLoop: do #endif @@ -147,7 +149,7 @@ subroutine ice_step use ice_boundary, only: ice_HaloUpdate use ice_calendar, only: dt, dt_dyn, ndtd, diagfreq, write_restart, istep use ice_diagnostics, only: init_mass_diags, runtime_diags, debug_model, debug_ice - use ice_diagnostics_bgc, only: hbrine_diags, zsal_diags, bgc_diags + use ice_diagnostics_bgc, only: hbrine_diags, bgc_diags use ice_domain, only: halo_info, nblocks use ice_dyn_eap, only: write_restart_eap use ice_dyn_shared, only: kdyn, kridge @@ -181,7 +183,7 @@ subroutine ice_step logical (kind=log_kind) :: & tr_iage, tr_FY, tr_lvl, tr_fsd, tr_snow, & tr_pond_lvl, tr_pond_topo, tr_brine, tr_iso, tr_aero, & - calc_Tsfc, skl_bgc, solve_zsal, z_tracers, wave_spec + calc_Tsfc, skl_bgc, z_tracers, wave_spec character(len=*), parameter :: subname = '(ice_step)' @@ -195,8 +197,7 @@ subroutine ice_step endif call icepack_query_parameters(calc_Tsfc_out=calc_Tsfc, skl_bgc_out=skl_bgc, & - solve_zsal_out=solve_zsal, z_tracers_out=z_tracers, ktherm_out=ktherm, & - wave_spec_out=wave_spec) + z_tracers_out=z_tracers, ktherm_out=ktherm, wave_spec_out=wave_spec) call icepack_query_tracer_flags(tr_iage_out=tr_iage, tr_FY_out=tr_FY, & tr_lvl_out=tr_lvl, tr_pond_lvl_out=tr_pond_lvl, & tr_pond_topo_out=tr_pond_topo, tr_brine_out=tr_brine, tr_aero_out=tr_aero, & @@ -226,10 +227,9 @@ subroutine ice_step call step_prep - !$OMP PARALLEL DO PRIVATE(iblk) - do iblk = 1, nblocks - - if (ktherm >= 0) then + if (ktherm >= 0) then + !$OMP PARALLEL DO PRIVATE(iblk) SCHEDULE(runtime) + do iblk = 1, nblocks !----------------------------------------------------------------- ! scale radiation fields @@ -267,10 +267,9 @@ subroutine ice_step call debug_ice (iblk, plabeld) endif - endif ! ktherm > 0 - - enddo ! iblk - !$OMP END PARALLEL DO + enddo + !$OMP END PARALLEL DO + endif ! ktherm > 0 ! clean up, update tendency diagnostics offset = dt @@ -300,7 +299,7 @@ subroutine ice_step endif ! ridging - !$OMP PARALLEL DO PRIVATE(iblk) + !$OMP PARALLEL DO PRIVATE(iblk) SCHEDULE(runtime) do iblk = 1, nblocks if (kridge > 0) call step_dyn_ridge (dt_dyn, ndtd, iblk) enddo @@ -334,9 +333,11 @@ subroutine ice_step !----------------------------------------------------------------- if (tr_snow) then ! advanced snow physics + !$OMP PARALLEL DO PRIVATE(iblk) SCHEDULE(runtime) do iblk = 1, nblocks call step_snow (dt, iblk) enddo + !$OMP END PARALLEL DO call update_state (dt) ! clean up endif @@ -384,9 +385,11 @@ subroutine ice_step call ice_timer_start(timer_diags) ! diagnostics if (mod(istep,diagfreq) == 0) then call runtime_diags(dt) ! log file - if (solve_zsal) call zsal_diags if (skl_bgc .or. z_tracers) call bgc_diags if (tr_brine) call hbrine_diags + if (my_task == master_task) then + call ice_memusage_print(nu_diag,subname) + endif endif call ice_timer_stop(timer_diags) ! diagnostics @@ -406,13 +409,12 @@ subroutine ice_step if (tr_fsd) call write_restart_fsd if (tr_iso) call write_restart_iso if (tr_aero) call write_restart_aero - if (solve_zsal .or. skl_bgc .or. z_tracers) & + if (skl_bgc .or. z_tracers) & call write_restart_bgc if (tr_brine) call write_restart_hbrine if (kdyn == 2) call write_restart_eap call final_restart endif - call ice_timer_stop(timer_readwrite) ! reading/writing end subroutine ice_step @@ -426,7 +428,7 @@ end subroutine ice_step subroutine coupling_prep (iblk) use ice_arrays_column, only: alvdfn, alidfn, alvdrn, alidrn, & - albicen, albsnon, albpndn, apeffn, fzsal_g, fzsal, snowfracn + albicen, albsnon, albpndn, apeffn, snowfracn use ice_blocks, only: nx_block, ny_block, get_block, block use ice_domain, only: blocks_ice use ice_calendar, only: dt, nstreams @@ -441,7 +443,7 @@ subroutine coupling_prep (iblk) fsens, flat, fswabs, flwout, evap, Tref, Qref, & scale_fluxes, frzmlt_init, frzmlt use ice_flux_bgc, only: faero_ocn, fiso_ocn, Qref_iso, fiso_evap, & - fzsal_ai, fzsal_g_ai, flux_bio, flux_bio_ai + flux_bio, flux_bio_ai use ice_grid, only: tmask use ice_state, only: aicen, aice #ifdef CICE_IN_NEMO @@ -592,8 +594,6 @@ subroutine coupling_prep (iblk) fsalt_ai (i,j,iblk) = fsalt (i,j,iblk) fhocn_ai (i,j,iblk) = fhocn (i,j,iblk) fswthru_ai(i,j,iblk) = fswthru(i,j,iblk) - fzsal_ai (i,j,iblk) = fzsal (i,j,iblk) - fzsal_g_ai(i,j,iblk) = fzsal_g(i,j,iblk) if (nbtrcr > 0) then do k = 1, nbtrcr @@ -639,8 +639,7 @@ subroutine coupling_prep (iblk) faero_ocn(:,:,:,iblk), & alvdr (:,:,iblk), alidr (:,:,iblk), & alvdf (:,:,iblk), alidf (:,:,iblk), & - fzsal (:,:,iblk), fzsal_g (:,:,iblk), & - flux_bio (:,:,1:nbtrcr,iblk), & + flux_bio =flux_bio (:,:,1:nbtrcr,iblk), & Qref_iso =Qref_iso (:,:,:,iblk), & fiso_evap=fiso_evap(:,:,:,iblk), & fiso_ocn =fiso_ocn (:,:,:,iblk)) diff --git a/cicecore/drivers/standalone/cice/CICE_InitMod.F90 b/cicecore/drivers/standalone/cice/CICE_InitMod.F90 index 38000446a..a48bdda30 100644 --- a/cicecore/drivers/standalone/cice/CICE_InitMod.F90 +++ b/cicecore/drivers/standalone/cice/CICE_InitMod.F90 @@ -82,7 +82,7 @@ subroutine cice_init get_forcing_atmo, get_forcing_ocn, get_wave_spec, init_snowtable use ice_forcing_bgc, only: get_forcing_bgc, get_atm_bgc, & faero_default, alloc_forcing_bgc, fiso_default - use ice_grid, only: init_grid1, init_grid2, alloc_grid + use ice_grid, only: init_grid1, init_grid2, alloc_grid, dealloc_grid use ice_history, only: init_hist, accum_hist use ice_restart_shared, only: restart, runtype use ice_init, only: input_data, init_state @@ -243,6 +243,8 @@ subroutine cice_init call init_flux_atm ! initialize atmosphere fluxes sent to coupler call init_flux_ocn ! initialize ocean fluxes sent to coupler + call dealloc_grid ! deallocate temporary grid arrays + if (my_task == master_task) then call ice_memusage_print(nu_diag,subname//':end') endif diff --git a/cicecore/drivers/unittest/gridavgchk/CICE_InitMod.F90 b/cicecore/drivers/unittest/gridavgchk/CICE_InitMod.F90 index 38000446a..cb1241a5e 100644 --- a/cicecore/drivers/unittest/gridavgchk/CICE_InitMod.F90 +++ b/cicecore/drivers/unittest/gridavgchk/CICE_InitMod.F90 @@ -82,7 +82,7 @@ subroutine cice_init get_forcing_atmo, get_forcing_ocn, get_wave_spec, init_snowtable use ice_forcing_bgc, only: get_forcing_bgc, get_atm_bgc, & faero_default, alloc_forcing_bgc, fiso_default - use ice_grid, only: init_grid1, init_grid2, alloc_grid + use ice_grid, only: init_grid1, init_grid2, alloc_grid, dealloc_grid use ice_history, only: init_hist, accum_hist use ice_restart_shared, only: restart, runtype use ice_init, only: input_data, init_state @@ -243,6 +243,7 @@ subroutine cice_init call init_flux_atm ! initialize atmosphere fluxes sent to coupler call init_flux_ocn ! initialize ocean fluxes sent to coupler + call dealloc_grid ! deallocate temporary grid arrays if (my_task == master_task) then call ice_memusage_print(nu_diag,subname//':end') endif diff --git a/cicecore/drivers/unittest/halochk/CICE_InitMod.F90 b/cicecore/drivers/unittest/halochk/CICE_InitMod.F90 index 38000446a..cb1241a5e 100644 --- a/cicecore/drivers/unittest/halochk/CICE_InitMod.F90 +++ b/cicecore/drivers/unittest/halochk/CICE_InitMod.F90 @@ -82,7 +82,7 @@ subroutine cice_init get_forcing_atmo, get_forcing_ocn, get_wave_spec, init_snowtable use ice_forcing_bgc, only: get_forcing_bgc, get_atm_bgc, & faero_default, alloc_forcing_bgc, fiso_default - use ice_grid, only: init_grid1, init_grid2, alloc_grid + use ice_grid, only: init_grid1, init_grid2, alloc_grid, dealloc_grid use ice_history, only: init_hist, accum_hist use ice_restart_shared, only: restart, runtype use ice_init, only: input_data, init_state @@ -243,6 +243,7 @@ subroutine cice_init call init_flux_atm ! initialize atmosphere fluxes sent to coupler call init_flux_ocn ! initialize ocean fluxes sent to coupler + call dealloc_grid ! deallocate temporary grid arrays if (my_task == master_task) then call ice_memusage_print(nu_diag,subname//':end') endif diff --git a/cicecore/drivers/unittest/opticep/CICE_InitMod.F90 b/cicecore/drivers/unittest/opticep/CICE_InitMod.F90 index 38000446a..cb1241a5e 100644 --- a/cicecore/drivers/unittest/opticep/CICE_InitMod.F90 +++ b/cicecore/drivers/unittest/opticep/CICE_InitMod.F90 @@ -82,7 +82,7 @@ subroutine cice_init get_forcing_atmo, get_forcing_ocn, get_wave_spec, init_snowtable use ice_forcing_bgc, only: get_forcing_bgc, get_atm_bgc, & faero_default, alloc_forcing_bgc, fiso_default - use ice_grid, only: init_grid1, init_grid2, alloc_grid + use ice_grid, only: init_grid1, init_grid2, alloc_grid, dealloc_grid use ice_history, only: init_hist, accum_hist use ice_restart_shared, only: restart, runtype use ice_init, only: input_data, init_state @@ -243,6 +243,7 @@ subroutine cice_init call init_flux_atm ! initialize atmosphere fluxes sent to coupler call init_flux_ocn ! initialize ocean fluxes sent to coupler + call dealloc_grid ! deallocate temporary grid arrays if (my_task == master_task) then call ice_memusage_print(nu_diag,subname//':end') endif diff --git a/cicecore/drivers/unittest/sumchk/CICE_InitMod.F90 b/cicecore/drivers/unittest/sumchk/CICE_InitMod.F90 index 38000446a..cb1241a5e 100644 --- a/cicecore/drivers/unittest/sumchk/CICE_InitMod.F90 +++ b/cicecore/drivers/unittest/sumchk/CICE_InitMod.F90 @@ -82,7 +82,7 @@ subroutine cice_init get_forcing_atmo, get_forcing_ocn, get_wave_spec, init_snowtable use ice_forcing_bgc, only: get_forcing_bgc, get_atm_bgc, & faero_default, alloc_forcing_bgc, fiso_default - use ice_grid, only: init_grid1, init_grid2, alloc_grid + use ice_grid, only: init_grid1, init_grid2, alloc_grid, dealloc_grid use ice_history, only: init_hist, accum_hist use ice_restart_shared, only: restart, runtype use ice_init, only: input_data, init_state @@ -243,6 +243,7 @@ subroutine cice_init call init_flux_atm ! initialize atmosphere fluxes sent to coupler call init_flux_ocn ! initialize ocean fluxes sent to coupler + call dealloc_grid ! deallocate temporary grid arrays if (my_task == master_task) then call ice_memusage_print(nu_diag,subname//':end') endif diff --git a/configuration/scripts/machines/Macros.freya_intel b/configuration/scripts/machines/Macros.freya_intel index f40ca4e23..b31264990 100644 --- a/configuration/scripts/machines/Macros.freya_intel +++ b/configuration/scripts/machines/Macros.freya_intel @@ -21,14 +21,14 @@ CFLAGS := -c -O2 -fp-model precise # Additional flags FIXEDFLAGS := -132 FREEFLAGS := -FR -FFLAGS := -fp-model source -convert big_endian -assume byterecl -ftz -traceback -no-wrap-margin +FFLAGS := -convert big_endian -assume byterecl #-xHost ifeq ($(ICE_BLDDEBUG), true) - FFLAGS += -O0 -g -check -fpe0 -ftrapuv -fp-model except -check noarg_temp_created + FFLAGS += -O0 -g -check -fpe0 -ftrapuv -fp-model except -check noarg_temp_created -fp-model source -ftz -traceback -no-wrap-margin # -heap-arrays 1024 else - FFLAGS += -O2 + FFLAGS += -O3 -xCORE-AVX512 -qopt-zmm-usage=high -finline-functions -finline -parallel endif LD := $(FC) LDFLAGS := $(FFLAGS) -v diff --git a/configuration/scripts/tests/omp_suite.ts b/configuration/scripts/tests/omp_suite.ts index 57effbe75..c640f49d0 100644 --- a/configuration/scripts/tests/omp_suite.ts +++ b/configuration/scripts/tests/omp_suite.ts @@ -32,7 +32,6 @@ smoke gx3 8x4 diag1,reprosum,run10day,gridc smoke gx3 6x2 alt01,reprosum,run10day,gridc smoke gx3 8x2 alt02,reprosum,run10day,gridc #smoke gx3 12x2 alt03,droundrobin,reprosum,run10day,gridc -smoke gx3 4x4 alt04,reprosum,run10day,gridc smoke gx3 4x4 alt05,reprosum,run10day,gridc smoke gx3 8x2 alt06,reprosum,run10day,gridc smoke gx3 7x2 alt07,reprosum,run10day,gridc @@ -58,7 +57,6 @@ smoke gx3 8x4 diag1,reprosum,run10day,gridcd smoke gx3 6x2 alt01,reprosum,run10day,gridcd smoke gx3 8x2 alt02,reprosum,run10day,gridcd #smoke gx3 12x2 alt03,droundrobin,reprosum,run10day,gridcd -smoke gx3 4x4 alt04,reprosum,run10day,gridcd smoke gx3 4x4 alt05,reprosum,run10day,gridcd smoke gx3 8x2 alt06,reprosum,run10day,gridcd smoke gx3 7x2 alt07,reprosum,run10day,gridcd @@ -113,7 +111,6 @@ smoke gx3 4x1 diag1,reprosum,run10day,cmplogrest,thread,grid smoke gx3 8x1 alt01,reprosum,run10day,cmplogrest,thread,gridc smoke_gx3_6x2_alt01_gridc_reprosum_run10day smoke gx3 8x1 alt02,reprosum,run10day,cmplogrest,thread,gridc smoke_gx3_8x2_alt02_gridc_reprosum_run10day #smoke gx3 8x1 alt03,reprosum,run10day,cmplogrest,thread,gridc smoke_gx3_12x2_alt03_droundrobin_gridc_reprosum_run10day -smoke gx3 8x1 alt04,reprosum,run10day,cmplogrest,thread,gridc smoke_gx3_4x4_alt04_gridc_reprosum_run10day smoke gx3 8x1 alt05,reprosum,run10day,cmplogrest,thread,gridc smoke_gx3_4x4_alt05_gridc_reprosum_run10day smoke gx3 8x1 alt06,reprosum,run10day,cmplogrest,thread,gridc smoke_gx3_8x2_alt06_gridc_reprosum_run10day smoke gx3 8x1 alt07,reprosum,run10day,cmplogrest,thread,gridc smoke_gx3_7x2_alt07_gridc_reprosum_run10day @@ -141,7 +138,6 @@ smoke gx3 4x1 diag1,reprosum,run10day,cmplogrest,thread,grid smoke gx3 8x1 alt01,reprosum,run10day,cmplogrest,thread,gridcd smoke_gx3_6x2_alt01_gridcd_reprosum_run10day smoke gx3 8x1 alt02,reprosum,run10day,cmplogrest,thread,gridcd smoke_gx3_8x2_alt02_gridcd_reprosum_run10day #smoke gx3 8x1 alt03,reprosum,run10day,cmplogrest,thread,gridcd smoke_gx3_12x2_alt03_droundrobin_gridcd_reprosum_run10day -smoke gx3 8x1 alt04,reprosum,run10day,cmplogrest,thread,gridcd smoke_gx3_4x4_alt04_gridcd_reprosum_run10day smoke gx3 8x1 alt05,reprosum,run10day,cmplogrest,thread,gridcd smoke_gx3_4x4_alt05_gridcd_reprosum_run10day smoke gx3 8x1 alt06,reprosum,run10day,cmplogrest,thread,gridcd smoke_gx3_8x2_alt06_gridcd_reprosum_run10day smoke gx3 8x1 alt07,reprosum,run10day,cmplogrest,thread,gridcd smoke_gx3_7x2_alt07_gridcd_reprosum_run10day From d14bb694f2f8df4e74361a9df999e82eaa44fc8b Mon Sep 17 00:00:00 2001 From: Mads Hvid Ribergaard <38077893+mhrib@users.noreply.github.com> Date: Fri, 17 Nov 2023 16:39:01 +0100 Subject: [PATCH 44/76] Add missing logical "timer_stats" (#910) Co-authored-by: Mads Hvid Ribergaard --- cicecore/drivers/nuopc/dmi/CICE_FinalMod.F90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/cicecore/drivers/nuopc/dmi/CICE_FinalMod.F90 b/cicecore/drivers/nuopc/dmi/CICE_FinalMod.F90 index 27d01f110..be4f7ccf4 100644 --- a/cicecore/drivers/nuopc/dmi/CICE_FinalMod.F90 +++ b/cicecore/drivers/nuopc/dmi/CICE_FinalMod.F90 @@ -31,7 +31,8 @@ module CICE_FinalMod subroutine CICE_Finalize use ice_restart_shared, only: runid - use ice_timers, only: ice_timer_stop, ice_timer_print_all, timer_total + use ice_timers, only: ice_timer_stop, ice_timer_print_all, & + timer_total, timer_stats character(len=*), parameter :: subname = '(CICE_Finalize)' From 1cf109b7c350f119e8e3cd8bd918fa31e61d829c Mon Sep 17 00:00:00 2001 From: "David A. Bailey" Date: Mon, 20 Nov 2023 14:03:59 -0700 Subject: [PATCH 45/76] Change to dealloc_grid in CICE_InitMod.F90 (#911) --- cicecore/drivers/nuopc/cmeps/CICE_InitMod.F90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/cicecore/drivers/nuopc/cmeps/CICE_InitMod.F90 b/cicecore/drivers/nuopc/cmeps/CICE_InitMod.F90 index 0c6bc9949..b235ebf0e 100644 --- a/cicecore/drivers/nuopc/cmeps/CICE_InitMod.F90 +++ b/cicecore/drivers/nuopc/cmeps/CICE_InitMod.F90 @@ -32,7 +32,7 @@ subroutine cice_init1() use ice_init , only: input_data use ice_init_column , only: input_zbgc, count_tracers - use ice_grid , only: init_grid1, alloc_grid, dealloc_grid + use ice_grid , only: init_grid1, alloc_grid use ice_domain , only: init_domain_blocks use ice_arrays_column , only: alloc_arrays_column use ice_state , only: alloc_state @@ -86,6 +86,7 @@ subroutine cice_init2() use ice_forcing , only: init_snowtable use ice_forcing_bgc , only: get_forcing_bgc, get_atm_bgc use ice_forcing_bgc , only: faero_default, alloc_forcing_bgc, fiso_default + use ice_grid , only: dealloc_grid use ice_history , only: init_hist, accum_hist use ice_restart_shared , only: restart, runtype use ice_init , only: input_data, init_state From 509e2c33e95e3a2370dc406fb2fe4d06192420a6 Mon Sep 17 00:00:00 2001 From: Philippe Blain Date: Thu, 23 Nov 2023 13:09:04 -0500 Subject: [PATCH 46/76] 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. --- cicecore/cicedyn/analysis/ice_history.F90 | 632 ++---------------- .../cicedyn/analysis/ice_history_shared.F90 | 24 +- cicecore/cicedyn/general/ice_flux.F90 | 4 +- 3 files changed, 98 insertions(+), 562 deletions(-) diff --git a/cicecore/cicedyn/analysis/ice_history.F90 b/cicecore/cicedyn/analysis/ice_history.F90 index 6c440cc86..34e5a9131 100644 --- a/cicecore/cicedyn/analysis/ice_history.F90 +++ b/cicecore/cicedyn/analysis/ice_history.F90 @@ -1496,42 +1496,42 @@ subroutine init_hist (dt) call define_hist_field(n_sithick,"sithick","m",tstr2D, tcstr, & "sea ice thickness", & "volume divided by area", c1, c0, & - ns1, f_sithick) + ns1, f_sithick, avg_ice_present=.true., mask_ice_free_points=.true.) call define_hist_field(n_siage,"siage","s",tstr2D, tcstr, & "sea ice age", & "none", c1, c0, & - ns1, f_siage) + ns1, f_siage, avg_ice_present=.true., mask_ice_free_points=.true.) call define_hist_field(n_sisnthick,"sisnthick","m",tstr2D, tcstr, & "sea ice snow thickness", & "snow volume divided by area", c1, c0, & - ns1, f_sisnthick) + ns1, f_sisnthick, avg_ice_present=.true., mask_ice_free_points=.true.) call define_hist_field(n_sitemptop,"sitemptop","K",tstr2D, tcstr, & "sea ice surface temperature", & "none", c1, c0, & - ns1, f_sitemptop) + ns1, f_sitemptop, avg_ice_present=.true., mask_ice_free_points=.true.) call define_hist_field(n_sitempsnic,"sitempsnic","K",tstr2D, tcstr, & "snow ice interface temperature", & "surface temperature when no snow present", c1, c0, & - ns1, f_sitempsnic) + ns1, f_sitempsnic, avg_ice_present=.true., mask_ice_free_points=.true.) call define_hist_field(n_sitempbot,"sitempbot","K",tstr2D, tcstr, & "sea ice bottom temperature", & "none", c1, c0, & - ns1, f_sitempbot) + ns1, f_sitempbot, avg_ice_present=.true., mask_ice_free_points=.true.) call define_hist_field(n_siu,"siu","m/s",ustr2D, ucstr, & "ice x velocity component", & "none", c1, c0, & - ns1, f_siu) + ns1, f_siu, avg_ice_present=.true., mask_ice_free_points=.true.) call define_hist_field(n_siv,"siv","m/s",ustr2D, ucstr, & "ice y velocity component", & "none", c1, c0, & - ns1, f_siv) + ns1, f_siv, avg_ice_present=.true., mask_ice_free_points=.true.) call define_hist_field(n_sidmasstranx,"sidmasstranx","kg/s",ustr2D, ucstr, & "x component of snow and sea ice mass transport", & @@ -1546,32 +1546,32 @@ subroutine init_hist (dt) call define_hist_field(n_sistrxdtop,"sistrxdtop","N m-2",ustr2D, ucstr, & "x component of atmospheric stress on sea ice", & "none", c1, c0, & - ns1, f_sistrxdtop) + ns1, f_sistrxdtop, avg_ice_present=.true., mask_ice_free_points=.true.) call define_hist_field(n_sistrydtop,"sistrydtop","N m-2",ustr2D, ucstr, & "y component of atmospheric stress on sea ice", & "none", c1, c0, & - ns1, f_sistrydtop) + ns1, f_sistrydtop, avg_ice_present=.true., mask_ice_free_points=.true.) call define_hist_field(n_sistrxubot,"sistrxubot","N m-2",ustr2D, ucstr, & "x component of ocean stress on sea ice", & "none", c1, c0, & - ns1, f_sistrxubot) + ns1, f_sistrxubot, avg_ice_present=.true., mask_ice_free_points=.true.) call define_hist_field(n_sistryubot,"sistryubot","N m-2",ustr2D, ucstr, & "y component of ocean stress on sea ice", & "none", c1, c0, & - ns1, f_sistryubot) + ns1, f_sistryubot, avg_ice_present=.true., mask_ice_free_points=.true.) call define_hist_field(n_sicompstren,"sicompstren","N m-1",tstr2D, tcstr, & "compressive sea ice strength", & "none", c1, c0, & - ns1, f_sicompstren) + ns1, f_sicompstren, avg_ice_present=.true., mask_ice_free_points=.true.) call define_hist_field(n_sispeed,"sispeed","m/s",ustr2D, ucstr, & "ice speed", & "none", c1, c0, & - ns1, f_sispeed) + ns1, f_sispeed, avg_ice_present=.true., mask_ice_free_points=.true.) call define_hist_field(n_sidir,"sidir","deg",ustr2D, ucstr, & "ice direction", & @@ -1581,7 +1581,7 @@ subroutine init_hist (dt) call define_hist_field(n_sialb,"sialb","1",tstr2D, tcstr, & "sea ice albedo", & "none", c1, c0, & - ns1, f_sialb) + ns1, f_sialb, avg_ice_present=.true., mask_ice_free_points=.true.) call define_hist_field(n_sihc,"sihc","J m-2",tstr2D, tcstr, & "sea ice heat content", & @@ -1666,117 +1666,117 @@ subroutine init_hist (dt) call define_hist_field(n_siflswdtop,"siflswdtop","W/m2",tstr2D, tcstr, & "down shortwave flux over sea ice", & "positive downward", c1, c0, & - ns1, f_siflswdtop) + ns1, f_siflswdtop, avg_ice_present=.true., mask_ice_free_points=.true.) call define_hist_field(n_siflswutop,"siflswutop","W/m2",tstr2D, tcstr, & "upward shortwave flux over sea ice", & "positive downward", c1, c0, & - ns1, f_siflswutop) + ns1, f_siflswutop, avg_ice_present=.true., mask_ice_free_points=.true.) call define_hist_field(n_siflswdbot,"siflswdbot","W/m2",tstr2D, tcstr, & "down shortwave flux at bottom of ice", & "positive downward", c1, c0, & - ns1, f_siflswdbot) + ns1, f_siflswdbot, avg_ice_present=.true., mask_ice_free_points=.true.) call define_hist_field(n_sifllwdtop,"sifllwdtop","W/m2",tstr2D, tcstr, & "down longwave flux over sea ice", & "positive downward", c1, c0, & - ns1, f_sifllwdtop) + ns1, f_sifllwdtop, avg_ice_present=.true., mask_ice_free_points=.true.) call define_hist_field(n_sifllwutop,"sifllwutop","W/m2",tstr2D, tcstr, & "upward longwave flux over sea ice", & "positive downward", c1, c0, & - ns1, f_sifllwutop) + ns1, f_sifllwutop, avg_ice_present=.true., mask_ice_free_points=.true.) call define_hist_field(n_siflsenstop,"siflsenstop","W/m2",tstr2D, tcstr, & "sensible heat flux over sea ice", & "positive downward", c1, c0, & - ns1, f_siflsenstop) + ns1, f_siflsenstop, avg_ice_present=.true., mask_ice_free_points=.true.) call define_hist_field(n_siflsensupbot,"siflsensupbot","W/m2",tstr2D, tcstr, & "sensible heat flux at bottom of sea ice", & "positive downward", c1, c0, & - ns1, f_siflsensupbot) + ns1, f_siflsensupbot, avg_ice_present=.true., mask_ice_free_points=.true.) call define_hist_field(n_sifllatstop,"sifllatstop","W/m2",tstr2D, tcstr, & "latent heat flux over sea ice", & "positive downward", c1, c0, & - ns1, f_sifllatstop) + ns1, f_sifllatstop, avg_ice_present=.true., mask_ice_free_points=.true.) call define_hist_field(n_siflcondtop,"siflcondtop","W/m2",tstr2D, tcstr, & "conductive heat flux at top of sea ice", & "positive downward", c1, c0, & - ns1, f_siflcondtop) + ns1, f_siflcondtop, avg_ice_present=.true., mask_ice_free_points=.true.) call define_hist_field(n_siflcondbot,"siflcondbot","W/m2",tstr2D, tcstr, & "conductive heat flux at bottom of sea ice", & "positive downward", c1, c0, & - ns1, f_siflcondbot) + ns1, f_siflcondbot, avg_ice_present=.true., mask_ice_free_points=.true.) call define_hist_field(n_sipr,"sipr","kg m-2 s-1",tstr2D, tcstr, & "rainfall over sea ice", & "none", c1, c0, & - ns1, f_sipr) + ns1, f_sipr, avg_ice_present=.true., mask_ice_free_points=.true.) call define_hist_field(n_sifb,"sifb","m",tstr2D, tcstr, & "sea ice freeboard above sea level", & "none", c1, c0, & - ns1, f_sifb) + ns1, f_sifb, avg_ice_present=.true., mask_ice_free_points=.true.) call define_hist_field(n_siflsaltbot,"siflsaltbot","kg m-2 s-1",tstr2D, tcstr, & "salt flux from sea ice", & "positive downward", c1, c0, & - ns1, f_siflsaltbot) + ns1, f_siflsaltbot, avg_ice_present=.true., mask_ice_free_points=.true.) call define_hist_field(n_siflfwbot,"siflfwbot","kg m-2 s-1",tstr2D, tcstr, & "fresh water flux from sea ice", & "positive downward", c1, c0, & - ns1, f_siflfwbot) + ns1, f_siflfwbot, avg_ice_present=.true., mask_ice_free_points=.true.) call define_hist_field(n_siflfwdrain,"siflfwdrain","kg m-2 s-1",tstr2D, tcstr, & "fresh water drainage through sea ice", & "positive downward", c1, c0, & - ns1, f_siflfwdrain) + ns1, f_siflfwdrain, avg_ice_present=.true., mask_ice_free_points=.true.) call define_hist_field(n_sidragtop,"sidragtop","1",tstr2D, tcstr, & "atmospheric drag over sea ice", & "none", c1, c0, & - ns1, f_sidragtop) + ns1, f_sidragtop, avg_ice_present=.true., mask_ice_free_points=.true.) call define_hist_field(n_sirdgthick,"sirdgthick","m",tstr2D, tcstr, & "sea ice ridge thickness", & "vrdg divided by ardg", c1, c0, & - ns1, f_sirdgthick) + ns1, f_sirdgthick, avg_ice_present=.true., mask_ice_free_points=.true.) call define_hist_field(n_siforcetiltx,"siforcetiltx","N m-2",tstr2D, tcstr, & "sea surface tilt term", & "none", c1, c0, & - ns1, f_siforcetiltx) + ns1, f_siforcetiltx, avg_ice_present=.true., mask_ice_free_points=.true.) call define_hist_field(n_siforcetilty,"siforcetilty","N m-2",tstr2D, tcstr, & "sea surface tile term", & "none", c1, c0, & - ns1, f_siforcetilty) + ns1, f_siforcetilty, avg_ice_present=.true., mask_ice_free_points=.true.) call define_hist_field(n_siforcecoriolx,"siforcecoriolx","N m-2",tstr2D, tcstr, & "coriolis term", & "none", c1, c0, & - ns1, f_siforcecoriolx) + ns1, f_siforcecoriolx, avg_ice_present=.true., mask_ice_free_points=.true.) call define_hist_field(n_siforcecorioly,"siforcecorioly","N m-2",tstr2D, tcstr, & "coriolis term", & "none", c1, c0, & - ns1, f_siforcecorioly) + ns1, f_siforcecorioly, avg_ice_present=.true., mask_ice_free_points=.true.) call define_hist_field(n_siforceintstrx,"siforceintstrx","N m-2",tstr2D, tcstr, & "internal stress term", & "none", c1, c0, & - ns1, f_siforceintstrx) + ns1, f_siforceintstrx, avg_ice_present=.true., mask_ice_free_points=.true.) call define_hist_field(n_siforceintstry,"siforceintstry","N m-2",tstr2D, tcstr, & "internal stress term", & "none", c1, c0, & - ns1, f_siforceintstry) + ns1, f_siforceintstry, avg_ice_present=.true., mask_ice_free_points=.true.) call define_hist_field(n_sistreave,"sistreave","N m-1",ustr2D, ucstr, & "average normal stress", & @@ -1866,11 +1866,11 @@ subroutine init_hist (dt) call define_hist_field(n_siitdthick,"siitdthick","m",tstr3Dc, tcstr, & "ice thickness, categories","none", c1, c0, & - ns1, f_siitdthick) + ns1, f_siitdthick, avg_ice_present=.true.) call define_hist_field(n_siitdsnthick,"siitdsnthick","m",tstr3Dc, tcstr, & "snow thickness, categories","none", c1, c0, & - ns1, f_siitdsnthick) + ns1, f_siitdsnthick, avg_ice_present=.true.) endif ! if (histfreq(ns1) /= 'x') then enddo ! ns1 @@ -3654,501 +3654,29 @@ subroutine accum_hist (dt) enddo ! j ! Only average for timesteps when ice present - if (index(avail_hist_fields(n)%vname,'sithick') /= 0) then - if (f_sithick(1:1) /= 'x' .and. n_sithick(ns) /= 0) then - do j = jlo, jhi - do i = ilo, ihi - if (tmask(i,j,iblk)) then - a2D(i,j,n_sithick(ns),iblk) = & - a2D(i,j,n_sithick(ns),iblk)*avgct(ns)*ravgip(i,j) - endif - if (ravgip(i,j) == c0) a2D(i,j,n_sithick(ns),iblk) = spval_dbl - enddo ! i - enddo ! j - endif - endif - if (index(avail_hist_fields(n)%vname,'siage') /= 0) then - if (f_siage(1:1) /= 'x' .and. n_siage(ns) /= 0) then - do j = jlo, jhi - do i = ilo, ihi - if (tmask(i,j,iblk)) then - a2D(i,j,n_siage(ns),iblk) = & - a2D(i,j,n_siage(ns),iblk)*avgct(ns)*ravgip(i,j) - endif - if (ravgip(i,j) == c0) a2D(i,j,n_siage(ns),iblk) = spval_dbl - enddo ! i - enddo ! j - endif - endif - if (index(avail_hist_fields(n)%vname,'sisnthick') /= 0) then - if (f_sisnthick(1:1) /= 'x' .and. n_sisnthick(ns) /= 0) then - do j = jlo, jhi - do i = ilo, ihi - if (tmask(i,j,iblk)) then - a2D(i,j,n_sisnthick(ns),iblk) = & - a2D(i,j,n_sisnthick(ns),iblk)*avgct(ns)*ravgip(i,j) - endif - if (ravgip(i,j) == c0) a2D(i,j,n_sisnthick(ns),iblk) = spval_dbl - enddo ! i - enddo ! j - endif - endif - if (index(avail_hist_fields(n)%vname,'sitemptop') /= 0) then - if (f_sitemptop(1:1) /= 'x' .and. n_sitemptop(ns) /= 0) then - do j = jlo, jhi - do i = ilo, ihi - if (tmask(i,j,iblk)) then - a2D(i,j,n_sitemptop(ns),iblk) = & - a2D(i,j,n_sitemptop(ns),iblk)*avgct(ns)*ravgip(i,j) - endif - if (ravgip(i,j) == c0) a2D(i,j,n_sitemptop(ns),iblk) = spval_dbl - enddo ! i - enddo ! j - endif - endif - if (index(avail_hist_fields(n)%vname,'sitempsnic') /= 0) then - if (f_sitempsnic(1:1) /= 'x' .and. n_sitempsnic(ns) /= 0) then - do j = jlo, jhi - do i = ilo, ihi - if (tmask(i,j,iblk)) then - a2D(i,j,n_sitempsnic(ns),iblk) = & - a2D(i,j,n_sitempsnic(ns),iblk)*avgct(ns)*ravgip(i,j) - endif - if (ravgip(i,j) == c0) a2D(i,j,n_sitempsnic(ns),iblk) = spval_dbl - enddo ! i - enddo ! j - endif - endif - if (index(avail_hist_fields(n)%vname,'sitempbot') /= 0) then - if (f_sitempbot(1:1) /= 'x' .and. n_sitempbot(ns) /= 0) then - do j = jlo, jhi - do i = ilo, ihi - if (tmask(i,j,iblk)) then - a2D(i,j,n_sitempbot(ns),iblk) = & - a2D(i,j,n_sitempbot(ns),iblk)*avgct(ns)*ravgip(i,j) - endif - if (ravgip(i,j) == c0) a2D(i,j,n_sitempbot(ns),iblk) = spval_dbl - enddo ! i - enddo ! j - endif - endif - if (index(avail_hist_fields(n)%vname,'siu') /= 0) then - if (f_siu(1:1) /= 'x' .and. n_siu(ns) /= 0) then - do j = jlo, jhi - do i = ilo, ihi - if (tmask(i,j,iblk)) then - a2D(i,j,n_siu(ns),iblk) = & - a2D(i,j,n_siu(ns),iblk)*avgct(ns)*ravgip(i,j) - endif - if (ravgip(i,j) == c0) a2D(i,j,n_siu(ns),iblk) = spval_dbl - enddo ! i - enddo ! j - endif - endif - if (index(avail_hist_fields(n)%vname,'siv') /= 0) then - if (f_siv(1:1) /= 'x' .and. n_siv(ns) /= 0) then - do j = jlo, jhi - do i = ilo, ihi - if (tmask(i,j,iblk)) then - a2D(i,j,n_siv(ns),iblk) = & - a2D(i,j,n_siv(ns),iblk)*avgct(ns)*ravgip(i,j) - endif - if (ravgip(i,j) == c0) a2D(i,j,n_siv(ns),iblk) = spval_dbl - enddo ! i - enddo ! j - endif - endif - if (index(avail_hist_fields(n)%vname,'sistrxdtop') /= 0) then - if (f_sistrxdtop(1:1) /= 'x' .and. n_sistrxdtop(ns) /= 0) then - do j = jlo, jhi - do i = ilo, ihi - if (tmask(i,j,iblk)) then - a2D(i,j,n_sistrxdtop(ns),iblk) = & - a2D(i,j,n_sistrxdtop(ns),iblk)*avgct(ns)*ravgip(i,j) - endif - if (ravgip(i,j) == c0) a2D(i,j,n_sistrxdtop(ns),iblk) = spval_dbl - enddo ! i - enddo ! j - endif - endif - if (index(avail_hist_fields(n)%vname,'sistrydtop') /= 0) then - if (f_sistrydtop(1:1) /= 'x' .and. n_sistrydtop(ns) /= 0) then - do j = jlo, jhi - do i = ilo, ihi - if (tmask(i,j,iblk)) then - a2D(i,j,n_sistrydtop(ns),iblk) = & - a2D(i,j,n_sistrydtop(ns),iblk)*avgct(ns)*ravgip(i,j) - endif - if (ravgip(i,j) == c0) a2D(i,j,n_sistrydtop(ns),iblk) = spval_dbl - enddo ! i - enddo ! j - endif - endif - if (index(avail_hist_fields(n)%vname,'sistrxubot') /= 0) then - if (f_sistrxubot(1:1) /= 'x' .and. n_sistrxubot(ns) /= 0) then - do j = jlo, jhi - do i = ilo, ihi - if (tmask(i,j,iblk)) then - a2D(i,j,n_sistrxubot(ns),iblk) = & - a2D(i,j,n_sistrxubot(ns),iblk)*avgct(ns)*ravgip(i,j) - endif - if (ravgip(i,j) == c0) a2D(i,j,n_sistrxubot(ns),iblk) = spval_dbl - enddo ! i - enddo ! j - endif - endif - if (index(avail_hist_fields(n)%vname,'sistryubot') /= 0) then - if (f_sistryubot(1:1) /= 'x' .and. n_sistryubot(ns) /= 0) then - do j = jlo, jhi - do i = ilo, ihi - if (tmask(i,j,iblk)) then - a2D(i,j,n_sistryubot(ns),iblk) = & - a2D(i,j,n_sistryubot(ns),iblk)*avgct(ns)*ravgip(i,j) - endif - if (ravgip(i,j) == c0) a2D(i,j,n_sistryubot(ns),iblk) = spval_dbl - enddo ! i - enddo ! j - endif - endif - if (index(avail_hist_fields(n)%vname,'sicompstren') /= 0) then - if (f_sicompstren(1:1) /= 'x' .and. n_sicompstren(ns) /= 0) then - do j = jlo, jhi - do i = ilo, ihi - if (tmask(i,j,iblk)) then - a2D(i,j,n_sicompstren(ns),iblk) = & - a2D(i,j,n_sicompstren(ns),iblk)*avgct(ns)*ravgip(i,j) - endif - if (ravgip(i,j) == c0) a2D(i,j,n_sicompstren(ns),iblk) = spval_dbl - enddo ! i - enddo ! j - endif - endif - if (index(avail_hist_fields(n)%vname,'sispeed') /= 0) then - if (f_sispeed(1:1) /= 'x' .and. n_sispeed(ns) /= 0) then - do j = jlo, jhi - do i = ilo, ihi - if (tmask(i,j,iblk)) then - a2D(i,j,n_sispeed(ns),iblk) = & - a2D(i,j,n_sispeed(ns),iblk)*avgct(ns)*ravgip(i,j) - endif - if (ravgip(i,j) == c0) a2D(i,j,n_sispeed(ns),iblk) = spval_dbl - enddo ! i - enddo ! j - endif + if (avail_hist_fields(n)%avg_ice_present) then + do j = jlo, jhi + do i = ilo, ihi + if (tmask(i,j,iblk)) then + a2D(i,j,n,iblk) = & + a2D(i,j,n,iblk)*avgct(ns)*ravgip(i,j) + endif + ! Mask ice-free points + if (avail_hist_fields(n)%mask_ice_free_points) then + if (ravgip(i,j) == c0) a2D(i,j,n,iblk) = spval_dbl + endif + enddo ! i + enddo ! j endif + + ! CMIP albedo: also mask points below horizon if (index(avail_hist_fields(n)%vname,'sialb') /= 0) then - if (f_sialb(1:1) /= 'x' .and. n_sialb(ns) /= 0) then - do j = jlo, jhi - do i = ilo, ihi - if (tmask(i,j,iblk)) then - a2D(i,j,n_sialb(ns),iblk) = & - a2D(i,j,n_sialb(ns),iblk)*avgct(ns)*ravgip(i,j) - endif - if (ravgip(i,j) == c0) a2D(i,j,n_sialb(ns),iblk) = spval_dbl - if (albcnt(i,j,iblk,ns) <= puny) a2D(i,j,n_sialb(ns),iblk) = spval_dbl - enddo ! i - enddo ! j - endif - endif - if (index(avail_hist_fields(n)%vname,'siflswdtop') /= 0) then - if (f_siflswdtop(1:1) /= 'x' .and. n_siflswdtop(ns) /= 0) then - do j = jlo, jhi - do i = ilo, ihi - if (tmask(i,j,iblk)) then - a2D(i,j,n_siflswdtop(ns),iblk) = & - a2D(i,j,n_siflswdtop(ns),iblk)*avgct(ns)*ravgip(i,j) - endif - if (ravgip(i,j) == c0) a2D(i,j,n_siflswdtop(ns),iblk) = spval_dbl - enddo ! i - enddo ! j - endif - endif - if (index(avail_hist_fields(n)%vname,'siflswutop') /= 0) then - if (f_siflswutop(1:1) /= 'x' .and. n_siflswutop(ns) /= 0) then - do j = jlo, jhi - do i = ilo, ihi - if (tmask(i,j,iblk)) then - a2D(i,j,n_siflswutop(ns),iblk) = & - a2D(i,j,n_siflswutop(ns),iblk)*avgct(ns)*ravgip(i,j) - endif - if (ravgip(i,j) == c0) a2D(i,j,n_siflswutop(ns),iblk) = spval_dbl - enddo ! i - enddo ! j - endif - endif - if (index(avail_hist_fields(n)%vname,'siflswdbot') /= 0) then - if (f_siflswdbot(1:1) /= 'x' .and. n_siflswdbot(ns) /= 0) then - do j = jlo, jhi - do i = ilo, ihi - if (tmask(i,j,iblk)) then - a2D(i,j,n_siflswdbot(ns),iblk) = & - a2D(i,j,n_siflswdbot(ns),iblk)*avgct(ns)*ravgip(i,j) - endif - if (ravgip(i,j) == c0) a2D(i,j,n_siflswdbot(ns),iblk) = spval_dbl - enddo ! i - enddo ! j - endif - endif - if (index(avail_hist_fields(n)%vname,'sifllwdtop') /= 0) then - if (f_sifllwdtop(1:1) /= 'x' .and. n_sifllwdtop(ns) /= 0) then - do j = jlo, jhi - do i = ilo, ihi - if (tmask(i,j,iblk)) then - a2D(i,j,n_sifllwdtop(ns),iblk) = & - a2D(i,j,n_sifllwdtop(ns),iblk)*avgct(ns)*ravgip(i,j) - endif - if (ravgip(i,j) == c0) a2D(i,j,n_sifllwdtop(ns),iblk) = spval_dbl - enddo ! i - enddo ! j - endif - endif - if (index(avail_hist_fields(n)%vname,'sifllwutop') /= 0) then - if (f_sifllwutop(1:1) /= 'x' .and. n_sifllwutop(ns) /= 0) then - do j = jlo, jhi - do i = ilo, ihi - if (tmask(i,j,iblk)) then - a2D(i,j,n_sifllwutop(ns),iblk) = & - a2D(i,j,n_sifllwutop(ns),iblk)*avgct(ns)*ravgip(i,j) - endif - if (ravgip(i,j) == c0) a2D(i,j,n_sifllwutop(ns),iblk) = spval_dbl - enddo ! i - enddo ! j - endif - endif - if (index(avail_hist_fields(n)%vname,'siflsenstop') /= 0) then - if (f_siflsenstop(1:1) /= 'x' .and. n_siflsenstop(ns) /= 0) then - do j = jlo, jhi - do i = ilo, ihi - if (tmask(i,j,iblk)) then - a2D(i,j,n_siflsenstop(ns),iblk) = & - a2D(i,j,n_siflsenstop(ns),iblk)*avgct(ns)*ravgip(i,j) - endif - if (ravgip(i,j) == c0) a2D(i,j,n_siflsenstop(ns),iblk) = spval_dbl - enddo ! i - enddo ! j - endif - endif - if (index(avail_hist_fields(n)%vname,'siflsensupbot') /= 0) then - if (f_siflsensupbot(1:1) /= 'x' .and. n_siflsensupbot(ns) /= 0) then - do j = jlo, jhi - do i = ilo, ihi - if (tmask(i,j,iblk)) then - a2D(i,j,n_siflsensupbot(ns),iblk) = & - a2D(i,j,n_siflsensupbot(ns),iblk)*avgct(ns)*ravgip(i,j) - endif - if (ravgip(i,j) == c0) a2D(i,j,n_siflsensupbot(ns),iblk) = spval_dbl - enddo ! i - enddo ! j - endif - endif - if (index(avail_hist_fields(n)%vname,'sifllatstop') /= 0) then - if (f_sifllatstop(1:1) /= 'x' .and. n_sifllatstop(ns) /= 0) then - do j = jlo, jhi - do i = ilo, ihi - if (tmask(i,j,iblk)) then - a2D(i,j,n_sifllatstop(ns),iblk) = & - a2D(i,j,n_sifllatstop(ns),iblk)*avgct(ns)*ravgip(i,j) - endif - if (ravgip(i,j) == c0) a2D(i,j,n_sifllatstop(ns),iblk) = spval_dbl - enddo ! i - enddo ! j - endif - endif - if (index(avail_hist_fields(n)%vname,'sipr') /= 0) then - if (f_sipr(1:1) /= 'x' .and. n_sipr(ns) /= 0) then - do j = jlo, jhi - do i = ilo, ihi - if (tmask(i,j,iblk)) then - a2D(i,j,n_sipr(ns),iblk) = & - a2D(i,j,n_sipr(ns),iblk)*avgct(ns)*ravgip(i,j) - endif - if (ravgip(i,j) == c0) a2D(i,j,n_sipr(ns),iblk) = spval_dbl - enddo ! i - enddo ! j - endif - endif - if (index(avail_hist_fields(n)%vname,'sifb') /= 0) then - if (f_sifb(1:1) /= 'x' .and. n_sifb(ns) /= 0) then - do j = jlo, jhi - do i = ilo, ihi - if (tmask(i,j,iblk)) then - a2D(i,j,n_sifb(ns),iblk) = & - a2D(i,j,n_sifb(ns),iblk)*avgct(ns)*ravgip(i,j) - endif - if (ravgip(i,j) == c0) a2D(i,j,n_sifb(ns),iblk) = spval_dbl - enddo ! i - enddo ! j - endif - endif - if (index(avail_hist_fields(n)%vname,'siflcondtop') /= 0) then - if (f_siflcondtop(1:1) /= 'x' .and. n_siflcondtop(ns) /= 0) then - do j = jlo, jhi - do i = ilo, ihi - if (tmask(i,j,iblk)) then - a2D(i,j,n_siflcondtop(ns),iblk) = & - a2D(i,j,n_siflcondtop(ns),iblk)*avgct(ns)*ravgip(i,j) - endif - if (ravgip(i,j) == c0) a2D(i,j,n_siflcondtop(ns),iblk) = spval_dbl - enddo ! i - enddo ! j - endif - endif - if (index(avail_hist_fields(n)%vname,'siflcondbot') /= 0) then - if (f_siflcondbot(1:1) /= 'x' .and. n_siflcondbot(ns) /= 0) then - do j = jlo, jhi - do i = ilo, ihi - if (tmask(i,j,iblk)) then - a2D(i,j,n_siflcondbot(ns),iblk) = & - a2D(i,j,n_siflcondbot(ns),iblk)*avgct(ns)*ravgip(i,j) - endif - if (ravgip(i,j) == c0) a2D(i,j,n_siflcondbot(ns),iblk) = spval_dbl - enddo ! i - enddo ! j - endif - endif - if (index(avail_hist_fields(n)%vname,'siflsaltbot') /= 0) then - if (f_siflsaltbot(1:1) /= 'x' .and. n_siflsaltbot(ns) /= 0) then - do j = jlo, jhi - do i = ilo, ihi - if (tmask(i,j,iblk)) then - a2D(i,j,n_siflsaltbot(ns),iblk) = & - a2D(i,j,n_siflsaltbot(ns),iblk)*avgct(ns)*ravgip(i,j) - endif - if (ravgip(i,j) == c0) a2D(i,j,n_siflsaltbot(ns),iblk) = spval_dbl - enddo ! i - enddo ! j - endif - endif - if (index(avail_hist_fields(n)%vname,'siflfwbot') /= 0) then - if (f_siflfwbot(1:1) /= 'x' .and. n_siflfwbot(ns) /= 0) then - do j = jlo, jhi - do i = ilo, ihi - if (tmask(i,j,iblk)) then - a2D(i,j,n_siflfwbot(ns),iblk) = & - a2D(i,j,n_siflfwbot(ns),iblk)*avgct(ns)*ravgip(i,j) - endif - if (ravgip(i,j) == c0) a2D(i,j,n_siflfwbot(ns),iblk) = spval_dbl - enddo ! i - enddo ! j - endif - endif - if (index(avail_hist_fields(n)%vname,'siflfwdrain') /= 0) then - if (f_siflfwdrain(1:1) /= 'x' .and. n_siflfwdrain(ns) /= 0) then - do j = jlo, jhi - do i = ilo, ihi - if (tmask(i,j,iblk)) then - a2D(i,j,n_siflfwdrain(ns),iblk) = & - a2D(i,j,n_siflfwdrain(ns),iblk)*avgct(ns)*ravgip(i,j) - endif - if (ravgip(i,j) == c0) a2D(i,j,n_siflfwdrain(ns),iblk) = spval_dbl - enddo ! i - enddo ! j - endif - endif - if (index(avail_hist_fields(n)%vname,'sidragtop') /= 0) then - if (f_sidragtop(1:1) /= 'x' .and. n_sidragtop(ns) /= 0) then - do j = jlo, jhi - do i = ilo, ihi - if (tmask(i,j,iblk)) then - a2D(i,j,n_sidragtop(ns),iblk) = & - a2D(i,j,n_sidragtop(ns),iblk)*avgct(ns)*ravgip(i,j) - endif - if (ravgip(i,j) == c0) a2D(i,j,n_sidragtop(ns),iblk) = spval_dbl - enddo ! i - enddo ! j - endif - endif - if (index(avail_hist_fields(n)%vname,'sirdgthick') /= 0) then - if (f_sirdgthick(1:1) /= 'x' .and. n_sirdgthick(ns) /= 0) then - do j = jlo, jhi - do i = ilo, ihi - if (tmask(i,j,iblk)) then - a2D(i,j,n_sirdgthick(ns),iblk) = & - a2D(i,j,n_sirdgthick(ns),iblk)*avgct(ns)*ravgip(i,j) - endif - if (ravgip(i,j) == c0) a2D(i,j,n_sirdgthick(ns),iblk) = spval_dbl - enddo ! i - enddo ! j - endif - endif - if (index(avail_hist_fields(n)%vname,'siforcetiltx') /= 0) then - if (f_siforcetiltx(1:1) /= 'x' .and. n_siforcetiltx(ns) /= 0) then - do j = jlo, jhi - do i = ilo, ihi - if (tmask(i,j,iblk)) then - a2D(i,j,n_siforcetiltx(ns),iblk) = & - a2D(i,j,n_siforcetiltx(ns),iblk)*avgct(ns)*ravgip(i,j) - endif - if (ravgip(i,j) == c0) a2D(i,j,n_siforcetiltx(ns),iblk) = spval_dbl - enddo ! i - enddo ! j - endif - endif - if (index(avail_hist_fields(n)%vname,'siforcetilty') /= 0) then - if (f_siforcetilty(1:1) /= 'x' .and. n_siforcetilty(ns) /= 0) then - do j = jlo, jhi - do i = ilo, ihi - if (tmask(i,j,iblk)) then - a2D(i,j,n_siforcetilty(ns),iblk) = & - a2D(i,j,n_siforcetilty(ns),iblk)*avgct(ns)*ravgip(i,j) - endif - if (ravgip(i,j) == c0) a2D(i,j,n_siforcetilty(ns),iblk) = spval_dbl - enddo ! i - enddo ! j - endif - endif - if (index(avail_hist_fields(n)%vname,'siforcecoriolx') /= 0) then - if (f_siforcecoriolx(1:1) /= 'x' .and. n_siforcecoriolx(ns) /= 0) then - do j = jlo, jhi - do i = ilo, ihi - if (tmask(i,j,iblk)) then - a2D(i,j,n_siforcecoriolx(ns),iblk) = & - a2D(i,j,n_siforcecoriolx(ns),iblk)*avgct(ns)*ravgip(i,j) - endif - if (ravgip(i,j) == c0) a2D(i,j,n_siforcecoriolx(ns),iblk) = spval_dbl - enddo ! i - enddo ! j - endif - endif - if (index(avail_hist_fields(n)%vname,'siforcecorioly') /= 0) then - if (f_siforcecorioly(1:1) /= 'x' .and. n_siforcecorioly(ns) /= 0) then - do j = jlo, jhi - do i = ilo, ihi - if (tmask(i,j,iblk)) then - a2D(i,j,n_siforcecorioly(ns),iblk) = & - a2D(i,j,n_siforcecorioly(ns),iblk)*avgct(ns)*ravgip(i,j) - endif - if (ravgip(i,j) == c0) a2D(i,j,n_siforcecorioly(ns),iblk) = spval_dbl - enddo ! i - enddo ! j - endif - endif - if (index(avail_hist_fields(n)%vname,'siforceintstrx') /= 0) then - if (f_siforceintstrx(1:1) /= 'x' .and. n_siforceintstrx(ns) /= 0) then - do j = jlo, jhi - do i = ilo, ihi - if (tmask(i,j,iblk)) then - a2D(i,j,n_siforceintstrx(ns),iblk) = & - a2D(i,j,n_siforceintstrx(ns),iblk)*avgct(ns)*ravgip(i,j) - endif - if (ravgip(i,j) == c0) a2D(i,j,n_siforceintstrx(ns),iblk) = spval_dbl - enddo ! i - enddo ! j - endif - endif - if (index(avail_hist_fields(n)%vname,'siforceintstry') /= 0) then - if (f_siforceintstry(1:1) /= 'x' .and. n_siforceintstry(ns) /= 0) then - do j = jlo, jhi - do i = ilo, ihi - if (tmask(i,j,iblk)) then - a2D(i,j,n_siforceintstry(ns),iblk) = & - a2D(i,j,n_siforceintstry(ns),iblk)*avgct(ns)*ravgip(i,j) - endif - if (ravgip(i,j) == c0) a2D(i,j,n_siforceintstry(ns),iblk) = spval_dbl - enddo ! i - enddo ! j - endif - endif + do j = jlo, jhi + do i = ilo, ihi + if (albcnt(i,j,iblk,ns) <= puny) a2D(i,j,n,iblk) = spval_dbl + enddo ! i + enddo ! j + endif ! back out albedo/zenith angle dependence if (avail_hist_fields(n)%vname(1:6) == 'albice') then @@ -4259,33 +3787,17 @@ subroutine accum_hist (dt) enddo ! i enddo ! j enddo ! k - if (index(avail_hist_fields(nn)%vname,'siitdthick') /= 0) then - if (f_siitdthick(1:1) /= 'x' .and. n_siitdthick(ns)-n2D /= 0) then - do k = 1, ncat_hist - do j = jlo, jhi - do i = ilo, ihi - if (tmask(i,j,iblk)) then - a3Dc(i,j,k,n_siitdthick(ns)-n2D,iblk) = & - a3Dc(i,j,k,n_siitdthick(ns)-n2D,iblk)*avgct(ns)*ravgipn(i,j,k) - endif - enddo ! i - enddo ! j - enddo ! k - endif - endif - if (index(avail_hist_fields(nn)%vname,'siitdsnthick') /= 0) then - if (f_siitdsnthick(1:1) /= 'x' .and. n_siitdsnthick(ns)-n2D /= 0) then - do k = 1, ncat_hist - do j = jlo, jhi - do i = ilo, ihi - if (tmask(i,j,iblk)) then - a3Dc(i,j,k,n_siitdsnthick(ns)-n2D,iblk) = & - a3Dc(i,j,k,n_siitdsnthick(ns)-n2D,iblk)*avgct(ns)*ravgipn(i,j,k) - endif - enddo ! i - enddo ! j - enddo ! k - endif + if (avail_hist_fields(nn)%avg_ice_present) then + do k = 1, ncat_hist + do j = jlo, jhi + do i = ilo, ihi + if (tmask(i,j,iblk)) then + a3Dc(i,j,k,n,iblk) = & + a3Dc(i,j,k,n,iblk)*avgct(ns)*ravgipn(i,j,k) + endif + enddo ! i + enddo ! j + enddo ! k endif endif diff --git a/cicecore/cicedyn/analysis/ice_history_shared.F90 b/cicecore/cicedyn/analysis/ice_history_shared.F90 index 3c31f23ca..6d4850119 100644 --- a/cicecore/cicedyn/analysis/ice_history_shared.F90 +++ b/cicecore/cicedyn/analysis/ice_history_shared.F90 @@ -81,6 +81,8 @@ module ice_history_shared real (kind=dbl_kind) :: conb ! additive conversion factor character (len=1) :: vhistfreq ! frequency of history output integer (kind=int_kind) :: vhistfreq_n ! number of vhistfreq intervals + logical (kind=log_kind) :: avg_ice_present ! only average where ice is present + logical (kind=log_kind) :: mask_ice_free_points ! mask ice-free points end type integer (kind=int_kind), parameter, public :: & @@ -811,7 +813,7 @@ end subroutine construct_filename subroutine define_hist_field(id, vname, vunit, vcoord, vcellmeas, & vdesc, vcomment, cona, conb, & - ns, vhistfreq) + ns, vhistfreq, avg_ice_present, mask_ice_free_points) use ice_calendar, only: histfreq, histfreq_n @@ -837,14 +839,28 @@ subroutine define_hist_field(id, vname, vunit, vcoord, vcellmeas, & integer (kind=int_kind), intent(in) :: & ns ! history file stream index + logical (kind=log_kind), optional, intent(in) :: & + avg_ice_present , & ! compute average only when ice is present + mask_ice_free_points ! mask ice-free points + integer (kind=int_kind) :: & ns1 , & ! variable stream loop index lenf ! length of namelist string character (len=40) :: stmp + logical (kind=log_kind) :: & + l_avg_ice_present , & ! compute average only when ice is present + l_mask_ice_free_points ! mask ice-free points + character(len=*), parameter :: subname = '(define_hist_field)' + l_avg_ice_present = .false. + l_mask_ice_free_points = .false. + + if(present(avg_ice_present)) l_avg_ice_present = avg_ice_present + if(present(mask_ice_free_points)) l_mask_ice_free_points = mask_ice_free_points + if (histfreq(ns) == 'x') then call abort_ice(subname//'ERROR: define_hist_fields has histfreq x') endif @@ -855,6 +871,10 @@ subroutine define_hist_field(id, vname, vunit, vcoord, vcellmeas, & do ns1 = 1, lenf if (vhistfreq(ns1:ns1) == histfreq(ns)) then + if (ns1 > 1 .and. index(vhistfreq(1:ns1-1),'x') /= 0) then + call abort_ice(subname//'ERROR: history frequency variable f_' // vname // ' can''t contain ''x'' along with active frequencies') + endif + num_avail_hist_fields_tot = num_avail_hist_fields_tot + 1 if (vcoord(11:14) == 'time') then @@ -917,6 +937,8 @@ subroutine define_hist_field(id, vname, vunit, vcoord, vcellmeas, & avail_hist_fields(id(ns))%conb = conb avail_hist_fields(id(ns))%vhistfreq = vhistfreq(ns1:ns1) avail_hist_fields(id(ns))%vhistfreq_n = histfreq_n(ns) + avail_hist_fields(id(ns))%avg_ice_present = l_avg_ice_present + avail_hist_fields(id(ns))%mask_ice_free_points = l_mask_ice_free_points endif enddo diff --git a/cicecore/cicedyn/general/ice_flux.F90 b/cicecore/cicedyn/general/ice_flux.F90 index 0fffa06b3..4c37a0696 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 + use ice_state, only: aice, vice, trcr, strength, divu, shear use ice_grid, only: grid_ice logical (kind=log_kind) :: & @@ -1041,6 +1041,8 @@ subroutine init_history_dyn sig1 (:,:,:) = c0 sig2 (:,:,:) = c0 + divu (:,:,:) = c0 + shear (:,:,:) = c0 taubxU (:,:,:) = c0 taubyU (:,:,:) = c0 strength (:,:,:) = c0 From 21fab166fd2b8e903df366dbc1c518dabd08c23f Mon Sep 17 00:00:00 2001 From: Tony Craig Date: Tue, 28 Nov 2023 10:04:36 -0800 Subject: [PATCH 47/76] 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 --- .../unittest/opticep/ice_init_column.F90 | 2 + .../drivers/unittest/opticep/ice_step_mod.F90 | 3 +- doc/source/developer_guide/dg_about.rst | 50 +++++++++++ doc/source/developer_guide/dg_dynamics.rst | 79 ----------------- doc/source/developer_guide/dg_infra.rst | 84 +++++++++++++++++++ doc/source/developer_guide/index.rst | 1 + doc/source/user_guide/ug_implementation.rst | 4 +- icepack | 2 +- 8 files changed, 142 insertions(+), 83 deletions(-) create mode 100644 doc/source/developer_guide/dg_infra.rst diff --git a/cicecore/drivers/unittest/opticep/ice_init_column.F90 b/cicecore/drivers/unittest/opticep/ice_init_column.F90 index cb9b93df1..a55338556 100644 --- a/cicecore/drivers/unittest/opticep/ice_init_column.F90 +++ b/cicecore/drivers/unittest/opticep/ice_init_column.F90 @@ -1593,6 +1593,8 @@ subroutine input_zbgc write(nu_diag,1005) ' phi_snow = ', phi_snow endif write(nu_diag,1010) ' solve_zsal (deprecated) = ', solve_zsal + write(nu_diag,* ) ' WARNING: zsalinity has been deprecated. Namelists and interfaces' + write(nu_diag,* ) ' will be removed in a future version' write(nu_diag,1010) ' skl_bgc = ', skl_bgc write(nu_diag,1010) ' restart_bgc = ', restart_bgc diff --git a/cicecore/drivers/unittest/opticep/ice_step_mod.F90 b/cicecore/drivers/unittest/opticep/ice_step_mod.F90 index 5b85cb7bf..370fde6be 100644 --- a/cicecore/drivers/unittest/opticep/ice_step_mod.F90 +++ b/cicecore/drivers/unittest/opticep/ice_step_mod.F90 @@ -618,7 +618,7 @@ subroutine step_therm2 (dt, iblk) use ice_calendar, only: yday use ice_domain_size, only: ncat, nilyr, nslyr, nblyr, nfsd use ice_flux, only: fresh, frain, fpond, frzmlt, frazil, frz_onset, & - update_ocn_f, fsalt, Tf, sss, salinz, fhocn, rside, fside, wlat, & + fsalt, Tf, sss, salinz, fhocn, rside, fside, wlat, & meltl, frazil_diag use ice_flux_bgc, only: flux_bio, faero_ocn, & fiso_ocn, HDO_ocn, H2_16O_ocn, H2_18O_ocn @@ -709,7 +709,6 @@ subroutine step_therm2 (dt, iblk) fresh = fresh (i,j, iblk), & fsalt = fsalt (i,j, iblk), & fhocn = fhocn (i,j, iblk), & - update_ocn_f = update_ocn_f, & bgrid = bgrid, & cgrid = cgrid, & igrid = igrid, & diff --git a/doc/source/developer_guide/dg_about.rst b/doc/source/developer_guide/dg_about.rst index 37318b2c5..95645d45d 100644 --- a/doc/source/developer_guide/dg_about.rst +++ b/doc/source/developer_guide/dg_about.rst @@ -25,3 +25,53 @@ There is extensive Information for Developers documentation available. See http - Software development practices guide - git Workflow Guide - including extensive information about the Pull Request process and requirements - Documentation Workflow Guide + + +Coding Standard +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +Overall, CICE code should be implemented as follows, + + * Adhere to the current coding and naming conventions + + * Write readable code. Use meaningful variable names; indent 2 or 3 spaces for loops and conditionals; vertically align similar elements where it makes sense, and provide concise comments throughout the code. + + * Declare common parameters in a shared module. Do not hardwire the same parameter in the code in multiple places. + + * Maintain bit-for-bit output for the default configuration (to the extent possible). Use namelist options to add new features. + + * Maintain global conservation of heat, water, salt + + * Use of C preprocessor (CPP) directives should be minimized and only used for build dependent modifications such as use of netcdf (or other "optional" libraries) or for various Fortran features that may not be supported by some compilers. Use namelist to support run-time code options. CPPs should be all caps. + + * All modules should have the following set at the top + + .. code-block:: fortran + + implicit none + private + + 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 + + .. code-block:: fortran + + character(len=*),parameter :: subname='(advance_timestep)' + + * Public Icepack interfaces should be accessed thru the icepack_intfc module like + + .. code-block:: fortran + + use icepack_intfc, only: icepack_init_parameters + + * Icepack does not write to output or abort, it provides methods to access those features. After each call to Icepack, **icepack_warnings_flush** should be called to flush Icepack output to the CICE log file and **icepack_warnings_aborted** should be check to abort on an Icepack error as follows, + + .. code-block:: fortran + + call icepack_physics() + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, file=__FILE__, line=__LINE__) + + * 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_dynamics.rst b/doc/source/developer_guide/dg_dynamics.rst index 1f1430e71..2c886a95f 100644 --- a/doc/source/developer_guide/dg_dynamics.rst +++ b/doc/source/developer_guide/dg_dynamics.rst @@ -46,82 +46,3 @@ upwind and remap. These are set in namelist via the ``advection`` variable. Transport can be disabled with the ``ktransport`` namelist variable. -Infrastructure -======================= - -Kinds ------------------- - -**cicecore/shared/ice_kinds_mod.F90** defines the kinds datatypes used in CICE. These kinds are -used throughout CICE code to define variable types. The CICE kinds are adopted from the kinds -defined in Icepack for consistency in interfaces. - -Constants ------------------- - -**cicecore/shared/ice_constants.F90** defines several model constants. Some are hardwired parameters -while others have internal defaults and can be set thru namelist. - -Dynamic Array Allocation -------------------------------- - -CICE v5 and earlier was implemented using mainly static arrays and required several CPPs to be set to define grid size, -blocks sizes, tracer numbers, and so forth. With CICE v6 and later, arrays are dynamically allocated and those -parameters are namelist settings. The following CPPs are no longer used in CICE v6 and later versions, - - -DNXGLOB=100 -DNYGLOB=116 -DBLCKX=25 -DBLCKY=29 -DMXBLCKS=4 -DNICELYR=7 -DNSNWLYR=1 -DNICECAT=5 -DTRAGE=1 -DTRFY=1 -DTRLVL=1 -DTRPND=1 -DTRBRI=0 -DNTRAERO=1 -DTRZS=0 -DNBGCLYR=7 -DTRALG=0 -DTRBGCZ=0 -DTRDOC=0 -DTRDOC=0 -DTRDIC=0 -DTRDON=0 -DTRFED=0 -DTRFEP=0 -DTRZAERO=0 -DTRBGCS=0 -DNUMIN=11 -DNUMAX=99 - -as they have been migrated to :ref:`tabnamelist` - - nx_global, ny_global, block_size_x, block_size_y, max_blocks, nilyr, nslyr, ncat, nblyr, n_aero, n_zaero, n_algae, n_doc, n_dic, n_don, n_fed, n_fep, numin, numax - - -Time Manager ------------------- - -Time manager data is module data in **cicecore/shared/ice_calendar.F90**. Much of the time manager -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` - - - -Communication ------------------- - -Two low-level communications packages, mpi and serial, are provided as part of CICE. This software -provides a middle layer between the model and the underlying libraries. Only the CICE mpi or -serial directories are compiled with CICE, not both. - -**cicedyn/infrastructure/comm/mpi/** -is based on MPI and provides various methods to do halo updates, global sums, gather/scatter, broadcasts -and similar using some fairly generic interfaces to isolate the MPI calls in the code. - -**cicedyn/infrastructure/comm/serial/** support the same interfaces, but operates -in shared memory mode with no MPI. The serial library will be used, by default in the CICE scripts, -if the number of MPI tasks is set to 1. The serial library allows the model to be run on a single -core or with OpenMP parallelism only without requiring an MPI library. - -I/O ------------------- - -There are three low-level IO packages in CICE, io_netcdf, io_binary, and io_pio. This software -provides a middle layer between the model and the underlying IO writing. -Only one of the three IO directories can be built with CICE. The CICE scripts will build with the io_netcdf -by default, but other options can be selecting by setting ``ICE_IOTYPE`` in **cice.settings** in the -case. This has to be set before CICE is built. - -**cicedyn/infrastructure/io/io_netcdf/** is the -default for the standalone CICE model, and it supports writing history and restart files in netcdf -format using standard netcdf calls. It does this by writing from and reading to the root task and -gathering and scattering fields from the root task to support model parallelism. - -**cicedyn/infrastructure/io/io_binary/** supports files in binary format using a gather/scatter -approach and reading to and writing from the root task. - -**cicedyn/infrastructure/io/io_pio/** support reading and writing through the pio interface. pio -is a parallel io library (https://github.com/NCAR/ParallelIO) that supports reading and writing of -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. diff --git a/doc/source/developer_guide/dg_infra.rst b/doc/source/developer_guide/dg_infra.rst new file mode 100644 index 000000000..c38e2c16d --- /dev/null +++ b/doc/source/developer_guide/dg_infra.rst @@ -0,0 +1,84 @@ +:tocdepth: 3 + +.. _dev_infra: + + +Infrastructure +======================= + +Kinds +------------------ + +**cicecore/shared/ice_kinds_mod.F90** defines the kinds datatypes used in CICE. These kinds are +used throughout CICE code to define variable types. The CICE kinds are adopted from the kinds +defined in Icepack for consistency in interfaces. + +Constants +------------------ + +**cicecore/shared/ice_constants.F90** defines several model constants. Some are hardwired parameters +while others have internal defaults and can be set thru namelist. + +Dynamic Array Allocation +------------------------------- + +CICE v5 and earlier was implemented using mainly static arrays and required several CPPs to be set to define grid size, +blocks sizes, tracer numbers, and so forth. With CICE v6 and later, arrays are dynamically allocated and those +parameters are namelist settings. The following CPPs are no longer used in CICE v6 and later versions, + + -DNXGLOB=100 -DNYGLOB=116 -DBLCKX=25 -DBLCKY=29 -DMXBLCKS=4 -DNICELYR=7 -DNSNWLYR=1 -DNICECAT=5 -DTRAGE=1 -DTRFY=1 -DTRLVL=1 -DTRPND=1 -DTRBRI=0 -DNTRAERO=1 -DTRZS=0 -DNBGCLYR=7 -DTRALG=0 -DTRBGCZ=0 -DTRDOC=0 -DTRDOC=0 -DTRDIC=0 -DTRDON=0 -DTRFED=0 -DTRFEP=0 -DTRZAERO=0 -DTRBGCS=0 -DNUMIN=11 -DNUMAX=99 + +as they have been migrated to :ref:`tabnamelist` + + nx_global, ny_global, block_size_x, block_size_y, max_blocks, nilyr, nslyr, ncat, nblyr, n_aero, n_zaero, n_algae, n_doc, n_dic, n_don, n_fed, n_fep, numin, numax + + +Time Manager +------------------ + +Time manager data is module data in **cicecore/shared/ice_calendar.F90**. Much of the time manager +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` + + + +Communication +------------------ + +Two low-level communications packages, mpi and serial, are provided as part of CICE. This software +provides a middle layer between the model and the underlying libraries. Only the CICE mpi or +serial directories are compiled with CICE, not both. + +**cicedyn/infrastructure/comm/mpi/** +is based on MPI and provides various methods to do halo updates, global sums, gather/scatter, broadcasts +and similar using some fairly generic interfaces to isolate the MPI calls in the code. + +**cicedyn/infrastructure/comm/serial/** support the same interfaces, but operates +in shared memory mode with no MPI. The serial library will be used, by default in the CICE scripts, +if the number of MPI tasks is set to 1. The serial library allows the model to be run on a single +core or with OpenMP parallelism only without requiring an MPI library. + +I/O +------------------ + +There are three low-level IO packages in CICE, io_netcdf, io_binary, and io_pio. This software +provides a middle layer between the model and the underlying IO writing. +Only one of the three IO directories can be built with CICE. The CICE scripts will build with the io_netcdf +by default, but other options can be selecting by setting ``ICE_IOTYPE`` in **cice.settings** in the +case. This has to be set before CICE is built. + +**cicedyn/infrastructure/io/io_netcdf/** is the +default for the standalone CICE model, and it supports writing history and restart files in netcdf +format using standard netcdf calls. It does this by writing from and reading to the root task and +gathering and scattering fields from the root task to support model parallelism. + +**cicedyn/infrastructure/io/io_binary/** supports files in binary format using a gather/scatter +approach and reading to and writing from the root task. + +**cicedyn/infrastructure/io/io_pio/** support reading and writing through the pio interface. pio +is a parallel io library (https://github.com/NCAR/ParallelIO) that supports reading and writing of +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. diff --git a/doc/source/developer_guide/index.rst b/doc/source/developer_guide/index.rst index 6fc3356f4..680746beb 100644 --- a/doc/source/developer_guide/index.rst +++ b/doc/source/developer_guide/index.rst @@ -13,6 +13,7 @@ Developer Guide dg_about.rst dg_dynamics.rst + dg_infra.rst dg_driver.rst dg_forcing.rst dg_icepack.rst diff --git a/doc/source/user_guide/ug_implementation.rst b/doc/source/user_guide/ug_implementation.rst index ab1d2fcc3..af246ccff 100644 --- a/doc/source/user_guide/ug_implementation.rst +++ b/doc/source/user_guide/ug_implementation.rst @@ -192,7 +192,9 @@ recommend that the user choose the local domains so that the global domain is evenly divided, if this is not possible then the furthest east and/or north blocks will contain nonphysical points (“padding”). These points are excluded from the computation domain and have little effect -on model performance. +on model performance. ``nghost`` is a hardcoded parameter in **ice_blocks.F90**. +While the halo code has been implemented to support arbitrary sized halos, +``nghost`` is set to 1 and has not been formally tested on larger halos. .. _fig-grid: diff --git a/icepack b/icepack index d1a42fb14..f6ff8f7c4 160000 --- a/icepack +++ b/icepack @@ -1 +1 @@ -Subproject commit d1a42fb142033ca8c82a3f440ed38c63d992a314 +Subproject commit f6ff8f7c4d4cb6feabe3651b13204cf43fc948e3 From b14cedfaed8b81500fc5422cfc44b6d80e5893ef Mon Sep 17 00:00:00 2001 From: "David A. Bailey" Date: Tue, 28 Nov 2023 15:10:16 -0700 Subject: [PATCH 48/76] 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 --- cicecore/cicedyn/analysis/ice_history_shared.F90 | 7 ++++--- cicecore/cicedyn/general/ice_init.F90 | 6 +++++- configuration/scripts/ice_in | 1 + doc/source/cice_index.rst | 1 + doc/source/user_guide/ug_case_settings.rst | 1 + doc/source/user_guide/ug_implementation.rst | 9 ++++++--- 6 files changed, 18 insertions(+), 7 deletions(-) diff --git a/cicecore/cicedyn/analysis/ice_history_shared.F90 b/cicecore/cicedyn/analysis/ice_history_shared.F90 index 6d4850119..16a153c93 100644 --- a/cicecore/cicedyn/analysis/ice_history_shared.F90 +++ b/cicecore/cicedyn/analysis/ice_history_shared.F90 @@ -57,6 +57,9 @@ module ice_history_shared character (len=char_len), public :: & history_format + character (len=char_len), public :: & + hist_suffix(max_nstrm) ! appended to 'h' in filename when not 'x' + !--------------------------------------------------------------- ! Instructions for adding a field: (search for 'example') ! Here or in ice_history_[process].F90: @@ -763,9 +766,7 @@ subroutine construct_filename(ncfile,suffix,ns) endif cstream = '' -!echmod ! this was implemented for CESM but it breaks post-processing software -!echmod ! of other groups (including RASM which uses CESMCOUPLED) -!echmod if (ns > 1) write(cstream,'(i1.1)') ns-1 + if (hist_suffix(ns) /= 'x') cstream = hist_suffix(ns) if (hist_avg(ns)) then ! write averaged data if (histfreq(ns) == '1' .and. histfreq_n(ns) == 1) then ! timestep diff --git a/cicecore/cicedyn/general/ice_init.F90 b/cicecore/cicedyn/general/ice_init.F90 index 75c5a03cf..8875c7a29 100644 --- a/cicecore/cicedyn/general/ice_init.F90 +++ b/cicecore/cicedyn/general/ice_init.F90 @@ -79,7 +79,7 @@ subroutine input_data 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, & + 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 use ice_flux, only: update_ocn_f, cpl_frazil, l_mpond_fresh @@ -188,6 +188,7 @@ subroutine input_data hist_time_axis, & print_global, print_points, latpnt, lonpnt, & debug_forcing, histfreq, histfreq_n, hist_avg, & + hist_suffix, & history_dir, history_file, history_precision, cpl_bgc, & histfreq_base, dumpfreq_base, timer_stats, memory_stats, & conserv_check, debug_model, debug_model_step, & @@ -324,6 +325,7 @@ subroutine input_data histfreq_n(:) = 1 ! output frequency 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 hist_time_axis = 'end' ! History file time axis averaging interval position @@ -911,6 +913,7 @@ subroutine input_data call broadcast_scalar(histfreq_base(n), master_task) call broadcast_scalar(dumpfreq(n), master_task) call broadcast_scalar(dumpfreq_base(n), master_task) + call broadcast_scalar(hist_suffix(n), master_task) enddo call broadcast_array(hist_avg, master_task) call broadcast_array(histfreq_n, master_task) @@ -2355,6 +2358,7 @@ subroutine input_data 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,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 diff --git a/configuration/scripts/ice_in b/configuration/scripts/ice_in index a1bbea26a..85f502683 100644 --- a/configuration/scripts/ice_in +++ b/configuration/scripts/ice_in @@ -49,6 +49,7 @@ histfreq_n = 1 , 1 , 1 , 1 , 1 histfreq_base = 'zero','zero','zero','zero','zero' hist_avg = .true.,.true.,.true.,.true.,.true. + hist_suffix = 'x','x','x','x','x' history_dir = './history/' history_file = 'iceh' history_precision = 4 diff --git a/doc/source/cice_index.rst b/doc/source/cice_index.rst index bf5533d46..dae10eda4 100644 --- a/doc/source/cice_index.rst +++ b/doc/source/cice_index.rst @@ -325,6 +325,7 @@ section :ref:`tabnamelist`. "history_format", "history file format", "" "history_precision", "history output precision: 4 or 8 byte", "4" "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)", "" "hmix", "ocean mixed layer depth", "20. m" "hour", "hour of the year", "" diff --git a/doc/source/user_guide/ug_case_settings.rst b/doc/source/user_guide/ug_case_settings.rst index a3e6166aa..fd808fd8f 100644 --- a/doc/source/user_guide/ug_case_settings.rst +++ b/doc/source/user_guide/ug_case_settings.rst @@ -198,6 +198,7 @@ setup_nml "``history_format``", "``default``", "read/write history files in default format", "``default``" "", "``pio_pnetcdf``", "read/write restart files with pnetcdf in pio", "" "``history_precision``", "integer", "history file precision: 4 or 8 byte", "4" + "``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``" "", "``internal``", "initial conditions set based on ice\_data\_type,conc,dist inputs", "" diff --git a/doc/source/user_guide/ug_implementation.rst b/doc/source/user_guide/ug_implementation.rst index af246ccff..a67fc3a58 100644 --- a/doc/source/user_guide/ug_implementation.rst +++ b/doc/source/user_guide/ug_implementation.rst @@ -1158,8 +1158,11 @@ 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 array and is customizable by stream. The data is -written at the period(s) given by ``histfreq`` and +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". + +The data 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 @@ -1199,7 +1202,7 @@ is a character string corresponding to ``histfreq`` or ‘x’ for none. files, no matter what the frequency is.) If there are no namelist flags with a given ``histfreq`` value, or if an element of ``histfreq_n`` is 0, then no file will be written at that frequency. The output period can be -discerned from the filenames. Each history stream will be either instantaneous +discerned from the filenames or the ``hist_suffix`` can be used. Each history stream will be either instantaneous or averaged as specified by the corresponding entry in the ``hist_avg`` namelist array, and the frequency will be relative to a reference date specified by the corresponding entry in ``histfreq_base``. More information about how the frequency is From 37f9a98b1b6529bc957fb888bd00348ab61c8b32 Mon Sep 17 00:00:00 2001 From: Tony Craig Date: Thu, 21 Dec 2023 07:15:02 -0800 Subject: [PATCH 49/76] 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. --- .github/workflows/test-cice.yml | 1 - .../comm/mpi/ice_global_reductions.F90 | 45 +++++++++++-------- .../comm/serial/ice_global_reductions.F90 | 45 +++++++++++-------- .../scripts/machines/Macros.conda_macos | 3 +- configuration/scripts/tests/gridsys_suite.ts | 6 +-- 5 files changed, 59 insertions(+), 41 deletions(-) diff --git a/.github/workflows/test-cice.yml b/.github/workflows/test-cice.yml index b04ca1714..160485d04 100644 --- a/.github/workflows/test-cice.yml +++ b/.github/workflows/test-cice.yml @@ -147,7 +147,6 @@ jobs: run: | cd $HOME/cice-dirs/input wget --progress=dot:giga https://zenodo.org/record/3728358/files/CICE_data_gx3_grid_ic-20200320.tar.gz && tar xvfz CICE_data_gx3_grid_ic-20200320.tar.gz - wget --progress=dot:giga https://zenodo.org/record/3728362/files/CICE_data_gx3_forcing_NCAR_bulk-20200320.tar.gz && tar xvfz CICE_data_gx3_forcing_NCAR_bulk-20200320.tar.gz wget --progress=dot:giga https://zenodo.org/record/3728364/files/CICE_data_gx3_forcing_JRA55-20200320.tar.gz && tar xvfz CICE_data_gx3_forcing_JRA55-20200320.tar.gz pwd ls -alR 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/configuration/scripts/machines/Macros.conda_macos b/configuration/scripts/machines/Macros.conda_macos index fad87507c..191e10d7d 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 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 From 1314e17b4213c6ce9424eab80763edf4b2ae867f Mon Sep 17 00:00:00 2001 From: TRasmussen <33480590+TillRasmussen@users.noreply.github.com> Date: Thu, 11 Jan 2024 18:25:52 +0100 Subject: [PATCH 50/76] 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 --- cicecore/cicedyn/dynamics/ice_dyn_eap.F90 | 4 +- cicecore/cicedyn/dynamics/ice_dyn_evp.F90 | 53 ++++++- cicecore/cicedyn/dynamics/ice_dyn_shared.F90 | 86 ++++++++++- cicecore/cicedyn/dynamics/ice_dyn_vp.F90 | 26 ++-- .../cicedyn/dynamics/ice_transport_remap.F90 | 141 ++++-------------- cicecore/cicedyn/infrastructure/ice_grid.F90 | 99 ------------ 6 files changed, 165 insertions(+), 244 deletions(-) diff --git a/cicecore/cicedyn/dynamics/ice_dyn_eap.F90 b/cicecore/cicedyn/dynamics/ice_dyn_eap.F90 index e240fc8f1..a8ac62797 100644 --- a/cicecore/cicedyn/dynamics/ice_dyn_eap.F90 +++ b/cicecore/cicedyn/dynamics/ice_dyn_eap.F90 @@ -109,7 +109,7 @@ subroutine eap (dt) seabed_stress_factor_LKD, seabed_stress_factor_prob, & seabed_stress_method, seabed_stress, & stack_fields, unstack_fields, iceTmask, iceUmask, & - fld2, fld3, fld4 + fld2, fld3, fld4, dxhy, dyhx, cxp, cyp, cxm, cym use ice_flux, only: rdg_conv, strairxT, strairyT, & strairxU, strairyU, uocn, vocn, ss_tltx, ss_tlty, fmU, & strtltxU, strtltyU, strocnxU, strocnyU, strintxU, strintyU, taubxU, taubyU, & @@ -118,7 +118,7 @@ subroutine eap (dt) stressp_1, stressp_2, stressp_3, stressp_4, & stressm_1, stressm_2, stressm_3, stressm_4, & stress12_1, stress12_2, stress12_3, stress12_4 - use ice_grid, only: tmask, umask, dxT, dyT, dxhy, dyhx, cxp, cyp, cxm, cym, & + use ice_grid, only: tmask, umask, dxT, dyT, & tarear, uarear, grid_average_X2Y, & grid_atm_dynu, grid_atm_dynv, grid_ocn_dynu, grid_ocn_dynv use ice_state, only: aice, aiU, vice, vsno, uvel, vvel, divu, shear, & diff --git a/cicecore/cicedyn/dynamics/ice_dyn_evp.F90 b/cicecore/cicedyn/dynamics/ice_dyn_evp.F90 index ee832e447..6a71d6a14 100644 --- a/cicecore/cicedyn/dynamics/ice_dyn_evp.F90 +++ b/cicecore/cicedyn/dynamics/ice_dyn_evp.F90 @@ -84,6 +84,12 @@ module ice_dyn_evp emass (:,:,:) , & ! total mass of ice and snow (E grid) emassdti (:,:,:) ! mass of E-cell/dte (kg/m^2 s) + 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 + real (kind=dbl_kind), allocatable :: & strengthU(:,:,:) , & ! strength averaged to U points divergU (:,:,:) , & ! div array on U points, differentiate from divu @@ -119,9 +125,10 @@ module ice_dyn_evp ! Elastic-viscous-plastic dynamics driver ! subroutine init_evp - use ice_blocks, only: nx_block, ny_block, nghost - use ice_domain_size, only: max_blocks, nx_global, ny_global - use ice_grid, only: grid_ice, dyT, dxT, uarear, tmask, G_HTE, G_HTN + use ice_blocks, only: get_block, nx_block, ny_block, nghost, block + use ice_domain_size, only: max_blocks + use ice_domain, only: nblocks, blocks_ice + use ice_grid, only: grid_ice, dyT, dxT, uarear, tmask, G_HTE, G_HTN, dxN, dyE use ice_calendar, only: dt_dyn use ice_dyn_shared, only: init_dyn_shared, evp_algorithm use ice_dyn_evp1d, only: dyn_evp1d_init @@ -131,6 +138,14 @@ subroutine init_evp character(len=*), parameter :: subname = '(init_evp)' + type (block) :: & + this_block ! block information for current block + + integer (kind=int_kind) :: & + i, j, iblk , & ! block index + ilo,ihi,jlo,jhi ! beginning and end of physical domain + + call init_dyn_shared(dt_dyn) if (evp_algorithm == "shared_mem_1d" ) then @@ -197,6 +212,32 @@ subroutine init_evp stat=ierr) if (ierr/=0) call abort_ice(subname//' ERROR: Out of memory E evp') + 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 memory ratio') + + !$OMP PARALLEL DO PRIVATE(iblk,i,j,ilo,ihi,jlo,jhi,this_block) + 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 + 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 + enddo ! iblk + !$OMP END PARALLEL DO + endif end subroutine init_evp @@ -219,7 +260,7 @@ subroutine evp (dt) ice_HaloDestroy, ice_HaloUpdate_stress use ice_blocks, only: block, get_block, nx_block, ny_block, nghost use ice_domain, only: nblocks, blocks_ice, halo_info, maskhalo_dyn - use ice_domain_size, only: max_blocks, ncat, nx_global, ny_global + use ice_domain_size, only: max_blocks, ncat use ice_flux, only: rdg_conv, rdg_shear, strairxT, strairyT, & strairxU, strairyU, uocn, vocn, ss_tltx, ss_tlty, fmU, & strtltxU, strtltyU, strocnxU, strocnyU, strintxU, strintyU, taubxU, taubyU, & @@ -238,8 +279,6 @@ subroutine evp (dt) stresspU, stressmU, stress12U use ice_grid, only: tmask, umask, umaskCD, nmask, emask, uvm, epm, npm, & dxE, dxN, dxT, dxU, dyE, dyN, dyT, dyU, & - ratiodxN, ratiodxNr, ratiodyE, ratiodyEr, & - dxhy, dyhx, cxp, cyp, cxm, cym, & tarear, uarear, earear, narear, grid_average_X2Y, uarea, & grid_type, grid_ice, & grid_atm_dynu, grid_atm_dynv, grid_ocn_dynu, grid_ocn_dynv @@ -250,7 +289,7 @@ subroutine evp (dt) ice_timer_start, ice_timer_stop, timer_evp use ice_dyn_shared, only: evp_algorithm, stack_fields, unstack_fields, & DminTarea, visc_method, deformations, deformationsC_T, deformationsCD_T, & - strain_rates_U, & + strain_rates_U, dxhy, dyhx, cxp, cyp, cxm, cym, & iceTmask, iceUmask, iceEmask, iceNmask, & dyn_haloUpdate, fld2, fld3, fld4 use ice_dyn_evp1d, only: dyn_evp1d_run diff --git a/cicecore/cicedyn/dynamics/ice_dyn_shared.F90 b/cicecore/cicedyn/dynamics/ice_dyn_shared.F90 index 9dbeaf1a7..d3f819f20 100644 --- a/cicecore/cicedyn/dynamics/ice_dyn_shared.F90 +++ b/cicecore/cicedyn/dynamics/ice_dyn_shared.F90 @@ -11,7 +11,7 @@ module ice_dyn_shared use ice_kinds_mod use ice_communicate, only: my_task, master_task, get_num_procs - use ice_constants, only: c0, c1, c2, c3, c4, c6 + use ice_constants, only: c0, c1, c2, c3, c4, c6, c1p5 use ice_constants, only: omega, spval_dbl, p01, p001, p5 use ice_blocks, only: nx_block, ny_block use ice_domain_size, only: max_blocks @@ -119,6 +119,14 @@ module ice_dyn_shared real (kind=dbl_kind), allocatable, public :: & DminTarea(:,:,:) ! deltamin * tarea (m^2/s) + 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)) + ! ice isotropic tensile strength parameter real (kind=dbl_kind), public :: & Ktens ! T=Ktens*P (tensile strength: see Konig and Holland, 2010) @@ -192,6 +200,22 @@ subroutine alloc_dyn_shared stat=ierr) if (ierr/=0) call abort_ice(subname//': Out of memory') + allocate( & + 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 + stat=ierr) + if (ierr/=0) call abort_ice(subname//': Out of memory') + + if (grid_ice == 'B' .and. evp_algorithm == "standard_2d") then + allocate( & + dxhy(nx_block,ny_block,max_blocks), & ! 0.5*(HTE - HTW) + dyhx(nx_block,ny_block,max_blocks), & ! 0.5*(HTN - HTS) + stat=ierr) + if (ierr/=0) call abort_ice(subname//': Out of memory') + endif + if (grid_ice == 'CD' .or. grid_ice == 'C') then allocate( & uvelE_init (nx_block,ny_block,max_blocks), & ! x-component of velocity (m/s), beginning of timestep @@ -214,8 +238,9 @@ end subroutine alloc_dyn_shared subroutine init_dyn_shared (dt) - use ice_blocks, only: nx_block, ny_block - use ice_domain, only: nblocks, halo_dynbundle + use ice_blocks, only: block, get_block + use ice_boundary, only: ice_halo, ice_haloUpdate + use ice_domain, only: nblocks, halo_dynbundle, blocks_ice, halo_info use ice_domain_size, only: max_blocks use ice_flux, only: & stressp_1, stressp_2, stressp_3, stressp_4, & @@ -224,7 +249,8 @@ subroutine init_dyn_shared (dt) stresspT, stressmT, stress12T, & stresspU, stressmU, stress12U use ice_state, only: uvel, vvel, uvelE, vvelE, uvelN, vvelN - use ice_grid, only: ULAT, NLAT, ELAT, tarea + use ice_grid, only: ULAT, NLAT, ELAT, tarea, HTE, HTN + use ice_constants, only: field_loc_center, field_type_vector real (kind=dbl_kind), intent(in) :: & dt ! time step @@ -232,9 +258,13 @@ subroutine init_dyn_shared (dt) ! local variables integer (kind=int_kind) :: & - i, j , & ! indices - nprocs, & ! number of processors - iblk ! block index + i, j , & ! indices + ilo, ihi, jlo, jhi, & !min and max index for interior of blocks + nprocs, & ! number of processors + iblk ! block index + + type (block) :: & + this_block ! block information for current block character(len=*), parameter :: subname = '(init_dyn_shared)' @@ -333,6 +363,48 @@ subroutine init_dyn_shared (dt) enddo ! iblk !$OMP END PARALLEL DO + if (grid_ice == 'B' .and. evp_algorithm == "standard_2d") then + 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 + 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 + enddo + + 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) + + endif + + 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+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 + enddo + end subroutine init_dyn_shared !======================================================================= diff --git a/cicecore/cicedyn/dynamics/ice_dyn_vp.F90 b/cicecore/cicedyn/dynamics/ice_dyn_vp.F90 index 58589f8d7..477d19515 100644 --- a/cicecore/cicedyn/dynamics/ice_dyn_vp.F90 +++ b/cicecore/cicedyn/dynamics/ice_dyn_vp.F90 @@ -52,7 +52,7 @@ module ice_dyn_vp use ice_fileunits, only: nu_diag use ice_flux, only: fmU use ice_global_reductions, only: global_sum - use ice_grid, only: dxT, dyT, dxhy, dyhx, cxp, cyp, cxm, cym, uarear + use ice_grid, only: dxT, dyT, uarear use ice_exit, only: abort_ice use icepack_intfc, only: icepack_warnings_flush, icepack_warnings_aborted use icepack_intfc, only: icepack_ice_strength, icepack_query_parameters @@ -120,19 +120,9 @@ subroutine init_vp use ice_boundary, only: ice_HaloUpdate use ice_constants, only: c1, & field_loc_center, field_type_scalar - use ice_domain, only: blocks_ice, halo_info + use ice_domain, only: blocks_ice use ice_calendar, only: dt_dyn use ice_dyn_shared, only: init_dyn_shared -! use ice_grid, only: tarea - - ! local variables - - integer (kind=int_kind) :: & - i, j, iblk, & - ilo,ihi,jlo,jhi ! beginning and end of physical domain - - type (block) :: & - this_block ! block information for current block call init_dyn_shared(dt_dyn) @@ -167,7 +157,8 @@ subroutine implicit_solver (dt) use ice_blocks, only: block, get_block, nx_block, ny_block use ice_domain, only: blocks_ice, halo_info, maskhalo_dyn use ice_domain_size, only: max_blocks, ncat - use ice_dyn_shared, only: deformations, iceTmask, iceUmask + use ice_dyn_shared, only: deformations, iceTmask, iceUmask, & + cxp, cyp, cxm, cym use ice_flux, only: rdg_conv, rdg_shear, strairxT, strairyT, & strairxU, strairyU, uocn, vocn, ss_tltx, ss_tlty, fmU, & strtltxU, strtltyU, strocnxU, strocnyU, strintxU, strintyU, taubxU, taubyU, & @@ -176,7 +167,7 @@ subroutine implicit_solver (dt) stressp_1, stressp_2, stressp_3, stressp_4, & stressm_1, stressm_2, stressm_3, stressm_4, & stress12_1, stress12_2, stress12_3, stress12_4 - use ice_grid, only: tmask, umask, dxT, dyT, cxp, cyp, cxm, cym, & + use ice_grid, only: tmask, umask, dxT, dyT, & tarear, grid_type, grid_average_X2Y, & grid_atm_dynu, grid_atm_dynv, grid_ocn_dynu, grid_ocn_dynv use ice_state, only: aice, aiU, vice, vsno, uvel, vvel, divu, shear, & @@ -686,9 +677,8 @@ subroutine anderson_solver (icellT , icellU , & use ice_domain, only: maskhalo_dyn, halo_info use ice_domain_size, only: max_blocks use ice_flux, only: fmU, TbU - use ice_grid, only: dxT, dyT, dxhy, dyhx, cxp, cyp, cxm, cym, & - uarear - use ice_dyn_shared, only: DminTarea + use ice_grid, only: dxT, dyT, uarear + use ice_dyn_shared, only: DminTarea, dxhy, dyhx, cxp, cyp, cxm, cym use ice_state, only: uvel, vvel, strength use ice_timers, only: ice_timer_start, ice_timer_stop, timer_bound @@ -2753,6 +2743,7 @@ subroutine fgmres (zetax2 , etax2 , & use ice_boundary, only: ice_HaloUpdate use ice_domain, only: maskhalo_dyn, halo_info use ice_timers, only: ice_timer_start, ice_timer_stop, timer_bound + use ice_dyn_shared, only: dxhy, dyhx, cxp, cyp, cxm, cym real (kind=dbl_kind), dimension(nx_block,ny_block,max_blocks,4), intent(in) :: & zetax2 , & ! zetax2 = 2*zeta (bulk viscosity) @@ -3154,6 +3145,7 @@ subroutine pgmres (zetax2 , etax2 , & use ice_boundary, only: ice_HaloUpdate use ice_domain, only: maskhalo_dyn, halo_info use ice_timers, only: ice_timer_start, ice_timer_stop, timer_bound + use ice_dyn_shared, only: dyhx, dxhy, cxp, cyp, cxm, cym real (kind=dbl_kind), dimension(nx_block,ny_block,max_blocks,4), intent(in) :: & zetax2 , & ! zetax2 = 2*zeta (bulk viscosity) diff --git a/cicecore/cicedyn/dynamics/ice_transport_remap.F90 b/cicecore/cicedyn/dynamics/ice_transport_remap.F90 index dd59efc87..11521a0fa 100644 --- a/cicecore/cicedyn/dynamics/ice_transport_remap.F90 +++ b/cicecore/cicedyn/dynamics/ice_transport_remap.F90 @@ -25,6 +25,7 @@ ! can be specified (following an idea of Mats Bentsen) ! 2010: ECH removed unnecessary grid arrays and optional arguments from ! horizontal_remap +! 2023: TAR, DMI Remove commented code and unnecessary arrays module ice_transport_remap @@ -253,52 +254,15 @@ module ice_transport_remap ! ! Grid quantities used by the remapping transport scheme ! -! Note: the arrays xyav, xxxav, etc are not needed for rectangular grids -! but may be needed in the future for other nonuniform grids. They have -! been commented out here to save memory and flops. +! Note: Arrays needed for nonuniform grids has been deleted. +! They can be found in version 6.5 and earlier ! ! author William H. Lipscomb, LANL subroutine init_remap - use ice_domain, only: nblocks - use ice_grid, only: xav, yav, xxav, yyav -! dxT, dyT, xyav, & -! xxxav, xxyav, xyyav, yyyav - - integer (kind=int_kind) :: & - i, j, iblk ! standard indices - character(len=*), parameter :: subname = '(init_remap)' - ! Compute grid cell average geometric quantities on the scaled - ! rectangular grid with dx = 1, dy = 1. - ! - ! Note: On a rectangular grid, the integral of any odd function - ! of x or y = 0. - - !$OMP PARALLEL DO PRIVATE(iblk,i,j) SCHEDULE(runtime) - do iblk = 1, nblocks - do j = 1, ny_block - do i = 1, nx_block - xav(i,j,iblk) = c0 - yav(i,j,iblk) = c0 -!!! These formulas would be used on a rectangular grid -!!! with dimensions (dxT, dyT): -!!! xxav(i,j,iblk) = dxT(i,j,iblk)**2 / c12 -!!! yyav(i,j,iblk) = dyT(i,j,iblk)**2 / c12 - xxav(i,j,iblk) = c1/c12 - yyav(i,j,iblk) = c1/c12 -! xyav(i,j,iblk) = c0 -! xxxav(i,j,iblk) = c0 -! xxyav(i,j,iblk) = c0 -! xyyav(i,j,iblk) = c0 -! yyyav(i,j,iblk) = c0 - enddo - enddo - enddo - !$OMP END PARALLEL DO - !------------------------------------------------------------------- ! Set logical l_fixed_area depending of the grid type. ! @@ -356,9 +320,7 @@ subroutine horizontal_remap (dt, ntrace, & use ice_domain, only: nblocks, blocks_ice, halo_info, maskhalo_remap use ice_blocks, only: block, get_block, nghost use ice_grid, only: HTE, HTN, dxu, dyu, & - earea, narea, tarear, hm, & - xav, yav, xxav, yyav -! xyav, xxxav, xxyav, xyyav, yyyav + earea, narea, tarear, hm use ice_timers, only: ice_timer_start, ice_timer_stop, timer_bound real (kind=dbl_kind), intent(in) :: & @@ -519,12 +481,7 @@ subroutine horizontal_remap (dt, ntrace, & tracer_type, depend, & has_dependents, icellsnc(0,iblk), & indxinc(:,0), indxjnc(:,0), & - hm (:,:,iblk), xav (:,:,iblk), & - yav (:,:,iblk), xxav (:,:,iblk), & - yyav (:,:,iblk), & -! xyav (:,:,iblk), & -! xxxav (:,:,iblk), xxyav (:,:,iblk), & -! xyyav (:,:,iblk), yyyav (:,:,iblk), & + hm (:,:,iblk), & mm (:,:,0,iblk), mc (:,:,0,iblk), & mx (:,:,0,iblk), my (:,:,0,iblk), & mmask(:,:,0) ) @@ -539,12 +496,7 @@ subroutine horizontal_remap (dt, ntrace, & tracer_type, depend, & has_dependents, icellsnc (n,iblk), & indxinc (:,n), indxjnc(:,n), & - hm (:,:,iblk), xav (:,:,iblk), & - yav (:,:,iblk), xxav (:,:,iblk), & - yyav (:,:,iblk), & -! xyav (:,:,iblk), & -! xxxav (:,:,iblk), xxyav (:,:,iblk), & -! xyyav (:,:,iblk), yyyav (:,:,iblk), & + hm (:,:,iblk), & mm (:,:,n,iblk), mc (:,:,n,iblk), & mx (:,:,n,iblk), my (:,:,n,iblk), & mmask (:,:,n), & @@ -1052,12 +1004,7 @@ subroutine construct_fields (nx_block, ny_block, & tracer_type, depend, & has_dependents, icells, & indxi, indxj, & - hm, xav, & - yav, xxav, & - yyav, & -! xyav, & -! xxxav, xxyav, & -! xyyav, yyyav, & + hm, & mm, mc, & mx, my, & mmask, & @@ -1084,11 +1031,7 @@ subroutine construct_fields (nx_block, ny_block, & indxj real (kind=dbl_kind), dimension (nx_block,ny_block), intent(in) :: & - hm , & ! land/boundary mask, thickness (T-cell) - xav, yav , & ! mean T-cell values of x, y - xxav, yyav ! mean T-cell values of xx, yy -! xyav, , & ! mean T-cell values of xy -! xxxav,xxyav,xyyav,yyyav ! mean T-cell values of xxx, xxy, xyy, yyy + hm ! land/boundary mask, thickness (T-cell) real (kind=dbl_kind), dimension (nx_block,ny_block), intent(in) :: & mm , & ! mean value of mass field @@ -1114,16 +1057,21 @@ subroutine construct_fields (nx_block, ny_block, & ij ! combined i/j horizontal index real (kind=dbl_kind), dimension (nx_block,ny_block) :: & + xav , & ! mean T-cell values of x + yav , & ! mean T-cell values of y mxav , & ! x coordinate of center of mass myav ! y coordinate of center of mass + real (kind=dbl_kind), parameter :: xxav=c1/c12 ! mean T-cell values of xx + real (kind=dbl_kind), parameter :: yyav=c1/c12 ! mean T-cell values of yy + real (kind=dbl_kind), dimension (nx_block,ny_block,ntrace) :: & mtxav , & ! x coordinate of center of mass*tracer mtyav ! y coordinate of center of mass*tracer real (kind=dbl_kind) :: & puny, & - w1, w2, w3, w7 ! work variables + w2, w3, w7 ! work variables character(len=*), parameter :: subname = '(construct_fields)' @@ -1177,9 +1125,11 @@ subroutine construct_fields (nx_block, ny_block, & do j = 1, ny_block do i = 1, nx_block - mc(i,j) = c0 - mx(i,j) = c0 - my(i,j) = c0 + xav(i,j) = c0 + yav(i,j) = c0 + mc(i,j) = c0 + mx(i,j) = c0 + my(i,j) = c0 mxav(i,j) = c0 myav(i,j) = c0 enddo @@ -1213,12 +1163,8 @@ subroutine construct_fields (nx_block, ny_block, & j = indxj(ij) ! mass field at geometric center - ! echmod: xav = yav = 0 mc(i,j) = mm(i,j) -! mc(i,j) = mm(i,j) - xav(i,j)*mx(i,j) & -! - yav(i,j)*my(i,j) - enddo ! ij ! tracers @@ -1230,18 +1176,10 @@ subroutine construct_fields (nx_block, ny_block, & j = indxj(ij) ! center of mass (mxav,myav) for each cell - ! echmod: xyav = 0 - mxav(i,j) = (mx(i,j)*xxav(i,j) & - + mc(i,j)*xav (i,j)) / mm(i,j) - myav(i,j) = (my(i,j)*yyav(i,j) & - + mc(i,j)*yav(i,j)) / mm(i,j) - -! mxav(i,j) = (mx(i,j)*xxav(i,j) & -! + my(i,j)*xyav(i,j) & -! + mc(i,j)*xav (i,j)) / mm(i,j) -! myav(i,j) = (mx(i,j)*xyav(i,j) & -! + my(i,j)*yyav(i,j) & -! + mc(i,j)*yav(i,j)) / mm(i,j) + + mxav(i,j) = mx(i,j)*xxav / mm(i,j) + myav(i,j) = my(i,j)*yyav / mm(i,j) + enddo do nt = 1, ntrace @@ -1276,30 +1214,14 @@ subroutine construct_fields (nx_block, ny_block, & if (tmask(i,j,nt) > 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/infrastructure/ice_grid.F90 b/cicecore/cicedyn/infrastructure/ice_grid.F90 index ef2db8a11..1cc3540ca 100644 --- a/cicecore/cicedyn/infrastructure/ice_grid.F90 +++ b/cicecore/cicedyn/infrastructure/ice_grid.F90 @@ -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,16 +222,6 @@ 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 @@ -288,23 +244,9 @@ 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 (save_ghte_ghtn) then if (my_task == master_task) then allocate( & @@ -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, & @@ -1353,12 +1260,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 From a20bfddf7a1260dbb61241e0838c678d2eecf972 Mon Sep 17 00:00:00 2001 From: "David A. Bailey" Date: Thu, 11 Jan 2024 11:07:36 -0700 Subject: [PATCH 51/76] scamn bugfix for nuopc driver (#926) Co-authored-by: John Truesdale --- .../drivers/nuopc/cmeps/ice_import_export.F90 | 78 +++++++++++-------- 1 file changed, 44 insertions(+), 34 deletions(-) diff --git a/cicecore/drivers/nuopc/cmeps/ice_import_export.F90 b/cicecore/drivers/nuopc/cmeps/ice_import_export.F90 index a932e0b2b..2c7da8d0b 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) From 6449f40c41aa1a5c00096696202d7bd7ebd2a69a Mon Sep 17 00:00:00 2001 From: JFLemieux73 <31927797+JFLemieux73@users.noreply.github.com> Date: Thu, 11 Jan 2024 19:17:20 +0000 Subject: [PATCH 52/76] 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 --- cicecore/cicedyn/analysis/ice_history.F90 | 20 ++++++++++--- .../cicedyn/analysis/ice_history_shared.F90 | 9 +++--- cicecore/cicedyn/dynamics/ice_dyn_eap.F90 | 20 +++++++++++-- cicecore/cicedyn/dynamics/ice_dyn_evp.F90 | 10 ++++--- cicecore/cicedyn/dynamics/ice_dyn_shared.F90 | 28 +++++++++++++++++-- cicecore/cicedyn/dynamics/ice_dyn_vp.F90 | 7 +++-- cicecore/cicedyn/general/ice_flux.F90 | 3 +- cicecore/cicedyn/general/ice_state.F90 | 2 ++ .../io/io_binary/ice_history_write.F90 | 1 + .../io/io_netcdf/ice_history_write.F90 | 1 + .../io/io_pio2/ice_history_write.F90 | 1 + configuration/scripts/ice_in | 1 + configuration/scripts/options/set_nml.histall | 1 + configuration/scripts/options/set_nml.histdbg | 1 + doc/source/cice_index.rst | 1 + 15 files changed, 85 insertions(+), 21 deletions(-) diff --git a/cicecore/cicedyn/analysis/ice_history.F90 b/cicecore/cicedyn/analysis/ice_history.F90 index 34e5a9131..0243d9861 100644 --- a/cicecore/cicedyn/analysis/ice_history.F90 +++ b/cicecore/cicedyn/analysis/ice_history.F90 @@ -3,7 +3,8 @@ ! ! The following variables are currently hard-wired as snapshots ! (instantaneous rather than time-averages): -! divu, shear, sig1, sig2, sigP, trsig, mlt_onset, frz_onset, hisnap, aisnap +! divu, shear, vort, sig1, sig2, sigP, trsig, mlt_onset, +! frz_onset, hisnap, aisnap ! ! Options for histfreq: '1','h','d','m','y','x', where x means that ! output stream will not be used (recommended for efficiency). @@ -597,6 +598,7 @@ subroutine init_hist (dt) call broadcast_scalar (f_strength, master_task) call broadcast_scalar (f_divu, master_task) call broadcast_scalar (f_shear, master_task) + call broadcast_scalar (f_vort, master_task) call broadcast_scalar (f_sig1, master_task) call broadcast_scalar (f_sig2, master_task) call broadcast_scalar (f_sigP, master_task) @@ -1312,14 +1314,19 @@ subroutine init_hist (dt) call define_hist_field(n_divu,"divu","%/day",tstr2D, tcstr, & "strain rate (divergence)", & - "none", secday*c100, c0, & + "divu is instantaneous, on T grid", secday*c100, c0, & ns1, f_divu) call define_hist_field(n_shear,"shear","%/day",tstr2D, tcstr, & "strain rate (shear)", & - "none", secday*c100, c0, & + "shear is instantaneous, on T grid", secday*c100, c0, & ns1, f_shear) + call define_hist_field(n_vort,"vort","%/day",tstr2D, tcstr, & + "strain rate (vorticity)", & + "vort is instantaneous, on T grid", secday*c100, c0, & + ns1, f_vort) + select case (grid_ice) case('B') description = ", on U grid (NE corner values)" @@ -2623,7 +2630,7 @@ subroutine accum_hist (dt) if (f_strength(1:1)/= 'x') & call accum_hist_field(n_strength,iblk, strength(:,:,iblk), a2D) -! The following fields (divu, shear, sig1, and sig2) will be smeared +! The following fields (divu, shear, vort, sig1, and sig2) will be smeared ! if averaged over more than a few days. ! Snapshots may be more useful (see below). @@ -2631,6 +2638,8 @@ subroutine accum_hist (dt) ! call accum_hist_field(n_divu, iblk, divu(:,:,iblk), a2D) ! if (f_shear (1:1) /= 'x') & ! call accum_hist_field(n_shear, iblk, shear(:,:,iblk), a2D) +! if (f_vort (1:1) /= 'x') & +! call accum_hist_field(n_vort, iblk, vort(:,:,iblk), a2D) ! if (f_sig1 (1:1) /= 'x') & ! call accum_hist_field(n_sig1, iblk, sig1(:,:,iblk), a2D) ! if (f_sig2 (1:1) /= 'x') & @@ -3967,6 +3976,7 @@ subroutine accum_hist (dt) if (.not. tmask(i,j,iblk)) then ! mask out land points if (n_divu (ns) /= 0) a2D(i,j,n_divu(ns), iblk) = spval_dbl if (n_shear (ns) /= 0) a2D(i,j,n_shear(ns), iblk) = spval_dbl + if (n_vort (ns) /= 0) a2D(i,j,n_vort(ns), iblk) = spval_dbl if (n_sig1 (ns) /= 0) a2D(i,j,n_sig1(ns), iblk) = spval_dbl if (n_sig2 (ns) /= 0) a2D(i,j,n_sig2(ns), iblk) = spval_dbl if (n_sigP (ns) /= 0) a2D(i,j,n_sigP(ns), iblk) = spval_dbl @@ -3996,6 +4006,8 @@ subroutine accum_hist (dt) divu (i,j,iblk)*avail_hist_fields(n_divu(ns))%cona if (n_shear (ns) /= 0) a2D(i,j,n_shear(ns),iblk) = & shear(i,j,iblk)*avail_hist_fields(n_shear(ns))%cona + if (n_vort (ns) /= 0) a2D(i,j,n_vort(ns),iblk) = & + vort(i,j,iblk)*avail_hist_fields(n_vort(ns))%cona if (n_sig1 (ns) /= 0) a2D(i,j,n_sig1(ns),iblk) = & sig1 (i,j,iblk)*avail_hist_fields(n_sig1(ns))%cona if (n_sig2 (ns) /= 0) a2D(i,j,n_sig2(ns),iblk) = & diff --git a/cicecore/cicedyn/analysis/ice_history_shared.F90 b/cicecore/cicedyn/analysis/ice_history_shared.F90 index 16a153c93..2c64bb021 100644 --- a/cicecore/cicedyn/analysis/ice_history_shared.F90 +++ b/cicecore/cicedyn/analysis/ice_history_shared.F90 @@ -4,7 +4,8 @@ ! ! The following variables are currently hard-wired as snapshots ! (instantaneous rather than time-averages): -! divu, shear, sig1, sig2, sigP, trsig, mlt_onset, frz_onset, hisnap, aisnap +! divu, shear, vort, sig1, sig2, sigP, trsig, mlt_onset, +! frz_onset, hisnap, aisnap ! ! Options for histfreq: '1','h','d','m','y','x', where x means that ! output stream will not be used (recommended for efficiency). @@ -267,7 +268,7 @@ module ice_history_shared f_strocnxE = 'x', f_strocnyE = 'x', & f_strintxE = 'x', f_strintyE = 'x', & f_taubxE = 'x', f_taubyE = 'x', & - f_strength = 'm', & + f_strength = 'm', f_vort = 'm', & f_divu = 'm', f_shear = 'm', & f_sig1 = 'm', f_sig2 = 'm', & f_sigP = 'm', & @@ -434,7 +435,7 @@ module ice_history_shared ! f_strocnxE, f_strocnyE , & ! f_strintxE, f_strintyE , & ! f_taubxE, f_taubyE , & - f_strength, & + f_strength, f_vort , & f_divu, f_shear , & f_sig1, f_sig2 , & f_sigP, & @@ -626,7 +627,7 @@ module ice_history_shared n_strocnxE , n_strocnyE , & n_strintxE , n_strintyE , & n_taubxE , n_taubyE , & - n_strength , & + n_strength , n_vort , & n_divu , n_shear , & n_sig1 , n_sig2 , & n_sigP , & diff --git a/cicecore/cicedyn/dynamics/ice_dyn_eap.F90 b/cicecore/cicedyn/dynamics/ice_dyn_eap.F90 index a8ac62797..cc85d8ab6 100644 --- a/cicecore/cicedyn/dynamics/ice_dyn_eap.F90 +++ b/cicecore/cicedyn/dynamics/ice_dyn_eap.F90 @@ -118,10 +118,10 @@ subroutine eap (dt) stressp_1, stressp_2, stressp_3, stressp_4, & stressm_1, stressm_2, stressm_3, stressm_4, & stress12_1, stress12_2, stress12_3, stress12_4 - use ice_grid, only: tmask, umask, dxT, dyT, & + use ice_grid, only: tmask, umask, dxT, dyT, dxU, dyU, & tarear, uarear, grid_average_X2Y, & grid_atm_dynu, grid_atm_dynv, grid_ocn_dynu, grid_ocn_dynv - use ice_state, only: aice, aiU, vice, vsno, uvel, vvel, divu, shear, & + use ice_state, only: aice, aiU, vice, vsno, uvel, vvel, divu, shear, vort, & aice_init, aice0, aicen, vicen, strength use ice_timers, only: timer_dynamics, timer_bound, & ice_timer_start, ice_timer_stop @@ -195,6 +195,7 @@ subroutine eap (dt) rdg_shear(i,j,iblk) = c0 ! always zero. Could be moved divu (i,j,iblk) = c0 shear(i,j,iblk) = c0 + vort(i,j,iblk) = c0 e11(i,j,iblk) = c0 e12(i,j,iblk) = c0 e22(i,j,iblk) = c0 @@ -433,6 +434,7 @@ subroutine eap (dt) arlx1i, denom1, & uvel (:,:,iblk), vvel (:,:,iblk), & dxT (:,:,iblk), dyT (:,:,iblk), & + dxU (:,:,iblk), dyU (:,:,iblk), & dxhy (:,:,iblk), dyhx (:,:,iblk), & cxp (:,:,iblk), cyp (:,:,iblk), & cxm (:,:,iblk), cym (:,:,iblk), & @@ -448,6 +450,7 @@ subroutine eap (dt) stress12_1(:,:,iblk), stress12_2(:,:,iblk), & stress12_3(:,:,iblk), stress12_4(:,:,iblk), & shear (:,:,iblk), divu (:,:,iblk), & + vort (:,:,iblk), & e11 (:,:,iblk), e12 (:,:,iblk), & e22 (:,:,iblk), & s11 (:,:,iblk), s12 (:,:,iblk), & @@ -1162,6 +1165,7 @@ subroutine stress_eap (nx_block, ny_block, & arlx1i, denom1, & uvel, vvel, & dxT, dyT, & + dxU, dyU, & dxhy, dyhx, & cxp, cyp, & cxm, cym, & @@ -1175,6 +1179,7 @@ subroutine stress_eap (nx_block, ny_block, & stress12_1, stress12_2, & stress12_3, stress12_4, & shear, divu, & + vort, & e11, e12, & e22, & s11, s12, & @@ -1206,6 +1211,8 @@ subroutine stress_eap (nx_block, ny_block, & vvel , & ! y-component of velocity (m/s) dxT , & ! width of T-cell through the middle (m) dyT , & ! height of T-cell through the middle (m) + dxU , & ! width of U-cell through the middle (m) + dyU , & ! height of U-cell through the middle (m) dxhy , & ! 0.5*(HTE - HTW) dyhx , & ! 0.5*(HTN - HTS) cyp , & ! 1.5*HTE - 0.5*HTW @@ -1226,6 +1233,7 @@ subroutine stress_eap (nx_block, ny_block, & real (kind=dbl_kind), dimension (nx_block,ny_block), intent(inout) :: & shear , & ! strain rate II component (1/s) divu , & ! strain rate I component, velocity divergence (1/s) + vort , & ! vorticity (1/s) e11 , & ! components of strain rate tensor (1/s) e12 , & ! e22 , & ! @@ -1255,6 +1263,7 @@ subroutine stress_eap (nx_block, ny_block, & divune, divunw, divuse, divusw , & ! divergence tensionne, tensionnw, tensionse, tensionsw, & ! tension shearne, shearnw, shearse, shearsw , & ! shearing + dvdxn, dvdxs, dudye, dudyw , & ! for vorticity calc ssigpn, ssigps, ssigpe, ssigpw , & ssigmn, ssigms, ssigme, ssigmw , & ssig12n, ssig12s, ssig12e, ssig12w , & @@ -1357,6 +1366,13 @@ subroutine stress_eap (nx_block, ny_block, & (tensionne + tensionnw + tensionse + tensionsw)**2 & + (shearne + shearnw + shearse + shearsw)**2) + ! vorticity + dvdxn = dyU(i,j)*vvel(i,j) - dyU(i-1,j)*vvel(i-1,j) + dvdxs = dyU(i,j-1)*vvel(i,j-1) - dyU(i-1,j-1)*vvel(i-1,j-1) + dudye = dxU(i,j)*uvel(i,j) - dxU(i,j-1)*uvel(i,j-1) + dudyw = dxU(i-1,j)*uvel(i-1,j) - dxU(i-1,j-1)*uvel(i-1,j-1) + vort(i,j) = p5*tarear(i,j)*(dvdxn + dvdxs - dudye - dudyw) + divu(i,j) = p25*(divune + divunw + divuse + divusw) * tarear(i,j) rdg_conv(i,j) = -min(p25*(alpharne + alpharnw & + alpharsw + alpharse),c0) * tarear(i,j) diff --git a/cicecore/cicedyn/dynamics/ice_dyn_evp.F90 b/cicecore/cicedyn/dynamics/ice_dyn_evp.F90 index 6a71d6a14..301a89916 100644 --- a/cicecore/cicedyn/dynamics/ice_dyn_evp.F90 +++ b/cicecore/cicedyn/dynamics/ice_dyn_evp.F90 @@ -283,7 +283,7 @@ subroutine evp (dt) grid_type, grid_ice, & grid_atm_dynu, grid_atm_dynv, grid_ocn_dynu, grid_ocn_dynv use ice_state, only: aice, aiU, vice, vsno, uvel, vvel, uvelN, vvelN, & - uvelE, vvelE, divu, shear, & + uvelE, vvelE, divu, shear, vort, & aice_init, aice0, aicen, vicen, strength use ice_timers, only: timer_dynamics, timer_bound, & ice_timer_start, ice_timer_stop, timer_evp @@ -385,6 +385,7 @@ subroutine evp (dt) rdg_shear(i,j,iblk) = c0 divu (i,j,iblk) = c0 shear(i,j,iblk) = c0 + vort (i,j,iblk) = c0 enddo enddo @@ -921,9 +922,10 @@ subroutine evp (dt) indxTi (:,iblk), indxTj (:,iblk), & uvel (:,:,iblk), vvel (:,:,iblk), & dxT (:,:,iblk), dyT (:,:,iblk), & + dxU (:,:,iblk), dyU (:,:,iblk), & cxp (:,:,iblk), cyp (:,:,iblk), & cxm (:,:,iblk), cym (:,:,iblk), & - tarear (:,:,iblk), & + tarear (:,:,iblk), vort (:,:,iblk), & shear (:,:,iblk), divu (:,:,iblk), & rdg_conv(:,:,iblk), rdg_shear(:,:,iblk) ) enddo @@ -1109,7 +1111,7 @@ subroutine evp (dt) dxN (:,:,iblk), dyE (:,:,iblk), & dxT (:,:,iblk), dyT (:,:,iblk), & tarear (:,:,iblk), uarea (:,:,iblk), & - shearU (:,:,iblk), & + shearU (:,:,iblk), vort (:,:,iblk), & shear (:,:,iblk), divu (:,:,iblk), & rdg_conv(:,:,iblk), rdg_shear(:,:,iblk)) enddo @@ -1299,7 +1301,7 @@ subroutine evp (dt) uvelN (:,:,iblk), vvelN (:,:,iblk), & dxN (:,:,iblk), dyE (:,:,iblk), & dxT (:,:,iblk), dyT (:,:,iblk), & - tarear (:,:,iblk), & + tarear (:,:,iblk), vort (:,:,iblk), & shear (:,:,iblk), divu (:,:,iblk), & rdg_conv(:,:,iblk), rdg_shear(:,:,iblk)) enddo diff --git a/cicecore/cicedyn/dynamics/ice_dyn_shared.F90 b/cicecore/cicedyn/dynamics/ice_dyn_shared.F90 index d3f819f20..015c925a6 100644 --- a/cicecore/cicedyn/dynamics/ice_dyn_shared.F90 +++ b/cicecore/cicedyn/dynamics/ice_dyn_shared.F90 @@ -1711,9 +1711,10 @@ subroutine deformations (nx_block, ny_block, & indxTi, indxTj, & uvel, vvel, & dxT, dyT, & + dxU, dyU, & cxp, cyp, & cxm, cym, & - tarear, & + tarear, vort, & shear, divu, & rdg_conv, rdg_shear ) @@ -1732,6 +1733,8 @@ subroutine deformations (nx_block, ny_block, & vvel , & ! y-component of velocity (m/s) dxT , & ! width of T-cell through the middle (m) dyT , & ! height of T-cell through the middle (m) + dxU , & ! width of U-cell through the middle (m) + dyU , & ! height of U-cell through the middle (m) cyp , & ! 1.5*HTE - 0.5*HTW cxp , & ! 1.5*HTN - 0.5*HTS cym , & ! 0.5*HTE - 1.5*HTW @@ -1739,6 +1742,7 @@ subroutine deformations (nx_block, ny_block, & tarear ! 1/tarea real (kind=dbl_kind), dimension (nx_block,ny_block), intent(inout) :: & + vort , & ! vorticity (1/s) shear , & ! strain rate II component (1/s) divu , & ! strain rate I component, velocity divergence (1/s) rdg_conv , & ! convergence term for ridging (1/s) @@ -1756,6 +1760,9 @@ subroutine deformations (nx_block, ny_block, & Deltane, Deltanw, Deltase, Deltasw , & ! Delta tmp ! useful combination + real (kind=dbl_kind) :: & ! at edges for vorticity calc : + dvdxn, dvdxs, dudye, dudyw ! dvdx and dudy terms on edges + character(len=*), parameter :: subname = '(deformations)' do ij = 1, icellT @@ -1794,6 +1801,13 @@ subroutine deformations (nx_block, ny_block, & (tensionne + tensionnw + tensionse + tensionsw)**2 + & (shearne + shearnw + shearse + shearsw )**2) + ! vorticity + dvdxn = dyU(i,j)*vvel(i,j) - dyU(i-1,j)*vvel(i-1,j) + dvdxs = dyU(i,j-1)*vvel(i,j-1) - dyU(i-1,j-1)*vvel(i-1,j-1) + dudye = dxU(i,j)*uvel(i,j) - dxU(i,j-1)*uvel(i,j-1) + dudyw = dxU(i-1,j)*uvel(i-1,j) - dxU(i-1,j-1)*uvel(i-1,j-1) + vort(i,j) = p5*tarear(i,j)*(dvdxn + dvdxs - dudye - dudyw) + enddo ! ij end subroutine deformations @@ -1811,7 +1825,7 @@ subroutine deformationsCD_T (nx_block, ny_block, & uvelN, vvelN, & dxN, dyE, & dxT, dyT, & - tarear, & + tarear, vort, & shear, divu, & rdg_conv, rdg_shear ) @@ -1837,6 +1851,7 @@ subroutine deformationsCD_T (nx_block, ny_block, & tarear ! 1/tarea real (kind=dbl_kind), dimension (nx_block,ny_block), intent(inout) :: & + vort , & ! vorticity (1/s) shear , & ! strain rate II component (1/s) divu , & ! strain rate I component, velocity divergence (1/s) rdg_conv , & ! convergence term for ridging (1/s) @@ -1888,6 +1903,9 @@ subroutine deformationsCD_T (nx_block, ny_block, & ! diagnostic only ! shear = sqrt(tension**2 + shearing**2) shear(i,j) = tarear(i,j)*sqrt( tensionT(i,j)**2 + shearT(i,j)**2 ) + ! vorticity + vort (i,j) = tarear(i,j)*( ( dyE(i,j)*vvelE(i,j) - dyE(i-1,j)*vvelE(i-1,j) ) & + - ( dxN(i,j)*uvelN(i,j) - dxN(i,j-1)*uvelN(i,j-1)) ) enddo ! ij @@ -1908,7 +1926,7 @@ subroutine deformationsC_T (nx_block, ny_block, & dxN, dyE, & dxT, dyT, & tarear, uarea, & - shearU, & + shearU, vort, & shear, divu, & rdg_conv, rdg_shear ) @@ -1936,6 +1954,7 @@ subroutine deformationsC_T (nx_block, ny_block, & shearU ! shearU real (kind=dbl_kind), dimension (nx_block,ny_block), intent(inout) :: & + vort , & ! vorticity (1/s) shear , & ! strain rate II component (1/s) divu , & ! strain rate I component, velocity divergence (1/s) rdg_conv , & ! convergence term for ridging (1/s) @@ -1999,6 +2018,9 @@ subroutine deformationsC_T (nx_block, ny_block, & ! diagnostic only...maybe we dont want to use shearTsqr here???? ! shear = sqrt(tension**2 + shearing**2) shear(i,j) = tarear(i,j)*sqrt( tensionT(i,j)**2 + shearT(i,j)**2 ) + ! vorticity + vort (i,j) = tarear(i,j)*( ( dyE(i,j)*vvelE(i,j) - dyE(i-1,j)*vvelE(i-1,j) ) & + - ( dxN(i,j)*uvelN(i,j) - dxN(i,j-1)*uvelN(i,j-1)) ) enddo ! ij diff --git a/cicecore/cicedyn/dynamics/ice_dyn_vp.F90 b/cicecore/cicedyn/dynamics/ice_dyn_vp.F90 index 477d19515..0d04bf974 100644 --- a/cicecore/cicedyn/dynamics/ice_dyn_vp.F90 +++ b/cicecore/cicedyn/dynamics/ice_dyn_vp.F90 @@ -167,10 +167,10 @@ subroutine implicit_solver (dt) stressp_1, stressp_2, stressp_3, stressp_4, & stressm_1, stressm_2, stressm_3, stressm_4, & stress12_1, stress12_2, stress12_3, stress12_4 - use ice_grid, only: tmask, umask, dxT, dyT, & + use ice_grid, only: tmask, umask, dxT, dyT, dxU, dyU, & tarear, grid_type, grid_average_X2Y, & grid_atm_dynu, grid_atm_dynv, grid_ocn_dynu, grid_ocn_dynv - use ice_state, only: aice, aiU, vice, vsno, uvel, vvel, divu, shear, & + use ice_state, only: aice, aiU, vice, vsno, uvel, vvel, divu, shear, vort, & aice_init, aice0, aicen, vicen, strength use ice_timers, only: timer_dynamics, timer_bound, & ice_timer_start, ice_timer_stop @@ -521,9 +521,10 @@ subroutine implicit_solver (dt) indxTi (:,iblk), indxTj (:,iblk), & uvel (:,:,iblk), vvel (:,:,iblk), & dxT (:,:,iblk), dyT (:,:,iblk), & + dxU (:,:,iblk), dyU (:,:,iblk), & cxp (:,:,iblk), cyp (:,:,iblk), & cxm (:,:,iblk), cym (:,:,iblk), & - tarear (:,:,iblk), & + tarear (:,:,iblk), vort (:,:,iblk), & shear (:,:,iblk), divu (:,:,iblk), & rdg_conv (:,:,iblk), rdg_shear (:,:,iblk)) enddo 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_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/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_netcdf/ice_history_write.F90 b/cicecore/cicedyn/infrastructure/io/io_netcdf/ice_history_write.F90 index 51d76a6f4..4a0e86233 100644 --- a/cicecore/cicedyn/infrastructure/io/io_netcdf/ice_history_write.F90 +++ b/cicecore/cicedyn/infrastructure/io/io_netcdf/ice_history_write.F90 @@ -1325,6 +1325,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' & 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..650005a83 100644 --- a/cicecore/cicedyn/infrastructure/io/io_pio2/ice_history_write.F90 +++ b/cicecore/cicedyn/infrastructure/io/io_pio2/ice_history_write.F90 @@ -1286,6 +1286,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' & diff --git a/configuration/scripts/ice_in b/configuration/scripts/ice_in index 85f502683..e33d16c18 100644 --- a/configuration/scripts/ice_in +++ b/configuration/scripts/ice_in @@ -571,6 +571,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/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/doc/source/cice_index.rst b/doc/source/cice_index.rst index dae10eda4..1249feb08 100644 --- a/doc/source/cice_index.rst +++ b/doc/source/cice_index.rst @@ -745,6 +745,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", "" From 7a4b95e6deec0ec72c1da35a23ae1eb3ffe3d077 Mon Sep 17 00:00:00 2001 From: Tony Craig Date: Mon, 22 Jan 2024 11:12:13 -0800 Subject: [PATCH 53/76] 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> --- .github/workflows/test-cice.yml | 5 +- cicecore/cicedyn/analysis/ice_history.F90 | 2 +- .../cicedyn/analysis/ice_history_shared.F90 | 2 +- cicecore/cicedyn/dynamics/ice_dyn_shared.F90 | 2 +- .../cicedyn/dynamics/ice_transport_remap.F90 | 2 +- cicecore/cicedyn/general/ice_forcing.F90 | 10 +- .../cicedyn/infrastructure/ice_blocks.F90 | 54 +- .../cicedyn/infrastructure/ice_domain.F90 | 79 +- cicecore/cicedyn/infrastructure/ice_grid.F90 | 92 +- .../cicedyn/infrastructure/ice_memusage.F90 | 3 +- .../cicedyn/infrastructure/ice_read_write.F90 | 1289 +++++------ .../cicedyn/infrastructure/ice_restoring.F90 | 2 +- .../io/io_binary/ice_restart.F90 | 24 +- .../io/io_netcdf/ice_history_write.F90 | 2045 ++++++++--------- .../io/io_netcdf/ice_restart.F90 | 415 ++-- .../io/io_pio2/ice_history_write.F90 | 1017 ++++---- .../infrastructure/io/io_pio2/ice_pio.F90 | 75 +- .../infrastructure/io/io_pio2/ice_restart.F90 | 1084 ++++----- cicecore/drivers/nuopc/cmeps/ice_mesh_mod.F90 | 3 +- .../scripts/machines/Macros.conda_macos | 4 + .../scripts/machines/environment.yml | 1 + configuration/scripts/options/set_env.iopio1 | 1 + configuration/scripts/options/set_env.iopio1p | 1 + doc/source/developer_guide/dg_about.rst | 10 +- doc/source/user_guide/ug_case_settings.rst | 21 +- doc/source/user_guide/ug_running.rst | 83 +- 26 files changed, 3293 insertions(+), 3033 deletions(-) diff --git a/.github/workflows/test-cice.yml b/.github/workflows/test-cice.yml index 160485d04..e7e41de11 100644 --- a/.github/workflows/test-cice.yml +++ b/.github/workflows/test-cice.yml @@ -147,8 +147,11 @@ jobs: run: | cd $HOME/cice-dirs/input wget --progress=dot:giga https://zenodo.org/record/3728358/files/CICE_data_gx3_grid_ic-20200320.tar.gz && tar xvfz CICE_data_gx3_grid_ic-20200320.tar.gz - wget --progress=dot:giga https://zenodo.org/record/3728364/files/CICE_data_gx3_forcing_JRA55-20200320.tar.gz && tar xvfz CICE_data_gx3_forcing_JRA55-20200320.tar.gz + wget --progress=dot:giga https://zenodo.org/records/10419929/files/CICE_data_gx3_forcing_JRA55_200501_20231220.tar.gz && tar xvfz CICE_data_gx3_forcing_JRA55_200501_20231220.tar.gz pwd + cd CICE_data/forcing/gx3/JRA55/8XDAILY + ln -s JRA55_gx3_03hr_forcing_200501.nc JRA55_gx3_03hr_forcing_2005.nc + cd $HOME/cice-dirs/input ls -alR # - name: run case # run: | diff --git a/cicecore/cicedyn/analysis/ice_history.F90 b/cicecore/cicedyn/analysis/ice_history.F90 index 0243d9861..87a339529 100644 --- a/cicecore/cicedyn/analysis/ice_history.F90 +++ b/cicecore/cicedyn/analysis/ice_history.F90 @@ -3,7 +3,7 @@ ! ! The following variables are currently hard-wired as snapshots ! (instantaneous rather than time-averages): -! divu, shear, vort, sig1, sig2, sigP, trsig, mlt_onset, +! divu, shear, vort, sig1, sig2, sigP, trsig, mlt_onset, ! frz_onset, hisnap, aisnap ! ! Options for histfreq: '1','h','d','m','y','x', where x means that diff --git a/cicecore/cicedyn/analysis/ice_history_shared.F90 b/cicecore/cicedyn/analysis/ice_history_shared.F90 index 2c64bb021..36f7f9131 100644 --- a/cicecore/cicedyn/analysis/ice_history_shared.F90 +++ b/cicecore/cicedyn/analysis/ice_history_shared.F90 @@ -4,7 +4,7 @@ ! ! The following variables are currently hard-wired as snapshots ! (instantaneous rather than time-averages): -! divu, shear, vort, sig1, sig2, sigP, trsig, mlt_onset, +! divu, shear, vort, sig1, sig2, sigP, trsig, mlt_onset, ! frz_onset, hisnap, aisnap ! ! Options for histfreq: '1','h','d','m','y','x', where x means that diff --git a/cicecore/cicedyn/dynamics/ice_dyn_shared.F90 b/cicecore/cicedyn/dynamics/ice_dyn_shared.F90 index 015c925a6..84edea237 100644 --- a/cicecore/cicedyn/dynamics/ice_dyn_shared.F90 +++ b/cicecore/cicedyn/dynamics/ice_dyn_shared.F90 @@ -1742,7 +1742,7 @@ subroutine deformations (nx_block, ny_block, & tarear ! 1/tarea real (kind=dbl_kind), dimension (nx_block,ny_block), intent(inout) :: & - vort , & ! vorticity (1/s) + vort , & ! vorticity (1/s) shear , & ! strain rate II component (1/s) divu , & ! strain rate I component, velocity divergence (1/s) rdg_conv , & ! convergence term for ridging (1/s) diff --git a/cicecore/cicedyn/dynamics/ice_transport_remap.F90 b/cicecore/cicedyn/dynamics/ice_transport_remap.F90 index 11521a0fa..8916c359d 100644 --- a/cicecore/cicedyn/dynamics/ice_transport_remap.F90 +++ b/cicecore/cicedyn/dynamics/ice_transport_remap.F90 @@ -1177,7 +1177,7 @@ subroutine construct_fields (nx_block, ny_block, & ! center of mass (mxav,myav) for each cell - mxav(i,j) = mx(i,j)*xxav / mm(i,j) + mxav(i,j) = mx(i,j)*xxav / mm(i,j) myav(i,j) = my(i,j)*yyav / mm(i,j) enddo 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/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 1cc3540ca..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 @@ -224,7 +224,7 @@ subroutine alloc_grid ocn_gridcell_frac(nx_block,ny_block,max_blocks),& ! only relevant for lat-lon grids 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) @@ -245,7 +245,7 @@ subroutine alloc_grid 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 stat=ierr) - if (ierr/=0) call abort_ice(subname//'ERROR: Out of memory1') + 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 @@ -259,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 @@ -277,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 @@ -324,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 @@ -676,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 @@ -991,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 @@ -1071,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 @@ -1086,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 @@ -1099,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 @@ -1128,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 @@ -1158,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 @@ -1267,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 @@ -1450,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 @@ -1652,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 @@ -2717,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 @@ -2826,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 @@ -2938,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 @@ -3167,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 @@ -3395,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 @@ -3597,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 @@ -3742,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 @@ -3772,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 @@ -3803,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 @@ -4478,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 @@ -4537,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 @@ -4567,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 @@ -4581,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..ad50b38f2 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,6 +1649,11 @@ 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 + ! 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)) @@ -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_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 4a0e86233..a0e0ad3c2 100644 --- a/cicecore/cicedyn/infrastructure/io/io_netcdf/ice_history_write.F90 +++ b/cicecore/cicedyn/infrastructure/io/io_netcdf/ice_history_write.F90 @@ -24,6 +24,7 @@ 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 @@ -137,654 +138,653 @@ subroutine ice_write_hist (ns) if (my_task == master_task) then - call construct_filename(ncfile(ns),'nc',ns) + 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') - - 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 - !----------------------------------------------------------------- - - 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 - - !----------------------------------------------------------------- - ! Define attributes for time bounds if hist_avg is true - !----------------------------------------------------------------- - - 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 + ! 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 - !----------------------------------------------------------------- - ! define information for required time-invariant variables - !----------------------------------------------------------------- + ! create file + iflag = nf90_clobber + if (lcdf64) iflag = ior(iflag,nf90_64bit_offset) + 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 - 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') + 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 + !----------------------------------------------------------------- + + status = nf90_def_var(ncid,'time',nf90_double,timid,varid) + call ice_check_nc(status, subname// ' ERROR: defining var time', & + file=__FILE__, line=__LINE__) + + status = nf90_put_att(ncid,varid,'long_name','time') + call ice_check_nc(status, subname// ' ERROR: time long_name', & + file=__FILE__, line=__LINE__) + + 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) + call ice_check_nc(status, subname// ' ERROR: time units', & + file=__FILE__, line=__LINE__) + + if (days_per_year == 360) then + status = nf90_put_att(ncid,varid,'calendar','360_day') + call ice_check_nc(status, subname// ' ERROR: time calendar 360', & + file=__FILE__, line=__LINE__) + elseif (days_per_year == 365 .and. .not.use_leap_years ) then + status = nf90_put_att(ncid,varid,'calendar','noleap') + call ice_check_nc(status, subname// ' ERROR: time calendar noleap', & + file=__FILE__, line=__LINE__) + elseif (use_leap_years) then + status = nf90_put_att(ncid,varid,'calendar','Gregorian') + call ice_check_nc(status, subname// ' ERROR: time calendar Gregorian', & + file=__FILE__, line=__LINE__) + else + call abort_ice(subname//' ERROR: invalid calendar settings', file=__FILE__, line=__LINE__) + endif - !----------------------------------------------------------------- - ! define information for optional time-invariant variables - !----------------------------------------------------------------- + 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: time bounds', & + file=__FILE__, line=__LINE__) + endif - 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 bounds if hist_avg is true + !----------------------------------------------------------------- + + 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) + call ice_check_nc(status, subname// ' ERROR: defining var time_bounds', & + file=__FILE__, line=__LINE__) + status = nf90_put_att(ncid,varid,'long_name', 'time interval endpoints') + call ice_check_nc(status, subname// ' ERROR: time_bounds long_name', & + file=__FILE__, line=__LINE__) + 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) + call ice_check_nc(status, subname// ' ERROR: time_bounds units', & + file=__FILE__, line=__LINE__) + if (days_per_year == 360) then + status = nf90_put_att(ncid,varid,'calendar','360_day') + call ice_check_nc(status, subname// ' ERROR: time calendar 360 time bounds', & + file=__FILE__, line=__LINE__) + elseif (days_per_year == 365 .and. .not.use_leap_years ) then + status = nf90_put_att(ncid,varid,'calendar','noleap') + call ice_check_nc(status, subname// ' ERROR: time calendar noleap time bounds', & + file=__FILE__, line=__LINE__) + elseif (use_leap_years) then + status = nf90_put_att(ncid,varid,'calendar','Gregorian') + call ice_check_nc(status, subname// ' ERROR: time calendar Gregorian time bounds', & + file=__FILE__, line=__LINE__) + else + call abort_ice(subname//' ERROR: invalid calendar settings', file=__FILE__, line=__LINE__) + endif - !----------------------------------------------------------------- - ! define attributes for time-invariant variables - !----------------------------------------------------------------- - - 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 + endif - !----------------------------------------------------------------- - ! global attributes - !----------------------------------------------------------------- - ! ... the user should change these to something useful ... - !----------------------------------------------------------------- + !----------------------------------------------------------------- + ! 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 + status = nf90_def_var(ncid, var_coord(i)%short_name, lprecision, & + dimid(1:2), varid) + call ice_check_nc(status, subname// ' ERROR: defining short_name for '//var_coord(i)%short_name, & + file=__FILE__, line=__LINE__) + status = nf90_put_att(ncid,varid,'long_name',var_coord(i)%long_name) + call ice_check_nc(status, subname// ' ERROR: defining long_name for '//var_coord(i)%short_name, & + file=__FILE__, line=__LINE__) + status = nf90_put_att(ncid, varid, 'units', var_coord(i)%units) + call ice_check_nc(status, subname// ' ERROR: defining units for '//var_coord(i)%short_name, & + file=__FILE__, line=__LINE__) + 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 + status = nf90_def_var(ncid, var_grdz(i)%short_name, & + lprecision, dimidex(i), varid) + call ice_check_nc(status, subname// ' ERROR: defining short_name for '//var_grdz(i)%short_name, & + file=__FILE__, line=__LINE__) + status = nf90_put_att(ncid,varid,'long_name',var_grdz(i)%long_name) + call ice_check_nc(status, subname// ' ERROR: defining long_name for '//var_grdz(i)%short_name, & + file=__FILE__, line=__LINE__) + status = nf90_put_att(ncid, varid, 'units', var_grdz(i)%units) + call ice_check_nc(status, subname// ' ERROR: defining units for '//var_grdz(i)%short_name, & + file=__FILE__, line=__LINE__) + 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) + call ice_check_nc(status, subname// ' ERROR: defining variable '//var_grd(i)%req%short_name, & + file=__FILE__, line=__LINE__) + status = nf90_put_att(ncid,varid, 'long_name', var_grd(i)%req%long_name) + call ice_check_nc(status, subname// ' ERROR: defining long_name for '//var_grd(i)%req%short_name, & + file=__FILE__, line=__LINE__) + status = nf90_put_att(ncid, varid, 'units', var_grd(i)%req%units) + call ice_check_nc(status, subname// ' ERROR: defining units for '//var_grd(i)%req%short_name, & + file=__FILE__, line=__LINE__) + 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 + status = nf90_def_var(ncid, var_nverts(i)%short_name, & + lprecision,dimid_nverts, varid) + call ice_check_nc(status, subname// ' ERROR: defining variable '//var_nverts(i)%short_name, & + file=__FILE__, line=__LINE__) + status = nf90_put_att(ncid,varid, 'long_name', var_nverts(i)%long_name) + call ice_check_nc(status, subname// ' ERROR: defining long_name for '//var_nverts(i)%short_name, & + file=__FILE__, line=__LINE__) + status = nf90_put_att(ncid, varid, 'units', var_nverts(i)%units) + call ice_check_nc(status, subname// ' ERROR: defining units for '//var_nverts(i)%short_name, & + file=__FILE__, line=__LINE__) + 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) + call ice_check_nc(status, subname// ' ERROR: defining variable '//avail_hist_fields(n)%vname, & + file=__FILE__, line=__LINE__) + 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) + call ice_check_nc(status, subname// ' ERROR: defining variable '//avail_hist_fields(n)%vname, & + file=__FILE__, line=__LINE__) + 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) + call ice_check_nc(status, subname// ' ERROR: defining variable '//avail_hist_fields(n)%vname, & + file=__FILE__, line=__LINE__) + 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) + call ice_check_nc(status, subname// ' ERROR: defining variable '//avail_hist_fields(n)%vname, & + file=__FILE__, line=__LINE__) + 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) + call ice_check_nc(status, subname// ' ERROR: defining variable '//avail_hist_fields(n)%vname, & + file=__FILE__, line=__LINE__) + 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) + call ice_check_nc(status, subname// ' ERROR: defining variable '//avail_hist_fields(n)%vname, & + file=__FILE__, line=__LINE__) + 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 + call ice_check_nc(status, subname// ' ERROR: defining variable '//avail_hist_fields(n)%vname, & + file=__FILE__, line=__LINE__) + 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 + call ice_check_nc(status, subname// ' ERROR: defining variable '//avail_hist_fields(n)%vname, & + file=__FILE__, line=__LINE__) + 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 + call ice_check_nc(status, subname// ' ERROR: defining variable '//avail_hist_fields(n)%vname, & + file=__FILE__, line=__LINE__) + call ice_write_hist_attrs(ncid,varid,avail_hist_fields(n),ns) + endif + enddo ! num_avail_hist_fields_4Df + + !----------------------------------------------------------------- + ! 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 +800,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 +939,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 +1020,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,15 +1247,14 @@ 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 @@ -1284,25 +1283,25 @@ subroutine ice_write_hist_attrs(ncid, varid, hfield, ns) #ifdef USE_NETCDF 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 +1313,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 @@ -1340,12 +1339,11 @@ 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 @@ -1375,19 +1373,18 @@ 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 diff --git a/cicecore/cicedyn/infrastructure/io/io_netcdf/ice_restart.F90 b/cicecore/cicedyn/infrastructure/io/io_netcdf/ice_restart.F90 index 84fcbe5b7..c670bf016 100644 --- a/cicecore/cicedyn/infrastructure/io/io_netcdf/ice_restart.F90 +++ b/cicecore/cicedyn/infrastructure/io/io_netcdf/ice_restart.F90 @@ -15,6 +15,7 @@ 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 @@ -54,7 +55,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 +77,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 +122,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 @@ -214,16 +219,18 @@ subroutine init_restart_write(filename_spec) iflag = 0 if (lcdf64) iflag = nf90_64bit_offset 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 +239,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 +388,9 @@ subroutine init_restart_write(filename_spec) deallocate(dims) - !----------------------------------------------------------------- - ! 3D restart fields (ncat) - !----------------------------------------------------------------- + !----------------------------------------------------------------- + ! 3D restart fields (ncat) + !----------------------------------------------------------------- allocate(dims(3)) @@ -482,9 +492,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 +544,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 +664,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 +689,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 + 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 - write(nu_diag,*) 'ndim3 not supported ',ndim3 + 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 - write(nu_diag,*) 'ndim3 not supported ',ndim3 + 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(:,:,:) + 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 +774,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 - write(nu_diag,*) 'ndim3 not supported',ndim3 + 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 + 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 +846,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 @@ -856,14 +874,15 @@ subroutine define_rest_field(ncid, vname, dims) integer (kind=int_kind) :: varid integer (kind=int_kind) :: & - status ! status variable from netCDF routine + status ! status variable from netCDF routine 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__) #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 +911,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 for '//trim(ice_ic), & 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 650005a83..bb4ef0ea1 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 @@ -167,7 +167,6 @@ 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 @@ -192,73 +191,106 @@ 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__) + + 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__) - 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,'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 + call ice_pio_check(pio_def_var(File,'time',pio_double,(/timid/),varid), & + subname//' ERROR: defining var time',file=__FILE__,line=__LINE__) + call ice_pio_check(pio_put_att(File,varid,'long_name','time'), & + subname//' ERROR: defining att long_name time',file=__FILE__,line=__LINE__) + + 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 + call ice_pio_check(pio_put_att(File,varid,'units',trim(title)), & + subname//' ERROR: defining att units '//trim(title),file=__FILE__,line=__LINE__) + + if (days_per_year == 360) then + call ice_pio_check(pio_put_att(File,varid,'calendar','360_day'), & + subname//' ERROR: defining att calendar 360',file=__FILE__,line=__LINE__) + elseif (days_per_year == 365 .and. .not.use_leap_years ) then + call ice_pio_check(pio_put_att(File,varid,'calendar','noleap'), & + subname//' ERROR: defining att calendar noleap',file=__FILE__,line=__LINE__) + elseif (use_leap_years) then + call ice_pio_check(pio_put_att(File,varid,'calendar','Gregorian'), & + subname//' ERROR: defining att calendar Gregorian',file=__FILE__,line=__LINE__) + 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 + 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 attributes for time_bounds if hist_avg is true + if (hist_avg(ns) .and. .not. write_ic) then + dimid2(1) = boundid + dimid2(2) = timid + call ice_pio_check(pio_def_var(File,'time_bounds',pio_double,dimid2,varid), & + subname//' ERROR: defining var time_bounds',file=__FILE__,line=__LINE__) + call ice_pio_check(pio_put_att(File,varid,'long_name', 'time interval endpoints'), & + subname//' ERROR: defining att long_name time interval endpoints',file=__FILE__,line=__LINE__) + + if (days_per_year == 360) then + call ice_pio_check(pio_put_att(File,varid,'calendar','360_day'), & + subname//' ERROR: defining att calendar 360 time bounds',file=__FILE__,line=__LINE__) + elseif (days_per_year == 365 .and. .not.use_leap_years ) then + call ice_pio_check(pio_put_att(File,varid,'calendar','noleap'), & + subname//' ERROR: defining att calendar noleap time bounds',file=__FILE__,line=__LINE__) + elseif (use_leap_years) then + call ice_pio_check(pio_put_att(File,varid,'calendar','Gregorian'), & + subname//' ERROR: defining att calendar Gregorian time bounds',file=__FILE__,line=__LINE__) + 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 + call ice_pio_check(pio_put_att(File,varid,'units',trim(title)), & + subname//' ERROR: defining att units '//trim(title),file=__FILE__,line=__LINE__) + endif !----------------------------------------------------------------- ! define information for required time-invariant variables @@ -402,67 +434,76 @@ 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_pio_check(pio_def_var(File, trim(var_coord(i)%short_name), lprecision,dimid2, varid), & + subname//' ERROR: defining var '//trim(var_coord(i)%short_name),file=__FILE__,line=__LINE__) + call ice_pio_check(pio_put_att(File,varid,'long_name',trim(var_coord(i)%long_name)), & + subname//' ERROR: defining att long_name '//trim(var_coord(i)%long_name),file=__FILE__,line=__LINE__) + call ice_pio_check(pio_put_att(File, varid, 'units', trim(var_coord(i)%units)), & + subname//' ERROR: defining att units '//trim(var_coord(i)%units),file=__FILE__,line=__LINE__) + 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_pio_check(pio_def_var(File, trim(var_grdz(i)%short_name), lprecision,(/dimidex(i)/), varid), & + subname//' ERROR: defining var'//trim(var_grdz(i)%short_name),file=__FILE__,line=__LINE__) + call ice_pio_check(pio_put_att(File, varid, 'long_name', var_grdz(i)%long_name), & + subname//' ERROR: defining att long_name '//trim(var_grdz(i)%long_name),file=__FILE__,line=__LINE__) + call ice_pio_check(pio_put_att(File, varid, 'units' , var_grdz(i)%units), & + subname//' ERROR: defining att units '//trim(var_grdz(i)%units),file=__FILE__,line=__LINE__) + endif + enddo + + do i = 1, nvar_grd + if (igrd(i)) then + call ice_pio_check(pio_def_var(File, trim(var_grd(i)%req%short_name), lprecision, dimid2, varid), & + subname//' ERROR: defining var'//trim(var_grd(i)%req%short_name),file=__FILE__,line=__LINE__) + call ice_pio_check(pio_put_att(File,varid, 'long_name', trim(var_grd(i)%req%long_name)), & + subname//' ERROR: defining att long_name '//trim(var_grd(i)%req%long_name),file=__FILE__,line=__LINE__) + call ice_pio_check(pio_put_att(File, varid, 'units', trim(var_grd(i)%req%units)), & + subname//' ERROR: defining att units '//trim(var_grd(i)%req%units),file=__FILE__,line=__LINE__) + 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_pio_check(pio_def_var(File, trim(var_nverts(i)%short_name),lprecision,dimid_nverts, varid), & + subname//' ERROR: defining var'//trim(var_nverts(i)%short_name),file=__FILE__,line=__LINE__) + call ice_pio_check(pio_put_att(File,varid, 'long_name', trim(var_nverts(i)%long_name)), & + subname//' ERROR: defining att long_name '//trim(var_nverts(i)%long_name),file=__FILE__,line=__LINE__) + call ice_pio_check(pio_put_att(File, varid, 'units', trim(var_nverts(i)%units)), & + subname//' ERROR: defining att units '//trim(var_nverts(i)%units),file=__FILE__,line=__LINE__) + call ice_write_hist_fill(File,varid,var_nverts(i)%short_name,history_precision) + endif + enddo !----------------------------------------------------------------- ! define attributes for time-variant variables @@ -472,102 +513,102 @@ subroutine ice_write_hist (ns) ! 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) + do n=1,num_avail_hist_fields_2D + if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then + call ice_pio_check(pio_def_var(File, trim(avail_hist_fields(n)%vname), lprecision, dimid3, varid), & + subname//' ERROR: defining var'//trim(avail_hist_fields(n)%vname),file=__FILE__,line=__LINE__) call ice_write_hist_attrs(File,varid,avail_hist_fields(n),ns) - endif - enddo ! num_avail_hist_fields_2D + endif + enddo ! num_avail_hist_fields_2D !----------------------------------------------------------------- ! 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) + do n = n2D + 1, n3Dccum + if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then + call ice_pio_check(pio_def_var(File, trim(avail_hist_fields(n)%vname), lprecision, dimidz, varid), & + subname//' ERROR: defining var'//trim(avail_hist_fields(n)%vname),file=__FILE__,line=__LINE__) call ice_write_hist_attrs(File,varid,avail_hist_fields(n),ns) - endif - enddo ! num_avail_hist_fields_3Dc + 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) + do n = n3Dccum + 1, n3Dzcum + if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then + call ice_pio_check(pio_def_var(File, trim(avail_hist_fields(n)%vname), lprecision, dimidz, varid), & + subname//' ERROR: defining var'//trim(avail_hist_fields(n)%vname),file=__FILE__,line=__LINE__) call ice_write_hist_attrs(File,varid,avail_hist_fields(n),ns) - endif - enddo ! num_avail_hist_fields_3Dz + 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) + do n = n3Dzcum + 1, n3Dbcum + if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then + call ice_pio_check(pio_def_var(File, trim(avail_hist_fields(n)%vname), lprecision, dimidz, varid), & + subname//' ERROR: defining var'//trim(avail_hist_fields(n)%vname),file=__FILE__,line=__LINE__) call ice_write_hist_attrs(File,varid,avail_hist_fields(n),ns) - endif - enddo ! num_avail_hist_fields_3Db + 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) + do n = n3Dbcum + 1, n3Dacum + if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then + call ice_pio_check(pio_def_var(File, trim(avail_hist_fields(n)%vname), lprecision, dimidz, varid), & + subname//' ERROR: defining var'//trim(avail_hist_fields(n)%vname),file=__FILE__,line=__LINE__) call ice_write_hist_attrs(File,varid,avail_hist_fields(n),ns) - endif - enddo ! num_avail_hist_fields_3Da + 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) + do n = n3Dacum + 1, n3Dfcum + if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then + call ice_pio_check(pio_def_var(File, trim(avail_hist_fields(n)%vname), lprecision, dimidz, varid), & + subname//' ERROR: defining var'//trim(avail_hist_fields(n)%vname),file=__FILE__,line=__LINE__) call ice_write_hist_attrs(File,varid,avail_hist_fields(n),ns) - endif - enddo ! num_avail_hist_fields_3Df + endif + enddo ! num_avail_hist_fields_3Df !----------------------------------------------------------------- ! define attributes for 4D variables @@ -578,56 +619,55 @@ subroutine ice_write_hist (ns) ! 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) + do n = n3Dfcum + 1, n4Dicum + if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then + call ice_pio_check(pio_def_var(File, trim(avail_hist_fields(n)%vname), lprecision, dimidcz, varid), & + subname//' ERROR: defining var'//trim(avail_hist_fields(n)%vname),file=__FILE__,line=__LINE__) call ice_write_hist_attrs(File,varid,avail_hist_fields(n),ns) - endif - enddo ! num_avail_hist_fields_4Di + 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 + 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) + do n = n4Dicum + 1, n4Dscum + if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then + call ice_pio_check(pio_def_var(File, trim(avail_hist_fields(n)%vname), lprecision, dimidcz, varid), & + subname//' ERROR: defining var'//trim(avail_hist_fields(n)%vname),file=__FILE__,line=__LINE__) call ice_write_hist_attrs(File,varid,avail_hist_fields(n),ns) - endif - enddo ! num_avail_hist_fields_4Ds - + 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) + do n = n4Dscum + 1, n4Dfcum + if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then + call ice_pio_check(pio_def_var(File, trim(avail_hist_fields(n)%vname), lprecision, dimidcz, varid), & + subname//' ERROR: defining var'//trim(avail_hist_fields(n)%vname),file=__FILE__,line=__LINE__) call ice_write_hist_attrs(File,varid,avail_hist_fields(n),ns) - endif - enddo ! num_avail_hist_fields_4Df + endif + enddo ! num_avail_hist_fields_4Df !----------------------------------------------------------------- ! global attributes @@ -635,31 +675,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)') 'Los Alamos 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 +717,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 - - 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)) + end select - 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__) + + if (history_format == 'pio_pnetcdf') then + call ice_pio_check(pio_put_att(File,pio_global,'io_flavor','io_pio pnetcdf'), & + subname//' ERROR: defining att io_flavor',file=__FILE__,line=__LINE__) + else + call ice_pio_check(pio_put_att(File,pio_global,'io_flavor','io_pio netcdf'), & + 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 +816,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 +866,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 +919,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 +930,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 +994,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 +1012,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 +1027,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 +1049,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 +1063,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 +1085,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 +1099,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 +1121,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 +1135,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 +1157,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 +1171,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 +1193,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 +1207,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 +1216,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 +1231,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 +1244,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 +1253,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 +1268,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 +1282,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 +1291,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 +1306,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) @@ -1211,6 +1319,7 @@ subroutine ice_write_hist (ns) !----------------------------------------------------------------- ! clean-up PIO descriptors !----------------------------------------------------------------- + call pio_seterrorhandling(File, PIO_INTERNAL_ERROR) call pio_freedecomp(File,iodesc2d) call pio_freedecomp(File,iodesc3dv) @@ -1239,7 +1348,6 @@ end subroutine ice_write_hist subroutine ice_write_hist_attrs(File, varid, hfield, ns) - use ice_kinds_mod use ice_calendar, only: histfreq, histfreq_n, write_ic use ice_history_shared, only: ice_hist_field, history_precision, & hist_avg @@ -1256,16 +1364,21 @@ subroutine ice_write_hist_attrs(File, varid, hfield, ns) integer (kind=int_kind) :: status character(len=*), parameter :: subname = '(ice_write_hist_attrs)' - status = pio_put_att(File,varid,'units', trim(hfield%vunit)) + 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, 'long_name', trim(hfield%vdesc)) + 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__) - status = pio_put_att(File,varid,'coordinates', trim(hfield%vcoord)) + 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__) - status = pio_put_att(File,varid,'cell_measures', trim(hfield%vcellmeas)) + 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 +1390,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 @@ -1297,9 +1411,11 @@ 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 @@ -1308,14 +1424,13 @@ end subroutine ice_write_hist_attrs subroutine ice_write_hist_fill(File,varid,vname,precision) - use ice_kinds_mod - use ice_pio - use pio + use ice_pio, only: ice_pio_check + 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 + character(len=*), intent(in) :: vname + integer (kind=int_kind), intent(in) :: precision ! local variables @@ -1323,11 +1438,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..8b02fb75e 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 @@ -66,23 +67,16 @@ subroutine ice_pio_init(mode, filename, File, clobber, cdf64, iotype) 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 - character(len=*), parameter :: subname = '(ice_pio_init)' + integer :: nprocs , istride, basetask, numiotasks, rearranger, pio_iotype, status, nmode + logical :: lclobber, lcdf64, exists logical, save :: first_call = .true. + character(len=*), parameter :: subname = '(ice_pio_init)' #ifdef CESMCOUPLED ice_pio_subsystem => shr_pio_getiosys(inst_name) pio_iotype = shr_pio_getiotype(inst_name) + + call pio_seterrorhandling(ice_pio_subsystem, PIO_RETURN_ERROR) #else #ifdef GPTL @@ -118,6 +112,9 @@ subroutine ice_pio_init(mode, filename, File, clobber, cdf64, iotype) call pio_init(my_task, MPI_COMM_ICE, numiotasks, master_task, istride, & rearranger, ice_pio_subsystem, base=basetask) + + call pio_seterrorhandling(ice_pio_subsystem, PIO_RETURN_ERROR) + !--- 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]) @@ -156,12 +153,16 @@ subroutine ice_pio_init(mode, filename, File, clobber, cdf64, iotype) nmode = pio_clobber if (lcdf64) nmode = ior(nmode,PIO_64BIT_OFFSET) 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 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 @@ -170,29 +171,37 @@ subroutine ice_pio_init(mode, filename, File, clobber, cdf64, iotype) nmode = pio_noclobber if (lcdf64) nmode = ior(nmode,PIO_64BIT_OFFSET) 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 +474,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..e55acc434 100644 --- a/cicecore/cicedyn/infrastructure/io/io_pio2/ice_restart.F90 +++ b/cicecore/cicedyn/infrastructure/io/io_pio2/ice_restart.F90 @@ -55,9 +55,7 @@ subroutine init_restart_read(ice_ic) character(len=char_len_long) :: & filename, filename0 - integer (kind=int_kind) :: status, status1 - - integer (kind=int_kind) :: iotype + integer (kind=int_kind) :: status, iotype character(len=*), parameter :: subname = '(init_restart_read)' @@ -78,40 +76,48 @@ 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 + 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 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 +125,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 @@ -147,38 +150,36 @@ 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_ni, dimid_nj, 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 @@ -186,30 +187,30 @@ subroutine init_restart_write(filename_spec) 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 +222,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) + 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) + + 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 +350,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,299 +377,298 @@ 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 (skl_bgc) then + if (tr_brine) then + call define_rest_field(File,'fbrn',dims) + call define_rest_field(File,'first_ice',dims) + endif + + 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_snow) then - do k=1,nslyr + 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 (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 + 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 - endif !z_tracers + 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)) @@ -687,104 +692,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) + call pio_seterrorhandling(File, PIO_RETURN_ERROR) - status = pio_inq_varid(File,trim(vname),vardesc) - - 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 +801,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 +894,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 @@ -905,12 +911,10 @@ subroutine define_rest_field(File, vname, dims) character (len=*) , intent(in) :: vname integer (kind=int_kind), intent(in) :: dims(:) - integer (kind=int_kind) :: & - status ! status variable from netCDF routine - character(len=*), parameter :: subname = '(define_rest_field)' - status = pio_def_var(File,trim(vname),pio_double,dims,vardesc) + call ice_pio_check(pio_def_var(File,trim(vname),pio_double,dims,vardesc), & + subname//' ERROR: def_var '//trim(vname),file=__FILE__,line=__LINE__) end subroutine define_rest_field @@ -931,9 +935,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_mesh_mod.F90 b/cicecore/drivers/nuopc/cmeps/ice_mesh_mod.F90 index 9493add51..a3db97fa1 100644 --- a/cicecore/drivers/nuopc/cmeps/ice_mesh_mod.F90 +++ b/cicecore/drivers/nuopc/cmeps/ice_mesh_mod.F90 @@ -437,8 +437,9 @@ 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_dyn_shared, only : dyhx, dxhy, cyp, cxp, cym, cxm use ice_boundary , only : ice_HaloUpdate use ice_domain , only : blocks_ice, nblocks, halo_info, distrb_info use ice_constants , only : c0, c1, p25 diff --git a/configuration/scripts/machines/Macros.conda_macos b/configuration/scripts/machines/Macros.conda_macos index 191e10d7d..6f26da0fc 100644 --- a/configuration/scripts/machines/Macros.conda_macos +++ b/configuration/scripts/machines/Macros.conda_macos @@ -61,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/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 index 8357b4aac..1a92353ce 100644 --- a/configuration/scripts/options/set_env.iopio1p +++ b/configuration/scripts/options/set_env.iopio1p @@ -1 +1,2 @@ setenv ICE_IOTYPE pio1 +setenv ICE_CPPDEFS -DUSE_PIO1 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/user_guide/ug_case_settings.rst b/doc/source/user_guide/ug_case_settings.rst index fd808fd8f..7ba3f35ad 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 pio code 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,10 +81,10 @@ 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" + " ", "pio", "uses io_pio directory, 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" @@ -208,7 +209,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", "``.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" @@ -616,7 +617,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 +627,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 +674,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_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. From 1a00e5e4e967c8429a7753ac3597f9c1476cf6b7 Mon Sep 17 00:00:00 2001 From: "David A. Bailey" Date: Mon, 5 Feb 2024 16:22:11 -0700 Subject: [PATCH 54/76] Fix for ice_mesh_mod with grid variables removed (#929) --- cicecore/drivers/nuopc/cmeps/ice_mesh_mod.F90 | 7 ------- 1 file changed, 7 deletions(-) diff --git a/cicecore/drivers/nuopc/cmeps/ice_mesh_mod.F90 b/cicecore/drivers/nuopc/cmeps/ice_mesh_mod.F90 index a3db97fa1..ae0a2d070 100644 --- a/cicecore/drivers/nuopc/cmeps/ice_mesh_mod.F90 +++ b/cicecore/drivers/nuopc/cmeps/ice_mesh_mod.F90 @@ -439,7 +439,6 @@ subroutine ice_mesh_init_tlon_tlat_area_hm() use ice_grid , only : uarea, uarear, tarear!, tinyarea use ice_grid , only : dxT, dyT, dxU, dyU use ice_grid , only : makemask - use ice_dyn_shared, only : dyhx, dxhy, cyp, cxp, cym, cxm use ice_boundary , only : ice_HaloUpdate use ice_domain , only : blocks_ice, nblocks, halo_info, distrb_info use ice_constants , only : c0, c1, p25 @@ -536,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 From 095e62a9342df74261b90fcb7a20d2ecdae2c5bc Mon Sep 17 00:00:00 2001 From: Tony Craig Date: Mon, 12 Feb 2024 14:49:02 -0800 Subject: [PATCH 55/76] 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 --- .github/PULL_REQUEST_TEMPLATE.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) 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: Date: Mon, 19 Feb 2024 14:08:37 -0500 Subject: [PATCH 56/76] 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 --- doc/source/user_guide/ug_testing.rst | 5 +++++ 1 file changed, 5 insertions(+) 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 From aca835755aa82ead50040ea7e43ec63619667054 Mon Sep 17 00:00:00 2001 From: Tony Craig Date: Thu, 22 Feb 2024 08:55:44 -0800 Subject: [PATCH 57/76] 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 --- .../cicedyn/analysis/ice_history_shared.F90 | 13 +- cicecore/cicedyn/general/ice_init.F90 | 303 ++++++++++++--- .../cicedyn/infrastructure/ice_read_write.F90 | 12 +- .../io/io_netcdf/ice_history_write.F90 | 347 ++++++++--------- .../io/io_netcdf/ice_restart.F90 | 52 ++- .../io/io_pio2/ice_history_write.F90 | 353 +++++++++--------- .../infrastructure/io/io_pio2/ice_pio.F90 | 156 +++++--- .../infrastructure/io/io_pio2/ice_restart.F90 | 76 +++- .../drivers/nuopc/cmeps/ice_comp_nuopc.F90 | 33 +- .../drivers/standalone/cice/CICE_InitMod.F90 | 2 +- cicecore/shared/ice_restart_shared.F90 | 11 +- configuration/scripts/ice_in | 12 + .../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 + configuration/scripts/options/set_env.iopio1p | 2 - configuration/scripts/options/set_env.iopio2p | 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/io_suite.ts | 108 ++---- doc/source/cice_index.rst | 12 + doc/source/developer_guide/dg_infra.rst | 4 +- doc/source/user_guide/ug_case_settings.rst | 50 ++- doc/source/user_guide/ug_implementation.rst | 126 +++++-- 39 files changed, 1092 insertions(+), 631 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/cicecore/cicedyn/analysis/ice_history_shared.F90 b/cicecore/cicedyn/analysis/ice_history_shared.F90 index 36f7f9131..ac2cf8afb 100644 --- a/cicecore/cicedyn/analysis/ice_history_shared.F90 +++ b/cicecore/cicedyn/analysis/ice_history_shared.F90 @@ -49,18 +49,23 @@ module ice_history_shared history_dir , & ! directory name for history file incond_dir ! directory for snapshot initial conditions - character (len=char_len_long), public :: & - pointer_file ! input pointer file for restarts - character (len=char_len), public :: & version_name character (len=char_len), public :: & - history_format + history_format , & ! history format, cdf1, cdf2, cdf5, etc + history_rearranger ! history file rearranger, box or subset for pio character (len=char_len), public :: & hist_suffix(max_nstrm) ! appended to 'h' in filename when not 'x' + integer (kind=int_kind), public :: & + history_iotasks , & ! iotasks, root, stride defines io pes for pio + history_root , & ! iotasks, root, stride defines io pes for pio + history_stride , & ! iotasks, root, stride defines io pes for pio + history_deflate , & ! compression level for hdf5/netcdf4 + history_chunksize(2) ! chunksize for hdf5/netcdf4 + !--------------------------------------------------------------- ! Instructions for adding a field: (search for 'example') ! Here or in ice_history_[process].F90: 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/infrastructure/ice_read_write.F90 b/cicecore/cicedyn/infrastructure/ice_read_write.F90 index ad50b38f2..4613843b5 100644 --- a/cicecore/cicedyn/infrastructure/ice_read_write.F90 +++ b/cicecore/cicedyn/infrastructure/ice_read_write.F90 @@ -1241,7 +1241,7 @@ subroutine ice_read_nc_xy(fid, nrec, varname, work, diag, & 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 +! 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) @@ -1442,7 +1442,7 @@ subroutine ice_read_nc_xyz(fid, nrec, varname, work, diag, & 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 +! 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) @@ -1654,7 +1654,7 @@ subroutine ice_read_nc_xyf(fid, nrec, varname, work, diag, & 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 +! 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) @@ -2589,13 +2589,13 @@ subroutine ice_check_nc(status, abort_msg, file, line) #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), & + 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), & + 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)) + call abort_ice(subname//' '//trim(nf90_strerror(status))//', '//trim(abort_msg)) endif endif #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 a0e0ad3c2..c03bc233a 100644 --- a/cicecore/cicedyn/infrastructure/io/io_netcdf/ice_history_write.F90 +++ b/cicecore/cicedyn/infrastructure/io/io_netcdf/ice_history_write.F90 @@ -27,11 +27,29 @@ module ice_history_write 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 @@ -61,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 @@ -78,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 @@ -86,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 @@ -108,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 @@ -148,8 +152,18 @@ subroutine ice_write_hist (ns) endif ! create file - iflag = nf90_clobber - if (lcdf64) iflag = ior(iflag,nf90_64bit_offset) + 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__) @@ -205,83 +219,44 @@ subroutine ice_write_hist (ns) file=__FILE__, line=__LINE__) !----------------------------------------------------------------- - ! define coordinate variables + ! define coordinate variables: time, time_bounds !----------------------------------------------------------------- - status = nf90_def_var(ncid,'time',nf90_double,timid,varid) - call ice_check_nc(status, subname// ' ERROR: defining var time', & - file=__FILE__, line=__LINE__) - - status = nf90_put_att(ncid,varid,'long_name','time') - call ice_check_nc(status, subname// ' ERROR: time long_name', & - file=__FILE__, line=__LINE__) - write(cdate,'(i8.8)') idate0 - write(title,'(a,a4,a1,a2,a1,a2,a1,i2.2,a1,i2.2,a1,i2.2)') 'days since ', & + 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 - status = nf90_put_att(ncid,varid,'units',title) - call ice_check_nc(status, subname// ' ERROR: time units', & - file=__FILE__, line=__LINE__) if (days_per_year == 360) then - status = nf90_put_att(ncid,varid,'calendar','360_day') - call ice_check_nc(status, subname// ' ERROR: time calendar 360', & - file=__FILE__, line=__LINE__) + cal_att='360_day' elseif (days_per_year == 365 .and. .not.use_leap_years ) then - status = nf90_put_att(ncid,varid,'calendar','noleap') - call ice_check_nc(status, subname// ' ERROR: time calendar noleap', & - file=__FILE__, line=__LINE__) + cal_att='noleap' elseif (use_leap_years) then - status = nf90_put_att(ncid,varid,'calendar','Gregorian') - call ice_check_nc(status, subname// ' ERROR: time calendar Gregorian', & - file=__FILE__, line=__LINE__) + cal_att='Gregorian' else call abort_ice(subname//' ERROR: invalid calendar settings', file=__FILE__, line=__LINE__) endif + time_coord = coord_attributes('time', 'time', trim(cal_units)) + call ice_hist_coord_def(ncid, time_coord, nf90_double, (/timid/), varid) + + 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: time bounds', & - file=__FILE__, line=__LINE__) + call ice_check_nc(status, subname//' ERROR: defining att bounds time_bounds',file=__FILE__,line=__LINE__) endif - !----------------------------------------------------------------- - ! Define attributes for time bounds if hist_avg is true - !----------------------------------------------------------------- - + ! 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)) + dimid(1) = boundid dimid(2) = timid - status = nf90_def_var(ncid,'time_bounds',lprecision,dimid(1:2),varid) - call ice_check_nc(status, subname// ' ERROR: defining var time_bounds', & - file=__FILE__, line=__LINE__) - status = nf90_put_att(ncid,varid,'long_name', 'time interval endpoints') - call ice_check_nc(status, subname// ' ERROR: time_bounds long_name', & - file=__FILE__, line=__LINE__) - 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) - call ice_check_nc(status, subname// ' ERROR: time_bounds units', & - file=__FILE__, line=__LINE__) - if (days_per_year == 360) then - status = nf90_put_att(ncid,varid,'calendar','360_day') - call ice_check_nc(status, subname// ' ERROR: time calendar 360 time bounds', & - file=__FILE__, line=__LINE__) - elseif (days_per_year == 365 .and. .not.use_leap_years ) then - status = nf90_put_att(ncid,varid,'calendar','noleap') - call ice_check_nc(status, subname// ' ERROR: time calendar noleap time bounds', & - file=__FILE__, line=__LINE__) - elseif (use_leap_years) then - status = nf90_put_att(ncid,varid,'calendar','Gregorian') - call ice_check_nc(status, subname// ' ERROR: time calendar Gregorian time bounds', & - file=__FILE__, line=__LINE__) - else - call abort_ice(subname//' ERROR: invalid calendar settings', file=__FILE__, line=__LINE__) - endif + 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 !----------------------------------------------------------------- @@ -431,16 +406,7 @@ subroutine ice_write_hist (ns) dimid(3) = timid do i = 1, ncoord - status = nf90_def_var(ncid, var_coord(i)%short_name, lprecision, & - dimid(1:2), varid) - call ice_check_nc(status, subname// ' ERROR: defining short_name for '//var_coord(i)%short_name, & - file=__FILE__, line=__LINE__) - status = nf90_put_att(ncid,varid,'long_name',var_coord(i)%long_name) - call ice_check_nc(status, subname// ' ERROR: defining long_name for '//var_coord(i)%short_name, & - file=__FILE__, line=__LINE__) - status = nf90_put_att(ncid, varid, 'units', var_coord(i)%units) - call ice_check_nc(status, subname// ' ERROR: defining units for '//var_coord(i)%short_name, & - file=__FILE__, line=__LINE__) + 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', & @@ -465,31 +431,13 @@ subroutine ice_write_hist (ns) do i = 1, nvar_grdz if (igrdz(i)) then - status = nf90_def_var(ncid, var_grdz(i)%short_name, & - lprecision, dimidex(i), varid) - call ice_check_nc(status, subname// ' ERROR: defining short_name for '//var_grdz(i)%short_name, & - file=__FILE__, line=__LINE__) - status = nf90_put_att(ncid,varid,'long_name',var_grdz(i)%long_name) - call ice_check_nc(status, subname// ' ERROR: defining long_name for '//var_grdz(i)%short_name, & - file=__FILE__, line=__LINE__) - status = nf90_put_att(ncid, varid, 'units', var_grdz(i)%units) - call ice_check_nc(status, subname// ' ERROR: defining units for '//var_grdz(i)%short_name, & - file=__FILE__, line=__LINE__) + 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 - status = nf90_def_var(ncid, var_grd(i)%req%short_name, & - lprecision, dimid(1:2), varid) - call ice_check_nc(status, subname// ' ERROR: defining variable '//var_grd(i)%req%short_name, & - file=__FILE__, line=__LINE__) - status = nf90_put_att(ncid,varid, 'long_name', var_grd(i)%req%long_name) - call ice_check_nc(status, subname// ' ERROR: defining long_name for '//var_grd(i)%req%short_name, & - file=__FILE__, line=__LINE__) - status = nf90_put_att(ncid, varid, 'units', var_grd(i)%req%units) - call ice_check_nc(status, subname// ' ERROR: defining units for '//var_grd(i)%req%short_name, & - file=__FILE__, line=__LINE__) + 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__) @@ -503,27 +451,18 @@ subroutine ice_write_hist (ns) 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) - call ice_check_nc(status, subname// ' ERROR: defining variable '//var_nverts(i)%short_name, & - file=__FILE__, line=__LINE__) - status = nf90_put_att(ncid,varid, 'long_name', var_nverts(i)%long_name) - call ice_check_nc(status, subname// ' ERROR: defining long_name for '//var_nverts(i)%short_name, & - file=__FILE__, line=__LINE__) - status = nf90_put_att(ncid, varid, 'units', var_nverts(i)%units) - call ice_check_nc(status, subname// ' ERROR: defining units for '//var_nverts(i)%short_name, & - file=__FILE__, line=__LINE__) + 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 - status = nf90_def_var(ncid, avail_hist_fields(n)%vname, & - lprecision, dimid, varid) - call ice_check_nc(status, subname// ' ERROR: defining variable '//avail_hist_fields(n)%vname, & - file=__FILE__, line=__LINE__) - call ice_write_hist_attrs(ncid,varid,avail_hist_fields(n),ns) + call ice_hist_field_def(ncid, avail_hist_fields(n),lprecision, dimid,ns) endif enddo ! num_avail_hist_fields_2D @@ -534,11 +473,7 @@ subroutine ice_write_hist (ns) 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) - call ice_check_nc(status, subname// ' ERROR: defining variable '//avail_hist_fields(n)%vname, & - file=__FILE__, line=__LINE__) - call ice_write_hist_attrs(ncid,varid,avail_hist_fields(n),ns) + call ice_hist_field_def(ncid, avail_hist_fields(n),lprecision, dimidz,ns) endif enddo ! num_avail_hist_fields_3Dc @@ -549,11 +484,7 @@ subroutine ice_write_hist (ns) 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) - call ice_check_nc(status, subname// ' ERROR: defining variable '//avail_hist_fields(n)%vname, & - file=__FILE__, line=__LINE__) - call ice_write_hist_attrs(ncid,varid,avail_hist_fields(n),ns) + call ice_hist_field_def(ncid, avail_hist_fields(n),lprecision, dimidz,ns) endif enddo ! num_avail_hist_fields_3Dz @@ -564,11 +495,7 @@ subroutine ice_write_hist (ns) 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) - call ice_check_nc(status, subname// ' ERROR: defining variable '//avail_hist_fields(n)%vname, & - file=__FILE__, line=__LINE__) - call ice_write_hist_attrs(ncid,varid,avail_hist_fields(n),ns) + call ice_hist_field_def(ncid, avail_hist_fields(n),lprecision, dimidz,ns) endif enddo ! num_avail_hist_fields_3Db @@ -579,11 +506,7 @@ subroutine ice_write_hist (ns) 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) - call ice_check_nc(status, subname// ' ERROR: defining variable '//avail_hist_fields(n)%vname, & - file=__FILE__, line=__LINE__) - call ice_write_hist_attrs(ncid,varid,avail_hist_fields(n),ns) + call ice_hist_field_def(ncid, avail_hist_fields(n),lprecision, dimidz,ns) endif enddo ! num_avail_hist_fields_3Da @@ -594,11 +517,7 @@ subroutine ice_write_hist (ns) 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) - call ice_check_nc(status, subname// ' ERROR: defining variable '//avail_hist_fields(n)%vname, & - file=__FILE__, line=__LINE__) - call ice_write_hist_attrs(ncid,varid,avail_hist_fields(n),ns) + call ice_hist_field_def(ncid, avail_hist_fields(n),lprecision, dimidz,ns) endif enddo ! num_avail_hist_fields_3Df @@ -610,12 +529,7 @@ subroutine ice_write_hist (ns) 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 - call ice_check_nc(status, subname// ' ERROR: defining variable '//avail_hist_fields(n)%vname, & - file=__FILE__, line=__LINE__) - call ice_write_hist_attrs(ncid,varid,avail_hist_fields(n),ns) + call ice_hist_field_def(ncid, avail_hist_fields(n),lprecision, dimidcz,ns) endif enddo ! num_avail_hist_fields_4Di @@ -627,12 +541,7 @@ subroutine ice_write_hist (ns) 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 - call ice_check_nc(status, subname// ' ERROR: defining variable '//avail_hist_fields(n)%vname, & - file=__FILE__, line=__LINE__) - call ice_write_hist_attrs(ncid,varid,avail_hist_fields(n),ns) + call ice_hist_field_def(ncid, avail_hist_fields(n),lprecision, dimidcz,ns) endif enddo ! num_avail_hist_fields_4Ds @@ -644,13 +553,10 @@ subroutine ice_write_hist (ns) 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 - call ice_check_nc(status, subname// ' ERROR: defining variable '//avail_hist_fields(n)%vname, & - file=__FILE__, line=__LINE__) - call ice_write_hist_attrs(ncid,varid,avail_hist_fields(n),ns) - endif + 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 !----------------------------------------------------------------- @@ -1260,28 +1166,46 @@ subroutine ice_write_hist (ns) 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) call ice_check_nc(status, subname// ' ERROR: defining units for '//hfield%vname, & file=__FILE__, line=__LINE__) @@ -1346,17 +1270,13 @@ subroutine ice_write_hist_attrs(ncid, varid, hfield, ns) 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 @@ -1389,6 +1309,59 @@ subroutine ice_write_hist_fill(ncid,varid,vname,precision) 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 c670bf016..e9be45481 100644 --- a/cicecore/cicedyn/infrastructure/io/io_netcdf/ice_restart.F90 +++ b/cicecore/cicedyn/infrastructure/io/io_netcdf/ice_restart.F90 @@ -18,7 +18,8 @@ module ice_restart 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 @@ -29,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 !======================================================================= @@ -169,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 @@ -216,8 +218,18 @@ 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) call ice_check_nc(status, subname//' ERROR: creating '//trim(filename), file=__FILE__, line=__LINE__) @@ -873,14 +885,32 @@ 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', & file=__FILE__, line=__LINE__) @@ -911,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 bb4ef0ea1..daebe1f2e 100644 --- a/cicecore/cicedyn/infrastructure/io/io_pio2/ice_history_write.F90 +++ b/cicecore/cicedyn/infrastructure/io/io_pio2/ice_history_write.F90 @@ -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,11 +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) @@ -232,64 +236,40 @@ subroutine ice_write_hist (ns) ! define coordinate variables: time, time_bounds !----------------------------------------------------------------- - call ice_pio_check(pio_def_var(File,'time',pio_double,(/timid/),varid), & - subname//' ERROR: defining var time',file=__FILE__,line=__LINE__) - call ice_pio_check(pio_put_att(File,varid,'long_name','time'), & - subname//' ERROR: defining att long_name time',file=__FILE__,line=__LINE__) - write(cdate,'(i8.8)') idate0 - write(title,'(a,a4,a1,a2,a1,a2,a1,i2.2,a1,i2.2,a1,i2.2)') 'days since ', & + 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 - call ice_pio_check(pio_put_att(File,varid,'units',trim(title)), & - subname//' ERROR: defining att units '//trim(title),file=__FILE__,line=__LINE__) if (days_per_year == 360) then - call ice_pio_check(pio_put_att(File,varid,'calendar','360_day'), & - subname//' ERROR: defining att calendar 360',file=__FILE__,line=__LINE__) + cal_att='360_day' elseif (days_per_year == 365 .and. .not.use_leap_years ) then - call ice_pio_check(pio_put_att(File,varid,'calendar','noleap'), & - subname//' ERROR: defining att calendar noleap',file=__FILE__,line=__LINE__) + cal_att='noleap' elseif (use_leap_years) then - call ice_pio_check(pio_put_att(File,varid,'calendar','Gregorian'), & - subname//' ERROR: defining att calendar Gregorian',file=__FILE__,line=__LINE__) + cal_att='Gregorian' else call abort_ice(subname//' ERROR: invalid calendar settings') 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 + ! 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_pio_check(pio_def_var(File,'time_bounds',pio_double,dimid2,varid), & - subname//' ERROR: defining var time_bounds',file=__FILE__,line=__LINE__) - call ice_pio_check(pio_put_att(File,varid,'long_name', 'time interval endpoints'), & - subname//' ERROR: defining att long_name time interval endpoints',file=__FILE__,line=__LINE__) - - if (days_per_year == 360) then - call ice_pio_check(pio_put_att(File,varid,'calendar','360_day'), & - subname//' ERROR: defining att calendar 360 time bounds',file=__FILE__,line=__LINE__) - elseif (days_per_year == 365 .and. .not.use_leap_years ) then - call ice_pio_check(pio_put_att(File,varid,'calendar','noleap'), & - subname//' ERROR: defining att calendar noleap time bounds',file=__FILE__,line=__LINE__) - elseif (use_leap_years) then - call ice_pio_check(pio_put_att(File,varid,'calendar','Gregorian'), & - subname//' ERROR: defining att calendar Gregorian time bounds',file=__FILE__,line=__LINE__) - 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 - call ice_pio_check(pio_put_att(File,varid,'units',trim(title)), & - subname//' ERROR: defining att units '//trim(title),file=__FILE__,line=__LINE__) + 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 !----------------------------------------------------------------- @@ -438,12 +418,7 @@ subroutine ice_write_hist (ns) dimid2(2) = jmtid do i = 1, ncoord - call ice_pio_check(pio_def_var(File, trim(var_coord(i)%short_name), lprecision,dimid2, varid), & - subname//' ERROR: defining var '//trim(var_coord(i)%short_name),file=__FILE__,line=__LINE__) - call ice_pio_check(pio_put_att(File,varid,'long_name',trim(var_coord(i)%long_name)), & - subname//' ERROR: defining att long_name '//trim(var_coord(i)%long_name),file=__FILE__,line=__LINE__) - call ice_pio_check(pio_put_att(File, varid, 'units', trim(var_coord(i)%units)), & - subname//' ERROR: defining att units '//trim(var_coord(i)%units),file=__FILE__,line=__LINE__) + 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', & @@ -466,23 +441,13 @@ subroutine ice_write_hist (ns) do i = 1, nvar_grdz if (igrdz(i)) then - call ice_pio_check(pio_def_var(File, trim(var_grdz(i)%short_name), lprecision,(/dimidex(i)/), varid), & - subname//' ERROR: defining var'//trim(var_grdz(i)%short_name),file=__FILE__,line=__LINE__) - call ice_pio_check(pio_put_att(File, varid, 'long_name', var_grdz(i)%long_name), & - subname//' ERROR: defining att long_name '//trim(var_grdz(i)%long_name),file=__FILE__,line=__LINE__) - call ice_pio_check(pio_put_att(File, varid, 'units' , var_grdz(i)%units), & - subname//' ERROR: defining att units '//trim(var_grdz(i)%units),file=__FILE__,line=__LINE__) + 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_pio_check(pio_def_var(File, trim(var_grd(i)%req%short_name), lprecision, dimid2, varid), & - subname//' ERROR: defining var'//trim(var_grd(i)%req%short_name),file=__FILE__,line=__LINE__) - call ice_pio_check(pio_put_att(File,varid, 'long_name', trim(var_grd(i)%req%long_name)), & - subname//' ERROR: defining att long_name '//trim(var_grd(i)%req%long_name),file=__FILE__,line=__LINE__) - call ice_pio_check(pio_put_att(File, varid, 'units', trim(var_grd(i)%req%units)), & - subname//' ERROR: defining att units '//trim(var_grd(i)%req%units),file=__FILE__,line=__LINE__) + 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) @@ -495,12 +460,7 @@ subroutine ice_write_hist (ns) dimid_nverts(3) = jmtid do i = 1, nvar_verts if (f_bounds) then - call ice_pio_check(pio_def_var(File, trim(var_nverts(i)%short_name),lprecision,dimid_nverts, varid), & - subname//' ERROR: defining var'//trim(var_nverts(i)%short_name),file=__FILE__,line=__LINE__) - call ice_pio_check(pio_put_att(File,varid, 'long_name', trim(var_nverts(i)%long_name)), & - subname//' ERROR: defining att long_name '//trim(var_nverts(i)%long_name),file=__FILE__,line=__LINE__) - call ice_pio_check(pio_put_att(File, varid, 'units', trim(var_nverts(i)%units)), & - subname//' ERROR: defining att units '//trim(var_nverts(i)%units),file=__FILE__,line=__LINE__) + 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 @@ -509,26 +469,18 @@ subroutine ice_write_hist (ns) ! define attributes for time-variant variables !----------------------------------------------------------------- - !----------------------------------------------------------------- ! 2D - !----------------------------------------------------------------- - 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 - call ice_pio_check(pio_def_var(File, trim(avail_hist_fields(n)%vname), lprecision, dimid3, varid), & - subname//' ERROR: defining var'//trim(avail_hist_fields(n)%vname),file=__FILE__,line=__LINE__) - call ice_write_hist_attrs(File,varid,avail_hist_fields(n),ns) + call ice_hist_field_def(File, avail_hist_fields(n),lprecision, dimid3, ns) endif - enddo ! num_avail_hist_fields_2D + enddo - !----------------------------------------------------------------- ! 3D (category) - !----------------------------------------------------------------- - dimidz(1) = imtid dimidz(2) = jmtid dimidz(3) = cmtid @@ -536,16 +488,11 @@ subroutine ice_write_hist (ns) do n = n2D + 1, n3Dccum if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then - call ice_pio_check(pio_def_var(File, trim(avail_hist_fields(n)%vname), lprecision, dimidz, varid), & - subname//' ERROR: defining var'//trim(avail_hist_fields(n)%vname),file=__FILE__,line=__LINE__) - call ice_write_hist_attrs(File,varid,avail_hist_fields(n),ns) + 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 @@ -553,16 +500,11 @@ subroutine ice_write_hist (ns) do n = n3Dccum + 1, n3Dzcum if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then - call ice_pio_check(pio_def_var(File, trim(avail_hist_fields(n)%vname), lprecision, dimidz, varid), & - subname//' ERROR: defining var'//trim(avail_hist_fields(n)%vname),file=__FILE__,line=__LINE__) - call ice_write_hist_attrs(File,varid,avail_hist_fields(n),ns) + 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 @@ -570,16 +512,11 @@ subroutine ice_write_hist (ns) do n = n3Dzcum + 1, n3Dbcum if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then - call ice_pio_check(pio_def_var(File, trim(avail_hist_fields(n)%vname), lprecision, dimidz, varid), & - subname//' ERROR: defining var'//trim(avail_hist_fields(n)%vname),file=__FILE__,line=__LINE__) - call ice_write_hist_attrs(File,varid,avail_hist_fields(n),ns) + 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 @@ -587,16 +524,11 @@ subroutine ice_write_hist (ns) do n = n3Dbcum + 1, n3Dacum if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then - call ice_pio_check(pio_def_var(File, trim(avail_hist_fields(n)%vname), lprecision, dimidz, varid), & - subname//' ERROR: defining var'//trim(avail_hist_fields(n)%vname),file=__FILE__,line=__LINE__) - call ice_write_hist_attrs(File,varid,avail_hist_fields(n),ns) + 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 @@ -604,21 +536,11 @@ subroutine ice_write_hist (ns) do n = n3Dacum + 1, n3Dfcum if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then - call ice_pio_check(pio_def_var(File, trim(avail_hist_fields(n)%vname), lprecision, dimidz, varid), & - subname//' ERROR: defining var'//trim(avail_hist_fields(n)%vname),file=__FILE__,line=__LINE__) - call ice_write_hist_attrs(File,varid,avail_hist_fields(n),ns) + call ice_hist_field_def(File, avail_hist_fields(n),lprecision, dimidz,ns) endif enddo ! num_avail_hist_fields_3Df - !----------------------------------------------------------------- - ! define attributes for 4D variables - ! time coordinate is dropped - !----------------------------------------------------------------- - - !----------------------------------------------------------------- ! 4D (ice categories) - !----------------------------------------------------------------- - dimidcz(1) = imtid dimidcz(2) = jmtid dimidcz(3) = kmtidi @@ -627,16 +549,11 @@ subroutine ice_write_hist (ns) do n = n3Dfcum + 1, n4Dicum if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then - call ice_pio_check(pio_def_var(File, trim(avail_hist_fields(n)%vname), lprecision, dimidcz, varid), & - subname//' ERROR: defining var'//trim(avail_hist_fields(n)%vname),file=__FILE__,line=__LINE__) - call ice_write_hist_attrs(File,varid,avail_hist_fields(n),ns) + 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 @@ -645,16 +562,11 @@ subroutine ice_write_hist (ns) do n = n4Dicum + 1, n4Dscum if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then - call ice_pio_check(pio_def_var(File, trim(avail_hist_fields(n)%vname), lprecision, dimidcz, varid), & - subname//' ERROR: defining var'//trim(avail_hist_fields(n)%vname),file=__FILE__,line=__LINE__) - call ice_write_hist_attrs(File,varid,avail_hist_fields(n),ns) + 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 @@ -663,9 +575,7 @@ subroutine ice_write_hist (ns) do n = n4Dscum + 1, n4Dfcum if (avail_hist_fields(n)%vhistfreq == histfreq(ns) .or. write_ic) then - call ice_pio_check(pio_def_var(File, trim(avail_hist_fields(n)%vname), lprecision, dimidcz, varid), & - subname//' ERROR: defining var'//trim(avail_hist_fields(n)%vname),file=__FILE__,line=__LINE__) - call ice_write_hist_attrs(File,varid,avail_hist_fields(n),ns) + call ice_hist_field_def(File, avail_hist_fields(n),lprecision, dimidcz,ns) endif enddo ! num_avail_hist_fields_4Df @@ -686,7 +596,7 @@ subroutine ice_write_hist (ns) 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) + 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__) @@ -741,13 +651,13 @@ subroutine ice_write_hist (ns) 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__) - if (history_format == 'pio_pnetcdf') then - call ice_pio_check(pio_put_att(File,pio_global,'io_flavor','io_pio pnetcdf'), & - subname//' ERROR: defining att io_flavor',file=__FILE__,line=__LINE__) - else - call ice_pio_check(pio_put_att(File,pio_global,'io_flavor','io_pio netcdf'), & - subname//' ERROR: defining att io_flavor',file=__FILE__,line=__LINE__) - endif +#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 @@ -1315,7 +1225,6 @@ subroutine ice_write_hist (ns) ! similarly for num_avail_hist_fields_4Db (define workd4b, iodesc4db) - !----------------------------------------------------------------- ! clean-up PIO descriptors !----------------------------------------------------------------- @@ -1342,27 +1251,119 @@ 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 + + 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 - subroutine ice_write_hist_attrs(File, varid, hfield, ns) + 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_def_var(File, hfield%vname, lprecision, dimids, varid) + call ice_pio_check(status, & + subname//' ERROR: defining var '//hfield%vname,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 var '//hfield%vname,file=__FILE__,line=__LINE__) + endif + + 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__) @@ -1418,17 +1419,17 @@ subroutine ice_write_hist_attrs(File, varid, hfield, ns) 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_pio, only: ice_pio_check 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 + 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 diff --git a/cicecore/cicedyn/infrastructure/io/io_pio2/ice_pio.F90 b/cicecore/cicedyn/infrastructure/io/io_pio2/ice_pio.F90 index 8b02fb75e..565e7adbb 100644 --- a/cicecore/cicedyn/infrastructure/io/io_pio2/ice_pio.F90 +++ b/cicecore/cicedyn/infrastructure/io/io_pio2/ice_pio.F90 @@ -44,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 @@ -59,22 +60,31 @@ 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 , istride, basetask, numiotasks, rearranger, pio_iotype, status, nmode - logical :: lclobber, lcdf64, exists - logical, save :: first_call = .true. + integer :: nprocs , lstride, lroot, liotasks, rearranger + integer :: pio_iotype, status, nmode0, nmode + logical :: lclobber, exists, ldebug character(len=*), parameter :: subname = '(ice_pio_init)' #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 @@ -86,74 +96,113 @@ 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) + 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) - !--- 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 - #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 create file '//trim(filename), & + 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) @@ -168,8 +217,7 @@ subroutine ice_pio_init(mode, filename, File, clobber, cdf64, iotype) 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__) diff --git a/cicecore/cicedyn/infrastructure/io/io_pio2/ice_restart.F90 b/cicecore/cicedyn/infrastructure/io/io_pio2/ice_restart.F90 index e55acc434..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,7 +54,9 @@ subroutine init_restart_read(ice_ic) character(len=char_len_long) :: & filename, filename0 - integer (kind=int_kind) :: status, iotype + integer (kind=int_kind) :: status + + logical (kind=log_kind), save :: first_call = .true. character(len=*), parameter :: subname = '(init_restart_read)' @@ -76,15 +77,21 @@ subroutine init_restart_read(ice_ic) write(nu_diag,*) 'Using restart dump=', trim(filename) end if - 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) +! 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) + 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 @@ -133,6 +140,8 @@ subroutine init_restart_read(ice_ic) npt = npt - istep0 endif + first_call = .false. + end subroutine init_restart_read !======================================================================= @@ -172,17 +181,16 @@ subroutine init_restart_write(filename_spec) character(len=char_len_long) :: filename integer (kind=int_kind) :: & - dimid_ni, dimid_nj, dimid_ncat, & - dimid_nilyr, dimid_nslyr, dimid_naero + 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 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) @@ -222,11 +230,11 @@ subroutine init_restart_write(filename_spec) close(nu_rst_pointer) endif - 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) + 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) @@ -674,6 +682,8 @@ subroutine init_restart_write(filename_spec) write(nu_diag,*) 'Writing ',filename(1:lenstr(filename)) endif + first_call = .false. + end subroutine init_restart_write !======================================================================= @@ -907,14 +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) :: chunks(size(dims)), i, status + character(len=*), parameter :: subname = '(define_rest_field)' - call ice_pio_check(pio_def_var(File,trim(vname),pio_double,dims,vardesc), & - subname//' ERROR: def_var '//trim(vname),file=__FILE__,line=__LINE__) + + 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 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/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 e33d16c18..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/' 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/options/set_env.iopio1p b/configuration/scripts/options/set_env.iopio1p deleted file mode 100644 index 1a92353ce..000000000 --- a/configuration/scripts/options/set_env.iopio1p +++ /dev/null @@ -1,2 +0,0 @@ -setenv ICE_IOTYPE pio1 -setenv ICE_CPPDEFS -DUSE_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.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/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 1249feb08..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", "" 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 7ba3f35ad..b8bde525d 100644 --- a/doc/source/user_guide/ug_case_settings.rst +++ b/doc/source/user_guide/ug_case_settings.rst @@ -38,7 +38,7 @@ can be found in :ref:`cicecpps`. The following CPPs are available. "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_PIO1", "Modifies pio code to be compatible with PIO1. By default, code is compatible with PIO2" + "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 " @@ -84,11 +84,13 @@ can be modified as needed. "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" - " ", "pio", "uses io_pio directory, supports netCDF and parallel netCDF thru PIO interfaces" + " ", "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", " " @@ -194,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``" @@ -209,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" @@ -227,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``", "" 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 From 64177e3e5658711f5f19030ddfcc6927f1dbda5d Mon Sep 17 00:00:00 2001 From: Philippe Blain Date: Thu, 22 Feb 2024 19:46:22 -0500 Subject: [PATCH 58/76] io: allow disabling coordinates in history files (#935) * ice_history_shared: add namelist flags for coordinate variables Users might not wish for all 8 coordinate variables to be written to each history file, so add namelist flags allowing to disable each coordinate variable independantly, following the approach used for the other grid variables. Move the definition of 'ncoord' from each IO backend to 'ice_history_shared'. Note that we already 'use' the whole of ice_history_shared in ice_history_write, so we do not need to adjust the use statement. Note that the code that writes these variables in module 'ice_history_write' in each of the IO backends is not modified, it will be adjusted in a following commit. * io_{netcdf,pio2}/ice_history_write: define coordinates attributes in a loop In ice_history_write::ice_write_hist, we initialize the 'var_coord' and 'coord_bounds' arrays by manually incrementing 'ind' and initializing each elements with the corresponding information for each coordinate variable. The rest of the code in that subroutine instead uses a loop on 'ncoord', which is a parameter holding the number of coordinates variable, along with 'select' statements. The latter approach is more elegant and also more flexible if we change the number of coordinates variables. Refactor the code to use a loop and leverage the integers n_{u,t,n,e}{lon,lat} added in the previous commit, in both io_netcdf and io_pio2, which have identical code in this part of the subroutine. * io_{netcdf,pio2}/ice_history_write: use namelist flags for coordinate variables In order to enable the namelist flags for each coordinate variables added in the previous commit, adjust the code of the io_netcdf and io_pio2 backends by checking the value of 'icoord(i)' for each loop on 'ncoord' that calls NetCDF or PIO functions. Add the new flags to the reference namelist. --- cicecore/cicedyn/analysis/ice_history.F90 | 23 +++ .../cicedyn/analysis/ice_history_shared.F90 | 19 ++ .../io/io_netcdf/ice_history_write.F90 | 176 +++++++++--------- .../io/io_pio2/ice_history_write.F90 | 158 ++++++++-------- configuration/scripts/ice_in | 8 + 5 files changed, 221 insertions(+), 163 deletions(-) diff --git a/cicecore/cicedyn/analysis/ice_history.F90 b/cicecore/cicedyn/analysis/ice_history.F90 index 87a339529..45a4bede0 100644 --- a/cicecore/cicedyn/analysis/ice_history.F90 +++ b/cicecore/cicedyn/analysis/ice_history.F90 @@ -447,6 +447,14 @@ subroutine init_hist (dt) if (f_Tsnz (1:1) /= 'x') f_VGRDs = .true. if (tr_fsd) f_NFSD = .true. + call broadcast_scalar (f_tlon, master_task) + call broadcast_scalar (f_tlat, master_task) + call broadcast_scalar (f_ulon, master_task) + call broadcast_scalar (f_ulat, master_task) + call broadcast_scalar (f_nlon, master_task) + call broadcast_scalar (f_nlat, master_task) + call broadcast_scalar (f_elon, master_task) + call broadcast_scalar (f_elat, master_task) call broadcast_scalar (f_tmask, master_task) call broadcast_scalar (f_umask, master_task) call broadcast_scalar (f_nmask, master_task) @@ -1973,6 +1981,21 @@ subroutine init_hist (dt) ! floe size distribution call init_hist_fsd_4Df + !----------------------------------------------------------------- + ! fill icoord array with namelist values + !----------------------------------------------------------------- + + icoord=.true. + + icoord(n_tlon ) = f_tlon + icoord(n_tlat ) = f_tlat + icoord(n_ulon ) = f_ulon + icoord(n_ulat ) = f_ulat + icoord(n_nlon ) = f_nlon + icoord(n_nlat ) = f_nlat + icoord(n_elon ) = f_elon + icoord(n_elat ) = f_elat + !----------------------------------------------------------------- ! fill igrd array with namelist values !----------------------------------------------------------------- diff --git a/cicecore/cicedyn/analysis/ice_history_shared.F90 b/cicecore/cicedyn/analysis/ice_history_shared.F90 index ac2cf8afb..678888b09 100644 --- a/cicecore/cicedyn/analysis/ice_history_shared.F90 +++ b/cicecore/cicedyn/analysis/ice_history_shared.F90 @@ -131,6 +131,7 @@ module ice_history_shared avail_hist_fields(max_avail_hist_fields) integer (kind=int_kind), parameter, public :: & + ncoord = 8 , & ! number of coordinate variables: TLON, TLAT, ULON, ULAT, NLON, NLAT, ELON, ELAT nvar_grd = 21 , & ! number of grid fields that can be written ! excluding grid vertices nvar_grdz = 6 ! number of category/vertical grid fields written @@ -165,6 +166,7 @@ module ice_history_shared avgct(max_nstrm) ! average sample counter logical (kind=log_kind), public :: & + icoord(ncoord) , & ! true if coord field is written to output file igrd (nvar_grd), & ! true if grid field is written to output file igrdz(nvar_grdz) ! true if category/vertical grid field is written @@ -194,6 +196,10 @@ module ice_history_shared !--------------------------------------------------------------- logical (kind=log_kind), public :: & + f_tlon = .true., f_tlat = .true., & + f_ulon = .true., f_ulat = .true., & + f_nlon = .true., f_nlat = .true., & + f_elon = .true., f_elat = .true., & f_tmask = .true., f_umask = .true., & f_nmask = .true., f_emask = .true., & f_blkmask = .true., & @@ -362,6 +368,10 @@ module ice_history_shared !--------------------------------------------------------------- namelist / icefields_nml / & + f_tlon , f_tlat , & + f_ulon , f_ulat , & + f_nlon , f_nlat , & + f_elon , f_elat , & f_tmask , f_umask , & f_nmask , f_emask , & f_blkmask , & @@ -529,6 +539,15 @@ module ice_history_shared !--------------------------------------------------------------- integer (kind=int_kind), parameter, public :: & + n_tlon = 1, & + n_tlat = 2, & + n_ulon = 3, & + n_ulat = 4, & + n_nlon = 5, & + n_nlat = 6, & + n_elon = 7, & + n_elat = 8, & + n_tmask = 1, & n_umask = 2, & n_nmask = 3, & 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 c03bc233a..396c52e37 100644 --- a/cicecore/cicedyn/infrastructure/io/io_netcdf/ice_history_write.F90 +++ b/cicecore/cicedyn/infrastructure/io/io_netcdf/ice_history_write.F90 @@ -113,9 +113,6 @@ subroutine ice_write_hist (ns) ! 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 - ! 4 vertices in each grid cell INTEGER (kind=int_kind), PARAMETER :: nverts = 4 @@ -263,39 +260,42 @@ subroutine ice_write_hist (ns) ! 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' + do ind = 1, ncoord + select case (ind) + case(n_tlon) + var_coord(ind) = coord_attributes('TLON', & + 'T grid center longitude', 'degrees_east') + coord_bounds(ind) = 'lont_bounds' + case(n_tlat) + var_coord(ind) = coord_attributes('TLAT', & + 'T grid center latitude', 'degrees_north') + coord_bounds(ind) = 'latt_bounds' + case(n_ulon) + var_coord(ind) = coord_attributes('ULON', & + 'U grid center longitude', 'degrees_east') + coord_bounds(ind) = 'lonu_bounds' + case(n_ulat) + var_coord(ind) = coord_attributes('ULAT', & + 'U grid center latitude', 'degrees_north') + coord_bounds(ind) = 'latu_bounds' + case(n_nlon) + var_coord(ind) = coord_attributes('NLON', & + 'N grid center longitude', 'degrees_east') + coord_bounds(ind) = 'lonn_bounds' + case(n_nlat) + var_coord(ind) = coord_attributes('NLAT', & + 'N grid center latitude', 'degrees_north') + coord_bounds(ind) = 'latn_bounds' + case(n_elon) + var_coord(ind) = coord_attributes('ELON', & + 'E grid center longitude', 'degrees_east') + coord_bounds(ind) = 'lone_bounds' + case(n_elat) + var_coord(ind) = coord_attributes('ELAT', & + 'E grid center latitude', 'degrees_north') + coord_bounds(ind) = 'late_bounds' + end select + end do var_grdz(1) = coord_attributes('NCAT', 'category maximum thickness', 'm') var_grdz(2) = coord_attributes('VGRDi', 'vertical ice levels', '1') @@ -406,18 +406,20 @@ subroutine ice_write_hist (ns) 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__) + if(icoord(i)) then + 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 endif enddo @@ -707,44 +709,46 @@ subroutine ice_write_hist (ns) !----------------------------------------------------------------- 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) - CASE ('TLAT') - 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) - CASE ('ULAT') - 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) - CASE ('NLAT') - 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) - 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) - 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__) + if(icoord(i)) then + 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) + CASE ('TLAT') + 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) + CASE ('ULAT') + 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) + CASE ('NLAT') + 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) + 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) + 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 endif enddo 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 daebe1f2e..0281f3721 100644 --- a/cicecore/cicedyn/infrastructure/io/io_pio2/ice_history_write.F90 +++ b/cicecore/cicedyn/infrastructure/io/io_pio2/ice_history_write.F90 @@ -110,9 +110,6 @@ subroutine ice_write_hist (ns) ! 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 - ! 4 vertices in each grid cell INTEGER (kind=int_kind), PARAMETER :: nverts = 4 @@ -276,39 +273,42 @@ subroutine ice_write_hist (ns) ! 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' + do ind = 1, ncoord + select case (ind) + case(n_tlon) + var_coord(ind) = coord_attributes('TLON', & + 'T grid center longitude', 'degrees_east') + coord_bounds(ind) = 'lont_bounds' + case(n_tlat) + var_coord(ind) = coord_attributes('TLAT', & + 'T grid center latitude', 'degrees_north') + coord_bounds(ind) = 'latt_bounds' + case(n_ulon) + var_coord(ind) = coord_attributes('ULON', & + 'U grid center longitude', 'degrees_east') + coord_bounds(ind) = 'lonu_bounds' + case(n_ulat) + var_coord(ind) = coord_attributes('ULAT', & + 'U grid center latitude', 'degrees_north') + coord_bounds(ind) = 'latu_bounds' + case(n_nlon) + var_coord(ind) = coord_attributes('NLON', & + 'N grid center longitude', 'degrees_east') + coord_bounds(ind) = 'lonn_bounds' + case(n_nlat) + var_coord(ind) = coord_attributes('NLAT', & + 'N grid center latitude', 'degrees_north') + coord_bounds(ind) = 'latn_bounds' + case(n_elon) + var_coord(ind) = coord_attributes('ELON', & + 'E grid center longitude', 'degrees_east') + coord_bounds(ind) = 'lone_bounds' + case(n_elat) + var_coord(ind) = coord_attributes('ELAT', & + 'E grid center latitude', 'degrees_north') + coord_bounds(ind) = 'late_bounds' + end select + end do var_grdz(1) = coord_attributes('NCAT', 'category maximum thickness', 'm') var_grdz(2) = coord_attributes('VGRDi', 'vertical ice levels', '1') @@ -418,16 +418,18 @@ subroutine ice_write_hist (ns) 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__) + if (icoord(i)) then + 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 endif enddo @@ -706,38 +708,40 @@ subroutine ice_write_hist (ns) allocate(workr2(nx_block,ny_block,nblocks)) 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) - CASE ('TLAT') - workd2(:,:,:) = tlat(:,:,1:nblocks)*rad_to_deg - CASE ('ULON') - workd2(:,:,:) = ulon(:,:,1:nblocks)*rad_to_deg - CASE ('ULAT') - workd2(:,:,:) = ulat(:,:,1:nblocks)*rad_to_deg - CASE ('NLON') - workd2(:,:,:) = nlon(:,:,1:nblocks)*rad_to_deg - CASE ('NLAT') - workd2(:,:,:) = nlat(:,:,1:nblocks)*rad_to_deg - CASE ('ELON') - 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 + if(icoord(i)) then + 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) + CASE ('TLAT') + workd2(:,:,:) = tlat(:,:,1:nblocks)*rad_to_deg + CASE ('ULON') + workd2(:,:,:) = ulon(:,:,1:nblocks)*rad_to_deg + CASE ('ULAT') + workd2(:,:,:) = ulat(:,:,1:nblocks)*rad_to_deg + CASE ('NLON') + workd2(:,:,:) = nlon(:,:,1:nblocks)*rad_to_deg + CASE ('NLAT') + workd2(:,:,:) = nlat(:,:,1:nblocks)*rad_to_deg + CASE ('ELON') + 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 - call ice_pio_check(status,subname//' ERROR: writing '//avail_hist_fields(n)%vname, & - file=__FILE__,line=__LINE__) + call ice_pio_check(status,subname//' ERROR: writing '//avail_hist_fields(n)%vname, & + file=__FILE__,line=__LINE__) + endif enddo ! Extra dimensions (NCAT, NFSD, VGRD*) diff --git a/configuration/scripts/ice_in b/configuration/scripts/ice_in index 103c56d2a..63a97d7d8 100644 --- a/configuration/scripts/ice_in +++ b/configuration/scripts/ice_in @@ -471,6 +471,14 @@ / &icefields_nml + f_tlon = .true. + f_tlat = .true. + f_ulon = .true. + f_ulat = .true. + f_nlon = .true. + f_nlat = .true. + f_elon = .true. + f_elat = .true. f_tmask = .true. f_umask = .false. f_nmask = .false. From 1a530ec749028c7abbab44b3c83b9f9d9475ad60 Mon Sep 17 00:00:00 2001 From: Anton Steketee <79179784+anton-seaice@users.noreply.github.com> Date: Thu, 29 Feb 2024 08:17:00 +1100 Subject: [PATCH 59/76] Typo in nmode0 in PIO for CESM_COUPLED (#938) For CESMCOUPLED, the pio_iotype is set though CMEPS. For completeness, we also need to check the ioformat set through CMEPS. ioformat is used to set the nmode0. nmode0 and clobber combine to set the nmode flag for pio_createfile / pio_openfile operations. Due a typo nmode0 was not being set for netcdf4 iotypes (before this change). --- cicecore/cicedyn/infrastructure/io/io_pio2/ice_pio.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cicecore/cicedyn/infrastructure/io/io_pio2/ice_pio.F90 b/cicecore/cicedyn/infrastructure/io/io_pio2/ice_pio.F90 index 565e7adbb..9028fa9b7 100644 --- a/cicecore/cicedyn/infrastructure/io/io_pio2/ice_pio.F90 +++ b/cicecore/cicedyn/infrastructure/io/io_pio2/ice_pio.F90 @@ -83,7 +83,7 @@ subroutine ice_pio_init(mode, filename, File, clobber, fformat, & if ((pio_iotype==PIO_IOTYPE_NETCDF).or.(pio_iotype==PIO_IOTYPE_PNETCDF)) then nmode0 = shr_pio_getioformat(inst_name) else - nmode=0 + nmode0 = 0 endif call pio_seterrorhandling(ice_pio_subsystem, PIO_RETURN_ERROR) From 9f30120897f7e27178c7e99357efd47d09923bee Mon Sep 17 00:00:00 2001 From: Anton Steketee <79179784+anton-seaice@users.noreply.github.com> Date: Thu, 29 Feb 2024 08:20:48 +1100 Subject: [PATCH 60/76] Set 'idate0' and 'use_leap_years' in nuopc cap (#936) Set idate0 in nuopc cap, so that the history "time:units" attribute in netcdf output is consistent with other model components. Set use_leap_years in nuopc cap, so that netcdf output "time:calendar" is set correctly in history output Co-authored-by: Denise Worthen --- .../drivers/nuopc/cmeps/ice_comp_nuopc.F90 | 25 +++++++++++++++---- 1 file changed, 20 insertions(+), 5 deletions(-) diff --git a/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 b/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 index efadabbda..6228c0bdd 100644 --- a/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 +++ b/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 @@ -23,10 +23,10 @@ module ice_comp_nuopc use ice_domain_size , only : nx_global, ny_global use ice_grid , only : grid_format, init_grid2 use ice_communicate , only : init_communicate, my_task, master_task, mpi_comm_ice - use ice_calendar , only : force_restart_now, write_ic, init_calendar - use ice_calendar , only : idate, mday, mmonth, myear, year_init + use ice_calendar , only : force_restart_now, write_ic + use ice_calendar , only : idate, idate0, mday, mmonth, myear, year_init, month_init, day_init use ice_calendar , only : msec, dt, calendar, calendar_type, nextsw_cday, istep - use ice_calendar , only : ice_calendar_noleap, ice_calendar_gregorian + use ice_calendar , only : ice_calendar_noleap, ice_calendar_gregorian, use_leap_years 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 @@ -676,6 +676,8 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) 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 @@ -789,7 +791,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) call cice_init2() call t_stopf ('cice_init2') !--------------------------------------------------------------------------- - ! use EClock to reset calendar information on initial start + ! use EClock to reset calendar information !--------------------------------------------------------------------------- ! - on initial run @@ -805,7 +807,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) if (ref_ymd /= start_ymd .or. ref_tod /= start_tod) then if (my_task == master_task) then write(nu_diag,*) trim(subname),': ref_ymd ',ref_ymd, ' must equal start_ymd ',start_ymd - write(nu_diag,*) trim(subname),': ref_ymd ',ref_tod, ' must equal start_ymd ',start_tod + write(nu_diag,*) trim(subname),': ref_tod',ref_tod, ' must equal start_tod ',start_tod end if end if @@ -837,6 +839,19 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) end if + ! - start time from ESMF clock. Used to set history time units + idate0 = start_ymd + year_init = (idate0/10000) + month_init= (idate0-year_init*10000)/100 ! integer month of basedate + day_init = idate0-year_init*10000-month_init*100 + + ! - Set use_leap_years based on calendar (as some CICE calls use this instead of the calendar type) + if (calendar_type == ice_calendar_gregorian) then + use_leap_years = .true. + else + use_leap_years = .false. ! no_leap calendars + endif + call calendar() ! update calendar info !---------------------------------------------------------------------------- From 740f2a65e055e37bebc81aa25675ebc2a65d735d Mon Sep 17 00:00:00 2001 From: Tony Craig Date: Thu, 29 Feb 2024 12:32:52 -0800 Subject: [PATCH 61/76] Port to Carpenter (#939) Port CICE to Carpenter for intel, cray, and gnu compilers with mpich. Will add weekly testing on Carpenter, Onyx was recently decommissioned. During development, - It was discovered that the serial compilers and parallel compilers produce different results. This was reported to sys admins. Serial compilation is done with the parallel compilers to ensure bit-for-bit results with serial and mpi comm versions. - It was discovered that the openmpi and intel mpi options are not working properly. This was reported to sys admins. All testing is done with mpich for now. --- configuration/scripts/cice.batch.csh | 2 +- configuration/scripts/cice.launch.csh | 2 +- .../scripts/machines/Macros.carpenter_cray | 60 ++++++++++++++++ .../scripts/machines/Macros.carpenter_gnu | 69 +++++++++++++++++++ .../scripts/machines/Macros.carpenter_intel | 59 ++++++++++++++++ .../scripts/machines/env.carpenter_cray | 54 +++++++++++++++ .../scripts/machines/env.carpenter_gnu | 58 ++++++++++++++++ .../scripts/machines/env.carpenter_intel | 57 +++++++++++++++ 8 files changed, 359 insertions(+), 2 deletions(-) create mode 100644 configuration/scripts/machines/Macros.carpenter_cray create mode 100644 configuration/scripts/machines/Macros.carpenter_gnu create mode 100644 configuration/scripts/machines/Macros.carpenter_intel create mode 100644 configuration/scripts/machines/env.carpenter_cray create mode 100644 configuration/scripts/machines/env.carpenter_gnu create mode 100644 configuration/scripts/machines/env.carpenter_intel diff --git a/configuration/scripts/cice.batch.csh b/configuration/scripts/cice.batch.csh index 33b27cbf8..50ef665bd 100755 --- a/configuration/scripts/cice.batch.csh +++ b/configuration/scripts/cice.batch.csh @@ -83,7 +83,7 @@ cat >> ${jobfile} << EOFB #PBS -l walltime=${batchtime} EOFB -else if (${ICE_MACHINE} =~ gaffney* || ${ICE_MACHINE} =~ koehr* || ${ICE_MACHINE} =~ mustang*) then +else if (${ICE_MACHINE} =~ gaffney* || ${ICE_MACHINE} =~ koehr* || ${ICE_MACHINE} =~ mustang* || ${ICE_MACHINE} =~ carpenter*) then cat >> ${jobfile} << EOFB #PBS -N ${shortcase} #PBS -q ${queue} diff --git a/configuration/scripts/cice.launch.csh b/configuration/scripts/cice.launch.csh index f8347e101..85d647d76 100755 --- a/configuration/scripts/cice.launch.csh +++ b/configuration/scripts/cice.launch.csh @@ -89,7 +89,7 @@ mpirun -np ${ntasks} -hostfile \$PBS_NODEFILE \${EXTRA_OMPI_SETTINGS} ./cice >&! EOFR #======= -else if (${ICE_MACHCOMP} =~ onyx* || ${ICE_MACHCOMP} =~ narwhal*) then +else if (${ICE_MACHCOMP} =~ onyx* || ${ICE_MACHCOMP} =~ narwhal* || ${ICE_MACHCOMP} =~ carpenter*) then cat >> ${jobfile} << EOFR aprun -q -n ${ntasks} -N ${taskpernodelimit} -d ${nthrds} ./cice >&! \$ICE_RUNLOG_FILE EOFR diff --git a/configuration/scripts/machines/Macros.carpenter_cray b/configuration/scripts/machines/Macros.carpenter_cray new file mode 100644 index 000000000..8496f7a9b --- /dev/null +++ b/configuration/scripts/machines/Macros.carpenter_cray @@ -0,0 +1,60 @@ +#============================================================================== +# Macros file for NAVYDSRC narwhal, cray compiler +#============================================================================== + +CPP := ftn -e P +CPPDEFS := -DFORTRANUNDERSCORE -DNO_R16 ${ICE_CPPDEFS} +CFLAGS := -c -O2 + +FIXEDFLAGS := -132 +FREEFLAGS := +FFLAGS := -hbyteswapio +FFLAGS_NOOPT:= -O0 +LDFLAGS := -hbyteswapio + +ifeq ($(ICE_BLDDEBUG), true) + FFLAGS += -O0 -hfp0 -g -Rbcdps -Ktrap=fp +else + FFLAGS += -O2 -hfp0 # -eo +endif + +SCC := cc +SFC := ftn +MPICC := cc +MPIFC := ftn + +ifeq ($(ICE_COMMDIR), mpi) + FC := $(MPIFC) + CC := $(MPICC) +else + FC := $(SFC) + CC := $(SCC) +endif +LD:= $(FC) + +# defined by module +#NETCDF_PATH := $(NETCDF) +#PNETCDF_PATH := $(PNETCDF) +#PNETCDF_PATH := /glade/apps/opt/pnetcdf/1.3.0/intel/default +#LAPACK_LIBDIR := /glade/apps/opt/lapack/3.4.2/intel/12.1.5/lib + +#PIO_CONFIG_OPTS:= --enable-filesystem-hints=gpfs + +INCLDIR := $(INCLDIR) +#INCLDIR += -I$(NETCDF_PATH)/include + +#LIB_NETCDF := $(NETCDF_PATH)/lib +#LIB_PNETCDF := $(PNETCDF_PATH)/lib +#LIB_MPI := $(IMPILIBDIR) +#SLIBS := -L$(LIB_NETCDF) -lnetcdf -lnetcdff + +ifeq ($(ICE_THREADED), true) + LDFLAGS += -fopenmp + CFLAGS += -fopenmp + FFLAGS += -fopenmp +else + LDFLAGS += -hnoomp +# CFLAGS += -hnoomp + FFLAGS += -hnoomp +endif + diff --git a/configuration/scripts/machines/Macros.carpenter_gnu b/configuration/scripts/machines/Macros.carpenter_gnu new file mode 100644 index 000000000..50dcdc08d --- /dev/null +++ b/configuration/scripts/machines/Macros.carpenter_gnu @@ -0,0 +1,69 @@ +#============================================================================== +# Macros file for NAVYDSRC narwhal, gnu compiler +#============================================================================== + +CPP := ftn -E +CPPDEFS := -DFORTRANUNDERSCORE ${ICE_CPPDEFS} +CFLAGS := -c + +FIXEDFLAGS := -ffixed-line-length-132 +FREEFLAGS := -ffree-form +FFLAGS := -fconvert=big-endian -fbacktrace -ffree-line-length-none -fallow-argument-mismatch +FFLAGS_NOOPT:= -O0 + +ifeq ($(ICE_BLDDEBUG), true) + FFLAGS += -O0 -g -fcheck=bounds -finit-real=nan -fimplicit-none -ffpe-trap=invalid,zero,overflow + CFLAGS += -O0 +endif + +ifeq ($(ICE_COVERAGE), true) + FFLAGS += -O0 -g -fprofile-arcs -ftest-coverage + CFLAGS += -O0 -g -coverage + LDFLAGS += -g -ftest-coverage -fprofile-arcs +endif + +ifneq ($(ICE_BLDDEBUG), true) +ifneq ($(ICE_COVERAGE), true) + FFLAGS += -O2 + CFLAGS += -O2 +endif +endif + +#SCC := gcc +#SFC := gfortran +SCC := cc +SFC := ftn +MPICC := cc +MPIFC := ftn + +ifeq ($(ICE_COMMDIR), mpi) + FC := $(MPIFC) + CC := $(MPICC) +else + FC := $(SFC) + CC := $(SCC) +endif +LD:= $(FC) + +# defined by module +#NETCDF_PATH := $(NETCDF) +#PNETCDF_PATH := $(PNETCDF) +#PNETCDF_PATH := /glade/apps/opt/pnetcdf/1.3.0/intel/default +#LAPACK_LIBDIR := /glade/apps/opt/lapack/3.4.2/intel/12.1.5/lib + +#PIO_CONFIG_OPTS:= --enable-filesystem-hints=gpfs + +INCLDIR := $(INCLDIR) +INCLDIR += -I$(NETCDF_PATH)/include + +LIB_NETCDF := $(NETCDF_PATH)/lib +#LIB_PNETCDF := $(PNETCDF_PATH)/lib +#LIB_MPI := $(IMPILIBDIR) +SLIBS := -L$(LIB_NETCDF) -lnetcdf -lnetcdff + +ifeq ($(ICE_THREADED), true) + LDFLAGS += -fopenmp + CFLAGS += -fopenmp + FFLAGS += -fopenmp +endif + diff --git a/configuration/scripts/machines/Macros.carpenter_intel b/configuration/scripts/machines/Macros.carpenter_intel new file mode 100644 index 000000000..53d63736d --- /dev/null +++ b/configuration/scripts/machines/Macros.carpenter_intel @@ -0,0 +1,59 @@ +#============================================================================== +# Macros file for NAVYDSRC narwhal, intel compiler +#============================================================================== + +CPP := fpp +CPPDEFS := -DFORTRANUNDERSCORE ${ICE_CPPDEFS} +CFLAGS := -c -O2 -fp-model precise -fcommon + +FIXEDFLAGS := -132 +FREEFLAGS := -FR +FFLAGS := -fp-model precise -convert big_endian -assume byterecl -ftz -traceback +# -mcmodel medium -shared-intel +FFLAGS_NOOPT:= -O0 + +ifeq ($(ICE_BLDDEBUG), true) + FFLAGS += -O0 -g -check uninit -check bounds -check pointers -fpe0 -check noarg_temp_created +# FFLAGS += -O0 -g -check all -fpe0 -ftrapuv -fp-model except -check noarg_temp_created -init=snan,arrays +else + FFLAGS += -O2 +endif + +#SCC := icx +#SFC := ifort +SCC := cc +SFC := ftn +MPICC := cc +MPIFC := ftn + +ifeq ($(ICE_COMMDIR), mpi) + FC := $(MPIFC) + CC := $(MPICC) +else + FC := $(SFC) + CC := $(SCC) +endif +LD:= $(FC) + +# defined by module +#NETCDF_PATH := $(NETCDF) +#PNETCDF_PATH := $(PNETCDF) +#PNETCDF_PATH := /glade/apps/opt/pnetcdf/1.3.0/intel/default +#LAPACK_LIBDIR := /glade/apps/opt/lapack/3.4.2/intel/12.1.5/lib + +#PIO_CONFIG_OPTS:= --enable-filesystem-hints=gpfs + +INCLDIR := $(INCLDIR) +INCLDIR += -I$(NETCDF_PATH)/include + +LIB_NETCDF := $(NETCDF_PATH)/lib +#LIB_PNETCDF := $(PNETCDF_PATH)/lib +#LIB_MPI := $(IMPILIBDIR) +SLIBS := -L$(LIB_NETCDF) -lnetcdf -lnetcdff + +ifeq ($(ICE_THREADED), true) + LDFLAGS += -qopenmp + CFLAGS += -qopenmp + FFLAGS += -qopenmp +endif + diff --git a/configuration/scripts/machines/env.carpenter_cray b/configuration/scripts/machines/env.carpenter_cray new file mode 100644 index 000000000..d2c832d8f --- /dev/null +++ b/configuration/scripts/machines/env.carpenter_cray @@ -0,0 +1,54 @@ +#!/bin/csh -f + +set inp = "undefined" +if ($#argv == 1) then + set inp = $1 +endif + +if ("$inp" != "-nomodules") then + +source ${MODULESHOME}/init/csh + +module unload PrgEnv-cray +module unload PrgEnv-gnu +module unload PrgEnv-intel +module unload PrgEnv-pgi +module load PrgEnv-cray/8.4.0 + +module unload cce +module load cce/16.0.0 + +module unload cray-mpich +module load cray-mpich/8.1.26 + +module unload cray-hdf5 +module unload cray-hdf5-parallel +module unload cray-netcdf-hdf5parallel +module unload cray-parallel-netcdf +module unload netcdf +module load cray-netcdf/4.9.0.3 +module load cray-hdf5/1.12.2.3 + +setenv NETCDF_PATH ${NETCDF_DIR} +limit coredumpsize unlimited +limit stacksize unlimited +setenv OMP_STACKSIZE 128M +setenv OMP_WAIT_POLICY PASSIVE +setenv FI_CXI_RX_MATCH_MODE hybrid + +endif + +setenv ICE_MACHINE_MACHNAME carpenter +setenv ICE_MACHINE_MACHINFO "Cray EX4000 AMD 9654 Genoa 2.1GHz, Slingshot Interconnect" +setenv ICE_MACHINE_ENVNAME cray +setenv ICE_MACHINE_ENVINFO "Cray Fortran/Clang 16.0.0, cray-mpich/8.1.26, netcdf/4.9.0.3" +setenv ICE_MACHINE_MAKE gmake +setenv ICE_MACHINE_WKDIR $WORKDIR/CICE_RUNS +setenv ICE_MACHINE_INPUTDATA /p/app/unsupported/RASM/cice_consortium +setenv ICE_MACHINE_BASELINE $WORKDIR/CICE_BASELINE +setenv ICE_MACHINE_SUBMIT "qsub " +setenv ICE_MACHINE_ACCT P00000000 +setenv ICE_MACHINE_QUEUE "debug" +setenv ICE_MACHINE_TPNODE 192 # tasks per node +setenv ICE_MACHINE_BLDTHRDS 12 +setenv ICE_MACHINE_QSTAT "qstat " diff --git a/configuration/scripts/machines/env.carpenter_gnu b/configuration/scripts/machines/env.carpenter_gnu new file mode 100644 index 000000000..96a04072f --- /dev/null +++ b/configuration/scripts/machines/env.carpenter_gnu @@ -0,0 +1,58 @@ +#!/bin/csh -f + +set inp = "undefined" +if ($#argv == 1) then + set inp = $1 +endif + +if ("$inp" != "-nomodules") then + +source ${MODULESHOME}/init/csh + +module unload PrgEnv-cray +module unload PrgEnv-gnu +module unload PrgEnv-intel +module unload PrgEnv-pgi +module load PrgEnv-gnu/8.4.0 + +module unload gcc +module load gcc/12.2.0 + +module unload cray-mpich +module unload mpi +module unload openmpi +module load cray-mpich/8.1.26 +#module load openmpi/4.1.6 +#module load mpi/2021.11 + +module unload cray-hdf5 +module unload cray-hdf5-parallel +module unload cray-netcdf-hdf5parallel +module unload cray-parallel-netcdf +module unload netcdf +module load cray-netcdf/4.9.0.3 +module load cray-hdf5/1.12.2.3 + +setenv NETCDF_PATH ${NETCDF_DIR} +limit coredumpsize unlimited +limit stacksize unlimited +setenv OMP_STACKSIZE 128M +setenv OMP_WAIT_POLICY PASSIVE +setenv FI_CXI_RX_MATCH_MODE hybrid + +endif + +setenv ICE_MACHINE_MACHNAME carpenter +setenv ICE_MACHINE_MACHINFO "Cray EX4000 AMD 9654 Genoa 2.1GHz, Slingshot Interconnect" +setenv ICE_MACHINE_ENVNAME gnu +setenv ICE_MACHINE_ENVINFO "gnu gcc 12.2.0 20220819, mpich/8.1.26, netcdf/4.9.0.3" +setenv ICE_MACHINE_MAKE gmake +setenv ICE_MACHINE_WKDIR $WORKDIR/CICE_RUNS +setenv ICE_MACHINE_INPUTDATA /p/app/unsupported/RASM/cice_consortium +setenv ICE_MACHINE_BASELINE $WORKDIR/CICE_BASELINE +setenv ICE_MACHINE_SUBMIT "qsub " +setenv ICE_MACHINE_ACCT P00000000 +setenv ICE_MACHINE_QUEUE "debug" +setenv ICE_MACHINE_TPNODE 192 # tasks per node +setenv ICE_MACHINE_BLDTHRDS 12 +setenv ICE_MACHINE_QSTAT "qstat " diff --git a/configuration/scripts/machines/env.carpenter_intel b/configuration/scripts/machines/env.carpenter_intel new file mode 100644 index 000000000..c97a7d25a --- /dev/null +++ b/configuration/scripts/machines/env.carpenter_intel @@ -0,0 +1,57 @@ +#!/bin/csh -f +set inp = "undefined" +if ($#argv == 1) then + set inp = $1 +endif + +if ("$inp" != "-nomodules") then + +source ${MODULESHOME}/init/csh + +module unload PrgEnv-cray +module unload PrgEnv-gnu +module unload PrgEnv-intel +module unload PrgEnv-pgi +module load PrgEnv-intel/8.4.0 + +module unload intel +module load intel/2023.0.0 + +module unload cray-mpich +module unload mpi +module unload openmpi +module load cray-mpich/8.1.26 +#module load mpi/2021.11 +#module load openmpi/4.1.6 + +module unload cray-hdf5 +module unload cray-hdf5-parallel +module unload cray-netcdf-hdf5parallel +module unload cray-parallel-netcdf +module unload netcdf +module load cray-netcdf/4.9.0.3 +module load cray-hdf5/1.12.2.3 + +setenv NETCDF_PATH ${NETCDF_DIR} +limit coredumpsize unlimited +limit stacksize unlimited +setenv OMP_STACKSIZE 128M +setenv OMP_WAIT_POLICY PASSIVE +setenv FI_CXI_RX_MATCH_MODE hybrid + +endif + +setenv ICE_MACHINE_MACHNAME carpenter +setenv ICE_MACHINE_MACHINFO "Cray EX4000 AMD 9654 Genoa 2.1GHz, Slingshot Interconnect" +setenv ICE_MACHINE_ENVNAME intel +setenv ICE_MACHINE_ENVINFO "ifort 2021.8.0 20221119, cray-mpich/8.1.26, netcdf/4.9.0.3" +setenv ICE_MACHINE_MAKE gmake +setenv ICE_MACHINE_WKDIR $WORKDIR/CICE_RUNS +setenv ICE_MACHINE_INPUTDATA /p/app/unsupported/RASM/cice_consortium +setenv ICE_MACHINE_BASELINE $WORKDIR/CICE_BASELINE +setenv ICE_MACHINE_SUBMIT "qsub " +setenv ICE_MACHINE_ACCT P00000000 +setenv ICE_MACHINE_QUEUE "debug" +setenv ICE_MACHINE_TPNODE 192 # tasks per node +setenv ICE_MACHINE_BLDTHRDS 12 +setenv ICE_MACHINE_QSTAT "qstat " From 22097493a8600c9ca7b20960ed1df9af67308084 Mon Sep 17 00:00:00 2001 From: "David A. Bailey" Date: Wed, 20 Mar 2024 13:13:48 -0600 Subject: [PATCH 62/76] Add a new diagnostic variable dvsdtd. (#940) * Add dvsdtd diagnostic for SIMIP sndmassdyn * Fix the units of SIMIP snow variables * Fix calls to update_state * Add present for dagedt and fix indents * This PR has been updated to include dvsdtt (thermodynamic tendency for snow). Also, the calls to update_state have been updated in all of the drivers. Note that I can only test the NUOPC/CMEPS and standalone drivers, so it would be good if others could test. * Update the opticep unit test to be consistent with the latest changes. --------- Co-authored-by: apcraig --- cicecore/cicedyn/analysis/ice_history.F90 | 32 ++++++++++++-- .../cicedyn/analysis/ice_history_shared.F90 | 3 ++ cicecore/cicedyn/general/ice_flux.F90 | 10 ++++- cicecore/cicedyn/general/ice_step_mod.F90 | 42 ++++++++++--------- .../drivers/direct/hadgem3/CICE_RunMod.F90 | 8 ++-- .../direct/nemo_concepts/CICE_RunMod.F90 | 8 ++-- cicecore/drivers/mct/cesm1/CICE_RunMod.F90 | 10 +++-- cicecore/drivers/nuopc/cmeps/CICE_RunMod.F90 | 10 +++-- cicecore/drivers/nuopc/dmi/CICE_RunMod.F90 | 10 +++-- .../drivers/standalone/cice/CICE_RunMod.F90 | 10 +++-- .../drivers/unittest/opticep/CICE_InitMod.F90 | 3 +- .../drivers/unittest/opticep/CICE_RunMod.F90 | 10 +++-- .../drivers/unittest/opticep/ice_step_mod.F90 | 42 ++++++++++--------- 13 files changed, 125 insertions(+), 73 deletions(-) diff --git a/cicecore/cicedyn/analysis/ice_history.F90 b/cicecore/cicedyn/analysis/ice_history.F90 index 45a4bede0..32f744477 100644 --- a/cicecore/cicedyn/analysis/ice_history.F90 +++ b/cicecore/cicedyn/analysis/ice_history.F90 @@ -362,6 +362,7 @@ subroutine init_hist (dt) f_sidmasslat = 'mxxxx' f_sndmasssnf = 'mxxxx' f_sndmassmelt = 'mxxxx' + f_sndmassdyn = 'mxxxx' f_siflswdtop = 'mxxxx' f_siflswutop = 'mxxxx' f_siflswdbot = 'mxxxx' @@ -402,6 +403,11 @@ subroutine init_hist (dt) f_siu = f_CMIP f_siv = f_CMIP f_sispeed = f_CMIP + f_sndmasssubl = f_CMIP + f_sndmasssnf = f_CMIP + f_sndmassmelt = f_CMIP + f_sndmassdyn = f_CMIP + f_sidmasssi = f_CMIP endif if (grid_ice == 'CD' .or. grid_ice == 'C') then @@ -654,6 +660,7 @@ subroutine init_hist (dt) call broadcast_scalar (f_sidmasslat, master_task) call broadcast_scalar (f_sndmasssnf, master_task) call broadcast_scalar (f_sndmassmelt, master_task) + call broadcast_scalar (f_sndmassdyn, master_task) call broadcast_scalar (f_siflswdtop, master_task) call broadcast_scalar (f_siflswutop, master_task) call broadcast_scalar (f_siflswdbot, master_task) @@ -1648,7 +1655,7 @@ subroutine init_hist (dt) "none", c1, c0, & ns1, f_sidmassevapsubl) - call define_hist_field(n_sndmasssubl,"sndmassubl","kg m-2 s-1",tstr2D, tcstr, & + call define_hist_field(n_sndmasssubl,"sndmasssubl","kg m-2 s-1",tstr2D, tcstr, & "snow mass change from evaporation and sublimation", & "none", c1, c0, & ns1, f_sndmasssubl) @@ -1678,6 +1685,11 @@ subroutine init_hist (dt) "none", c1, c0, & ns1, f_sndmassmelt) + call define_hist_field(n_sndmassdyn,"sndmassdyn","kg m-2 s-1",tstr2D, tcstr, & + "snow mass change from dynamics ridging", & + "none", c1, c0, & + ns1, f_sndmassdyn) + call define_hist_field(n_siflswdtop,"siflswdtop","W/m2",tstr2D, tcstr, & "down shortwave flux over sea ice", & "positive downward", c1, c0, & @@ -2160,7 +2172,7 @@ subroutine accum_hist (dt) taubxN, taubyN, strocnxN, strocnyN, & strairxE, strairyE, strtltxE, strtltyE, strintxE, strintyE, & taubxE, taubyE, strocnxE, strocnyE, & - fmU, fmN, fmE, daidtt, dvidtt, daidtd, dvidtd, fsurf, & + fmU, fmN, fmE, daidtt, dvidtt, daidtd, dvidtd, dvsdtd, fsurf, & fcondtop, fcondbot, fsurfn, fcondtopn, flatn, fsensn, albcnt, snwcnt, & stressp_1, stressm_1, stress12_1, & stresspT, stressmT, stress12T, & @@ -3068,7 +3080,7 @@ subroutine accum_hist (dt) do j = jlo, jhi do i = ilo, ihi if (aice(i,j,iblk) > puny) then - worka(i,j) = evaps(i,j,iblk)*rhos + worka(i,j) = evaps(i,j,iblk) endif enddo enddo @@ -3080,7 +3092,7 @@ subroutine accum_hist (dt) do j = jlo, jhi do i = ilo, ihi if (aice(i,j,iblk) > puny) then - worka(i,j) = aice(i,j,iblk)*fsnow(i,j,iblk)*rhos + worka(i,j) = aice(i,j,iblk)*fsnow(i,j,iblk) endif enddo enddo @@ -3099,6 +3111,18 @@ subroutine accum_hist (dt) call accum_hist_field(n_sndmassmelt, iblk, worka(:,:), a2D) endif + if (f_sndmassdyn(1:1) /= 'x') then + worka(:,:) = c0 + do j = jlo, jhi + do i = ilo, ihi + if (aice(i,j,iblk) > puny) then + worka(i,j) = dvsdtd(i,j,iblk)*rhos + endif + enddo + enddo + call accum_hist_field(n_sndmassdyn, iblk, worka(:,:), a2D) + endif + if (f_siflswdtop(1:1) /= 'x') then worka(:,:) = c0 do j = jlo, jhi diff --git a/cicecore/cicedyn/analysis/ice_history_shared.F90 b/cicecore/cicedyn/analysis/ice_history_shared.F90 index 678888b09..62ee3c2ba 100644 --- a/cicecore/cicedyn/analysis/ice_history_shared.F90 +++ b/cicecore/cicedyn/analysis/ice_history_shared.F90 @@ -314,6 +314,7 @@ module ice_history_shared f_sidmasslat = 'x', & f_sndmasssnf = 'x', & f_sndmassmelt = 'x', & + f_sndmassdyn = 'x', & f_siflswdtop = 'x', & f_siflswutop = 'x', & f_siflswdbot = 'x', & @@ -485,6 +486,7 @@ module ice_history_shared f_sidmasslat, & f_sndmasssnf, & f_sndmassmelt, & + f_sndmassdyn, & f_siflswdtop, & f_siflswutop, & f_siflswdbot, & @@ -684,6 +686,7 @@ module ice_history_shared n_sidmasslat, & n_sndmasssnf, & n_sndmassmelt, & + n_sndmassdyn, & n_siflswdtop, & n_siflswutop, & n_siflswdbot, & diff --git a/cicecore/cicedyn/general/ice_flux.F90 b/cicecore/cicedyn/general/ice_flux.F90 index 2d61bf642..4d19bb8b2 100644 --- a/cicecore/cicedyn/general/ice_flux.F90 +++ b/cicecore/cicedyn/general/ice_flux.F90 @@ -107,6 +107,7 @@ module ice_flux strintyE, & ! divergence of internal ice stress, y at E points (N/m^2) daidtd , & ! ice area tendency due to transport (1/s) dvidtd , & ! ice volume tendency due to transport (m/s) + dvsdtd , & ! snow volume tendency due to transport (m/s) dagedtd , & ! ice age tendency due to transport (s/s) dardg1dt, & ! rate of area loss by ridging ice (1/s) dardg2dt, & ! rate of area gain by new ridges (1/s) @@ -319,6 +320,7 @@ module ice_flux dsnow, & ! change in snow thickness (m/step-->cm/day) daidtt, & ! ice area tendency thermo. (s^-1) dvidtt, & ! ice volume tendency thermo. (m/s) + dvsdtt, & ! snow volume tendency thermo. (m/s) dagedtt,& ! ice age tendency thermo. (s/s) mlt_onset, &! day of year that sfc melting begins frz_onset, &! day of year that freezing begins (congel or frazil) @@ -419,6 +421,7 @@ subroutine alloc_flux strintyU (nx_block,ny_block,max_blocks), & ! divergence of internal ice stress, y (N/m^2) daidtd (nx_block,ny_block,max_blocks), & ! ice area tendency due to transport (1/s) dvidtd (nx_block,ny_block,max_blocks), & ! ice volume tendency due to transport (m/s) + dvsdtd (nx_block,ny_block,max_blocks), & ! snow volume tendency due to transport (m/s) dagedtd (nx_block,ny_block,max_blocks), & ! ice age tendency due to transport (s/s) dardg1dt (nx_block,ny_block,max_blocks), & ! rate of area loss by ridging ice (1/s) dardg2dt (nx_block,ny_block,max_blocks), & ! rate of area gain by new ridges (1/s) @@ -530,6 +533,7 @@ subroutine alloc_flux dsnow (nx_block,ny_block,max_blocks), & ! change in snow thickness (m/step-->cm/day) daidtt (nx_block,ny_block,max_blocks), & ! ice area tendency thermo. (s^-1) dvidtt (nx_block,ny_block,max_blocks), & ! ice volume tendency thermo. (m/s) + dvsdtt (nx_block,ny_block,max_blocks), & ! snow volume tendency thermo. (m/s) dagedtt (nx_block,ny_block,max_blocks), & ! ice age tendency thermo. (s/s) mlt_onset (nx_block,ny_block,max_blocks), & ! day of year that sfc melting begins frz_onset (nx_block,ny_block,max_blocks), & ! day of year that freezing begins (congel or frazil) @@ -918,7 +922,7 @@ end subroutine init_flux_ocn subroutine init_history_therm - use ice_state, only: aice, vice, trcr + use ice_state, only: aice, vice, vsno, trcr use ice_arrays_column, only: & hfreebd, hdraft, hridge, distrdg, hkeel, dkeel, lfloe, dfloe, & Cdn_atm_skin, Cdn_atm_floe, Cdn_atm_pond, Cdn_atm_rdg, & @@ -965,6 +969,7 @@ subroutine init_history_therm meltl (:,:,:) = c0 daidtt (:,:,:) = aice(:,:,:) ! temporary initial area dvidtt (:,:,:) = vice(:,:,:) ! temporary initial volume + dvsdtt (:,:,:) = vsno(:,:,:) ! temporary initial volume if (tr_iage) then dagedtt(:,:,:) = trcr(:,:,nt_iage,:) ! temporary initial age else @@ -1022,7 +1027,7 @@ end subroutine init_history_therm subroutine init_history_dyn - use ice_state, only: aice, vice, trcr, strength, divu, shear, vort + use ice_state, only: aice, vice, vsno, trcr, strength, divu, shear, vort use ice_grid, only: grid_ice logical (kind=log_kind) :: & @@ -1061,6 +1066,7 @@ subroutine init_history_dyn opening (:,:,:) = c0 daidtd (:,:,:) = aice(:,:,:) ! temporary initial area dvidtd (:,:,:) = vice(:,:,:) ! temporary initial volume + dvsdtd (:,:,:) = vsno(:,:,:) ! temporary initial volume if (tr_iage) & dagedtd (:,:,:) = trcr(:,:,nt_iage,:) ! temporary initial age fmU (:,:,:) = c0 diff --git a/cicecore/cicedyn/general/ice_step_mod.F90 b/cicecore/cicedyn/general/ice_step_mod.F90 index b738e670b..2726a6101 100644 --- a/cicecore/cicedyn/general/ice_step_mod.F90 +++ b/cicecore/cicedyn/general/ice_step_mod.F90 @@ -750,7 +750,7 @@ end subroutine step_therm2 ! ! authors: Elizabeth Hunke, LANL - subroutine update_state (dt, daidt, dvidt, dagedt, offset) + subroutine update_state (dt, daidt, dvidt, dvsdt, dagedt, offset) use ice_domain_size, only: ncat ! use ice_grid, only: tmask @@ -766,6 +766,7 @@ subroutine update_state (dt, daidt, dvidt, dagedt, offset) real (kind=dbl_kind), dimension(:,:,:), intent(inout), optional :: & daidt, & ! change in ice area per time step dvidt, & ! change in ice volume per time step + dvsdt, & ! change in snow volume per time step dagedt ! change in ice age per time step real (kind=dbl_kind), intent(in), optional :: & @@ -827,25 +828,26 @@ subroutine update_state (dt, daidt, dvidt, dagedt, offset) nt_strata = nt_strata(:,:), & Tf = Tf(i,j,iblk)) - if (present(offset)) then - - !----------------------------------------------------------------- - ! Compute thermodynamic area and volume tendencies. - !----------------------------------------------------------------- - - daidt(i,j,iblk) = (aice(i,j,iblk) - daidt(i,j,iblk)) / dt - dvidt(i,j,iblk) = (vice(i,j,iblk) - dvidt(i,j,iblk)) / dt - if (tr_iage) then - if (offset > c0) then ! thermo - if (trcr(i,j,nt_iage,iblk) > c0) & - dagedt(i,j,iblk) = (trcr(i,j,nt_iage,iblk) & - - dagedt(i,j,iblk) - offset) / dt - else ! dynamics - dagedt(i,j,iblk) = (trcr(i,j,nt_iage,iblk) & - - dagedt(i,j,iblk)) / dt - endif - endif ! tr_iage - endif ! present(offset) + if (present(offset)) then + + !----------------------------------------------------------------- + ! Compute thermodynamic area and volume tendencies. + !----------------------------------------------------------------- + + if (present(daidt)) daidt(i,j,iblk) = (aice(i,j,iblk) - daidt(i,j,iblk)) / dt + if (present(dvidt)) dvidt(i,j,iblk) = (vice(i,j,iblk) - dvidt(i,j,iblk)) / dt + if (present(dvsdt)) dvsdt(i,j,iblk) = (vsno(i,j,iblk) - dvsdt(i,j,iblk)) / dt + if (present(dagedt) .and. tr_iage) then + if (offset > c0) then ! thermo + if (trcr(i,j,nt_iage,iblk) > c0) & + dagedt(i,j,iblk) = (trcr(i,j,nt_iage,iblk) & + - dagedt(i,j,iblk) - offset) / dt + else ! dynamics + dagedt(i,j,iblk) = (trcr(i,j,nt_iage,iblk) & + - dagedt(i,j,iblk)) / dt + endif + endif ! tr_iage + endif ! present(offset) enddo ! i enddo ! j diff --git a/cicecore/drivers/direct/hadgem3/CICE_RunMod.F90 b/cicecore/drivers/direct/hadgem3/CICE_RunMod.F90 index b67e1a223..43a1a003f 100644 --- a/cicecore/drivers/direct/hadgem3/CICE_RunMod.F90 +++ b/cicecore/drivers/direct/hadgem3/CICE_RunMod.F90 @@ -140,7 +140,7 @@ subroutine ice_step use ice_dyn_eap, only: write_restart_eap use ice_dyn_shared, only: kdyn use ice_flux, only: scale_factor, init_history_therm, & - daidtt, daidtd, dvidtt, dvidtd, dagedtt, dagedtd + daidtt, daidtd, dvidtt, dvidtd, dvsdtt, dvsdtd, dagedtt, dagedtd use ice_history, only: accum_hist use ice_history_bgc, only: init_history_bgc use ice_restart, only: final_restart @@ -238,7 +238,8 @@ subroutine ice_step ! clean up, update tendency diagnostics offset = dt - call update_state (dt, daidtt, dvidtt, dagedtt, offset) + call update_state (dt=dt, daidt=daidtt, dvidt=dvidtt, dvsdt=dvsdtt, & + dagedt=dagedtt, offset=offset) call ice_timer_stop(timer_thermo) ! thermodynamics call ice_timer_stop(timer_column) ! column physics @@ -265,7 +266,8 @@ subroutine ice_step ! clean up, update tendency diagnostics offset = c0 - call update_state (dt_dyn, daidtd, dvidtd, dagedtd, offset) + call update_state (dt=dt_dyn, daidt=daidtd, dvidt=dvidtd, dvsdt=dvsdtd, & + dagedt=dagedtd, offset=offset) enddo diff --git a/cicecore/drivers/direct/nemo_concepts/CICE_RunMod.F90 b/cicecore/drivers/direct/nemo_concepts/CICE_RunMod.F90 index c9875d769..78c703c91 100644 --- a/cicecore/drivers/direct/nemo_concepts/CICE_RunMod.F90 +++ b/cicecore/drivers/direct/nemo_concepts/CICE_RunMod.F90 @@ -140,7 +140,7 @@ subroutine ice_step use ice_dyn_eap, only: write_restart_eap use ice_dyn_shared, only: kdyn use ice_flux, only: scale_factor, init_history_therm, & - daidtt, daidtd, dvidtt, dvidtd, dagedtt, dagedtd + daidtt, daidtd, dvidtt, dvidtd, dvsdtt, dvsdtd, dagedtt, dagedtd use ice_history, only: accum_hist use ice_history_bgc, only: init_history_bgc use ice_restart, only: final_restart @@ -238,7 +238,8 @@ subroutine ice_step ! clean up, update tendency diagnostics offset = dt - call update_state (dt, daidtt, dvidtt, dagedtt, offset) + call update_state (dt=dt, daidt=daidtt, dvidt=dvidtt, dvsdt=dvsdtt, & + dagedt=dagedtt, offset=offset) call ice_timer_stop(timer_thermo) ! thermodynamics call ice_timer_stop(timer_column) ! column physics @@ -265,7 +266,8 @@ subroutine ice_step ! clean up, update tendency diagnostics offset = c0 - call update_state (dt_dyn, daidtd, dvidtd, dagedtd, offset) + call update_state (dt=dt_dyn, daidt=daidtd, dvidt=dvidtd, dvsdt=dvsdtd, & + dagedt=dagedtd, offset=offset) enddo diff --git a/cicecore/drivers/mct/cesm1/CICE_RunMod.F90 b/cicecore/drivers/mct/cesm1/CICE_RunMod.F90 index 5836479b4..6ff6b1270 100644 --- a/cicecore/drivers/mct/cesm1/CICE_RunMod.F90 +++ b/cicecore/drivers/mct/cesm1/CICE_RunMod.F90 @@ -132,7 +132,7 @@ subroutine ice_step use ice_dyn_eap, only: write_restart_eap use ice_dyn_shared, only: kdyn, kridge use ice_flux, only: scale_factor, init_history_therm, & - daidtt, daidtd, dvidtt, dvidtd, dagedtt, dagedtd + daidtt, daidtd, dvidtt, dvidtd, dvsdtt, dvsdtd, dagedtt, dagedtd use ice_history, only: accum_hist use ice_history_bgc, only: init_history_bgc use ice_restart, only: final_restart @@ -261,7 +261,8 @@ subroutine ice_step ! clean up, update tendency diagnostics offset = dt - call update_state (dt, daidtt, dvidtt, dagedtt, offset) + call update_state (dt=dt, daidt=daidtt, dvidt=dvidtt, dvsdt=dvsdtt, & + dagedt=dagedtt, offset=offset) call ice_timer_stop(timer_thermo) ! thermodynamics call ice_timer_stop(timer_column) ! column physics @@ -302,7 +303,8 @@ subroutine ice_step ! clean up, update tendency diagnostics offset = c0 - call update_state (dt_dyn, daidtd, dvidtd, dagedtd, offset) + call update_state (dt=dt_dyn, daidt=daidtd, dvidt=dvidtd, dvsdt=dvsdtd, & + dagedt=dagedtd, offset=offset) enddo @@ -326,7 +328,7 @@ subroutine ice_step call step_snow (dt, iblk) enddo !$OMP END PARALLEL DO - call update_state (dt) ! clean up + call update_state (dt=dt) ! clean up endif !$OMP PARALLEL DO PRIVATE(iblk) SCHEDULE(runtime) diff --git a/cicecore/drivers/nuopc/cmeps/CICE_RunMod.F90 b/cicecore/drivers/nuopc/cmeps/CICE_RunMod.F90 index 483048051..c2cae81cb 100644 --- a/cicecore/drivers/nuopc/cmeps/CICE_RunMod.F90 +++ b/cicecore/drivers/nuopc/cmeps/CICE_RunMod.F90 @@ -119,7 +119,7 @@ subroutine ice_step use ice_dyn_eap, only: write_restart_eap use ice_dyn_shared, only: kdyn, kridge use ice_flux, only: scale_factor, init_history_therm, & - daidtt, daidtd, dvidtt, dvidtd, dagedtt, dagedtd + daidtt, daidtd, dvidtt, dvidtd, dvsdtt, dvsdtd, dagedtt, dagedtd use ice_history, only: accum_hist use ice_history_bgc, only: init_history_bgc use ice_restart, only: final_restart @@ -250,7 +250,8 @@ subroutine ice_step ! clean up, update tendency diagnostics offset = dt - call update_state (dt, daidtt, dvidtt, dagedtt, offset) + call update_state (dt=dt, daidt=daidtt, dvidt=dvidtt, dvsdt=dvsdtt, & + dagedt=dagedtt, offset=offset) call ice_timer_stop(timer_thermo) ! thermodynamics call ice_timer_stop(timer_column) ! column physics @@ -291,7 +292,8 @@ subroutine ice_step ! clean up, update tendency diagnostics offset = c0 - call update_state (dt_dyn, daidtd, dvidtd, dagedtd, offset) + call update_state (dt=dt_dyn, daidt=daidtd, dvidt=dvidtd, dvsdt=dvsdtd, & + dagedt=dagedtd, offset=offset) enddo if (debug_model) then @@ -318,7 +320,7 @@ subroutine ice_step do iblk = 1, nblocks call step_snow (dt, iblk) enddo - call update_state (dt) ! clean up + call update_state (dt=dt) ! clean up endif !MHRI: CHECK THIS OMP diff --git a/cicecore/drivers/nuopc/dmi/CICE_RunMod.F90 b/cicecore/drivers/nuopc/dmi/CICE_RunMod.F90 index 897f62eea..5f8fb52bc 100644 --- a/cicecore/drivers/nuopc/dmi/CICE_RunMod.F90 +++ b/cicecore/drivers/nuopc/dmi/CICE_RunMod.F90 @@ -154,7 +154,7 @@ subroutine ice_step use ice_dyn_eap, only: write_restart_eap use ice_dyn_shared, only: kdyn, kridge use ice_flux, only: scale_factor, init_history_therm, & - daidtt, daidtd, dvidtt, dvidtd, dagedtt, dagedtd + daidtt, daidtd, dvidtt, dvidtd, dvsdtt, dvsdtd, dagedtt, dagedtd use ice_history, only: accum_hist use ice_history_bgc, only: init_history_bgc use ice_restart, only: final_restart @@ -273,7 +273,8 @@ subroutine ice_step ! clean up, update tendency diagnostics offset = dt - call update_state (dt, daidtt, dvidtt, dagedtt, offset) + call update_state (dt=dt, daidt=daidtt, dvidt=dvidtt, dvsdt=dvsdtt, & + dagedt=dagedtt, offset=offset) call ice_timer_stop(timer_thermo) ! thermodynamics call ice_timer_stop(timer_column) ! column physics @@ -314,7 +315,8 @@ subroutine ice_step ! clean up, update tendency diagnostics offset = c0 - call update_state (dt_dyn, daidtd, dvidtd, dagedtd, offset) + call update_state (dt=dt_dyn, daidt=daidtd, dvidt=dvidtd, dvsdt=dvsdtd, & + dagedt=dagedtd, offset=offset) enddo @@ -338,7 +340,7 @@ subroutine ice_step call step_snow (dt, iblk) enddo !$OMP END PARALLEL DO - call update_state (dt) ! clean up + call update_state (dt=dt) ! clean up endif !MHRI: CHECK THIS OMP diff --git a/cicecore/drivers/standalone/cice/CICE_RunMod.F90 b/cicecore/drivers/standalone/cice/CICE_RunMod.F90 index 42514e06c..59213f728 100644 --- a/cicecore/drivers/standalone/cice/CICE_RunMod.F90 +++ b/cicecore/drivers/standalone/cice/CICE_RunMod.F90 @@ -146,7 +146,7 @@ subroutine ice_step use ice_dyn_eap, only: write_restart_eap use ice_dyn_shared, only: kdyn, kridge use ice_flux, only: scale_factor, init_history_therm, & - daidtt, daidtd, dvidtt, dvidtd, dagedtt, dagedtd + daidtt, daidtd, dvidtt, dvidtd, dvsdtt, dvsdtd, dagedtt, dagedtd use ice_history, only: accum_hist use ice_history_bgc, only: init_history_bgc use ice_restart, only: final_restart @@ -265,7 +265,8 @@ subroutine ice_step ! clean up, update tendency diagnostics offset = dt - call update_state (dt, daidtt, dvidtt, dagedtt, offset) + call update_state (dt=dt, daidt=daidtt, dvidt=dvidtt, dvsdt=dvsdtt, & + dagedt=dagedtt, offset=offset) call ice_timer_stop(timer_thermo) ! thermodynamics call ice_timer_stop(timer_column) ! column physics @@ -306,7 +307,8 @@ subroutine ice_step ! clean up, update tendency diagnostics offset = c0 - call update_state (dt_dyn, daidtd, dvidtd, dagedtd, offset) + call update_state (dt=dt_dyn, daidt=daidtd, dvidt=dvidtd, dvsdt=dvsdtd, & + dagedt=dagedtd, offset=offset) enddo @@ -330,7 +332,7 @@ subroutine ice_step call step_snow (dt, iblk) enddo !$OMP END PARALLEL DO - call update_state (dt) ! clean up + call update_state (dt=dt) ! clean up endif !$OMP PARALLEL DO PRIVATE(iblk) SCHEDULE(runtime) diff --git a/cicecore/drivers/unittest/opticep/CICE_InitMod.F90 b/cicecore/drivers/unittest/opticep/CICE_InitMod.F90 index cb1241a5e..194293118 100644 --- a/cicecore/drivers/unittest/opticep/CICE_InitMod.F90 +++ b/cicecore/drivers/unittest/opticep/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 @@ -244,6 +244,7 @@ subroutine cice_init call init_flux_ocn ! initialize ocean fluxes sent to coupler call dealloc_grid ! deallocate temporary grid arrays + if (my_task == master_task) then call ice_memusage_print(nu_diag,subname//':end') endif diff --git a/cicecore/drivers/unittest/opticep/CICE_RunMod.F90 b/cicecore/drivers/unittest/opticep/CICE_RunMod.F90 index 42514e06c..59213f728 100644 --- a/cicecore/drivers/unittest/opticep/CICE_RunMod.F90 +++ b/cicecore/drivers/unittest/opticep/CICE_RunMod.F90 @@ -146,7 +146,7 @@ subroutine ice_step use ice_dyn_eap, only: write_restart_eap use ice_dyn_shared, only: kdyn, kridge use ice_flux, only: scale_factor, init_history_therm, & - daidtt, daidtd, dvidtt, dvidtd, dagedtt, dagedtd + daidtt, daidtd, dvidtt, dvidtd, dvsdtt, dvsdtd, dagedtt, dagedtd use ice_history, only: accum_hist use ice_history_bgc, only: init_history_bgc use ice_restart, only: final_restart @@ -265,7 +265,8 @@ subroutine ice_step ! clean up, update tendency diagnostics offset = dt - call update_state (dt, daidtt, dvidtt, dagedtt, offset) + call update_state (dt=dt, daidt=daidtt, dvidt=dvidtt, dvsdt=dvsdtt, & + dagedt=dagedtt, offset=offset) call ice_timer_stop(timer_thermo) ! thermodynamics call ice_timer_stop(timer_column) ! column physics @@ -306,7 +307,8 @@ subroutine ice_step ! clean up, update tendency diagnostics offset = c0 - call update_state (dt_dyn, daidtd, dvidtd, dagedtd, offset) + call update_state (dt=dt_dyn, daidt=daidtd, dvidt=dvidtd, dvsdt=dvsdtd, & + dagedt=dagedtd, offset=offset) enddo @@ -330,7 +332,7 @@ subroutine ice_step call step_snow (dt, iblk) enddo !$OMP END PARALLEL DO - call update_state (dt) ! clean up + call update_state (dt=dt) ! clean up endif !$OMP PARALLEL DO PRIVATE(iblk) SCHEDULE(runtime) diff --git a/cicecore/drivers/unittest/opticep/ice_step_mod.F90 b/cicecore/drivers/unittest/opticep/ice_step_mod.F90 index 370fde6be..64320e601 100644 --- a/cicecore/drivers/unittest/opticep/ice_step_mod.F90 +++ b/cicecore/drivers/unittest/opticep/ice_step_mod.F90 @@ -752,7 +752,7 @@ end subroutine step_therm2 ! ! authors: Elizabeth Hunke, LANL - subroutine update_state (dt, daidt, dvidt, dagedt, offset) + subroutine update_state (dt, daidt, dvidt, dvsdt, dagedt, offset) use ice_domain_size, only: ncat ! use ice_grid, only: tmask @@ -768,6 +768,7 @@ subroutine update_state (dt, daidt, dvidt, dagedt, offset) real (kind=dbl_kind), dimension(:,:,:), intent(inout), optional :: & daidt, & ! change in ice area per time step dvidt, & ! change in ice volume per time step + dvsdt, & ! change in snow volume per time step dagedt ! change in ice age per time step real (kind=dbl_kind), intent(in), optional :: & @@ -829,25 +830,26 @@ subroutine update_state (dt, daidt, dvidt, dagedt, offset) nt_strata = nt_strata(:,:), & Tf = Tf(i,j,iblk)) - if (present(offset)) then - - !----------------------------------------------------------------- - ! Compute thermodynamic area and volume tendencies. - !----------------------------------------------------------------- - - daidt(i,j,iblk) = (aice(i,j,iblk) - daidt(i,j,iblk)) / dt - dvidt(i,j,iblk) = (vice(i,j,iblk) - dvidt(i,j,iblk)) / dt - if (tr_iage) then - if (offset > c0) then ! thermo - if (trcr(i,j,nt_iage,iblk) > c0) & - dagedt(i,j,iblk) = (trcr(i,j,nt_iage,iblk) & - - dagedt(i,j,iblk) - offset) / dt - else ! dynamics - dagedt(i,j,iblk) = (trcr(i,j,nt_iage,iblk) & - - dagedt(i,j,iblk)) / dt - endif - endif ! tr_iage - endif ! present(offset) + if (present(offset)) then + + !----------------------------------------------------------------- + ! Compute thermodynamic area and volume tendencies. + !----------------------------------------------------------------- + + if (present(daidt)) daidt(i,j,iblk) = (aice(i,j,iblk) - daidt(i,j,iblk)) / dt + if (present(dvidt)) dvidt(i,j,iblk) = (vice(i,j,iblk) - dvidt(i,j,iblk)) / dt + if (present(dvsdt)) dvsdt(i,j,iblk) = (vsno(i,j,iblk) - dvsdt(i,j,iblk)) / dt + if (tr_iage .and. present(dagedt)) then + if (offset > c0) then ! thermo + if (trcr(i,j,nt_iage,iblk) > c0) & + dagedt(i,j,iblk) = (trcr(i,j,nt_iage,iblk) & + - dagedt(i,j,iblk) - offset) / dt + else ! dynamics + dagedt(i,j,iblk) = (trcr(i,j,nt_iage,iblk) & + - dagedt(i,j,iblk)) / dt + endif + endif ! tr_iage + endif ! present(offset) enddo ! i enddo ! j From 12dd204349090058a66715163932ae3243f9632c Mon Sep 17 00:00:00 2001 From: Tony Craig Date: Fri, 22 Mar 2024 15:48:20 -0700 Subject: [PATCH 63/76] Port to Carpenter intel and gnu with intel mpi instead of cray-mpich (#942) --- configuration/scripts/cice.launch.csh | 22 +++++- .../scripts/machines/Macros.carpenter_cray | 2 +- .../scripts/machines/Macros.carpenter_gnu | 2 +- .../scripts/machines/Macros.carpenter_gnuimpi | 69 +++++++++++++++++++ .../scripts/machines/Macros.carpenter_intel | 2 +- .../machines/Macros.carpenter_intelimpi | 59 ++++++++++++++++ .../scripts/machines/env.carpenter_gnuimpi | 58 ++++++++++++++++ .../scripts/machines/env.carpenter_intelimpi | 57 +++++++++++++++ 8 files changed, 267 insertions(+), 4 deletions(-) create mode 100644 configuration/scripts/machines/Macros.carpenter_gnuimpi create mode 100644 configuration/scripts/machines/Macros.carpenter_intelimpi create mode 100644 configuration/scripts/machines/env.carpenter_gnuimpi create mode 100644 configuration/scripts/machines/env.carpenter_intelimpi diff --git a/configuration/scripts/cice.launch.csh b/configuration/scripts/cice.launch.csh index 85d647d76..51c8f044f 100755 --- a/configuration/scripts/cice.launch.csh +++ b/configuration/scripts/cice.launch.csh @@ -89,11 +89,31 @@ mpirun -np ${ntasks} -hostfile \$PBS_NODEFILE \${EXTRA_OMPI_SETTINGS} ./cice >&! EOFR #======= -else if (${ICE_MACHCOMP} =~ onyx* || ${ICE_MACHCOMP} =~ narwhal* || ${ICE_MACHCOMP} =~ carpenter*) then +else if (${ICE_MACHCOMP} =~ onyx* || ${ICE_MACHCOMP} =~ narwhal*) then cat >> ${jobfile} << EOFR aprun -q -n ${ntasks} -N ${taskpernodelimit} -d ${nthrds} ./cice >&! \$ICE_RUNLOG_FILE EOFR +#======= +else if (${ICE_MACHCOMP} =~ carpenter*) then +if (${ICE_COMMDIR} =~ serial*) then +cat >> ${jobfile} << EOFR +./cice >&! \$ICE_RUNLOG_FILE +EOFR +else + +if (${ICE_ENVNAME} =~ intelimpi* || ${ICE_ENVNAME} =~ gnuimpi*) then +cat >> ${jobfile} << EOFR +mpiexec -n ${ntasks} -ppn ${taskpernodelimit} ./cice >&! \$ICE_RUNLOG_FILE +EOFR +else +cat >> ${jobfile} << EOFR +mpiexec --cpu-bind depth -n ${ntasks} -ppn ${taskpernodelimit} -d ${nthrds} ./cice >&! \$ICE_RUNLOG_FILE +EOFR +endif + +endif + #======= else if (${ICE_MACHCOMP} =~ cori* || ${ICE_MACHCOMP} =~ perlmutter*) then if (${ICE_COMMDIR} =~ serial*) then diff --git a/configuration/scripts/machines/Macros.carpenter_cray b/configuration/scripts/machines/Macros.carpenter_cray index 8496f7a9b..1c8fb50ca 100644 --- a/configuration/scripts/machines/Macros.carpenter_cray +++ b/configuration/scripts/machines/Macros.carpenter_cray @@ -1,5 +1,5 @@ #============================================================================== -# Macros file for NAVYDSRC narwhal, cray compiler +# Macros file for ERDC carpenter, cray compiler #============================================================================== CPP := ftn -e P diff --git a/configuration/scripts/machines/Macros.carpenter_gnu b/configuration/scripts/machines/Macros.carpenter_gnu index 50dcdc08d..61efa80c2 100644 --- a/configuration/scripts/machines/Macros.carpenter_gnu +++ b/configuration/scripts/machines/Macros.carpenter_gnu @@ -1,5 +1,5 @@ #============================================================================== -# Macros file for NAVYDSRC narwhal, gnu compiler +# Macros file for ERDC carpenter, gnu compiler #============================================================================== CPP := ftn -E diff --git a/configuration/scripts/machines/Macros.carpenter_gnuimpi b/configuration/scripts/machines/Macros.carpenter_gnuimpi new file mode 100644 index 000000000..ef0c5e96a --- /dev/null +++ b/configuration/scripts/machines/Macros.carpenter_gnuimpi @@ -0,0 +1,69 @@ +#============================================================================== +# Macros file for NAVYDSRC narwhal, gnu compiler +#============================================================================== + +CPP := ftn -E +CPPDEFS := -DFORTRANUNDERSCORE ${ICE_CPPDEFS} +CFLAGS := -c + +FIXEDFLAGS := -ffixed-line-length-132 +FREEFLAGS := -ffree-form +FFLAGS := -fconvert=big-endian -fbacktrace -ffree-line-length-none -fallow-argument-mismatch +FFLAGS_NOOPT:= -O0 + +ifeq ($(ICE_BLDDEBUG), true) + FFLAGS += -O0 -g -fcheck=bounds -finit-real=nan -fimplicit-none -ffpe-trap=invalid,zero,overflow + CFLAGS += -O0 +endif + +ifeq ($(ICE_COVERAGE), true) + FFLAGS += -O0 -g -fprofile-arcs -ftest-coverage + CFLAGS += -O0 -g -coverage + LDFLAGS += -g -ftest-coverage -fprofile-arcs +endif + +ifneq ($(ICE_BLDDEBUG), true) +ifneq ($(ICE_COVERAGE), true) + FFLAGS += -O2 + CFLAGS += -O2 +endif +endif + +#SCC := gcc +#SFC := gfortran +SCC := mpicc +SFC := mpif90 +MPICC := mpicc +MPIFC := mpif90 + +ifeq ($(ICE_COMMDIR), mpi) + FC := $(MPIFC) + CC := $(MPICC) +else + FC := $(SFC) + CC := $(SCC) +endif +LD:= $(FC) + +# defined by module +#NETCDF_PATH := $(NETCDF) +#PNETCDF_PATH := $(PNETCDF) +#PNETCDF_PATH := /glade/apps/opt/pnetcdf/1.3.0/intel/default +#LAPACK_LIBDIR := /glade/apps/opt/lapack/3.4.2/intel/12.1.5/lib + +#PIO_CONFIG_OPTS:= --enable-filesystem-hints=gpfs + +INCLDIR := $(INCLDIR) +INCLDIR += -I$(NETCDF_PATH)/include + +LIB_NETCDF := $(NETCDF_PATH)/lib +#LIB_PNETCDF := $(PNETCDF_PATH)/lib +#LIB_MPI := $(IMPILIBDIR) +SLIBS := -L$(LIB_NETCDF) -lnetcdf -lnetcdff + +ifeq ($(ICE_THREADED), true) + LDFLAGS += -fopenmp + CFLAGS += -fopenmp + FFLAGS += -fopenmp +endif + diff --git a/configuration/scripts/machines/Macros.carpenter_intel b/configuration/scripts/machines/Macros.carpenter_intel index 53d63736d..d53f959e4 100644 --- a/configuration/scripts/machines/Macros.carpenter_intel +++ b/configuration/scripts/machines/Macros.carpenter_intel @@ -1,5 +1,5 @@ #============================================================================== -# Macros file for NAVYDSRC narwhal, intel compiler +# Macros file for ERDC carpenter, intel compiler #============================================================================== CPP := fpp diff --git a/configuration/scripts/machines/Macros.carpenter_intelimpi b/configuration/scripts/machines/Macros.carpenter_intelimpi new file mode 100644 index 000000000..0c1aa5812 --- /dev/null +++ b/configuration/scripts/machines/Macros.carpenter_intelimpi @@ -0,0 +1,59 @@ +#============================================================================== +# Macros file for ERDC carpenter, intel compiler, intel mpi +#============================================================================== + +CPP := fpp +CPPDEFS := -DFORTRANUNDERSCORE ${ICE_CPPDEFS} +CFLAGS := -c -O2 -fp-model precise -fcommon + +FIXEDFLAGS := -132 +FREEFLAGS := -FR +FFLAGS := -fp-model precise -convert big_endian -assume byterecl -ftz -traceback +# -mcmodel medium -shared-intel +FFLAGS_NOOPT:= -O0 + +ifeq ($(ICE_BLDDEBUG), true) + FFLAGS += -O0 -g -check uninit -check bounds -check pointers -fpe0 -check noarg_temp_created +# FFLAGS += -O0 -g -check all -fpe0 -ftrapuv -fp-model except -check noarg_temp_created -init=snan,arrays +else + FFLAGS += -O2 +endif + +#SCC := icx +#SFC := ifort +SCC := mpiicc +SFC := mpiifort +MPICC := mpiicc +MPIFC := mpiifort + +ifeq ($(ICE_COMMDIR), mpi) + FC := $(MPIFC) + CC := $(MPICC) +else + FC := $(SFC) + CC := $(SCC) +endif +LD:= $(FC) + +# defined by module +#NETCDF_PATH := $(NETCDF) +#PNETCDF_PATH := $(PNETCDF) +#PNETCDF_PATH := /glade/apps/opt/pnetcdf/1.3.0/intel/default +#LAPACK_LIBDIR := /glade/apps/opt/lapack/3.4.2/intel/12.1.5/lib + +#PIO_CONFIG_OPTS:= --enable-filesystem-hints=gpfs + +INCLDIR := $(INCLDIR) +INCLDIR += -I$(NETCDF_PATH)/include + +LIB_NETCDF := $(NETCDF_PATH)/lib +#LIB_PNETCDF := $(PNETCDF_PATH)/lib +#LIB_MPI := $(IMPILIBDIR) +SLIBS := -L$(LIB_NETCDF) -lnetcdf -lnetcdff + +ifeq ($(ICE_THREADED), true) + LDFLAGS += -qopenmp + CFLAGS += -qopenmp + FFLAGS += -qopenmp +endif + diff --git a/configuration/scripts/machines/env.carpenter_gnuimpi b/configuration/scripts/machines/env.carpenter_gnuimpi new file mode 100644 index 000000000..f21bf97a5 --- /dev/null +++ b/configuration/scripts/machines/env.carpenter_gnuimpi @@ -0,0 +1,58 @@ +#!/bin/csh -f + +set inp = "undefined" +if ($#argv == 1) then + set inp = $1 +endif + +if ("$inp" != "-nomodules") then + +source ${MODULESHOME}/init/csh + +module unload PrgEnv-cray +module unload PrgEnv-gnu +module unload PrgEnv-intel +module unload PrgEnv-pgi +module load PrgEnv-gnu/8.4.0 + +module unload gcc +module load gcc/11.2.0 + +module unload cray-mpich +module unload mpi +module unload openmpi +#module load cray-mpich/8.1.26 +#module load openmpi/4.1.6 +module load mpi/2021.11 + +module unload cray-hdf5 +module unload cray-hdf5-parallel +module unload cray-netcdf-hdf5parallel +module unload cray-parallel-netcdf +module unload netcdf +module load cray-netcdf/4.9.0.3 +module load cray-hdf5/1.12.2.3 + +setenv NETCDF_PATH ${NETCDF_DIR} +limit coredumpsize unlimited +limit stacksize unlimited +setenv OMP_STACKSIZE 128M +setenv OMP_WAIT_POLICY PASSIVE +setenv FI_CXI_RX_MATCH_MODE hybrid + +endif + +setenv ICE_MACHINE_MACHNAME carpenter +setenv ICE_MACHINE_MACHINFO "Cray EX4000 AMD 9654 Genoa 2.1GHz, Slingshot Interconnect" +setenv ICE_MACHINE_ENVNAME gnuimpi +setenv ICE_MACHINE_ENVINFO "gnu gcc 11.2.0 20210728, intel mpi 2021.11, netcdf/4.9.0.3" +setenv ICE_MACHINE_MAKE gmake +setenv ICE_MACHINE_WKDIR $WORKDIR/CICE_RUNS +setenv ICE_MACHINE_INPUTDATA /p/app/unsupported/RASM/cice_consortium +setenv ICE_MACHINE_BASELINE $WORKDIR/CICE_BASELINE +setenv ICE_MACHINE_SUBMIT "qsub " +setenv ICE_MACHINE_ACCT P00000000 +setenv ICE_MACHINE_QUEUE "debug" +setenv ICE_MACHINE_TPNODE 192 # tasks per node +setenv ICE_MACHINE_BLDTHRDS 12 +setenv ICE_MACHINE_QSTAT "qstat " diff --git a/configuration/scripts/machines/env.carpenter_intelimpi b/configuration/scripts/machines/env.carpenter_intelimpi new file mode 100644 index 000000000..25385b09a --- /dev/null +++ b/configuration/scripts/machines/env.carpenter_intelimpi @@ -0,0 +1,57 @@ +#!/bin/csh -f +set inp = "undefined" +if ($#argv == 1) then + set inp = $1 +endif + +if ("$inp" != "-nomodules") then + +source ${MODULESHOME}/init/csh + +module unload PrgEnv-cray +module unload PrgEnv-gnu +module unload PrgEnv-intel +module unload PrgEnv-pgi +module load PrgEnv-intel/8.4.0 + +module unload intel +module load intel/2023.0.0 + +module unload cray-mpich +module unload mpi +module unload openmpi +#module load cray-mpich/8.1.26 +module load mpi/2021.11 +#module load openmpi/4.1.6 + +module unload cray-hdf5 +module unload cray-hdf5-parallel +module unload cray-netcdf-hdf5parallel +module unload cray-parallel-netcdf +module unload netcdf +module load cray-netcdf/4.9.0.3 +module load cray-hdf5/1.12.2.3 + +setenv NETCDF_PATH ${NETCDF_DIR} +limit coredumpsize unlimited +limit stacksize unlimited +setenv OMP_STACKSIZE 128M +setenv OMP_WAIT_POLICY PASSIVE +setenv FI_CXI_RX_MATCH_MODE hybrid + +endif + +setenv ICE_MACHINE_MACHNAME carpenter +setenv ICE_MACHINE_MACHINFO "Cray EX4000 AMD 9654 Genoa 2.1GHz, Slingshot Interconnect" +setenv ICE_MACHINE_ENVNAME intelimpi +setenv ICE_MACHINE_ENVINFO "ifort 2021.8.0 20221119, intel mpi 2021.11, netcdf/4.9.0.3" +setenv ICE_MACHINE_MAKE gmake +setenv ICE_MACHINE_WKDIR $WORKDIR/CICE_RUNS +setenv ICE_MACHINE_INPUTDATA /p/app/unsupported/RASM/cice_consortium +setenv ICE_MACHINE_BASELINE $WORKDIR/CICE_BASELINE +setenv ICE_MACHINE_SUBMIT "qsub " +setenv ICE_MACHINE_ACCT P00000000 +setenv ICE_MACHINE_QUEUE "debug" +setenv ICE_MACHINE_TPNODE 192 # tasks per node +setenv ICE_MACHINE_BLDTHRDS 12 +setenv ICE_MACHINE_QSTAT "qstat " From 67a2f165741badd9622ce34dd560ee2559fa9849 Mon Sep 17 00:00:00 2001 From: Tony Craig Date: Thu, 4 Apr 2024 09:37:53 -0700 Subject: [PATCH 64/76] Add checks that individual history streams have unique filenames (#943) Add checks that individual history streams have unique filenames. If they do not, then streams will overwrite each other. With this change, abort in that case. Added in ice_history_shared.F90, subroutine construct_filename. The implementation tracks the latest filenames for each stream and checks versus those names. Because the file naming convention relies heavily on the current model date/time, this should be adequate (versus keeping track of all history filenames ever used). Updated the cstream string in subroutine construct_filename. It was hardwired to len=1 which probably was an error. Made it len=char_len to support longer hist_suffix character strings in filenames. Updated the ncfile variable implementation in ice_write_hist in io_binary, io_netcdf, and io_pio2. It was defined as an array of length max_nstrm, and was changed to a non-array character string. The array implementation served no purpose. Modified the set_nml.histinst to add hist_suffix values for each stream. The latest code modifications cause The current test suite to fail with "histall,histinst" because it creates multiple streams with the same filename. Setting hist_suffix for histinst fixes this (and tests hist_suffix). Clean up abort calls in ice_history_shared.F90, add space before "ERROR:". Update the documentation describing history streams. Some "_" formatting was changed to simply "_" where the backslash wasn't needed in ug_implementation.rst. Several namelist settings were tested to make sure the model would abort with identical filenames including the case where a time averaged file with output at each timestep conflicts with an instantaneous history stream of lower output frequency. --- .../cicedyn/analysis/ice_history_shared.F90 | 42 +++-- cicecore/cicedyn/general/ice_init.F90 | 2 +- .../io/io_binary/ice_history_write.F90 | 16 +- .../io/io_netcdf/ice_history_write.F90 | 14 +- .../io/io_pio2/ice_history_write.F90 | 12 +- .../scripts/options/set_nml.histinst | 1 + doc/source/user_guide/ug_case_settings.rst | 2 +- doc/source/user_guide/ug_implementation.rst | 150 +++++++++--------- 8 files changed, 130 insertions(+), 109 deletions(-) diff --git a/cicecore/cicedyn/analysis/ice_history_shared.F90 b/cicecore/cicedyn/analysis/ice_history_shared.F90 index 62ee3c2ba..d6fa78542 100644 --- a/cicecore/cicedyn/analysis/ice_history_shared.F90 +++ b/cicecore/cicedyn/analysis/ice_history_shared.F90 @@ -57,7 +57,7 @@ module ice_history_shared history_rearranger ! history file rearranger, box or subset for pio character (len=char_len), public :: & - hist_suffix(max_nstrm) ! appended to 'h' in filename when not 'x' + hist_suffix(max_nstrm) ! appended to history_file in filename integer (kind=int_kind), public :: & history_iotasks , & ! iotasks, root, stride defines io pes for pio @@ -757,18 +757,22 @@ subroutine construct_filename(ncfile,suffix,ns) dt use ice_restart_shared, only: lenstr - character (char_len_long), intent(inout) :: ncfile - character (len=2), intent(in) :: suffix + character (len=*), intent(inout) :: ncfile + character (len=*), intent(in) :: suffix integer (kind=int_kind), intent(in) :: ns integer (kind=int_kind) :: iyear, imonth, iday, isec - character (len=1) :: cstream + integer (kind=int_kind) :: n + character (len=char_len) :: cstream + character (len=char_len_long), save :: ncfile_last(max_nstrm) = 'UnDefineD' character(len=*), parameter :: subname = '(construct_filename)' iyear = myear imonth = mmonth iday = mday isec = int(msec - dt,int_kind) + cstream = '' + if (hist_suffix(ns) /= 'x') cstream = hist_suffix(ns) ! construct filename if (write_ic) then @@ -793,9 +797,6 @@ subroutine construct_filename(ncfile,suffix,ns) endif endif - cstream = '' - if (hist_suffix(ns) /= 'x') cstream = hist_suffix(ns) - 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)') & @@ -831,6 +832,25 @@ subroutine construct_filename(ncfile,suffix,ns) endif + ! Check whether the filename is already in use. + ! Same filename in multiple history streams leads to files being overwritten (not good). + ! The current filename convention means we just have to check latest filename, + ! not all filenames ever generated because of use of current model date/time in filename. + + ! write(nu_diag,'(2a,i2,1x,a)') subname, 'debug ncfile= ',ns,trim(ncfile) + do n = 1,max_nstrm + ! write(nu_diag,'(2a,i2,1x,a)') subname, 'debug nfile_last= ',n,trim(ncfile_last(n)) + if (ncfile == ncfile_last(n)) then + write(nu_diag,*) subname,' history stream = ',ns + write(nu_diag,*) subname,' history filename = ',trim(ncfile) + write(nu_diag,*) subname,' filename in use for stream ',n + write(nu_diag,*) subname,' filename for stream ',trim(ncfile_last(n)) + write(nu_diag,*) subname,' Use namelist hist_suffix so history filenames are unique' + call abort_ice(subname//' ERROR: history filename already used for another history stream '//trim(ncfile)) + endif + enddo + ncfile_last(ns) = ncfile + end subroutine construct_filename !======================================================================= @@ -891,7 +911,7 @@ subroutine define_hist_field(id, vname, vunit, vcoord, vcellmeas, & if(present(mask_ice_free_points)) l_mask_ice_free_points = mask_ice_free_points if (histfreq(ns) == 'x') then - call abort_ice(subname//'ERROR: define_hist_fields has histfreq x') + call abort_ice(subname//' ERROR: define_hist_fields has histfreq x') endif if (ns == 1) id(:) = 0 @@ -901,7 +921,7 @@ subroutine define_hist_field(id, vname, vunit, vcoord, vcellmeas, & if (vhistfreq(ns1:ns1) == histfreq(ns)) then if (ns1 > 1 .and. index(vhistfreq(1:ns1-1),'x') /= 0) then - call abort_ice(subname//'ERROR: history frequency variable f_' // vname // ' can''t contain ''x'' along with active frequencies') + call abort_ice(subname//' ERROR: history frequency variable f_' // vname // ' can''t contain ''x'' along with active frequencies') endif num_avail_hist_fields_tot = num_avail_hist_fields_tot + 1 @@ -931,7 +951,7 @@ subroutine define_hist_field(id, vname, vunit, vcoord, vcellmeas, & write(nu_diag,*) subname,' num_avail_hist_fields_tot = ',num_avail_hist_fields_tot write(nu_diag,*) subname,' max_avail_hist_fields = ',max_avail_hist_fields endif - call abort_ice(subname//'ERROR: Need in computation of max_avail_hist_fields') + call abort_ice(subname//' ERROR: Need in computation of max_avail_hist_fields') endif if (num_avail_hist_fields_tot /= & @@ -947,7 +967,7 @@ subroutine define_hist_field(id, vname, vunit, vcoord, vcellmeas, & if (my_task == master_task) then write(nu_diag,*) subname,' num_avail_hist_fields_tot = ',num_avail_hist_fields_tot endif - call abort_ice(subname//'ERROR: in num_avail_hist_fields') + call abort_ice(subname//' ERROR: in num_avail_hist_fields') endif id(ns) = num_avail_hist_fields_tot diff --git a/cicecore/cicedyn/general/ice_init.F90 b/cicecore/cicedyn/general/ice_init.F90 index 24ac40db3..a7f84e46e 100644 --- a/cicecore/cicedyn/general/ice_init.F90 +++ b/cicecore/cicedyn/general/ice_init.F90 @@ -938,7 +938,7 @@ subroutine input_data call broadcast_scalar(histfreq_base(n), master_task) call broadcast_scalar(dumpfreq(n), master_task) call broadcast_scalar(dumpfreq_base(n), master_task) - call broadcast_scalar(hist_suffix(n), master_task) + call broadcast_scalar(hist_suffix(n), master_task) enddo call broadcast_array(hist_avg, master_task) call broadcast_array(histfreq_n, master_task) 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 b16d00f07..dae187eae 100644 --- a/cicecore/cicedyn/infrastructure/io/io_binary/ice_history_write.F90 +++ b/cicecore/cicedyn/infrastructure/io/io_binary/ice_history_write.F90 @@ -58,7 +58,7 @@ subroutine ice_write_hist(ns) integer (kind=int_kind) :: k,n,nn,nrec,nbits character (char_len) :: title - character (char_len_long) :: ncfile(max_nstrm), hdrfile + character (char_len_long) :: ncfile, hdrfile integer (kind=int_kind) :: icategory,i_aice @@ -85,26 +85,26 @@ subroutine ice_write_hist(ns) if (my_task == master_task) then - call construct_filename(ncfile(ns),'da',ns) + call construct_filename(ncfile,'da',ns) ! add local directory path name to ncfile if (write_ic) then - ncfile(ns) = trim(incond_dir)//ncfile(ns) + ncfile = trim(incond_dir)//ncfile else - ncfile(ns) = trim(history_dir)//ncfile(ns) + ncfile = trim(history_dir)//ncfile endif - hdrfile = trim(ncfile(ns))//'.hdr' + hdrfile = trim(ncfile)//'.hdr' !----------------------------------------------------------------- ! create history files !----------------------------------------------------------------- - call ice_open(nu_history, ncfile(ns), nbits) ! direct access + call ice_open(nu_history, ncfile, nbits) ! direct access open(nu_hdr,file=hdrfile,form='formatted',status='unknown') ! ascii title = 'sea ice model: CICE' write (nu_hdr, 999) 'source',title,' ' - write (nu_hdr, 999) 'file name contains model date',trim(ncfile(ns)),' ' + write (nu_hdr, 999) 'file name contains model date',trim(ncfile),' ' #ifdef CESMCOUPLED write (nu_hdr, 999) 'runid',runid,' ' #endif @@ -391,7 +391,7 @@ subroutine ice_write_hist(ns) close (nu_hdr) ! header file close (nu_history) ! data file write (nu_diag,*) ' ' - write (nu_diag,*) 'Finished writing ',trim(ncfile(ns)) + write (nu_diag,*) 'Finished writing ',trim(ncfile) endif end subroutine ice_write_hist 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 396c52e37..7d29fc4cc 100644 --- a/cicecore/cicedyn/infrastructure/io/io_netcdf/ice_history_write.F90 +++ b/cicecore/cicedyn/infrastructure/io/io_netcdf/ice_history_write.F90 @@ -102,7 +102,7 @@ subroutine ice_write_hist (ns) real (kind=dbl_kind) :: ltime2 character (char_len) :: title, cal_units, cal_att character (char_len) :: time_period_freq = 'none' - character (char_len_long) :: ncfile(max_nstrm) + character (char_len_long) :: ncfile real (kind=dbl_kind) :: secday, rad_to_deg integer (kind=int_kind) :: ind,boundid, lprecision @@ -139,13 +139,13 @@ subroutine ice_write_hist (ns) if (my_task == master_task) then - call construct_filename(ncfile(ns),'nc',ns) + call construct_filename(ncfile,'nc',ns) ! add local directory path name to ncfile if (write_ic) then - ncfile(ns) = trim(incond_dir)//ncfile(ns) + ncfile = trim(incond_dir)//ncfile else - ncfile(ns) = trim(history_dir)//ncfile(ns) + ncfile = trim(history_dir)//ncfile endif ! create file @@ -161,8 +161,8 @@ subroutine ice_write_hist (ns) 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), & + status = nf90_create(ncfile, iflag, ncid) + call ice_check_nc(status, subname// ' ERROR: creating history ncfile '//ncfile, & file=__FILE__, line=__LINE__) !----------------------------------------------------------------- @@ -1160,7 +1160,7 @@ subroutine ice_write_hist (ns) 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)) + write(nu_diag,*) 'Finished writing ',trim(ncfile) endif #else 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 0281f3721..b8971a872 100644 --- a/cicecore/cicedyn/infrastructure/io/io_pio2/ice_history_write.F90 +++ b/cicecore/cicedyn/infrastructure/io/io_pio2/ice_history_write.F90 @@ -93,7 +93,7 @@ subroutine ice_write_hist (ns) 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) + character (len=char_len_long) :: ncfile integer (kind=int_kind) :: icategory,ind,i_aice,boundid, lprecision @@ -156,15 +156,15 @@ subroutine ice_write_hist (ns) file=__FILE__, line=__LINE__) if (my_task == master_task) then - call construct_filename(ncfile(ns),'nc',ns) + call construct_filename(ncfile,'nc',ns) ! add local directory path name to ncfile if (write_ic) then - ncfile(ns) = trim(incond_dir)//ncfile(ns) + ncfile = trim(incond_dir)//ncfile else - ncfile(ns) = trim(history_dir)//ncfile(ns) + ncfile = trim(history_dir)//ncfile endif - filename = ncfile(ns) + filename = ncfile end if call broadcast_scalar(filename, master_task) @@ -1252,7 +1252,7 @@ subroutine ice_write_hist (ns) call pio_closefile(File) if (my_task == master_task) then write(nu_diag,*) ' ' - write(nu_diag,*) 'Finished writing ',trim(ncfile(ns)) + write(nu_diag,*) 'Finished writing ',trim(ncfile) endif first_call = .false. diff --git a/configuration/scripts/options/set_nml.histinst b/configuration/scripts/options/set_nml.histinst index 31d566d76..34000f635 100644 --- a/configuration/scripts/options/set_nml.histinst +++ b/configuration/scripts/options/set_nml.histinst @@ -1 +1,2 @@ hist_avg = .false.,.false.,.false.,.false.,.false. +hist_suffix = '1','2','3','4','5' diff --git a/doc/source/user_guide/ug_case_settings.rst b/doc/source/user_guide/ug_case_settings.rst index b8bde525d..9f1f8a259 100644 --- a/doc/source/user_guide/ug_case_settings.rst +++ b/doc/source/user_guide/ug_case_settings.rst @@ -186,7 +186,6 @@ setup_nml "", "zero", "restart output frequency relative to year-month-day of 0000-01-01", "" "``dumpfreq_n``", "integer array", "write restart frequency with ``dumpfreq``", "1,1,1,1,1" "``dump_last``", "logical", "write restart on last time step of simulation", "``.false.``" - "``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", "" @@ -218,6 +217,7 @@ setup_nml "", "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_avg``", "logical", "write time-averaged data", "``.true.,.true.,.true.,.true.,.true.``" "``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``" diff --git a/doc/source/user_guide/ug_implementation.rst b/doc/source/user_guide/ug_implementation.rst index c243616d2..7d172e91d 100644 --- a/doc/source/user_guide/ug_implementation.rst +++ b/doc/source/user_guide/ug_implementation.rst @@ -132,11 +132,11 @@ This is shown in Figure :ref:`fig-Cgrid`. The user has several ways to initialize the grid: *popgrid* reads grid lengths and other parameters for a nonuniform grid (including tripole and regional grids), and *rectgrid* creates a regular rectangular grid. -The input files **global\_gx3.grid** and **global\_gx3.kmt** contain the +The input files **global_gx3.grid** and **global_gx3.kmt** contain the :math:`\left<3^\circ\right>` POP grid and land mask; -**global\_gx1.grid** and **global\_gx1.kmt** contain the -:math:`\left<1^\circ\right>` grid and land mask, and **global\_tx1.grid** -and **global\_tx1.kmt** contain the :math:`\left<1^\circ\right>` POP +**global_gx1.grid** and **global_gx1.kmt** contain the +:math:`\left<1^\circ\right>` grid and land mask, and **global_tx1.grid** +and **global_tx1.kmt** contain the :math:`\left<1^\circ\right>` POP tripole grid and land mask. These are binary unformatted, direct access, Big Endian files. @@ -183,7 +183,7 @@ block distribution are ``nx_block`` :math:`\times`\ ``ny_block``. The physical portion of a subdomain is indexed as [``ilo:ihi``, ``jlo:jhi``], with nghost “ghost” or “halo" cells outside the domain used for boundary conditions. These parameters are illustrated in :ref:`fig-grid` in one -dimension. The routines *global\_scatter* and *global\_gather* +dimension. The routines *global_scatter* and *global_gather* distribute information from the global domain to the local domains and back, respectively. If MPI is not being used for grid decomposition in the ice model, these routines simply adjust the indexing on the global @@ -215,7 +215,7 @@ four subdomains. The user sets the ``NTASKS`` and ``NTHRDS`` settings in **cice.settings** and chooses a block size ``block_size_x`` :math:`\times`\ ``block_size_y``, ``max_blocks``, and decomposition information ``distribution_type``, ``processor_shape``, -and ``distribution_type`` in **ice\_in**. That information is used to +and ``distribution_type`` in **ice_in**. That information is used to determine how the blocks are distributed across the processors, and how the processors are distributed across the grid domain. The model is parallelized over blocks @@ -223,18 +223,18 @@ for both MPI and OpenMP. Some suggested combinations for these parameters for best performance are given in Section :ref:`performance`. The script **cice.setup** computes some default decompositions and layouts but the user can overwrite the defaults by manually changing the values in -`ice\_in`. At runtime, the model will print decomposition +`ice_in`. At runtime, the model will print decomposition information to the log file, and if the block size or max blocks is inconsistent with the task and thread size, the model will abort. The code will also print a warning if the maximum number of blocks is too large. Although this is not fatal, it does use extra memory. If ``max_blocks`` is set to -1, the code will compute a tentative ``max_blocks`` on the fly. -A loop at the end of routine *create\_blocks* in module -**ice\_blocks.F90** will print the locations for all of the blocks on +A loop at the end of routine *create_blocks* in module +**ice_blocks.F90** will print the locations for all of the blocks on the global grid if the namelist variable ``debug_blocks`` is set to be true. Likewise, a similar loop at -the end of routine *create\_local\_block\_ids* in module -**ice\_distribution.F90** will print the processor and local block +the end of routine *create_local_block_ids* in module +**ice_distribution.F90** will print the processor and local block number for each block. With this information, the grid decomposition into processors and blocks can be ascertained. This ``debug_blocks`` variable should be used carefully as there may be hundreds or thousands of blocks to print @@ -242,7 +242,7 @@ and this information should be needed only rarely. ``debug_blocks`` can be set to true using the ``debugblocks`` option with **cice.setup**. This information is much easier to look at using a debugger such as Totalview. There is also -an output field that can be activated in `icefields\_nml`, ``f_blkmask``, +an output field that can be activated in `icefields_nml`, ``f_blkmask``, that prints out the variable ``blkmask`` to the history file and which labels the blocks in the grid decomposition according to ``blkmask = my_task + iblk/100``. @@ -427,7 +427,7 @@ restoring timescale ``trestore`` may be used (it is also used for restoring ocean sea surface temperature in stand-alone ice runs). This implementation is only intended to provide the “hooks" for a more sophisticated treatment; the rectangular grid option can be used to test -this configuration. The ‘displaced\_pole’ grid option should not be used +this configuration. The ‘displaced_pole’ grid option should not be used unless the regional grid contains land all along the north and south boundaries. The current form of the boundary condition routines does not allow Neumann boundary conditions, which must be set explicitly. This @@ -470,7 +470,7 @@ The logical masks ``tmask``, ``umask``, ``nmask``, and ``emask`` respectively) are useful in conditional statements. In addition to the land masks, two other masks are implemented in -*dyn\_prep* in order to reduce the dynamics component’s work on a global +*dyn_prep* in order to reduce the dynamics component’s work on a global grid. At each time step the logical masks ``iceTmask`` and ``iceUmask`` are determined from the current ice extent, such that they have the value “true” wherever ice exists. They also include a border of cells around @@ -842,7 +842,7 @@ is the step count at the start of a long multi-restart run, and is continuous across model restarts. In general, the time manager should be advanced by calling -*advance\_timestep*. This subroutine in **ice\_calendar.F90** +*advance_timestep*. This subroutine in **ice_calendar.F90** automatically advances the model time by ``dt``. It also advances the istep numbers and calls subroutine *calendar* to update additional calendar data. @@ -912,7 +912,7 @@ may vary with each run depending on several factors including the model timestep, initial date, and value of ``istep0``. The model year is limited by some integer math. In particular, calculation -of elapsed hours in **ice\_calendar.F90**, and the model year is +of elapsed hours in **ice_calendar.F90**, and the model year is limited to the value of ``myear_max`` set in that file. Currently, that's 200,000 years. @@ -927,10 +927,10 @@ set the namelist variables ``year_init``, ``month_init``, ``day_init``, ``sec_init``, and ``dt`` in conjuction with ``days_per_year`` and ``use_leap_years`` to initialize the model date, timestep, and calendar. To overwrite the default/namelist settings in the coupling layer, -set the **ice\_calendar.F90** variables ``myear``, ``mmonth``, ``mday``, +set the **ice_calendar.F90** variables ``myear``, ``mmonth``, ``mday``, ``msec`` and ``dt`` after the namelists have been read. Subroutine *calendar* should then be called to update all the calendar data. -Finally, subroutine *advance\_timestep* should be used to advance +Finally, subroutine *advance_timestep* should be used to advance the model time manager. It advances the step numbers, advances time by ``dt``, and updates the calendar data. The older method of manually advancing the steps and adding ``dt`` to ``time`` should @@ -945,11 +945,11 @@ Initialization and Restarts The ice model’s parameters and variables are initialized in several steps. Many constants and physical parameters are set in -**ice\_constants.F90**. Namelist variables (:ref:`tabnamelist`), -whose values can be altered at run time, are handled in *input\_data* +**ice_constants.F90**. Namelist variables (:ref:`tabnamelist`), +whose values can be altered at run time, are handled in *input_data* and other initialization routines. These variables are given default values in the code, which may then be changed when the input file -**ice\_in** is read. Other physical constants, numerical parameters, and +**ice_in** is read. Other physical constants, numerical parameters, and variables are first set in initialization routines for each ice model component or module. Then, if the ice model is being restarted from a previous run, core variables are read and reinitialized in @@ -1038,12 +1038,12 @@ An additional namelist option, ``restart_coszen`` specifies whether the cosine of the zenith angle is included in the restart files. This is mainly used in coupled models. -MPI is initialized in *init\_communicate* for both coupled and +MPI is initialized in *init_communicate* for both coupled and stand-alone MPI runs. The ice component communicates with a flux coupler or other climate components via external routines that handle the variables listed in the `Icepack documentation `_. For stand-alone runs, -routines in **ice\_forcing.F90** read and interpolate data from files, +routines in **ice_forcing.F90** read and interpolate data from files, and are intended merely to provide guidance for the user to write his or her own routines. Whether the code is to be run in stand-alone or coupled mode is determined at compile time, as described below. @@ -1232,51 +1232,54 @@ 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`. -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". - -The data written at the period(s) given by ``histfreq`` and +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 +The files are written to binary or netCDF files prepended by the ``history_file`` +and ``history_suffix`` +namelist setting. The 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. With binary files, a separate header +The history filenames will have a form like +**[history_file][history_suffix][_freq].[timeID].[nc,da]** +depending on the namelist options 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** +according to settings in the **icefields_nml** section of **ice_in** (see :ref:`tabnamelist`). The user may add (or subtract) variables not already available in the namelist by following the instructions in section :ref:`addhist`. -The history module has been divided into several +The history implementation has been divided into several modules based on the desired formatting and on the variables themselves. Parameters, variables and routines needed by multiple -modules is in **ice\_history\_shared.F90**, while the primary routines +modules is in **ice_history_shared.F90**, while the primary routines for initializing and accumulating all of the history variables are in -**ice\_history.F90**. These routines call format-specific code in the -**io\_binary**, **io\_netcdf** and **io\_pio** directories. History +**ice_history.F90**. These routines call format-specific code in the +**io_binary**, **io_netcdf** and **io_pio2** directories. History variables specific to certain components or parameterizations are -collected in their own history modules (**ice\_history\_bgc.F90**, -**ice\_history\_drag.F90**, **ice\_history\_mechred.F90**, -**ice\_history\_pond.F90**). +collected in their own history modules (**ice_history_bgc.F90**, +**ice_history_drag.F90**, **ice_history_mechred.F90**, +**ice_history_pond.F90**). The history modules allow output at different frequencies. Five output -frequencies (``1``, ``h``, ``d``, ``m``, ``y``) are available simultaneously during a run. -The same variable can be output at different frequencies (say daily and -monthly) via its namelist flag, `f\_` :math:`\left<{var}\right>`, which -is a character string corresponding to ``histfreq`` or ‘x’ for none. -(Grid variable flags are logicals, since they are written to all -files, no matter what the frequency is.) If there are no namelist flags +options (``1``, ``h``, ``d``, ``m``, ``y``) are available simultaneously for ``histfreq`` +during a run, and each stream must have a unique value for ``histfreq``. In other words, ``d`` +cannot be used by two different streams. Each stream has an associated frequency +set by ``histfreq_n``. The frequency is +relative to a reference date specified by the corresponding entry in ``histfreq_base``. +Each stream can be instantaneous or time averaged +data over the frequency internal. The ``hist_avg`` namelist turns on time averaging +for each stream individually. +The same model variable can be written to multiple history streams (ie. daily ``d`` and +monthly ``m``) via its namelist flag, `f_` :math:`\left<{var}\right>`, while ``x`` +turns that history variable off. For example, ``f_aice = 'md'`` will write aice to the +monthly and daily streams. +Grid variable history output flags are logicals and written to all stream files if +turned on. If there are no namelist flags with a given ``histfreq`` value, or if an element of ``histfreq_n`` is 0, then -no file will be written at that frequency. The output period can be -discerned from the filenames or the ``hist_suffix`` can be used. Each history stream will be either instantaneous -or averaged as specified by the corresponding entry in the ``hist_avg`` namelist array, and the frequency -will be relative to a reference date specified by the corresponding entry in ``histfreq_base``. -More information about how the frequency is -computed is found in :ref:`timemanager`. +no file will be written at that frequency. The history filenames are set in +the subroutine **construct_filename** in **ice_history_shared.F90**. +In cases where two streams produce the same identical filename, the model will +abort. Use the namelist ``hist_suffix`` to make stream filenames unique. +More information about how the frequency is computed is found in :ref:`timemanager`. Also, some Earth Sytem Models require the history file time axis to be centered in the averaging interval. The flag ``hist_time_axis`` will allow the user to chose ``begin``, ``middle``, @@ -1299,7 +1302,9 @@ For example, in the namelist: Here, ``hi`` will be written to a file on every timestep, ``hs`` will be written once every 6 hours, ``aice`` once a month, ``meltb`` once a month AND -once every 6 hours, and ``Tsfc`` and ``iage`` will not be written. +once every 6 hours, and ``Tsfc`` and ``iage`` will not be written. All streams +are time averaged over the interval although because one stream has ``histfreq=1`` and +``histfreq_n=1``, that is equivalent to instantaneous output each model timestep. From an efficiency standpoint, it is best to set unused frequencies in ``histfreq`` to ‘x’. Having output at all 5 frequencies takes nearly 5 times @@ -1322,19 +1327,14 @@ above, ``meltb`` is called ``meltb`` in the monthly file (for backward compatibility with the default configuration) and ``meltb_h`` in the 6-hourly file. -Using the same frequency twice in ``histfreq`` will have unexpected -consequences and currently will cause the code to abort. It is not -possible at the moment to output averages once a month and also once -every 3 months, for example. - -If ``write_ic`` is set to true in **ice\_in**, a snapshot of the same set +If ``write_ic`` is set to true in **ice_in**, a snapshot of the same set of history fields at the start of the run will be written to the history -directory in **iceh\_ic.[timeID].nc(da)**. Several history variables are +directory in **iceh_ic.[timeID].nc(da)**. Several history variables are hard-coded for instantaneous output regardless of the ``hist_avg`` averaging flag, at the frequency given by their namelist flag. The normalized principal components of internal ice stress (``sig1``, ``sig2``) are computed -in *principal\_stress* and written to the history file. This calculation +in *principal_stress* and written to the history file. This calculation is not necessary for the simulation; principal stresses are merely computed for diagnostic purposes and included here for the user’s convenience. @@ -1342,7 +1342,7 @@ convenience. Several history variables are available in two forms, a value representing an average over the sea ice fraction of the grid cell, and another that is multiplied by :math:`a_i`, representing an average over -the grid cell area. Our naming convention attaches the suffix “\_ai" to +the grid cell area. Our naming convention attaches the suffix “_ai" to the grid-cell-mean variable names. Beginning with CICE v6, history variables requested by the Sea Ice Model Intercomparison @@ -1352,9 +1352,9 @@ Project (SIMIP) :cite:`Notz16` have been added as possible history output variab `daily `_ requested SIMIP variables provide the names of possible history fields in CICE. However, each of the additional variables can be output at any temporal frequency -specified in the **icefields\_nml** section of **ice\_in** as detailed above. +specified in the **icefields_nml** section of **ice_in** as detailed above. Additionally, a new history output variable, ``f_CMIP``, has been added. When ``f_CMIP`` -is added to the **icefields\_nml** section of **ice\_in** then all SIMIP variables +is added to the **icefields_nml** section of **ice_in** then all SIMIP variables will be turned on for output at the frequency specified by ``f_CMIP``. It may also be helpful for debugging to increase the precision of the history file @@ -1367,7 +1367,7 @@ Diagnostic files Like ``histfreq``, the parameter ``diagfreq`` can be used to regulate how often output is written to a log file. The log file unit to which diagnostic -output is written is set in **ice\_fileunits.F90**. If ``diag_type`` = +output is written is set in **ice_fileunits.F90**. If ``diag_type`` = ‘stdout’, then it is written to standard out (or to **ice.log.[ID]** if you redirect standard out as in **cice.run**); otherwise it is written to the file given by ``diag_file``. @@ -1381,7 +1381,7 @@ useful for checking global conservation of mass and energy. ``print_points`` writes data for two specific grid points defined by the input namelist ``lonpnt`` and ``latpnt``. By default, one point is near the North Pole and the other is in the Weddell Sea; these -may be changed in **ice\_in**. +may be changed in **ice_in**. The namelist ``debug_model`` prints detailed debug diagnostics for a single point as the model advances. The point is defined @@ -1394,16 +1394,16 @@ namelist, the point associated with ``lonpnt(1)`` and ``latpnt(1)`` is used. in detail at a particular (usually failing) grid point. Memory use diagnostics are controlled by the logical namelist ``memory_stats``. -This feature uses an intrinsic query in C defined in **ice\_memusage\_gptl.c**. +This feature uses an intrinsic query in C defined in **ice_memusage_gptl.c**. Memory diagnostics will be written at the the frequency defined by diagfreq. -Timers are declared and initialized in **ice\_timers.F90**, and the code -to be timed is wrapped with calls to *ice\_timer\_start* and -*ice\_timer\_stop*. Finally, *ice\_timer\_print* writes the results to +Timers are declared and initialized in **ice_timers.F90**, and the code +to be timed is wrapped with calls to *ice_timer_start* and +*ice_timer_stop*. Finally, *ice_timer_print* writes the results to the log file. The optional “stats" argument (true/false) prints additional statistics. The "stats" argument can be set by the ``timer_stats`` -namelist. Calling *ice\_timer\_print\_all* prints all of +namelist. Calling *ice_timer_print_all* prints all of the timings at once, rather than having to call each individually. Currently, the timers are set up as in :ref:`timers`. Section :ref:`addtimer` contains instructions for adding timers. @@ -1415,8 +1415,8 @@ the code, including the dynamics and advection routines. The Dynamics, Advection, and Column timers do not overlap and represent most of the overall model work. -The timers use *MPI\_WTIME* for parallel runs and the F90 intrinsic -*system\_clock* for single-processor runs. +The timers use *MPI_WTIME* for parallel runs and the F90 intrinsic +*system_clock* for single-processor runs. .. _timers: From 29c7bcf839bc3ce48e4d6128d6f29ba73839222e Mon Sep 17 00:00:00 2001 From: Denise Worthen Date: Mon, 15 Apr 2024 17:05:45 -0400 Subject: [PATCH 65/76] remove compiler warnings for CICE; fix missing j-loop index (#75) (#944) * fix dummy arguments w/o values * fix missing j-loop in export 4d Resolve compiler warning arising from ice_prescribed_mod due to the intent(out) variable RC not being given an explicit value. This is an operational requirement for NOAA. Fix bug arising from missing j-loop index in ice_import_export --- cicecore/drivers/nuopc/cmeps/ice_import_export.F90 | 8 +++++--- cicecore/drivers/nuopc/cmeps/ice_prescribed_mod.F90 | 4 +++- 2 files changed, 8 insertions(+), 4 deletions(-) diff --git a/cicecore/drivers/nuopc/cmeps/ice_import_export.F90 b/cicecore/drivers/nuopc/cmeps/ice_import_export.F90 index 2c7da8d0b..47abb0373 100644 --- a/cicecore/drivers/nuopc/cmeps/ice_import_export.F90 +++ b/cicecore/drivers/nuopc/cmeps/ice_import_export.F90 @@ -1773,9 +1773,11 @@ subroutine state_setexport_4d(state, fldname, input, index, lmask, ifrac, ungrid end do end do else - do i = ilo, ihi - n = n+1 - dataPtr1d(n) = input(i,j,index,iblk) + do j = jlo, jhi + do i = ilo, ihi + n = n+1 + dataPtr1d(n) = input(i,j,index,iblk) + end do end do end if end do diff --git a/cicecore/drivers/nuopc/cmeps/ice_prescribed_mod.F90 b/cicecore/drivers/nuopc/cmeps/ice_prescribed_mod.F90 index 0a11ee6ea..b46f22ff7 100644 --- a/cicecore/drivers/nuopc/cmeps/ice_prescribed_mod.F90 +++ b/cicecore/drivers/nuopc/cmeps/ice_prescribed_mod.F90 @@ -7,7 +7,8 @@ module ice_prescribed_mod ! Ice/ocean fluxes are set to zero, and ice dynamics are not calculated. ! Regridding and data cycling capabilities are included. - use ESMF + use ESMF, only : ESMF_Clock, ESMF_Mesh, ESMF_SUCCESS, ESMF_FAILURE + use ESMF, only : ESMF_LogFoundError, ESMF_LOGERR_PASSTHRU, ESMF_Finalize, ESMF_END_ABORT #ifndef CESMCOUPLED @@ -23,6 +24,7 @@ subroutine ice_prescribed_init(clock, mesh, rc) type(ESMF_Mesh) , intent(in) :: mesh integer , intent(out) :: rc ! do nothing + rc = ESMF_SUCCESS end subroutine ice_prescribed_init #else From 3e30553fad3bbc637acc9f58ef3dc5889dbdfc68 Mon Sep 17 00:00:00 2001 From: Tony Craig Date: Wed, 1 May 2024 12:56:21 -0700 Subject: [PATCH 66/76] Fix Github Actions for macos system update (#948) Github Actions broke again after default macos system update. Clang was not picking up the C system files. Had to change the implementation and add -isysroot to the CFLAGS option. At the same time, removed prior implementation where the system files were linked into /usr/local/include, this was no longer working. --- .github/workflows/test-cice.yml | 3 +-- configuration/scripts/machines/Macros.conda_macos | 3 ++- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/.github/workflows/test-cice.yml b/.github/workflows/test-cice.yml index e7e41de11..20d944d88 100644 --- a/.github/workflows/test-cice.yml +++ b/.github/workflows/test-cice.yml @@ -46,7 +46,6 @@ jobs: run: | sudo xcode-select -r sudo xcode-select -s /Library/Developer/CommandLineTools - sudo ln -s /Library/Developer/CommandLineTools/SDKs/MacOSX.sdk/usr/include/* /usr/local/include/ echo "xcrun --show-sdk-path: $(xcrun --show-sdk-path)" echo "xcode-select -p: $(xcode-select -p)" - name: system info @@ -55,7 +54,7 @@ jobs: type wget type curl type csh - echo "readlink \$(which csh): $(python -c 'import os, sys; print os.path.realpath(sys.argv[1])' $(which csh))" + echo "readlink \$(which csh): $(python -c 'import os, sys; print(os.path.realpath(sys.argv[1]))' $(which csh))" echo "csh --version: $(csh --version)" echo "uname -a: $(uname -a)" echo "sw_vers: $(sw_vers)" diff --git a/configuration/scripts/machines/Macros.conda_macos b/configuration/scripts/machines/Macros.conda_macos index 6f26da0fc..f8b95aa76 100644 --- a/configuration/scripts/machines/Macros.conda_macos +++ b/configuration/scripts/machines/Macros.conda_macos @@ -47,7 +47,8 @@ SDKPATH = $(shell xcrun --show-sdk-path) ifeq ($(strip $(SDKPATH)),) CFLAGS_HOST := else - CFLAGS_HOST = -isysroot $(SDKPATH) + CFLAGS_HOST := -isysroot $(SDKPATH) + CFLAGS += -isysroot $(SDKPATH) LD += -L$(SDKPATH)/usr/lib endif From 0af031d785d3bc622cd19af48a2e9465b5abe9a0 Mon Sep 17 00:00:00 2001 From: Anton Steketee <79179784+anton-seaice@users.noreply.github.com> Date: Sat, 4 May 2024 04:20:56 +1000 Subject: [PATCH 67/76] Standalone gadi (#2) (#947) Add standalone build config for gadi supercomputer --------- Co-authored-by: Anton Steketee --- configuration/scripts/cice.batch.csh | 25 +++++++ configuration/scripts/cice.launch.csh | 12 +++ .../scripts/machines/Macros.gadi_intel | 73 +++++++++++++++++++ configuration/scripts/machines/env.gadi_intel | 56 ++++++++++++++ 4 files changed, 166 insertions(+) create mode 100644 configuration/scripts/machines/Macros.gadi_intel create mode 100644 configuration/scripts/machines/env.gadi_intel diff --git a/configuration/scripts/cice.batch.csh b/configuration/scripts/cice.batch.csh index 50ef665bd..520d165a3 100755 --- a/configuration/scripts/cice.batch.csh +++ b/configuration/scripts/cice.batch.csh @@ -48,6 +48,31 @@ cat >> ${jobfile} << EOFB ###PBS -m be EOFB +else if (${ICE_MACHINE} =~ gadi*) then +if (${queue} =~ *sr) then #sapphire rapids + @ memuse = ( $ncores * 481 / 100 ) +else if (${queue} =~ *bw) then #broadwell + @ memuse = ( $ncores * 457 / 100 ) +else if (${queue} =~ *sl) then + @ memuse = ( $ncores * 6 ) +else #normal queues + @ memuse = ( $ncores * 395 / 100 ) +endif +cat >> ${jobfile} << EOFB +#PBS -q ${queue} +#PBS -P ${ICE_MACHINE_PROJ} +#PBS -N ${ICE_CASENAME} +#PBS -l storage=gdata/${ICE_MACHINE_PROJ}+scratch/${ICE_MACHINE_PROJ}+gdata/ik11 +#PBS -l ncpus=${ncores} +#PBS -l mem=${memuse}gb +#PBS -l walltime=${batchtime} +#PBS -j oe +#PBS -W umask=003 +#PBS -o ${ICE_CASEDIR} +source /etc/profile.d/modules.csh +module use `echo ${MODULEPATH} | sed 's/:/ /g'` #copy the users modules +EOFB + else if (${ICE_MACHINE} =~ gust*) then cat >> ${jobfile} << EOFB #PBS -q ${queue} diff --git a/configuration/scripts/cice.launch.csh b/configuration/scripts/cice.launch.csh index 51c8f044f..f8eb0a5d2 100755 --- a/configuration/scripts/cice.launch.csh +++ b/configuration/scripts/cice.launch.csh @@ -46,6 +46,18 @@ mpiexec --cpu-bind depth -n ${ntasks} -ppn ${taskpernodelimit} -d ${nthrds} ./ci EOFR endif +#======= +else if (${ICE_MACHCOMP} =~ gadi*) then +if (${ICE_COMMDIR} =~ serial*) then +cat >> ${jobfile} << EOFR +./cice >&! \$ICE_RUNLOG_FILE +EOFR +else +cat >> ${jobfile} << EOFR +mpirun -n ${ntasks} ./cice >&! \$ICE_RUNLOG_FILE +EOFR +endif + #======= else if (${ICE_MACHCOMP} =~ hobart* || ${ICE_MACHCOMP} =~ izumi*) then if (${ICE_COMMDIR} =~ serial*) then diff --git a/configuration/scripts/machines/Macros.gadi_intel b/configuration/scripts/machines/Macros.gadi_intel new file mode 100644 index 000000000..df7746731 --- /dev/null +++ b/configuration/scripts/machines/Macros.gadi_intel @@ -0,0 +1,73 @@ +#============================================================================== +# Makefile macros for NCI Gadi, intel compiler +#============================================================================== + +CPP := fpp +CPPDEFS := -DFORTRANUNDERSCORE -DREPRODUCIBLE ${ICE_CPPDEFS} +CFLAGS := -c -O2 -fp-model precise -Wno-unused-variable -Wno-unused-parameter + +FIXEDFLAGS := -132 +FREEFLAGS := -FR + +NCI_INTEL_FLAGS := -r8 -i4 -traceback -w -fpe0 -ftz -convert big_endian -assume byterecl -check noarg_temp_created +NCI_REPRO_FLAGS := -fp-model precise -fp-model source -align all + +ifeq ($(ICE_BLDDEBUG), true) + NCI_DEBUG_FLAGS := -g3 -O0 -debug all -check all -no-vec -assume nobuffered_io + FFLAGS := $(NCI_INTEL_FLAGS) $(NCI_REPRO_FLAGS) $(NCI_DEBUG_FLAGS) + CPPDEFS := $(CPPDEFS) -DDEBUG=$(DEBUG) +else + NCI_OPTIM_FLAGS := -g3 -O2 -axCORE-AVX2 -debug all -check none -qopt-report=5 -qopt-report-annotate -assume buffered_io + FFLAGS := $(NCI_INTEL_FLAGS) $(NCI_REPRO_FLAGS) $(NCI_OPTIM_FLAGS) +endif + +SCC := icx +SFC := ifort +MPICC := mpicc +MPIFC := mpifort + +ifeq ($(ICE_COMMDIR), mpi) + FC := $(MPIFC) + CC := $(MPICC) +else + FC := $(SFC) + CC := $(SCC) +endif +LD:= $(FC) + +SLIBS := $(SLIBS) +INCLDIR := $(INCLDIR) + +# if spack modules loaded, use them. otherwise use system modules +ifndef SPACK_NETCDF_FORTRAN_ROOT + SLIBS += -L$(NETCDF)/lib -lnetcdf -lnetcdff + INCLDIR += -I$(NETCDF)/include +else + SLIBS += -L$(SPACK_NETCDF_C_ROOT)/lib64 -lnetcdf + SLIBS += -L$(SPACK_NETCDF_FORTRAN_ROOT)/lib -lnetcdff + INCLDIR += -I$(SPACK_NETCDF_C_ROOT)/include + INCLDIR += -I$(SPACK_NETCDF_FORTRAN_ROOT)/include +endif + +ifeq ($(ICE_THREADED), true) + LDFLAGS += -qopenmp + CFLAGS += -qopenmp + FFLAGS += -qopenmp +endif + +ifeq ($(ICE_IOTYPE), pio1) + LIB_PIO := $(PIO_LIBDIR) + SLIBS += -L$(LIB_PIO) -lpio +endif + +ifeq ($(ICE_IOTYPE), pio2) + ifndef SPACK_PARALLELIO_ROOT + SLIBS += -L$(PARALLELIO_ROOT)/lib -lpioc -lpiof + else + SLIBS += -L$(SPACK_PARALLELIO_ROOT)/lib -lpioc -lpiof + INCLDIR += -I $(SPACK_PARALLELIO_ROOT)/include + endif + + SLIBS += $(SLIBS) -L$(OMPI_BASE)/lib -lmpi_usempif08 -lmpi_usempi_ignore_tkr -lmpi_mpifh + +endif \ No newline at end of file diff --git a/configuration/scripts/machines/env.gadi_intel b/configuration/scripts/machines/env.gadi_intel new file mode 100644 index 000000000..9d056bc50 --- /dev/null +++ b/configuration/scripts/machines/env.gadi_intel @@ -0,0 +1,56 @@ +#!/bin/csh -f + +set inp = "undefined" +if ($#argv == 1) then + set inp = $1 +endif + +if ("$inp" != "-nomodules") then + + source /etc/profile.d/modules.csh + + module load intel-compiler + module load openmpi + + if ($?ICE_IOTYPE) then + if ($ICE_IOTYPE =~ pio*) then + if ($ICE_IOTYPE == "pio1") then + # we don't have pio1 installed anywhere + module load pnetcdf + module load netcdf + module load pio + else + module load parallelio + endif + else + module load netcdf + endif + endif + + if ($?ICE_BFBTYPE) then + if ($ICE_BFBTYPE =~ qcchk*) then + # conda/analysis has the required librarys, skip building from cice yaml file + module use /g/data/hh5/public/modules + module load conda/analysis + # conda env create -f ../../configuration/scripts/tests/qctest.yml + # conda activate qctest + endif + endif + +endif + +setenv ICE_MACHINE_MACHNAME gadi +setenv ICE_MACHINE_MACHINFO "Intel Xeon Scalable" +setenv ICE_MACHINE_ENVNAME intel +setenv ICE_MACHINE_ENVINFO "INTEL_COMPILER_VERSION $INTEL_COMPILER_VERSION, OMPI_VERSION $OMPI_VERSION" +setenv ICE_MACHINE_MAKE gmake +setenv ICE_MACHINE_WKDIR /scratch/$PROJECT/$USER/CICE_RUNS +setenv ICE_MACHINE_INPUTDATA /g/data/ik11/inputs +setenv ICE_MACHINE_BASELINE /scratch/$PROJECT/$USER/CICE_BASELINE +setenv ICE_MACHINE_SUBMIT "qsub" +setenv ICE_MACHINE_PROJ $PROJECT +setenv ICE_MACHINE_ACCT $USER +setenv ICE_MACHINE_QUEUE "normal" +setenv ICE_MACHINE_TPNODE 48 +setenv ICE_MACHINE_BLDTHRDS 4 +setenv ICE_MACHINE_QSTAT "qstat" From b2a9b0fe669b0f3b9bc51fabebd24001889a030a Mon Sep 17 00:00:00 2001 From: Anton Steketee <79179784+anton-seaice@users.noreply.github.com> Date: Sat, 11 May 2024 06:23:20 +1000 Subject: [PATCH 68/76] Autoset nprocs and improve max_blocks estimate (#949) This change allows nprocs to be set to -1 in 'ice_in' and then the number of processors will be automatically detected. This change improves the automatic calculation of max_blocks to give a better (but still not foolproof) estimate of max_blocks if it is not set in ice_in. --- .../cicedyn/infrastructure/ice_domain.F90 | 48 +++++++++++-------- cicecore/shared/ice_distribution.F90 | 3 +- configuration/scripts/ice_in | 2 +- doc/source/user_guide/ug_case_settings.rst | 3 +- 4 files changed, 32 insertions(+), 24 deletions(-) diff --git a/cicecore/cicedyn/infrastructure/ice_domain.F90 b/cicecore/cicedyn/infrastructure/ice_domain.F90 index 8b680f2d4..df112eb50 100644 --- a/cicecore/cicedyn/infrastructure/ice_domain.F90 +++ b/cicecore/cicedyn/infrastructure/ice_domain.F90 @@ -101,7 +101,7 @@ subroutine init_domain_blocks ! This routine reads in domain information and calls the routine ! to set up the block decomposition. - use ice_distribution, only: processor_shape + use ice_distribution, only: processor_shape, proc_decomposition use ice_domain_size, only: ncat, nilyr, nslyr, max_blocks, & nx_global, ny_global, block_size_x, block_size_y use ice_fileunits, only: goto_nml @@ -112,7 +112,8 @@ subroutine init_domain_blocks !---------------------------------------------------------------------- integer (int_kind) :: & - nml_error ! namelist read error flag + nml_error, & ! namelist read error flag + nprocs_x, nprocs_y ! procs decomposed into blocks character(len=char_len) :: nml_name ! text namelist name character(len=char_len_long) :: tmpstr2 ! for namelist check @@ -216,21 +217,36 @@ subroutine init_domain_blocks call broadcast_scalar(maskhalo_bound, master_task) call broadcast_scalar(add_mpi_barriers, master_task) call broadcast_scalar(debug_blocks, master_task) - if (my_task == master_task) then - if (max_blocks < 1) then - max_blocks=( ((nx_global-1)/block_size_x + 1) * & - ((ny_global-1)/block_size_y + 1) - 1) / nprocs + 1 - max_blocks=max(1,max_blocks) - write(nu_diag,'(/,a52,i6,/)') & - '(ice_domain): max_block < 1: max_block estimated to ',max_blocks - endif - endif call broadcast_scalar(max_blocks, master_task) call broadcast_scalar(block_size_x, master_task) call broadcast_scalar(block_size_y, master_task) call broadcast_scalar(nx_global, master_task) call broadcast_scalar(ny_global, master_task) + ! Set nprocs if not set in namelist +#ifdef CESMCOUPLED + nprocs = get_num_procs() +#else + if (nprocs < 0) then + nprocs = get_num_procs() + else if (nprocs /= get_num_procs()) then + write(nu_diag,*) subname,' ERROR: nprocs, get_num_procs = ',nprocs,get_num_procs() + call abort_ice(subname//' ERROR: Input nprocs not same as system (e.g MPI) request', file=__FILE__, line=__LINE__) + endif +#endif + + ! Determine max_blocks if not set + if (max_blocks < 1) then + call proc_decomposition(nprocs, nprocs_x, nprocs_y) + max_blocks=((nx_global-1)/block_size_x/nprocs_x+1) * & + ((ny_global-1)/block_size_y/nprocs_y+1) + max_blocks=max(1,max_blocks) + if (my_task == master_task) then + write(nu_diag,'(/,a52,i6,/)') & + '(ice_domain): max_block < 1: max_block estimated to ',max_blocks + endif + endif + !---------------------------------------------------------------------- ! ! perform some basic checks on domain @@ -242,16 +258,6 @@ subroutine init_domain_blocks !*** domain size zero or negative !*** 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 - !*** -#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', file=__FILE__, line=__LINE__) -#endif else if (nghost < 1) then !*** !*** must have at least 1 layer of ghost cells diff --git a/cicecore/shared/ice_distribution.F90 b/cicecore/shared/ice_distribution.F90 index 0f3f6c198..6e06069ab 100644 --- a/cicecore/shared/ice_distribution.F90 +++ b/cicecore/shared/ice_distribution.F90 @@ -41,7 +41,8 @@ module ice_distribution ice_distributionGet, & ice_distributionGetBlockLoc, & ice_distributionGetBlockID, & - create_local_block_ids + create_local_block_ids, & + proc_decomposition character (char_len), public :: & processor_shape ! 'square-pop' (approx) POP default config diff --git a/configuration/scripts/ice_in b/configuration/scripts/ice_in index 63a97d7d8..ad29e05ce 100644 --- a/configuration/scripts/ice_in +++ b/configuration/scripts/ice_in @@ -302,7 +302,7 @@ / &domain_nml - nprocs = 4 + nprocs = -1 nx_global = 100 ny_global = 116 block_size_x = 25 diff --git a/doc/source/user_guide/ug_case_settings.rst b/doc/source/user_guide/ug_case_settings.rst index 9f1f8a259..6deab8c11 100644 --- a/doc/source/user_guide/ug_case_settings.rst +++ b/doc/source/user_guide/ug_case_settings.rst @@ -369,7 +369,8 @@ domain_nml "``maskhalo_remap``", "logical", "mask unused halo cells for transport", "``.false.``" "``maskhalo_bound``", "logical", "mask unused halo cells for boundary updates", "``.false.``" "``max_blocks``", "integer", "maximum number of blocks per MPI task for memory allocation", "-1" - "``nprocs``", "integer", "number of processors to use", "-1" + "``nprocs``", "integer", "number of MPI tasks to use", "-1" + "", "``-1``", "find number of MPI tasks automatically", "" "``ns_boundary_type``", "``cyclic``", "periodic boundary conditions in y-direction", "``open``" "", "``open``", "Dirichlet boundary conditions in y", "" "", "``tripole``", "U-fold tripole boundary conditions in y", "" From 53cdc70deb291d93fc8b031d07310047cba9dbb5 Mon Sep 17 00:00:00 2001 From: Tony Craig Date: Tue, 14 May 2024 16:21:46 -0700 Subject: [PATCH 69/76] Update the calculation of uvel and vvel in evp dynamics (#953) Update the calculation of uvel and vvel in subroutine evp in file ice_dyn_evp.F90. Do an unmasked grid_average_X2Y when averaging from uvelE to uvel and from vvelN to vvel instead of a masked average. The masking is handled separately. This change is bit-for-bit and saves a few flops. Closes #952. Update the documentation to add the hemispheric sign dependence in the water stress terms in the dynamics equations. Closes #951. --- cicecore/cicedyn/dynamics/ice_dyn_evp.F90 | 12 +++---- doc/source/science_guide/sg_coupling.rst | 3 +- doc/source/science_guide/sg_dynamics.rst | 40 ++++++++++++----------- 3 files changed, 28 insertions(+), 27 deletions(-) diff --git a/cicecore/cicedyn/dynamics/ice_dyn_evp.F90 b/cicecore/cicedyn/dynamics/ice_dyn_evp.F90 index 301a89916..68101f579 100644 --- a/cicecore/cicedyn/dynamics/ice_dyn_evp.F90 +++ b/cicecore/cicedyn/dynamics/ice_dyn_evp.F90 @@ -718,8 +718,8 @@ subroutine evp (dt) field_loc_Eface, field_type_vector) call ice_timer_stop(timer_bound) - call grid_average_X2Y('S', uvelE, 'E', uvel, 'U') - call grid_average_X2Y('S', vvelN, 'N', vvel, 'U') + call grid_average_X2Y('A', uvelE, 'E', uvel, 'U') + call grid_average_X2Y('A', vvelN, 'N', vvel, 'U') uvel(:,:,:) = uvel(:,:,:)*uvm(:,:,:) vvel(:,:,:) = vvel(:,:,:)*uvm(:,:,:) endif @@ -1084,8 +1084,8 @@ subroutine evp (dt) field_loc_Eface, field_type_vector, & vvelE) - call grid_average_X2Y('S', uvelE, 'E', uvel, 'U') - call grid_average_X2Y('S', vvelN, 'N', vvel, 'U') + call grid_average_X2Y('A', uvelE, 'E', uvel, 'U') + call grid_average_X2Y('A', vvelN, 'N', vvel, 'U') uvel(:,:,:) = uvel(:,:,:)*uvm(:,:,:) vvel(:,:,:) = vvel(:,:,:)*uvm(:,:,:) @@ -1275,8 +1275,8 @@ subroutine evp (dt) field_loc_Nface, field_type_vector, & uvelN, vvelN) - call grid_average_X2Y('S', uvelE, 'E', uvel, 'U') - call grid_average_X2Y('S', vvelN, 'N', vvel, 'U') + call grid_average_X2Y('A', uvelE, 'E', uvel, 'U') + call grid_average_X2Y('A', vvelN, 'N', vvel, 'U') uvel(:,:,:) = uvel(:,:,:)*uvm(:,:,:) vvel(:,:,:) = vvel(:,:,:)*uvm(:,:,:) diff --git a/doc/source/science_guide/sg_coupling.rst b/doc/source/science_guide/sg_coupling.rst index 666c13ed4..4e8168530 100644 --- a/doc/source/science_guide/sg_coupling.rst +++ b/doc/source/science_guide/sg_coupling.rst @@ -132,8 +132,7 @@ coefficient, :math:`\rho_w` is the density of seawater, and necessary if the top ocean model layers are not able to resolve the Ekman spiral in the boundary layer. If the top layer is sufficiently thin compared to the typical depth of the Ekman spiral, then -:math:`\theta=0` is a good approximation. Here we assume that the top -layer is thin enough. +:math:`\theta=0` is a good approximation. Please see the `Icepack documentation `_ for additional information about atmospheric and oceanic forcing and other data exchanged between the diff --git a/doc/source/science_guide/sg_dynamics.rst b/doc/source/science_guide/sg_dynamics.rst index 1ddf94472..978da7fcb 100644 --- a/doc/source/science_guide/sg_dynamics.rst +++ b/doc/source/science_guide/sg_dynamics.rst @@ -35,11 +35,11 @@ For clarity, the two components of Equation :eq:`vpmom` are \begin{aligned} m{\partial u\over\partial t} &= {\partial\sigma_{1j}\over\partial x_j} + \tau_{ax} + a_i c_w \rho_w - \left|{\bf U}_w - {\bf u}\right| \left[\left(U_w-u\right)\cos\theta - \left(V_w-v\right)\sin\theta\right] + \left|{\bf U}_w - {\bf u}\right| \left[\left(U_w-u\right)\cos\theta \mp \left(V_w-v\right)\sin\theta\right] -C_bu +mfv - mg{\partial H_\circ\over\partial x}, \\ m{\partial v\over\partial t} &= {\partial\sigma_{2j}\over\partial x_j} + \tau_{ay} + a_i c_w \rho_w - \left|{\bf U}_w - {\bf u}\right| \left[\left(U_w-u\right)\sin\theta + \left(V_w-v\right)\cos\theta\right] + \left|{\bf U}_w - {\bf u}\right| \left[ \pm \left(U_w-u\right)\sin\theta + \left(V_w-v\right)\cos\theta\right] -C_bv-mfu - mg{\partial H_\circ\over\partial y}. \end{aligned} :label: momsys @@ -121,18 +121,18 @@ variables used in the code. .. math:: \underbrace{\left({m\over\Delta t_e}+{\tt vrel} \cos\theta\ + C_b \right)}_{\tt cca} u^{k+1} - - \underbrace{\left(mf+{\tt vrel}\sin\theta\right)}_{\tt ccb}v^{l} + - \underbrace{\left(mf \pm {\tt vrel}\sin\theta\right)}_{\tt ccb}v^{l} = &\underbrace{{\partial\sigma_{1j}^{k+1}\over\partial x_j}}_{\tt strintx} + \underbrace{\tau_{ax} - mg{\partial H_\circ\over\partial x} }_{\tt forcex} \\ - &+ {\tt vrel}\underbrace{\left(U_w\cos\theta-V_w\sin\theta\right)}_{\tt waterx} + {m\over\Delta t_e}u^k, + &+ {\tt vrel}\underbrace{\left(U_w\cos\theta \mp V_w\sin\theta\right)}_{\tt waterx} + {m\over\Delta t_e}u^k, :label: umom .. math:: - \underbrace{\left(mf+{\tt vrel}\sin\theta\right)}_{\tt ccb} u^{l} + \underbrace{\left(mf \pm {\tt vrel}\sin\theta\right)}_{\tt ccb} u^{l} + \underbrace{\left({m\over\Delta t_e}+{\tt vrel} \cos\theta + C_b \right)}_{\tt cca}v^{k+1} = &\underbrace{{\partial\sigma_{2j}^{k+1}\over\partial x_j}}_{\tt strinty} + \underbrace{\tau_{ay} - mg{\partial H_\circ\over\partial y} }_{\tt forcey} \\ - &+ {\tt vrel}\underbrace{\left(U_w\sin\theta+V_w\cos\theta\right)}_{\tt watery} + {m\over\Delta t_e}v^k, + &+ {\tt vrel}\underbrace{\left( \pm U_w\sin\theta+V_w\cos\theta\right)}_{\tt watery} + {m\over\Delta t_e}v^k, :label: vmom where :math:`{\tt vrel}\ \cdot\ {\tt waterx(y)}= {\tt taux(y)}` and the definitions of :math:`u^{l}` and :math:`v^{l}` vary depending on the grid. @@ -140,19 +140,19 @@ where :math:`{\tt vrel}\ \cdot\ {\tt waterx(y)}= {\tt taux(y)}` and the definiti As :math:`u` and :math:`v` are collocated on the B grid, :math:`u^{l}` and :math:`v^{l}` are respectively :math:`u^{k+1}` and :math:`v^{k+1}` such that this system of equations can be solved as follows. Define .. math:: - \hat{u} = F_u + \tau_{ax} - mg{\partial H_\circ\over\partial x} + {\tt vrel} \left(U_w\cos\theta - V_w\sin\theta\right) + {m\over\Delta t_e}u^k + \hat{u} = F_u + \tau_{ax} - mg{\partial H_\circ\over\partial x} + {\tt vrel} \left(U_w\cos\theta \mp V_w\sin\theta\right) + {m\over\Delta t_e}u^k :label: cevpuhat .. math:: - \hat{v} = F_v + \tau_{ay} - mg{\partial H_\circ\over\partial y} + {\tt vrel} \left(U_w\sin\theta + V_w\cos\theta\right) + {m\over\Delta t_e}v^k, + \hat{v} = F_v + \tau_{ay} - mg{\partial H_\circ\over\partial y} + {\tt vrel} \left(\pm U_w\sin\theta + V_w\cos\theta\right) + {m\over\Delta t_e}v^k, :label: cevpvhat where :math:`{\bf F} = \nabla\cdot\sigma^{k+1}`. Then .. math:: \begin{aligned} - \left({m\over\Delta t_e} +{\tt vrel}\cos\theta\ + C_b \right)u^{k+1} - \left(mf + {\tt vrel}\sin\theta\right) v^{k+1} &= \hat{u} \\ - \left(mf + {\tt vrel}\sin\theta\right) u^{k+1} + \left({m\over\Delta t_e} +{\tt vrel}\cos\theta + C_b \right)v^{k+1} &= \hat{v}.\end{aligned} + \left({m\over\Delta t_e} +{\tt vrel}\cos\theta\ + C_b \right)u^{k+1} - \left(mf \pm {\tt vrel}\sin\theta\right) v^{k+1} &= \hat{u} \\ + \left(mf \pm {\tt vrel}\sin\theta\right) u^{k+1} + \left({m\over\Delta t_e} +{\tt vrel}\cos\theta + C_b \right)v^{k+1} &= \hat{v}.\end{aligned} Solving simultaneously for :math:`u^{k+1}` and :math:`v^{k+1}`, @@ -168,7 +168,7 @@ where :label: cevpa .. math:: - b = mf + {\tt vrel}\sin\theta. + b = mf \pm {\tt vrel}\sin\theta. :label: cevpb Note that the time discretization and solution method for the EAP is exactly the same as for the B grid EVP. More details on the EAP model are given in Section :ref:`stress-eap`. @@ -191,20 +191,20 @@ implicit solvers and there is an additional term for the pseudo-time iteration. .. math:: {\beta^*(u^{k+1}-u^k)\over\Delta t_e} + {m(u^{k+1}-u^n)\over\Delta t} + {\left({\tt vrel} \cos\theta + C_b \right)} u^{k+1} - - & {\left(mf+{\tt vrel}\sin\theta\right)} v^{l} + - & {\left(mf \pm {\tt vrel}\sin\theta\right)} v^{l} = {{\partial\sigma_{1j}^{k+1}\over\partial x_j}} + {\tau_{ax}} \\ & - {mg{\partial H_\circ\over\partial x} } - + {\tt vrel} {\left(U_w\cos\theta-V_w\sin\theta\right)}, + + {\tt vrel} {\left(U_w\cos\theta \mp V_w\sin\theta\right)}, :label: umomr .. math:: {\beta^*(v^{k+1}-v^k)\over\Delta t_e} + {m(v^{k+1}-v^n)\over\Delta t} + {\left({\tt vrel} \cos\theta + C_b \right)}v^{k+1} - + & {\left(mf+{\tt vrel}\sin\theta\right)} u^{l} + + & {\left(mf \pm {\tt vrel}\sin\theta\right)} u^{l} = {{\partial\sigma_{2j}^{k+1}\over\partial x_j}} + {\tau_{ay}} \\ & - {mg{\partial H_\circ\over\partial y} } - + {\tt vrel}{\left(U_w\sin\theta+V_w\cos\theta\right)}, + + {\tt vrel}{\left( \pm U_w\sin\theta+V_w\cos\theta\right)}, :label: vmomr where :math:`\beta^*` is a numerical parameter and :math:`u^n, v^n` are the components of the previous time level solution. @@ -212,18 +212,18 @@ With :math:`\beta=\beta^* \Delta t \left( m \Delta t_e \right)^{-1}` :cite:`Bou .. math:: \underbrace{\left((\beta+1){m\over\Delta t}+{\tt vrel} \cos\theta\ + C_b \right)}_{\tt cca} u^{k+1} - - \underbrace{\left(mf+{\tt vrel} \sin\theta\right)}_{\tt ccb} & v^{l} + - \underbrace{\left(mf \pm {\tt vrel} \sin\theta\right)}_{\tt ccb} & v^{l} = \underbrace{{\partial\sigma_{1j}^{k+1}\over\partial x_j}}_{\tt strintx} + \underbrace{\tau_{ax} - mg{\partial H_\circ\over\partial x} }_{\tt forcex} \\ - & + {\tt vrel}\underbrace{\left(U_w\cos\theta-V_w\sin\theta\right)}_{\tt waterx} + {m\over\Delta t}(\beta u^k + u^n), + & + {\tt vrel}\underbrace{\left(U_w\cos\theta \mp V_w\sin\theta\right)}_{\tt waterx} + {m\over\Delta t}(\beta u^k + u^n), :label: umomr2 .. math:: - \underbrace{\left(mf+{\tt vrel}\sin\theta\right)}_{\tt ccb} u^{l} + \underbrace{\left(mf \pm {\tt vrel}\sin\theta\right)}_{\tt ccb} u^{l} + \underbrace{\left((\beta+1){m\over\Delta t}+{\tt vrel} \cos\theta + C_b \right)}_{\tt cca} & v^{k+1} = \underbrace{{\partial\sigma_{2j}^{k+1}\over\partial x_j}}_{\tt strinty} + \underbrace{\tau_{ay} - mg{\partial H_\circ\over\partial y} }_{\tt forcey} \\ - & + {\tt vrel}\underbrace{\left(U_w\sin\theta+V_w\cos\theta\right)}_{\tt watery} + {m\over\Delta t}(\beta v^k + v^n), + & + {\tt vrel}\underbrace{\left( \pm U_w\sin\theta+V_w\cos\theta\right)}_{\tt watery} + {m\over\Delta t}(\beta v^k + v^n), :label: vmomr2 At this point, the solutions :math:`u^{k+1}` and :math:`v^{k+1}` for the B or the C grids are obtained in the same manner as for the standard EVP approach (see Section :ref:`evp-momentum` for details). @@ -292,6 +292,8 @@ Ice-Ocean stress At the end of each (thermodynamic) time step, the ice–ocean stress must be constructed from :math:`{\tt taux(y)}` and the terms containing :math:`{\tt vrel}` on the left hand side of the equations. +The water stress calculation has a hemispheric dependence on the sign of the +:math:`\pm {\tt vrel}\sin\theta` term. The Hibler-Bryan form for the ice-ocean stress :cite:`Hibler87` is included in **ice\_dyn\_shared.F90** but is currently commented out, From 53d595b11eb4a376bb631f52968e13c3e40384fe Mon Sep 17 00:00:00 2001 From: Tony Craig Date: Tue, 14 May 2024 16:22:25 -0700 Subject: [PATCH 70/76] Update Icepack to #ae69b806990 (May 14, 2024) (#955) Update version number to 6.5.1 in preparation for release Update copyright date and LICENSE.pdf --- LICENSE.pdf | Bin 55036 -> 55309 bytes cicecore/cicedyn/dynamics/ice_dyn_core1d.F90 | 2 +- cicecore/drivers/direct/hadgem3/CICE.F90 | 4 ++-- cicecore/drivers/mct/cesm1/CICE_copyright.txt | 4 ++-- .../drivers/nuopc/cmeps/CICE_copyright.txt | 4 ++-- cicecore/drivers/nuopc/dmi/CICE.F90 | 4 ++-- cicecore/drivers/standalone/cice/CICE.F90 | 4 ++-- cicecore/drivers/unittest/opticep/CICE.F90 | 4 ++-- cicecore/version.txt | 2 +- doc/source/conf.py | 6 +++--- doc/source/intro/copyright.rst | 2 +- icepack | 2 +- 12 files changed, 19 insertions(+), 19 deletions(-) diff --git a/LICENSE.pdf b/LICENSE.pdf index 80ae31d5183808e151adbeca14f21d7b66e4761a..18e26a09961123cc71743b11a8c7c894bf3eaf13 100644 GIT binary patch delta 40337 zcmZU41B@nJ6y>yS+s3p#ZQHhO>ucNnx4*V++qP}Hr_G(+Y&M(Sq>`6Y=brPbZoRxz zZr%E<28*o&OArKQ;YbvA0O6=_U%p_E6Fdr`9iIepgD4P{fuA%^H_aw9Yipc`Vio}Q);bz%HR1kr?(#|Wu*we5MLAl2 zmSNeN)xI>T!Vb?a*MPZ*s1;@!3razFg#=st0@*qo`N=In{WR*vPB+as z&zfjSe#DItt8K#(bM?LH3fMRj&W=N}&N!?Y;Nck$nlBlX?^N;pHc0Rn?zn^w zT(57x1}4-PT^a)vUes9?i@R-SxXbII;|1TThWFBSxfhAqZ*U9Z-NFD1UP3LHkR5H0 z`M$YRVmaMbZr+`T9sCf`88NK~3LC{%^sRN;W~f`YCtbgMTkfvK26A_xmnoN2!R#O& zk|Lx0jf>CBY8VWobshb+u0f62KBpPPD6ZgZGjW`b;C1nb-rrsS$COh)Selg5nA(X4 zi`EVszVQSY-ynm_I zgBmF%XCSYRxPH&<@+^tfL}$s_Ddb?O%(P#6n+#Ooy9!6yB#5X@Lvts%)z`TF!9vnA=x^Rx7QYWH7H zJpz6SH9&F{f(QQYA({uvzIsE^`!$+dVvy9g=S=!v?n~_qNcu1v&&z*LSg<5i?f@&F z7avN;G{QiDuEKU{fmC4YE7D*-z73m z50Y@~P6>^NN;pn?nk*nW8^Qk;>G9*HM36hM9~k@}`4|X$ ze4RQ@!6~_gP(^H7)yOrwBs@Dy5?5=#Bv^nq0fX!LCUt3}2-yuYGd9U&|6Cq%Q^P4x z7j;xr?pWVYEP>`CYHS`;uYK68kE}m~E_@zP(XK08P=ey*BIF+5DjDVJpSAe6T+kpW-#(+#201!+P^u!V4o9n zF;F$}v8DT1igjFD|LUXfv;F$+or`<3rC9K61xw`b_)0Gir{@5AQveV8k!XbX%keXS z&CHm)Z^SeID1!Q>mG-O#M1(s*yv3gf4>;>SF1Rd1 zM(xBU$lsI*_IP^AzGx(f9J!U-w{CBSIq+Q`c{pb&!qHLS1{}^sCu!G`x99RSj>@vI zVPlDiGGyFL;)T;?Y$D5G(Qi7GXwxGAOG&Nttm>0{ChX42KO7=BTK%+-G2^z9)nh$` zYPFZqui099gYl|}=4>@ua(T-M6m{mN0-TR4uCXA{Zpt$GDWL4CTr`pTl0HaGA&E$` zif%BL7EhCF*~27On8a3nSQ?ESQSr#7HuidA0*XB%RdVcX(lJ-jbQI=t+Y%Un%e}oJ zl97$Gqph5*B|m%jfj!wk((!eKna>4>Sg-t{$Iv%>tjA=tlNH*jGE*Lc@<;Eb^gXYIskWGgb?6Rl1v3tbuH`qBb1?qnr z$ToYB`0PY%DZX|AMKZv#NJ13=YdqqtMGYe)9QUOO!(T1MT~TTO}3j+mlCI_Nt&X$^mbo4sp!29(ps~0 zWaU(3$rzTUBCFukY`_oTDP=z(se0|G(s5LV6lYz33!A|p#%!?B8N2iN{sk#a;%wX3 zA}4bRLW{##{pbiqvU!Ea+-OhBMr!dOCFhG=*Y-Apz^EVxWhJPg$wI3*t{gbaU5%s; zE2I&B50mV69Sn4svsbqv#* zs#muUdx9ea9%bVAFpoJpSz{i9t>~^StU8i4C-4AwuEVYR=#6`bVr7=Mvj3@TbYIs!KN1Na+$RoL;&z;7gOb0d|xYxccARxLf2TO61hi+R8= zX{)@|1qjgZ6*2(!)O-T9uNezN1YOCGLlJ&TwKdMY{9aON~pC;DqSgv@X+Qy;pK70v`me} z!Rh+MVmSc#OPS*|S&yc02wsUIkHv5ktOmpuuwTX4UQXigG1ukJl82o^G>_$y5N`eH94cuG>Q*N&MG-S0uPe4JEKt`9)*ebhMZCV#ljH{(*HKwwuGrhCX>4{ zFf_MtKupwO80!npHMTr;0S!2%TrzZb73ULg6jE~q2HA-)yg`)zdE&IPkC=UT6fyBY z>qaaFP*aifH(3Tgjtq=6qBvd7kV)U!^iCeMsX;%ncj%m8{Dxgxn|UQsIt5>4=9(!` z7?9IWAU$a2FZVMKEppuyYRfyX8m|lP1`Kz;EoD8xRwV7jaSwaD(+*a#WW|nLTZ%`x z&)WqK$9Nt=uPhOjKTFrbvd8ez&oDXMFvRr$jx8f%ad2?I-<=6G+*T<}NF+qpx=c;J zkF5}=V|azl9kb^>oq;KRQBBF6Ug~-i=I9pO#eX-lET0(hr$Gaht9Kl+Xjz*wL9D?8v9aDfyKFhb1KWs2B6hCuTb-U`m{YB70_qI5Z=*|B zLg<33PDc;zr^0L((T|Y42&O~D-j8s{Nf7xwDyX=el9%n}+Ch2t*{3TwZFZL||X zcD0_$tu5)t(1&yF)Vm)=r7BuCVE9noQ@D2tXy9lZB`x`Qe{15S_tepjyo zkK7YeOD&BNgb$VTZMkjcZa);RXIDDffw84?G6a}h-)E)?w)ae`g=u;MnrfsDa$;^D zDX)&A6F3%y-G2jJ7s6k&(E(imN+yMAh^BJ1BbzaHaygGBNKAU?r^iqb%BYLaQr8$2#_Cuj_&4#u(C?T#g-xo9^?GS8t zeC>vg1csRf>qxe665L>3I^ylzYtrK?vG=MGp76#+A42-yDXAV2-C)V(`rfD%47N zNxn=C0;B4>FO;waYheKKEzRf(Jx1Dy)j2f=|GW8aGjNR&v$m4&W>Okc{^pxLtwKjQ z)qNwruNBbL|E8U*q2GEB1B%zNlbGmEEZ{Vs_3PjvniSwPD}?T~QIk4if6d$AW~k%_ zZDHcB`G!#RqqRwCE^xZ`FBRCHF{MSZac=HcZW!ft{sw^qldT4{prbW-oN9Uby}B)h zaG@#0n5wfUj>JSX5g>c>7@y08)*|L)Qeb8<^2iyd*%%Ks?4oFUE&7o8nakMT|5_8k zK;mVxy49TBYs>u3+`0OSo=W21JZC@lR|d$u3H7`8$*sFY>v+35aj2@$(%HNWUWIg0#h}FvzmM&8RpzYS zWo48VIBa)aTO`=g*Ky&JbX~Mtpw`Xm)dUfTz~E#N-4p=RB5`O0#&NWHTiov0N6P11?JLX+#QP~>4s7zn>hJE&k*%= zcc&~J)d!%8^A(V}rMR>rTqGOO3y65zPG5>~0ax3vw^(3XE*61026aNvO%e*jI}8O& z&c>t=yhX^yxJYZcfgwgqDy~lHxiKsz5MQ*4G>#3zq>))(;pKx{d`tUA`UYvkcTR?O z2mfe!3Nwb7h`m!G=2&@|)c8+d07^3^M{t|T_pS&Yw7WPwQg01JXvQlJeDEW|WnlaaqEMWFh@7&aCWcy5x*y}k*K zbJSoDhX>ohUX#*Bgu~sdXZ>-L4yl0%M3(~WATRJz-$-7F+33qCQhPUM+Gj}jxDJU= zMF6nmr|!$&n_fLAH&-hnRCAwMuEzv%eM<{iCPL{n|cgxcY)*{2eX*31;`j+Rs z8|Jv}-;^LmxkRp#xO9-Eo>?I-N4O1J97thM`2KR-h}*j7M0yN)dEn!n(XXOMU_Y!e zv=&nrr;P~C$0%t&NLo5Ue7_r7_6!X_X#;{ryzC)uX%7h2l@!>1xJ#YtC^-=2pu6fhp- z-X6PG?X02n}{m#CQ zi3I>ojXMP+E#YW{R&!zO=)hcldb>mxlP z@onIs#3E@{dyC&b{Zu$Ux1XeHJ7pRjWUyaB)~Q=TpcUNLef#NW2OuAJoDj3dE&!24 zNZ@*&^qmfJxuWKggGb}t^*!6u@0t6X#@m#b3e6)P={WQF`=xj1YqWRkXBI>D@%k2z z8kRDS@dtA0kdWp=|Ol{e^4H(2UFWLuDjnyU=PLr6H3Y{bzVz%prm0M1G=s zFn=iuTYqtfq-}Pf7-Cy`;=1cU;L9umDfDb^NXe}J`;U0lJRk&X9q&zC&n}>ETUybJ zXdLs<8Sy$P$)EPnyT9ClmM-}uY4b0U;q4NlKwlFUVUw`8 z*r~iBBdnRdX(KzfD2O=hZ*?m(4>M;)XESp%XES>fGZ$h$zTc`|j%LLFKLz_+)XK%t z*2qiL!9>-{)z*yI)!EIApFi0PhY*5=g_#338Ki^|z|PFV!Ou_Z;_7T>WC!aByz2Ha zR8`v$_y)S%KDt{_E+&^}$Rq!uAgLHw9gGqMi8W7&ZFgGn|3YscOGo!8g_1e}GNYAA(Q8^Ol_EM}}IWSP4+7`8soAr~Xk1Jm>{E&>P8AVr}SV>;{M?kE;p7T|Lz z0#llHM38cE9x{e1a(!>*jPIk=>C%T#Se|3?K}o+-kt_zW!no~$ispwqL>h4fz_+Q- zf`^VQkzTeN-j8!aq^})L7$mL{KWtFbG88TkjWN`0Af<|6YI3v-6&td74xGRd#kKUW za_(2>$7>iMac+I}PUR)pVoM;=+J86T#r=V^BkG&nm-I%Zsl?%!UM=SWb(y!+Ay%eS ziqn9I$r2$K7b!hXhEs-9XGC)cFhR;uYuEV2JUToh&{4Ua>w|cT{%#B6Qn!D_+seU5 zce^t78^S;$Iy!B5>K@`Aq8KT)x}1ySao&hXgHx3gK9~O>BQgAVzZqbKj2kkNF+rR3 zHH$>X*5~$fLvns=gxZm$;uIjm^6g-W!K4%?;(@M*(h*4tT#)xS^5yOT{H?P^-Ddcy zK^o2#QkD%Q?r_3JjLa3vZ-WNKCLBCi189}#BL9U|<<@+jEuYomPlbDMR;k+|J?sBW z#9qyBEVGA1dZ%<<`H@Z-m}XKBS^9kzKTyw+CqVcC4A@6GgXg*tJ<*!NCd{t_Wes~e z!>!*@$nau;=4QhC+sKp+XlPigB~gj5X2z&NU(!b5MrI5_VlfJ;ygZjp4?_7)fPpK^ zj+E8pD~thk`;!hs#~cz3_4H|+4i@bwHY4OGK!j=B1@^BXL-&Y3l^b-voelswVR|kT z^cry@a5ZF<(SnXP!l_B&R`e6M`IhzhX4N*`=Vn4m?E{VRFnRj{RM`pCw74+2VV*D! zeTFh&`Ov(UzW=y6#2Zzi>)-{o5>3vGqJ9H#8i_8LS7MFA2-0&1WnfO0j0NC4v#<R@q2NgEJ!Xf_xM%98hOww99z)F zY?2e#OZK^F(v>v=aIypP1q>|_Vr2Xx*hfh(`q^H|(&vwhaQmVeIa9z8%2}|3?fFvw z5Pe0a?*yG!V~^lsvldQD*$v`uvapw!#GY#&B59iN$cpy@AhsWu+$^4$iEO6Ab>TS; ztC`P6Od|g>^W%JBx-K%y4e+0s5dEzm>DDwscxEP$cIrYXXT%P*hwr#A_rI!yvw0pw zf7F@F4f}R=g~g7tQ!}czuF4ktw^2gzgK@9fBetyeO|ltgK+>}kP5x(;!QM6HO3z9# zIW@Y>g)XB3*nh2HrU*3CVRplPUz|r7leSB~q*O?<5s#CEudTu5Xlf|vs&bX&Q&-kS zXP_U8KMHjb=?~aFogRN~(~}SXGil8%Ls=+PyJ)>cTP%!D9au0jSLP02sr^H95;_t? zV}7p)Md=DmoXdGMStx6qB>%eZO8>b^Vo3#lC{P>&T&3PrrAXh<5~vv;IKw{2SMh|u z{aLQNFyVK%kgcDn;_vRb`MOfW5wH=#>w?Mv`rvKi)wMJ5*!h+D z$F;OUw^+JiFBwsvL%Z3N#3hD6l@-=|!_l^bK&7~b#uGkk*^ws`#<9Yt}+%BIH{J#lsA4qQnBZE%zf^_Z7MO{ z?2rR{>E}+}CwW!C_Us>De4c5C)Asn^CJ$fUysN zHsbPfhuf42WYuqphZ*_vu_Efh1&_WUSs8g6+>=~*s=|3wBN7#4 zwLjA6qg+X&bWzc%&x@vIDi4L>i%`>CtpwG}%)n2+W@!z%V&`p9TNCuV6gnQ3U4M=rG7UG5 z*{a$Bg|CU7pnx!tGxVMJOLdZdp}@i}(uiX9XZ?$oot8;~|== zVLtXd)Y}7=L0HDY!sJ8h{-xA?`%EgXqa1_Cn7>?nxkRy*LR3AsRgAKdO5SEYQi9^= zLW;rfzq$A4junRX^wkEmYS|1xsdDNBs@Bjf>71ye+M^Qt@7r}6u*W;yM5?>jDt}Nu zIX{-zzAFDr`DFPLC0VpZD;5P4ER(2rDF%y+Uj~}h!&Bm7a9Fc+{I2T**PiY{OH^lw z1-xurjBdJ4C?Sx)Wf7pKNd5Q@e+@WNRgG?cQ{#Zn4%%=15Q%RV1UnsZ z)`Q(epl9{th0|XhEerdE&>fMw;#&kceG$Pdwb=Schk~xz3fN6Y3GSGT(W>OHhm^IO zlD~g-j)AhE*hP6`i$qJJ`{*Zc#GZD2E?t&?Vf*~zr)n=}V1g7e*n?pLrQ7E;6pDUY zUUI^>V%(sPPdGke0?#7=*rQJl?<|RVLT(`5CQ!m>gH57;uy4*^yd&_5;+uM02wuo| zij!MfRfkj>vB$L`xi6yT>(_(W)$?HorW!z<=!4v%(czGel}lDIx*?VDgYGU+`$;M8 za}`*=O$B7_3jt$2_KAHZT#JJE1UdG&k)yyM6$Av|SZ z7L$RgOQusgV0iUE)phY~iRukmd{nloLr^x#S~NNrGEGOY`4AFqggJx!afw{1{e&TT zb()V+(HO;4H3L*YgqJ~nPqfi{=9v$VJ2IM~4>WHIy^PFEZ?-4yI57nNrl46789Nf~ zjI;pxH}@i5mrTilFu*}MjBmQiT!Zl zxi3ndDEcHENfJ@_kvqfhyNmlxAh+RX`tS9Q*>&Q4HEsR?N5i|zegoxhOFZ_xo#s8; zZ$gXx+o3oUYGSM;u_IReH|-8NCfFooRN4@2qog_7DolGUeas!?&SAL&sHplV#9>Oc z(LIV_hmuU?Rp$?l$it|+J>`Aj;WD??M4h{ya9hgRM67YTBeaJeYmVXGuPUkQ0da`c{ zZx=*_TbN`tX&(2w<=05Meg{!U(TLIPn4ojg5-Qy&9aoN&nO7L_`X7nzN3Ng|Ar0jD z+-U@RAo6p*npsO*_e%aXB)SKdioo?G$+=ET47bs*o$Z^)$;gb?QIoXfx07-9?v z*UymvTwz|I0mwO6JDC2c<(lLpLm^yZKq`H*8;o7_m*`$<-zf26-(jBNztZsyy4+e` z`49HTXcHn6hqT2NTI?##x=$^%#fW4&UpTowA6lcQ>CV5kipEfX7eYDeafQkc)3V@L z$VyScz=i09^irQB6$a({3VMgag+wbO!4#eW;s=CTLiuHaf)tb(rb4rb#W>~_&Y0he zEySg0)p>%y-r;;5~wRlQl&gM;Yva0$)ba)AoJiiz=n^?^@ar`LTo_iH@k-(XHU5wykn?aZg zrn1w2%VOCU3tb!Tnw)bLg`gXT4F0unBye5KjN2g3mbmP@;|j^!h;n#E{}+UIBitjv z@ycdmJM2FkTV{a-E9R*jD}uKjOx3FcNVMV~W%v4%6XB7MSQEz8jh9;LJ!b2_kQ00{ zufQ0BJzxLg&ef9AX0T?3-0leZ{7&}pQ#tl7cjVwmbALFof$&B;*)C-(YHls@-Hmd) zJ{MO1v9EsYKCHtO$n{I~XOCy;A%1VQ?bJ8ytMeZJ9nZ7{YM2zinJA+j&Spyhzy)dA zRU7^%WB?ZbucYqj^Z~Z%4zCK<0h)e*&ywdBnn56(vWL*0iJQ+Q_HsNU@e3io;OW7| zv%;}n85KW8m`e0&*CbXGs?vZe^lp}JL=%ldDN4x`_;Brr+n!?ZH9k8MFVG2P@XB)NQyMc z7p-Qs@;;4XF(z}7S|xLV;8OWA)vkBFj4CyRA}p>tmX%b#Dv8>~(+}@8z-GxhR=RjT zB2Vd@9XCb1TGeKWXS)13#WUC50HQ!xm6l!d1~NDmLosK)$5Z^{vl!CS>*IoTV>DvJ zvBHmnAE>Na?)gEB(K2gX<(I4k@cx8_urU~-SBLyXSG2im)y$dP1m8+px_pBBax2#qNcy?RsF?}z6#wo5`A1=}JtMIc$*HI17HyNT?w$Yj@;$7xP zgCXk0-5l*G-Qbi7TfAVL+-b+5NtrDnOlbX_abkH5B&^X^uU?>=`+`gZ;Bq*=Cp z=Gh8h4M!^xd@D3EY))?r0$LjcDmZocF>lukIrLdE^u+$JnTe*X>oun- zD=|)0oVBYdfokK{ZdwXG7t46}>X)%)w-@y4Sf!I?twA8pd~u7{heKZ~9~l^#X3ZP) z%Ic|@4O8|yssEX!&~s#sn)4R=1&aF_<#)XXb zL#(PXk?iF|6MtzW#NZyV8t!tq8*P~{mI_FE{aM#<9n3NTucfB7F0xS;g^jsn!{##B?XNzd3FYlo1H-f)T zSv!f59S^HcUccr81Qz+FNA20y>-{?UEn5$VG~p3DiR7*plAtvbnliI8$l=AYI$xWx z7q7!X19fw$I9K6G9F*+s-R+4t)3S7uva+mpZ<;!O7>UH_bR8uh? z0H9si^7uL5F_cK1OgH!G3qj+P)3M-PiO_`epZAhOc;nMBqNHYtk|lnnP!7?XCZMh5 z0n5#6vV>-V(7a+kZ0MkEI|N8$OMAB1iW3MH>xkK3 z>NXu?wR%TL0V#RQ@(U){|g(=0M!zm&X2-QnMEOO9t(N{++k>F1_qDs+MKAC6lo$tr4Rv2|X<^B)OY;u`2#94%plmKr7+eC@-?wyf{2NqvqpqT%X${V$SZpQEs;U}B zsEhDy0}Tyz&Vs6n8h>j)y^^mW0BV=tFoiv}d%UrmU;9nc0S{lXKaU5PTwILCVDp&AAdSE~5U`rBrN0}Ijl^Uyo6DAb6)1OsiAXo*vwi5Q zb0YVPj|jrM50LL?RSW0WmaI_Xhq&)ERblamgPn;cFo_K)B6P^Zm(I}ulsiKeS~xgT zC%(=kWZHJq3=}((%^uquWqzoAg*gvl=EGs2-meIA{yG`x=}{_j(-W*|YwCLEsnhww z10*Cu<3qt-fn6&rpGgaa&5*Lh11W~WhnrA%A-%$=1Q1%UhBo&4=kFGwt4u#?`xtDl zTFn~o@F&W)ce4Y@lGywJK4SaXBimhTwlv{u(tUHjpKI~0aQk1|O0J~z=!AhOXDfL= zpxMxrqC_3o9WeA_Yvi^APWGm|&d4Tbm<2k)@QadgP2|+&85>Psb>ADm%`{mG$vQxF#FN+&TKyy33AT^?LME4Ab*;7tWrN<4TfJJ za@u@UHKN8jBya(P>xs_sM160n`WH%LYA$^vpI(WkW}I27Nyf3JIrm3)R2}q(&Jh1^ zGU>C=GjQOG7}qU;{!e5Z-Zp=ZKf{5xE1sro8~SPeFA29`M8P)UDx9? z+_}hss-CTMhcrh<-73iSGaV@nSi0d9Smqr;`dQfGxfpjqC=$IeGkKk0po4f2yxpp+ zwKrQ((Y?(9uGV6e5bl*$5~Rxc84F2 zm~y*Ly8?F}Uxn&xic@iwt$GU`Z_1yE<_QGpY3*Ze47*jg3vbt;qQ931JX)(&DzB=h zBG+yMvd^#pd?n%4NP7kzlv7X0l8;b>!mPlB^gxw+o9Av+6ei02&G3DYM+|IMBW|=* zR-+0S6}c&EaZ~Q;vyFK-bLW&&XZaPQ+p#ac0b@P?NX% z*n;0ja32qTc*E?6x!6Bfuib~kIEPqq2Hg7CQ3abDSg~o&0@&u?&-`hfu4U!!Tz;TL z7LW%3Z&#=}m_3o0{7Ru#Vg<|ijvKYYr(tU&odc0!BCptH%N`o|}}_)ty$ zKXe9tP`g_idK~%g_{ul%u9x#LYtQCWyHhfyA_{kp0vLbMzntTx6`hTisX1_6(_2eTr!Q=*Rp3FoUeszlAJMo>r3U`Mv^WyFWgn%#CYbo-h~& z^>0H-cP{n(#Gsg;T6zlb<~o~eEkV3(-Un<0u%0Pk{hG~Lkeq4gc;N>Ai#7Ev8D(C3 z0DY7wrQ>|YsMkiQ3iemt#lj8J4~c!SLJczC$*%o9M8pCm+!bjHeJ|ugJmp6QV7~9i zBOdc}GdQEQ6>DekoqG{Epn2ZABVc~2{_FS5#=nam<1an(Z1>RJo-C)4>)@ay0CRiS zjp9A=Vr(yvv2ePnw^Tb4V-fvMvwpJ~lnfkd`0wiOj}qJLi)X~CJ-iWPl(%2Onumd9 z=4}qs$cL{6#-Hgh5UfKqh5oA*KtW>9eWYBE(!PJtx-%$ma&ymxVrwmIa`;nny$PA88 zl6bRz^>Hn>DEly)p*p}?Fs>o(T1)!-Qn+{w;59Ia3h}*(@$G{yy@b9BkYAu>n=grU zBe${&Dv@#<&z~>xSG)K;s6jVpslNpmHeTJn zGWveFw70jTkQ?7_%(E&Hc>5CdMZES}Oo~#>M!S-+0kWqio>V9y{6KE7V*l~uF0{~} z0Ul+`q3I;`&RWT(HVD!JN}Fl8GySr6r8>_BM#8e2lD(=Kc*l>MD(`($lx}yPYoI` z!L@f)>t2`*D-tclX3W^iA`K1Uv7QHVrcT4!!GzaKDy3trv#`YgAX-AgAFky7wZrc} zI%<|WO2TWqq@JDxM#z$=WPW2k;ul*-U} z#Esxb;4EQMR+#SwxE!Rr%$m8l3{&x2uKnbUtu~EaZtNknf9G76qyI2k(LlSbjC^{k z`((PUJpbfbSlVh3LvX8pT3q~AuUI_rwtNBCzPwUCmF(dPg92)JyGI6WrZR41E`?tt zLAugcwzagSn(behYKcG7rOT%No!AGNWqh!tlo>E}DMKs(?AdnZ?JohMF&VU{wvs56 zhK6N;e0I!?8+}71N7T>L{E4z`l*i9u>H|adk_09rgrC*NB^*)7?!X`m^~>E#3#%>gKKX72NVxVjZhcDw#Zpa z1A4wDwY{tUT%WgXEX#ruY_ZNEM)BbL{B3&HGnKr|N9<|Im#AGi+E-5|i(NGgf&*wL zvVqtONJs75SByN#f3U?}_Y_vuc6#8^1>oUG*jiHnLnT+{NaKLIbNw!AT!@qOphECE z%m0AYFM^m1AV64jXm8DkQbyzDRHmP!VU~q(TM+O8#!zD9D4krD`&fI<&ocRX5ASlJ zxd2S1NhPR`C75SMxcR<$Xh>1C1E=rFjzhx}OAwg(s8=}CK%9917>_x;5Q{H@e@y(5>^p)(8Id$c4Mk*6VoK~2WB^%kDwx|oajeTg^@62}RCv|cgm9q%T^EkaH)o{JC{c{Xrl355$woJ2lgK4KbwHki5GVb2#k zoGbB=+)@|_f2d+Gh|UG&L_3O^98@v<70f;8T zB(g&Q9kLJi4)ml7(V$!%=)HLx>OE$hO&-;gh9;Z_$v0$;cvs4yog>1*wWHkySsPf5 zNEcd-L>HX8QFW&g`^nDWy?z_WJ%1a@y?-0bBwwEs!B$Kgp}o*nz$*zKv<(UX0M{$z z3vDm6|U5~+RoZpltC!5#8JGXBTDM+EQw{!(XM^r6Zf^ugjC^#Rd- z{SxmT{HTQy+JXIA%qu=$jyE14=k%5873=^mLDU!Jp1~8Qh4>q%g|r8L6WL(@mDX0_ z3*xyCacFfbEQ`3F>?^toT>4*p;h-w8e9cHm}7-xDcE zWNY@`?-lI;>Q49q;Wgn<;*RvdV4q?ret))nb^lja4A-w(Vt>$DQh!*0k8*9l1wPV% zO+@Y>UW9?;C+c&_b05iCxF`0G=x5a7>Ye(9+AHLaI3MUO@ptUu?!Mko;T_=tpwEBE zVc%~E&<9nnv4`y&@k%gyyH7Smw0F2Pc}IpX_!)UP%M|bm=bQA-iht?}$}fT+5*$JE z%J;PJ$Ju{zBivuC|Kgkh@<0E%yqEq9JO+NloIWc2;|93D&}PoTfQwLErAUtQ zM0-I00GD@=e->P&{~L_{6Py6Q?|0|dl;4Hs8 z$^C`!&(l#J5bW}f_fPaMRXnGUtN&bPxWCwE0Ovkj|9-py_Jq5<6VCi!z~-OcQGR!j z+YjmV@egp(;9q`dPaie@2`9L}FlNqc|9OVGywm-oz8!|n=YRGe|L4I0^q>7*C z6rGGEa5W`z7*9qY&BMZkZTu%~J?ZR8qvyX0Y<@{zxUJRnu1p~O5m^w-8O1nBUe;YRoAASAfsqHy5Y9DA=>&F#JHS=Y0FHdGsoii*NJks-~nks zK%N$Y*Gq}j{VLz^V#E<71Id}#>BPWmSb%R;Tn&iBx(XVZzu7oNWdm0&uvFGD3>RCu z9I{THwz#Z^Y4KO4zVt1@q5RjRayu%NKhm7-Qh+e*ew0@nmCg`H%fYf>HcYY~@gOXe z!h+66!E{XVw}Xu~h0%5#S9x1ii_>9xucTlv)4WnBxwxDWkHvaE#!DwX#y^=y5|b3~ zoESiB5nQzd(;!|`GdISL!OCXZeFB59tXpbA$CBPnsv1?SjP1u{&y+a(RW@h2h0D@zcg`6yPO|5$kl123jlOQSm_f<$oXVYcGE{T!wdonN}oAj^FdDK zA_K`$ZXdCE^Nb9bVn|(`kDQ>B`o#jqa3VSzu@Jzy+KsZsRpa9L6R^!@CKD_q^F9xvB zqOTlt>mg#PL5lvBy`$M?l}besasLzM90{PjFGHbEvZHKkg7)2Jrar2vyQ8&fH=~}I zGvc&R0`5!hD2^NbrmM!+wi0J9g^(NFZt~Rr_?o=c`C6Get?hUX9jU097~V4UU=m|d$1 zyTf(jpC9~XRrfG24TovYkjv>uw-@@oKBk97_>7zI8NFn_e6`A{t8zHAN0d8d1Q!F7 z*KRLRB~)WokExWh|5xHP^{*V$oENDVf14Lu?$5L{HDbUGM`T17)Y z4nw1nv-CAR8lveJ%4EHyaIbNZ^{yve)U`_}!->0jE1`OCKe<^pfb!D`)*04?f7X>& z(b`W`vX%X7MmP9ne~({i_iyl1zw0UT6RtA@k>#uzbRk_y*U)F_UV4E3ovNwJw~O3z zTAvRl(i+`%4lXN+EvzFa+PZKn=-Q%W|Mc<6H5&4)X0L`qTUTrJAR`(s8B0|amC{AF zt#IA!!u(caVwI#=@q!VTB;al$$69e+iR1a`$6bJ-noA=Sy#|oj32d z+Xs&hlZLSGO%rjIPeFN>lJPt7NH)-?uhOuePbKtKwVFolC|y%f+^Zo4e+9z|qwcsQ&dt1jp#H*L+&m!O{>+`2DL z;{8JTc0nQ8iM^k!-<~5!W92#hq<*VpD9C?`%*O+rhJGgNno$OHEtdgGa%)mg^!;Ql zrWf}V)3wDLifJ*XZ=a!Be~HiDPd}Hnayi*hzPp^_E>A{2DO;blQmdvpZ^>AZFD>l{t4^HT-AQx zd~w_jcU(AO+U@Ix?6@L%)uRoOoFcWNMyXr3U_#Tdocvm^_Se@=n78s_#^HWktvgY= zTC|nklk@EcVuD74e{2$D6Diaan+ge+2pWZwh&>J7N6vSo`(ouyK-eeb*g5W`dCezfj%WW8)q5T!<~RH_xCUN1gH#CnRZK#Qe?dATo#;-OtIT}CtSX6$ zxL>iL$z(!C>qc{?tDD$D=8!p1LCVl0!pvN4Waai zHusZxPeoqTf4-=D&tO-9mM9I>t%=wT4tLlPHa3x)$Tf!RjE{kFI8>7+Xd+|tXOLe- zrk7m^7m^F;yu1q|^UJOv%OgvRmY1y&*C={aJ?g8?S6kL(t+C%N-l@Lbe5d6;`@?yU zM;%P(-HXe=~E-g?QG?8kkBEw1*4QkN4eTM)LuLj zVrGQXe|vJ2tr1)yfd6%qywk>&%I-+pKipgnGYgE7oh{4muqv6CSux~>2isnI>~}9O z*p#dq|G}2$7ED=2hFm5uojbRuVo2r0=9@2GaCP2jy6M^tQ?7lsuY3Hui&mdIw`HPvf5%i^h^yqh)Is4<)CmVfh+ZzcBJ#fC zz2N&1alW`ru|j>h=2HD-hGo`E{Wq$wv1&EyH3f9IS`l#uB2Is>>{(kN#t#j zX4GzEHdzx3FAU@E30@{1qkPnH{D}NbVDJ z{`zF!jgR$i`sLHXWmjEDcV2yN$0wIel$>EwThBDFe*?^@ zMpqQ8tz*8BOxxKdwI{4~=};Zx&Rg)D(JySl@q}QO>J1*NP15Lh zIQ48?S^dJfvd=3!(bhL_b3 zMMb*K8nE!6oI;2@Gx%Ts^KnGjeBuZ#K<(M)(vQ=v3&m!l$xBO|!j%Nu6!a0beKSVZXdko2VLMHB9MV-}ibf z#xzbka^!E{kXZVXR;+sA1qt1dxJUM=jV6;p(t0(%=77>>vPy2V+vCZ0f95Cy?C09y z3g&H%x0G`~TEhLlf^@P!FP-f6rjs2!xzENu`7X&?ZZPSv@ha0e(IbXFEK0HC1`kHglH8cA3{C z`6X|5cF-(knLEvd{aGVpKYc|uQ!gINyuO@`0O^VAC);JcS~3YXyIrl;sI&XY&$7mZ zb?8Q;Z0@J=trNV&+fTodjegnKY&>cdjF0#)>gC$)a-;S*-MA(4f8!h59ubeVC2+%B zWh{v*aBE!EW-M_=SD_6Vb%Jz+NW1?PS4k^gNT?F{AJe+F(?3M(Zfhk06(?Oh9^m75Orz9|o64mX+OGdQaKL+~1e&ckhqv&)168{q)PNrg@dsOe?a3<;<5q zvpLGk3TIpqzx4dENy?~`|PKPdY=tP*ocf7nne2{xt2o#nOX+VgGk zlG4W9aphAbbp}XspF#_y(l{Pz+p+H4h>Cj4k9!85i zz^rsk58K(^mbOJy=ClpMcRiKRck`%@o&%qs=qZ~VcH~6PDWl_lH|x%I%THVpo>6t{ zZRb9}Yj*SEuI7RcA5QVq1XO^aHo5-@RXp@3r3OVj1gJ|MNBQ3b3J%8Qf#LlLUuvF(6qyUuOdHN ze<1zzz;<&qDG{k(sNKHCu--ro{X$HRWohVUAcT}ko1ZWfpSi|N&2AYLP?PXGiOK16 zQYTjr=h*PK+OjPCy^TXDhWyM>wB$02gh_6w z_@>V{@{0#oeXwHbk-M*bb(wGO;L)cBpV-;EgVg--wl#$oPnKJ!xM;9!?~WS=-#*Yk z`0d)RN3*s+`tz>id&s1x#@MZ%INS3>xJxcWcCw@GCCIHhk1pqW=?>`~NwHK~f10&Q zy4!k>?G?`}Id4m9r`eK~;}ujkvdX>MOY_xAp9ca#mCs`cgd72vFW+c1P*=X)4(ja0 z1Pe(Ud~u6xQCRv@AMapuXc-$~YjI>vg&ZRO5a|qU2n~dUP{6@gql2$T2cK>SngV(W zSEG_AD%~tmxh~j|kpWwaCpe;Qf7l)Uo(tvllB+to#IoI9lT8X|<#|onQ;6G!kYn~u zAs(x1%E{?xCs|xEZCzz&FATqEu}OHCjo_>UawV>dP}!7Rdp27E`6Nz8Jh%C|!6hHA zoN|bi4!&`8+M@8#z#?J6N`Fzfckr3F20wr1?U~tR6mbw2X~R-)GEynm z$QARlFU`I${+M%f{Hgdrg?fssQ`xCnsa~n+QTC|TsMlyTxjs)$AQ<*}qJfZFW)q?g z7>z!SN3CL08DJ@@0Hr>qN0lvkC<&qcky8d6qa{!*u~!K6E!--KqNq?Cb3BK#vvbs% z&1$uBa}9g104hl}K_y^Ye_zPWysf1rn~S2p;uuz4;NI*FzmqRL%YKCqLl;-)GS6PFdPnYJUx+76yTakU*u@b^d3H@Kst zH^{ekq{_sJ1Tz$+Bj14ZU6f?}%sag{Vh*qsfQMiHLLtE3@0IcQf15+ggfy|879d+o z7$TcV;o?ZSG8{Gc!edX#HW#%h&TQ%F?- zy}qC1$p*DYmE-d`0zoATm8BFYJW3Dt#(4K}DYBN4D*9e+d}5B#m5XMlMNX(3`_0 znZpxvxFmDdmHf-1JBDj6fmT`L%c>GYt&t%bz^iG`gQG{LWB}SB(naEIx zB{UQ=V@ldyDNn;YLtufA3+O~TBw}wKU?|!L$;y?*d*5vf4R5F;dBO-`9*>;Kd2#5pI6Uj z-peQ1t7Mbx4Vul(mbDgYvP`g0#+@rIDT`<{76BhFd``R zXo#2sf9B!D?~}}`sJ0jkAq2^991fa@vY6Ro9*W=xMsC)>nHzHMq{r z$yzjU!{DW_-7{rw-yM6#En7IuYV`=X#ZB69f8LVUAOHLFgS+p@3zOAzYXW(B<>8A5 zJ4RL?|Kkr^fA^;graB93p)!;_+wC5}mD)%yO`iy#94)g+gK&T9`|V63;qv~}aoNIx zG5H4!RAfyCIBwEOia^Zy#%JtQ9W$X%VIH;mpldSJ9@ z9lb7Fu5892MUB%1fAt`@cq&5?m_r+Je-hD< zdyiZ@KTQk{sdo19J5I9%d0=qX8Juy^8O0c9l%cV78T;Ff@SMCbz<1#QSDk>IU*QUL zm}gh2eI6PJI(;5XAn5XWNFb!~dCY;3#f(I)cDg9j8kd@BiA!WvT|rH!x<@^r7E)>w zS2wHM)xr$*ZuLI3pcYv%HP=9Oe}C%7ZLBT^2IU-X0Ce~}13iI(fDjKf2igO|?!dkP zWkNX@CBbPL7kyWEhO0S2r=`F!{GZJ0NlDPl{%PuPQu&mI&*D=SK7Kn7vl+s3u3|sV zP(4k`{Z|;DG13JBf`g>h+oS;gg*&uVuW)E5J>h>ayUU6ph)okM%*e+}|ldXK!- zu+6xuY*+m|hWAPh79A0cR7n-3H^QpYb+DOiFuqx;)}fUSRH652yoN#ulbEJPGeL6` zyj1=^d|PhP=v=xusi0+Yo!s2`FnNe>ly}e_+GO49@Dc1IZ_{^$uis{hvD zw3pe-%S+?slgK@AyW!5#e>=)G>F-l=AZ7}B6W+!K8`$F17zZKZw7Wb`rBhvy=ZOrD zP^Ri9UgW?|b6xz!R_sK=BUdR6Dvy%w2!UYC=gAKQ6SX5e356(n6ehky_BblMFyT7OnmX@6>9hg2m?#wzw>m_B0_U`ij4?e3FU zZ1)!QGVgz)(bn|4d6IeS!_T`B@_$G_=E|Wklpm8>nvt?kf0MJxu`B*C^~4p`W!8$p zBEDQoPCRqQGO8;PhqK#d|NbT{&@R#dUViqMJpPn5vMb+oa`NJI?Hki zI@2s9&mQcsE+Epc^1Y4_T0-`kQCT~2)fJ%a`6RA7KO|+31QPLspUAPn+i;YVq9ezK}N({oeRl)=f$yQ z&b!FHu|3WYoQKHQPJ_XT2Xke7R9vWZR>ns=1$#W=%!><3ry}lf2vI1&*l?(JR5>eL z74e$Ve+i}Y;c{5&T;^IF?}Zzj*TwIFyW)?*!|@HJ$y3IFn;$fL)5Pi6G} zawG0@sn1hi;pt&KM96b;Q?G?s)(}GFe+d<9D6!;F5~0P`Vb;s6chdtjMOD^d&>}Hw zEEr(cSWsYc4P`O8hAb8{p)_a-W?3vjT%o^}O_9w+tI-hZajPvFfy+a0nP@iqrMM(Z zf`oLo&5Xjqz_D%o{EY$rVnte4z~6k!9mMySXX|>Z%?jTh7u42Kye~jnh-VRq4+EXmJUp85)EOtv3m2Bu-RcNN~@6%Ob zGyBrskK41VsBAvT`KMl!GOdC(0hOx!EDI>~&sxS`A9zToFoJ0e+0S$-_xRPGya}jS zOp%6<7@jj+G5)wpFrHMEUv3Z^j{otL;ylqIW)(dV1E~g zra!-p&Ca}-WUs)^k-DPar{9I0{KZ)*@vvW(x$~@fM!mThJj7W{vQ!wdD=;K!4aLMo z5iDw3F*rn9F`PMB(W`I)f8)+#mLR}zXeE0$XXZaEvzVnw9z84EptAZyDR@gf6s^itFiZhkE6O1 z$LG!LPTMv++h+T0nJwBX?XIMig?EH|!vZ(SMpy}kKtf_kfWd%cB@|=eVug^lYr#^`@Y$g&6VHhWY4@eZ{EyK`Sv!U zUnN<8S}JBzb*-MBf0rp2H>R&nj}*s?mX|0L2xUVnLjU6bKSA^38T8}i>%LzlUr)c5 zc`wO^^h7wr+kuqEQ8dWK5}43>VhJj&=G(%VMq+h>P9!)_TgL14&^*V>R6q)p1A1U2 zU=A!RHf@(w5$VMPMS5>>s(7-<6!VBMNJLm6A`BA69d?3kOik+w;g9yO7mAbUhG$}6 zPWhM|)x@`e_n1M z>#JQ7zUuy^x2>)8(>KpvKOV*WxjT9ta}D%X9K7k#llCQ|_>J*_`&YOCD`vNvw_~jE zP$_Cg&n`j(+*c99+R+BwyAo|fcc2OCYy1x#|3(QWhfZCHn1A&=bH8blKB<>@Z$@IM z$ai=iHP)5(tnLw{(Q*E@v7PZl~ zW$FJ8gHD0pW(ea^Z(~|IW8ji5q*N`GvRFkc%_>?lp(SWG>WLRnSO{R`ao|FHZnGI8Vg@M`DmOOcl>yh>6q-XdBY-o-+;Qdf z{ddj2H2d2tC)VDy3*CjV$bxRixOdZ$t@nKCbBDis?XKnZ=N$(gwW{VTp1Go@?-MBa zJyb^b&VF|G#9wCbH2v<2-8@0R8F7<)J zQ|Kw}XzII#vq=xD-iGc;-j;qS`3U+p{b+K3;f2C$ldEDoAUm{5b8Xp2h%wv;m&-|9 zKR3)V6Wl(I=BVIzLe)w1Ws?SDK@#h=PaGra(Z{T$(h%52a-=#%lUZXT0-R)%ePbUC z!WYn(;ZGv`RU?6plc-}ef7)!VqS_)-D7CUihyxMc(eGb7vFBS)A!YcktshC z`Es-mz}X#vMx(7f19wVJ@c~Vo-ujMwLAF$_dw~v^5dnc%=g+}%1!m0?r~qlcL%Ah zbZ|d<1<`0HYI-qsTkWCtP%ykT8jM7q4Z}#)|BxFKk6x?YZME8S);7B-C6IZs_?f%QNW>A!&5FNm@ITWzLmJS@J@K$~u6lx$ufB<4v((txy(gK9`m- zi*wksZJLbPe;i+80p<-8G+DLc?y$-*HU##9%Pm*hJ|$hA1A76&JeC@zh!$eCD2}?R z?5J1D4k8{7BI1lNV!V72x*4Bm1R*;s5!wLrbSjx@g|>phnt4i-hrV;^Rd?p*zx$7O zulU1v=T)OW2>8RCrUeELU$f)OT|Md9Z+~UwTYrDefA(%)ASPmoD7S0hWjimPUsE1{^{N?58t-2 zcw^)<=rixorC1}jI`)A1{@~;0M}r)V!Vxd%^l<^GXM$4_RFsw+d~A}Q(p>_| zQM%9Ge~=ycbp6zR%r7VDj2_?xLgxfR(gZ^1gt*Te%|(Dd+TjQ)B1JYw_C-vQXXy;( zJ^Q|H0V?Pv^v{dW{*1b1$Z+e>WT{i!1u6wJ%_ayfpJY5YNB0Ia6KE zr6lvp+3&AS_H=!CrX`A-tajHmm!kRbR4r%UGCz%Gwf?3eiBthVHYn|7zkiwUFn#by$ z?sU6>_YgkB67w%8eTIRUT^w7IjWMEsgjqel9#E*WqGFyZFM0R z;ax5}>~lq6pUYo5b58#oYT0cd%AaU}f4QM^#vH)w-loF`i=itn-u`qKk5M-j%ZN^h zC8t@3me!JXwLnSElr>vG7BMDi1uA3FK&wE8@I&HM&=AH&Y7|fwowGr+gzuyh_3b7in58IX3h3>Yt7+zwYpBw6;@)uhz;~EBgn)E?Pb$I@l;}c!mynQADy$ zGXHwi9;LmU9SaiRr)fwtCr?hH5(N5LWhsWdyruqx7ZGVfF+%t%H6w&CUm~r3tD30( zhx}pmbc}h{cT9OMa3J;<&isV`e>;Kinvbx@IP;U{$Ji&hCq0jO%@1=EjtTi8??lXe zwP%a(I@5M>JZ9eL-QeqwUBO<>nKyBR{3h`-`=H0H$NH(Y%m(us)~v>=rf$z-YMI@v zu~{y|XFM6N8B36{a%?zuGG=ZXwnLOXri$Kxx6R9VIUC$!(2n^y$4Bj8f75OZNi#3L z_#&8UiA6i8yD2jYQVx$4bl7=3IqHi9qmyTM=}s@lsyxSGX~>PG0W-@20N1=eNVkbP zu$V>B94mb2L%!dZy}Eb8d)jOAzEk$-o_@~(&uNcY^$dGPJmVgdXOe#Jh#LD^3?lz9 z@fh--89FsYDNTz5$=d?ne}P+tbpGdHzd;h?ckYi!G+4741ClR@id=W-a@_=01gXyR zt~wSQUpwNeiy0S;zV@`E-qLyp2O)P5zGQ(C2#8P`10w`y`w%i1LAqxChoxFAJDb*K zO=-!$Y(Cv~S$7c)BE8hJ$ZR#Q)NHZ#D?a?Z>B}44(S%vkgkrMef72iR8{@pL5UyD; zQ20C5f!{Q_&_ ztUUQ9Lz%5}vR!f2t#}CnAo4;r2=Q~c4dGUQ2X{J!T4}j3Xc`b66WA1+If9yhTg=J}QEjz#s@Pp!jbs#WMUfX^(yM?>Pa#i4};Abk^OxxIP z+&1w>%gxrC12+bDgl<%?FWqjshrcUyXX(!J?)H1R2Q6Q5eMNaN@Idgs%vVeIl^^Gy z6rQv^8F)PSMCi%zW2I-fXZWMyWZ+QwhvmQUf3bWN{)@W&f2z_I<*V9v3#RViHIc2+ z&lOBpa98kG3Cs#%Wprs~MaeW6+)%o>%=B~p{6-67;wTY|Ss`z!EtHM6b9GD0ofD?y zc|F0h5HeYu#*+=oJZC``zMhr=>@nQ;62O1)#kpwmpq>{(Azl!~5SF_l5uRc(BDezX zpes|#1~al1f1f2CNd?pO_U>SP^6bbnL5rwPp53au%RHxAEtYr?&khDcp@<-g#1Iz@ z;ek*o%=2-u)Rs%_EXTo~P`Mp%w!7qXCWDoHinfUGT^M2B*V#wf@jE-H*V>JMND|MVdK7l$6}e+jDwJ)4B_ox68i6z`S!Ee#d#Z_&+1#`D;$H z_wx83C-n{zgRt?3=|7k%FwOyjx-%KCtr3BhTE?rWB3l|%(^WGxh&=HoIyN!VU=IW( zU1?C8e~F{!++Y(=6E$u}?ZSvVH+x5B_9wF^lCz&JSlx@}p%0W=cOF@OlToo2=kohq zSz1bVR}095=zQ3lx&UKvs+zd%!{?aGKl(eY8_1DlaPnnQ4DyA#>`LaGPdNZk-K%TXxkYIoF2lDjVT={dcR=>x#n6HQdN zQ8zkoijU-ODm)Z_F!3mQRC*%zMEr@wqlG6*&n2GIo=ZL3eWdZS^kVQu_2v3h-!J7~ zf2x16obC(BB}tXzYBHB8mP!{$Wx1@*i*=^Uxg``<)BDuEa^J~5(@O<(UE!9}?YZ40 z(}LWfbuh*V34g*nztOiMuprIK?jlMSuZTSod!%S;Vqn}9=+m>#RFQU4v7#xc!J`NU z*Z>cYBADt-RE#+(6Ir2ny}KLYrUHIH z%bNMC8mN(@5LPi&R7RJgVKjmcpeghgI*mj$N&i)MEL7L1TU18vpyK=DbbONjf58#G z?`ti@Ix~b-AGg#LF3H$2UmfY6Ta3ArNBCPumEOT6$zPg)k1Fva9vVoQS9o=QEClpJ)h?m4t zZ#`A^!uZq?Z#|yz0%v^dptlZHe}s=%h_i+U?}0_G7kIfISLJ#)nCBh!w9$ZR9yhAd zNFuKf1wse;_OayDAg=8r5z`s|-R`@rS&wf*zTC;!;yvO0=O(QoR>f6k4U(0`b{ z=+I`&qmf0>Tt1(33A%LlzMiy4ZDTaeECmKOq5IITy_e%HrWn$e%>D?qcV;{u$>T(L z$l<%_YQTFJ#``CTUh&IAW(vtfLVvtb)617Bm-+k4ro8WF-}cn@^xeMQY1VJ{vouxq zaGs1>?k}6oW_%YJ4{eH3e=16HnRGIv70cztNH1TE2DpupflPn-TJ~D*+RU|WBjs^4 z&fdn|mKkpwFYj&p7Wx*wuY5fG%kW!e^>%g_w=2USjt(M2A&jQfV3f)fgOs5fMwDlw!G&R`|lIyL|f%78=$hw(r+>`1_L$-0#4+#bUG=_4-E@lQY ziV*>2fYZQA0T8x=e_RL+0QA$=dMi~7L_)${FcIdQ!+Wr*auU5B2yD5eclKB) zbxD3^3N+N&doC<3cc^7-Ut zvn$XyFDr)fez4XqJ3GznX7*DZ)CJ74W_FX>AQ4Fo9o~#5f5;Uz-eLh8E{tlFwPN6` zOs}hWVG7>7&0PQ1%H zdG;521SVOnrkx5>$f!bQD3TW8dh;f#G~JlSvciyDC(&&uN;B{}e~~+ZN_c~ifT^iB za=GKuFHS(1e^OB2Y6;y{q2)E5NLHiu@y6rA5s{H|@(yZ8*3-+;O>A@1^l=k3b@Kp@yH^B(qp|nk>bs0xAq^RK;esR;&2I ze}vxvyRPyaRLG|^_(gl2(xTe9Hldkx?X*UZYermV*q}99H1L$J9HMYsKY!Fodz}%*?4F zX?nCV4RJg-=Y-U(4sm%)|%&xBP&Tg6&c#)^sSX_W6VGM z;n`EnG4q!wFO@_;H!%O{h#4?g0$et`f31{4-1>?YOiO_1Rsb^?A|1eUE6lgSe5+OQ zQ6^e&fjsJT>jIwU_E14hu*3#wj@WSwsGh8M`6fnO=(U-5HR9TLGMKK_f8n~X@dH8e<_8& z%^qP7bH9t4%&7&op-we*J+sYp2eZrcDDxE0E#XiP?@rtLToLy|#b>2VK`$l6(A<@@ zN6iyvde}UU#c{^`p4CfHO44eTZ2h(o+l0+Dj#me43}pj%U>SF(Y$t7;4P*b&-kNP# z`~He%&JV;>8nJ9MLt}=8d#vH~f7MCF5rP^Szsgv+l*&X@6cCjV)Rl6XtWw=_?TE*$~o^!LXXx{A){msw6dG}NO zkF0m7N~q0_T!qSK>zn@W@3z!x8Tx}`fBdI2Umfr1VGjT8(twm0naRxje?J|SmtQ#W ze9(<$l*Jf^mSgS_Lw`ERn^22?(1DL7+z=kXdNqf@4aY`eG#Il;kaR4JDgGgsn_h=I zKRyB+CEU(n5|7DuZm4m5ngGfP$cBAdCiyp$jcR>y>q(&52=UIJ8X}3*9Au$u;4eP##6!ruQeF zLEl3^Kyoq7f-EWKRbAm1ImTOCiFPH;{YefR8Jl!})qCKyzh0s>sda4{Sk zkI__2im4=Yb|f}&UL@4%m@Rf?_)Q0L{LrfjTo@!*cO4qNTdw1qf3(DY8nvR;);(6* zT9Qc2+%PplO;87@De5gsfB~9%^4h?y0lGhc_6AU35?OWmG>a%!VvRykW_Ce*!7=*F zhWi9^$cDy7XGVukjS{fRq|ql9#ylA9wsTDn=1T49gsd0~$T%vz%eY^-#xN>w^qWeA#ufe0bPw2fJ=y>{#0 zzJt)AUH{OYpBHgj5{da+F1Yv`yFYnRR~21)_y>r6^EG7Ovno|edA3C(%Rl*zZ-2Ox zjCeH)pLN5Qt-uj#=vkA?cp?Jcz?1KIOd~NgbfN)ypqRj6+&D&+&Q3kEWJ$FIC~{%0 zSRF3iV!FkAmy=$37dSPJTgoA|)Fmzv*NYFB9&6iI;-*TcbF`{bYV27I?H0@h7xk*E z)yvc?#cR}?)VzWi%%{rLymS7Qnp$k~vy;D~vH z1$gW!?_9Lw!6xv8?(1DEQO>+)vLPS1Z{&zl~T z#}oW#$TUBD5;G9+Hykt^4Ej>J4$t_~Ac8l-{gn4+f^~-%ZT0T-?(s6-Gj8`dq=QWG zbeZ47zsWNauk-j$_yhb~Jj*|6_n4^N09Q<2m&cO&h4hmA9!D{jtDGx|>cSC&q zf`LOUg=l(okSGVlYBNUkXAb|GB~iEPg}MzdJaC*0D9_LUjW`%Iwt~jK=9Xw|iN=;d zwsgBt_elP_Uv<`PDhb&{xsOTdgM))E*4NC5HaM6J988O)3_ty^(3XEKyEfilhn^|1z56!^z5X8Je)43`K(br^0+xqXQxtQP z`5r1q^G)p53WQ%3bYMFLqE`oVNV2ntw`UPgBK&0htbeD=fS`7npuQ36$3AQ1d+8#d z)FM8La%3HoD0on2p^AUV^prH!I590v8%${m#OdSGOYrYF$GWE^k*ipbY?dm-OqL2tkc|NMy)MpS4}pMSUdpy$C9 zvyfS6UFyG`x!r1h$b?FToiX@0Ioa$8n*vOFhB7{DjdCC}`^3hyNS!9moPn?#as%Vd%4 za7y<&94HCE`pocfm9#xQM%!o@ZL*!Tx;GT7PS_EE_-6Zveae2)&f5L?XBn2^ngJ*V zP_CNBpi4B{Ufh4YJ#=b}*pPaAXU2LPGgz}NH6tfwE$#NEG*3$NW6f=c| zr1Q)>;C4>bDp&<r*Z017$!Gi;bN3R~}sYZO2<o^}?l4C**?J#mxV~GWk4e z88yh}z56PGhY4AGS)&{h?MYc5dYWuYpG)9|5 zUq3vM8;^ne``5Y+=E{3x`(rP}m{{`|(&9s6c&@HYEJw?scHwdz4=v9F>MZYfBljfY zb=OuN?c{OC3E>Vk_Q3^c!6ehJTm8$$k{|W^$Nhh_|9Sf76pN8-71fJ(i7e;87+svt zJ68Q8Q^x!*g4cCw6;sxuQW@2u9|5byInh zzG;6Se&*&)aA?S4t!}dK`PyQ%m{@TZx2s;{@Q!$2!Nh*@?7!phkO{>1XJE20W!P8MK@x-PJDVdI3h^& z2G%OZW=Ll`H+D+Ojgqkb(VS7HWK=puQiXppMQSpInYV#OG$bgn1zGxI63oYwF_$>> zO6<)TjrqjbnQ3sY!-)2#hDXL)w%Vqt_FSnajBz)u*wC{mSqp`I3Noj(j`m7>wVh%6 zQma!%tu3`)TN^^5d65vcqP9wHgA?lLcS`{r+7KhNf^o9^xzaf9z z6U5Vl^Qe{W%T=^ud972Y7pM>^W$F!~i%J)Vs5RM(RceuMLCC1a)`|{mu0H;4t~OGp z4UnHCgN+i_ri(=h!)Q&C!Pa#8X}K9A){6Zi3Cp0Tvx!7ghcf&WrZWb9LldzGY#xf8{3^Rc8NOD)(%8{?JpE>O;Rl7iGUPc;|85%nH7MXl9p=j305Q z>TajXnHaNR8@Xik@_RRQbSjE=p>TP$J({?T-nH$fuWz_;?54dNFZ}2Wl>vXPoSeUN zY1QjBVWv;nFmd`1tj%@Odz!p4+^qxRN}^LFj8IgPu&t0lFa@kUfD;PX5|^pA=5%OpAp5iiG8gge{9rOBWex+P;+TE)*lfF)|z@!!dj} zrwO&eoqsdRu=@>>kE)vqN*F z#=9rFO$WNCx=(g9ITrPI4|k8iklu|{UdcwBlZ-=m#tYdTHWbAq| zQA-#5s*&14q^3J5a+g@Fayli^uOx*D5gibbLmUzJim!+!5r~vlpkm2lw9sD|E{qgR zCn@G-B#46qdVZq#bfec$CGcdWXnF7na*Uz1&k@Jlk_Y!mT)>0Z++}Wb>D1K6!uBqV<>RPtJaKgQ|oe zHeb33E&SSLrRwV0&}GGFGU*b#*E1Iw+9P;odhv?G_+p{rbkj3)j7nlg5GG|^RaDf` zw-yjGn63RNO!~a-urUb|DK1v&f5E1 zd!L8>bas4O;R!VNX;3rJs0=EYn5HjEcuX3@u>~IR31p2SSfp_3x?_SP z06(lGYH9aPGtETb#$EaQd-k{bXy^tEKZJl-M|D~QQ`s3)0L&1|ybXe&sq(pNrg*`` zLs*br!>sOxIaM4iE))ex43-=! z4!EbymXwl(dNji(@5VXVwi@4KalJmTRs>bVtYV*6YeaFde#vsE{gS>oJv}Yr1%VBB z1e;L>rZ0?)d4s-`TEzO+tB-sSK6$Q2HF?9#K`j^8{?#>cBrkIX`Q z`|@|kkR|+`gxPP&C(DV(7|;^;^gv|xq!-;7FU{yejHk*zS9k-W*SDOf#h zgs3Kz67O@8QO|e2N*){)hinIJz|w8!L3$CRy)Cl0B>qQmKuUA$%Q>Nfwe>>taHR}5O*1u;>(ACakYTzDoT!`0`v z5+C5wy(YcUO#h0Lv~(|Xm6=7SiaOpGy3^|9b8srFl)r6^v=xXH`AiCT3bs`;i))Ez zRTGm}*6QVqJX6cRzD$n1EFp>l2F<;%@87_+8e$FirgS|JcPYtKKh(b}EbsiOpkc(V zED*I;eOLP~KT_-Th4K{NH8I@VHD8H1taTr@+iznY7Z7W?785Ho%9n!0nb=P=Kzcwe zSFoeQmmZpE9?)ckYsa%{iUkWk{%trvKKbngR20#0@lCP`%6)Z>L| zk77VWE?H4Zg~_@)(CPB96}V@t-pgD4$0Ij(YUnpEqqF&r>*agPwycYZT%&k&YinSi zt11J`sqW2z-AZ;+FOmRQJ|PqfI`vr$E04G<%RO9|_v@bB+`n5A!<08&Z`pRW>zH4+ zzDZIQ1$X@J8x8rK3d%;y<0m$K+WnQ(AJnn99xFLYf$HU9XwWNA$sTM?Bg+^6Cb+Pe z`P@rhvc7>N@6B%pS4;E9L+;a$8MyWB@zkS0$}wV(%Z1?4Pnr399-!*zfEy(>nN&c~!Mb8c zy+L0b+oxlDnRD01c1BtMaqr-oc4_XI{3_;#$?yI|emo<_Wn_be+-xc$C6mAee;|@j zW#RkS6iFBQPoEh8js0(9zS(}bXLrkl?}B{;)kV&L2j*G@{B!J>X-Js96l&_Nu#KHe z|Jc*t#Cb>oNsVH%bbmzFHkbeJ#tt#nCe#9{w%&MuRARG{(Exko^9eQ1b#jK5Zkiu? zw^^GrqH~oTjl2G&#w=|eyl6CmULVF244SX1`YH{g4C_n*`M9p{eg4q9!8Xa4EdC(P zJKdJGIo*HRIKR%tZpi#AyYp{ATB}y@)c4VZ9{0_Y55y7iU%zr{sa9an87ief^-$Fp z72c7gEhxYq3yU>UVOc%O<7>e#pbZN9=Dqg24p;1-G2RVK6Hh9QzuqM~9X+G=uz0t& zJ!uW(7twS8WzgBGDKm9D%J=O~`z_h~X`cJ@jE9jajV|pzb!(|yNQ&fS-DeAC8!H?DQ^pf-k`MFUG>f-<^Q~@MtI`Cn zS?&&KCL#tWV9m`O4Sq7|B%TYZno51Klb1hl4#cME+LBJRB=5)9zO3uj{Iz<(dUdIp zEGBaEnu{-1#t+w{C<{vs(>z&e43eaLS0Hy<PE z6c@KI6ZuHlD{SQ@UQqi=3oOBt!P|*TTb%p|&%CIkK%V1rEdQZo_JWE#J@`filP-Lk z&F)P*dLZ}G^562cuU*Q%^xFnv$;$OxpAsbiN#X>TSM}xEkg3n`e0CyP8leY)!DpS| zuRqs!OGW%Eid_3(x?yV2!o*p9)OkwR)=wS%0Yn5 zAH7-dwtj%8%}2Gal@9Yy#s&1!mW%bs&F&ZXh7@HD;7sQaKg^9Lz;%CSD~!MA+!hAc zQ7;K-O*=rr>>MZF)ZJ;fv2!g`FGK<-}xnS@H@yQ??vD`F&@_F=UOredcDYm~>D2 z4q-7!AM81V*h?LsFnwVlG-Jn8xAu_*5;JC6Q6*N}dxa6BiFHpqdCK%JCNTa{iK$*| znYp>7WwEHL9GHnQaQ&(BS#ZGM-yuqnzduhySZgHxL>JL#+^>egltyJr|Oh+GiSI-htUhNwygX4 z_j&eRpw(1P#tcJ=v}>kI&F-YRbhM%ChNe-$FJz9?=fXH#$XIESx4lR{e3|VyLO>hxD$e+mEWb*d-qKF+3 zyfV_+o$1Y;393tWsRd^oPGHMfjh`OKUrDEYtJO+jQuqLhKAB%DHxnItJXT|_UANJP zZQJ7gfKNl>4(4}&Pywy=l^WLm9dG!gD&pFuvoi3kppw;2U z9Xdjeb-$7DmZJVp!ilKV0if@0+0eStIs7i7ulEPpQjNt$RNWe_Gl|7QBG~qj9*X?M zhM#GnB+Y_kg5q6TgCGw$xKEm%KPKEgRGnFdr9!~;<>J@uNw^WWE!~u=WK5$HnUxEK z{>2ctb(VV!Mh*2g%IYdW^XuKOO(xu(1{L{0Son=Ko!bi!wc_v@`=%x|_Lr;OZQ=GJ zaH63Ns*AMi@N0z&`Zezx&#%b4FA$R>JlNcFzuzGjP3cn*6k6Idbn*P-N32k_&(^3?mlOV{q%5Z3%cL0&0(sruR~e^GUy717#tF396W zBCf|?Ob}u?AAp2@g_gc;fQyI(PYVyFkHftwob%v<>eq67s zxqgpk7!l^~`2HTSKcCr~c_1_-xzwBnP2tz)j4$q%jsZwQeM_{>1Ig4^1Y| zRoc7wT0I698r$OcJUh>wzZxFbbGn<3&8;f)-|lWVdFb7#Hts%nzN>l^0{EW>mw@Nn z&c(^On>#Sq#FOs|&iEo9W&#XIHyRg@G6Sp4?0FN+*22USz(_GL`vfZdfk3vB!c=ZE zus?_39?6XBRRJs`K}Ke$&*w#@r(Jrz^1>niQi9_7S&R?+S>{>prvOm^+_}^&0gykV zUUNPZcj@K`X_9_7))v@1*Nm{?HJA_SV|%8AQ6#b>mB5q|Re%z@gI5 zrY(^7kHnXuSGmCF#Z!)6zYH2u`=&*bbyzWFI3+fvD%!)U`zmM}ZBnlI2ho{{R|X-+``Ki8RIy2tBGg=}R4Km((Q&U|gj@0ot)p`88<#ATCF zI;1#~0hv^8f_!?V=c6qaX&4q~+k1|E#toJhD_M2x7S`#>b56(a->WeRdRuCIJE%1h z1_T?0kBG+_^ z;{~-DrnW+MkTIL+i6$8y0HS+B-9&wLQ~#!)af;`)Fo|g{@}SY{vNsFkr*?{?3_GK? zt)xa45bMfdT>Fg&A$eF`5*=WY6(3+W*($QT8!m!qD;pzEh_Y^}%;rXf~!Stmr<`I)Q-C{8JOJ78_}GP3$m()}>LJ z{8R50!Tsr`>!AsLHIvCi=SN?$(@$qhZ3<4CVQ0DQuz+Mrfa3XWAP$dlBgI+h+8~sD;km4MtIWdJtsK9uZp1mmZ z_ja8DeRo`taUGB(L6b*TLNC1;>Qa9`H~vkUx@FmI%_D*+G^f|w&`Mv6{y2rXg$q^J63tR?0yOf;2EZu>=cR#RaPNJ zzBTf=Gbq%eRPy&#z!1q3#l$nSp+OutVq#&TI z>u0Dha5!a-A=v2nY~Ll2lHKc5k}iI<_Isn#rCa0%1VOUvRRzmc)Kj8FfB24A-{PWB zbLTfjiv(jLoc(xFc$uU&CF3Ps0@8S}u+002Rr)Y@pW1D?+EeEpd&0aF!R=PaOPmA`*>*_6q@}52w>Bc@E)@RS54$zcF75t+de3<3x|Alv zPGK*^lXR+vJ7T6zKO)2NvMGLEp@p-1@Iz%dh}cDv4$)P|J)Eb1)7G;uDC12PqCW}@ zS*z!;s8Ktg)d;;$=iJ$at=RPL#{b-D3&8c$o-JYW7e?nhz0l4cSao zmDZ9s9d;BzOy)()(&hC_U`uq*cciZ+R8Hg23C(4U4lcJTS9@Z`RnFr+d;&DC8kOK$ z=Moxkww%tO#*g-guXL^}3l9n5x3V!XiKCqQWN%^^kC^!XOpF-wDkj*#h(i8oa@5kW zI+D>LbUzVg^JL}{Ab37B!k)=hQXT12ZJg2aQkXtQV3KrOQl(%-t@NxoqA1K+l#au` z*sk&8u$+Bi+3PHXk^BQrd<1}${yTh&sA&isgXA@iJJ*)w$cp+&!2(=vWY*);8WOZS z*ONzcLZ{;@8bT3ZFvBH{q{MGm3!Gh z6|66MU%is03pewL@AaG0BpU_Wlil=utuM3Ri@Yj@7C?2}zj#%?dZcL(%`YPGBfE6P z3;1Ra?|xu-U)Ua@A-l*2z486ih97}!4+`)AD6c0B@#W1AQ8&LLA*^DD#+OSQH$wvy972`{k(-ExiI zt_&^;osYCLY^>gI5MwX%#Zn#YqtbocUORmnPv-Y}OI-QY1f>VqY)x(K+-;sX3VH9Br z+Gtb}Wy{);KUxInv#Kxp(IPCXb_3fW6q>Xvm)s2%L&a1nTJdC~TmK}9gn5U;W8m$lot&o09=*PDEu4;C^*&<&!^JDIHQ6Yj7;0QT$=OHg z`c_6jb|{}O@W(2)1Q+O`eEm8V1rA0v=f+h+7e6|sa1c!Q=16R|kr%4W3v*=~=>3hw!vy!$5$?m>YnogAB9LD@b~774vP48lW5KJj zw+=D*#WgJee}u6xT_4TNS!k+qV#TTx zj5E+FX(O*kuD@)geeWTL_((|p1vv<_x0efKY2NMbgpIO@m*2RY%~%zJC#B#zJ31W2 zt3`VS5C{lhms{TARS{x{Mqm{V;}g2L=0AS(m^}wZ^!(cxjTM^9#qcuxImJGYW=4pL zrQO#jWw1=t)>n!-5>pVV@rlq!N!>|U9C0YW#A!L5*WQ*RF+3ZMU}`8d$1BMm4`S_C zM`H~UvZ`mrN~xH0h-0ghcrBXnH>8QyY#|^FfsvWGWIlea3zrt zaWxSn^4R{^`sw?lh(!q6Ya;>P<1N#AGIpXmL(!f9fIlrhl8NVy`j+>1L^=Wg?)IB^xaB4a2lc7Q@3gayw=qZ$EUsF zjnJl^M)tnn!7?5}9zj#Vt}i>))Clmxe#oAQ&?jbuE4*XNjMK!1Q@P4NCZOu>9|PW@ z6NNl{OW*b*Q{MT+5;s{2Zj4*=k&xAUq!TZSbD8e-9xF#?7!v-J=QYrMa8fw6(MFTf zo#lCoxRDSKTOLp%lsT3nP{3w(R8FECVM@bL!Pi~Yi42vI-#R6XE*y5>ol1h7?!H}0 zfS>j;!APU-5;oBB_TOnxXXIB6G66KaO9ii?j{)@)aXHtW>i~gv`)3$q^m120xttt+ zz}{H658))pj4{x??>e0HOksxIWgmMZC7+?qnVFAwE)) z{B?2k*40lOWMS2xlnn$bY;Y_~YMJXkd}`um7ElXXnV?R~5eZ4ofipR6d;?xk{c26t zM&eNELfqNf{|Yxj!mCKWalRx(4Hm7 z_OP;C<3yq{pfr6^5B|3B{9z+>`$ERVD5zhqA?GTqg2+NM)*4Q%wL3&Z4wgkMLeTp2 z=mq&>=TAYhhV|g!XBe5(Y`v>ORn8n42k=;IG zdRmYb^`vnTI7E`KPi7Tj6fMS17DDA3gFM8T3^~MvvOiNlJ0z)N;sLM|k#R~qw|Bn} z3!VQ;Qzk{*sjM^IV1@lL`c`Uh63cj*SGL>r)+gzO8cp%B{aU$RTG z_s{3yUt3)jXF_Lx`VN67@|SZc&ZEafUiZ{_RJcbte&A~g&)Pd@$CnlXoT<(Z1bAy< z0jBx4u}lPNr{z+(ER7LP;;AyaD04=15@GC*jS96?{L7kx zzvn0qUtnDlbiUf+SfLwur#N)ewFJqr%2&Q<*i4%S8a|yW1&p4 zoD45M_nx2*SWHxKAf1^L^V+8wz_oK^X|J}?my13;aJgetvEtSoN$Ny08c@IwPZk1_b@T0P(NjkpKVy delta 39985 zcmZ5`b8ui!&~0q~VjCOVww-M3WH&Z8y0L9%W7`|swr$(Vmw(>(UcIVY)phRaKGV~6 zYi>=?MAd-5SAxe1fiZK%iP(X%*VZwE0xz!*&v*^Sd6URKJ7~8&@Y{Eyw$So*Gr|LZ<6y7h|*W!dNjkHV=RCY@blk`n= zJ!7;A!SW(1qyg7$(K*4ndx{1b7=Zt3@qUT|XV~V487^O#W1TF^uR1hfp;kv|)UI&b;JN$5gq|CvCrK?BCZsR{I60Unv zGOAFVK||Uo(ZiLg)nS-WMwIpTw_h#B&-9+M$tGQXWmUaCkrdgbwh4WmpZV{USWf4g zgYi*zx;~ZQCRF}dRVWTN^a8MITV;iW)6tA_f>OX5P&_Q5{P;u|&#KkotSi6ws~2q89pZzexYw<}+R=X#_AQaAeTOqpRUG z6RXa7;D8N)UO zg5ghEfM~Mq4|cuFD`c?u@x5TH~4CK=RYKBTlXKGL(ndr4$!51)5&8A2;%Kn zE~dT)bC>MPo4N~sS03#yVi{V>=h_Q1&4qm3fSL`)UW5fc6Y*>7L~6$pXsZv#ewI)D zmy0PHfeI&zfN<;3n+(;r9SY@SwC21D3)lN!Mp=zF7lqd01q4uSIIb-kN9wEguwujO z!5&-zl>whvelXYvMfsJKdgVpkYvw!!^C$%vw#IbiTANEu`0i&yFGqBug$>X-&sklu zUk^NydHhY_7tDj-exAFR{SRALA@KI@bAcPAK2_oEEYH`eN$umagF(9#Fc0gWgb=$`#3mhWGcB*vLy!(G12OLWZODs=)>h( zdtsuZcWS5qAHwZLfMwCBVD?UA|249)WP7SIwn&eVg6_?a*WMXK-!|7>K7wcRhnJg> zb(Q4DdnAExmWXOn_Cdv$+?^kn6v@*6j`ZxHc|$pE8=b;ng#4|Y$?y` z=xzsm5r*N5cQ1C#dREdzarT^C-U|me{kDuwuG!YE&L zu4e;9a&*wk*o=wzs0W`KkQ?lVQWSJeyS|PcTZNbm!3)dhQ%UXx88tgM6_TH}!idLFb{GO25z&liaE5~h*Nkq@T*AblXZ~TB% z2$$|b;hr_JAcr3O-GGy1UgBZM42+rPtzZL)Kj59}7x)OFOxzlW%&Ey}HG{I5(-2EB zR+jQlUA$4dSj(-R<3@WT2iePE8*u9&79-D(f;ZEvm_c$CEPphp{0)YqqL_iVxB?Ak zy7hxCV*tIV@WE-T=OUi~BS(DRwOo|ALEUwps4PE*9(4wsbMeCp8Uye_%?wH-bjecy}83=0Q&D3 z_Fyo#xlLmFSgZ9WQB=0U^cFe#K2!z}9$!|__B7)LvwT`C(r@i~f?)V30l?PUpO86Cvq{PyLOP7Mi$O95JN(&zE`E_OD)rb~_ z5YOh9U%f)L<%A_%RPWp6T95(85qa#eG6Gwf6#R!CW%@@wlKMjGLs`$}nGF4|Eg@>L zXvF0v3k!ZBioU`m!b@V)3~w^?Mfo6!eK~>BFk~=H&aKv-gVGaX#A7&F2}l|(nrrUj zhaMR}DfpVez108)^Eq)A3r0AU9=_Q><>1==a>4jkqRXxZd3}LZ+?4=EnEthNYrzx2 zBvS2NPl{Mxl@1pM*x+CpyVXl~HJPqdX;_7LjY#3visj1EgB zLS@S4=E8|_=2)?A*mhs~jd~Je`o!a#Gk5 zjU0X_bUTca{NZta8rh6rUhj= zNOMe6lsWi<;RL|QyYxN&B>J(&@F?`&_SODeWUdl z6m?Q;SbY26t*WWaJcUUqcdu1>fnGC{Pb}VL9n5PsG z4{40Q(K%ML<|=LLB_LYHZJxV=F|BzK<*rtdIQAsj>>xnr)1}lb3~?qWGl+hjUNnw0 zqIZh_U$;H#(rGy9j$+Vj9sfPt^Ru9Jb@bskP3CP|HWtEjiMTq49h209!U{b4Tnyua zkq`Ls^YaN3$8ty<_iI&z3oiwb>-9j~@#x9Wq2C-O;nAu!HYF5Y#Er$DloNwBVAZU*IRfhd(N;9ZKC1#7Sp zM}Z(cCH`tde9@8(X)YGQH&Pp4<`o7V_k8PihKq9j6+HXHi?h#f^63R4vNE-d>EZfl z^Ea(Iw;V_d8N}fS|IiTdn-@Q;4d)NbAA;BIC7k zSTpsBw_HFSF$yv*@40@WEG3&-njQ4|yg>_i;NRmoXyDRZp~|V$(&Jaykh0=!b?TBO z=Y8IhdfAl`&vEbSqaf)G;a=&;%;#U?ZI96^8|1%yMt1P2 z+b%Y3wQO9H^>flZ$tL{DtjuGPR4Hg(hYo|B<3Lf=ZRVQK7&l7SjjA)o%H2|tYqA>% zVNkrkoXbR@KO1c^0%$tgN_mT#8Nr6KZNH{NDWGzuGBsvV*L|sS&M?_i8De@#)7K~F5km_bKAgkash5peu4t5&8$6NFeg{ij98grkfG+vJP&9Ljlcu17O;9EX5bPTwIxy65e2kL5dcM=>}{-B|O=5kc)| zy;m=;dvu6_Ho|g&Zmi~@48&Qu%$amtS^Si%|0Pqwx_lPLHAmt!61*YE<$GReZj%ul zg{5dbvc%)ja`@S%m@xXe1QBH$S@HRSGKoUpR5!3?R|iHHP;DshMAyk6?O2+mIwhDN@n3qZ25$m1m+Z8dUN zbUMnf-LSavGRoOh)VL;a5k*Nl@6zjq9@YAO(mC;B>2pW@VJ5dRQrVf~k}x{JkEv;KC72;c_U5lSgXL&GO8rC7oR zJkt3s{H=ri>a~d7&4 zQQQA|q7Ap2HkB%bT2X!A`UhWqUczUsWHRCN`rS-JeOrLyA|+!{m22-2?|DLyC(v%jzOe|7YXc!ox5euEa=9~ptlsCW zRGt~c0lJGeMxw$^gN^?^k&zuW%i3%a%x#bQC6Jy>;fZ)a4-iOq{GPCag%h{an4?!6 zNr_$##km1`!?*?1b1=UqP2aRJ;!fxEiwJO}0&hG^|kX{J@R6xqVvwg5<{Lr zW4GXHD`N5t(F>MsWB&@(`|lS#>4;B};RYA<_@g{IiT|(7!Hv*~N!FWauB&Jh@T`M$ zFjP^(wu2`0!uwfl>U3r}SwdL)s%`@!go%`v7JXS@nrmvpS6;lGjQ2F`Q1FNiX|aE> z2i6Y>B(N=SvA&W%$x{1pVP*Vp2fGPtOxZ|=7F6NH(oECl_4;2DW7TKf_Vrf(w%~=} z`$$a={wQd$jI1$MZ#*QsG$D3KaP(Lmk7hi}^J8*IfQ?SgL!Mza*HY8T?E>V8?36b8 z*zcDfVhNjR*;3u_>E$s6T(UZQabg2eRJsoMlaWq8GTNo1+I6dI%E*orT*rzaTVcCI z%PUOq!s*MAeq3i)9MJ%583so&^S&`NR=XxZcZ!BYMH-%d$3B~UM;bf z>r#H%)>=MR8S%=ISo-S4SWG)kn&Ywsq~-xkd8&s&D!TfsWAmLy38iRV(uLI+8=otq z4^Na$@EnUBFebtcNB=XaXq28^x*zr1bx6(~4|t}VsU;52Rdf=kUd-^|5)56&!#M&J zT2=^Q{{g2(xxsL0)#aj`Xb>M>{#lmhGwQLbJ4d0>O)QuB;q2=e+rPRPy&W* z*1o@u!4Z6ZEzgpL3no=EQ_8R}c0zu{q5^|lIVN0P$gHMXK9q)EJTS%x_#6h0@1Q~5 za$QzR+)IDC=^LCR4n_Xl%~Nt(u}K1!_-ZWq{gTBLC-Ld zI5&B{tj^Eva%qa|{O$Q&F2h@T`r9{D<4gO6lzcu&A#&42P3v3rquF2AH9hI)wT})_ z0zHY)m{|-o*YD+SwIbGr5bt!4Z& z!#Y2_!Nq&}XAT7W#J4`*!P#ctHhZpbr(&k1#I-Et3`z||D+)CN4!_9hLgil<m9ZM(wj&<%M|CYH9eZBi)*n5`XvEDh#pnk}!S0BKx%!%AO8flX{YEm6Ri* zwCKRnT#>C9>rUqCsmv;x=`wOX$eWqX>Nl zw+C9^fP7R#Iyf_1Q>S`PY*EmJZX7~zW^T3wrcxq+m5rN)O+bLy$=T7&$Og_m^StAa zp_+J;pii0Y)!D`6efIt433*mQhIQ<8Y(^A4wQ^G+iD)lU9=SD`e?LYjeB@pyNOZuM zuSo(3ls&rlX-UcUF*O4jm%slg!rnI0$yMp8xzl0C)>HG>jlRLD>YL+P=IeavDF+xR z2)sXlu-kWr7pzRb0ImdG#DQ#w%i2WtZwDD? z@&*5nhiQ`|_cQ)bHlV&5I@AV?X@mP>^bzTS?sxAycq(w#KoQ~faTB8mhK*&EK{S4z z>T&?^r3Yk{Q-BQkYF)tdc7s}43;G=lXx#zH6S_RRVpu}*INht+D|6MlujlF^cF;8@ z8I}v@I2UusT^%do2goKb;VY?zpKZ8rR9q4;6P=DTDlc32g4<&|Z?WQchl*BHPElHr z#Bzi0zpAVaR&(+Hy8m}4VY2R~{+7i09ze4N8e8wSKFtj57q=idVL zKka?ICZ3THQz?Dns8f9lRItsRR^SXo!3e=9iXu<~V4uy6R#J$ET0q_tZtFR|CZNw~ zKRytdlml}xKisAEe_(lQ{|Sc*zlm#R{G9{WX)%U54!%_Z$yx=nb&jKoQe&>f20pI3jljy!o5+!j^HAsBvBX)@g+`7cvudX@#$(u&p;^l z{%%+mn3EQ(kqnzT(hS#hoiTVlIHb(K2>JWkSH3TP8WpIWP4kT~ACPRXLlP4WX~6{;kvDYXAN!UYrPVm@0 z{wY=b+Hmri>ykR&o!WMqn#1A~jHUUk82APKf~O}Bpa{efaJ>x+D)AL?mEn7TDpxK+ zu!S@{omR~?V^d;dg@3OH9+LpyXdT-bgVpq5J%K|acXKOc+gcsbr1+Bv*; zYzT;OG6D9#|%JUowRfFSDU~- z0HG`Z3U(}E#6|sv4rdDA6SIR#7yXf9J_^aiXpk0Q_La&rdRwdOo08%CfGL7?h&<4O znWgmyuVscaum1g~Ke}x|9E;RP;3pHl75{5~?G!UMp}#`Ro`UJ-K;RBZxD1n#W=Iw2 z*+*;|RYxrN9J3(&+z)^@;^UO{VHsC-S4Oxpi3GY=_n8=tvgKd)NZ=3b?WeRF-_^9? zKr^hwxcn+;79+@D`69vRa)|h5)XwR&u zKk%$qHL)?Cu)EGx8y1(9;)G~iXP8A=DR(xQM}$I{B-HtLMvlVR3&-I&@HOW_sTL_o z`7IeJm$&ZpWPgCf3X-uAXBI!HY2@m@53bJA=j8n7J}xeJEl#4RG?mN+Kc%qxEFpco zm~jr+A?cpfe^7GA5C|WHqGyI`r=k_y|0zQceqQwiGEk`_6FTRrAFRZhM6A?pfeJQ3`wA#Jkh zsKNhIOuYDBCypsi(nGz+2L;ScqTXr;dCpB(61UyYRI`{6Hej6dRlS#gQZ1ebz#env z3&MVk9Pcxstd;d^t84Q5**cy+c|keWY~Wj0XQz}7u{>y+b0q&5U^#P78__gpNluF@ zcOXu#>IZJrjby;anha0L@2T?1Vv|-G7NUv1r$P{qt*g%c+fe+Emc@v#dqqnLlXh$l z)(B#VKWNv~*~o}%TP9K){g^RFm_&en@j{8ZOpq?65?ByokC9EMsjZGmG9Es2Ug$u; zMe4MVu!zoVh;$zVL&AOIjd5p$tc<4P;gpQb2@pTq8ZUNFL9DEHYz6ZgZ#NI^?QJ@1 zHi6w)DX_dNo4vgw>+a5ve8znKWCCdrVB*@rD81^1IASDg?#9`$VB)makp9nb13_My z#Cq;GbIE|xEaCaG#JMOevXZCh0*9I-KN8Ie+#)A=R*wgVe*uc^@0@Jwe-*8{n-@>b z=l}+#^hU$>JUN6_!XPyxm`i&`K^{Zt{>JlRO|zel*BacD>((k&?|f5d*@{hi#RWzPC}8&atii_)YC^wrGeH3TNknO(qTdvs9Pnlwy2)kOorS@VLWq@5jYy)77tnzQ}xhp#)(YxRRD|( z2V40FcL%geZf>3KWR^qy$&?A=J1qq8rJYc=EKmY)0{(ig64M3eVEQ-4&nXi+0r98* znrv&~=EOAwe;`K)8$5CP-Xdo|pYA3;%7v5C`GC_6H|%HT8GWwUv*5~OqBB7%FXoCl zM2h}tZ!fWzCX$EZ6(jQC@}3TKTH92?=o@)@OLMn7Nid|5h}TPDFWwVKJ-r0|foUT> z%aL6FWF76oH+I64;Z)_JgYw|c3moZLsU&$`<|sF4;hO)X2)pPS&W@Y3!^g93w^pgI z&TXS-ZI0Sw2rs;Y&KesFl;Q!W;`;%=Cl`f~cd92)nntlL_{Uwd#z~sz7u`DRDEFMyNwp-`bt zd!5&S{!U?}?0Dd&2Wx;4H@ixw8+6RkVy{JdV=dN~JiLU^V%qqu!z@!j-FKefj7 zv+!oiqRf`hPo7r?fd6IwwjS}2uM0WW|H3H%e`ndb~MZL-(Z%>5~0(@MfuLg|`3pC*Q zyFYs1_x4AK;z7BRhP-WiH$Y-`D|1CAi<5cDeIJ{EYm0KMgT|0?^rp`<&=m^vo;=lL zjFXwn6qN*^HpGh69=Viu7>2aZ5C^T&r4Z0Mn{16Z`&PT}~#FMI_PBoOq##`d8Xc&ATaG5AEzP3=yVPMzE}B&KJz zA(#4a@g0!Q3kO89ywFySTbUr}yIjXRpf;&6S%hL$;?!(T1?0RDI*XKF>;CpTh|S!l zfi?H^ap7I{qCN-zmgfEwYTa{0f6MtIjITqsnlzRRFZoHm2yDQ$4TG@wu9gz~8jDVz zcOTb*&Zzy;=Mut|hF_7*#^M;;`&cNgNMwKD)^>!PjwD-$nKB_Nmck!1L>3X!B)=QR z9Fd*W4YA`QAPfY*#*E%G$$YZg_EhnmqPo}qN5jti;C@OSEe@&Q;Lj*3Ya^hY_Os7U zsf@8Z;u`rD4Nx~3`KU|TA3LB@b=zJ)%-dLjF{!!Nw0^@(R6)Mqxnt-o412z&hl-OO zIWWc4lDwq!-uJ#0P*)PXC@_GLHp;n_2l3V zt52a3FB^UxwK?#*HQUobm?L@Y^IB`4P@~|g?c?;d1AH>R0WvQ6Hfk{*OOf?2yqQ5= zXn4^iIpY-YBgI^|56*3dC}JekiSX>bT)EJbVly>DQ;oval5HvG^Q=JB|~Pk?kT-43!snN z?o(sw<^`5O!T;Z<9geVgV_bHwuW4A~Fxmv}vV*K39GLMh@FjmN4+LK=E$RAao z2KQSVUtV8FrLd)DT%SznJ3ovdD+ZM}LwH(nfSj#d%FDo%8Al){=D|uN44-{d*uMlZ zh`P~|B{Q=B=s!msfxVkFDaxHWg`)VC=L%B2eGfww5nI5TD~5e{JvS=RvTu5ULoPolfCT|K3V!)ySXY z>g(n1G7fSM+NDYyKZL2rh1WcRJo2rmTG2_Y$1IBLYX3c7{{s5j-AMf-4E1zd$tNEPQ^L%Z1m%Fm%*nEAB3pw*ozR%8wSvqiC$`T#B4#~UVjfqKP! zHVr9-MA|9Sm%r+fv76<-$NZg~Gy?c@b6qJ8r|fzm7g|aAT}NAk<74>W=j@XMt$12{ zh%7Rgd0hobrtmD6IJBnK$fN%`Jm+1z5BHqe5 z1%jEI-v7R1&ew+oiSU&U<|bVNeF<9x!)%fc@|%%VyBj3|R>TTdK^UbBELk}Xzy5mM z$F-u6X`9OOM%!RqVsYRKF=YC8_{6+_;nw+(z2ND}d$rU(ieyI~tkYNtnOll}c0lHw zOo!J(?;s5zy{s_>FN2zPej=6}5cM!ROueALx$SV@{~WeP9)ok37ce~p6e?~EzhGjo zTX7yy;b~+ zRhx@G5i~MmKqjZv*2QCh?xbtZ%x2VHed>#@L|a)zG#>j99*C4eLfJoIQ0B#lBzFSf z8A*=&*$mgiocWiVq#4qCT$^4sao9x)$#(m7CT>SI+Lh_$rmz08gSO<5!hS@UKdA%n z)oWx*`&Iv{Q1r!06!wPVE0?QebvzgorRkFRiYV2OO369~{a3026u)g*7*wj1Cdo8v zLs=FoRBDu|!zF1Ks^?f4_)Wb$CJ`r$p~JDqx9L~!(CaOCp8G$(6hi%We=CDu9r`}d zukwcM%oHh7yM0WOvCbLLe3J;ce1AT0Tcw};CGI5U*A%aJ&3`=@cd2@FTygZtnL_hHGD?|tb)gT=j^LR`J1L*boITi+m z%2sM{3_zN2<&3XLP}H$7qDF*!r#Hvhawk|wxjeE?ob8q&6ZQj7zA~sp*2?dB97OF% zErdb2H%n`S%K6{uf0aXVE1?Xeau={`y+g7LiY;gRl$hmJs9m0o9I_O84kGKR(<40+ zq#-Hu7fe}zRIw~!^b1PWBJWBhq9l!w*D9v^(GpvpELi7lSM90hDRc2K?>&3O6C>JL zMswy2ddmC(|GOVNbeLq5Wxs2==zmpvxIlTS@qnMU(L|^Zp0FI#{SCoy{_uL^auBo< ztQV=L!z|YtADtCS9x zR4V>n(?VTzfWT3{kZsnq)@WF7x^`jSwqRYm;&lEf_XdSZ6g5)IhWvLaBTn zffx)l;OOpmZ*{uNDQOus5TC6TA)b}ZRXlgnq@!y~-(v04ymsnpzOr%YyOw2Pz_ypq zsxxn>arC#wzLyQN9*?uwKQt$XEkF1fX}NhJJzJ}sy;5@9;g_ebt70@L-(<~@$y3Wk z6~1Es-bjPp2#d~yN4Y$-M%Grc*#Oq8R=s0405&j#LTjkdRTQ_;d3NvW>0y51s^_um zMOZDkcJQ?4Wq$Pb!H~ItpTl_iWVR}KvP>s|*JL*bY0Z&|UB792mm8+1g1-Y7ui=E2 z5V+|(wU43-ie z7!+|=Dy631hID7n(PnDRRqDSA6T1#QjF2SFmZBaa3QLqAO?xD; z^%`erM%5kk(pa%(|EGt#?o$qh`TdJj%ny=Yr9Rva8E|rp)Kw%A)SyAF_h>T(TNavumNTBc~!bFA` zKf%DIr3pU@F}|S-760$Xol75mGGZuXa4+qVA5@We=nz?x*pLDK8QjoG3+xj+9WSb{ z%-t^%cbC_9AU%RefW9>iLt9@(MOjx#eVp1Ake82 zrAec1bQ0gnwgn%##bjvS9`x3DWu*kJ1OXEAgp-kaxMI2|0E$v30xis1Dlt-q+&Ii{ zz$~mkRg84brv-$_%}0Qc?_%LalY8yg)Ks;|p6P8rs#igK>e3jwksHQd$UsDdo|lX0 zMJ!2UfQ*%u(_h=^gT}_fMo}4B!0L>0alw3big9pANA297bcso01@`tV z%dh?3YFFFIpS2A_kWODEKI`+=PRwQ_lmuKd^13&)hn`FV0auyx_i!kxszl^)gMp@h z3?L-Uk!Wf#O7ljxJPZ@s!+=fYwLpvRUT#&$Zo> z;%of*T+p1GD|RX>s6GCX-Tof0N0&d8q<0IwgZ2+YF;riUYu?1^E;Gi{(u&nDT=+!D zPFQ&)7dPsf`JI3OLjV(L$MaUZJEo?{KY`W*v zdzSi@eoce>uVS^F-$NA^;CPnYu^>laBt&sDb#%SQm7`FqS873=0z6TX|MEs&lJnq< zV-W_ZA1~&5!et>uhUz;rJDX^R*N89s@2!t_jtNKRX2jSM@Zc!yTrqvX1^4dt>NaS0 z^j7v}m00QTVD2off6>1(+yen8?p0WXgIsr<=DWy$r*5yN3bsN32fWuO^LJ0Cji}F! zcgj)P^`tOHRLnb%2$oMuBcqrh+C_J!tq_K2h3@Gr?0;y*mkN(ryrey7OMIJi9QU%* zT`U)S&Xwmk(5;agkE>Y}8TK+icjv47({#dEoBuOSZQQj^!#H6P?}ekQ2OF#CW}#ia zQVR@P-V%9yV95&wCPNgu{}_bcP0l8Sdd?7RpKy{^Nj8TK1eQAx-Z`jQ1-0`3(O0X} z>PS+NejwyC{Lk9eyqdMxbmJveyAK`JTXc}Ku8!6HGE%=Wx^VK?<)FZu&P6;*I2CH? zZ+>hLw#d)mD#9$e)J3%LKW^|Ty-75&2%GB8Ni{M}G7J$*0NS0C2rOH!-VS8F5(F$= z>{V7gG5Fd%!6`!{ahdmNi?#}9>A_u)dM}UgH5_xUHa3|Y>b`er2mff9%6-93c-id3 zs{Cq!YxSeAMz-3yI=&LVMyA@ZcX*443fqrWbb@e(0gnO7Ade2?j`$`E-UdBw;rZ7F zhspw*+0hOepsw_g(uk%FOcH&@<*!bRLa-Ab~7_cbdL|3 zj_OS%H1UW$shtP)z?GyXeVt~{MRQ*@axP&H{dKpS2E21P!({{UDcl)Uwg2uL<_T9a z6ysk^RlhGnC>Dsh$cLc|F=b4s`m6S;-WFLWPasbsPfcZXX>m|;QSwpRjhkz^)bQwL z{p`@fgdgm!ZC^G|<2*+6ylc-eJChJ(e{G$4lN>9G%og-m_-#ZSUe!#6%edo1JpN9= zukdq32r!v2d`0h^MDLF}M#@F&j=&cE8D%TLgX0Z1Bb(DdPsRKojU8YM$HTqo9zO%0 z$C)rR%X!O(Y5a1Z=LKruWu>TolA5k8)v7veBSvMoro#--GG-z156mTmhWvR=m3xur z+lX*)iuQ%z44Ydg*Y!z=eW&U{cP2RAuQ5ms1v2`?7FqJJ^q~J0PmcsjKg*$0&Qjg1 z$TY(R#rya!j8#H0WvCfPNx77Od)#sjd2&}BXihMb<4Bxz5flQhiJyncuP{)*3Fi$5 zv+zISnr3LuH1KX z4zAd^8u=cbp-=xRL}c@fpFc>F>0yaK$ZDo7zu2D8$dT0c?AU&Krnv+aLI+1X;_w1elj(sq_>ztkQdxa17TP z#248(`6xzNb*}(Wz{A0eU-KlDT5y z4j1I~B4jrBIQ2klug06PggkW zkeq|9SsD{!<`cr)G>Odjh35(s;IZm2ry_;MahlJA+RD!4!CR0XaQ-tY<6LV?k&^~}$*8ImWF{9bF&zXCRbI$*4 zdV+C|SL2)M(k`T2~!85fCT<1vu5bC z=AMRNhl#Z!Y1UIuV72fu*wE8k_A0;p6qoVT>Y}ytRO2IKP@{J6RMQ}a<1^!2BKd>* ztUT^vVffWU%_H$?!Tk@tg|+2ok^gG)zY&YB6ifCN!qxT9WbKS)=0wKm9-pDc%MF%p z8(BOX=~MqkX?~t$bv0GBzB+rCIy&$-3^~d%hYQ0lPtHGlKmvtv-49K8WqY>qQo$#? zo!+2`RGoIN@Rr}T0mbya;%7u_srZAP^@`+Zh|;B%ok2_vbdz4E=@d7u{htt7IhskD zDa)zuG$aP?EszNlQ;?6)$BEtV-DTbXx(B;eK_SOd*V|QPtP$S%iRmP4NF%Q2l&0Qv zBLzN9X2c_~fI4JDX!x1Jwg`skMfN2KLtO2)bGIIGLt!kjpW(K2JlyZlyKBb+;!lds zEG?inOUH!5OJgd5q`4(M%*ELc%m0}b?4ihb>>W@9yiVKYq&*HP$h;w@6n%)vhk<`& zpQ^}5p(5IWwV@h_K7syYoc;(^U`T|aXulb-sI<|70pRl?LXfew`VEboQNxUVYfkhV zm~bHvQ~mQHYJMl`Ry+w|GC*a*p~HA+h88oJE?}~LorjneAg_SI1bXlL3sKv8Bfb1w z?YQos8MwSx`S=Tkm=~On*-*-Q&H%4GH3Q-yMz(A5IreYPaQ8P9>Wu$0nyDY`44k`jkaHt@WW~-wHY>Oh0_&^(7 zlO2kHF!wSeiySn zrh8DN4&gF}9P(oVaX?8d=nR&j7O(Jk?C-%x1C;!@Aa015(4j~*`iR9~%TTOP6h-I} zBq{M(0jPf;XA`FAO%V|hSRdYSr}nec1F z_RN?_A24*0@==By@u8za_l%rRWm7>?h!ysi5lm2Y{=z!^r$5XTqzhqE_#_W5~%91idgJ)`Az2x%MLTLo%_tKw$RL^^4gfO z9Fj1E(4toRm8$?j82CR$pm!Um!&=~O0JLL&$k3%8k^VCy)Lq0HE*EUuK#EY#o`q1( zK9&B3&=5mJI#FHtC1O{nc1Vo^fnXgYid`Ff`rQlsCE=f^j5UN+qVE{GG49Yq27QR3 zZoN^ZG209+us60XI5&ivQH_^D?5UnaLvKd(yWsZly8-sJ$$vukpjr?e$kwA<0N5K* zckD&7PbiVyMMKvNMNf(EyCwSdmjhb}2qo4*yQDjyd3R9zi@6_r>`>i$@=M)}IEVPJ zv3FUoxps-R!{&2#w4$eaF#9`d0F0YI?ko>T?cFzm+fSj4BLCe`^f&LAEeAhK9*cWH zHj#CX-movny`r55WQA7u&4t_~kEZ=9BMR-uQsL3SP7;cwuh4SLr~m$qr$p>H7Gac=DJzmTp- zvjd+{zCfW-yMmukzhH?9^n+BdNp?B$yMkg+x&mTUtGl1g|A4b*I$`)f_s^tINuakG0{P$PomSS^5lsm zcQMgUrca>LE9y7kDh5WmKUBYi907%|Zw~|R;;*FtHB{dkJDH!bNB4@~8i$!asZOs( zlP4kH8oQZ3p-!(P-{70s&HQ9Ox{vuz;r)xOcq?P){^^U+;Z=C@1p3=`Khr1H>HmUH z!lU~quHvpC?hpRSlPd=WAjRpmEfbjAI>`KFIJy^fQUF4nUU@U;w!X(kI=XM>F7Em+ zj?LtW-S^bczC9fNj{zc_UUj}5zZ0PProXlR_l1wI(<|tA0^jLvXLjZ|z4}a^ym1#_ z9c6w}9^G?(YmRV#$bSbpDgXgauXw<>%y-3kj_$oP=bjuCwuZR9iT)q(;qo2NReZIV z*%{;XDlmCc{XJTg)2mhHoWXaUX^!rHertYLQ~jHI=iI$N{<44legHg$uB$K1;;yH! z|B3}41T#OsK#Nr$w_<3c9;bf^g90+Iy2!(3-uEjPV80XTY65&!3u6UC zUeF=pku4n|UnscpcALXk!(<0k!(=DP|Kj%TS_FbRbdA`-k;Pi$WIn=rD#|+IM=3U8 zoo$groUq=~+7H?H1Smdn8#wqBqd9w*UU>%Wuv}sdj7b@sYT60^!I62u_yG;B0PSyu z(hIopc+MNZBZ8Re2}ULqmhxdUZgAB#$pIn zD(#hk#*n0?Px?@WULB2qE7!#ki49EV&H@(H)xif9&%R>!=@}EtppZk?H@^hlIE;0_ zsQ-!h@Lu|>t6ba8nNWJv+g65IUaDto>-T(2>gey+2cd;}EiuUT>Ep1MV8uLuhAc^p0OeVRXJMRd*?S0NfZCjNB)D1oImW62*y;GKw9 zpe<+7?pS0fH@qN&j9;|MG%k=R-V?@0x70nO_@%9EO%VrH_k??MF7JQyEhd<~I(-qkUkzcBss;;i; z9oW!rYX2&RisZ3UrW+_j$~^JbQI@*j+y<2xIX^}nwON;QkyymP^Q1a25#8TtJc07P zM#3cLB#N`%bpkBF8p+~Wm@07Ih_(>6aJzdfb0c0>@}yLWjHRSV#|a!=Z(9)Bol0wh ze>fl;Jq|W89Y0{lGXPG3)AG+OHv;d^woj9_OG|^ABsD@$L!)&;Q|qq)>ih($K)6h1 zymc}&>1d82$|0i=1pN2_24PWOTuVArq*CF_wf;{AP~>tZd@)b}S%L-HIu&f+YD6ef zqO3@)O5>yiq;14a)2qOg13NOll+RYzOxJGR^nUW!Y?YtG|3GEoT$J-v1;S<+mgz_tUmPHjOgu z3fId1`0!7w7Yy>yaG2%{SWZ8>v%u%^GCeHBcie*S=pnPE>y-{|rQMM|q|6~9I2jl{ zHe0?jp&Y4vLaC5^zmQFTQvJd{$#I2hk!g|nLG43^`%GK4TMe(uU$wvDc;EiMe zhoM$WS-R>jHBt8orIJpRyVg0$M(0yb>f9}q;>6w7OQ_D%M{bjU^q~0b7|RsPe9J0} z%+g1cl7;=(j4tp=zAm58=G)|>KIb0t1FkbYk)*6CbUs~0*U{(betL-hovNtQyPMp8 zUZ0O7(i+`*2`(#(t~q^?o&l*3Opb5k@pzGUm!kDyEBU zU+KKfiTN#t#A;E0zVbx_E=kh4pcN&?z9@+j!CwwgUWTGlD1#N59Ymp|N`Fa3#Xw=p zl+%YvJMnF}YWl|9uyg+doBt9Y_2>^n$<%ohhq;Kn|EDmiCHFpY-J^>;cfI`1`dPDn zv!nmyAaMZuzG*D3@(C!<5;A%h9?1^(=qlCh=Tiw?WsSOjK{HI-7?AB(ll=Ta`BGV1 z+5WP_W#4I(P)2IhtAfjme;3*n+Fkr=@uA?M@Q1};1dfMwBUSl*m?u|blqmxKpg-gf`(+Aw*pQp6L2`-7il!2e z5kr1$WGd09ixu&y#H-I?Y$GNzUu+dzhabMi7C>izG-|2foP%<*abfv0TZtVPA7h_# z&ON!oAX|q_vdY<2+irYhV(spgT^)Dyf4O#A%caHwv;TFcDLXbUFt0@h|Dit9_Z3`>AGB9?(4%{x!t8tI5xW;3-{`_yPnS76M0GV zlJ-5lO$i#J&{LN>V$<7QVSU)pNNy!J=x;JS0fxa)MH-=zjLe%tei4~mIv3`WIdoR; z+{otyTXUCJ)i^``61>$28=+3uCyt-8~6xA_6vqq$E;o-FN??NlAt zexW;VI377(lCRXOBUMmI29?O`RiJZ4WE@00-+dJFBIa52IW=lxL>`s6i(^Ov-jmpW z3MI@MK(#1|#ykO&O{TJj{qi7gK+2q{q%f;sDioVh2Lduw3J=?WqPC)`5Hlg1-+`h` zBTydz|1BW7=S>Nv&7R)vxp5d~_6A$p)-0RdqF`P|KgimLTVH?Tx3A3GlB^v4!M5k; zO;|<-ER~kboY_@Apki#(ZCB2_K6f~O-E!lm2{%61vtaawE7n{(vvb|PW$gjo!8{WQpLLvKYF4~Ffg(TXEcBtJZIN8sha`dx*D%LwUp}8Z0 zQYV?UM#+liW7&G^CM&f*L&D&IKcSV+ZR%5ex5-%4QF4I+X}Qpt^fMC@U16-Imia<5 zZB-W6oUzoVL$%D>yB)3SK4BYJu)N zydKGcmaS3kMRT^oEmj$S{a$~UU+}-;c7~X7i-Ke3wa9JFGdRkac!bM|i;8q!G+^OB zvAKyWGx%Tr-1ru@N$IgmKmPcyW;pwcb0AOR2{9YI)Ul1ST~;y^uZMbaAls7-IbPz) zrdiJle+4@_B|44pSIMrT*&e~D%C_Zzw}W)C-x;WkR0XkWrgU$A9C#xZV;U!(IPtfy zNG$ykSFV2XMG@VAxLb0o3`V0~)Ogh1CcnaJw1_T~%k9o~z_8DIjU&(pR^P%ye_@(ifc+B&I z@q6)yoF6=eYGb3DdeKnFNrD`YCtGdMxYf37yW6IsO1H{t%5qzmdW@n^^kioTOk$R) z1JA>v(O~GKuSzEB!9$40o3j}pJ#l?xhon=9M!{;csZ?rzRdyfwQBoVR4&7{!Ono%o zJH|siee^5I;FAnZhLZ-t@R;w4Zm!)<7iy2gB_cO7n@Yq7@l$D2~eU;Ig{a zQ0$1VMvE!x0PzG7_x>xc7FWKQP$uvn)4JC4Kf7Ac+CuzFPP%9e<7r?ZDJ5ykm@A`} z3QwH*=j6bD;HmxN$2&`hlD`DW!OGULXO3T1nRnG^Uy+yJ9TV}!l;N<^5&yMp@=y1! zxlA4o%ZmMlQ;431&V0o7-vEH@Gx=!nKokbil~Q~XO!BOSHJ-Jl_qiU5Y;|po9Cv*Y z`8=i@1j{4KO7AbZuXJe9S#}=~XS>wee4WUtG6G^jk zQsi!G5<#pQPbP)hsyeE=sy0=rTya-P69}Tx74qacV=@I5Ja*5R(lw#`L+_U=eN|Fb zQ`IzoI!$Pkw<+3`ZSf_Fg|3C}4$q>{!pQQx8x=RZZ}zM!?W%e$_Cf5+(2pT!i^}MA ztNj7d>$drWr6CYxg-{;#hJ--=pu$q2IFMIfuD0dp+3hx3oX0d}eJ;smYF|~(y;|mV z^;XxEv1o7IFz!oPm_B++Hqm(E*))5+Eb1M9R5*ZThz;dtNw!Hw0pYMrkg-IK-c$xM z;*$|P2)`wT3l$a%9bc%!V-})bj~GB*Hi~q-(Z{034V6{Tkhj1O?ZknM8@=>Y6wg;D zPKev=vHPJIR6t3t&O#Ib#IaVIpmID1!d-(vpD{{Pc(Rr=QuRm>#yVy)A8v zC{1Y_gztJvq35?hPx>ToayBdB?9WePQ?XrbV4Q zo}KW*x}nW(y4_Pd`KB4W#)m6{3xs*s`U}I3(9>7XeAuW|R$qU~)sNeLn(uyO>6kml zvHyCPz^K$GawBqeh)}6k?TL{XjR`UD-NySoj~E{@?=(Jb)~Y->da_cu#=6vhcAL;` zdq}w3wN=<7sC9xtMsr38ErL9z5=|jD9t7k&sGE@8&?hwR^xZGd%N9r({I#MeV-7MVp(ds6$l|E;?}23#A~WHQIktT1ym<|4q|k89n`_q!!a^EeH!1_ zqOA+~EylMCI?;ISWcwSQElz!ZR(;~DQ%E_?o_v*y*JpJrba(l)dHk4*l%m)gP=} za^l__Ut8v#*?)3R|5LlVcarKq{CZu1*`4Lm%CG1z-M@2f|2v2J`oCU(-}!jfj>mu8 zeR>}mw`YXS;*PUDKZv{JGGr$k+FpXxqIGL?ZWiwn|18Rvh)c3oi}zaYv%cznHRl~s z;npcxawV;dO&Qp!B-+{-E9O^yV21dg{!x*+7+@7-J@BgD-BD%yM&I z>f@bk4$UKjY%LD0E|-FT#1|wT!A-%#K_Te3^VMkQtI^J<+m5DyPQ=xy;E4(sOH^zK zv}a_%*5VnCXd5nwe#?b&e#upyU1HfTkI^cIvvNJg>L!RIIeE;Hq4_8e%MoRkMJUMA$ zc%XlwFmIKwFx=h$?A!fEpM7U)HW^0j#7XLNn64M#ey|;9yp&W()l&Ja?5ndMh(F=j z8s8H?T&|kn>`-(lSE*L1yA)l@b*go0b;#?^@dv_QchnzLNo+z?euKfQcB_8I4Ia4WM#Hzh%Tv_Eo6VRN(?ibQr`rf=g`Q5Z#q+MMG)mYtoWQg2nM6kDs=DH@cb za*R^Iwmy@Zcw0+~w-!ddMKP>8&$ZQu7R@2I;2zsl-hqcIp&UdmDv?V?1gk0NGl?5ZOu!7DdVw;jqDA zzI=TDyJFs;&lb*(53R{t{L`25c+_Wig~r8YR%66kT9P+IPR|?*7BA}0o0c8S>#vy< zvHM~}SN3mz4ckR&n$UTjCokOp-W5$&Ba^5fCCdJSRS_xJmKWIj%$9B{iIQM$U79PP{v*IF2y>Ou}Y~?7f_{Nr|ToRl3wLj=6Kz9 ze?WmkWhwb`x5B{pPLJ1}>kmc?^E4`*OioeMIQ{m2A_(R}o|s4Tn54szNG`S6Rgq}k zR>&uiAIGCs2cEFjD->QO8KWf6@gv&~sTd4gk_Ij`1DB*B;K|{V%;AYST#`8(ivMNN zox(MjKr5}2pUF^qe``G_JbozSXR>HUdS}l1C_-d7+&zhji428UOoKrao~n@8O05^{ zOK0VOhxz1@@5YbOhr=Y&Q2(7?<1360II}xGF4v*gcu^^Yf9Qj*h8c5FXkRwY?=K%S zD%?L|mfvZ1gu?@T%Y}LAaR0kgTJo5@M&NGqJKSx`NUJnXBO6vsoe@_a6&<3J`YNP~ zwu+^y4o8P`X~BBOdS}v+bZU!YOSG%Cf}^5;*ws|gQE{v6N!j5FnNGM_ySG9Zp+dPh z{uwYcsRhgU{?p6%AJU5!V53ww;Qm6p!x2#A6$*yDfSN?T9vz!`51(X@f=#j~U@|qC z*PE%)JjP5Jcdjz0%rdi#NyCf;dSp8%&_4RTq}3#va)~k5n@iCUIw^^)nOu?O=Z-9Y zpWdC36%rz@vsjdiic9SXKQ1yUiD!4J3`>^zqDoN}&Wq$n3L=6+hlYsJZyHQ|UeTnC zYKlM~L=b(3!Jv*PiikFBD9Rk5nPtwe+W8h1=4*=a9*B`-UUVjs8c+5R(st2^)hXIJB`HQt)bsor^MPS(Q1Yx}Q${k{n^ zd+ypdYT5ij7K>ZJEpFVV%ND=!yu?a$3E3t!paKD6reAHM7T?SIUf z=*YJQOHuM{w|fXzY6H1CeIk5%xWpz6!hNZ4cQA>B%lcBMB{K__aosQDA}X_gU;)X( zk}V{_Wf$Pma@Nk)B_=aq$q6vc(HBRdf z1ibESf1u3kF7^i+yzZg?0QI_mHU6N*>vsEtxN#KugXLcL5PuM7AQ%d{hYlH{)oN&Q zQBiibTV=Kcs1zWF0>l@H2RZ_q0tW(z1ByT&^+_&qc-!#3!v)`PGQ1%iC~qojE2Cu_ zhP8j>h+ZO|TEM=t6+0JjGT>j{W=?7Nq^aPnRhqt`UcP){7r*~Mr-Mut zvY9SH9*D-{w4ReU5}y z!0B}pe^BjpoBTnu35i;N<#1A_HBJ@N5~qw+bq3TOsxH-Gm5@@AxT;CjrV^&8_Nor3 z1eJ^xQ*jMc^`*Yw&gx>IU&`SIK)bKQ-{n8-7vlaVf16*}>p$S9OemM4BsfjuqVHUg z;c8CMX(=!a|0nZ$RuXjS&!!G1l}~B-B0go|(|7VPn;|^s$`9gy4As%3)OU^HSp%I1 zWECu?*BF+>mz6KCcuuohueuV5S=LaD(^Wyo(;2jju9eo)`=nm|cEj${-F1J~zgMC+ zYl&c>3MwzT1y+}AfURVc;jI#t7Oixka-CQ0(HB6N#MIU5G3s04<+AtT>oTKS>(s_c zIW3iHrKW~Q$s=@sv$T`$)Ff-)fREq+d569$dWvYJWB@XN~*U2xo zVrLR=sZya=x)p3k@CRaEcb-3xs2So;$YnCO+{kwbuh$)a@dpQ&Rk;TffPg`tg@$tt z0J}sP7ca|-$IF1|%WC8eai}SiRp|+3eweyRJpYu5j254!giXKXZM9yUF>Rn@pqy$pcMu=v+|OEU9CqMK!V7qB>b? zOKY@la8)eE)~w>i zX)aQHjk6LbuS&;^4q^b6-Qd*c8S{+=vbfSbgbazbIOdbtjw@r!9QTm>WBVK*IF6Bj zFCBWl0}tkk_^`N8;i!lYcL=t4#E}~p6b^aZZWp4EkFmi}Wv_IUJImwMC1Xlv!*W>S zSms<5?}oLGo8tGuJ@F^t(fFp4WXbFHR~>sxKC-{>I8buJ{)OWU=i!oX;Ya&-@$d*T z(mpIUiL}@!#OB(UI$w6Y6o1$8Zv3c!<7nKFzA^K8-7bHin6n7(=_-FPeTU}f48lxG zAX(sW0&zMVj6R0OV_9*BJsxw!NDRkrcR8JQs%C$qD;|&Jsp7xDeasmv4)}cjP5z{x z?Hh;v3jYSFgp?4%2+=NG_$zVn?3t~2Bvbg zDsw5T!X?cDj`Mpz?na%sf?L^wb;rakT{TIASm|(>DjlM^5>$>#dtd6n4tu3No>iIt z;+wk`(h9A9zAi6bmCTqVr%Pq*McmpYpI0#6U4 zAwr&)8oSNJyp9kmjVWJ8i8+Uo2raS>D zoL#lZ<+yIo-Kk&#hCgGrU3FU4Cr+$Riy82USII@J6cg-d&geN$ZFZXTNi|fO$G|A_ z6qsb54|C1S%@2?#$R4tP!@Q6DNX&nygq;#v0MCJ)b?mVz#J?3i4u6L2m@wjtr zCn}YcUCDwy8PCnVoz6PQFb+1rd&uYWeVog_%z>)S@Ie!Tyg{_VYMNCBxKleesYVfT>iTaqZZuM5f2T~Lg# z`s=FlSn*=VBKM-~6?q-ScV#P=Ii3#f&il~)VfF_hg)<@+=jB$0DD99b0QtZ zUB%j$fw;2svm3MDbAITSKb}Wk3%zguAoPCZVBVJ@MYa^o$x|5^l?I5{t@H*}kz`l`OGkLqLkoayeF>B*3;A@@ZFa?KQ!|e z-}@?)y1d~IjE=0_KdY-w@G)bS-OT0HDF;wImJP-2A z2sKWbs7rX>#^mC?QCG=DQ!dG+y2>uyWp*vgv@j^6XXs3zSF))#+F^^@Xxp;%|AaxO zz;82z@u;^kEuArNNf%P87D`#HqLpS9Et${~G#mBA3n(lEF!DI?D&@qRF?XbZ?<#1; zjllbV?cM@P$aqB}hFU>GZ4jl{3=uJd6bf|;o6)&|Yit@PI9P3R{2+UT|Fw)hR&ooJVOf8j~=q;@p* z&BEEFhgEMycPDR6KbU+NeVu+Jxxesy;b)V+V>=)lv`TYr*@uZS+y|G-NnAfS%rO(( zK91(7;5S0mN%T3B8Dv2c%e4<3BkIuytfbNq*hX@s7DJP4WFi7oV3Uw!9}M)T(U{>+ zBK%b&VSSUkWHW!_Y^|c&B2p-|vPOsl5#G`7e|BQe*PcYm@SR)VzrYm|zWu`9TY4_1 zZ=?~L-S$Be(Rlp&9h0fqn{FSl()XgrKC^SL3+xNyXMbffV>;1IZ_xen7xKt~9JGa@ z9HtDFHRo2N)wJO3nM8~Albzk20VZhLtZepg4r~sxW}AQ6PPI+-n69&2XS>e6%`p-g ziH?*;%Deg7ExT;H?6*30iC{wY`{|>N(xxzKHJ*Qd{ZZe)KY; z(N5I#V(PZqgYBVUcxyBmi98dAk*fbeHzppvR=eA3wdbsDc2i0q4VyqSSOdzmGl>j% zH<2ERR}qSWQynFAspNd#Nx$Yqs&l{dH7Dboq<4QEjeaANlOTQ;Pl)a~(BrtX|3)vIpT?KEvM) z>b~93^IMi@(i=k3=ya2`b|%Z5E0eP1g$k8*08?|}6<5ZaV!>LWEY^H3EnybtuxHye z8MA*mzQh8|8zyM7YQ^1Qm0@fM>;;!wuC#qbx;zK=0)%-iHA)dJ#A;C-byL|>~@$LG3w(z9Rx{L0t=<(hx(-M&Cf#1c_%*S^bkUOd0DV#k#qzxUz? zUlYuYND2M>J)axCbz{es`N(&!yL;_D|55WtO91)vv21jJ$VPwEdp4qt^v3YU$j8vf z=#Paz7U4^=Mr?KLe)E07$IOoeIU0o{UeM{|0#MHcrzEH-EjjquBt50O1eBw6pS^z} zJMiiHsr{H=PSP1Yzzc-V3528xgw6?ZpEsI|0DZK>5mZEqY>w=Um?F>68OnS19o+&{ z&`ao_7oYuUb<2?9>^n0A1TTUKtfdAgIB0QH@dM7Cl6srYBX~2EZmHp=wd)Nc>VU}@ zN#6tiIcR-`4nt}p9!x)<{!5DOwHx-|Xf)`L#oK>~{nrIX zzywy!F`uHfj7@06I@%u(!BfMXH;4j9I`9Oups7iM!0XmJuVW#FFY`2y)jQqkb_4Gr ze269HUr_oC12MVMg^ik2MkD2YCbsCp8nx4-zck#ARMK-Ht7$q+;i1!KVF47jybJq3!`99w?f;h)jkP8GhFQB8%qObmIVN=d3}&v5_MoPi=sJJ zc+ZD?zb$)p?}YcX*W`V(?9n~_o&%oK9<%Bh_KbMOJtog2{q_+x_Qe=P{$b)VOa5i^ z>9)(di)aw(rJhA*t9hkni?v_z-lt5T+vtua%$gdvOzP7Hlu;GolVNGJzQ7MZs26u1k0^#%dNIZ*Tqtc|ns94 zw$90R#Z|ZBB?y4X3)LXR&*3(NTm4Pk=@e?E<-(w8KzLMOQ*4gUTQb&+D-*~D+cN3) zPPQJXmY0993%M1RrNOoA05`x7iUZbxz(9Fz`_=3g?i$NgfvbWat86oEW4CeJ#2YL( zS#Jv55Zn>ELA}0oo9S-;&d?pDJIcG;@8KS>eBSkW<$=Kc!Fw}bDBW9rjDJFS!tzAm zvEbvOC&G`Gp5~tBkBXClL*?(5|H}W>@_zWQ>hgc9N>`MxYTqrGx`Wq5wnjfuFkQi2 z!CxgXD}Ebfe&-L>gEsTkyL@Z{7yrs5KHrmeBEiHFWn3Cu91j|Cm zWN{i#HYoF)1zGrdS_ZJkaNkP+|AiOkqRE4LUI>MFK@dY&?utZsip7ZF3b=!=Oeq`8 z$X0)RmUJW)OxN4HgZ0U?BTok{qB?nYtL`rIoNBdL;z2w+7zl+Tf+!M0Trh+OLZvXz z$H7utF15292YW*0cD&i{lGB+CR`My@BEnZtgn3_PA8yC*?4Vw2Hv%F_fMcpqu9n-! z+b7zY)$NjWBfUR|;L>&{viXHn54wT+WXvo_p?s;`Q7=jEy40uV^ggB!0Ao)yQQbz};Jh(D zlDo0+VElo^Bj^$7@z~?>#}khf9xpwccvgEh^-TAX#!J!*!57q*>Qj9`m4AP#{?&52 zFC>>FRgSC4T&7qmT_Ba^vN|u;nJ(v+P*_dxQ~Sz&C;Ln<7SMHtn@hLlc9%>Ga)Z{v z7$YS73Ge(y--^J3G%LG{C|SHB_HgXsqN$02aZ{jA&pJ~@+DXNVrl1CoA{bx;JUohE zsyo&6sJ`$*vw?@u;z28lY6*W8Vrof>JEgeXpin_>uo4$!11dgCx{$$0*yst?&Bzoq z`(-8QPsQP^rLJIiAudUARB$6yz?4%aUJ|wBR@G85=A=wyh2r(@Zit%-`28$v=C5j? zMvg*Q#Z*xlU5bX$2s(hK(Cg?l64506H{G#NU88PM8MT9o?~Bv%N&0^~NA$igwh-&g z5LSgS3p+m`qM20$iV(phdlRMpA@n(a?ZAJ7U~tD$^g;Y&Fk%2Iq0t2cM@lFgFU@DL zt^*SG)v+zPt)<~U;wwd1_aRv3xH5fpH{Awa(}ZLLEBTwc%UVw;mUfFJL+kp0nFm8dX^+~*Xqs6H3~WO8qFsA0$6HJ>q%E2K9%}E*cs!EFiSUrachS{= z_b!b0j}yJ(r-#fGl8J==Sfi$wFH@IFshCv)1M212bO{u{sl_>@(Lp6*j;b0`0QhYwF z=DIQXb36~|5l?6ERz^wrN*S)qXSj4qF-Ii?U*Cv;D(QdoPM-Z62}$v`{7}%*9Yhn1 z>%2e{H4={(-UbfJxSmHbP15g56Q~`tYh>BlygBV zb9e)U0G3^*rYLA?vL7VZTcHEzM-Gs6Gq<)U)su$Y+NK{83;<{h<%nI(3}h4|0?GiV zft3OvYz2S05E=mJr>yl>su+lbgu7ra^!NV8)c?SHu&Qzr{X7uZa!K#(u~6!g{LB<+ zsIzxpSX%B*(F-G`)fb>35_`j)otW1Y*MDecX7(E`brto|-CH^mqNe5Z$;)O}ps!w5 z4CVb`tzC9@n%T|lr#h$$m}SlECbdB#k{UX^8Bc$ZD{8#O0ybP2)hKJlz*(7ISMkCW zy!}g}j8@>~dEk{*$lOYuBP~}T4i8nphZHMR#FWjKt5#jWC$;L~Fsz+;mv!>&PxJ^( zvRX|$6{L_+h0IVSEyDHYO;l;RF^y$~A-PVX+fI~b;C22acLJ601|b1cQ?KT7$EBZ~ zfG~fhpuW`-y0b#dYdVpvM(g8^$AlvyBj@BD)Q-yS)LoXlYHV2c_DGHKhDivmG_PbA zsf*$(d-TTcFfZCUm5MJzE5v1%WwjMu3woAau)*>X%WcA~;;k0PTJJ4hI@;LWpojSi zRqZWi3)N?_cn4*urj7`8YsONy5^q6IO~QY&6Ac2?u$56sv(0L<_A20h%v$QJmCedl zg()dJ6aRKzX5h# zq&Z@*cd2&ZGJvTnNJJLQom5NRhnEmQd%%Ju(U>r^a%v+|SM~!=%l6eD1l7M2HLWka%;5K=&91a$q|oW0!wk@=wXm z3pU>r$^PJ-4Qm=&iY}$J(t*7(39@mu|+GfA+nzr?@*Oc zn;p3dm5=2VA9yb4#xlxc z3`5H?_lTiCALLD_#Xso42NG@w4`98TL*RyEBQY9`StLk07RD6+kjqW4!=3LR0ge)G zXE2G!{@OhI1u7KV%}yR zr^aK4utIWDeVu>$jaleIOVD~{U1)P+SQ!p&Q^rDf%Aa*jI46`x(AVkxiKo%G(094- z`rqPDg?^`=K?+MRmp90FMekC_6Q>iLQ$^oA`#PoKC5j0K6{dgymoZ!n$Hrqc6_a8r z37s8@O`I1AbvkB?T^WAOfgIoUY62Gq$<vE_$GfXu^&dQXti~Zm9~~75;HeU zjZhQR0cwhRof2Sxrk=Pqa7%#h51_pP6qrO-T|Uhsij`QSERvaB5MOYN{+!`HfgG}- zvC)~)p;My-ta7==^zB5wqG|dbu zPg$oBgrm?DCBbK=lhk`51tCY^&i9l0do?j@!NXW^+{c-?drV(79W*iUQyjiEz{C`Q zv)dhw;QNFw1>e6VcZ(aWHQ^zdayYz4A*R5wnH-C~t6nB!NN1=sh2f-x=IF{RCa#Llm2QJkm z*X7Ngot}Tap4U7kk0P=z zv>n;uN(B5Y?F%9cnvx4v0ane7g4i+&q59KU&L@9`L&gB4a$`>XimwZ*Ij;td-typ`uW?4`@s`E z1Icdv(^wu_O;OB^=DVpJ%{Q@ID-eEF(1Gm~h+ZAcA<51n-kwD~iSU#0v;Lhf1A^LR zg8D|NAN!1v@1=`;Qj7Q~%8_+UqToT9g(`m{(^Jw^ftP##Ao8Oh#(?j0Rs_{tI1{jOt%nhB;$Dd7ev0c+Y9*?3wjk+_~%cY zFrq?(`uw}p2Rsj?n1#$j>r(%1%xzZlgCn`C%BnuzR;JRhMW&ZOo;xqhttmfNzjljS*4!T>&rE_r$nR(L1r zcMqbr+$558TPBNShf})8;Xp|M)~APutEBDeG1^AMXp`-v)xDuub;6DS#5dbV>{IrW zcGm9CKf|yL*9<^0fO6F|23?}r_Tqo$jiFOx#D>({J2TeXn8BKDsTnybYiYMPrFl}C zHxr`L?qmr4UCa~~lFl>lfZI7yt6&wdSrQ2N5D}QL=I5z+&?6yj{+gLrvzZJ12M-P$ z9=&>?ryB89mPezhq8@sOSvm8_cs!p>W)^;!-ng`P_rG1gu+SZ;#XjzGwSRx)l?#_b zosbJ=7c>6{%jEN@Wz-;ZpZ*!y+kao`flh`hNSo+wZQIt+R2y4lFS$!KHM&-B+S+w} zYGf1C*1E-atFotd=lok1?OAdA>M!`dpggd8(sayx$ahHjUiEt`rZ%12^!ldLn}Pw= zQ;}-!&gdrdqx|yDMv(F{ow0xALCU{ChB7WTNHY>#F1NssYe?3>J|ts4q`~WOTN}{o z7TMC+tL@jG*BEUQefjV}ZafC=?_cURm@Ds%?TZuKu0OMcYvANPOL{^#f)Q!GZV zRa7tDC9<6VVsvpn?^yM3Od0dL2wvBzRZLlrN@cXQyr;ak%#;=2uVpKsM7dTkGUIE} zTDUhG##Y?<{vpXtI=>{gn6*Y=JVvCoS~P=5(5TlJsP4(2)tQmZROV#Hl(ECiOw0O- zJHOXuAQ+kJ)lKD1`lf$<_?eqG!J#3GwYtf^=ZlNcVq(Qv+^%|&!#m=A858@-vwzZ^ zB#Oogf`OM@qj!>iPIo=fK#le?)6dZT41z##nt?~@4_8Tx&&t5hgP07Rqi~PR)f+cG zgKofjo%qyla72*k4Xjm+&5+J?ZtRql8zo`=qdB8Y$*6RSqzZpyiqvEZGj9NkXh=|C z3$pabB$$sUV=i&%<=AU68uN*wJKVu zEDoV{=?x*YenWq_Cy1v9=TR%$m#b*S@>-`(FHj*;%G4V|7nLp!QERdntJEUjf{;;- ztrZ>CTz&9MRBfb88z4VP1{)=;O&5z2hS8cNgRSZGQ*tv#tQGr35|%+vXA_C04rTZ$ z$iJor-^y<8B1fUQ@?oU38+-m1-mb0Pcw*lz!{5%?8P$VjZXN}uj&DD`-`Id#%{*@nIRGIxtsob;WxkFD@st^7OU6lR&;2pC%kSCH(Wxlfg~H|0_GscVde^oazr5kXu^abp zyzu=`R|bEya&rF8rB$!jgqc2N!^G*our}98?`iVJaJLSKD~V2#FhWsD!nQ&J!4$Ca z08S`ik0TnMVh12qQot>vFp!E>Yv}@tnXFcNU5uO~R#4y^1#m3DDDJ#VOjd;!j^WNb zx`Qxfa=rq>T3DZmS*?s04KEqIq^T+dP1J}TtJZ%>rJdot39MM966k^?zZwH&Qy(Nk zt91Ou4(WK#7&(Cz#N+4bh67a@P_jnW_!rYvd{Q{2Gc6MKD-xC~61FThEnQ@&Y5P*T zyHJb_$H;Ju49D=@oF>!;cm8w;cHqwYM`2%~(B0MK+JtF0`zJu?!gpa<$4Ch^u#%U$ z^|pVS*gcHpW{2iTjdxFUn+|kOb)W2JaxCia9_}82A-x-^ypoMLCmDzCj2E(z^zyiv zjY!KAv1}wY$=LN`qLwc9RU@^9NKJQAUXPEyRvNDv1J^!!Be=|-=!UT@Z? zZ8B$fAY|rQEtm?K{UOBh0WJ*exoIgQhGD250d@>$r%^YcnKNkcY7(VvL~Rn)5b`>W ziXcsm5v|(#nZAogf-bvQ)@SE?^bV1UE-bfybh)R#c(&()gj;b$1D=u{$>z__eE5IH zMe8rspP2pT22}|`Y`%06TKL7wO4Ze~q05TVWYQ&euV*eWv`6sF^x_qV@x?;L>85Aq z7?s3~AWX_P*a*1WV#JaWBSH2tm%<2`gAiISK#CV}nt>MBbff*~2+S62N{iy-&aV$O z(e3pXy1jCkV4Di&5Z~(9*4R$WhU1eZh7%VROw>;dNv{qyEhL5~<^)CwOfz#(gm#lp zhA08MlX!+G0qT>XhF<~4lL3b!X^o%*DfDKMOm0+uG*M#%9#@bqvUX z-gW3hU&yO|M{)#1h?AmBRt&XW%=43shZ_N#lcGi+bh(qz`pzyY<+oZ5 zF9-AMBZAdNaEJNzQzA>s{pOl1U?w*;HFeIN(WJ63Vwi_uruK3(9swZgn4=!8(=sa| zWu0YI)KS;=MH+_g?#_XsQ(!=lkVb}Xqy=gC(=~KSBPlH@($d`mQqnP$v^1~J^L}~O zeVNT`>%XPDE~_7x^7(z%5oy@f_2IB}A0ICVdlc zR-`KoZ)Td+^fkI^e1z^o2Vs{0EZ%;P&Z=|6kv-0?d8v%gGd6lb;)ZaQwLB|}bFNLZ zxzDHg<36E%^}m_%R8we!R5ST37Xo`T`_17l@aL~~*O(?8l<|sW(`4cX@Y#)e)GBkO zK3eMq{zFxVvCtXAJwviXudv>veaco6FYN=Js18Eq*o>MDTaN~kcP>4^3-0=-#<>`v zbvQdpnN1HRfxt0zNWK=|>q)V;)}YEOe@i8d14%?Ycz7_U4UGspAa`4~QQNbH8GzuQ zk%5bp2cd>hQ9o>Fq9;7czmg)1UZ=6c-y|o$|5?pw7-unIqS#2qK&kbsh}TMG7FRQw zxDH07EeKx z#+_DHs3R#mb2;`1g_z{9&-8Dc+%dOqAbv6B)4%gBvc$iLwGM?BgNNME?gyv#edbh4 z3yL%7oGBCxL81n|%o`Hddfx;+*d<@tZ~pOlh0$iV<`&PS3mO0vyUk?gK|qlr2h+W7 zkKNY5j144o$EH2(BgmTq9kW}^t{nE+ZJtJvi5%zqm;4X&(>@Fk#l##UX7wmPrdI;g zdyItkCAxEjO%+{U9=Tg-veJ58O)DdVTKf&3{M-K=H_K4-u{~bck`;$!F0S3dD{bI# zB3gKF4Vt8rIx~T zAq+Hy<(MogQ1|4SaU(oFX}krN{qt> zTcXS9a6?5oix? zayI&E1elQA;x2vjxV}$3IsA)rujo(I8Q{%mJFfVB$1OFk7NIaY9?chR3B_V@n%}jL zH49&AKLEl=u3*!(AN$13S8b)7gkX5Sla}HUr*r#KgEqB2@>O(UqyC8vjr3crz{g?7 zB2Cb*A{F{A1@#NtwL{n%4XaVuG@YTvkaQTl*4jpxeV9H1)nEP3@K`u#How`)5@2OQhmn*@nd*B$z9hNiHS}rQ17i6_UNmV z`ePHf>=DJG;ah_`&>gwvaV0f)r0-dqF!)&7QztupL_gnp|7NLcGPj7x<_Lz z@##>EIc(*LLJe578VIbD1E1fvb5Yq3(yS7iX2x;9qxG_3lCC15QQ59fI%l?&08;ly z6-l?^rDf`PJ1Sh9tXAcumzz|++6qec+rOE22_h@nsV)q+RI_m&-n_2gBtj494BA#5 z7~!PU#QR~3^H$Bv!y4XV<<){6_wN(e!Zx$9w)gU;A9hCeE1q;OZz`g7Ax$cV(61r% zs?E)<@4d}jlYd9~%&S`yI<>@EB>xf&YyN8u?hJ*&) zeb9>Gt4G*&k8awPh@bTNBFU(trAhWLpKiym4klx4Ss{q4riAKZdyUD>Mc_K^BU~)q zboCuf`?UFMM()Bs20n$zvFr);;{>Tvh12LRm0p#>g8RkMx2p=WN?U1;jUy$mc;c%i ztvAk|sMCx5`mHDlO@|x)3stt3w)~l(30Nd=8y}s+NUvUu#gmNcFy|#TOC^Dd9_zVl zThh{`L^~!uCiIs|SjxM+M4;H_idPQLn-3fhY1pm;=pgne>ptCq86gN0PE}mo6r%89 zj-GcGRKtYbV#|by4G~d_;(vq%|K+iWHlnym3RA4prN3>0hdeqI&rVj3no z875NcCaUQ6i@sQS6VWaS^66;eBw-cowW3$`j2Mn1eD;MKSp{eOh;{s?_o$@CVjz56 zj&Ks{M7uGqxmt*DU}}oaYB7@&MQbYyOk zoUmoO-idYPdAgJSz%LE^B+OKIjjOe3}}{(v%e$XYnKwncggj%oa9-U}Xj} z4@4MC4ln74zJ=JW=`riuo7?tocR5+q>YEWMt{Tk_&o}o#c*BK}FBEcBeYY(Pr@^1@ z_`XWuw6Ss7tY7t~!^iVJqAcG)mAZ18%_}z0Mp$wi$5Itmk6InzZU5plc0l2t*d4T$ z8HzPK&srK@OKuldO5ipzgBv?~bzzwPyCayEYArmo&zA(xl)8t`WV)R)FrM;p( z>kR5-qsDtSGTT{;u`90~YU_5VYK8qezVS(fAJ7O9xjFrbD!PKIsQICvx=33dOst(qV4&4L1G3PjC@w z>o{&d&i96%!vn#4^zmr|8!Wz_SO)7M!7f@zrJ(|v&ZS#Ci0XBp>!fvx4zbngh~-&%>RPP6T5ijg(xxc5%DhY-8_i?y z>Jqp*irb94rrM!uU*KAZyea5rV8Vl8C{Os}^U?A*z(9f$BXJtV9(O+$cGI(W zKV*sDmM1v*`Rt8~1X>N^E&P=B-1t4|zpt&&XMPR%EIeiZrUPzjfZLy@GK&j0=i_|i zPaoF2CRU_CN&m{j#uJjE<~(Y12ydeK`V@_19;DcmfMi-i^bpQ3|H>ccJOT8=2=Y0% z>&KMpP-&_j5iUr|_k4AyucqQd9tA0?$p<9{M3WlF1de91QAG*h|%Z zzdY!oBfjeEmv&g<5Uk?#qjv#&B}HDbl6CEZvm2FPGjtz~?LR50C=lc5qTUZKIA#K8 zC3mtdsa6M;Umc&PgqokM?h0~gmCUcJM>z@D&us12di=d>tA2S+NY@EX3%X9H4F*d3 zCNToq5&99*G3H{SxXqhMOBl=zn)!li3Q>)OP_^(w|3~JfWa&bl76vSS`SwK3LTPC9 zX95;q%*-fe#k0Ha?b5d#po!}_L^UGUo;7!am@D+v0m?qZtO53|OFgndatU6m4xwu+ zv9xDpt@dYB|CizY`YJybl`lcx2f7Gc<3oVoXkirM%%u#JPNR9Yk;(BX84(3y>U2Mw zEf|)kUwMgo7<%~+^dX$=+^J$-aub$6T`P!JUzac|*5FW{lRV?D9)MwMl(qiEr)F@}uZ4l21u;Ly0o!B?19v3h4MmP>o z!xPKS{l)0R`EA32Tc5k%3GNs+~mIt_l5#<+OLx$Yhi3Zqv9LTLWfl z(38Vxa(mKHOc_XHM9t4h475l&PNM(@$3!yi8|DXiVn6dF9Wr_-r0`(WoND;K_}sry z=7HiZkt8%L06}<^6e%ynQysfSsZoVM#RL7z7--lsamMW~suKV1*}vmGNcWYtEay6T zbvW=-ex^gYVJMmcEMY`Z9;-2S?dqyUeAh~<>89i#(Y^Bw@ zFF1mRDIODj>)-5{RvDU8vLeaN3%^;rjA9RP;u`cz{wvP8;GbXg8WWK#dhrQ7(HO@k z2BxOWI>K6>yBjdPhS>}z6Y>0#1nT$F;=1cYqe>9PM)A2M~*n7Ls`9?b}h}J~zKOON+i@q#a2Cpk=UMG?d zdbIKL7nD2Kn;z2iIWvFx+lqrbYelE7TWTDzJF5_|hUYr(T~qWuTS2 z;hIO?6fD>iLSfQaM%thE)BmPwfP*KBEe~t@R0n@8oRU5e{(_+HCF69Ub)H5!%DK*b z?P{sjY10qlmYwKG++eA9>cE$Y=84TTg(|t)te3KmX7tP<=IfbtvW*J-V5)i@GL5s48^;@Xws2wkX4ZKjA;}?Ti+Bza2lAu)3wBEHoxwY&Nt35_`#@@&T>HHHvYU_&jN$z-ZLiVw<*c9e>oxh-W@boy~hA zW0VH$0&&WJ3@~3FhwH`d${WAYTr*?(dq#28woTUAi-x8=YN?&B-RbCG)dlPX|_s3?}%9NMqos&?oEQ z%3ENU4!@JwoBzAWljs%sbM2|_vp#YH>T{e7H#I>5yVBz%N*<1SKTy%m)mhn2#(qTd zHmA=Gq_3RqAhPs&-tH4Oc*$eQjtH~pqquVA;nUkWg04(TdCSYFTbrxd-Q^s=O*uSM zl1de+8%7C|d*EGAoBT@k(Yc`UxmLI*$4L|%tAap zu&ma)Tf&|}!*HKv(in?nU9<&qAY34t-*1VVQCT&{ub*jCL!sfjJjP4>H{!6RLAos< ztj;TPy-WJV@E|A4`r*eR-2#ezWyua2A-i}(hgAOXIiN)O@_~ROeqd{0_D92KsZCd1 zOId?QEnf7strxxo8JfR?8hv+E%_x_^*1o*uCRu0)t%r1Fl~%+K6i&)0D3@`*Dv{7R z2M4pwt6j|%EM@Gl&i42cVgk8m1^rz8x{Q!dr3sW21P|39pHHLgtBL$7B8i-D-u~#1 zzK)!EHwkE%o}Hz8lk8NSDA-*u9vy*QSPzcOPUf`U7fO!Kd^@Q%b~S*EZ^v>6KL3qv zX<){b+#j&j$iy>u92R8D`js35&G8h+DL0e8Fh@5G0bV5=Q6aGVJI z407crbfdRqjp1bj?R*fv|IS~r&tnJYLB_0_D>PoDrb=$7wS;&a6Hi(KL-Y?L+^BJ6c^@wKLLcuEjJHwQ7aR@752=+nbjaV--g< zE8hXg$phPQ{20yR*=FcW2md=iJ@HbSQAtyOWj~G!_v5|Hlzw(=VYjNmZ6XLSkJT^7 z@n%`W^&=6}o@#yG;gfGiNhfbT@4eVgrcPeRkp;AcEeEt|#j24j7&l#+TeVT9I$ z^_aUM$zdekX@%zanm&@KOy%d?ckCsalD-OFRv!L!!&U=@oqxW|^@-1EN0ydx)dQGO zs(<&pwYunzFN*da`0h=6b^hd8VHSCvmK{tbhMD>bGQ#{wm33my%|Oiu7WVE~h;p|Z zMIzt5#9Aif&HQe=2}?H>opKQ6WKM*Or}^&$yz!&0sKrVd_`pV`v6kNW!6Ncv`Oz@< zCmP-{WwqJ$zZdAGw(903wvExt-T-?L`l<7d&I`C!ZKHG+CI6nB&Ucy7KP~PXB6iu5@VwbRWNrlcCH&N7`r&r+M;umC7(fm61`3@^nInw); z4pZJk^V)gta~7bHY3@5YEGY`BBIxU^W%h1zkG_ZjFqQO^oUXFpznfhn;xP z^b1?r0;!MVNBK>QreSSa9{sV+D-{|@+tg0UrG)2bc?v8RN_Gy$zu7qh0n@fziEGU#s_{YoKA|; zFm`_%l<1DGC8wp1rq$y7lVc&|&30v2Wnbl^J{m8cNm^I%8m}|(7Z7kYK8<*Ac58kP zJP6$A{6XeEsl`^=WlltX;ojm8%Z|d3xkM%!_kv{F#ppi<%eJU_Y+>FS#n(<6QAro` z&}S$}C%|L|Y^A5Iii=%iX-u73Q_CW0bo2Sv(Q`m21k(9YUa zSh>*!vR?H_(}T|q5{Ye&JB#g;3ww}au>S6oNQ9Cot)GcCW+GWzqGs<{Ox`6iR^5WS zsF-w~ypy3K!9#=B$CEDa-y=02s`3b!-XsS!DA9nswkrk9@YN${;WiReYxNZGYJc&+ z(XqH5xX=H793OuBEoK1>xbi)EG-lMQ=*8SUBW-cp-ZnssFi~F8tEIgC(g~K5+ERUE zwh;w5Qr#$%Jw`fARzW1NBqJNQOJKWAwlqe zFbG%(BJf{KL{#KInE*ueKd*-f@`Hu`S10m+ViFYkuV91(MTGyq@c-x_U_nUAj|F)w PVXzn$3ky_35$pc}gCu9b diff --git a/cicecore/cicedyn/dynamics/ice_dyn_core1d.F90 b/cicecore/cicedyn/dynamics/ice_dyn_core1d.F90 index f3f71b490..b95d2be67 100644 --- a/cicecore/cicedyn/dynamics/ice_dyn_core1d.F90 +++ b/cicecore/cicedyn/dynamics/ice_dyn_core1d.F90 @@ -1,5 +1,5 @@ !=============================================================================== -! Copyright (C) 2023, Intel Corporation +! Copyright (C) 2024, Intel Corporation ! Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: ! 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. ! 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. diff --git a/cicecore/drivers/direct/hadgem3/CICE.F90 b/cicecore/drivers/direct/hadgem3/CICE.F90 index fac02de9b..2cdac546a 100644 --- a/cicecore/drivers/direct/hadgem3/CICE.F90 +++ b/cicecore/drivers/direct/hadgem3/CICE.F90 @@ -1,8 +1,8 @@ !======================================================================= -! Copyright (c) 2023, Triad National Security, LLC +! Copyright (c) 2024, Triad National Security, LLC ! All rights reserved. ! -! Copyright 2023. Triad National Security, LLC. This software was +! Copyright 2024. Triad National Security, LLC. This software was ! produced under U.S. Government contract DE-AC52-06NA25396 for Los ! Alamos National Laboratory (LANL), which is operated by Triad ! National Security, LLC for the U.S. Department of Energy. The U.S. diff --git a/cicecore/drivers/mct/cesm1/CICE_copyright.txt b/cicecore/drivers/mct/cesm1/CICE_copyright.txt index af2afdf3d..3f81ec782 100644 --- a/cicecore/drivers/mct/cesm1/CICE_copyright.txt +++ b/cicecore/drivers/mct/cesm1/CICE_copyright.txt @@ -1,7 +1,7 @@ -! Copyright (c) 2023, Triad National Security, LLC +! Copyright (c) 2024, Triad National Security, LLC ! All rights reserved. ! -! Copyright 2023. Triad National Security, LLC. This software was +! Copyright 2024. Triad National Security, LLC. This software was ! produced under U.S. Government contract DE-AC52-06NA25396 for Los ! Alamos National Laboratory (LANL), which is operated by Triad ! National Security, LLC for the U.S. Department of Energy. The U.S. diff --git a/cicecore/drivers/nuopc/cmeps/CICE_copyright.txt b/cicecore/drivers/nuopc/cmeps/CICE_copyright.txt index af2afdf3d..3f81ec782 100644 --- a/cicecore/drivers/nuopc/cmeps/CICE_copyright.txt +++ b/cicecore/drivers/nuopc/cmeps/CICE_copyright.txt @@ -1,7 +1,7 @@ -! Copyright (c) 2023, Triad National Security, LLC +! Copyright (c) 2024, Triad National Security, LLC ! All rights reserved. ! -! Copyright 2023. Triad National Security, LLC. This software was +! Copyright 2024. Triad National Security, LLC. This software was ! produced under U.S. Government contract DE-AC52-06NA25396 for Los ! Alamos National Laboratory (LANL), which is operated by Triad ! National Security, LLC for the U.S. Department of Energy. The U.S. diff --git a/cicecore/drivers/nuopc/dmi/CICE.F90 b/cicecore/drivers/nuopc/dmi/CICE.F90 index 5ace27736..f993686e8 100644 --- a/cicecore/drivers/nuopc/dmi/CICE.F90 +++ b/cicecore/drivers/nuopc/dmi/CICE.F90 @@ -1,8 +1,8 @@ !======================================================================= -! Copyright (c) 2023, Triad National Security, LLC +! Copyright (c) 2024, Triad National Security, LLC ! All rights reserved. ! -! Copyright 2023. Triad National Security, LLC. This software was +! Copyright 2024. Triad National Security, LLC. This software was ! produced under U.S. Government contract DE-AC52-06NA25396 for Los ! Alamos National Laboratory (LANL), which is operated by Triad ! National Security, LLC for the U.S. Department of Energy. The U.S. diff --git a/cicecore/drivers/standalone/cice/CICE.F90 b/cicecore/drivers/standalone/cice/CICE.F90 index 5ace27736..f993686e8 100644 --- a/cicecore/drivers/standalone/cice/CICE.F90 +++ b/cicecore/drivers/standalone/cice/CICE.F90 @@ -1,8 +1,8 @@ !======================================================================= -! Copyright (c) 2023, Triad National Security, LLC +! Copyright (c) 2024, Triad National Security, LLC ! All rights reserved. ! -! Copyright 2023. Triad National Security, LLC. This software was +! Copyright 2024. Triad National Security, LLC. This software was ! produced under U.S. Government contract DE-AC52-06NA25396 for Los ! Alamos National Laboratory (LANL), which is operated by Triad ! National Security, LLC for the U.S. Department of Energy. The U.S. diff --git a/cicecore/drivers/unittest/opticep/CICE.F90 b/cicecore/drivers/unittest/opticep/CICE.F90 index 5ace27736..f993686e8 100644 --- a/cicecore/drivers/unittest/opticep/CICE.F90 +++ b/cicecore/drivers/unittest/opticep/CICE.F90 @@ -1,8 +1,8 @@ !======================================================================= -! Copyright (c) 2023, Triad National Security, LLC +! Copyright (c) 2024, Triad National Security, LLC ! All rights reserved. ! -! Copyright 2023. Triad National Security, LLC. This software was +! Copyright 2024. Triad National Security, LLC. This software was ! produced under U.S. Government contract DE-AC52-06NA25396 for Los ! Alamos National Laboratory (LANL), which is operated by Triad ! National Security, LLC for the U.S. Department of Energy. The U.S. diff --git a/cicecore/version.txt b/cicecore/version.txt index c908e44d9..083549d70 100644 --- a/cicecore/version.txt +++ b/cicecore/version.txt @@ -1 +1 @@ -CICE 6.5.0 +CICE 6.5.1 diff --git a/doc/source/conf.py b/doc/source/conf.py index 0e7ce0886..fec9406c0 100644 --- a/doc/source/conf.py +++ b/doc/source/conf.py @@ -57,7 +57,7 @@ # General information about the project. project = u'CICE' -copyright = u'2023, Triad National Security, LLC (code) and National Center for Atmospheric Research (documentation)' +copyright = u'2024, Triad National Security, LLC (code) and National Center for Atmospheric Research (documentation)' author = u'CICE-Consortium' # The version info for the project you're documenting, acts as replacement for @@ -65,9 +65,9 @@ # built documents. # # The short X.Y version. -version = u'6.5.0' +version = u'6.5.1' # The full version, including alpha/beta/rc tags. -version = u'6.5.0' +version = u'6.5.1' # The language for content autogenerated by Sphinx. Refer to documentation # for a list of supported languages. diff --git a/doc/source/intro/copyright.rst b/doc/source/intro/copyright.rst index e477d9d57..8ddeef022 100644 --- a/doc/source/intro/copyright.rst +++ b/doc/source/intro/copyright.rst @@ -5,7 +5,7 @@ Copyright ============================= -© Copyright 2023, Triad National Security LLC. All rights reserved. +© Copyright 2024, Triad National Security LLC. All rights reserved. This software was produced under U.S. Government contract 89233218CNA000001 for Los Alamos National Laboratory (LANL), which is operated by Triad National Security, LLC for the U.S. Department diff --git a/icepack b/icepack index f6ff8f7c4..ae69b8069 160000 --- a/icepack +++ b/icepack @@ -1 +1 @@ -Subproject commit f6ff8f7c4d4cb6feabe3651b13204cf43fc948e3 +Subproject commit ae69b806990ef2412e2f714c5b4ba4c096b163b6 From 969a76d812a1e8479276a9964c0e0fd0341641d0 Mon Sep 17 00:00:00 2001 From: Tony Craig Date: Thu, 16 May 2024 17:39:04 -0700 Subject: [PATCH 71/76] Update the automated max_blocks calculation (#954) Update support for max_blocks=-1. This update computes the blocks required on each MPI task and then sets that as max_blocks if max_blocks=-1 in namelist. This is done in ice_distribution and is a function of the decomposition among other things. Refactor the decomposition computation to defer usage of max_blocks and eliminate the blockIndex array. Update some indentation formatting in ice_distribution.F90. Modify cice.setup and cice_decomp.csh to set max_blocks=-1 unless it's explicitly defined by the cice.setup -p setting. Fix a bug in ice_gather_scatter related to zero-ing out of the halo with the field_loc_noupdate setting. This was zero-ing out the blocks extra times and there were no problems as long as max_blocks was the same value on all MPI tasks. With the new implementation of max_blocks=-1, max_blocks can be different values on different MPI tasks. An error was generated and then the implementation was fixed so each block on each task is now zeroed out exactly once. Update diagnostics related to max_block information. Write out the min and max max_blocks values across MPI tasks. Add extra allocation/deallocation checks in ice_distribution.F90 and add a function, ice_memusage_allocErr, to ice_memusage.F90 that checks the alloc/dealloc return code, writes an error message, and aborts. This function could be used in other parts of the code as well. Fix a bug in the io_binary restart output where each task was writing some output when it should have just been the master task. Update test cases Update documentation --- cice.setup | 8 +- .../comm/mpi/ice_gather_scatter.F90 | 36 +- .../comm/serial/ice_gather_scatter.F90 | 32 +- .../cicedyn/infrastructure/ice_domain.F90 | 96 +- cicecore/cicedyn/infrastructure/ice_grid.F90 | 14 +- .../cicedyn/infrastructure/ice_memusage.F90 | 34 +- .../io/io_binary/ice_restart.F90 | 11 +- cicecore/shared/ice_distribution.F90 | 1083 +++++++---------- cicecore/shared/ice_domain_size.F90 | 11 +- configuration/scripts/cice_decomp.csh | 3 +- configuration/scripts/tests/decomp_suite.ts | 51 +- configuration/scripts/tests/first_suite.ts | 18 +- configuration/scripts/tests/gridsys_suite.ts | 54 +- configuration/scripts/tests/perf_suite.ts | 48 +- configuration/scripts/tests/unittest_suite.ts | 13 + doc/source/user_guide/ug_case_settings.rst | 1 + doc/source/user_guide/ug_implementation.rst | 22 +- 17 files changed, 686 insertions(+), 849 deletions(-) diff --git a/cice.setup b/cice.setup index 4c7a222ff..2fd68cd18 100755 --- a/cice.setup +++ b/cice.setup @@ -684,7 +684,7 @@ EOF set thrd = `echo ${pesx} | cut -d x -f 2` set blckx = `echo ${pesx} | cut -d x -f 3` set blcky = `echo ${pesx} | cut -d x -f 4` - set mblck = 0 + set mblck = -1 if (${task} == 0 || ${thrd} == 0 || ${blckx} == 0 || ${blcky} == 0) then echo "${0}: ERROR in -p argument, cannot have zeros" exit -1 @@ -696,7 +696,7 @@ EOF set thrd = `echo ${pesx} | cut -d x -f 2` set blckx = 0 set blcky = 0 - set mblck = 0 + set mblck = -1 if (${task} == 0 || ${thrd} == 0) then echo "${0}: ERROR in -p argument, cannot have zeros" exit -1 @@ -708,7 +708,7 @@ EOF set thrd = 1 set blckx = 0 set blcky = 0 - set mblck = 0 + set mblck = -1 if (${task} == 0) then echo "${0}: ERROR in -p argument, cannot have zeros" exit -1 @@ -757,7 +757,7 @@ EOF # update pesx based on use defined settings and machine limits to reflect actual value set pesx = ${task}x${thrd}x${blckx}x${blcky}x${mblck} - if (${mblck} == 0) then + if (${mblck} <= 0) then set pesx = ${task}x${thrd}x${blckx}x${blcky} endif if (${blckx} == 0 || ${blcky} == 0) then diff --git a/cicecore/cicedyn/infrastructure/comm/mpi/ice_gather_scatter.F90 b/cicecore/cicedyn/infrastructure/comm/mpi/ice_gather_scatter.F90 index 030deabca..cfb98befe 100644 --- a/cicecore/cicedyn/infrastructure/comm/mpi/ice_gather_scatter.F90 +++ b/cicecore/cicedyn/infrastructure/comm/mpi/ice_gather_scatter.F90 @@ -1836,12 +1836,12 @@ subroutine scatter_global_dbl(ARRAY, ARRAY_G, src_task, dst_dist, & !----------------------------------------------------------------- if (field_loc == field_loc_noupdate) then - do n=1,nblocks_tot + do n=1,nblocks_tot + if (dst_dist%blockLocation(n) == my_task+1 .and. & + dst_dist%blockLocalID(n) > 0) then + dst_block = dst_dist%blockLocalID(n) this_block = get_block(n,n) - - if (dst_block > 0) then - ! north edge do j = this_block%jhi+1,ny_block do i = 1, nx_block @@ -1867,8 +1867,8 @@ subroutine scatter_global_dbl(ARRAY, ARRAY_G, src_task, dst_dist, & enddo enddo - endif - enddo + endif + enddo endif if (add_mpi_barriers) then @@ -2222,12 +2222,12 @@ subroutine scatter_global_real(ARRAY, ARRAY_G, src_task, dst_dist, & !----------------------------------------------------------------- if (field_loc == field_loc_noupdate) then - do n=1,nblocks_tot + do n=1,nblocks_tot + if (dst_dist%blockLocation(n) == my_task+1 .and. & + dst_dist%blockLocalID(n) > 0) then + dst_block = dst_dist%blockLocalID(n) this_block = get_block(n,n) - - if (dst_block > 0) then - ! north edge do j = this_block%jhi+1,ny_block do i = 1, nx_block @@ -2253,8 +2253,8 @@ subroutine scatter_global_real(ARRAY, ARRAY_G, src_task, dst_dist, & enddo enddo - endif - enddo + endif + enddo endif if (add_mpi_barriers) then @@ -2608,12 +2608,12 @@ subroutine scatter_global_int(ARRAY, ARRAY_G, src_task, dst_dist, & !----------------------------------------------------------------- if (field_loc == field_loc_noupdate) then - do n=1,nblocks_tot + do n=1,nblocks_tot + if (dst_dist%blockLocation(n) == my_task+1 .and. & + dst_dist%blockLocalID(n) > 0) then + dst_block = dst_dist%blockLocalID(n) this_block = get_block(n,n) - - if (dst_block > 0) then - ! north edge do j = this_block%jhi+1,ny_block do i = 1, nx_block @@ -2639,8 +2639,8 @@ subroutine scatter_global_int(ARRAY, ARRAY_G, src_task, dst_dist, & enddo enddo - endif - enddo + endif + enddo endif if (add_mpi_barriers) then diff --git a/cicecore/cicedyn/infrastructure/comm/serial/ice_gather_scatter.F90 b/cicecore/cicedyn/infrastructure/comm/serial/ice_gather_scatter.F90 index 34cca2d03..5f4938281 100644 --- a/cicecore/cicedyn/infrastructure/comm/serial/ice_gather_scatter.F90 +++ b/cicecore/cicedyn/infrastructure/comm/serial/ice_gather_scatter.F90 @@ -1002,12 +1002,12 @@ subroutine scatter_global_dbl(ARRAY, ARRAY_G, src_task, dst_dist, & !----------------------------------------------------------------- if (field_loc == field_loc_noupdate) then - do n=1,nblocks_tot + do n=1,nblocks_tot + if (dst_dist%blockLocation(n) /= 0 .and. & + dst_dist%blockLocalID(n) > 0) then + dst_block = dst_dist%blockLocalID(n) this_block = get_block(n,n) - - if (dst_block > 0) then - ! north edge do j = this_block%jhi+1,ny_block do i = 1, nx_block @@ -1033,8 +1033,8 @@ subroutine scatter_global_dbl(ARRAY, ARRAY_G, src_task, dst_dist, & enddo enddo - endif - enddo + endif + enddo endif !----------------------------------------------------------------------- @@ -1250,12 +1250,12 @@ subroutine scatter_global_real(ARRAY, ARRAY_G, src_task, dst_dist, & !----------------------------------------------------------------- if (field_loc == field_loc_noupdate) then - do n=1,nblocks_tot + do n=1,nblocks_tot + if (dst_dist%blockLocation(n) /= 0 .and. & + dst_dist%blockLocalID(n) > 0) then + dst_block = dst_dist%blockLocalID(n) this_block = get_block(n,n) - - if (dst_block > 0) then - ! north edge do j = this_block%jhi+1,ny_block do i = 1, nx_block @@ -1281,8 +1281,8 @@ subroutine scatter_global_real(ARRAY, ARRAY_G, src_task, dst_dist, & enddo enddo - endif - enddo + endif + enddo endif !----------------------------------------------------------------------- @@ -1498,12 +1498,12 @@ subroutine scatter_global_int(ARRAY, ARRAY_G, src_task, dst_dist, & !----------------------------------------------------------------- if (field_loc == field_loc_noupdate) then - do n=1,nblocks_tot + do n=1,nblocks_tot + if (dst_dist%blockLocation(n) /= 0 .and. & + dst_dist%blockLocalID(n) > 0) then + dst_block = dst_dist%blockLocalID(n) this_block = get_block(n,n) - - if (dst_block > 0) then - ! north edge do j = this_block%jhi+1,ny_block do i = 1, nx_block diff --git a/cicecore/cicedyn/infrastructure/ice_domain.F90 b/cicecore/cicedyn/infrastructure/ice_domain.F90 index df112eb50..91af49947 100644 --- a/cicecore/cicedyn/infrastructure/ice_domain.F90 +++ b/cicecore/cicedyn/infrastructure/ice_domain.F90 @@ -223,7 +223,12 @@ subroutine init_domain_blocks call broadcast_scalar(nx_global, master_task) call broadcast_scalar(ny_global, master_task) - ! Set nprocs if not set in namelist +!---------------------------------------------------------------------- +! +! Set nprocs if not explicitly set to valid value in namelist +! +!---------------------------------------------------------------------- + #ifdef CESMCOUPLED nprocs = get_num_procs() #else @@ -235,18 +240,6 @@ subroutine init_domain_blocks endif #endif - ! Determine max_blocks if not set - if (max_blocks < 1) then - call proc_decomposition(nprocs, nprocs_x, nprocs_y) - max_blocks=((nx_global-1)/block_size_x/nprocs_x+1) * & - ((ny_global-1)/block_size_y/nprocs_y+1) - max_blocks=max(1,max_blocks) - if (my_task == master_task) then - write(nu_diag,'(/,a52,i6,/)') & - '(ice_domain): max_block < 1: max_block estimated to ',max_blocks - endif - endif - !---------------------------------------------------------------------- ! ! perform some basic checks on domain @@ -321,6 +314,7 @@ subroutine init_domain_distribution(KMTG,ULATG,grid_ice) use ice_boundary, only: ice_HaloCreate use ice_distribution, only: create_distribution, create_local_block_ids, ice_distributionGet use ice_domain_size, only: max_blocks, nx_global, ny_global + use ice_global_reductions, only: global_sum, global_maxval real (dbl_kind), dimension(nx_global,ny_global), intent(in) :: & KMTG ,&! global topography @@ -608,9 +602,9 @@ subroutine init_domain_distribution(KMTG,ULATG,grid_ice) 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 - write(nu_diag,*) 'ice_domain nocn = ',minval(nocn),maxval(nocn),sum(nocn) - write(nu_diag,*) 'ice_domain work_per_block = ',minval(work_per_block),maxval(work_per_block),sum(work_per_block) + write(nu_diag,'(2a,4i9)') subname,' work_unit = ',work_unit, max_work_unit + write(nu_diag,'(2a,4i9)') subname,' nocn = ',minval(nocn),maxval(nocn),sum(nocn) + write(nu_diag,'(2a,4i9)') subname,' work_per_block = ',minval(work_per_block),maxval(work_per_block),sum(work_per_block) endif deallocate(nocn) @@ -634,8 +628,42 @@ subroutine init_domain_distribution(KMTG,ULATG,grid_ice) call create_local_block_ids(blocks_ice, distrb_info) - ! write out block distribution - ! internal check of icedistributionGet as part of verification process +!---------------------------------------------------------------------- +! +! check block sizes and max_blocks +! +!---------------------------------------------------------------------- + + if (associated(blocks_ice)) then + nblocks = size(blocks_ice) + else + nblocks = 0 + endif + + tblocks_tmp = global_sum(nblocks, distrb_info) + nblocks_max = global_maxval(nblocks, distrb_info) + + if (my_task == master_task) then + write(nu_diag,'(2a,i8)') subname,' total number of blocks is', tblocks_tmp + endif + + if (nblocks > max_blocks) then + write(nu_diag,'(2a,2i6)') subname,' ERROR: nblocks, max_blocks = ',nblocks,max_blocks + write(nu_diag,'(2a,2i6)') subname,' ERROR: max_blocks too small: increase to', nblocks_max + call abort_ice(subname//' ERROR max_blocks too small', file=__FILE__, line=__LINE__) + else if (nblocks_max < max_blocks) then + if (my_task == master_task) then + write(nu_diag,'(2a,2i6)') subname,' NOTE: max_blocks too large: decrease to', nblocks_max + endif + endif + +!---------------------------------------------------------------------- +! +! write out block distribution +! internal check of icedistributionGet as part of verification process +! +!---------------------------------------------------------------------- + if (debug_blocks) then call flush_fileunit(nu_diag) @@ -713,38 +741,6 @@ subroutine init_domain_distribution(KMTG,ULATG,grid_ice) endif endif - if (associated(blocks_ice)) then - nblocks = size(blocks_ice) - else - nblocks = 0 - endif - 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 - end do - - if (my_task == master_task) then - write(nu_diag,*) & - 'ice: total number of blocks is', tblocks_tmp - 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__) - 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 - endif - !---------------------------------------------------------------------- ! ! Set up ghost cell updates for each distribution. diff --git a/cicecore/cicedyn/infrastructure/ice_grid.F90 b/cicecore/cicedyn/infrastructure/ice_grid.F90 index c43b7989c..54bc3ad92 100644 --- a/cicecore/cicedyn/infrastructure/ice_grid.F90 +++ b/cicecore/cicedyn/infrastructure/ice_grid.F90 @@ -301,6 +301,10 @@ subroutine init_grid1 real (kind=dbl_kind), dimension(:,:), allocatable :: & work_g1, work_g2 + integer (kind=int_kind) :: & + max_blocks_min, & ! min value of max_blocks across procs + max_blocks_max ! max value of max_blocks across procs + real (kind=dbl_kind) :: & rad_to_deg @@ -390,9 +394,15 @@ subroutine init_grid1 ! write additional domain information !----------------------------------------------------------------- + max_blocks_min = global_minval(max_blocks, distrb_info) + max_blocks_max = global_maxval(max_blocks, distrb_info) if (my_task == master_task) then - write(nu_diag,'(a26,i6)') ' Block size: nx_block = ',nx_block - write(nu_diag,'(a26,i6)') ' ny_block = ',ny_block + write(nu_diag,* ) '' + write(nu_diag,'(2a)' ) subname,' Block size:' + write(nu_diag,'(2a,i8)') subname,' nx_block = ',nx_block + write(nu_diag,'(2a,i8)') subname,' ny_block = ',ny_block + write(nu_diag,'(2a,i8)') subname,' min(max_blocks) = ',max_blocks_min + write(nu_diag,'(2a,i8)') subname,' max(max_blocks) = ',max_blocks_max endif end subroutine init_grid1 diff --git a/cicecore/cicedyn/infrastructure/ice_memusage.F90 b/cicecore/cicedyn/infrastructure/ice_memusage.F90 index 323a9074e..45b882879 100644 --- a/cicecore/cicedyn/infrastructure/ice_memusage.F90 +++ b/cicecore/cicedyn/infrastructure/ice_memusage.F90 @@ -8,13 +8,16 @@ MODULE ice_memusage !------------------------------------------------------------------------------- use ice_kinds_mod, only : dbl_kind, log_kind + use ice_fileunits, only : nu_diag + use ice_exit, only : abort_ice implicit none private ! PUBLIC: Public interfaces - public :: ice_memusage_getusage, & + public :: ice_memusage_allocErr, & + ice_memusage_getusage, & ice_memusage_init, & ice_memusage_print @@ -29,6 +32,35 @@ MODULE ice_memusage contains +!=============================================================================== +! check memory alloc/dealloc return code + +logical function ice_memusage_allocErr(istat, errstr) + + implicit none + + !----- arguments ----- + + integer :: istat !< input error code + + character(len=*), optional :: errstr !< error string + + !----- local ----- + + character(*),parameter :: subname = '(ice_memusage_allocErr)' + + ice_memusage_allocErr = .false. + if (istat /= 0) then + ice_memusage_allocErr = .true. + if (present(errstr)) then + write(nu_diag,*) 'ERROR: '//trim(errstr) + endif + call abort_ice(subname//'ERROR: alloc/dealloc', file=__FILE__, line=__LINE__) + return + endif + +end function ice_memusage_allocErr + !=============================================================================== ! Initialize memory conversion to MB diff --git a/cicecore/cicedyn/infrastructure/io/io_binary/ice_restart.F90 b/cicecore/cicedyn/infrastructure/io/io_binary/ice_restart.F90 index 606f0d46b..5866d7130 100644 --- a/cicecore/cicedyn/infrastructure/io/io_binary/ice_restart.F90 +++ b/cicecore/cicedyn/infrastructure/io/io_binary/ice_restart.F90 @@ -12,6 +12,7 @@ module ice_restart use ice_restart_shared, only: & restart, restart_ext, restart_dir, restart_file, pointer_file, & runid, runtype, use_restart_time, lenstr + use ice_communicate, only: my_task, master_task use ice_fileunits, only: nu_diag, nu_rst_pointer use ice_fileunits, only: nu_dump, nu_dump_eap, nu_dump_FY, nu_dump_age use ice_fileunits, only: nu_dump_lvl, nu_dump_pond, nu_dump_hbrine @@ -48,7 +49,6 @@ subroutine init_restart_read(ice_ic) use ice_calendar, only: istep0, istep1, timesecs, npt, myear, & set_date_from_timesecs - use ice_communicate, only: my_task, master_task use ice_dyn_shared, only: kdyn use ice_read_write, only: ice_open, ice_open_ext @@ -381,7 +381,6 @@ subroutine init_restart_write(filename_spec) use ice_calendar, only: msec, mmonth, mday, myear, istep1, & timesecs - use ice_communicate, only: my_task, master_task use ice_dyn_shared, only: kdyn use ice_read_write, only: ice_open, ice_open_ext @@ -721,7 +720,9 @@ subroutine read_restart_field(nu,nrec,work,atype,vname,ndim3, & character(len=*), parameter :: subname = '(read_restart_field)' - write(nu_diag,*) 'vname ',trim(vname) + if (my_task == master_task) then + write(nu_diag,*) subname,' read vname ',trim(vname) + endif if (present(field_loc)) then do n=1,ndim3 if (restart_ext) then @@ -782,6 +783,9 @@ subroutine write_restart_field(nu,nrec,work,atype,vname,ndim3,diag) character(len=*), parameter :: subname = '(write_restart_field)' + if (my_task == master_task) then + write(nu_diag,*) subname,' write vname ',trim(vname) + endif do n=1,ndim3 work2(:,:,:) = work(:,:,n,:) if (restart_ext) then @@ -801,7 +805,6 @@ end subroutine write_restart_field subroutine final_restart() use ice_calendar, only: istep1, timesecs - use ice_communicate, only: my_task, master_task logical (kind=log_kind) :: & tr_iage, tr_FY, tr_lvl, tr_iso, tr_aero, & diff --git a/cicecore/shared/ice_distribution.F90 b/cicecore/shared/ice_distribution.F90 index 6e06069ab..d0768fc5a 100644 --- a/cicecore/shared/ice_distribution.F90 +++ b/cicecore/shared/ice_distribution.F90 @@ -15,6 +15,7 @@ module ice_distribution use ice_blocks, only: nblocks_x, nblocks_y, nblocks_tot, debug_blocks use ice_exit, only: abort_ice use ice_fileunits, only: nu_diag + use ice_memusage, only: ice_memusage_allocErr implicit none private @@ -33,8 +34,6 @@ module ice_distribution blockGlobalID ! global block id for each local block integer (int_kind), dimension(:), pointer :: blockCnt - integer (int_kind), dimension(:,:), pointer :: blockIndex - end type public :: create_distribution, & @@ -123,7 +122,8 @@ function create_distribution(dist_type, nprocs, work_per_block) case default - call abort_ice(subname//'ERROR: ice distribution: unknown distribution type') + call abort_ice(subname//'ERROR: ice distribution: unknown distribution type', & + file=__FILE__, line=__LINE__) end select @@ -153,7 +153,8 @@ subroutine create_local_block_ids(block_ids, distribution) !----------------------------------------------------------------------- integer (int_kind) :: & - n, bcount ! dummy counters + n, bcount, &! dummy counters + istat ! status flag for deallocate character(len=*),parameter :: subname='(create_local_block_ids)' @@ -168,9 +169,6 @@ subroutine create_local_block_ids(block_ids, distribution) if (distribution%blockLocation(n) == my_task+1) bcount = bcount + 1 end do - - if (bcount > 0) allocate(block_ids(bcount)) - !----------------------------------------------------------------------- ! ! now fill array with proper block ids @@ -178,6 +176,8 @@ subroutine create_local_block_ids(block_ids, distribution) !----------------------------------------------------------------------- if (bcount > 0) then + allocate(block_ids(bcount), stat=istat) + if (ice_memusage_allocErr(istat,subname//'alloc block_ids')) return do n=1,size(distribution%blockLocation) if (distribution%blockLocation(n) == my_task+1) then block_ids(distribution%blockLocalID(n)) = n @@ -315,7 +315,8 @@ subroutine proc_decomposition(nprocs, nprocs_x, nprocs_y) end do proc_loop if (nprocs_x == 0) then - call abort_ice(subname//'ERROR: Unable to find 2d processor config') + call abort_ice(subname//'ERROR: Unable to find 2d processor config', & + file=__FILE__, line=__LINE__) endif if (my_task == master_task) then @@ -364,11 +365,16 @@ subroutine ice_distributionDestroy(distribution) !---------------------------------------------------------------------- deallocate(distribution%blockLocation, stat=istat) + if (ice_memusage_allocErr(istat,subname//'dealloc blockLocation')) return + deallocate(distribution%blockLocalID , stat=istat) + if (ice_memusage_allocErr(istat,subname//'dealloc blockLocalID')) return + deallocate(distribution%blockGlobalID, stat=istat) - deallocate(distribution%blockCnt , stat=istat) - deallocate(distribution%blockindex , stat=istat) + if (ice_memusage_allocErr(istat,subname//'dealloc blockGlobalID')) return + deallocate(distribution%blockCnt , stat=istat) + if (ice_memusage_allocErr(istat,subname//'dealloc blockCnt')) return !----------------------------------------------------------------------- @@ -383,19 +389,19 @@ subroutine ice_distributionGet(distribution,& ! This routine extracts information from a distribution. type (distrb), intent(in) :: & - distribution ! input distribution for which information - ! is requested + distribution ! input distribution for which information + ! is requested - integer (int_kind), intent(out), optional :: & - nprocs ,&! number of processors in this dist - communicator ,&! communicator to use in this dist - numLocalBlocks ! number of blocks distributed to this - ! local processor + integer (int_kind), intent(out), optional :: & + nprocs ,&! number of processors in this dist + communicator ,&! communicator to use in this dist + numLocalBlocks ! number of blocks distributed to this + ! local processor - integer (int_kind), dimension(:), optional :: & - blockLocation ,&! processor location for all blocks - blockLocalID ,&! local block id for all blocks - blockGlobalID ! global block id for each local block + integer (int_kind), dimension(:), optional :: & + blockLocation ,&! processor location for all blocks + blockLocalID ,&! local block id for all blocks + blockGlobalID ! global block id for each local block character(len=*),parameter :: subname='(ice_distributionGet)' @@ -414,7 +420,8 @@ subroutine ice_distributionGet(distribution,& if (associated(distribution%blockLocation)) then blockLocation = distribution%blockLocation else - call abort_ice(subname//'ERROR: blockLocation not allocated') + call abort_ice(subname//'ERROR: blockLocation not allocated', & + file=__FILE__, line=__LINE__) return endif endif @@ -423,7 +430,8 @@ subroutine ice_distributionGet(distribution,& if (associated(distribution%blockLocalID)) then blockLocalID = distribution%blockLocalID else - call abort_ice(subname//'ERROR: blockLocalID not allocated') + call abort_ice(subname//'ERROR: blockLocalID not allocated', & + file=__FILE__, line=__LINE__) return endif endif @@ -432,7 +440,8 @@ subroutine ice_distributionGet(distribution,& if (associated(distribution%blockGlobalID)) then blockGlobalID = distribution%blockGlobalID else - call abort_ice(subname//'ERROR: blockGlobalID not allocated') + call abort_ice(subname//'ERROR: blockGlobalID not allocated', & + file=__FILE__, line=__LINE__) return endif endif @@ -471,7 +480,8 @@ subroutine ice_distributionGetBlockLoc(distribution, blockID, & !----------------------------------------------------------------------- if (blockID < 0 .or. blockID > nblocks_tot) then - call abort_ice(subname//'ERROR: invalid block id') + call abort_ice(subname//'ERROR: invalid block id', & + file=__FILE__, line=__LINE__) return endif @@ -515,7 +525,8 @@ subroutine ice_distributionGetBlockID(distribution, localID, & !----------------------------------------------------------------------- if (localID < 0 .or. localID > distribution%numLocalBlocks) then - call abort_ice(subname//'ERROR: invalid local id') + call abort_ice(subname//'ERROR: invalid local id', & + file=__FILE__, line=__LINE__) return endif @@ -533,7 +544,7 @@ end subroutine ice_distributionGetBlockID !*********************************************************************** - function create_distrb_cart(nprocs, workPerBlock) result(newDistrb) + function create_distrb_cart(nprocs, workPerBlock, max_blocks_calc) result(newDistrb) ! This function creates a distribution of blocks across processors ! using a 2-d Cartesian distribution. @@ -542,11 +553,14 @@ function create_distrb_cart(nprocs, workPerBlock) result(newDistrb) nprocs ! number of processors in this distribution integer (int_kind), dimension(:), intent(in) :: & - workPerBlock ! amount of work per block + workPerBlock ! amount of work per block + + logical (log_kind), optional :: & + max_blocks_calc ! compute max_blocks (default true) type (distrb) :: & - newDistrb ! resulting structure describing Cartesian - ! distribution of blocks + newDistrb ! resulting structure describing Cartesian + ! distribution of blocks !---------------------------------------------------------------------- ! @@ -555,24 +569,31 @@ function create_distrb_cart(nprocs, workPerBlock) result(newDistrb) !---------------------------------------------------------------------- integer (int_kind) :: & - i, j, &! dummy loop indices + i, j, n, &! dummy loop indices istat, &! status flag for allocation iblock, jblock, &! is, ie, js, je, &! start, end block indices for each proc processor, &! processor position in cartesian decomp globalID, &! global block ID localID, &! block location on this processor - nprocsX, &! num of procs in x for global domain - nprocsY, &! num of procs in y for global domain + nprocsX, &! num of procs in x for global domain + nprocsY, &! num of procs in y for global domain numBlocksXPerProc, &! num of blocks per processor in x numBlocksYPerProc, &! num of blocks per processor in y numBlocksPerProc ! required number of blocks per processor - character(len=char_len) :: & - numBlocksPerProc_str ! required number of blocks per processor (as string) + logical (log_kind) :: & + lmax_blocks_calc ! local max_blocks_calc setting character(len=*),parameter :: subname='(create_distrb_cart)' +!---------------------------------------------------------------------- + + lmax_blocks_calc = .true. + if (present(max_blocks_calc)) then + lmax_blocks_calc = max_blocks_calc + endif + !---------------------------------------------------------------------- ! ! create communicator for this distribution @@ -591,27 +612,18 @@ function create_distrb_cart(nprocs, workPerBlock) result(newDistrb) call proc_decomposition(nprocs, nprocsX, nprocsY) - !---------------------------------------------------------------------- ! ! allocate space for decomposition ! !---------------------------------------------------------------------- - allocate (newDistrb%blockLocation(nblocks_tot), & - newDistrb%blockLocalID (nblocks_tot), stat=istat) - - if (istat > 0) then - call abort_ice( & - 'create_distrb_cart: error allocating blockLocation or blockLocalID') - return - endif - - allocate (newDistrb%blockCnt(nprocs)) - newDistrb%blockCnt(:) = 0 + allocate(newDistrb%blockLocation(nblocks_tot), & + newDistrb%blockLocalID (nblocks_tot), stat=istat) + if (ice_memusage_allocErr(istat,subname//'alloc blockLocation or blockLocalID')) return - allocate(newDistrb%blockIndex(nprocs,max_blocks)) - newDistrb%blockIndex(:,:) = 0 + allocate(newDistrb%blockCnt(nprocs), stat=istat) + if (ice_memusage_allocErr(istat,subname//'alloc blockLocation or blockLocalID')) return !---------------------------------------------------------------------- ! @@ -622,17 +634,10 @@ function create_distrb_cart(nprocs, workPerBlock) result(newDistrb) numBlocksXPerProc = (nblocks_x-1)/nprocsX + 1 numBlocksYPerProc = (nblocks_y-1)/nprocsY + 1 - ! Check if max_blocks is too small - numBlocksPerProc = numBlocksXPerProc * numBlocksYPerProc - if (numBlocksPerProc > max_blocks) then - write(numBlocksPerProc_str, '(i2)') numBlocksPerProc - call abort_ice(subname//'ERROR: max_blocks too small (need at least '//trim(numBlocksPerProc_str)//')') - return - endif - + newDistrb%blockCnt(:) = 0 do j=1,nprocsY do i=1,nprocsX - processor = (j-1)*nprocsX + i ! number the processors + processor = (j-1)*nprocsX + i ! number the processors ! left to right, bot to top is = (i-1)*numBlocksXPerProc + 1 ! starting block in i @@ -642,16 +647,14 @@ function create_distrb_cart(nprocs, workPerBlock) result(newDistrb) je = j *numBlocksYPerProc ! ending block in j if (je > nblocks_y) je = nblocks_y - localID = 0 ! initialize counter for local index do jblock = js,je do iblock = is,ie globalID = (jblock - 1)*nblocks_x + iblock if (workPerBlock(globalID) /= 0) then - localID = localID + 1 + newDistrb%blockCnt(processor) = newDistrb%blockCnt(processor) + 1 + localID = newDistrb%blockCnt(processor) newDistrb%blockLocation(globalID) = processor newDistrb%blockLocalID (globalID) = localID - newDistrb%blockCnt(processor) = newDistrb%blockCnt(processor) + 1 - newDistrb%blockIndex(processor,localID) = globalID else ! no work - eliminate block from distribution newDistrb%blockLocation(globalID) = 0 newDistrb%blockLocalID (globalID) = 0 @@ -659,64 +662,25 @@ function create_distrb_cart(nprocs, workPerBlock) result(newDistrb) end do end do - ! if this is the local processor, set number of local blocks - if (my_task == processor - 1) then - newDistrb%numLocalBlocks = localID - endif - end do end do -!---------------------------------------------------------------------- -! -! now store the local info -! -!---------------------------------------------------------------------- + newDistrb%numLocalBlocks = newDistrb%blockCnt(my_task+1) - if (newDistrb%numLocalBlocks > 0) then - allocate (newDistrb%blockGlobalID(newDistrb%numLocalBlocks), & - stat=istat) - if (istat > 0) then - call abort_ice( & - 'create_distrb_cart: error allocating blockGlobalID') - return + ! set local blockGlobalID array + allocate(newDistrb%blockGlobalID(newDistrb%numLocalBlocks), stat=istat) + if (ice_memusage_allocErr(istat,subname//'alloc numLocalBlocks')) return + do n = 1,nblocks_tot + if (my_task+1 == newDistrb%blockLocation(n)) then + localID = newDistrb%blockLocalID(n) + newDistrb%blockGlobalID (localID) = n endif + enddo - do j=1,nprocsY - do i=1,nprocsX - processor = (j-1)*nprocsX + i - - if (processor == my_task + 1) then - is = (i-1)*numBlocksXPerProc + 1 ! starting block in i - ie = i *numBlocksXPerProc ! ending block in i - if (ie > nblocks_x) ie = nblocks_x - js = (j-1)*numBlocksYPerProc + 1 ! starting block in j - je = j *numBlocksYPerProc ! ending block in j - if (je > nblocks_y) je = nblocks_y - - localID = 0 ! initialize counter for local index - do jblock = js,je - do iblock = is,ie - globalID = (jblock - 1)*nblocks_x + iblock - if (workPerBlock(globalID) /= 0) then - localID = localID + 1 - newDistrb%blockGlobalID (localID) = globalID - endif - end do - end do - - endif - - end do - end do - - else - allocate (newDistrb%blockGlobalID(newDistrb%numLocalBlocks), & - stat=istat) - if (istat > 0) then - call abort_ice( & - 'create_distrb_cart: error allocating blockGlobalID') - return + ! set/check max_blocks + if (lmax_blocks_calc) then + if (max_blocks < 0) then + max_blocks = newDistrb%numLocalBlocks endif endif @@ -750,22 +714,23 @@ function create_distrb_rake(nprocs, workPerBlock) result(newDistrb) ! !---------------------------------------------------------------------- - integer (int_kind) :: & - i,j,n ,&! dummy loop indices - pid ,&! dummy for processor id - istat ,&! status flag for allocates - localBlock ,&! local block position on processor - numOcnBlocks ,&! number of ocean blocks - maxWork ,&! max amount of work in any block - nprocsX ,&! num of procs in x for global domain - nprocsY ! num of procs in y for global domain + integer (int_kind) :: & + i, j, n, &! dummy loop indices + processor, &! dummy for processor id + istat, &! status flag for allocates + globalID, &! global block ID + localID, &! block location on this processor + numOcnBlocks, &! number of ocean blocks + maxWork, &! max amount of work in any block + nprocsX, &! num of procs in x for global domain + nprocsY ! num of procs in y for global domain integer (int_kind), dimension(:), allocatable :: & - priority ,&! priority for moving blocks - workTmp ,&! work per row or column for rake algrthm + priority, &! priority for moving blocks + workTmp, &! work per row or column for rake algrthm procTmp ! temp processor id for rake algrthm - type (distrb) :: dist ! temp hold distribution + type (distrb) :: dist ! temp hold distribution character(len=*),parameter :: subname='(create_distrb_rake)' @@ -775,7 +740,8 @@ function create_distrb_rake(nprocs, workPerBlock) result(newDistrb) ! !---------------------------------------------------------------------- - dist = create_distrb_cart(nprocs, workPerBlock) + ! ignore max_block calc in create_distrb_cart and recompute below + dist = create_distrb_cart(nprocs, workPerBlock, max_blocks_calc=.false.) !---------------------------------------------------------------------- ! @@ -792,11 +758,7 @@ function create_distrb_rake(nprocs, workPerBlock) result(newDistrb) write(nu_diag,*) subname,' 1d rake on entire distribution' allocate(priority(nblocks_tot), stat=istat) - if (istat > 0) then - call abort_ice( & - 'create_distrb_rake: error allocating priority') - return - endif + if (ice_memusage_allocErr(istat,subname//'alloc priority')) return !*** initialize priority array @@ -812,11 +774,7 @@ function create_distrb_rake(nprocs, workPerBlock) result(newDistrb) end do allocate(workTmp(nprocs), procTmp(nprocs), stat=istat) - if (istat > 0) then - call abort_ice( & - 'create_distrb_rake: error allocating procTmp') - return - endif + if (ice_memusage_allocErr(istat,subname//'alloc procTmp')) return workTmp(:) = 0 do i=1,nprocs @@ -832,11 +790,7 @@ function create_distrb_rake(nprocs, workPerBlock) result(newDistrb) priority, dist) deallocate(workTmp, procTmp, stat=istat) - if (istat > 0) then - call abort_ice( & - 'create_distrb_rake: error deallocating procTmp') - return - endif + if (ice_memusage_allocErr(istat,subname//'dealloc procTmp')) return !---------------------------------------------------------------------- ! @@ -857,11 +811,7 @@ function create_distrb_rake(nprocs, workPerBlock) result(newDistrb) !---------------------------------------------------------------------- allocate(priority(nblocks_tot), stat=istat) - if (istat > 0) then - call abort_ice( & - 'create_distrb_rake: error allocating priority') - return - endif + if (ice_memusage_allocErr(istat,subname//'alloc priority')) return !*** set highest priority such that eastern-most blocks !*** and blocks with the least amount of work are @@ -880,20 +830,16 @@ function create_distrb_rake(nprocs, workPerBlock) result(newDistrb) end do allocate(workTmp(nprocsX), procTmp(nprocsX), stat=istat) - if (istat > 0) then - call abort_ice( & - 'create_distrb_rake: error allocating procTmp') - return - endif + if (ice_memusage_allocErr(istat,subname//'alloc procTmp')) return do j=1,nprocsY workTmp(:) = 0 do i=1,nprocsX - pid = (j-1)*nprocsX + i - procTmp(i) = pid + processor = (j-1)*nprocsX + i + procTmp(i) = processor do n=1,nblocks_tot - if (dist%blockLocation(n) == pid) then + if (dist%blockLocation(n) == processor) then workTmp(i) = workTmp(i) + workPerBlock(n) endif end do @@ -904,11 +850,7 @@ function create_distrb_rake(nprocs, workPerBlock) result(newDistrb) end do deallocate(workTmp, procTmp, stat=istat) - if (istat > 0) then - call abort_ice( & - 'create_distrb_rake: error deallocating procTmp') - return - endif + if (ice_memusage_allocErr(istat,subname//'dealloc procTmp')) return !---------------------------------------------------------------------- ! @@ -931,20 +873,16 @@ function create_distrb_rake(nprocs, workPerBlock) result(newDistrb) end do allocate(workTmp(nprocsY), procTmp(nprocsY), stat=istat) - if (istat > 0) then - call abort_ice( & - 'create_distrb_rake: error allocating procTmp') - return - endif + if (ice_memusage_allocErr(istat,subname//'alloc procTmp')) return do i=1,nprocsX workTmp(:) = 0 do j=1,nprocsY - pid = (j-1)*nprocsX + i - procTmp(j) = pid + processor = (j-1)*nprocsX + i + procTmp(j) = processor do n=1,nblocks_tot - if (dist%blockLocation(n) == pid) then + if (dist%blockLocation(n) == processor) then workTmp(j) = workTmp(j) + workPerBlock(n) endif end do @@ -956,11 +894,7 @@ function create_distrb_rake(nprocs, workPerBlock) result(newDistrb) end do deallocate(workTmp, procTmp, priority, stat=istat) - if (istat > 0) then - call abort_ice( & - 'create_distrb_rake: error deallocating procTmp') - return - endif + if (ice_memusage_allocErr(istat,subname//'dealloc procTmp')) return endif ! 1d or 2d rake @@ -976,76 +910,46 @@ function create_distrb_rake(nprocs, workPerBlock) result(newDistrb) allocate(newDistrb%blockLocation(nblocks_tot), & newDistrb%blockLocalID(nblocks_tot), stat=istat) - if (istat > 0) then - call abort_ice( & - 'create_distrb_rake: error allocating blockLocation or blockLocalID') - return - endif + if (ice_memusage_allocErr(istat,subname//'alloc blockLocation or blockLocalID')) return - allocate (newDistrb%blockCnt(nprocs)) + allocate(newDistrb%blockCnt(nprocs), stat=istat) + if (ice_memusage_allocErr(istat,subname//'alloc blockCnt')) return newDistrb%blockCnt(:) = 0 - allocate(newDistrb%blockIndex(nprocs,max_blocks)) - newDistrb%blockIndex(:,:) = 0 - - allocate(procTmp(nprocs), stat=istat) - if (istat > 0) then - call abort_ice( & - 'create_distrb_rake: error allocating procTmp') - return - endif - - procTmp = 0 do n=1,nblocks_tot - pid = dist%blockLocation(n) ! processor id - newDistrb%blockLocation(n) = pid - - if (pid > 0) then - procTmp(pid) = procTmp(pid) + 1 - if (procTmp(pid) > max_blocks) then - call abort_ice(subname//'ERROR: max_blocks too small') - return - endif - newDistrb%blockLocalID (n) = procTmp(pid) - newDistrb%blockIndex(pid,procTmp(pid)) = n + globalID = n + processor = dist%blockLocation(globalID) ! processor id + newDistrb%blockLocation(globalID) = processor + + if (processor > 0) then + newDistrb%blockCnt(processor) = newDistrb%blockCnt(processor) + 1 + localID = newDistrb%blockCnt(processor) + newDistrb%blockLocation(globalID) = processor + newDistrb%blockLocalID (globalID) = localID else - newDistrb%blockLocalID (n) = 0 + newDistrb%blockLocation(globalID) = 0 + newDistrb%blockLocalID (globalID) = 0 endif end do - newDistrb%blockCnt(:) = procTmp(:) - newDistrb%numLocalBlocks = procTmp(my_task+1) - - if (minval(procTmp) < 1) then - call abort_ice(subname//'ERROR: processors left with no blocks') - return - endif - - deallocate(procTmp, stat=istat) - - if (istat > 0) then - call abort_ice(subname//'ERROR: allocating last procTmp') - return - endif + newDistrb%numLocalBlocks = newDistrb%blockCnt(my_task+1) - allocate(newDistrb%blockGlobalID(newDistrb%numLocalBlocks), & - stat=istat) - - if (istat > 0) then - call abort_ice(subname//'ERROR: allocating blockGlobalID') - return - endif - - localBlock = 0 - do n=1,nblocks_tot - if (newDistrb%blockLocation(n) == my_task+1) then - localBlock = localBlock + 1 - newDistrb%blockGlobalID(localBlock) = n + ! set local blockGlobalID array + allocate(newDistrb%blockGlobalID(newDistrb%numLocalBlocks), stat=istat) + if (ice_memusage_allocErr(istat,subname//'alloc numLocalBlocks')) return + do n = 1,nblocks_tot + if (my_task+1 == newDistrb%blockLocation(n)) then + localID = newDistrb%blockLocalID(n) + newDistrb%blockGlobalID (localID) = n endif - end do + enddo -!---------------------------------------------------------------------- + ! set/check max_blocks + if (max_blocks < 0) then + max_blocks = newDistrb%numLocalBlocks + endif + ! destroy cart distribution call ice_distributionDestroy(dist) !---------------------------------------------------------------------- @@ -1061,7 +965,7 @@ function create_distrb_roundrobin(nprocs, workPerBlock) result(newDistrb) ! standalone CAM mode. integer (int_kind), intent(in) :: & - nprocs ! number of processors in this distribution + nprocs ! number of processors in this distribution integer (int_kind), dimension(:), intent(in) :: & workPerBlock ! amount of work per block @@ -1077,15 +981,12 @@ function create_distrb_roundrobin(nprocs, workPerBlock) result(newDistrb) !---------------------------------------------------------------------- integer (int_kind) :: & - i, j, &! dummy loop indices + i, j, n, &! dummy loop indices istat, &! status flag for allocation processor, &! processor position in cartesian decomp globalID, &! global block ID localID ! block location on this processor - integer (int_kind), dimension(:), allocatable :: & - proc_tmp ! temp processor id - character(len=*),parameter :: subname='(create_distrb_roundrobin)' !---------------------------------------------------------------------- @@ -1110,15 +1011,12 @@ function create_distrb_roundrobin(nprocs, workPerBlock) result(newDistrb) ! !---------------------------------------------------------------------- - allocate (newDistrb%blockLocation(nblocks_tot), & - newDistrb%blockLocalID (nblocks_tot), stat=istat) - if (istat > 0) then - call abort_ice( & - 'create_distrb_roundrobin: error allocating blockLocation or blockLocalID') - return - endif + allocate(newDistrb%blockLocation(nblocks_tot), & + newDistrb%blockLocalID (nblocks_tot), stat=istat) + if (ice_memusage_allocErr(istat,subname//'alloc blockLocation or blockLocalID')) return - allocate (newDistrb%blockCnt(nprocs)) + allocate(newDistrb%blockCnt(nprocs), stat=istat) + if (ice_memusage_allocErr(istat,subname//'alloc blockCnt')) return !---------------------------------------------------------------------- ! @@ -1126,67 +1024,42 @@ function create_distrb_roundrobin(nprocs, workPerBlock) result(newDistrb) ! !---------------------------------------------------------------------- - allocate(proc_tmp(nprocs)) processor = 0 globalID = 0 - proc_tmp = 0 - - allocate(newDistrb%blockIndex(nprocs,max_blocks)) - newDistrb%blockIndex(:,:) = 0 + newDistrb%numLocalBlocks = 0 + newDistrb%blockCnt(:) = 0 + ! compute decomposition do j=1,nblocks_y do i=1,nblocks_x - globalID = globalID + 1 - if (workPerBlock(globalID) /= 0) then processor = mod(processor,nprocs) + 1 - proc_tmp(processor) = proc_tmp(processor) + 1 - localID = proc_tmp(processor) - if (localID > max_blocks) then - call abort_ice(subname//'ERROR: max_blocks too small') - return - endif + newDistrb%blockCnt(processor) = newDistrb%blockCnt(processor) + 1 + localID = newDistrb%blockCnt(processor) newDistrb%blockLocation(globalID) = processor newDistrb%blockLocalID (globalID) = localID - newDistrb%blockIndex(processor,localID) = globalID else ! no work - eliminate block from distribution newDistrb%blockLocation(globalID) = 0 newDistrb%blockLocalID (globalID) = 0 endif + enddo + enddo + newDistrb%numLocalBlocks = newDistrb%blockCnt(my_task+1) + + ! set local blockGlobalID array + allocate(newDistrb%blockGlobalID(newDistrb%numLocalBlocks), stat=istat) + if (ice_memusage_allocErr(istat,subname//'alloc numLocalBlocks')) return + do n = 1,nblocks_tot + if (my_task+1 == newDistrb%blockLocation(n)) then + localID = newDistrb%blockLocalID(n) + newDistrb%blockGlobalID (localID) = n + endif + enddo - end do - end do - - newDistrb%numLocalBlocks = proc_tmp(my_task+1) - newDistrb%blockCnt(:) = proc_tmp(:) - deallocate(proc_tmp) - -! write(nu_diag,*) 'my_task,newDistrb%numLocalBlocks',& -! my_task,newDistrb%numLocalBlocks - -!---------------------------------------------------------------------- -! -! now store the local info -! -!---------------------------------------------------------------------- - - globalID = 0 - - if (newDistrb%numLocalBlocks > 0) then - allocate (newDistrb%blockGlobalID(newDistrb%numLocalBlocks), & - stat=istat) - if (istat > 0) then - call abort_ice( & - 'create_distrb_roundrobin: error allocating numLocalBlocks') - return - endif - - processor = my_task + 1 - do localID = 1,newDistrb%numLocalBlocks - newDistrb%blockGlobalID (localID) = newDistrb%blockIndex(processor,& - localID) - enddo + ! set/check max_blocks + if (max_blocks < 0) then + max_blocks = newDistrb%numLocalBlocks endif !---------------------------------------------------------------------- @@ -1202,7 +1075,7 @@ function create_distrb_spiralcenter(nprocs, workPerBlock) result(newDistrb) ! standalone CAM mode. integer (int_kind), intent(in) :: & - nprocs ! number of processors in this distribution + nprocs ! number of processors in this distribution integer (int_kind), dimension(:), intent(in) :: & workPerBlock ! amount of work per block @@ -1219,14 +1092,13 @@ function create_distrb_spiralcenter(nprocs, workPerBlock) result(newDistrb) integer (int_kind) :: & n, i, j, ic, jc, id, jd, cnt, &! dummy loop indices - istat, &! status flag for allocation - processor, &! processor position in cartesian decomp - nblocklist, &! number of blocks in blocklist - globalID, &! global block ID - localID ! block location on this processor + istat, &! status flag for allocation + processor, &! processor position in cartesian decomp + nblocklist, &! number of blocks in blocklist + globalID, &! global block ID + localID ! block location on this processor integer (int_kind), dimension(:), allocatable :: & - proc_tmp, &! temp processor id blocklist ! temp block ordered list integer (int_kind), dimension(:,:), allocatable :: & blockchk ! temp block check array @@ -1255,10 +1127,12 @@ function create_distrb_spiralcenter(nprocs, workPerBlock) result(newDistrb) ! !---------------------------------------------------------------------- - allocate (newDistrb%blockLocation(nblocks_tot), & - newDistrb%blockLocalID (nblocks_tot), stat=istat) + allocate(newDistrb%blockLocation(nblocks_tot), & + newDistrb%blockLocalID (nblocks_tot), stat=istat) + if (ice_memusage_allocErr(istat,subname//'alloc blockLocation or blockLocalID')) return - allocate (newDistrb%blockCnt(nprocs)) + allocate(newDistrb%blockCnt(nprocs), stat=istat) + if (ice_memusage_allocErr(istat,subname//'alloc blockCnt')) return !---------------------------------------------------------------------- ! @@ -1271,18 +1145,15 @@ function create_distrb_spiralcenter(nprocs, workPerBlock) result(newDistrb) ! !---------------------------------------------------------------------- - allocate(proc_tmp(nprocs)) - allocate(blocklist(nblocks_tot)) - allocate(blockchk(nblocks_x,nblocks_y)) + allocate(blocklist(nblocks_tot), stat=istat) + if (ice_memusage_allocErr(istat,subname//'alloc blocklist')) return + allocate(blockchk(nblocks_x,nblocks_y), stat=istat) + if (ice_memusage_allocErr(istat,subname//'alloc blockchk')) return nblocklist = 0 blocklist = 0 blockchk = 0 processor = 0 globalID = 0 - proc_tmp = 0 - - allocate(newDistrb%blockIndex(nprocs,max_blocks)) - newDistrb%blockIndex(:,:) = 0 jc = nblocks_y/2 ic = nblocks_x/2 @@ -1354,10 +1225,12 @@ function create_distrb_spiralcenter(nprocs, workPerBlock) result(newDistrb) if (nblocklist /= nblocks_x*nblocks_y .or. & maxval(blockchk) /= 1 .or. minval(blockchk) /= 1) then - call abort_ice(subname//'ERROR: blockchk invalid') + call abort_ice(subname//'ERROR: blockchk invalid', & + file=__FILE__, line=__LINE__) return endif - deallocate(blockchk) + deallocate(blockchk, stat=istat) + if (ice_memusage_allocErr(istat,subname//'dealloc blockchk')) return !---------------------------------------------------------------------- ! @@ -1365,55 +1238,42 @@ function create_distrb_spiralcenter(nprocs, workPerBlock) result(newDistrb) ! !---------------------------------------------------------------------- - do n = 1,nblocklist - - globalID = blocklist(n) - - if (workPerBlock(globalID) /= 0) then - processor = mod(processor,nprocs) + 1 - proc_tmp(processor) = proc_tmp(processor) + 1 - localID = proc_tmp(processor) - if (localID > max_blocks) then - call abort_ice(subname//'ERROR: max_blocks too small') - return - endif - newDistrb%blockLocation(globalID) = processor - newDistrb%blockLocalID (globalID) = localID - newDistrb%blockIndex(processor,localID) = globalID - else ! no work - eliminate block from distribution - newDistrb%blockLocation(globalID) = 0 - newDistrb%blockLocalID (globalID) = 0 - endif + newDistrb%numLocalBlocks = 0 + newDistrb%blockCnt(:) = 0 + do n = 1,nblocklist + globalID = blocklist(n) + if (workPerBlock(globalID) /= 0) then + processor = mod(processor,nprocs) + 1 + newDistrb%blockCnt(processor) = newDistrb%blockCnt(processor) + 1 + localID = newDistrb%blockCnt(processor) + newDistrb%blockLocation(globalID) = processor + newDistrb%blockLocalID (globalID) = localID + else ! no work - eliminate block from distribution + newDistrb%blockLocation(globalID) = 0 + newDistrb%blockLocalID (globalID) = 0 + endif end do + newDistrb%numLocalBlocks = newDistrb%blockCnt(my_task+1) + + ! set local blockGlobalID array + allocate(newDistrb%blockGlobalID(newDistrb%numLocalBlocks), stat=istat) + if (ice_memusage_allocErr(istat,subname//'alloc numLocalBlocks')) return + do n = 1,nblocks_tot + if (my_task+1 == newDistrb%blockLocation(n)) then + localID = newDistrb%blockLocalID(n) + newDistrb%blockGlobalID (localID) = n + endif + enddo - newDistrb%numLocalBlocks = proc_tmp(my_task+1) - newDistrb%blockCnt(:) = proc_tmp(:) - deallocate(proc_tmp) - deallocate(blocklist) - -! write(nu_diag,*) 'my_task,newDistrb%numLocalBlocks',& -! my_task,newDistrb%numLocalBlocks - -!---------------------------------------------------------------------- -! -! now store the local info -! -!---------------------------------------------------------------------- - - globalID = 0 - - if (newDistrb%numLocalBlocks > 0) then - allocate (newDistrb%blockGlobalID(newDistrb%numLocalBlocks), & - stat=istat) - - processor = my_task + 1 - do localID = 1,newDistrb%numLocalBlocks - newDistrb%blockGlobalID (localID) = newDistrb%blockIndex(processor,& - localID) - enddo + ! set/check max_blocks + if (max_blocks < 0) then + max_blocks = newDistrb%numLocalBlocks endif + deallocate(blocklist, stat=istat) + if (ice_memusage_allocErr(istat,subname//'dealloc blocklist')) return + !---------------------------------------------------------------------- end function create_distrb_spiralcenter @@ -1427,7 +1287,7 @@ function create_distrb_wghtfile(nprocs, workPerBlock) result(newDistrb) ! standalone CAM mode. integer (int_kind), intent(in) :: & - nprocs ! number of processors in this distribution + nprocs ! number of processors in this distribution integer (int_kind), dimension(:), intent(in) :: & workPerBlock ! amount of work per block @@ -1450,9 +1310,6 @@ function create_distrb_wghtfile(nprocs, workPerBlock) result(newDistrb) globalID, &! global block ID localID ! block location on this processor - integer (int_kind), dimension(:), allocatable :: & - proc_tmp ! temp processor id - logical (log_kind) :: up ! direction of pe counting character(len=*),parameter :: subname='(create_distrb_wghtfile)' @@ -1479,10 +1336,12 @@ function create_distrb_wghtfile(nprocs, workPerBlock) result(newDistrb) ! !---------------------------------------------------------------------- - allocate (newDistrb%blockLocation(nblocks_tot), & - newDistrb%blockLocalID (nblocks_tot), stat=istat) + allocate(newDistrb%blockLocation(nblocks_tot), & + newDistrb%blockLocalID (nblocks_tot), stat=istat) + if (ice_memusage_allocErr(istat,subname//'alloc blockLocation or blockLocalID')) return - allocate (newDistrb%blockCnt(nprocs)) + allocate(newDistrb%blockCnt(nprocs), stat=istat) + if (ice_memusage_allocErr(istat,subname//'alloc blockCnt')) return !---------------------------------------------------------------------- ! @@ -1492,94 +1351,76 @@ function create_distrb_wghtfile(nprocs, workPerBlock) result(newDistrb) ! !---------------------------------------------------------------------- - allocate(proc_tmp(nprocs)) processor = 0 - proc_tmp = 0 + newDistrb%numLocalBlocks = 0 + newDistrb%blockCnt(:) = 0 up = .true. - allocate(newDistrb%blockIndex(nprocs,max_blocks)) - newDistrb%blockIndex(:,:) = 0 - if (my_task == master_task) & write(nu_diag,*) subname,' workPerBlock = ',minval(workPerBlock),maxval(workPerBlock) if (minval(workPerBlock) < 0 .or. maxval(workPerBlock) > 12) then write(nu_diag,*) subname,' workPerBlock = ',minval(workPerBlock),maxval(workPerBlock) - call abort_ice(subname//'ERROR: workPerBlock incorrect') + call abort_ice(subname//'ERROR: workPerBlock incorrect', & + file=__FILE__, line=__LINE__) return endif ! do not distribution blocks with work=0 - do n=maxval(workPerBlock),1,-1 - cnt = 0 - do j=1,nblocks_y - do i=1,nblocks_x - - if (mod(j,2) == 1) then - globalID = (j-1)*nblocks_x + i - else - globalID = (j-1)*nblocks_x + nblocks_x - i + 1 - endif - - if (workPerBlock(globalID) == 0) then ! no work - eliminate block from distribution - newDistrb%blockLocation(globalID) = 0 - newDistrb%blockLocalID (globalID) = 0 - elseif (workPerBlock(globalID) == n) then - cnt = cnt + 1 -! processor = mod(processor,nprocs) + 1 - if (up) then - processor = processor + 1 + do n = maxval(workPerBlock),1,-1 + cnt = 0 + do j=1,nblocks_y + do i=1,nblocks_x + if (mod(j,2) == 1) then + globalID = (j-1)*nblocks_x + i else - processor = processor - 1 - endif - if (processor > nprocs) then - up = .false. - processor = nprocs - elseif (processor < 1) then - up = .true. - processor = 1 + globalID = (j-1)*nblocks_x + nblocks_x - i + 1 endif - proc_tmp(processor) = proc_tmp(processor) + 1 - localID = proc_tmp(processor) - if (localID > max_blocks) then - call abort_ice(subname//'ERROR: max_blocks too small') - return + if (workPerBlock(globalID) == 0) then ! no work - eliminate block from distribution + newDistrb%blockLocation(globalID) = 0 + newDistrb%blockLocalID (globalID) = 0 + elseif (workPerBlock(globalID) == n) then + cnt = cnt + 1 + if (up) then + processor = processor + 1 + else + processor = processor - 1 + endif + if (processor > nprocs) then + up = .false. + processor = nprocs + elseif (processor < 1) then + up = .true. + processor = 1 + endif + newDistrb%blockCnt(processor) = newDistrb%blockCnt(processor) + 1 + localID = newDistrb%blockCnt(processor) + newDistrb%blockLocation(globalID) = processor + newDistrb%blockLocalID (globalID) = localID endif - newDistrb%blockLocation(globalID) = processor - newDistrb%blockLocalID (globalID) = localID - newDistrb%blockIndex(processor,localID) = globalID - endif - - end do - end do -! write(nu_diag,*) 'create_distrb_wghtfile n cnt = ',n,cnt + end do + end do +! write(nu_diag,*) subname,'n cnt = ',n,cnt end do + newDistrb%numLocalBlocks = newDistrb%blockCnt(my_task+1) + + ! set local blockGlobalID array + allocate(newDistrb%blockGlobalID(newDistrb%numLocalBlocks), stat=istat) + if (ice_memusage_allocErr(istat,subname//'alloc numLocalBlocks')) return + do n = 1,nblocks_tot + if (my_task+1 == newDistrb%blockLocation(n)) then + localID = newDistrb%blockLocalID(n) + newDistrb%blockGlobalID (localID) = n + endif + enddo - newDistrb%numLocalBlocks = proc_tmp(my_task+1) - newDistrb%blockCnt(:) = proc_tmp(:) - deallocate(proc_tmp) + ! set/check max_blocks + if (max_blocks < 0) then + max_blocks = newDistrb%numLocalBlocks + endif -! write(nu_diag,*) 'my_task,newDistrb%numLocalBlocks',& +! write(nu_diag,*) subname,'my_task,newDistrb%numLocalBlocks',& ! my_task,newDistrb%numLocalBlocks -!---------------------------------------------------------------------- -! -! now store the local info -! -!---------------------------------------------------------------------- - - globalID = 0 - - if (newDistrb%numLocalBlocks > 0) then - allocate (newDistrb%blockGlobalID(newDistrb%numLocalBlocks), & - stat=istat) - - processor = my_task + 1 - do localID = 1,newDistrb%numLocalBlocks - newDistrb%blockGlobalID (localID) = newDistrb%blockIndex(processor,& - localID) - enddo - endif - !---------------------------------------------------------------------- end function create_distrb_wghtfile @@ -1593,7 +1434,7 @@ function create_distrb_sectrobin(nprocs, workPerBlock) result(newDistrb) ! standalone CAM mode. integer (int_kind), intent(in) :: & - nprocs ! number of processors in this distribution + nprocs ! number of processors in this distribution integer (int_kind), dimension(:), intent(in) :: & workPerBlock ! amount of work per block @@ -1609,18 +1450,15 @@ function create_distrb_sectrobin(nprocs, workPerBlock) result(newDistrb) !---------------------------------------------------------------------- integer (int_kind) :: & - i, j, &! dummy loop indices + i, j, n, &! dummy loop indices istat, &! status flag for allocation mblocks, &! estimate of max blocks per pe processor, &! processor position in cartesian decomp globalID, &! global block ID localID ! block location on this processor - integer (int_kind), dimension(:), allocatable :: & - proc_tmp ! temp processor id - logical (log_kind), dimension(:), allocatable :: & - bfree ! map of assigned blocks + bfree ! map of assigned blocks, true = free integer (int_kind) :: cnt, blktogether, i2 integer (int_kind) :: totblocks, nchunks @@ -1650,15 +1488,12 @@ function create_distrb_sectrobin(nprocs, workPerBlock) result(newDistrb) ! !---------------------------------------------------------------------- - allocate (newDistrb%blockLocation(nblocks_tot), & - newDistrb%blockLocalID (nblocks_tot), stat=istat) - if (istat > 0) then - call abort_ice( & - 'create_distrb_sectrobin: error allocating blockLocation or blockLocalID') - return - endif + allocate(newDistrb%blockLocation(nblocks_tot), & + newDistrb%blockLocalID (nblocks_tot), stat=istat) + if (ice_memusage_allocErr(istat,subname//'alloc blockLocation or blockLocalID')) return - allocate (newDistrb%blockCnt(nprocs)) + allocate(newDistrb%blockCnt(nprocs), stat=istat) + if (ice_memusage_allocErr(istat,subname//'alloc blockCnt')) return !---------------------------------------------------------------------- ! @@ -1666,15 +1501,12 @@ function create_distrb_sectrobin(nprocs, workPerBlock) result(newDistrb) ! !---------------------------------------------------------------------- - allocate(proc_tmp(nprocs)) processor = 0 globalID = 0 - proc_tmp = 0 - - allocate(newDistrb%blockIndex(nprocs,max_blocks)) - newDistrb%blockIndex(:,:) = 0 - - allocate(bfree(nblocks_x*nblocks_y)) + newDistrb%numLocalBlocks = 0 + newDistrb%blockCnt(:) = 0 + allocate(bfree(nblocks_x*nblocks_y), stat=istat) + if (ice_memusage_allocErr(istat,subname//'alloc bfree')) return bfree=.true. totblocks = 0 @@ -1696,12 +1528,13 @@ function create_distrb_sectrobin(nprocs, workPerBlock) result(newDistrb) blktogether = max(1,nint(float(totblocks)/float(6*nprocs))) -! write(nu_diag,*) 'ice_distrb_sectrobin totblocks = ',totblocks,nblocks_y*nblocks_x +! write(nu_diag,*) subname,'totblocks = ',totblocks,nblocks_y*nblocks_x !------------------------------ ! southern group of blocks ! weave back and forth in i vs j ! go south to north, low - high pes + ! keepgoing to false to stop distribution !------------------------------ processor=1 @@ -1720,24 +1553,18 @@ function create_distrb_sectrobin(nprocs, workPerBlock) result(newDistrb) cnt = 0 if (processor == 1) keepgoing = .false. endif -! write(nu_diag,'(a,6i7,l2)') 'tcx ',i,j,globalID,cnt,blktogether,processor,keepgoing +! write(nu_diag,'(a,6i7,l2)') subname,i,j,globalID,cnt,blktogether,processor,keepgoing if (keepgoing) then if (bfree(globalID)) then if (workPerBlock(globalID) /= 0) then - proc_tmp(processor) = proc_tmp(processor) + 1 - localID = proc_tmp(processor) - if (localID > max_blocks) then - call abort_ice(subname//'ERROR: max_blocks too small') - return - endif + newDistrb%blockCnt(processor) = newDistrb%blockCnt(processor) + 1 + localID = newDistrb%blockCnt(processor) newDistrb%blockLocation(globalID) = processor newDistrb%blockLocalID (globalID) = localID - newDistrb%blockIndex(processor,localID) = globalID cnt = cnt + 1 totblocks = totblocks-1 bfree(globalID) = .false. - else ! no work - eliminate block from distribution bfree(globalID) = .false. newDistrb%blockLocation(globalID) = 0 @@ -1748,12 +1575,13 @@ function create_distrb_sectrobin(nprocs, workPerBlock) result(newDistrb) end do end do -! write(nu_diag,*) 'ice_distrb_sectrobin totblocks left after southern = ',totblocks +! write(nu_diag,*) subname,'totblocks left after southern = ',totblocks !------------------------------ ! northern group of blocks ! weave back and forth in i vs j ! go north to south, high - low pes + ! keepgoing to false to stop distribution !------------------------------ processor=nprocs @@ -1776,19 +1604,13 @@ function create_distrb_sectrobin(nprocs, workPerBlock) result(newDistrb) if (keepgoing) then if (bfree(globalID)) then if (workPerBlock(globalID) /= 0) then - proc_tmp(processor) = proc_tmp(processor) + 1 - localID = proc_tmp(processor) - if (localID > max_blocks) then - call abort_ice(subname//'ERROR: max_blocks too small') - return - endif + newDistrb%blockCnt(processor) = newDistrb%blockCnt(processor) + 1 + localID = newDistrb%blockCnt(processor) newDistrb%blockLocation(globalID) = processor newDistrb%blockLocalID (globalID) = localID - newDistrb%blockIndex(processor,localID) = globalID cnt = cnt + 1 - totblocks = totblocks - 1 + totblocks = totblocks-1 bfree(globalID) = .false. - else ! no work - eliminate block from distribution bfree(globalID) = .false. newDistrb%blockLocation(globalID) = 0 @@ -1799,12 +1621,13 @@ function create_distrb_sectrobin(nprocs, workPerBlock) result(newDistrb) end do end do -! write(nu_diag,*) 'ice_distrb_sectrobin totblocks left after northern = ',totblocks +! write(nu_diag,*) subname,'totblocks left after northern = ',totblocks !------------------------------ ! central group of blocks ! weave back and forth in i vs j ! go north to south, low - high / low - high pes + ! distribute rest of blocks in 2 chunks per proc !------------------------------ nchunks = 2*nprocs @@ -1820,35 +1643,29 @@ function create_distrb_sectrobin(nprocs, workPerBlock) result(newDistrb) endif globalID = (j-1)*nblocks_x + i2 if (totblocks > 0) then - do while (proc_tmp(processor) >= mblocks .or. cnt >= blktogether) - nchunks = nchunks - 1 - if (nchunks == 0) then - blktogether = 1 - else - blktogether = max(1,nint(float(totblocks)/float(nchunks))) - endif - cnt = 0 - processor = mod(processor,nprocs) + 1 - enddo + do while (newDistrb%blockCnt(processor) >= mblocks .or. cnt >= blktogether) + nchunks = nchunks - 1 + if (nchunks == 0) then + blktogether = 1 + else + blktogether = max(1,nint(float(totblocks)/float(nchunks))) + endif + cnt = 0 + processor = mod(processor,nprocs) + 1 + enddo endif -! write(nu_diag,*) 'ice_distrb_sectrobin central ',i,j,totblocks,cnt,nchunks,blktogether,processor +! write(nu_diag,*) subname,'central ',i,j,totblocks,cnt,nchunks,blktogether,processor if (bfree(globalID)) then if (workPerBlock(globalID) /= 0) then - proc_tmp(processor) = proc_tmp(processor) + 1 - localID = proc_tmp(processor) - if (localID > max_blocks) then - call abort_ice(subname//'ERROR: max_blocks too small') - return - endif + newDistrb%blockCnt(processor) = newDistrb%blockCnt(processor) + 1 + localID = newDistrb%blockCnt(processor) newDistrb%blockLocation(globalID) = processor newDistrb%blockLocalID (globalID) = localID - newDistrb%blockIndex(processor,localID) = globalID cnt = cnt + 1 totblocks = totblocks-1 bfree(globalID) = .false. - else ! no work - eliminate block from distribution bfree(globalID) = .false. newDistrb%blockLocation(globalID) = 0 @@ -1858,34 +1675,25 @@ function create_distrb_sectrobin(nprocs, workPerBlock) result(newDistrb) end do end do - newDistrb%numLocalBlocks = proc_tmp(my_task+1) - newDistrb%blockCnt(:) = proc_tmp(:) - deallocate(proc_tmp) - deallocate(bfree) + newDistrb%numLocalBlocks = newDistrb%blockCnt(my_task+1) -!---------------------------------------------------------------------- -! -! now store the local info -! -!---------------------------------------------------------------------- - - globalID = 0 + ! set local blockGlobalID array + allocate(newDistrb%blockGlobalID(newDistrb%numLocalBlocks), stat=istat) + if (ice_memusage_allocErr(istat,subname//'alloc numLocalBlocks')) return + do n = 1,nblocks_tot + if (my_task+1 == newDistrb%blockLocation(n)) then + localID = newDistrb%blockLocalID(n) + newDistrb%blockGlobalID (localID) = n + endif + enddo - if (newDistrb%numLocalBlocks > 0) then - allocate (newDistrb%blockGlobalID(newDistrb%numLocalBlocks), & - stat=istat) - if (istat > 0) then - call abort_ice( & - 'create_distrb_sectrobin: error allocating numLocalBlocks') - return + ! set/check max_blocks + if (max_blocks < 0) then + max_blocks = newDistrb%numLocalBlocks endif - processor = my_task + 1 - do localID = 1,newDistrb%numLocalBlocks - newDistrb%blockGlobalID (localID) = newDistrb%blockIndex(processor,& - localID) - enddo - endif + deallocate(bfree, stat=istat) + if (ice_memusage_allocErr(istat,subname//'dealloc bfree')) return !---------------------------------------------------------------------- @@ -1900,7 +1708,7 @@ function create_distrb_sectcart(nprocs, workPerBlock) result(newDistrb) ! standalone CAM mode. integer (int_kind), intent(in) :: & - nprocs ! number of processors in this distribution + nprocs ! number of processors in this distribution integer (int_kind), dimension(:), intent(in) :: & workPerBlock ! amount of work per block @@ -1924,9 +1732,6 @@ function create_distrb_sectcart(nprocs, workPerBlock) result(newDistrb) blktogether, &! number of blocks together cnt ! counter - integer (int_kind), dimension(:), allocatable :: & - proc_tmp ! temp processor id - integer (int_kind) :: n character(len=*),parameter :: subname='(create_distrb_sectcart)' @@ -1953,27 +1758,19 @@ function create_distrb_sectcart(nprocs, workPerBlock) result(newDistrb) ! !---------------------------------------------------------------------- - allocate (newDistrb%blockLocation(nblocks_tot), & - newDistrb%blockLocalID (nblocks_tot), stat=istat) - if (istat > 0) then - call abort_ice( & - 'create_distrb_sectcart: error allocating blockLocation or blockLocalID') - return - endif + allocate(newDistrb%blockLocation(nblocks_tot), & + newDistrb%blockLocalID (nblocks_tot), stat=istat) + if (ice_memusage_allocErr(istat,subname//'alloc blockLocation or blockLocalID')) return + + allocate(newDistrb%blockCnt(nprocs), stat=istat) + if (ice_memusage_allocErr(istat,subname//'alloc blockCnt')) return - allocate (newDistrb%blockCnt(nprocs)) !---------------------------------------------------------------------- ! ! distribute blocks linearly across processors in quadrants ! !---------------------------------------------------------------------- - allocate(proc_tmp(nprocs)) - proc_tmp = 0 - - allocate(newDistrb%blockIndex(nprocs,max_blocks)) - newDistrb%blockIndex(:,:) = 0 - blktogether = max(1,nint(float(nblocks_x*nblocks_y)/float(4*nprocs))) ! --- two phases, reset processor and cnt for each phase @@ -1981,10 +1778,14 @@ function create_distrb_sectcart(nprocs, workPerBlock) result(newDistrb) ! --- phase 2 is north to south, east to west on the right half of the domain if (mod(nblocks_x,2) /= 0) then - call abort_ice(subname//'ERROR: nblocks_x not divisible by 2') + call abort_ice(subname//'ERROR: nblocks_x not divisible by 2', & + file=__FILE__, line=__LINE__) return endif + newDistrb%numLocalBlocks = 0 + newDistrb%blockCnt(:) = 0 + do n=1,2 processor = 1 cnt = 0 @@ -2007,15 +1808,10 @@ function create_distrb_sectcart(nprocs, workPerBlock) result(newDistrb) cnt = cnt + 1 if (workPerBlock(globalID) /= 0) then - proc_tmp(processor) = proc_tmp(processor) + 1 - localID = proc_tmp(processor) - if (localID > max_blocks) then - call abort_ice(subname//'ERROR: max_blocks too small') - return - endif + newDistrb%blockCnt(processor) = newDistrb%blockCnt(processor) + 1 + localID = newDistrb%blockCnt(processor) newDistrb%blockLocation(globalID) = processor newDistrb%blockLocalID (globalID) = localID - newDistrb%blockIndex(processor,localID) = globalID else ! no work - eliminate block from distribution newDistrb%blockLocation(globalID) = 0 newDistrb%blockLocalID (globalID) = 0 @@ -2024,36 +1820,21 @@ function create_distrb_sectcart(nprocs, workPerBlock) result(newDistrb) end do end do end do + newDistrb%numLocalBlocks = newDistrb%blockCnt(my_task+1) + + ! set local blockGlobalID array + allocate(newDistrb%blockGlobalID(newDistrb%numLocalBlocks), stat=istat) + if (ice_memusage_allocErr(istat,subname//'alloc numLocalBlocks')) return + do n = 1,nblocks_tot + if (my_task+1 == newDistrb%blockLocation(n)) then + localID = newDistrb%blockLocalID(n) + newDistrb%blockGlobalID (localID) = n + endif + enddo - newDistrb%numLocalBlocks = proc_tmp(my_task+1) - newDistrb%blockCnt(:) = proc_tmp(:) - deallocate(proc_tmp) - -! write(nu_diag,*) 'my_task,newDistrb%numLocalBlocks',& -! my_task,newDistrb%numLocalBlocks - -!---------------------------------------------------------------------- -! -! now store the local info -! -!---------------------------------------------------------------------- - - globalID = 0 - - if (newDistrb%numLocalBlocks > 0) then - allocate (newDistrb%blockGlobalID(newDistrb%numLocalBlocks), & - stat=istat) - if (istat > 0) then - call abort_ice( & - 'create_distrb_sectcart: error allocating numLocalBlocks') - return - endif - - processor = my_task + 1 - do localID = 1,newDistrb%numLocalBlocks - newDistrb%blockGlobalID (localID) = newDistrb%blockIndex(processor,& - localID) - enddo + ! set/check max_blocks + if (max_blocks < 0) then + max_blocks = newDistrb%numLocalBlocks endif !---------------------------------------------------------------------- @@ -2062,7 +1843,7 @@ end function create_distrb_sectcart !********************************************************************** - function create_distrb_spacecurve(nprocs,work_per_block) + function create_distrb_spacecurve(nprocs,work_per_block) result(newDistrb) ! This function distributes blocks across processors in a ! load-balanced manner using space-filling curves @@ -2071,14 +1852,14 @@ function create_distrb_spacecurve(nprocs,work_per_block) use ice_spacecurve integer (int_kind), intent(in) :: & - nprocs ! number of processors in this distribution + nprocs ! number of processors in this distribution integer (int_kind), dimension(:), intent(in) :: & - work_per_block ! amount of work per block + work_per_block ! amount of work per block type (distrb) :: & - create_distrb_spacecurve ! resulting structure describing - ! load-balanced distribution of blocks + newDistrb ! resulting structure describing Cartesian + ! distribution of blocks !---------------------------------------------------------------------- ! @@ -2087,16 +1868,18 @@ function create_distrb_spacecurve(nprocs,work_per_block) !---------------------------------------------------------------------- integer (int_kind) :: & - i,j,n ,&! dummy loop indices - pid ,&! dummy for processor id + i, j, n, &! dummy loop indices + istat, &! status flag for allocation + processor, &! processor position in cartesian decomp + globalID, &! global block ID localID ! local block position on processor integer (int_kind), dimension(:),allocatable :: & idxT_i,idxT_j ! Temporary indices for SFC integer (int_kind), dimension(:,:),allocatable :: & - Mesh ,&! !arrays to hold Space-filling curve - Mesh2 ,&! + Mesh, &! !arrays to hold Space-filling curve + Mesh2, &! Mesh3 ! integer (int_kind) :: & @@ -2111,11 +1894,6 @@ function create_distrb_spacecurve(nprocs,work_per_block) integer (int_kind) :: subNum, sfcNum logical :: foundx - integer (int_kind), dimension(:), allocatable :: & - proc_tmp ! temp processor id for rake algrthm - - type (distrb) :: dist ! temp hold distribution - character(len=*),parameter :: subname='(create_distrb_spacecurve)' !------------------------------------------------------ @@ -2126,10 +1904,39 @@ function create_distrb_spacecurve(nprocs,work_per_block) !------------------------------------------------------ if((.not. IsFactorable(nblocks_y)) .or. (.not. IsFactorable(nblocks_x))) then - create_distrb_spacecurve = create_distrb_cart(nprocs, work_per_block) + newDistrb = create_distrb_cart(nprocs, work_per_block) return endif +!---------------------------------------------------------------------- +! +! create communicator for this distribution +! +!---------------------------------------------------------------------- + + call create_communicator(newDistrb%communicator, nprocs) + +!---------------------------------------------------------------------- +! +! try to find best processor arrangement +! +!---------------------------------------------------------------------- + + newDistrb%nprocs = nprocs + +!---------------------------------------------------------------------- +! +! allocate space for decomposition +! +!---------------------------------------------------------------------- + + allocate(newDistrb%blockLocation(nblocks_tot), & + newDistrb%blockLocalID (nblocks_tot), stat=istat) + if (ice_memusage_allocErr(istat,subname//'alloc blockLocation or blockLocalID')) return + + allocate(newDistrb%blockCnt(nprocs), stat=istat) + if (ice_memusage_allocErr(istat,subname//'alloc blockCnt')) return + !----------------------------------------------- ! Factor the numbers of blocks in each dimension !----------------------------------------------- @@ -2156,36 +1963,16 @@ function create_distrb_spacecurve(nprocs,work_per_block) sb_x = ProdFactor(xdim) sb_y = ProdFactor(ydim) - call create_communicator(dist%communicator, nprocs) - - dist%nprocs = nprocs - - !---------------------------------------------------------------------- - ! - ! allocate space for decomposition - ! - !---------------------------------------------------------------------- - - allocate (dist%blockLocation(nblocks_tot), & - dist%blockLocalID (nblocks_tot)) - - dist%blockLocation=0 - dist%blockLocalID =0 - - allocate (dist%blockCnt(nprocs)) - dist%blockCnt(:) = 0 - - allocate(dist%blockIndex(nprocs,max_blocks)) - dist%blockIndex(:,:) = 0 - !---------------------------------------------------------------------- ! Create the array to hold the SFC and indices into it !---------------------------------------------------------------------- - allocate(Mesh(curveSize,curveSize)) - allocate(Mesh2(nblocks_x,nblocks_y)) - allocate(Mesh3(nblocks_x,nblocks_y)) - allocate(idxT_i(nblocks_tot),idxT_j(nblocks_tot)) + allocate(Mesh(curveSize,curveSize), & + Mesh2(nblocks_x,nblocks_y), & + Mesh3(nblocks_x,nblocks_y), & + idxT_i(nblocks_tot), & + idxT_j(nblocks_tot), stat=istat) + if (ice_memusage_allocErr(istat,subname//'alloc meshes')) return Mesh = 0 Mesh2 = 0 @@ -2266,7 +2053,7 @@ function create_distrb_spacecurve(nprocs,work_per_block) ! ! First region gets nblocksL+1 blocks per partition ! Second region gets nblocksL blocks per partition -! if(debug_blocks) write(nu_diag,*) 'nprocs,extra,nblocks,nblocksL,s1: ', & +! if(debug_blocks) write(nu_diag,*) subname,'nprocs,extra,nblocks,nblocksL,s1: ', & ! nprocs,extra,nblocks,nblocksL,s1 !----------------------------------------------------------- @@ -2285,7 +2072,7 @@ function create_distrb_spacecurve(nprocs,work_per_block) ! ------------------------------------ ii=ii-1 tmp1 = ii/(nblocksL+1) - dist%blockLocation(n) = tmp1+1 + newDistrb%blockLocation(n) = tmp1+1 else ! ------------------------------------ ! If on the second region of curve @@ -2293,7 +2080,7 @@ function create_distrb_spacecurve(nprocs,work_per_block) ! ------------------------------------ ii=ii-s1-1 tmp1 = ii/nblocksL - dist%blockLocation(n) = extra + tmp1 + 1 + newDistrb%blockLocation(n) = extra + tmp1 + 1 endif endif enddo @@ -2303,54 +2090,52 @@ function create_distrb_spacecurve(nprocs,work_per_block) ! Reset the dist data structure !---------------------------------------------------------------------- - allocate(proc_tmp(nprocs)) - proc_tmp = 0 + globalID = 0 + newDistrb%numLocalBlocks = 0 + newDistrb%blockCnt(:) = 0 do n=1,nblocks_tot - pid = dist%blockLocation(n) - !!!dist%blockLocation(n) = pid - - if(pid>0) then - proc_tmp(pid) = proc_tmp(pid) + 1 - if (proc_tmp(pid) > max_blocks) then - call abort_ice(subname//'ERROR: max_blocks too small') - return - endif - dist%blockLocalID(n) = proc_tmp(pid) - dist%blockIndex(pid,proc_tmp(pid)) = n - else - dist%blockLocalID(n) = 0 + globalID = n + processor = newDistrb%blockLocation(globalID) + if (processor > 0) then + newDistrb%blockCnt(processor) = newDistrb%blockCnt(processor) + 1 + localID = newDistrb%blockCnt(processor) + newDistrb%blockLocalID (globalID) = localID + else ! no work - eliminate block from distribution + newDistrb%blockLocation(globalID) = 0 + newDistrb%blockLocalID (globalID) = 0 endif enddo - dist%numLocalBlocks = proc_tmp(my_task+1) - dist%blockCnt(:) = proc_tmp(:) + newDistrb%numLocalBlocks = newDistrb%blockCnt(my_task+1) - if (dist%numLocalBlocks > 0) then - allocate (dist%blockGlobalID(dist%numLocalBlocks)) - dist%blockGlobalID = 0 - endif - localID = 0 - do n=1,nblocks_tot - if (dist%blockLocation(n) == my_task+1) then - localID = localID + 1 - dist%blockGlobalID(localID) = n + ! set local blockGlobalID array + allocate(newDistrb%blockGlobalID(newDistrb%numLocalBlocks), stat=istat) + if (ice_memusage_allocErr(istat,subname//'alloc numLocalBlocks')) return + do n = 1,nblocks_tot + if (my_task+1 == newDistrb%blockLocation(n)) then + localID = newDistrb%blockLocalID(n) + newDistrb%blockGlobalID (localID) = n endif enddo + ! set/check max_blocks + if (max_blocks < 0) then + max_blocks = newDistrb%numLocalBlocks + endif + ! if (debug_blocks) then -! if (my_task == master_task) write(nu_diag,*) 'dist%blockLocation:= ',dist%blockLocation -! write(nu_diag,*) 'IAM: ',my_task,' SpaceCurve: Number of blocks {total,local} :=', & -! nblocks_tot,nblocks,proc_tmp(my_task+1) +! if (my_task == master_task) write(nu_diag,*) subname,'dist%blockLocation:= ',dist%blockLocation +! write(nu_diag,*) subname,'IAM: ',my_task,' SpaceCurve: Number of blocks {total,local} :=', & +! nblocks_tot,nblocks,newDistrb%numLocalBlocks ! endif + !--------------------------------- ! Deallocate temporary arrays !--------------------------------- - deallocate(proc_tmp) - deallocate(Mesh,Mesh2,Mesh3) - deallocate(idxT_i,idxT_j) - create_distrb_spacecurve = dist ! return the result + deallocate(Mesh,Mesh2,Mesh3,idxT_i,idxT_j, stat=istat) + if (ice_memusage_allocErr(istat,subname//'dealloc meshes')) return !---------------------------------------------------------------------- @@ -2374,11 +2159,11 @@ subroutine ice_distributionRake (procWork, procID, blockWork, & ! ensure a block does not stray too far from its neighbors. integer (int_kind), intent(in), dimension(:) :: & - blockWork ,&! amount of work per block + blockWork, &! amount of work per block procID ! global processor number integer (int_kind), intent(inout), dimension(:) :: & - procWork ,&! amount of work per processor + procWork, &! amount of work per processor priority ! priority for moving a given block type (distrb), intent(inout) :: & @@ -2394,7 +2179,7 @@ subroutine ice_distributionRake (procWork, procID, blockWork, & i, n, &! dummy loop indices np1, &! n+1 corrected for cyclical wrap iproc, inext, &! processor ids for current and next - nprocs, numBlocks, &! number of blocks, processors + nprocs, numBlocks, &! number of blocks, processors lastPriority, &! priority for most recent block minPriority, &! minimum priority lastLoc, &! location for most recent block diff --git a/cicecore/shared/ice_domain_size.F90 b/cicecore/shared/ice_domain_size.F90 index 999a35f48..b0ac9b036 100644 --- a/cicecore/shared/ice_domain_size.F90 +++ b/cicecore/shared/ice_domain_size.F90 @@ -21,7 +21,7 @@ module ice_domain_size ! namelist integer (kind=int_kind), public :: & - max_blocks , & ! max number of blocks per processor + max_blocks , & ! number of blocks allocated per task block_size_x, & ! size of block in first horiz dimension block_size_y, & ! size of block in second horiz dimension nx_global , & ! i-axis size @@ -47,15 +47,6 @@ module ice_domain_size integer (kind=int_kind), public, parameter :: & max_nstrm = 5 ! max number of history output streams - !*** The model will inform the user of the correct - !*** values for the parameter below. A value higher than - !*** necessary will not cause the code to fail, but will - !*** allocate more memory than is necessary. A value that - !*** is too low will cause the code to exit. - !*** A good initial guess is found using - !*** max_blocks = (nx_global/block_size_x)*(ny_global/block_size_y)/ - !*** num_procs - !======================================================================= end module ice_domain_size diff --git a/configuration/scripts/cice_decomp.csh b/configuration/scripts/cice_decomp.csh index bcf27beee..d990c628f 100755 --- a/configuration/scripts/cice_decomp.csh +++ b/configuration/scripts/cice_decomp.csh @@ -167,7 +167,8 @@ setenv ICE_DECOMP_NXGLOB $nxglob setenv ICE_DECOMP_NYGLOB $nyglob setenv ICE_DECOMP_BLCKX $blckx setenv ICE_DECOMP_BLCKY $blcky -setenv ICE_DECOMP_MXBLCKS $mxblcks +# tcraig, do not override max blocks value of -1 +#setenv ICE_DECOMP_MXBLCKS $mxblcks setenv ICE_DECOMP_DECOMP $decomp setenv ICE_DECOMP_DSHAPE $dshape diff --git a/configuration/scripts/tests/decomp_suite.ts b/configuration/scripts/tests/decomp_suite.ts index 8d47506d6..d33572f0b 100644 --- a/configuration/scripts/tests/decomp_suite.ts +++ b/configuration/scripts/tests/decomp_suite.ts @@ -1,8 +1,10 @@ # Test Grid PEs Sets BFB-compare restart gx3 4x2x25x29x4 dslenderX2 restart gx1 64x1x16x16x10 dwghtfile +restart gx1 32x2x10x12x32 dsectcart,short restart gbox180 16x1x6x6x60 dspacecurve,debugblocks decomp gx3 4x2x25x29x5 none +decomp gx3 4x2x25x29 none decomp gx3 4x2x25x29x5 dynpicard,reprosum decomp gx3 4x2x25x29x5 dyneap restart gx3 1x1x50x58x4 droundrobin,thread restart_gx3_4x2x25x29x4_dslenderX2 @@ -13,7 +15,7 @@ restart gx3 6x2x50x58x1 droundrobin restart_gx3_4x2x25x2 restart gx3 5x2x33x23x4 droundrobin restart_gx3_4x2x25x29x4_dslenderX2 restart gx3 4x2x19x19x10 droundrobin restart_gx3_4x2x25x29x4_dslenderX2 restart gx3 20x2x5x4x30 dsectrobin,short restart_gx3_4x2x25x29x4_dslenderX2 -restart gx3 16x2x5x10x20 drakeX2 restart_gx3_4x2x25x29x4_dslenderX2 +restart gx3 16x2x5x10 drakeX2 restart_gx3_4x2x25x29x4_dslenderX2 restart gx3 8x2x8x10x20 droundrobin,maskhalo restart_gx3_4x2x25x29x4_dslenderX2 restart gx3 1x4x25x29x16 droundrobin restart_gx3_4x2x25x29x4_dslenderX2 restart gx3 1x8x30x20x32 droundrobin restart_gx3_4x2x25x29x4_dslenderX2 @@ -23,28 +25,29 @@ restart gx3 16x2x2x2x200 droundrobin restart_gx3_4x2x25x2 restart gx3 16x2x3x3x100 droundrobin restart_gx3_4x2x25x29x4_dslenderX2 restart gx3 16x2x8x8x80 dspiralcenter restart_gx3_4x2x25x29x4_dslenderX2 restart gx3 10x1x10x29x4 dsquarepop,thread restart_gx3_4x2x25x29x4_dslenderX2 -restart gx3 8x1x25x29x4 drakeX2,thread restart_gx3_4x2x25x29x4_dslenderX2 +restart gx3 8x1x25x29 drakeX2,thread restart_gx3_4x2x25x29x4_dslenderX2 -smoke gx3 4x2x25x29x4 debug,run2day,dslenderX2 -smoke gx1 64x1x16x16x10 debug,run2day,dwghtfile -smoke gbox180 16x1x6x6x60 debug,run2day,dspacecurve,debugblocks -smoke gx3 1x1x25x58x8 debug,run2day,droundrobin,thread smoke_gx3_4x2x25x29x4_debug_dslenderX2_run2day -smoke gx3 20x1x5x116x1 debug,run2day,dslenderX1,thread smoke_gx3_4x2x25x29x4_debug_dslenderX2_run2day -smoke gx3 6x2x4x29x18 debug,run2day,dspacecurve smoke_gx3_4x2x25x29x4_debug_dslenderX2_run2day -smoke gx3 8x2x10x12x16 debug,run2day,droundrobin smoke_gx3_4x2x25x29x4_debug_dslenderX2_run2day -smoke gx3 6x2x50x58x1 debug,run2day,droundrobin smoke_gx3_4x2x25x29x4_debug_dslenderX2_run2day -smoke gx3 5x2x33x23x4 debug,run2day,droundrobin smoke_gx3_4x2x25x29x4_debug_dslenderX2_run2day -smoke gx3 4x2x19x19x10 debug,run2day,droundrobin smoke_gx3_4x2x25x29x4_debug_dslenderX2_run2day -smoke gx3 20x2x5x4x30 debug,run2day,dsectrobin,short smoke_gx3_4x2x25x29x4_debug_dslenderX2_run2day -smoke gx3 16x2x5x10x20 debug,run2day,drakeX2 smoke_gx3_4x2x25x29x4_debug_dslenderX2_run2day -smoke gx3 8x2x8x10x20 debug,run2day,droundrobin,maskhalo smoke_gx3_4x2x25x29x4_debug_dslenderX2_run2day -smoke gx3 1x6x25x29x16 debug,run2day,droundrobin smoke_gx3_4x2x25x29x4_debug_dslenderX2_run2day -smoke gx3 1x8x30x20x32 debug,run2day,droundrobin smoke_gx3_4x2x25x29x4_debug_dslenderX2_run2day -smoke gx3 1x1x120x125x1 debug,run2day,droundrobin,thread smoke_gx3_4x2x25x29x4_debug_dslenderX2_run2day -smoke gx3 16x2x1x1x800 debug,run2day,droundrobin smoke_gx3_4x2x25x29x4_debug_dslenderX2_run2day -smoke gx3 16x2x2x2x200 debug,run2day,droundrobin smoke_gx3_4x2x25x29x4_debug_dslenderX2_run2day -smoke gx3 16x2x3x3x100 debug,run2day,droundrobin smoke_gx3_4x2x25x29x4_debug_dslenderX2_run2day -smoke gx3 16x2x8x8x80 debug,run2day,dspiralcenter smoke_gx3_4x2x25x29x4_debug_dslenderX2_run2day -smoke gx3 10x1x10x29x4 debug,run2day,dsquarepop,thread smoke_gx3_4x2x25x29x4_debug_dslenderX2_run2day -smoke gx3 8x1x25x29x4 debug,run2day,drakeX2,thread smoke_gx3_4x2x25x29x4_debug_dslenderX2_run2day +smoke gx3 4x2x25x29 debug,run2day,dslenderX2 +smoke gx1 64x1x16x16 debug,run2day,dwghtfile +smoke gx1 32x2x10x12 debug,run2day,dsectcart +smoke gbox180 16x1x6x6 debug,run2day,dspacecurve,debugblocks +smoke gx3 1x1x25x58 debug,run2day,droundrobin,thread smoke_gx3_4x2x25x29_debug_dslenderX2_run2day +smoke gx3 20x1x5x116 debug,run2day,dslenderX1,thread smoke_gx3_4x2x25x29_debug_dslenderX2_run2day +smoke gx3 6x2x4x29 debug,run2day,dspacecurve smoke_gx3_4x2x25x29_debug_dslenderX2_run2day +smoke gx3 8x2x10x12x18 debug,run2day,droundrobin smoke_gx3_4x2x25x29_debug_dslenderX2_run2day +smoke gx3 6x2x50x58 debug,run2day,droundrobin smoke_gx3_4x2x25x29_debug_dslenderX2_run2day +smoke gx3 5x2x33x23 debug,run2day,droundrobin smoke_gx3_4x2x25x29_debug_dslenderX2_run2day +smoke gx3 4x2x19x19x10 debug,run2day,droundrobin smoke_gx3_4x2x25x29_debug_dslenderX2_run2day +smoke gx3 20x2x5x4 debug,run2day,dsectrobin,short smoke_gx3_4x2x25x29_debug_dslenderX2_run2day +smoke gx3 16x2x5x10 debug,run2day,drakeX2 smoke_gx3_4x2x25x29_debug_dslenderX2_run2day +smoke gx3 8x2x8x10x20 debug,run2day,droundrobin,maskhalo smoke_gx3_4x2x25x29_debug_dslenderX2_run2day +smoke gx3 1x6x25x29x16 debug,run2day,droundrobin smoke_gx3_4x2x25x29_debug_dslenderX2_run2day +smoke gx3 1x8x30x20x32 debug,run2day,droundrobin smoke_gx3_4x2x25x29_debug_dslenderX2_run2day +smoke gx3 1x1x120x125x1 debug,run2day,droundrobin,thread smoke_gx3_4x2x25x29_debug_dslenderX2_run2day +smoke gx3 16x2x1x1x800 debug,run2day,droundrobin smoke_gx3_4x2x25x29_debug_dslenderX2_run2day +smoke gx3 16x2x2x2x200 debug,run2day,droundrobin smoke_gx3_4x2x25x29_debug_dslenderX2_run2day +smoke gx3 16x2x3x3x100 debug,run2day,droundrobin smoke_gx3_4x2x25x29_debug_dslenderX2_run2day +smoke gx3 16x2x8x8 debug,run2day,dspiralcenter smoke_gx3_4x2x25x29_debug_dslenderX2_run2day +smoke gx3 10x1x10x29 debug,run2day,dsquarepop,thread smoke_gx3_4x2x25x29_debug_dslenderX2_run2day +smoke gx3 8x1x25x29 debug,run2day,drakeX2,thread smoke_gx3_4x2x25x29_debug_dslenderX2_run2day diff --git a/configuration/scripts/tests/first_suite.ts b/configuration/scripts/tests/first_suite.ts index bef24d9eb..208c786f8 100644 --- a/configuration/scripts/tests/first_suite.ts +++ b/configuration/scripts/tests/first_suite.ts @@ -2,18 +2,18 @@ smoke gx3 8x2 diag1,run5day # decomp_suite restart gx3 4x2x25x29x4 dslenderX2 -smoke gx3 4x2x25x29x4 debug,run2day,dslenderX2 +smoke gx3 4x2x25x29 debug,run2day,dslenderX2 # reprosum_suite smoke gx3 4x2x25x29x4 dslenderX2,diag1,reprosum # travis_suite smoke gx3 1x2 run2day # gridsys_suite -smoke gx3 1x1x100x116x1 reprosum,run10day -smoke gx1 32x1x16x16x32 reprosum,run10day -smoke gx3 1x1x100x116x1 reprosum,run10day,gridcd -smoke gx1 32x1x16x16x32 reprosum,run10day,gridcd -smoke gx3 1x1x100x116x1 reprosum,run10day,gridc -smoke gx1 32x1x16x16x32 reprosum,run10day,gridc +smoke gx3 1x1x100x116 reprosum,run10day +smoke gx1 32x1x16x16 reprosum,run10day +smoke gx3 1x1x100x116 reprosum,run10day,gridcd +smoke gx1 32x1x16x16 reprosum,run10day,gridcd +smoke gx3 1x1x100x116 reprosum,run10day,gridc +smoke gx1 32x1x16x16 reprosum,run10day,gridc # perf_suite -smoke gx1 32x1x16x16x15 run2day,droundrobin -smoke gx1 64x1x16x16x8 run2day,droundrobin,thread +smoke gx1 32x1x16x16 run2day,droundrobin +smoke gx1 64x1x16x16 run2day,droundrobin,thread diff --git a/configuration/scripts/tests/gridsys_suite.ts b/configuration/scripts/tests/gridsys_suite.ts index e2731dd39..eca6497a4 100644 --- a/configuration/scripts/tests/gridsys_suite.ts +++ b/configuration/scripts/tests/gridsys_suite.ts @@ -1,17 +1,17 @@ # Test Grid PEs Sets BFB-compare -smoke gx3 1x1x100x116x1 reprosum,run10day -smoke gx1 32x1x16x16x32 reprosum,run10day -smoke gx3 1x1x100x116x1 reprosum,run10day,gridcd -smoke gx1 32x1x16x16x32 reprosum,run10day,gridcd -smoke gx3 1x1x100x116x1 reprosum,run10day,gridc -smoke gx1 32x1x16x16x32 reprosum,run10day,gridc +smoke gx3 1x1x100x116 reprosum,run10day +smoke gx1 32x1x16x16 reprosum,run10day +smoke gx3 1x1x100x116 reprosum,run10day,gridcd +smoke gx1 32x1x16x16 reprosum,run10day,gridcd +smoke gx3 1x1x100x116 reprosum,run10day,gridc +smoke gx1 32x1x16x16 reprosum,run10day,gridc smoke gx3 8x2 diag1,run5day smoke gx3 8x4 diag1,run5day,debug restart gx3 4x2 debug,diag1 restart2 gx1 16x2 debug,diag1 restart tx1 40x2 diag1 -smoke gbox12 1x1x12x12x1 boxchan +smoke gbox12 1x1x12x12 boxchan smoke gbox80 4x2 boxchan1e,debug smoke gbox80 8x1 boxchan1n smoke gbox80 1x1 box2001 @@ -22,19 +22,19 @@ smoke gbox80 4x2 boxclosed,boxforcee,run1day smoke gbox80 4x1 boxclosed,boxforcene,run1day,kmtislands smoke gbox80 4x2 boxopen,kmtislands,boxforcee,run1day smoke gbox80 2x2 boxclosed,boxforcen,run1day,vargrid -smoke gx3 1x1x25x29x16 reprosum,run10day,dwblockall smoke_gx3_1x1x100x116x1_reprosum_run10day -smoke gx3 1x1x5x4x580 reprosum,run10day,dwblockall smoke_gx3_1x1x100x116x1_reprosum_run10day -smoke gx3 1x1x5x4x580 reprosum,run10day smoke_gx3_1x1x100x116x1_reprosum_run10day -smoke gx1 32x1x16x16x32 reprosum,run10day,cmplogrest,dwblockall smoke_gx1_32x1x16x16x32_reprosum_run10day -smoke gx1 32x1x16x12x40 reprosum,run10day,cmplogrest,dwblockall smoke_gx1_32x1x16x16x32_reprosum_run10day -smoke gx1 32x1x16x12x40 reprosum,run10day,cmplogrest smoke_gx1_32x1x16x16x32_reprosum_run10day +smoke gx3 1x1x25x29 reprosum,run10day,dwblockall smoke_gx3_1x1x100x116_reprosum_run10day +smoke gx3 1x1x5x4 reprosum,run10day,dwblockall smoke_gx3_1x1x100x116_reprosum_run10day +smoke gx3 1x1x5x4 reprosum,run10day smoke_gx3_1x1x100x116_reprosum_run10day +smoke gx1 32x1x16x16 reprosum,run10day,cmplogrest,dwblockall smoke_gx1_32x1x16x16_reprosum_run10day +smoke gx1 32x1x16x12 reprosum,run10day,cmplogrest,dwblockall smoke_gx1_32x1x16x16_reprosum_run10day +smoke gx1 32x1x16x12 reprosum,run10day,cmplogrest smoke_gx1_32x1x16x16_reprosum_run10day smoke gx3 8x2 diag1,run5day,gridcd smoke gx3 8x4 diag1,run5day,debug,gridcd restart gx3 4x2 debug,diag1,gridcd restart2 gx1 16x2 debug,diag1,gridcd restart tx1 40x2 diag1,gridcd -smoke gbox12 1x1x12x12x1 boxchan,gridcd +smoke gbox12 1x1x12x12 boxchan,gridcd smoke gbox80 4x2 boxchan1e,debug,gridcd smoke gbox80 8x1 boxchan1n,gridcd smoke gbox80 1x1 box2001,gridcd @@ -45,19 +45,19 @@ smoke gbox80 4x2 boxclosed,boxforcee,run1day,gridcd smoke gbox80 4x1 boxclosed,boxforcene,run1day,kmtislands,gridcd smoke gbox80 4x2 boxopen,kmtislands,boxforcee,run1day,gridcd smoke gbox80 2x2 boxclosed,boxforcen,run1day,vargrid,gridcd -smoke gx3 1x1x25x29x16 reprosum,run10day,dwblockall,gridcd smoke_gx3_1x1x100x116x1_gridcd_reprosum_run10day -smoke gx3 1x1x5x4x580 reprosum,run10day,dwblockall,gridcd smoke_gx3_1x1x100x116x1_gridcd_reprosum_run10day -smoke gx3 1x1x5x4x580 reprosum,run10day,gridcd smoke_gx3_1x1x100x116x1_gridcd_reprosum_run10day -smoke gx1 32x1x16x16x32 reprosum,run10day,cmplogrest,dwblockall,gridcd smoke_gx1_32x1x16x16x32_gridcd_reprosum_run10day -smoke gx1 32x1x16x12x40 reprosum,run10day,cmplogrest,dwblockall,gridcd smoke_gx1_32x1x16x16x32_gridcd_reprosum_run10day -smoke gx1 32x1x16x12x40 reprosum,run10day,cmplogrest,gridcd smoke_gx1_32x1x16x16x32_gridcd_reprosum_run10day +smoke gx3 1x1x25x29 reprosum,run10day,dwblockall,gridcd smoke_gx3_1x1x100x116_gridcd_reprosum_run10day +smoke gx3 1x1x5x4 reprosum,run10day,dwblockall,gridcd smoke_gx3_1x1x100x116_gridcd_reprosum_run10day +smoke gx3 1x1x5x4 reprosum,run10day,gridcd smoke_gx3_1x1x100x116_gridcd_reprosum_run10day +smoke gx1 32x1x16x16 reprosum,run10day,cmplogrest,dwblockall,gridcd smoke_gx1_32x1x16x16_gridcd_reprosum_run10day +smoke gx1 32x1x16x12 reprosum,run10day,cmplogrest,dwblockall,gridcd smoke_gx1_32x1x16x16_gridcd_reprosum_run10day +smoke gx1 32x1x16x12 reprosum,run10day,cmplogrest,gridcd smoke_gx1_32x1x16x16_gridcd_reprosum_run10day smoke gx3 8x2 diag1,run5day,gridc smoke gx3 8x4 diag1,run5day,debug,gridc restart gx3 4x2 debug,diag1,gridc restart2 gx1 16x2 debug,diag1,gridc restart tx1 40x2 diag1,gridc -smoke gbox12 1x1x12x12x1 boxchan,gridc +smoke gbox12 1x1x12x12 boxchan,gridc smoke gbox80 4x2 boxchan1e,debug,gridc smoke gbox80 8x1 boxchan1n,gridc smoke gbox80 1x1 box2001,gridc @@ -68,9 +68,9 @@ smoke gbox80 4x2 boxclosed,boxforcee,run1day,gridc smoke gbox80 4x1 boxclosed,boxforcene,run1day,kmtislands,gridc smoke gbox80 4x2 boxopen,kmtislands,boxforcee,run1day,gridc smoke gbox80 2x2 boxclosed,boxforcen,run1day,vargrid,gridc -smoke gx3 1x1x25x29x16 reprosum,run10day,dwblockall,gridc smoke_gx3_1x1x100x116x1_gridc_reprosum_run10day -smoke gx3 1x1x5x4x580 reprosum,run10day,dwblockall,gridc smoke_gx3_1x1x100x116x1_gridc_reprosum_run10day -smoke gx3 1x1x5x4x580 reprosum,run10day,gridc smoke_gx3_1x1x100x116x1_gridc_reprosum_run10day -smoke gx1 32x1x16x16x32 reprosum,run10day,cmplogrest,dwblockall,gridc smoke_gx1_32x1x16x16x32_gridc_reprosum_run10day -smoke gx1 32x1x16x12x40 reprosum,run10day,cmplogrest,dwblockall,gridc smoke_gx1_32x1x16x16x32_gridc_reprosum_run10day -smoke gx1 32x1x16x12x40 reprosum,run10day,cmplogrest,gridc smoke_gx1_32x1x16x16x32_gridc_reprosum_run10day +smoke gx3 1x1x25x29 reprosum,run10day,dwblockall,gridc smoke_gx3_1x1x100x116_gridc_reprosum_run10day +smoke gx3 1x1x5x4 reprosum,run10day,dwblockall,gridc smoke_gx3_1x1x100x116_gridc_reprosum_run10day +smoke gx3 1x1x5x4 reprosum,run10day,gridc smoke_gx3_1x1x100x116_gridc_reprosum_run10day +smoke gx1 32x1x16x16 reprosum,run10day,cmplogrest,dwblockall,gridc smoke_gx1_32x1x16x16_gridc_reprosum_run10day +smoke gx1 32x1x16x12 reprosum,run10day,cmplogrest,dwblockall,gridc smoke_gx1_32x1x16x16_gridc_reprosum_run10day +smoke gx1 32x1x16x12 reprosum,run10day,cmplogrest,gridc smoke_gx1_32x1x16x16_gridc_reprosum_run10day diff --git a/configuration/scripts/tests/perf_suite.ts b/configuration/scripts/tests/perf_suite.ts index a4d8ef588..a7da95390 100644 --- a/configuration/scripts/tests/perf_suite.ts +++ b/configuration/scripts/tests/perf_suite.ts @@ -1,29 +1,29 @@ # Test Grid PEs Sets BFB-compare -smoke gx1 32x1x16x16x15 run2day,droundrobin -smoke gx1 64x1x16x16x8 run2day,droundrobin,thread +smoke gx1 32x1x16x16 run2day,droundrobin +smoke gx1 64x1x16x16 run2day,droundrobin,thread # -smoke gx1 1x1x320x384x1 run2day,droundrobin smoke_gx1_32x1x16x16x15_droundrobin_run2day -smoke gx1 1x1x160x192x4 run2day,droundrobin smoke_gx1_32x1x16x16x15_droundrobin_run2day -smoke gx1 1x1x80x96x16 run2day,droundrobin smoke_gx1_32x1x16x16x15_droundrobin_run2day -smoke gx1 1x1x40x48x64 run2day,droundrobin smoke_gx1_32x1x16x16x15_droundrobin_run2day -smoke gx1 1x1x20x24x256 run2day,droundrobin smoke_gx1_32x1x16x16x15_droundrobin_run2day +smoke gx1 1x1x320x384 run2day,droundrobin smoke_gx1_32x1x16x16_droundrobin_run2day +smoke gx1 1x1x160x192 run2day,droundrobin smoke_gx1_32x1x16x16_droundrobin_run2day +smoke gx1 1x1x80x96 run2day,droundrobin smoke_gx1_32x1x16x16_droundrobin_run2day +smoke gx1 1x1x40x48 run2day,droundrobin smoke_gx1_32x1x16x16_droundrobin_run2day +smoke gx1 1x1x20x24 run2day,droundrobin smoke_gx1_32x1x16x16_droundrobin_run2day # -smoke gx1 1x1x16x16x480 run2day,droundrobin smoke_gx1_32x1x16x16x15_droundrobin_run2day -smoke gx1 2x1x16x16x240 run2day,droundrobin smoke_gx1_32x1x16x16x15_droundrobin_run2day -smoke gx1 4x1x16x16x120 run2day,droundrobin smoke_gx1_32x1x16x16x15_droundrobin_run2day -smoke gx1 8x1x16x16x60 run2day,droundrobin smoke_gx1_32x1x16x16x15_droundrobin_run2day -smoke gx1 16x1x16x16x30 run2day,droundrobin smoke_gx1_32x1x16x16x15_droundrobin_run2day -#smoke gx1 32x1x16x16x15 run2day,droundrobin -smoke gx1 64x1x16x16x8 run2day,droundrobin smoke_gx1_32x1x16x16x15_droundrobin_run2day -smoke gx1 128x1x16x16x4 run2day,droundrobin smoke_gx1_32x1x16x16x15_droundrobin_run2day +smoke gx1 1x1x16x16 run2day,droundrobin smoke_gx1_32x1x16x16_droundrobin_run2day +smoke gx1 2x1x16x16 run2day,droundrobin smoke_gx1_32x1x16x16_droundrobin_run2day +smoke gx1 4x1x16x16 run2day,droundrobin smoke_gx1_32x1x16x16_droundrobin_run2day +smoke gx1 8x1x16x16 run2day,droundrobin smoke_gx1_32x1x16x16_droundrobin_run2day +smoke gx1 16x1x16x16 run2day,droundrobin smoke_gx1_32x1x16x16_droundrobin_run2day +#smoke gx1 32x1x16x16 run2day,droundrobin +smoke gx1 64x1x16x16 run2day,droundrobin smoke_gx1_32x1x16x16_droundrobin_run2day +smoke gx1 128x1x16x16 run2day,droundrobin smoke_gx1_32x1x16x16_droundrobin_run2day # -smoke gx1 64x1x16x16x8 run2day,droundrobin smoke_gx1_32x1x16x16x15_droundrobin_run2day -#smoke gx1 64x1x16x16x8 run2day,droundrobin,thread -smoke gx1 32x2x16x16x16 run2day,droundrobin smoke_gx1_64x1x16x16x8_droundrobin_run2day_thread -smoke gx1 16x4x16x16x32 run2day,droundrobin smoke_gx1_64x1x16x16x8_droundrobin_run2day_thread -smoke gx1 8x8x16x16x64 run2day,droundrobin smoke_gx1_64x1x16x16x8_droundrobin_run2day_thread -smoke gx1 4x16x16x16x128 run2day,droundrobin smoke_gx1_64x1x16x16x8_droundrobin_run2day_thread -smoke gx1 32x2x16x16x16 run2day,droundrobin,ompscheds smoke_gx1_64x1x16x16x8_droundrobin_run2day_thread -smoke gx1 32x2x16x16x16 run2day,droundrobin,ompschedd1 smoke_gx1_64x1x16x16x8_droundrobin_run2day_thread -smoke gx1 32x2x16x16x16 run2day,droundrobin,ompscheds1 smoke_gx1_64x1x16x16x8_droundrobin_run2day_thread +smoke gx1 64x1x16x16 run2day,droundrobin smoke_gx1_32x1x16x16_droundrobin_run2day +#smoke gx1 64x1x16x16 run2day,droundrobin,thread +smoke gx1 32x2x16x16 run2day,droundrobin smoke_gx1_64x1x16x16_droundrobin_run2day_thread +smoke gx1 16x4x16x16 run2day,droundrobin smoke_gx1_64x1x16x16_droundrobin_run2day_thread +smoke gx1 8x8x16x16 run2day,droundrobin smoke_gx1_64x1x16x16_droundrobin_run2day_thread +smoke gx1 4x16x16x16 run2day,droundrobin smoke_gx1_64x1x16x16_droundrobin_run2day_thread +smoke gx1 32x2x16x16 run2day,droundrobin,ompscheds smoke_gx1_64x1x16x16_droundrobin_run2day_thread +smoke gx1 32x2x16x16 run2day,droundrobin,ompschedd1 smoke_gx1_64x1x16x16_droundrobin_run2day_thread +smoke gx1 32x2x16x16 run2day,droundrobin,ompscheds1 smoke_gx1_64x1x16x16_droundrobin_run2day_thread # diff --git a/configuration/scripts/tests/unittest_suite.ts b/configuration/scripts/tests/unittest_suite.ts index 840fc822e..779e218ff 100644 --- a/configuration/scripts/tests/unittest_suite.ts +++ b/configuration/scripts/tests/unittest_suite.ts @@ -15,21 +15,34 @@ unittest gx1 28x1 gridavgchk,dwblockall unittest gx1 16x2 gridavgchk unittest gbox128 8x2 gridavgchk unittest gbox80 1x1x10x10x80 halochk,cyclic,debug +unittest gbox80 1x1x10x10 halochk,cyclic,debug unittest gbox80 1x1x24x23x16 halochk +unittest gbox80 1x1x24x23 halochk unittest gbox80 1x1x23x24x16 halochk,cyclic +unittest gbox80 1x1x23x24 halochk,cyclic unittest gbox80 1x1x23x23x16 halochk,open +unittest gbox80 1x1x23x23 halochk,open unittest tx1 1x1x90x60x16 halochk,dwblockall +unittest tx1 1x1x90x60 halochk,dwblockall unittest tx1 1x1x90x60x16 halochk,dwblockall,tripolet +unittest tx1 1x1x90x60 halochk,dwblockall,tripolet unittest tx1 1x1x95x65x16 halochk,dwblockall +unittest tx1 1x1x95x65 halochk,dwblockall unittest tx1 1x1x95x65x16 halochk,dwblockall,tripolet +unittest tx1 1x1x95x65 halochk,dwblockall,tripolet unittest gx3 4x2 halochk,dwblockall,debug unittest gx3 8x2x16x12x10 halochk,cyclic,dwblockall +unittest gx3 8x2x16x12 halochk,cyclic,dwblockall unittest gx3 17x1x16x12x10 halochk,open,dwblockall +unittest gx3 17x1x16x12 halochk,open,dwblockall unittest tx1 4x2 halochk,dwblockall unittest tx1 4x2 halochk,dwblockall,tripolet unittest tx1 4x2x65x45x10 halochk,dwblockall +unittest tx1 4x2x65x45 halochk,dwblockall unittest tx1 4x2x57x43x12 halochk,dwblockall,tripolet +unittest tx1 4x2x57x43 halochk,dwblockall,tripolet unittest gx3 1x1 optargs unittest gx3 1x1 opticep unittest gx3 4x2x25x29x4 debug,run2day,dslenderX2,opticep,cmplog smoke_gx3_4x2x25x29x4_debug_dslenderX2_run2day +unittest gx3 4x2x25x29 debug,run2day,dslenderX2,opticep,cmplog smoke_gx3_4x2x25x29x4_debug_dslenderX2_run2day unittest gx3 8x2 diag1,run5day,opticep,cmplog smoke_gx3_8x2_diag1_run5day diff --git a/doc/source/user_guide/ug_case_settings.rst b/doc/source/user_guide/ug_case_settings.rst index 6deab8c11..405e64dc1 100644 --- a/doc/source/user_guide/ug_case_settings.rst +++ b/doc/source/user_guide/ug_case_settings.rst @@ -369,6 +369,7 @@ domain_nml "``maskhalo_remap``", "logical", "mask unused halo cells for transport", "``.false.``" "``maskhalo_bound``", "logical", "mask unused halo cells for boundary updates", "``.false.``" "``max_blocks``", "integer", "maximum number of blocks per MPI task for memory allocation", "-1" + "", "``-1``", "find number of blocks per MPI task automatically", "" "``nprocs``", "integer", "number of MPI tasks to use", "-1" "", "``-1``", "find number of MPI tasks automatically", "" "``ns_boundary_type``", "``cyclic``", "periodic boundary conditions in y-direction", "``open``" diff --git a/doc/source/user_guide/ug_implementation.rst b/doc/source/user_guide/ug_implementation.rst index 7d172e91d..4f349c264 100644 --- a/doc/source/user_guide/ug_implementation.rst +++ b/doc/source/user_guide/ug_implementation.rst @@ -213,22 +213,24 @@ ghost cells, and the same numbering system is applied to each of the four subdomains. The user sets the ``NTASKS`` and ``NTHRDS`` settings in **cice.settings** -and chooses a block size ``block_size_x`` :math:`\times`\ ``block_size_y``, -``max_blocks``, and decomposition information ``distribution_type``, ``processor_shape``, -and ``distribution_type`` in **ice_in**. That information is used to -determine how the blocks are -distributed across the processors, and how the processors are -distributed across the grid domain. The model is parallelized over blocks +and chooses a block size, ``block_size_x`` :math:`\times`\ ``block_size_y``, +and decomposition information ``distribution_type``, ``processor_shape``, +and ``distribution_wgt`` in **ice_in**. +This information is used to determine how the blocks are +distributed across the processors. The model is parallelized over blocks for both MPI and OpenMP. Some suggested combinations for these parameters for best performance are given in Section :ref:`performance`. The script **cice.setup** computes some default decompositions and layouts -but the user can overwrite the defaults by manually changing the values in -`ice_in`. At runtime, the model will print decomposition +but the user can override the defaults by manually changing the values in +`ice_in`. The number of blocks per processor can vary, and this is computed +internally when the namelist ``max_blocks=-1``. ``max_blocks`` +can also be set by the user, although this may use extra memory and the +model will abort if ``max_blocks`` is set too small for the decomposition. +At runtime, the model will print decomposition information to the log file, and if the block size or max blocks is inconsistent with the task and thread size, the model will abort. The code will also print a warning if the maximum number of blocks is too large. -Although this is not fatal, it does use extra memory. If ``max_blocks`` is -set to -1, the code will compute a tentative ``max_blocks`` on the fly. +Although this is not fatal, it does use extra memory. A loop at the end of routine *create_blocks* in module **ice_blocks.F90** will print the locations for all of the blocks on From 4587504299b19173736eb718930af97331b28967 Mon Sep 17 00:00:00 2001 From: Tony Craig Date: Sat, 18 May 2024 06:42:07 -0700 Subject: [PATCH 72/76] Update Machine Ports, Add CPPs NO_CDF2, NO_CDF5 (#956) These changes are associated with the multi-machine pre-release testing for CICE. Update Hera port, new compiler version Add NO_CDF2, NO_CDF5, and NO_HDF5 CPP options to model to support older/other versions of netcdf. Several machines with only netcdf 4.4 do not support cdf5 format. Sometimes netcdf is not built with hdf5. We need a CPP to avoid that part of the code to allow the model to build on those machines. Set NO_CDF5 for gaffney, koehr, mustang machines Set NO_HDF5 for compy Update documentation --- .../io/io_netcdf/ice_history_write.F90 | 29 +++++++++++++++++++ .../io/io_netcdf/ice_restart.F90 | 22 ++++++++++++++ .../scripts/machines/Macros.compy_intel | 2 +- .../scripts/machines/Macros.gaffney_gnu | 2 +- .../scripts/machines/Macros.gaffney_intel | 2 +- .../scripts/machines/Macros.koehr_intel | 2 +- .../scripts/machines/Macros.mustang_intel18 | 2 +- .../scripts/machines/Macros.mustang_intel19 | 2 +- .../scripts/machines/Macros.mustang_intel20 | 2 +- configuration/scripts/machines/env.hera_intel | 7 +++-- doc/source/user_guide/ug_case_settings.rst | 3 ++ doc/source/user_guide/ug_implementation.rst | 5 +++- doc/source/user_guide/ug_running.rst | 2 ++ 13 files changed, 71 insertions(+), 11 deletions(-) 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 7d29fc4cc..92df8dad8 100644 --- a/cicecore/cicedyn/infrastructure/io/io_netcdf/ice_history_write.F90 +++ b/cicecore/cicedyn/infrastructure/io/io_netcdf/ice_history_write.F90 @@ -152,11 +152,26 @@ subroutine ice_write_hist (ns) if (history_format == 'cdf1') then iflag = nf90_clobber elseif (history_format == 'cdf2') then +#ifdef NO_CDF2 + call abort_ice(subname//' ERROR: history_format cdf2 not available ', & + file=__FILE__, line=__LINE__) +#else iflag = ior(nf90_clobber,nf90_64bit_offset) +#endif elseif (history_format == 'cdf5') then +#ifdef NO_CDF5 + call abort_ice(subname//' ERROR: history_format cdf5 not available ', & + file=__FILE__, line=__LINE__) +#else iflag = ior(nf90_clobber,nf90_64bit_data) +#endif elseif (history_format == 'hdf5') then +#ifdef NO_HDF5 + call abort_ice(subname//' ERROR: history_format hdf5 not available ', & + file=__FILE__, line=__LINE__) +#else iflag = ior(nf90_clobber,nf90_netcdf4) +#endif else call abort_ice(subname//' ERROR: history_format not allowed for '//trim(history_format), & file=__FILE__, line=__LINE__) @@ -1192,6 +1207,12 @@ subroutine ice_hist_field_def(ncid, hfield, lprecision, dimids, ns) 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__) +#ifdef NO_HDF5 + if (history_format=='hdf5') then + call abort_ice(subname//' ERROR: history_format hdf5 not available ', & + file=__FILE__, line=__LINE__) + endif +#else if (history_format=='hdf5' .and. size(dimids)>1) then if (dimids(1)==imtid .and. dimids(2)==jmtid) then chunks(1)=history_chunksize(1) @@ -1208,6 +1229,7 @@ subroutine ice_hist_field_def(ncid, hfield, lprecision, dimids, ns) 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 +#endif ! add attributes status = nf90_put_att(ncid,varid,'units', hfield%vunit) @@ -1335,6 +1357,12 @@ subroutine ice_hist_coord_def(ncid, coord, lprecision, dimids, varid) 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__) +#ifdef NO_HDF5 + if (history_format=='hdf5') then + call abort_ice(subname//' ERROR: history_format hdf5 not available ', & + file=__FILE__, line=__LINE__) + endif +#else if (history_format=='hdf5' .and. size(dimids)>1) then if (dimids(1)==imtid .and. dimids(2)==jmtid) then chunks(1)=history_chunksize(1) @@ -1351,6 +1379,7 @@ subroutine ice_hist_coord_def(ncid, coord, lprecision, dimids, varid) 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 +#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, & diff --git a/cicecore/cicedyn/infrastructure/io/io_netcdf/ice_restart.F90 b/cicecore/cicedyn/infrastructure/io/io_netcdf/ice_restart.F90 index e9be45481..9bf3b1d8a 100644 --- a/cicecore/cicedyn/infrastructure/io/io_netcdf/ice_restart.F90 +++ b/cicecore/cicedyn/infrastructure/io/io_netcdf/ice_restart.F90 @@ -221,11 +221,26 @@ subroutine init_restart_write(filename_spec) if (restart_format == 'cdf1') then iflag = nf90_clobber elseif (restart_format == 'cdf2') then +#ifdef NO_CDF2 + call abort_ice(subname//' ERROR: restart_format cdf2 not available ', & + file=__FILE__, line=__LINE__) +#else iflag = ior(nf90_clobber,nf90_64bit_offset) +#endif elseif (restart_format == 'cdf5') then +#ifdef NO_CDF5 + call abort_ice(subname//' ERROR: restart_format cdf5 not available ', & + file=__FILE__, line=__LINE__) +#else iflag = ior(nf90_clobber,nf90_64bit_data) +#endif elseif (restart_format == 'hdf5') then +#ifdef NO_HDF5 + call abort_ice(subname//' ERROR: restart_format hdf5 not available ', & + file=__FILE__, line=__LINE__) +#else iflag = ior(nf90_clobber,nf90_netcdf4) +#endif else call abort_ice(subname//' ERROR: restart_format not allowed for '//trim(restart_format), & file=__FILE__, line=__LINE__) @@ -894,6 +909,12 @@ subroutine define_rest_field(ncid, vname, dims) 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__) +#ifdef NO_HDF5 + if (restart_format=='hdf5') then + call abort_ice(subname//' ERROR: restart_format hdf5 not available ', & + file=__FILE__, line=__LINE__) + endif +#else 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) @@ -910,6 +931,7 @@ subroutine define_rest_field(ncid, vname, dims) 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 +#endif #else call abort_ice(subname//' ERROR: USE_NETCDF cpp not defined', & diff --git a/configuration/scripts/machines/Macros.compy_intel b/configuration/scripts/machines/Macros.compy_intel index 604337f59..eabdbc00a 100644 --- a/configuration/scripts/machines/Macros.compy_intel +++ b/configuration/scripts/machines/Macros.compy_intel @@ -3,7 +3,7 @@ #============================================================================== CPP := fpp -CPPDEFS := -DFORTRANUNDERSCORE ${ICE_CPPDEFS} +CPPDEFS := -DFORTRANUNDERSCORE -DNO_HDF5 ${ICE_CPPDEFS} CFLAGS := -c -O2 -fp-model precise -xHost FIXEDFLAGS := -132 diff --git a/configuration/scripts/machines/Macros.gaffney_gnu b/configuration/scripts/machines/Macros.gaffney_gnu index 4ae235bc9..4d4c53971 100644 --- a/configuration/scripts/machines/Macros.gaffney_gnu +++ b/configuration/scripts/machines/Macros.gaffney_gnu @@ -3,7 +3,7 @@ #============================================================================== CPP := ftn -E -CPPDEFS := -DFORTRANUNDERSCORE ${ICE_CPPDEFS} +CPPDEFS := -DFORTRANUNDERSCORE -DNO_CDF5 ${ICE_CPPDEFS} CFLAGS := -c FIXEDFLAGS := -ffixed-line-length-132 diff --git a/configuration/scripts/machines/Macros.gaffney_intel b/configuration/scripts/machines/Macros.gaffney_intel index 7eccd36da..03c3c3251 100644 --- a/configuration/scripts/machines/Macros.gaffney_intel +++ b/configuration/scripts/machines/Macros.gaffney_intel @@ -3,7 +3,7 @@ #============================================================================== CPP := fpp -CPPDEFS := -DFORTRANUNDERSCORE ${ICE_CPPDEFS} +CPPDEFS := -DFORTRANUNDERSCORE -DNO_CDF5 ${ICE_CPPDEFS} CFLAGS := -c -O2 -fp-model precise -xHost FIXEDFLAGS := -132 diff --git a/configuration/scripts/machines/Macros.koehr_intel b/configuration/scripts/machines/Macros.koehr_intel index aee4b31a8..cd593e33b 100644 --- a/configuration/scripts/machines/Macros.koehr_intel +++ b/configuration/scripts/machines/Macros.koehr_intel @@ -3,7 +3,7 @@ #============================================================================== CPP := fpp -CPPDEFS := -DFORTRANUNDERSCORE ${ICE_CPPDEFS} +CPPDEFS := -DFORTRANUNDERSCORE -DNO_CDF5 ${ICE_CPPDEFS} CFLAGS := -c -O2 -fp-model precise -xHost FIXEDFLAGS := -132 diff --git a/configuration/scripts/machines/Macros.mustang_intel18 b/configuration/scripts/machines/Macros.mustang_intel18 index 28c1c1964..03a2b8891 100644 --- a/configuration/scripts/machines/Macros.mustang_intel18 +++ b/configuration/scripts/machines/Macros.mustang_intel18 @@ -3,7 +3,7 @@ #============================================================================== CPP := fpp -CPPDEFS := -DFORTRANUNDERSCORE ${ICE_CPPDEFS} +CPPDEFS := -DFORTRANUNDERSCORE -DNO_CDF5 ${ICE_CPPDEFS} CFLAGS := -c -O2 -fp-model precise -xHost FIXEDFLAGS := -132 diff --git a/configuration/scripts/machines/Macros.mustang_intel19 b/configuration/scripts/machines/Macros.mustang_intel19 index 28c1c1964..03a2b8891 100644 --- a/configuration/scripts/machines/Macros.mustang_intel19 +++ b/configuration/scripts/machines/Macros.mustang_intel19 @@ -3,7 +3,7 @@ #============================================================================== CPP := fpp -CPPDEFS := -DFORTRANUNDERSCORE ${ICE_CPPDEFS} +CPPDEFS := -DFORTRANUNDERSCORE -DNO_CDF5 ${ICE_CPPDEFS} CFLAGS := -c -O2 -fp-model precise -xHost FIXEDFLAGS := -132 diff --git a/configuration/scripts/machines/Macros.mustang_intel20 b/configuration/scripts/machines/Macros.mustang_intel20 index 28c1c1964..03a2b8891 100644 --- a/configuration/scripts/machines/Macros.mustang_intel20 +++ b/configuration/scripts/machines/Macros.mustang_intel20 @@ -3,7 +3,7 @@ #============================================================================== CPP := fpp -CPPDEFS := -DFORTRANUNDERSCORE ${ICE_CPPDEFS} +CPPDEFS := -DFORTRANUNDERSCORE -DNO_CDF5 ${ICE_CPPDEFS} CFLAGS := -c -O2 -fp-model precise -xHost FIXEDFLAGS := -132 diff --git a/configuration/scripts/machines/env.hera_intel b/configuration/scripts/machines/env.hera_intel index 6698c0c2c..9bab973b6 100644 --- a/configuration/scripts/machines/env.hera_intel +++ b/configuration/scripts/machines/env.hera_intel @@ -10,8 +10,9 @@ if ("$inp" != "-nomodules") then source /etc/profile.d/modules.csh #module list module purge -module load intel/18.0.5.274 -module load impi/2018.0.4 +module load gnu/13.2.0 +module load intel/2023.2.0 +module load impi/2023.2.0 module load netcdf/4.7.0 #module list @@ -23,7 +24,7 @@ setenv OMP_STACKSIZE 64M setenv ICE_MACHINE_MACHNAME hera setenv ICE_MACHINE_MACHINFO "Cray CS500 Intel SkyLake 2.4GHz, Infiniband HDR" setenv ICE_MACHINE_ENVNAME intel -setenv ICE_MACHINE_ENVINFO "ifort 18.0.5 20180823, intelmpi/2018.0.4, netcdf/4.7.0" +setenv ICE_MACHINE_ENVINFO "icc/ifort 2021.10.0 20230609, intelmpi/2023.2.0, netcdf/4.7.0" setenv ICE_MACHINE_MAKE gmake setenv ICE_MACHINE_WKDIR $HOME/scratch/CICE_RUNS setenv ICE_MACHINE_INPUTDATA /home/Anthony.Craig/scratch/CICE_INPUTDATA diff --git a/doc/source/user_guide/ug_case_settings.rst b/doc/source/user_guide/ug_case_settings.rst index 405e64dc1..8e7b154db 100644 --- a/doc/source/user_guide/ug_case_settings.rst +++ b/doc/source/user_guide/ug_case_settings.rst @@ -33,7 +33,10 @@ can be found in :ref:`cicecpps`. The following CPPs are available. "ESMF_INTERFACE", "Turns on ESMF support in a subset of driver code. Also USE_ESMF_LIB and USE_ESMF_METADATA" "FORTRANUNDERSCORE", "Used in ice_shr_reprosum86.c to support Fortran-C interfaces. This should generally be turned on at all times. There are other CPPs (FORTRANDOUBULEUNDERSCORE, FORTRANCAPS, etc) in ice_shr_reprosum.c that are generally not used in CICE but could be useful if problems arise in the Fortran-C interfaces" "GPTL", "Turns on GPTL initialization if needed for PIO" + "NO_CDF2", "Turns off support for netcdf cdf2 (nf90_64bit_offset)" + "NO_CDF5", "Turns off support for netcdf cdf5 (nf90_64bit_data)" "NO_F2003", "Turns off some Fortran 2003 features" + "NO_HDF2", "Turns off support for netcdf hdf5 (netcdf4 including chunking and compression)" "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." diff --git a/doc/source/user_guide/ug_implementation.rst b/doc/source/user_guide/ug_implementation.rst index 4f349c264..91909082c 100644 --- a/doc/source/user_guide/ug_implementation.rst +++ b/doc/source/user_guide/ug_implementation.rst @@ -1220,7 +1220,10 @@ 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. +such as MPI, hdf5, or pnetCDF. There are CPPs that will deprecate cdf2, +cdf5, and hdf5 support should the netcdf library be built without those features. +Those CPPs are ``NO_CDF2``, ``NO_CDF5``, and ``NO_HDF5``. Those can be added +to the Macros machine file explicity when needed. .. _history: diff --git a/doc/source/user_guide/ug_running.rst b/doc/source/user_guide/ug_running.rst index 9337b3c47..7ac37f16e 100644 --- a/doc/source/user_guide/ug_running.rst +++ b/doc/source/user_guide/ug_running.rst @@ -49,6 +49,7 @@ The Consortium has tested the following compilers at some point, - Intel ifort 2021.6.0 - Intel ifort 2021.8.0 - Intel ifort 2021.9.0 +- Intel ifort 2021.10.0 - Intel ifort 2022.2.1 - PGI 16.10.0 - PGI 19.9-0 @@ -86,6 +87,7 @@ The Consortium has tested the following MPI implementations and versions, - MPICH 8.1.14 - MPICH 8.1.21 - MPICH 8.1.25 +- MPICH 8.1.26 - Intel MPI 18.0.1 - Intel MPI 18.0.4 - Intel MPI 2019 Update 6 From 44c59980dc9b0cbcdab0a168083f43307b009258 Mon Sep 17 00:00:00 2001 From: "David A. Bailey" Date: Sat, 18 May 2024 07:43:53 -0600 Subject: [PATCH 73/76] CAM single colum fix (#957) This only impacts single column CAM (CESM) runs. --- cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 b/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 index 6228c0bdd..3423fbf36 100644 --- a/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 +++ b/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 @@ -919,6 +919,12 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) end if enddo deallocate(lfieldnamelist) + call State_SetScalar(dble(0), flds_scalar_index_nx, exportState, & + flds_scalar_name, flds_scalar_num, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call State_SetScalar(dble(0), flds_scalar_index_ny, exportState, & + flds_scalar_name, flds_scalar_num, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return ! ******************* ! *** RETURN HERE *** ! ******************* From 2771786a4c8cbd9d776d5a7628eb24c911c46506 Mon Sep 17 00:00:00 2001 From: Tony Craig Date: Thu, 30 May 2024 18:30:50 -0700 Subject: [PATCH 74/76] Update CICE plotting tools. Add ciceplots.csh and ciceplots2d.py. (#958) Update CICE plotting tools. Add ciceplots.csh and ciceplots2d.py. Update timeseries.py. Remove timeseries.csh. Have the plotting tools copied into case directories. Update documentation. ciceplots2d.py generates global and polar plots for fields on CICE history files. ciceplots.csh is a general script that calls timeseries.py and ciceplots2d.py to generate plots for a user defined case. Add basemap to the cice conda environment.yml file to support the plotting packages. Add output to JRA55_files in ice_forcing.F90 to make it easier to understand when/why JRA55 files are missing. Add NO_CDF5 CPP to izumi_nag Macros file. Change 10 year production test case to 8 year test. This will serve as basis for release results. Update Icepack to #083d6e3cf42198 from May 28, 2024. Includes updates to Icepack plotting tools. --- cice.setup | 2 +- cicecore/cicedyn/general/ice_forcing.F90 | 3 + configuration/scripts/ciceplots.csh | 56 +++++++ configuration/scripts/ciceplots2d.py | 148 ++++++++++++++++++ .../scripts/machines/Macros.izumi_nag | 2 +- .../scripts/machines/environment.yml | 3 + .../scripts/options/set_nml.run8year | 7 + configuration/scripts/tests/prod_suite.ts | 2 +- configuration/scripts/timeseries.csh | 129 --------------- configuration/scripts/timeseries.py | 100 +++++++----- doc/source/developer_guide/dg_scripts.rst | 5 +- doc/source/user_guide/ug_running.rst | 104 +++++------- icepack | 2 +- 13 files changed, 323 insertions(+), 240 deletions(-) create mode 100755 configuration/scripts/ciceplots.csh create mode 100755 configuration/scripts/ciceplots2d.py create mode 100644 configuration/scripts/options/set_nml.run8year delete mode 100755 configuration/scripts/timeseries.csh diff --git a/cice.setup b/cice.setup index 2fd68cd18..0e574f803 100755 --- a/cice.setup +++ b/cice.setup @@ -838,7 +838,7 @@ EOF endif # from basic script dir to case - foreach file (cice.build cice.settings Makefile ice_in makdep.c setup_run_dirs.csh timeseries.csh timeseries.py) + foreach file (cice.build cice.settings Makefile ice_in makdep.c setup_run_dirs.csh ciceplots.csh ciceplots2d.py timeseries.py) if !(-e ${ICE_SCRIPTS}/$file) then echo "${0}: ERROR, ${ICE_SCRIPTS}/$file not found" exit -1 diff --git a/cicecore/cicedyn/general/ice_forcing.F90 b/cicecore/cicedyn/general/ice_forcing.F90 index b977f54aa..241bf8b5d 100755 --- a/cicecore/cicedyn/general/ice_forcing.F90 +++ b/cicecore/cicedyn/general/ice_forcing.F90 @@ -2276,6 +2276,9 @@ subroutine JRA55_files(yr) enddo if (.not.exists) then + write(nu_diag,*) subname,' atm_data_dir = ',trim(atm_data_dir) + write(nu_diag,*) subname,' atm_data_type_prefix = ',trim(atm_data_type_prefix) + write(nu_diag,*) subname,' atm_data_version = ',trim(atm_data_version) call abort_ice(error_message=subname//' could not find forcing file') endif diff --git a/configuration/scripts/ciceplots.csh b/configuration/scripts/ciceplots.csh new file mode 100755 index 000000000..43528b33e --- /dev/null +++ b/configuration/scripts/ciceplots.csh @@ -0,0 +1,56 @@ +#!/bin/csh -f + +source ${MODULESHOME}/init/csh + +# User defined stuff +# Set case and case directory +# Set files, notes, fstr, and fields + +set case = "CICE6.5.1" +set casedir = "/glade/derecho/scratch/tcraig/CICE_RUNS/cgx1proda" + +# setup plots + +set histdir = "${casedir}/history" + +set files = ("${histdir}/iceh.2012-03.nc" \ + "${histdir}/iceh.2012-09.nc" ) +set notes = ("2012 March Mean" \ + "2012 Sept Mean" ) +set fstrs = ("Mar12" \ + "Sep12" ) + +set fields = ("aice" "hi" "hs") + +#conda config --add channels conda-forge +#conda config --set channel_priority strict +#conda search basemap --channel conda-forge +#conda create -p /glade/u/home/tcraig/conda/envs/basemap -c conda-forge basemap=1.4.1 basemap-data basemap-data-hires netCDF4 + +module load conda +source ${NCAR_ROOT_CONDA}/etc/profile.d/conda.csh + +conda activate /glade/u/home/tcraig/conda/envs/basemap + +echo " " +echo " " + +echo ./timeseries.py \"${casedir}\" --case \"${case}\" --grid +./timeseries.py "${casedir}" --case "${case}" --grid + +echo " " + +set cnt = 0 +while ($cnt < ${#files}) + @ cnt = $cnt + 1 + set file = "${files[$cnt]}" + set note = "${notes[$cnt]}" + set fstr = "${fstrs[$cnt]}" + foreach field ($fields) + echo ./ciceplots2d.py \"$field\" \"$file\" \"$case\" \"$note\" \"$fstr\" + ./ciceplots2d.py "$field" "$file" "$case" "$note" "$fstr" + end +end + +echo "DONE" + diff --git a/configuration/scripts/ciceplots2d.py b/configuration/scripts/ciceplots2d.py new file mode 100755 index 000000000..2ad73e66f --- /dev/null +++ b/configuration/scripts/ciceplots2d.py @@ -0,0 +1,148 @@ +#!/usr/bin/env python3 + +#Importing the necessary libraries +import sys +import os +import numpy as np +from netCDF4 import Dataset +import matplotlib as mpl +import matplotlib.pyplot as plt +from mpl_toolkits.basemap import Basemap + +if len(sys.argv) != 6: + print("ciceplots.py requires 5 arguments") + print(" 1. field name in file, ie. \"aice\"") + print(" 2. cice history file full path, ie. \"/glade/scratch/user/case/history/iceh.2012-03.nc\"") + print(" 3. case name, used to annotate plot, ie. \"CICE6.5.1\"") + print(" 4. notes, used to annotate plot, ie. 2012 \"March Mean\"") + print(" 5. file string, use to create unique png filenames, ie. \"Mar12\"") + quit() + +field = sys.argv[1] +pathf = sys.argv[2] +casen = sys.argv[3] +notes = sys.argv[4] +fstr = sys.argv[5] +fname = os.path.basename(pathf) +title = field + " " + notes +cfnam = casen + " " + fname +#print("field = ",field) +#print("pathf = ",pathf) +#print("casen = ",casen) +#print("notes = ",notes) +#print("fname = ",fname) +#print("title = ",title) +#print("cfnam = ",cfnam) + +#Reading the netCDF file +data = Dataset(pathf,'r') +#print (data) + +lons = data.variables['TLON'][:,:] +lats = data.variables['TLAT'][:,:] +var1 = data.variables[field][:,:,:] +var1 = var1[0,:,:] +var1[ var1==0.00 ] = np.nan +#mask = data.variables['tmask'][:,:] +#mask[ mask>0.5 ] = np.nan + +#print("lons.shape = ",lons.shape) +#print("var1.shape = ",var1.shape) + +# Lon/Lat Projection + +#print("Plot global") +#m = Basemap(projection='cyl',llcrnrlat=-90,urcrnrlat=90, +# llcrnrlon=0,urcrnrlon=360,resolution='c') +m = Basemap(projection='cyl',llcrnrlat=-90,urcrnrlat=90, + llcrnrlon=0,urcrnrlon=360,resolution='l') +fig, ax = plt.subplots() +#plt.figure(figsize=(6,4)) +m.drawcoastlines(linewidth=0.2) +m.fillcontinents(color='black',lake_color='white') +#draw parallels and meridians. +m.drawparallels(np.arange(-60.,61.,30.),labels=[1,0,0,0]) +m.drawmeridians(np.arange(0.,361.,45.),labels=[1,0,0,1]) +#draw map boundary +m.drawmapboundary(fill_color='white') +#setting colorbar +cmap = plt.get_cmap('jet') +barticks = None +norm = "linear" +if field in ['hi']: + bounds = np.arange(0,2.05,0.1) + bounds = np.append(bounds,[2.25,2.5,2.75,3.0,3.25,3.5,3.75,4.0]) + norm = mpl.colors.BoundaryNorm(bounds,cmap.N,extend='max') + barticks=[0,0.5,1.0,1.5,2.0,2.5,3.0,3.5,4.0] +if field in ['hs']: + bounds = np.arange(0,1.02,0.05) + bounds = np.append(bounds,[1.5,2.0,2.5,3.0,3.5,4.0]) + norm = mpl.colors.BoundaryNorm(bounds,cmap.N,extend='max') + barticks=[0,0.25,0.5,0.75,1.0,2.0,3.0,4.0] +#matplotlib scatter-plot +m.scatter(lons,lats,c=var1,cmap=cmap,marker='o',s=0.2,norm=norm) +m.colorbar(label=field, ticks=barticks) +plt.rcParams["figure.dpi"] = 300 +plt.title(title) +plt.text(x=0.0,y=-0.1,s=cfnam,transform=ax.transAxes,horizontalalignment='left',verticalalignment='top',fontsize='x-small') +oname = field + "_gl_" + fstr + ".png" +print('Saving file to ',oname) +plt.savefig(oname) +#plt.show() +plt.close() + +# North Polar Stereographic Projection + +#print("Plot NH") +#m = Basemap(projection='npstere',boundinglat=45,lon_0=-45,resolution='c') +m = Basemap(projection='npstere',boundinglat=45,lon_0=-45,resolution='l') +fig, ax = plt.subplots() +#plt.figure(figsize=(6,4)) +m.drawcoastlines(linewidth=0.2) +m.fillcontinents(color='black',lake_color='white') +# draw parallels and meridians. +m.drawparallels(np.arange(-60.,61.,30.),labels=[0,0,0,0]) +m.drawmeridians(np.arange(0.,361.,45.),labels=[0,0,0,0]) +m.drawmapboundary(fill_color='white') +#setting colorbar (set above) +m.scatter(lons,lats,c=var1,cmap=cmap,marker='o',s=0.2,latlon=True,norm=norm) +#m.colorbar(label=field) +m.colorbar(label=field, ticks=barticks) +plt.rcParams["figure.dpi"] = 300 +plt.title (title) +plt.text(x=0.0,y=-0.02,s=cfnam,transform=ax.transAxes,horizontalalignment='left',verticalalignment='top',fontsize='x-small') +oname = field + "_nh_" + fstr + ".png" +print('Saving file to ',oname) +plt.savefig(oname) +#plt.show() +plt.close() + +# South Polar Stereographic Projection + +#print("Plot SH") +#m = Basemap(projection='npstere',boundinglat=45,lon_0=-45,resolution='c') +m = Basemap(projection='spstere',boundinglat=-45,lon_0=180,resolution='l') +fig, ax = plt.subplots() +#plt.figure(figsize=(6,4)) +m.drawcoastlines(linewidth=0.2) +m.fillcontinents(color='black',lake_color='white') +# draw parallels and meridians. +m.drawparallels(np.arange(-60.,61.,30.),labels=[0,0,0,0]) +m.drawmeridians(np.arange(0.,361.,45.),labels=[0,0,0,0]) +m.drawmapboundary(fill_color='white') +#setting colorbar (set above) +m.scatter(lons,lats,c=var1,cmap=cmap,marker='o',s=0.2,latlon=True,norm=norm) +#m.colorbar(label=field) +m.colorbar(label=field, ticks=barticks) +plt.rcParams["figure.dpi"] = 300 +plt.title (title) +plt.text(x=0.0,y=-0.02,s=cfnam,transform=ax.transAxes,horizontalalignment='left',verticalalignment='top',fontsize='x-small') +oname = field + "_sh_" + fstr + ".png" +print('Saving file to ',oname) +plt.savefig(oname) +#plt.show() +plt.close() + +#print("Done") +quit() + diff --git a/configuration/scripts/machines/Macros.izumi_nag b/configuration/scripts/machines/Macros.izumi_nag index c12edb904..9265c9de1 100644 --- a/configuration/scripts/machines/Macros.izumi_nag +++ b/configuration/scripts/machines/Macros.izumi_nag @@ -3,7 +3,7 @@ #============================================================================== CPP := /usr/bin/cpp -CPPDEFS := -DFORTRANUNDERSCORE -DNO_R16 $(ICE_CPPDEFS) +CPPDEFS := -DFORTRANUNDERSCORE -DNO_R16 -DNO_CDF5 $(ICE_CPPDEFS) CFLAGS := -c FIXEDFLAGS := -fixed diff --git a/configuration/scripts/machines/environment.yml b/configuration/scripts/machines/environment.yml index 30ed1e148..119bf7ea0 100644 --- a/configuration/scripts/machines/environment.yml +++ b/configuration/scripts/machines/environment.yml @@ -15,6 +15,9 @@ dependencies: - matplotlib-base - cartopy - netcdf4 + - basemap=1.4.1 + - basemap-data + - basemap-data-hires # Python dependencies for building the HTML documentation - sphinx - sphinxcontrib-bibtex diff --git a/configuration/scripts/options/set_nml.run8year b/configuration/scripts/options/set_nml.run8year new file mode 100644 index 000000000..1515fa7c9 --- /dev/null +++ b/configuration/scripts/options/set_nml.run8year @@ -0,0 +1,7 @@ +npt_unit = 'y' +npt = 8 +dumpfreq = 'y' +dumpfreq_n = 1 +diagfreq = 24 +histfreq = 'm','x','x','x','x' + diff --git a/configuration/scripts/tests/prod_suite.ts b/configuration/scripts/tests/prod_suite.ts index 877fa1ce6..5e62e94ea 100644 --- a/configuration/scripts/tests/prod_suite.ts +++ b/configuration/scripts/tests/prod_suite.ts @@ -1,6 +1,6 @@ # Test Grid PEs Sets BFB-compare qcchk gx3 72x1 qc,qcchk,medium qcchk_gx3_72x1_medium_qc_qcchk qcchk gx1 144x1 qc,qcchk,medium -smoke gx1 144x2 gx1prod,long,run10year +smoke gx1 128x2 gx1prod,long,run8year qcchk gx3 72x1 qc,qcchkf,medium,alt02 qcchk_gx3_72x1_medium_qc_qcchk qcchk gx3 72x1 qc,qcchk,dt3456s,medium qcchk_gx3_72x1_medium_qc_qcchk diff --git a/configuration/scripts/timeseries.csh b/configuration/scripts/timeseries.csh deleted file mode 100755 index b6b3fcf2e..000000000 --- a/configuration/scripts/timeseries.csh +++ /dev/null @@ -1,129 +0,0 @@ -#!/bin/csh - -# Check to see if test case directory was passed -if ( $1 == "-h" ) then - echo "To generate timeseries plots, this script can be passed a directory" - echo "containing a logs/ subdirectory, or it can be run in the directory with" - echo "the log files, without being passed a directory." - echo "Example: ./timeseries.csh ./annual_gx3_conrad_4x1.t00" - echo "Example: ./timeseries.csh" - echo "It will pull the diagnostic data from the most recently modified log file." - exit -1 -endif -set basename = `echo $1 | sed -e 's#/$##' | sed -e 's/^\.\///'` - -# Set x-axis limits - # Manually set x-axis limits -#set xrange = 'set xrange ["19980101":"19981231"]' - # Let gnuplot determine x-axis limits -set xrange = '' - -# Determine if BASELINE dataset exists -if ( $1 == "" ) then -set basefile_dir = "IGNORE" -else -source $1/cice.settings -set basefile_dir = "$ICE_BASELINE/$ICE_BASECOM/$ICE_TESTNAME" -endif - -if ( -d $basefile_dir ) then - set num_basefile = `ls $basefile_dir | grep cice.runlog | wc -l` - if ( $num_basefile > 0 ) then - set baseline_exists = 1 - foreach file ($basefile_dir/cice.runlog.*) - set base_logfile = $file - end - else - set baseline_exists = 0 - endif -else - set baseline_exists = 0 -endif - -set fieldlist=("total ice area (km^2)" \ - "total ice extent(km^2)" \ - "total ice volume (m^3)" \ - "total snw volume (m^3)" \ - "rms ice speed (m/s)" ) - -# Get the filename for the latest log -if ( $1 == "" ) then -foreach file (./cice.runlog.*) - set logfile = $file -end -else -foreach file ($1/logs/cice.runlog.*) - set logfile = $file -end -endif - -# Loop through each field and create the plot -foreach field ($fieldlist:q) - # Add backslashes before (, ), and ^ for grep searches - set search_name = "`echo '$field' | sed 's/(/\\(/' | sed 's/)/\\)/' | sed 's/\^/\\^/'`" - set fieldname = `echo "$field" | sed -e 's/([^()]*)//g'` - set search = "'$search_name'\|istep1" - rm -f data.txt - foreach line ("`egrep $search $logfile`") - if ("$line" =~ *"istep1"*) then - set argv = ( $line ) - set date = $4 - @ hour = ( $6 / 3600 ) - else - set data1 = `echo $line | rev | cut -d ' ' -f2 | rev` - set data2 = `echo $line | rev | cut -d ' ' -f1 | rev` - echo "$date-$hour,$data1,$data2" >> data.txt - endif - end - set format = "%Y%m%d-%H" - - set output = `echo $fieldname | sed 's/ /_/g'` - set output = "${output}_${ICE_CASENAME}.png" - - echo "Plotting data for '$fieldname' and saving to $output" - -# Call the plotting routine, which uses the data in the data.txt file -gnuplot << EOF > $output -# Plot style -set style data points - -set datafile separator "," - -# Term type and background color, canvas size -set terminal png size 1920,960 - -# x-axis -set xdata time -set timefmt "$format" -set format x "%Y/%m/%d" - -# Axis tick marks -set xtics rotate - -set title "$field (Diagnostic Output)" -set ylabel "$field" -set xlabel "Simulation Day" - -set key left top - -# Set x-axlis limits -$xrange - -if ( $baseline_exists == 1 ) \ - plot "data_baseline.txt" using (timecolumn(1)):2 with lines lw 2 lt 2 lc 2 title \ - "Arctic - Baseline", \ - "" using (timecolumn(1)):3 with lines lw 2 lt 2 lc 5 title "Antarctic - Baseline", \ - "data.txt" using (timecolumn(1)):2 with lines lw 2 lt 1 lc 1 title "Arctic", \ - "" using (timecolumn(1)):3 with lines lw 2 lt 1 lc 3 title "Antarctic"; \ -else \ - plot "data.txt" using (timecolumn(1)):2 with lines lw 2 lt 1 lc 1 title "Arctic", \ - "" using (timecolumn(1)):3 with lines lw 2 lt 1 lc 3 title "Antarctic" \ - -EOF - -# Delete the data file -rm -f data.txt -if ( $baseline_exists ) then - rm -f data_baseline.txt -endif -end diff --git a/configuration/scripts/timeseries.py b/configuration/scripts/timeseries.py index 2c36cea73..c53106071 100755 --- a/configuration/scripts/timeseries.py +++ b/configuration/scripts/timeseries.py @@ -1,4 +1,4 @@ -#!/usr/bin/env python +#!/usr/bin/env python3 ''' This script generates timeseries plots of CICE diagnostic output. @@ -51,16 +51,16 @@ def get_data(logfile,field): logger.debug('Extracting data for {}'.format(field)) # Build the regular expression to extract the data - field_regex = field.replace('(','\(').replace('^','\^').replace(')','\)') - number_regex = '[-+]?\d+\.?\d+([eE][-+]?\d+)?' - my_regex = '^{}\s+=\s+({})\s+({})'.format(field_regex,number_regex,number_regex) + field_regex = field.replace('(','\\(').replace('^','\\^').replace(')','\\)') + number_regex = r'[-+]?\d+\.?\d+([eE][-+]?\d+)?' + my_regex = r'^{}\s+=\s+({})\s+({})'.format(field_regex,number_regex,number_regex) dtg = [] arctic = [] antarctic = [] with open(logfile) as f: for line in f.readlines(): - m1 = re.search('istep1:\s+(\d+)\s+idate:\s+(\d+)\s+sec:\s+(\d+)', line) + m1 = re.search(r'istep1:\s+(\d+)\s+idate:\s+(\d+)\s+sec:\s+(\d+)', line) if m1: # Extract the current date-time group from the file date = m1.group(2) @@ -83,6 +83,11 @@ def get_data(logfile,field): antarctic.append(float(m.group(3))) logger.debug(' Arctic = {}, Antarctic = {}'.format(arctic[-1], antarctic[-1])) + # remove first few elements of dtg + if len(dtg) > len(arctic): + stind = len(dtg) - len(arctic) + dtg = dtg[stind:] + return dtg, arctic, antarctic, expon def latexit(string): @@ -90,15 +95,17 @@ def latexit(string): return (s.replace(')','$)',1))[::-1] def plot_timeseries(log, field, dtg, arctic, antarctic, expon, dtg_base=None, arctic_base=None, \ - antarctic_base=None, base_dir=None, grid=False): + antarctic_base=None, base_dir=None, grid=False, casename=None, base_casename=None): ''' Plot the timeseries data from the CICE log file ''' import re - casename = re.sub(r"/logs", "", os.path.abspath(log).rstrip('/')).split('/')[-1] + if casename is None: + casename = re.sub(r"/logs", "", os.path.abspath(log).rstrip('/')).split('/')[-1] if base_dir: - base_casename = re.sub(r"/logs", "", os.path.abspath(base_dir).rstrip('/')).split('/')[-1] + if base_casename is None: + base_casename = re.sub(r"/logs", "", os.path.abspath(base_dir).rstrip('/')).split('/')[-1] # Load the plotting libraries, but set the logging level for matplotlib # to WARNING so that matplotlib debugging info is not printed when running @@ -108,7 +115,8 @@ def plot_timeseries(log, field, dtg, arctic, antarctic, expon, dtg_base=None, ar import matplotlib.dates as mdates import matplotlib.ticker as ticker - fig = plt.figure(figsize=(12,8)) +# fig = plt.figure(figsize=(12,8)) + fig = plt.figure(figsize=(6,4)) ax = fig.add_axes([0.05,0.08,0.9,0.9]) # Add the arctic data to the plot @@ -132,55 +140,54 @@ def plot_timeseries(log, field, dtg, arctic, antarctic, expon, dtg_base=None, ar ax.xaxis.set_minor_locator(mdates.MonthLocator()) # Add a text box that prints the test case name and the baseline case name (if given) - try: - text_field = "Test/Case: {}\nBaseline: {}".format(casename,base_casename) - from matplotlib.offsetbox import AnchoredText - anchored_text = AnchoredText(text_field,loc=2) - ax.add_artist(anchored_text) - except: - text_field = "Test/Case: {}".format(casename) - from matplotlib.offsetbox import AnchoredText - anchored_text = AnchoredText(text_field,loc=2) - ax.add_artist(anchored_text) + if base_casename is None: + text_field = "{}".format(casename) + else: + text_field = "{}\n{}".format(casename,base_casename) + + from matplotlib.offsetbox import AnchoredText + anchored_text = AnchoredText(text_field,loc='upper left') + anchored_text.patch.set_alpha(0.5) + ax.add_artist(anchored_text) - ax.legend(loc='upper right') + ax.legend(loc='upper right',framealpha=0.5) # Add grid lines if the `--grid` argument was passed at the command line. if grid: ax.grid(ls='--') # Reduce the number of ticks on the y axis - nbins = 10 - try: - minval = min( \ - min(min(arctic), min(antarctic)), \ - min(min(arctic_base), min(antarctic_base))) - maxval = max( \ - max(max(arctic), max(antarctic)), \ - max(max(arctic_base), max(antarctic_base))) - except: - minval = min(min(arctic), min(antarctic)) - maxval = max(max(arctic), max(antarctic)) - step = (maxval-minval)/nbins - ax.yaxis.set_ticks(np.arange(minval, maxval+step, step)) +# nbins = 10 +# try: +# minval = min( \ +# min(min(arctic), min(antarctic)), \ +# min(min(arctic_base), min(antarctic_base))) +# maxval = max( \ +# max(max(arctic), max(antarctic)), \ +# max(max(arctic_base), max(antarctic_base))) +# except: +# minval = min(min(arctic), min(antarctic)) +# maxval = max(max(arctic), max(antarctic)) +# step = (maxval-minval)/nbins +# ax.yaxis.set_ticks(np.arange(minval, maxval+step, step)) # Format the y-axis tick labels, based on whether or not the values in the log file # are in scientific notation or float notation. if expon: - ax.yaxis.set_major_formatter(ticker.FormatStrFormatter('%0.3e')) + ax.yaxis.set_major_formatter(ticker.FormatStrFormatter('%0.1e')) else: - ax.yaxis.set_major_formatter(ticker.FormatStrFormatter('%0.5f')) + ax.yaxis.set_major_formatter(ticker.FormatStrFormatter('%0.3f')) # Rotate and right align the x labels for tick in ax.get_xticklabels(): - tick.set_rotation(45) + tick.set_rotation(30) # Create an output file and save the figure field_tmp = field.split('(')[0].rstrip() try: - outfile = '{}_{}_base-{}.png'.format(field_tmp.replace(' ','_'), casename,base_casename) + outfile = '{}_{}_base-{}.png'.format(field_tmp.replace(' ','_'),casename.replace(' ','_'),base_casename.replace(' ','_')) except: - outfile = '{}_{}.png'.format(field_tmp.replace(' ','_'), casename) + outfile = '{}_{}.png'.format(field_tmp.replace(' ','_'), casename.replace(' ','_')) logger.info('Saving file to {}'.format(outfile)) plt.savefig(outfile,dpi=300,bbox_inches='tight') @@ -204,6 +211,10 @@ def main(): dataset, if desired. A specific log file or case directory can \ be passed. If a directory is passed, the most recent log file \ will be used.') + parser.add_argument('--case', dest='casename', help='User specified casename for plots.', \ + action='store') + parser.add_argument('--basecase', dest='base_casename', help='User specified base casename \ + for plots.', action='store') parser.add_argument('-v', '--verbose', dest='verbose', help='Print debug output?', \ action='store_true') parser.add_argument('--area', dest='area', help='Create a plot for total ice area?', \ @@ -227,6 +238,8 @@ def main(): parser.set_defaults(snow_volume=False) parser.set_defaults(speed=False) parser.set_defaults(grid=False) + parser.set_defaults(casename=None) + parser.set_defaults(base_casename=None) args = parser.parse_args() @@ -268,7 +281,7 @@ def main(): logger.debug('{} is a file'.format(args.log_dir)) log = args.log_dir log_dir = args.log_dir.rsplit('/',1)[0] - logger.info('Log file = {}'.format(log)) + if args.base_dir: if os.path.isdir(args.base_dir): base_log = find_logfile(args.base_dir) @@ -278,6 +291,9 @@ def main(): base_dir = args.base_dir.rsplit('/',1)[0] logger.info('Base Log file = {}'.format(base_log)) + logger.info('casename = {}'.format(args.casename)) + logger.info('Log file = {}'.format(log)) + # Loop through each field and create the plot for field in fieldlist: logger.debug('Current field = {}'.format(field)) @@ -290,9 +306,11 @@ def main(): # Plot the data if args.base_dir: plot_timeseries(log_dir, field, dtg, arctic, antarctic, expon, dtg_base, \ - arctic_base, antarctic_base, base_dir, grid=args.grid) + arctic_base, antarctic_base, base_dir, grid=args.grid, \ + casename=args.casename, base_casename=args.base_casename) else: - plot_timeseries(log_dir, field, dtg, arctic, antarctic, expon, grid=args.grid) + plot_timeseries(log_dir, field, dtg, arctic, antarctic, expon, grid=args.grid, \ + casename=args.casename) if __name__ == "__main__": main() diff --git a/doc/source/developer_guide/dg_scripts.rst b/doc/source/developer_guide/dg_scripts.rst index dac5e9a52..d4b29acbb 100644 --- a/doc/source/developer_guide/dg_scripts.rst +++ b/doc/source/developer_guide/dg_scripts.rst @@ -22,6 +22,8 @@ The directory structure under configure/scripts is as follows. | **cice.run.setup.csh** sets up the run scripts | **cice.settings** defines environment, model configuration and run settings | **cice.test.setup.csh** creates configurations for testing the model +| **ciceplots.csh** general script to generate timeseries and 2d CICE plots +| **ciceplots2d.py** python script to generate 2d CICE plots | **ice_in** namelist input data | **machines/** machine specific files to set env and Macros | **makdep.c** determines module dependencies @@ -31,8 +33,7 @@ The directory structure under configure/scripts is as follows. | **parse_settings.sh** replaces settings with command-line configuration | **setup_run_dirs.csh** creates the case run directories | **set_version_number.csh** updates the model version number from the **cice.setup** command line -| **timeseries.csh** generates PNG timeseries plots from output files, using GNUPLOT -| **timeseries.py** generates PNG timeseries plots from output files, using Python +| **timeseries.py** python script to generate timeseries plots from CICE log file | **tests/** scripts for configuring and running basic tests .. _dev_strategy: diff --git a/doc/source/user_guide/ug_running.rst b/doc/source/user_guide/ug_running.rst index 7ac37f16e..021c5bcbe 100644 --- a/doc/source/user_guide/ug_running.rst +++ b/doc/source/user_guide/ug_running.rst @@ -845,12 +845,13 @@ A few notes about the conda configuration: mpirun -np ${ntasks} --oversubscribe ./cice >&! \$ICE_RUNLOG_FILE - It is not recommeded to run other test suites than ``quick_suite`` or ``travis_suite`` on a personal computer. -- The conda environment is automatically activated when compiling or running the model using the ``./cice.build`` and ``./cice.run`` scripts in the case directory. These scripts source the file ``env.conda_{linux.macos}``, which calls ``conda activate cice``. +- If needed, the conda environment is automatically activated when compiling or running the model using the ``./cice.build`` and ``./cice.run`` scripts in the case directory. These scripts source the file ``env.conda_{linux.macos}``, which calls ``conda activate cice``. - To use the "cice" conda environment with the Python plotting (see :ref:`timeseries`) and quality control (QC) scripts (see :ref:`CodeValidation`), you must manually activate the environment: .. code-block:: bash cd ~/cice-dirs/cases/case1 + conda env create -f configuration/scripts/machines/environment.yml --force conda activate cice python timeseries.py ~/cice-dirs/cases/case1/logs conda deactivate # to deactivate the environment @@ -955,58 +956,49 @@ in shell startup files or otherwise at users discretion: .. _timeseries: -Timeseries Plotting +Plotting Tools ------------------- -The CICE scripts include two scripts that will generate timeseries figures from a -diagnostic output file, a Python version (``timeseries.py``) and a csh version -(``timeseries.csh``). Both scripts create the same set of plots, but the Python -script has more capabilities, and it's likely that the csh -script will be removed in the future. +CICE includes a couple of simple scripts to generate plots. The ``timeseries.py`` +scripts generates northern and southern hemisphere timeseries plots for several +fields from the CICE log file. The ``ciceplots2d.py`` script generates some +two-dimensional plots from CICE history files as global and polar projections. +The script ``ciceplots.csh`` is a general script that sets up the inputs for the +python plotting tools and calls them. Both python tools produce png files. -To use the ``timeseries.py`` script, the following requirements must be met: +To use the python scripts, the following python packages are required: -* Python v2.7 or later -* numpy Python package -* matplotlib Python package -* datetime Python package +* Python3 +* numpy +* matplotlib +* re +* datetime +* netcdf4 +* basemap, basemap-data, basemap-data-hires -See :ref:`CodeValidation` for additional information about how to setup the Python -environment, but we recommend using ``pip`` as follows: :: +The easist way to install the package is via the cice env file provided with CICE via conda: - pip install --user numpy - pip install --user matplotlib - pip install --user datetime - -When creating a case or test via ``cice.setup``, the ``timeseries.csh`` and -``timeseries.py`` scripts are automatically copied to the case directory. -Alternatively, the plotting scripts can be found in ``./configuration/scripts``, and can be -run from any directory. - -The Python script can be passed a directory, a specific log file, or no directory at all: + .. code-block:: bash - - If a directory is passed, the script will look either in that directory or in - directory/logs for a filename like cice.run*. As such, users can point the script - to either a case directory or the ``logs`` directory directly. The script will use - the file with the most recent creation time. - - If a specific file is passed the script parses that file, assuming that the file - matches the same form of cice.run* files. - - If nothing is passed, the script will look for log files or a ``logs`` directory in the - directory from where the script was run. + conda env create -f configuration/scripts/machines/environment.yml --force + conda activate cice -For example: +Then edit the ``ciceplots.csh`` script and run it. ``ciceplots.csh`` also demonstrates +how to call each python script separately. -Run the timeseries script on the desired case. :: +When creating a case or test via ``cice.setup``, these three plotting scripts +are automatically copied to the case directory. +Alternatively, the plotting scripts can be found in ``./configuration/scripts`` and can +be run as needed. -$ python timeseries.py /p/work1/turner/CICE_RUNS/conrad_intel_smoke_col_1x1_diag1_run1year.t00/ +Briefly, the ``timeseries.py`` script has a few options but can be called as follows: -or :: + .. code-block:: bash -$ python timeseries.py /p/work1/turner/CICE_RUNS/conrad_intel_smoke_col_1x1_diag1_run1year.t00/logs - -The output figures are placed in the directory where the ``timeseries.py`` script is run. + ./timeseries.py /p/work1/turner/CICE_RUNS/conrad_intel_smoke_col_1x1_diag1_run1year.t00 --grid --case CICE6.0.1 -The plotting script will plot the following variables by default, but you can also select +The timeseries script parses the log file, so the temporal resolution is based on the log output frequency. +The timeseries plotting script will plot the following variables by default, but you can also select specific plots to create via the optional command line arguments. - total ice area (:math:`km^2`) @@ -1015,30 +1007,14 @@ specific plots to create via the optional command line arguments. - total snow volume (:math:`m^3`) - RMS ice speed (:math:`m/s`) -For example, to plot only total ice volume and total snow volume :: +The ``ciceplots2d.py`` script is called as follows: -$ python timeseries.py /p/work1/turner/CICE_RUNS/conrad_intel_smoke_col_1x1_diag1_run1year.t00/ --volume --snw_vol - -To generate plots for all of the cases within a suite with a testid, create and run a script such as :: - - #!/bin/csh - foreach dir (`ls -1 | grep testid`) - echo $dir - python timeseries.py $dir - end - -Plots are only made for a single output file at a time. The ability to plot output from -a series of cice.run* files is not currently possible, but may be added in the future. -However, using the ``--bdir`` option will plot two datasets (from log files) on the -same figure. - -For the latest help information for the script, run :: - -$ python timeseries.py -h - -The ``timeseries.csh`` script works basically the same way as the Python version, however it -does not include all of the capabilities present in the Python version. + .. code-block:: bash -To use the C-Shell version of the script, :: + ./ciceplots2d.py aice /p/work1/turner/CICE_RUNS/conrad_intel_smoke_col_1x1_diag1_run1year.t00/history/iceh.2005-09.nc CICE6.0.1 "Sept 2005 Mean" 2005Sep -$ ./timeseries.csh /p/work1/turner/CICE_RUNS/conrad_intel_smoke_col_1x1_diag1_run1year.t00/ +In the example above, a global, northern hemisphere, and southern hemisphere plot would be created +for the aice field from iceh.2005-09.nc file. Titles on the plot would reference CICE6.0.1 and +"Sept 2005 Mean" and the png files would contain the string 2005Sep as well as the field name and region. +The two-dimensional plots are generated using the scatter feature from matplotlib, so they are fairly +primitive. diff --git a/icepack b/icepack index ae69b8069..083d6e3cf 160000 --- a/icepack +++ b/icepack @@ -1 +1 @@ -Subproject commit ae69b806990ef2412e2f714c5b4ba4c096b163b6 +Subproject commit 083d6e3cf42198bc7b4ffd1f02063c4c5b35b639 From 9216f6ade5702dbf7822a37ce0cd82ca08a49c76 Mon Sep 17 00:00:00 2001 From: Nick Szapiro Date: Thu, 20 Jun 2024 21:04:07 +0000 Subject: [PATCH 75/76] Restore cicecore/cicedyn/general/ice_forcing.F90 to CICE-Consortium/main --- cicecore/cicedyn/general/ice_forcing.F90 | 3 +++ 1 file changed, 3 insertions(+) diff --git a/cicecore/cicedyn/general/ice_forcing.F90 b/cicecore/cicedyn/general/ice_forcing.F90 index b977f54aa..241bf8b5d 100755 --- a/cicecore/cicedyn/general/ice_forcing.F90 +++ b/cicecore/cicedyn/general/ice_forcing.F90 @@ -2276,6 +2276,9 @@ subroutine JRA55_files(yr) enddo if (.not.exists) then + write(nu_diag,*) subname,' atm_data_dir = ',trim(atm_data_dir) + write(nu_diag,*) subname,' atm_data_type_prefix = ',trim(atm_data_type_prefix) + write(nu_diag,*) subname,' atm_data_version = ',trim(atm_data_version) call abort_ice(error_message=subname//' could not find forcing file') endif From e998a0e410eca0b0d9951918d7a6e343273ba72a Mon Sep 17 00:00:00 2001 From: Nick Szapiro Date: Thu, 20 Jun 2024 21:37:15 +0000 Subject: [PATCH 76/76] Update icepack to main --- icepack | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/icepack b/icepack index f6ff8f7c4..083d6e3cf 160000 --- a/icepack +++ b/icepack @@ -1 +1 @@ -Subproject commit f6ff8f7c4d4cb6feabe3651b13204cf43fc948e3 +Subproject commit 083d6e3cf42198bc7b4ffd1f02063c4c5b35b639