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/48] 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/48] 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/48] 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/48] 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/48] 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/48] 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/48] 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/48] 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/48] 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/48] 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/48] 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/48] 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/48] 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/48] 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/48] 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/48] 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/48] 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/48] 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/48] 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/48] 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/48] 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/48] 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/48] 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/48] 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/48] 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/48] 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/48] 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/48] 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/48] 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/48] 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/48] 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/48] 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/48] 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/48] 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/48] 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/48] 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/48] 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/48] 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/48] 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/48] 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/48] 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/48] 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/48] 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/48] 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/48] 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/48] 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/48] 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/48] 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