From 6bc1c144e017f9c91b9f8f229d9d00609fe1201d Mon Sep 17 00:00:00 2001 From: Denise Worthen Date: Wed, 2 Aug 2023 17:09:26 -0400 Subject: [PATCH] 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) --- cicecore/cicedyn/analysis/ice_diagnostics.F90 | 162 +-- cicecore/cicedyn/analysis/ice_history.F90 | 4 +- .../cicedyn/analysis/ice_history_pond.F90 | 6 +- .../cicedyn/analysis/ice_history_shared.F90 | 8 +- .../cicedyn/analysis/ice_history_snow.F90 | 2 +- cicecore/cicedyn/dynamics/ice_dyn_vp.F90 | 41 +- .../cicedyn/dynamics/ice_transport_driver.F90 | 1155 +++++++++-------- .../cicedyn/dynamics/ice_transport_remap.F90 | 113 +- cicecore/cicedyn/general/ice_forcing.F90 | 539 ++------ cicecore/cicedyn/general/ice_init.F90 | 77 +- .../infrastructure/comm/mpi/ice_reprosum.F90 | 2 +- .../comm/serial/ice_boundary.F90 | 512 ++++++-- .../cicedyn/infrastructure/ice_domain.F90 | 4 +- .../io/io_netcdf/ice_history_write.F90 | 82 +- .../io/io_pio2/ice_history_write.F90 | 68 +- cicecore/drivers/nuopc/cmeps/ice_mesh_mod.F90 | 20 +- cicecore/drivers/unittest/optargs/optargs.F90 | 160 ++- .../drivers/unittest/optargs/optargs_subs.F90 | 116 +- cicecore/drivers/unittest/opticep/CICE.F90 | 4 +- .../drivers/unittest/opticep/CICE_InitMod.F90 | 28 +- .../drivers/unittest/opticep/CICE_RunMod.F90 | 741 +++++++++++ .../unittest/opticep/ice_init_column.F90 | 176 ++- .../drivers/unittest/opticep/ice_step_mod.F90 | 118 +- cicecore/shared/ice_fileunits.F90 | 22 +- configuration/scripts/Makefile | 8 +- configuration/scripts/cice.batch.csh | 15 + configuration/scripts/cice.launch.csh | 12 + configuration/scripts/ice_in | 3 +- .../scripts/machines/Macros.derecho_intel | 19 +- .../scripts/machines/env.derecho_intel | 12 +- 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 | 1 - configuration/scripts/options/set_nml.gx3 | 1 - .../scripts/options/set_nml.histinst | 2 +- configuration/scripts/options/set_nml.jra55 | 2 - configuration/scripts/options/set_nml.jra55do | 1 - configuration/scripts/options/set_nml.qc | 2 +- configuration/scripts/options/set_nml.run3dt | 2 +- configuration/scripts/options/set_nml.tx1 | 1 - configuration/scripts/tests/base_suite.ts | 3 + configuration/scripts/tests/baseline.script | 27 +- configuration/scripts/tests/comparelog.csh | 16 +- configuration/scripts/tests/unittest_suite.ts | 47 +- doc/source/cice_index.rst | 7 +- doc/source/developer_guide/dg_forcing.rst | 10 +- doc/source/developer_guide/dg_tools.rst | 4 +- doc/source/intro/citing.rst | 2 +- doc/source/master_list.bib | 10 +- doc/source/science_guide/sg_dynamics.rst | 4 +- doc/source/science_guide/sg_horiztrans.rst | 6 +- doc/source/science_guide/sg_tracers.rst | 2 +- doc/source/user_guide/ug_case_settings.rst | 10 +- doc/source/user_guide/ug_implementation.rst | 14 +- doc/source/user_guide/ug_testing.rst | 14 +- doc/source/user_guide/ug_troubleshooting.rst | 4 +- 57 files changed, 2738 insertions(+), 1719 deletions(-) create mode 100644 cicecore/drivers/unittest/opticep/CICE_RunMod.F90 diff --git a/cicecore/cicedyn/analysis/ice_diagnostics.F90 b/cicecore/cicedyn/analysis/ice_diagnostics.F90 index 53631b2d4..395cca98d 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 @@ -1945,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/analysis/ice_history.F90 b/cicecore/cicedyn/analysis/ice_history.F90 index f19158f6a..587767889 100644 --- a/cicecore/cicedyn/analysis/ice_history.F90 +++ b/cicecore/cicedyn/analysis/ice_history.F90 @@ -263,7 +263,7 @@ subroutine init_hist (dt) trim(tmpstr2), file=__FILE__, line=__LINE__) endif end do - + close(nu_nml) call release_fileunit(nu_nml) endif @@ -2225,7 +2225,7 @@ subroutine accum_hist (dt) n4Dfcum = n4Dscum + num_avail_hist_fields_4Df ! should equal num_avail_hist_fields_tot do ns = 1,nstreams - if (.not. hist_avg) then ! write snapshots + if (.not. hist_avg(ns)) then ! write snapshots do n = 1,n2D if (avail_hist_fields(n)%vhistfreq == histfreq(ns)) & a2D(:,:,n,:) = c0 diff --git a/cicecore/cicedyn/analysis/ice_history_pond.F90 b/cicecore/cicedyn/analysis/ice_history_pond.F90 index d209e6db6..976a87d40 100644 --- a/cicecore/cicedyn/analysis/ice_history_pond.F90 +++ b/cicecore/cicedyn/analysis/ice_history_pond.F90 @@ -100,14 +100,14 @@ subroutine init_hist_pond_2D trim(nml_filename), & file=__FILE__, line=__LINE__) endif - + ! goto this namelist in file call goto_nml(nu_nml,trim(nml_name),nml_error) if (nml_error /= 0) then call abort_ice(subname//'ERROR: searching for '// trim(nml_name), & file=__FILE__, line=__LINE__) endif - + ! read namelist nml_error = 1 do while (nml_error > 0) @@ -121,7 +121,7 @@ subroutine init_hist_pond_2D trim(tmpstr2), file=__FILE__, line=__LINE__) endif end do - + close(nu_nml) call release_fileunit(nu_nml) endif diff --git a/cicecore/cicedyn/analysis/ice_history_shared.F90 b/cicecore/cicedyn/analysis/ice_history_shared.F90 index 70aa5e14c..3c31f23ca 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 @@ -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 @@ -743,7 +745,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 +765,7 @@ subroutine construct_filename(ncfile,suffix,ns) !echmod ! of other groups (including RASM which uses CESMCOUPLED) !echmod if (ns > 1) write(cstream,'(i1.1)') ns-1 - if (hist_avg) then ! write averaged data + if (hist_avg(ns)) then ! write averaged data if (histfreq(ns) == '1' .and. histfreq_n(ns) == 1) then ! timestep write(ncfile,'(a,a,i4.4,a,i2.2,a,i2.2,a,i5.5,a,a)') & history_file(1:lenstr(history_file))//trim(cstream),'_inst.', & diff --git a/cicecore/cicedyn/analysis/ice_history_snow.F90 b/cicecore/cicedyn/analysis/ice_history_snow.F90 index 62e65b5a3..19722b014 100644 --- a/cicecore/cicedyn/analysis/ice_history_snow.F90 +++ b/cicecore/cicedyn/analysis/ice_history_snow.F90 @@ -77,7 +77,7 @@ subroutine init_hist_snow_2D (dt) integer (kind=int_kind) :: ns integer (kind=int_kind) :: nml_error ! namelist i/o error flag real (kind=dbl_kind) :: rhofresh, secday - logical (kind=log_kind) :: tr_snow + logical (kind=log_kind) :: tr_snow character(len=char_len_long) :: tmpstr2 ! for namelist check character(len=char_len) :: nml_name ! for namelist check diff --git a/cicecore/cicedyn/dynamics/ice_dyn_vp.F90 b/cicecore/cicedyn/dynamics/ice_dyn_vp.F90 index 3915004b4..32971c5b6 100644 --- a/cicecore/cicedyn/dynamics/ice_dyn_vp.F90 +++ b/cicecore/cicedyn/dynamics/ice_dyn_vp.F90 @@ -2502,7 +2502,7 @@ function global_dot_product (nx_block , ny_block , & vector2_x , vector2_y) & result(dot_product) - use ice_domain, only: distrb_info + use ice_domain, only: distrb_info, ns_boundary_type use ice_domain_size, only: max_blocks use ice_fileunits, only: bfbflag @@ -2552,8 +2552,14 @@ function global_dot_product (nx_block , ny_block , & enddo !$OMP END PARALLEL DO - ! Use local summation result unless bfbflag is active - if (bfbflag == 'off') then + ! Use faster local summation result for several bfbflag settings. + ! The local implementation sums over each block, sums over local + ! blocks, and calls global_sum on a scalar and should be just as accurate as + ! bfbflag = 'off', 'lsum8', and 'lsum4' without the extra copies and overhead + ! in the more general array global_sum. But use the array global_sum + ! if bfbflag is more strict or for tripole grids (requires special masking) + if (ns_boundary_type /= 'tripole' .and. ns_boundary_type /= 'tripoleT' .and. & + (bfbflag == 'off' .or. bfbflag == 'lsum8' .or. bfbflag == 'lsum4')) then dot_product = global_sum(sum(dot), distrb_info) else dot_product = global_sum(prod, distrb_info, field_loc_NEcorner) @@ -3120,7 +3126,7 @@ subroutine fgmres (zetax2 , etax2 , & j = indxUj(ij, iblk) workspace_x(i, j, iblk) = workspace_x(i, j, iblk) + rhs_hess(it) * arnoldi_basis_x(i, j, iblk, it) - workspace_y(i, j, iblk) = workspace_x(i, j, iblk) + rhs_hess(it) * arnoldi_basis_y(i, j, iblk, it) + workspace_y(i, j, iblk) = workspace_y(i, j, iblk) + rhs_hess(it) * arnoldi_basis_y(i, j, iblk, it) enddo ! ij enddo !$OMP END PARALLEL DO @@ -3151,7 +3157,6 @@ subroutine pgmres (zetax2 , etax2 , & use ice_boundary, only: ice_HaloUpdate use ice_domain, only: maskhalo_dyn, halo_info - use ice_fileunits, only: bfbflag use ice_timers, only: ice_timer_start, ice_timer_stop, timer_bound real (kind=dbl_kind), dimension(nx_block,ny_block,max_blocks,4), intent(in) :: & @@ -3343,21 +3348,17 @@ subroutine pgmres (zetax2 , etax2 , & workspace_x , workspace_y) ! Update workspace with boundary values - ! NOTE: skipped for efficiency since this is just a preconditioner - ! unless bfbflag is active - if (bfbflag /= 'off') then - call stack_fields(workspace_x, workspace_y, fld2) - call ice_timer_start(timer_bound) - if (maskhalo_dyn) then - call ice_HaloUpdate (fld2, halo_info_mask, & - field_loc_NEcorner, field_type_vector) - else - call ice_HaloUpdate (fld2, halo_info, & - field_loc_NEcorner, field_type_vector) - endif - call ice_timer_stop(timer_bound) - call unstack_fields(fld2, workspace_x, workspace_y) + call stack_fields(workspace_x, workspace_y, fld2) + call ice_timer_start(timer_bound) + if (maskhalo_dyn) then + call ice_HaloUpdate (fld2, halo_info_mask, & + field_loc_NEcorner, field_type_vector) + else + call ice_HaloUpdate (fld2, halo_info, & + field_loc_NEcorner, field_type_vector) endif + call ice_timer_stop(timer_bound) + call unstack_fields(fld2, workspace_x, workspace_y) !$OMP PARALLEL DO PRIVATE(iblk) do iblk = 1, nblocks @@ -3528,7 +3529,7 @@ subroutine pgmres (zetax2 , etax2 , & j = indxUj(ij, iblk) workspace_x(i, j, iblk) = workspace_x(i, j, iblk) + rhs_hess(it) * arnoldi_basis_x(i, j, iblk, it) - workspace_y(i, j, iblk) = workspace_x(i, j, iblk) + rhs_hess(it) * arnoldi_basis_y(i, j, iblk, it) + workspace_y(i, j, iblk) = workspace_y(i, j, iblk) + rhs_hess(it) * arnoldi_basis_y(i, j, iblk, it) enddo ! ij enddo !$OMP END PARALLEL DO diff --git a/cicecore/cicedyn/dynamics/ice_transport_driver.F90 b/cicecore/cicedyn/dynamics/ice_transport_driver.F90 index 59cc436d9..4f9d84d98 100644 --- a/cicecore/cicedyn/dynamics/ice_transport_driver.F90 +++ b/cicecore/cicedyn/dynamics/ice_transport_driver.F90 @@ -2,12 +2,12 @@ ! ! Drivers for remapping and upwind ice transport ! -! authors: Elizabeth C. Hunke and William H. Lipscomb, LANL +! authors: Elizabeth C. Hunke and William H. Lipscomb, LANL ! ! 2004: Revised by William Lipscomb from ice_transport_mpdata. ! Stripped out mpdata, retained upwind, and added block structure. ! 2006: Incorporated remap transport driver and renamed from -! ice_transport_upwind. +! ice_transport_upwind. ! 2011: ECH moved edgearea arrays into ice_transport_remap.F90 module ice_transport_driver @@ -37,17 +37,14 @@ module ice_transport_driver ! 'upwind' => 1st order donor cell scheme ! 'remap' => remapping scheme - logical, parameter :: & ! if true, prescribe area flux across each edge - l_fixed_area = .false. - ! NOTE: For remapping, hice and hsno are considered tracers. ! ntrace is not equal to ntrcr! integer (kind=int_kind) :: & ntrace ! number of tracers in use - + integer (kind=int_kind), dimension(:), allocatable, public :: & - tracer_type ,&! = 1, 2, or 3 (depends on 0, 1 or 2 other tracers) + tracer_type , & ! = 1, 2, or 3 (depends on 0, 1 or 2 other tracers) depend ! tracer dependencies (see below) logical (kind=log_kind), dimension (:), allocatable, public :: & @@ -57,13 +54,13 @@ module ice_transport_driver conserv_check ! if true, check conservation integer (kind=int_kind), parameter :: & - integral_order = 3 ! polynomial order of quadrature integrals - ! linear=1, quadratic=2, cubic=3 + integral_order = 3 ! polynomial order of quadrature integrals + ! linear=1, quadratic=2, cubic=3 logical (kind=log_kind), parameter :: & - l_dp_midpt = .true. ! if true, find departure points using - ! corrected midpoint velocity - + l_dp_midpt = .true. ! if true, find departure points using + ! corrected midpoint velocity + !======================================================================= contains @@ -81,162 +78,165 @@ 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 - integer (kind=int_kind) :: ntrcr, nt_Tsfc, nt_qice, nt_qsno, & - nt_sice, nt_fbri, nt_iage, nt_FY, 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 + integer (kind=int_kind) :: & + ntrcr , nt_Tsfc , nt_qice , nt_qsno , & + nt_sice , nt_fbri , nt_iage , nt_FY , & + 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 character(len=*), parameter :: subname = '(init_transport)' - call ice_timer_start(timer_advect) ! advection + call ice_timer_start(timer_advect) ! advection call icepack_query_tracer_sizes(ntrcr_out=ntrcr) call icepack_query_tracer_indices(nt_Tsfc_out=nt_Tsfc, nt_qice_out=nt_qice, & - nt_qsno_out=nt_qsno, nt_sice_out=nt_sice, nt_fbri_out=nt_fbri, & - nt_iage_out=nt_iage, nt_FY_out=nt_FY, nt_fsd_out=nt_fsd, & - 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_isosno_out=nt_isosno, nt_isoice_out=nt_isoice) + nt_qsno_out=nt_qsno, nt_sice_out=nt_sice, nt_fbri_out=nt_fbri, & + nt_iage_out=nt_iage, nt_FY_out=nt_FY, nt_fsd_out=nt_fsd, & + 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_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__) ntrace = 2 + ntrcr ! hice,hsno,trcr - if (allocated(tracer_type)) deallocate(tracer_type) - if (allocated(depend)) deallocate(depend) + if (allocated(tracer_type)) deallocate(tracer_type) + if (allocated(depend)) deallocate(depend) if (allocated(has_dependents)) deallocate(has_dependents) allocate (tracer_type (ntrace), & depend (ntrace), & has_dependents(ntrace)) - ! define tracer dependency arrays - ! see comments in remapping routine - - depend(1:2) = 0 ! hice, hsno - tracer_type(1:2) = 1 ! no dependency - - k = 2 - - do nt = 1, ntrcr - depend(k+nt) = trcr_depend(nt) ! 0 for ice area tracers - ! 1 for ice volume tracers - ! 2 for snow volume tracers - tracer_type(k+nt) = 2 ! depends on 1 other tracer - if (trcr_depend(nt) == 0) then - tracer_type(k+nt) = 1 ! depends on no other tracers - elseif (trcr_depend(nt) > 2) then - if (trcr_depend(trcr_depend(nt)-2) > 0) then - tracer_type(k+nt) = 3 ! depends on 2 other tracers - endif - endif - enddo - - has_dependents = .false. - do nt = 1, ntrace - if (depend(nt) > 0) then - nt1 = depend(nt) - has_dependents(nt1) = .true. - if (nt1 > nt) then - write(nu_diag,*) & - 'Tracer nt2 =',nt,' depends on tracer nt1 =',nt1 - call abort_ice(subname// & - 'ERROR: remap transport: Must have nt2 > nt1') - endif - endif - enddo ! ntrace - - ! diagnostic output - if (my_task == master_task) then - write (nu_diag, *) 'tracer index depend type has_dependents' - nt = 1 - write(nu_diag,1000) 'hi ',nt,depend(nt),tracer_type(nt),& - has_dependents(nt) - nt = 2 - write(nu_diag,1000) 'hs ',nt,depend(nt),tracer_type(nt),& - has_dependents(nt) - k=2 - do nt = k+1, k+ntrcr - if (nt-k==nt_Tsfc) & - write(nu_diag,1000) 'nt_Tsfc ',nt,depend(nt),tracer_type(nt),& - has_dependents(nt) - if (nt-k==nt_qice) & - write(nu_diag,1000) 'nt_qice ',nt,depend(nt),tracer_type(nt),& - has_dependents(nt) - if (nt-k==nt_qsno) & - write(nu_diag,1000) 'nt_qsno ',nt,depend(nt),tracer_type(nt),& - has_dependents(nt) - if (nt-k==nt_sice) & - write(nu_diag,1000) 'nt_sice ',nt,depend(nt),tracer_type(nt),& - has_dependents(nt) - if (nt-k==nt_fbri) & - write(nu_diag,1000) 'nt_fbri ',nt,depend(nt),tracer_type(nt),& - has_dependents(nt) - if (nt-k==nt_iage) & - write(nu_diag,1000) 'nt_iage ',nt,depend(nt),tracer_type(nt),& - has_dependents(nt) - if (nt-k==nt_FY) & - write(nu_diag,1000) 'nt_FY ',nt,depend(nt),tracer_type(nt),& - has_dependents(nt) - if (nt-k==nt_alvl) & - write(nu_diag,1000) 'nt_alvl ',nt,depend(nt),tracer_type(nt),& - has_dependents(nt) - if (nt-k==nt_vlvl) & - write(nu_diag,1000) 'nt_vlvl ',nt,depend(nt),tracer_type(nt),& - has_dependents(nt) - if (nt-k==nt_apnd) & - write(nu_diag,1000) 'nt_apnd ',nt,depend(nt),tracer_type(nt),& - has_dependents(nt) - if (nt-k==nt_hpnd) & - write(nu_diag,1000) 'nt_hpnd ',nt,depend(nt),tracer_type(nt),& - has_dependents(nt) - if (nt-k==nt_ipnd) & - write(nu_diag,1000) 'nt_ipnd ',nt,depend(nt),tracer_type(nt),& - has_dependents(nt) - if (nt-k==nt_smice) & - write(nu_diag,1000) 'nt_smice ',nt,depend(nt),tracer_type(nt),& - has_dependents(nt) - if (nt-k==nt_smliq) & - write(nu_diag,1000) 'nt_smliq ',nt,depend(nt),tracer_type(nt),& - has_dependents(nt) - if (nt-k==nt_rhos) & - write(nu_diag,1000) 'nt_rhos ',nt,depend(nt),tracer_type(nt),& - has_dependents(nt) - if (nt-k==nt_rsnw) & - write(nu_diag,1000) 'nt_rsnw ',nt,depend(nt),tracer_type(nt),& - has_dependents(nt) - if (nt-k==nt_fsd) & - write(nu_diag,1000) 'nt_fsd ',nt,depend(nt),tracer_type(nt),& - has_dependents(nt) - if (nt-k==nt_isosno) & - write(nu_diag,1000) 'nt_isosno ',nt,depend(nt),tracer_type(nt),& - has_dependents(nt) - if (nt-k==nt_isoice) & - write(nu_diag,1000) 'nt_isoice ',nt,depend(nt),tracer_type(nt),& - has_dependents(nt) - 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 - 1000 format (1x,a,2x,i6,2x,i6,2x,i4,4x,l4) - - if (trim(advection)=='remap') call init_remap ! grid quantities - - call ice_timer_stop(timer_advect) ! advection + ! define tracer dependency arrays + ! see comments in remapping routine + + depend(1:2) = 0 ! hice, hsno + tracer_type(1:2) = 1 ! no dependency + + k = 2 + + do nt = 1, ntrcr + depend(k+nt) = trcr_depend(nt) ! 0 for ice area tracers + ! 1 for ice volume tracers + ! 2 for snow volume tracers + tracer_type(k+nt) = 2 ! depends on 1 other tracer + if (trcr_depend(nt) == 0) then + tracer_type(k+nt) = 1 ! depends on no other tracers + elseif (trcr_depend(nt) > 2) then + if (trcr_depend(trcr_depend(nt)-2) > 0) then + tracer_type(k+nt) = 3 ! depends on 2 other tracers + endif + endif + enddo + + has_dependents = .false. + do nt = 1, ntrace + if (depend(nt) > 0) then + nt1 = depend(nt) + has_dependents(nt1) = .true. + if (nt1 > nt) then + write(nu_diag,*) & + 'Tracer nt2 =',nt,' depends on tracer nt1 =',nt1 + call abort_ice(subname// & + 'ERROR: remap transport: Must have nt2 > nt1') + endif + endif + enddo ! ntrace + + ! diagnostic output + if (my_task == master_task) then + write (nu_diag, *) 'tracer index depend type has_dependents' + nt = 1 + write(nu_diag,1000) 'hi ',nt,depend(nt),tracer_type(nt),& + has_dependents(nt) + nt = 2 + write(nu_diag,1000) 'hs ',nt,depend(nt),tracer_type(nt),& + has_dependents(nt) + k=2 + do nt = k+1, k+ntrcr + if (nt-k==nt_Tsfc) & + write(nu_diag,1000) 'nt_Tsfc ',nt,depend(nt),tracer_type(nt),& + has_dependents(nt) + if (nt-k==nt_qice) & + write(nu_diag,1000) 'nt_qice ',nt,depend(nt),tracer_type(nt),& + has_dependents(nt) + if (nt-k==nt_qsno) & + write(nu_diag,1000) 'nt_qsno ',nt,depend(nt),tracer_type(nt),& + has_dependents(nt) + if (nt-k==nt_sice) & + write(nu_diag,1000) 'nt_sice ',nt,depend(nt),tracer_type(nt),& + has_dependents(nt) + if (nt-k==nt_fbri) & + write(nu_diag,1000) 'nt_fbri ',nt,depend(nt),tracer_type(nt),& + has_dependents(nt) + if (nt-k==nt_iage) & + write(nu_diag,1000) 'nt_iage ',nt,depend(nt),tracer_type(nt),& + has_dependents(nt) + if (nt-k==nt_FY) & + write(nu_diag,1000) 'nt_FY ',nt,depend(nt),tracer_type(nt),& + has_dependents(nt) + if (nt-k==nt_alvl) & + write(nu_diag,1000) 'nt_alvl ',nt,depend(nt),tracer_type(nt),& + has_dependents(nt) + if (nt-k==nt_vlvl) & + write(nu_diag,1000) 'nt_vlvl ',nt,depend(nt),tracer_type(nt),& + has_dependents(nt) + if (nt-k==nt_apnd) & + write(nu_diag,1000) 'nt_apnd ',nt,depend(nt),tracer_type(nt),& + has_dependents(nt) + if (nt-k==nt_hpnd) & + write(nu_diag,1000) 'nt_hpnd ',nt,depend(nt),tracer_type(nt),& + has_dependents(nt) + if (nt-k==nt_ipnd) & + write(nu_diag,1000) 'nt_ipnd ',nt,depend(nt),tracer_type(nt),& + has_dependents(nt) + if (nt-k==nt_smice) & + write(nu_diag,1000) 'nt_smice ',nt,depend(nt),tracer_type(nt),& + has_dependents(nt) + if (nt-k==nt_smliq) & + write(nu_diag,1000) 'nt_smliq ',nt,depend(nt),tracer_type(nt),& + has_dependents(nt) + if (nt-k==nt_rhos) & + write(nu_diag,1000) 'nt_rhos ',nt,depend(nt),tracer_type(nt),& + has_dependents(nt) + if (nt-k==nt_rsnw) & + write(nu_diag,1000) 'nt_rsnw ',nt,depend(nt),tracer_type(nt),& + has_dependents(nt) + if (nt-k==nt_fsd) & + write(nu_diag,1000) 'nt_fsd ',nt,depend(nt),tracer_type(nt),& + has_dependents(nt) + if (nt-k==nt_isosno) & + write(nu_diag,1000) 'nt_isosno ',nt,depend(nt),tracer_type(nt),& + has_dependents(nt) + if (nt-k==nt_isoice) & + write(nu_diag,1000) 'nt_isoice ',nt,depend(nt),tracer_type(nt),& + has_dependents(nt) + 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 + 1000 format (1x,a,2x,i6,2x,i6,2x,i4,4x,l4) + + if (trim(advection)=='remap') call init_remap ! grid quantities + + call ice_timer_stop(timer_advect) ! advection end subroutine init_transport @@ -249,7 +249,7 @@ end subroutine init_transport ! ! This scheme preserves monotonicity of ice area and tracers. That is, ! it does not produce new extrema. It is second-order accurate in space, -! except where gradients are limited to preserve monotonicity. +! except where gradients are limited to preserve monotonicity. ! ! authors William H. Lipscomb, LANL @@ -262,8 +262,8 @@ subroutine transport_remap (dt) use ice_domain_size, only: ncat, max_blocks use ice_blocks, only: nx_block, ny_block, block, get_block, nghost use ice_state, only: aice0, aicen, vicen, vsnon, trcrn, & - uvel, vvel, bound_state - use ice_grid, only: tarea + uvel, vvel, bound_state, uvelE, vvelN + use ice_grid, only: tarea, grid_ice use ice_calendar, only: istep1 use ice_timers, only: ice_timer_start, ice_timer_stop, & timer_advect, timer_bound @@ -274,88 +274,87 @@ subroutine transport_remap (dt) ! local variables - integer (kind=int_kind) :: & - iblk ,&! block index - ilo,ihi,jlo,jhi,&! beginning and end of physical domain - n ,&! ice category index - nt, nt1, nt2 ! tracer indices - - real (kind=dbl_kind), & - dimension (nx_block,ny_block,0:ncat,max_blocks) :: & - aim ,&! mean ice category areas in each grid cell + integer (kind=int_kind) :: & + iblk , & ! block index + ilo,ihi,jlo,jhi, & ! beginning and end of physical domain + n , & ! ice category index + nt, nt1, nt2 ! tracer indices + + real (kind=dbl_kind), dimension (nx_block,ny_block,0:ncat,max_blocks) :: & + aim , & ! mean ice category areas in each grid cell aimask ! = 1. if ice is present, = 0. otherwise - real (kind=dbl_kind), & - dimension (nx_block,ny_block,ntrace,ncat,max_blocks) :: & - trm ,&! mean tracer values in each grid cell + real (kind=dbl_kind), dimension (nx_block,ny_block,ntrace,ncat,max_blocks) :: & + trm , & ! mean tracer values in each grid cell trmask ! = 1. if tracer is present, = 0. otherwise - logical (kind=log_kind) :: & + logical (kind=log_kind) :: & ckflag ! if true, abort the model - integer (kind=int_kind) :: & - istop, jstop ! indices of grid cell where model aborts + integer (kind=int_kind) :: & + istop, jstop ! indices of grid cell where model aborts - integer (kind=int_kind), dimension(0:ncat,max_blocks) :: & + integer (kind=int_kind), dimension(0:ncat,max_blocks) :: & icellsnc ! number of cells with ice - integer (kind=int_kind), & - dimension(nx_block*ny_block,0:ncat,max_blocks) :: & - indxinc, indxjnc ! compressed i/j indices + integer (kind=int_kind), dimension(nx_block*ny_block,0:ncat,max_blocks) :: & + indxinc, indxjnc ! compressed i/j indices integer (kind=int_kind) :: & - ntrcr + ntrcr ! number of tracers type (block) :: & - this_block ! block information for current block - + this_block ! block information for current block + ! variables related to optional bug checks - logical (kind=log_kind), parameter :: & + logical (kind=log_kind), parameter :: & l_monotonicity_check = .false. ! if true, check monotonicity - real (kind=dbl_kind), dimension(0:ncat) :: & - asum_init ,&! initial global ice area + real (kind=dbl_kind), dimension(0:ncat) :: & + asum_init , & ! initial global ice area asum_final ! final global ice area - real (kind=dbl_kind), dimension(ntrace,ncat) :: & - atsum_init ,&! initial global ice area*tracer + real (kind=dbl_kind), dimension(ntrace,ncat) :: & + atsum_init , & ! initial global ice area*tracer atsum_final ! final global ice area*tracer - real (kind=dbl_kind), dimension (:,:,:,:,:), allocatable :: & - tmin ,&! local min tracer - tmax ! local max tracer + real (kind=dbl_kind), dimension (:,:,:,:,:), allocatable :: & + tmin , & ! local min tracer + tmax ! local max tracer - integer (kind=int_kind) :: alloc_error + integer (kind=int_kind) :: & + alloc_error real (kind=dbl_kind), dimension (nx_block,ny_block,max_blocks) :: & work1 - character(len=char_len_long) :: fieldid + character(len=char_len_long) :: & + fieldid character(len=*), parameter :: subname = '(transport_remap)' - call ice_timer_start(timer_advect) ! advection + call ice_timer_start(timer_advect) ! advection 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__) -!---!------------------------------------------------------------------- -!---! Prepare for remapping. -!---! Initialize, update ghost cells, fill tracer arrays. -!---!------------------------------------------------------------------- + !------------------------------------------------------------------- + ! Prepare for remapping. + ! Initialize, update ghost cells, fill tracer arrays. + !------------------------------------------------------------------- ckflag = .false. istop = 0 jstop = 0 - !------------------------------------------------------------------- - ! Compute open water area in each grid cell. - ! Note: An aggregate_area call is needed only if the open - ! water area has changed since the previous call. - ! Here we assume that aice0 is up to date. - !------------------------------------------------------------------- + !------------------------------------------------------------------- + ! Compute open water area in each grid cell. + ! Note: An aggregate_area call is needed only if the open + ! water area has changed since the previous call. + ! Here we assume that aice0 is up to date. + !------------------------------------------------------------------- ! !$OMP PARALLEL DO PRIVATE(i,j,iblk) SCHEDULE(runtime) ! do iblk = 1, nblocks @@ -364,16 +363,16 @@ subroutine transport_remap (dt) ! call aggregate_area (ncat, ! aicen(i,j,:,iblk), & ! aice (i,j, iblk), & -! aice0(i,j, iblk)) +! aice0(i,j, iblk)) ! enddo ! enddo ! enddo ! !$OMP END PARALLEL DO - !------------------------------------------------------------------- - ! Ghost cell updates for state variables. - ! Commented out because ghost cells are updated after cleanup_itd. - !------------------------------------------------------------------- + !------------------------------------------------------------------- + ! Ghost cell updates for state variables. + ! Commented out because ghost cells are updated after cleanup_itd. + !------------------------------------------------------------------- ! call ice_timer_start(timer_bound) ! call ice_HaloUpdate (aice0, halo_info, & @@ -385,11 +384,11 @@ subroutine transport_remap (dt) ! call ice_timer_stop(timer_bound) - !------------------------------------------------------------------- - ! Ghost cell updates for ice velocity. - ! Commented out because ghost cell velocities are computed - ! in ice_dyn_evp. - !------------------------------------------------------------------- + !------------------------------------------------------------------- + ! Ghost cell updates for ice velocity. + ! Commented out because ghost cell velocities are computed + ! in ice_dyn_evp. + !------------------------------------------------------------------- ! call ice_timer_start(timer_bound) ! call ice_HaloUpdate (uvel, halo_info, & @@ -402,29 +401,29 @@ subroutine transport_remap (dt) !$OMP PARALLEL DO PRIVATE(iblk) SCHEDULE(runtime) do iblk = 1, nblocks - !------------------------------------------------------------------- - ! Fill arrays with fields to be remapped. - !------------------------------------------------------------------- + !------------------------------------------------------------------- + ! Fill arrays with fields to be remapped. + !------------------------------------------------------------------- - call state_to_tracers(nx_block, ny_block, & - ntrcr, ntrace, & - aice0(:,:, iblk), aicen(:,:,:,iblk), & - trcrn(:,:,:,:,iblk), & - vicen(:,:,:,iblk), vsnon(:,:, :,iblk), & - aim (:,:,:,iblk), trm (:,:,:,:,iblk)) + call state_to_tracers(nx_block, ny_block, & + ntrcr, ntrace, & + aice0(:,:, iblk), aicen(:,:,:, iblk), & + trcrn(:,:,:,:,iblk), & + vicen(:,:,:, iblk), vsnon(:,:,:, iblk), & + aim (:,:,:, iblk), trm (:,:,:,:,iblk)) enddo !$OMP END PARALLEL DO -!---!------------------------------------------------------------------- -!---! Optional conservation and monotonicity checks. -!---!------------------------------------------------------------------- + !------------------------------------------------------------------- + ! Optional conservation and monotonicity checks. + !------------------------------------------------------------------- if (conserv_check) then - !------------------------------------------------------------------- - ! Compute initial values of globally conserved quantities. - !------------------------------------------------------------------- + !------------------------------------------------------------------- + ! Compute initial values of globally conserved quantities. + !------------------------------------------------------------------- do n = 0, ncat asum_init(n) = global_sum(aim(:,:,n,:), distrb_info, & @@ -459,7 +458,7 @@ subroutine transport_remap (dt) enddo ! n endif ! conserv_check - + if (l_monotonicity_check) then allocate(tmin(nx_block,ny_block,ntrace,ncat,max_blocks), & @@ -474,33 +473,33 @@ subroutine transport_remap (dt) !$OMP PARALLEL DO PRIVATE(iblk,ilo,ihi,jlo,jhi,this_block,n) SCHEDULE(runtime) do iblk = 1, nblocks - this_block = get_block(blocks_ice(iblk),iblk) + 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 masks. - ! Masks are used to prevent tracer values in cells without ice - ! from being used in the monotonicity check. - !------------------------------------------------------------------- + !------------------------------------------------------------------- + ! Compute masks. + ! Masks are used to prevent tracer values in cells without ice + ! from being used in the monotonicity check. + !------------------------------------------------------------------- call make_masks (nx_block, ny_block, & ilo, ihi, jlo, jhi, & nghost, ntrace, & has_dependents, & - icellsnc(:,iblk), & - indxinc(:,:,iblk), indxjnc(:,:,iblk), & - aim(:,:,:,iblk), aimask(:,:,:,iblk), & + icellsnc (:,iblk), & + indxinc(:,:,iblk), indxjnc(:,:, iblk), & + aim(:,:,:, iblk), aimask(:,:,:, iblk), & trm(:,:,:,:,iblk), trmask(:,:,:,:,iblk)) - !------------------------------------------------------------------- - ! Compute local max and min of tracer fields. - !------------------------------------------------------------------- + !------------------------------------------------------------------- + ! Compute local max and min of tracer fields. + !------------------------------------------------------------------- do n = 1, ncat - call local_max_min & + call local_max_min & (nx_block, ny_block, & ilo, ihi, jlo, jhi, & trm (:,:,:,n,iblk), & @@ -519,16 +518,16 @@ subroutine transport_remap (dt) !$OMP PARALLEL DO PRIVATE(iblk,ilo,ihi,jlo,jhi,this_block,n) SCHEDULE(runtime) do iblk = 1, nblocks - this_block = get_block(blocks_ice(iblk),iblk) + 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 - call quasilocal_max_min (nx_block, ny_block, & - ilo, ihi, jlo, jhi, & - tmin(:,:,:,n,iblk), & + call quasilocal_max_min (nx_block, ny_block, & + ilo, ihi, jlo, jhi, & + tmin(:,:,:,n,iblk), & tmax(:,:,:,n,iblk)) enddo enddo @@ -536,38 +535,47 @@ subroutine transport_remap (dt) endif ! l_monotonicity_check - !------------------------------------------------------------------- - ! Main remapping routine: Step ice area and tracers forward in time. - !------------------------------------------------------------------- - - call horizontal_remap (dt, ntrace, & - uvel (:,:,:), vvel (:,:,:), & - aim (:,:,:,:), trm (:,:,:,:,:), & - l_fixed_area, & - tracer_type, depend, & - has_dependents, integral_order, & - l_dp_midpt) - - !------------------------------------------------------------------- - ! Given new fields, recompute state variables. - !------------------------------------------------------------------- + !------------------------------------------------------------------- + ! Main remapping routine: Step ice area and tracers forward in time. + !------------------------------------------------------------------- + + if (grid_ice == 'CD' .or. grid_ice == 'C') then + call horizontal_remap (dt, ntrace, & + uvel (:,:,:), vvel (:,:,:), & + aim (:,:,:,:), trm(:,:,:,:,:), & + tracer_type, depend, & + has_dependents, integral_order, & + l_dp_midpt, & + uvelE (:,:,:), vvelN (:,:,:)) + else + call horizontal_remap (dt, ntrace, & + uvel (:,:,:), vvel (:,:,:), & + aim (:,:,:,:), trm(:,:,:,:,:), & + tracer_type, depend, & + has_dependents, integral_order, & + l_dp_midpt) + endif + + !------------------------------------------------------------------- + ! Given new fields, recompute state variables. + !------------------------------------------------------------------- !$OMP PARALLEL DO PRIVATE(iblk) SCHEDULE(runtime) do iblk = 1, nblocks - call tracers_to_state (nx_block, ny_block, & - ntrcr, ntrace, & - aim (:,:,:,iblk), trm (:,:,:,:,iblk), & - aice0(:,:, iblk), aicen(:,:,:,iblk), & - trcrn(:,:,:,:,iblk), & - vicen(:,:,:,iblk), vsnon(:,:, :,iblk)) + call tracers_to_state (nx_block, ny_block, & + ntrcr, ntrace, & + aim (:,:,:, iblk), trm (:,:,:,:,iblk), & + aice0(:,:, iblk), aicen(:,:,:, iblk), & + trcrn(:,:,:,:,iblk), & + vicen(:,:,:, iblk), vsnon(:,:, :,iblk)) enddo ! iblk !$OMP END PARALLEL DO - !------------------------------------------------------------------- - ! Ghost cell updates for state variables. - !------------------------------------------------------------------- + !------------------------------------------------------------------- + ! Ghost cell updates for state variables. + !------------------------------------------------------------------- call ice_timer_start(timer_bound) @@ -577,14 +585,14 @@ subroutine transport_remap (dt) call ice_timer_stop(timer_bound) -!---!------------------------------------------------------------------- -!---! Optional conservation and monotonicity checks -!---!------------------------------------------------------------------- + !------------------------------------------------------------------- + ! Optional conservation and monotonicity checks + !------------------------------------------------------------------- - !------------------------------------------------------------------- - ! Compute final values of globally conserved quantities. - ! Check global conservation of area and area*tracers. (Optional) - !------------------------------------------------------------------- + !------------------------------------------------------------------- + ! Compute final values of globally conserved quantities. + ! Check global conservation of area and area*tracers. (Optional) + !------------------------------------------------------------------- if (conserv_check) then @@ -651,14 +659,14 @@ subroutine transport_remap (dt) endif ! conserv_check - !------------------------------------------------------------------- - ! Check tracer monotonicity. (Optional) - !------------------------------------------------------------------- + !------------------------------------------------------------------- + ! Check tracer monotonicity. (Optional) + !------------------------------------------------------------------- if (l_monotonicity_check) then !$OMP PARALLEL DO PRIVATE(iblk,ilo,ihi,jlo,jhi,this_block,n,ckflag,istop,jstop) SCHEDULE(runtime) do iblk = 1, nblocks - this_block = get_block(blocks_ice(iblk),iblk) + this_block = get_block(blocks_ice(iblk),iblk) ilo = this_block%ilo ihi = this_block%ihi jlo = this_block%jlo @@ -669,13 +677,12 @@ subroutine transport_remap (dt) jstop = 0 do n = 1, ncat - call check_monotonicity & - (nx_block, ny_block, & - ilo, ihi, jlo, jhi, & - tmin(:,:,:,n,iblk), tmax(:,:,:,n,iblk), & - aim (:,:, n,iblk), trm (:,:,:,n,iblk), & - ckflag, & - istop, jstop) + call check_monotonicity (nx_block, ny_block, & + ilo, ihi, jlo, jhi, & + tmin(:,:,:,n,iblk), tmax(:,:,:,n,iblk), & + aim (:,:, n,iblk), trm (:,:,:,n,iblk), & + ckflag, & + istop, jstop) if (ckflag) then write (nu_diag,*) 'istep1, my_task, iblk, cat =', & @@ -692,8 +699,8 @@ subroutine transport_remap (dt) endif ! l_monotonicity_check - call ice_timer_stop(timer_advect) ! advection - + call ice_timer_stop(timer_advect) ! advection + end subroutine transport_remap !======================================================================= @@ -709,37 +716,36 @@ subroutine transport_upwind (dt) use ice_domain_size, only: ncat, max_blocks use ice_state, only: aice0, aicen, vicen, vsnon, trcrn, & uvel, vvel, trcr_depend, bound_state, trcr_base, & - n_trcr_strata, nt_strata - use ice_grid, only: HTE, HTN, tarea, tmask + n_trcr_strata, nt_strata, uvelE, vvelN + use ice_grid, only: HTE, HTN, tarea, tmask, grid_ice use ice_timers, only: ice_timer_start, ice_timer_stop, & timer_bound, timer_advect - real (kind=dbl_kind), intent(in) :: & + real (kind=dbl_kind), intent(in) :: & dt ! time step ! local variables - integer (kind=int_kind) :: & - ntrcr, & ! + integer (kind=int_kind) :: & + ntrcr , & ! narr ! max number of state variable arrays - integer (kind=int_kind) :: & - i, j, iblk ,&! horizontal indices + integer (kind=int_kind) :: & + i, j, iblk , & ! horizontal indices ilo,ihi,jlo,jhi ! beginning and end of physical domain - real (kind=dbl_kind), dimension (nx_block,ny_block,nblocks) :: & + real (kind=dbl_kind), dimension (nx_block,ny_block,nblocks) :: & uee, vnn ! cell edge velocities - real (kind=dbl_kind), & - dimension (:,:,:,:), allocatable :: & + real (kind=dbl_kind), dimension (:,:,:,:), allocatable :: & works ! work array type (block) :: & - this_block ! block information for current block + this_block ! block information for current block character(len=*), parameter :: subname = '(transport_upwind)' - call ice_timer_start(timer_advect) ! advection + call ice_timer_start(timer_advect) ! advection call icepack_query_tracer_sizes(ntrcr_out=ntrcr) call icepack_warnings_flush(nu_diag) @@ -750,61 +756,64 @@ subroutine transport_upwind (dt) allocate (works(nx_block,ny_block,narr,max_blocks)) - !------------------------------------------------------------------- - ! Get ghost cell values of state variables. - ! (Assume velocities are already known for ghost cells, also.) - !------------------------------------------------------------------- + !------------------------------------------------------------------- + ! Get ghost cell values of state variables. + ! (Assume velocities are already known for ghost cells, also.) + !------------------------------------------------------------------- ! call bound_state (aicen, & ! vicen, vsnon, & ! ntrcr, trcrn) ! call ice_timer_start(timer_bound) -! call ice_HaloUpdate (uvel, halo_info, & +! call ice_HaloUpdate (uvel, halo_info, & ! field_loc_NEcorner, field_type_vector) -! call ice_HaloUpdate (vvel, halo_info, & +! call ice_HaloUpdate (vvel, halo_info, & ! field_loc_NEcorner, field_type_vector) ! call ice_timer_stop(timer_bound) - !------------------------------------------------------------------- - ! Average corner velocities to edges. - !------------------------------------------------------------------- - - !$OMP PARALLEL DO PRIVATE(iblk,i,j,ilo,ihi,jlo,jhi,this_block) SCHEDULE(runtime) - 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 + !------------------------------------------------------------------- + ! Average corner velocities to edges. + !------------------------------------------------------------------- + if (grid_ice == 'CD' .or. grid_ice == 'C') then + uee(:,:,:)=uvelE(:,:,:) + vnn(:,:,:)=vvelN(:,:,:) + else + !$OMP PARALLEL DO PRIVATE(iblk,i,j,ilo,ihi,jlo,jhi,this_block) SCHEDULE(runtime) + 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 - uee(i,j,iblk) = p5*(uvel(i,j,iblk) + uvel(i,j-1,iblk)) - vnn(i,j,iblk) = p5*(vvel(i,j,iblk) + vvel(i-1,j,iblk)) - enddo + do j = jlo, jhi + do i = ilo, ihi + uee(i,j,iblk) = p5*(uvel(i,j,iblk) + uvel(i ,j-1,iblk)) + vnn(i,j,iblk) = p5*(vvel(i,j,iblk) + vvel(i-1,j ,iblk)) + enddo + enddo enddo - enddo - !$OMP END PARALLEL DO + !$OMP END PARALLEL DO - call ice_timer_start(timer_bound) - call ice_HaloUpdate (uee, halo_info, & - field_loc_Eface, field_type_vector) - call ice_HaloUpdate (vnn, halo_info, & - field_loc_Nface, field_type_vector) - call ice_timer_stop(timer_bound) + call ice_timer_start(timer_bound) + call ice_HaloUpdate (uee, halo_info, & + field_loc_Eface, field_type_vector) + call ice_HaloUpdate (vnn, halo_info, & + field_loc_Nface, field_type_vector) + call ice_timer_stop(timer_bound) + endif !$OMP PARALLEL DO PRIVATE(iblk,ilo,ihi,jlo,jhi,this_block) SCHEDULE(runtime) do iblk = 1, nblocks - this_block = get_block(blocks_ice(iblk),iblk) + this_block = get_block(blocks_ice(iblk),iblk) ilo = this_block%ilo ihi = this_block%ihi jlo = this_block%jlo jhi = this_block%jhi - - !----------------------------------------------------------------- - ! fill work arrays with fields to be advected - !----------------------------------------------------------------- + !----------------------------------------------------------------- + ! fill work arrays with fields to be advected + !----------------------------------------------------------------- call state_to_work (nx_block, ny_block, & ntrcr, & @@ -813,21 +822,21 @@ subroutine transport_upwind (dt) vicen (:,:, :,iblk), vsnon (:,:, :,iblk), & aice0 (:,:, iblk), works (:,:, :,iblk)) - !----------------------------------------------------------------- - ! advect - !----------------------------------------------------------------- + !----------------------------------------------------------------- + ! advect + !----------------------------------------------------------------- call upwind_field (nx_block, ny_block, & ilo, ihi, jlo, jhi, & dt, & narr, works(:,:,:,iblk), & - uee(:,:,iblk), vnn (:,:,iblk), & - HTE(:,:,iblk), HTN (:,:,iblk), & + uee (:,:,iblk), vnn (:,:,iblk), & + HTE (:,:,iblk), HTN (:,:,iblk), & tarea(:,:,iblk)) - !----------------------------------------------------------------- - ! convert work arrays back to state variables - !----------------------------------------------------------------- + !----------------------------------------------------------------- + ! convert work arrays back to state variables + !----------------------------------------------------------------- call work_to_state (nx_block, ny_block, & ntrcr, narr, & @@ -836,16 +845,16 @@ subroutine transport_upwind (dt) tmask(:,:, iblk), & aicen(:,:, :,iblk), trcrn (:,:,:,:,iblk), & vicen(:,:, :,iblk), vsnon (:,:, :,iblk), & - aice0(:,:, iblk), works (:,:, :,iblk)) + aice0(:,:, iblk), works (:,:, :,iblk)) enddo ! iblk !$OMP END PARALLEL DO - + deallocate (works) - !------------------------------------------------------------------- - ! Ghost cell updates for state variables. - !------------------------------------------------------------------- + !------------------------------------------------------------------- + ! Ghost cell updates for state variables. + !------------------------------------------------------------------- call ice_timer_start(timer_bound) @@ -855,7 +864,7 @@ subroutine transport_upwind (dt) call ice_timer_stop(timer_bound) - call ice_timer_stop(timer_advect) ! advection + call ice_timer_stop(timer_advect) ! advection end subroutine transport_upwind @@ -865,7 +874,7 @@ end subroutine transport_upwind !======================================================================= ! ! Fill ice area and tracer arrays. -! Assume that the advected tracers are hicen, hsnon, trcrn, +! Assume that the advected tracers are hicen, hsnon, trcrn, ! qicen(1:nilyr), and qsnon(1:nslyr). ! This subroutine must be modified if a different set of tracers ! is to be transported. The rule for ordering tracers @@ -884,47 +893,47 @@ subroutine state_to_tracers (nx_block, ny_block, & use ice_domain_size, only: ncat, nslyr integer (kind=int_kind), intent(in) :: & - nx_block, ny_block, & ! block dimensions - ntrcr , & ! number of tracers in use - ntrace ! number of tracers in use incl. hi, hs + nx_block, ny_block, & ! block dimensions + ntrcr , & ! number of tracers in use + ntrace ! number of tracers in use incl. hi, hs real (kind=dbl_kind), dimension (nx_block,ny_block), intent(in) :: & - aice0 ! fractional open water area + aice0 ! fractional open water area real (kind=dbl_kind), dimension (nx_block,ny_block,ncat), intent(in) :: & - aicen ,&! fractional ice area - vicen ,&! volume per unit area of ice (m) - vsnon ! volume per unit area of snow (m) + aicen , & ! fractional ice area + vicen , & ! volume per unit area of ice (m) + vsnon ! volume per unit area of snow (m) real (kind=dbl_kind), dimension (nx_block,ny_block,ntrcr,ncat), intent(in) :: & - trcrn ! ice area tracers + trcrn ! ice area tracers real (kind=dbl_kind), dimension (nx_block,ny_block,0:ncat), intent(out) :: & - aim ! mean ice area in each grid cell + aim ! mean ice area in each grid cell real (kind=dbl_kind), dimension (nx_block,ny_block,ntrace,ncat), intent(out) :: & - trm ! mean tracer values in each grid cell + trm ! mean tracer values in each grid cell ! local variables integer (kind=int_kind) :: & - nt_qsno ,&! - i, j, n ,&! standard indices - it, kt ,&! tracer indices - ij ! combined i/j index + nt_qsno , & ! + i, j, n , & ! standard indices + it, kt , & ! tracer indices + ij ! combined i/j index real (kind=dbl_kind) :: & - puny ,&! - rhos ,&! - Lfresh ,&! - w1 ! work variable + puny , & ! + rhos , & ! snow density (km/m^3) + Lfresh , & ! latent heat of melting fresh ice (J/kg) + w1 ! work variable integer (kind=int_kind), dimension(nx_block*ny_block,0:ncat) :: & - indxi ,&! compressed i/j indices - indxj + indxi , & ! compressed i/j indices + indxj integer (kind=int_kind), dimension(0:ncat) :: & - icells ! number of cells with ice + icells ! number of cells with ice character(len=*), parameter :: subname = '(state_to_tracers)' @@ -941,9 +950,9 @@ subroutine state_to_tracers (nx_block, ny_block, & trm(:,:,:,n) = c0 - !------------------------------------------------------------------- - ! Find grid cells where ice is present and fill area array. - !------------------------------------------------------------------- + !------------------------------------------------------------------- + ! Find grid cells where ice is present and fill area array. + !------------------------------------------------------------------- icells(n) = 0 do j = 1, ny_block @@ -957,13 +966,13 @@ subroutine state_to_tracers (nx_block, ny_block, & endif ! aim > puny enddo enddo - - !------------------------------------------------------------------- - ! Fill tracer array - ! Note: If aice > 0, then hice > 0, but we can have hsno = 0. - ! Alse note: We transport qice*nilyr rather than qice, so as to - ! avoid extra operations here and in tracers_to_state. - !------------------------------------------------------------------- + + !------------------------------------------------------------------- + ! Fill tracer array + ! Note: If aice > 0, then hice > 0, but we can have hsno = 0. + ! Alse note: We transport qice*nilyr rather than qice, so as to + ! avoid extra operations here and in tracers_to_state. + !------------------------------------------------------------------- do ij = 1, icells(n) i = indxi(ij,n) @@ -990,7 +999,7 @@ subroutine state_to_tracers (nx_block, ny_block, & endif enddo enddo ! ncat - + end subroutine state_to_tracers !======================================================================= @@ -1009,42 +1018,42 @@ subroutine tracers_to_state (nx_block, ny_block, & use ice_domain_size, only: ncat, nslyr integer (kind=int_kind), intent(in) :: & - nx_block, ny_block, & ! block dimensions - ntrcr , & ! number of tracers in use - ntrace ! number of tracers in use incl. hi, hs + nx_block, ny_block, & ! block dimensions + ntrcr , & ! number of tracers in use + ntrace ! number of tracers in use incl. hi, hs real (kind=dbl_kind), dimension (nx_block,ny_block,0:ncat), intent(in) :: & - aim ! fractional ice area + aim ! fractional ice area real (kind=dbl_kind), dimension (nx_block,ny_block,ntrace,ncat), intent(in) :: & - trm ! mean tracer values in each grid cell + trm ! mean tracer values in each grid cell real (kind=dbl_kind), dimension (nx_block,ny_block), intent(inout) :: & - aice0 ! fractional ice area + aice0 ! fractional ice area real (kind=dbl_kind), dimension (nx_block,ny_block,ncat), intent(inout) :: & - aicen ,&! fractional ice area - vicen ,&! volume per unit area of ice (m) - vsnon ! volume per unit area of snow (m) + aicen , & ! fractional ice area + vicen , & ! volume per unit area of ice (m) + vsnon ! volume per unit area of snow (m) real (kind=dbl_kind), dimension (nx_block,ny_block,ntrcr,ncat), intent(inout) :: & - trcrn ! tracers + trcrn ! tracers ! local variables integer (kind=int_kind) :: & - nt_qsno ,&! - i, j, n ,&! standard indices - it, kt ,&! tracer indices - icells ,&! number of cells with ice - ij + nt_qsno , & ! + i, j, n , & ! standard indices + it, kt , & ! tracer indices + icells , & ! number of cells with ice + ij real (kind=dbl_kind) :: & - rhos, & - Lfresh + rhos , & ! + Lfresh ! integer (kind=int_kind), dimension (nx_block*ny_block) :: & - indxi, indxj ! compressed indices + indxi, indxj ! compressed indices character(len=*), parameter :: subname = '(tracers_to_state)' @@ -1058,20 +1067,20 @@ subroutine tracers_to_state (nx_block, ny_block, & do n = 1, ncat - icells = 0 - do j = 1, ny_block - do i = 1, nx_block - if (aim(i,j,n) > c0) then - icells = icells + 1 - indxi(icells) = i - indxj(icells) = j - endif - enddo - enddo + icells = 0 + do j = 1, ny_block + do i = 1, nx_block + if (aim(i,j,n) > c0) then + icells = icells + 1 + indxi(icells) = i + indxj(icells) = j + endif + enddo + enddo - !------------------------------------------------------------------- - ! Compute state variables. - !------------------------------------------------------------------- + !------------------------------------------------------------------- + ! Compute state variables. + !------------------------------------------------------------------- do ij = 1, icells i = indxi(ij) @@ -1089,7 +1098,7 @@ subroutine tracers_to_state (nx_block, ny_block, & j = indxj(ij) trcrn(i,j,it,n) = trm(i,j,kt+it,n) - rhos*Lfresh ! snow enthalpy enddo - else + else do ij = 1, icells i = indxi(ij) j = indxj(ij) @@ -1116,24 +1125,24 @@ subroutine global_conservation (ckflag, fieldid, & fieldid ! field information string real (kind=dbl_kind), intent(in) :: & - asum_init ,&! initial global ice area + asum_init , & ! initial global ice area asum_final ! final global ice area real (kind=dbl_kind), dimension(ntrace), intent(in), optional :: & - atsum_init ,&! initial global ice area*tracer + atsum_init, & ! initial global ice area*tracer atsum_final ! final global ice area*tracer logical (kind=log_kind), intent(inout) :: & - ckflag ! if true, abort on return + ckflag ! if true, abort on return ! local variables integer (kind=int_kind) :: & - nt ! tracer index + nt ! tracer index real (kind=dbl_kind) :: & - puny ,&! - diff ! difference between initial and final values + puny , & ! + diff ! difference between initial and final values character(len=*), parameter :: subname = '(global_conservation)' @@ -1156,21 +1165,21 @@ subroutine global_conservation (ckflag, fieldid, & endif if (present(atsum_init)) then - do nt = 1, ntrace - if (abs(atsum_init(nt)) > puny) then - diff = atsum_final(nt) - atsum_init(nt) - if (abs(diff/atsum_init(nt)) > puny) then - ckflag = .true. - write (nu_diag,*) - write (nu_diag,*) subname,'Ice area*tracer conserv error ', trim(fieldid),nt - write (nu_diag,*) subname,' Tracer index =', nt - write (nu_diag,*) subname,' Initial global area*tracer =', atsum_init(nt) - write (nu_diag,*) subname,' Final global area*tracer =', atsum_final(nt) - write (nu_diag,*) subname,' Fractional error =', abs(diff)/atsum_init(nt) - write (nu_diag,*) subname,' atsum_final-atsum_init =', diff + do nt = 1, ntrace + if (abs(atsum_init(nt)) > puny) then + diff = atsum_final(nt) - atsum_init(nt) + if (abs(diff/atsum_init(nt)) > puny) then + ckflag = .true. + write (nu_diag,*) + write (nu_diag,*) subname,'Ice area*tracer conserv error ', trim(fieldid),nt + write (nu_diag,*) subname,' Tracer index =', nt + write (nu_diag,*) subname,' Initial global area*tracer =', atsum_init(nt) + write (nu_diag,*) subname,' Final global area*tracer =', atsum_final(nt) + write (nu_diag,*) subname,' Fractional error =', abs(diff)/atsum_init(nt) + write (nu_diag,*) subname,' atsum_final-atsum_init =', diff + endif endif - endif - enddo + enddo endif ! present(atsum_init) end subroutine global_conservation @@ -1180,7 +1189,7 @@ end subroutine global_conservation ! At each grid point, compute the local max and min of a scalar ! field phi: i.e., the max and min values in the nine-cell region ! consisting of the home cell and its eight neighbors. -! +! ! To extend to the neighbors of the neighbors (25 cells in all), ! follow this call with a call to quasilocal_max_min. ! @@ -1193,33 +1202,33 @@ subroutine local_max_min (nx_block, ny_block, & aimask, trmask) integer (kind=int_kind), intent(in) :: & - nx_block, ny_block,&! block dimensions - ilo,ihi,jlo,jhi ! beginning and end of physical domain + nx_block, ny_block, & ! block dimensions + ilo,ihi,jlo,jhi ! beginning and end of physical domain real (kind=dbl_kind), intent(in), dimension(nx_block,ny_block) :: & - aimask ! ice area mask + aimask ! ice area mask real (kind=dbl_kind), intent(in), dimension (nx_block,ny_block,ntrace) :: & - trm ,&! tracer fields - trmask ! tracer mask + trm , & ! tracer fields + trmask ! tracer mask real (kind=dbl_kind), intent(out), dimension (nx_block,ny_block,ntrace) :: & - tmin ,&! local min tracer - tmax ! local max tracer + tmin , & ! local min tracer + tmax ! local max tracer ! local variables integer (kind=int_kind) :: & - i, j ,&! horizontal indices - nt, nt1 ! tracer indices + i, j , & ! horizontal indices + nt, nt1 ! tracer indices real (kind=dbl_kind), dimension(nx_block,ny_block) :: & - phimask ! aimask or trmask, as appropriate + phimask ! aimask or trmask, as appropriate real (kind=dbl_kind) :: & - phi_nw, phi_n, phi_ne ,&! field values in 8 neighbor cells - phi_w, phi_e ,& - phi_sw, phi_s, phi_se + phi_nw, phi_n, phi_ne , & ! field values in 8 neighbor cells + phi_w , phi_e , & + phi_sw, phi_s, phi_se character(len=*), parameter :: subname = '(local_max_min)' @@ -1244,46 +1253,46 @@ subroutine local_max_min (nx_block, ny_block, & endif -!----------------------------------------------------------------------- -! Store values of trm in the 8 neighbor cells. -! If aimask = 1, use the true value; otherwise use the home cell value -! so that non-physical values of phi do not contribute to the gradient. -!----------------------------------------------------------------------- + !----------------------------------------------------------------------- + ! Store values of trm in the 8 neighbor cells. + ! If aimask = 1, use the true value; otherwise use the home cell value + ! so that non-physical values of phi do not contribute to the gradient. + !----------------------------------------------------------------------- do j = jlo, jhi - do i = ilo, ihi - - phi_nw = phimask(i-1,j+1) * trm(i-1,j+1,nt) & - + (c1-phimask(i-1,j+1))* trm(i, j, nt) - phi_n = phimask(i, j+1) * trm(i, j+1,nt) & - + (c1-phimask(i, j+1))* trm(i, j, nt) - phi_ne = phimask(i+1,j+1) * trm(i+1,j+1,nt) & - + (c1-phimask(i+1,j+1))* trm(i, j, nt) - phi_w = phimask(i-1,j) * trm(i-1,j, nt) & - + (c1-phimask(i-1,j)) * trm(i, j, nt) - phi_e = phimask(i+1,j) * trm(i+1,j, nt) & - + (c1-phimask(i+1,j)) * trm(i, j, nt) - phi_sw = phimask(i-1,j-1) * trm(i-1,j-1,nt) & - + (c1-phimask(i-1,j-1))* trm(i, j, nt) - phi_s = phimask(i, j-1) * trm(i, j-1,nt) & - + (c1-phimask(i, j-1))* trm(i, j, nt) - phi_se = phimask(i+1,j-1) * trm(i+1,j-1,nt) & - + (c1-phimask(i+1,j-1))* trm(i, j, nt) - -!----------------------------------------------------------------------- -! Compute the minimum and maximum among the nine local cells. -!----------------------------------------------------------------------- - - tmax(i,j,nt) = max (phi_nw, phi_n, phi_ne, phi_w, & - trm(i,j,nt), phi_e, phi_sw, phi_s, phi_se) - - tmin(i,j,nt) = min (phi_nw, phi_n, phi_ne, phi_w, & - trm(i,j,nt), phi_e, phi_sw, phi_s, phi_se) - - enddo ! i - enddo ! j + do i = ilo, ihi - enddo ! nt + phi_nw = phimask(i-1,j+1) * trm(i-1,j+1,nt) & + + (c1-phimask(i-1,j+1))* trm(i, j, nt) + phi_n = phimask(i, j+1) * trm(i, j+1,nt) & + + (c1-phimask(i, j+1))* trm(i, j, nt) + phi_ne = phimask(i+1,j+1) * trm(i+1,j+1,nt) & + + (c1-phimask(i+1,j+1))* trm(i, j, nt) + phi_w = phimask(i-1,j) * trm(i-1,j, nt) & + + (c1-phimask(i-1,j)) * trm(i, j, nt) + phi_e = phimask(i+1,j) * trm(i+1,j, nt) & + + (c1-phimask(i+1,j)) * trm(i, j, nt) + phi_sw = phimask(i-1,j-1) * trm(i-1,j-1,nt) & + + (c1-phimask(i-1,j-1))* trm(i, j, nt) + phi_s = phimask(i, j-1) * trm(i, j-1,nt) & + + (c1-phimask(i, j-1))* trm(i, j, nt) + phi_se = phimask(i+1,j-1) * trm(i+1,j-1,nt) & + + (c1-phimask(i+1,j-1))* trm(i, j, nt) + + !----------------------------------------------------------------------- + ! Compute the minimum and maximum among the nine local cells. + !----------------------------------------------------------------------- + + tmax(i,j,nt) = max (phi_nw, phi_n, phi_ne, phi_w, & + trm(i,j,nt), phi_e, phi_sw, phi_s, phi_se) + + tmin(i,j,nt) = min (phi_nw, phi_n, phi_ne, phi_w, & + trm(i,j,nt), phi_e, phi_sw, phi_s, phi_se) + + enddo ! i + enddo ! j + + enddo ! nt end subroutine local_max_min @@ -1300,18 +1309,18 @@ subroutine quasilocal_max_min (nx_block, ny_block, & tmin, tmax) integer (kind=int_kind), intent(in) :: & - nx_block, ny_block,&! block dimensions - ilo,ihi,jlo,jhi ! beginning and end of physical domain + nx_block, ny_block, & ! block dimensions + ilo,ihi,jlo,jhi ! beginning and end of physical domain real (kind=dbl_kind), intent(inout), dimension (nx_block,ny_block,ntrace) :: & - tmin ,&! local min tracer - tmax ! local max tracer + tmin , & ! local min tracer + tmax ! local max tracer ! local variables integer (kind=int_kind) :: & - i, j ,&! horizontal indices - nt ! tracer index + i, j , & ! horizontal indices + nt ! tracer index character(len=*), parameter :: subname = '(quasilocal_max_min)' @@ -1352,37 +1361,37 @@ subroutine check_monotonicity (nx_block, ny_block, & istop, jstop) integer (kind=int_kind), intent(in) :: & - nx_block, ny_block,&! block dimensions - ilo,ihi,jlo,jhi ! beginning and end of physical domain + nx_block, ny_block, & ! block dimensions + ilo,ihi,jlo,jhi ! beginning and end of physical domain real (kind=dbl_kind), intent(in), dimension (nx_block,ny_block) :: & - aim ! new ice area + aim ! new ice area real (kind=dbl_kind), intent(in), dimension (nx_block,ny_block,ntrace) :: & - trm ! new tracers + trm ! new tracers real (kind=dbl_kind), intent(in), dimension (nx_block,ny_block,ntrace) :: & - tmin ,&! local min tracer - tmax ! local max tracer + tmin , & ! local min tracer + tmax ! local max tracer logical (kind=log_kind), intent(inout) :: & - ckflag ! if true, abort on return + ckflag ! if true, abort on return integer (kind=int_kind), intent(inout) :: & - istop, jstop ! indices of grid cell where model aborts + istop, jstop ! indices of grid cell where model aborts ! local variables integer (kind=int_kind) :: & - i, j ,&! horizontal indices - nt, nt1, nt2 ! tracer indices + i, j , & ! horizontal indices + nt, nt1, nt2 ! tracer indices real (kind=dbl_kind) :: & - puny ,&! - w1, w2 ! work variables + puny , & ! + w1, w2 ! work variables logical (kind=log_kind), dimension (nx_block, ny_block) :: & - l_check ! if true, check monotonicity + l_check ! if true, check monotonicity character(len=*), parameter :: subname = '(check_monotonicity)' @@ -1393,15 +1402,15 @@ subroutine check_monotonicity (nx_block, ny_block, & do nt = 1, ntrace - !------------------------------------------------------------------- - ! Load logical array to identify tracers that need checking. - !------------------------------------------------------------------- + !------------------------------------------------------------------- + ! Load logical array to identify tracers that need checking. + !------------------------------------------------------------------- if (tracer_type(nt)==1) then ! does not depend on another tracer do j = jlo, jhi do i = ilo, ihi - if (aim(i,j) > puny) then + if (aim(i,j) > puny) then l_check(i,j) = .true. else l_check(i,j) = .false. @@ -1438,9 +1447,9 @@ subroutine check_monotonicity (nx_block, ny_block, & enddo endif - !------------------------------------------------------------------- - ! Make sure new values lie between tmin and tmax - !------------------------------------------------------------------- + !------------------------------------------------------------------- + ! Make sure new values lie between tmin and tmax + !------------------------------------------------------------------- do j = jlo, jhi do i = ilo, ihi @@ -1497,24 +1506,24 @@ subroutine state_to_work (nx_block, ny_block, & integer (kind=int_kind), intent(in) :: & nx_block, ny_block, & ! block dimensions ntrcr , & ! number of tracers in use - narr ! number of 2D state variable arrays in works array + narr ! number of 2D state variable arrays in works array integer (kind=int_kind), dimension (ntrcr), intent(in) :: & trcr_depend ! = 0 for aicen tracers, 1 for vicen, 2 for vsnon real (kind=dbl_kind), dimension (nx_block,ny_block,ncat), intent(in) :: & - aicen ,&! concentration of ice - vicen ,&! volume per unit area of ice (m) - vsnon ! volume per unit area of snow (m) + aicen , & ! concentration of ice + vicen , & ! volume per unit area of ice (m) + vsnon ! volume per unit area of snow (m) real (kind=dbl_kind), dimension (nx_block,ny_block,ntrcr,ncat), intent(in) :: & - trcrn ! ice tracers + trcrn ! ice tracers real (kind=dbl_kind), dimension (nx_block,ny_block), intent(in) :: & - aice0 ! concentration of open water + aice0 ! concentration of open water real (kind=dbl_kind), dimension(nx_block,ny_block,narr), intent (out) :: & - works ! work array + works ! work array ! local variables @@ -1525,8 +1534,8 @@ subroutine state_to_work (nx_block, ny_block, & tr_pond_lvl, tr_pond_topo integer (kind=int_kind) :: & - i, j, n, it ,&! counting indices - narrays ! counter for number of state variable arrays + i, j, n, it, & ! counting indices + narrays ! counter for number of state variable arrays character(len=*), parameter :: subname = '(state_to_work)' @@ -1585,36 +1594,36 @@ subroutine state_to_work (nx_block, ny_block, & elseif (trcr_depend(it) == 2+nt_alvl) then do j = 1, ny_block do i = 1, nx_block - works(i,j,narrays+it) = aicen(i,j,n) & + works(i,j,narrays+it) = aicen(i,j ,n) & * trcrn(i,j,nt_alvl,n) & - * trcrn(i,j,it,n) + * trcrn(i,j,it ,n) enddo enddo elseif (trcr_depend(it) == 2+nt_apnd .and. & tr_pond_topo) then do j = 1, ny_block do i = 1, nx_block - works(i,j,narrays+it) = aicen(i,j,n) & + works(i,j,narrays+it) = aicen(i,j ,n) & * trcrn(i,j,nt_apnd,n) & - * trcrn(i,j,it,n) + * trcrn(i,j,it ,n) enddo enddo elseif (trcr_depend(it) == 2+nt_apnd .and. & tr_pond_lvl) then do j = 1, ny_block do i = 1, nx_block - works(i,j,narrays+it) = aicen(i,j,n) & + works(i,j,narrays+it) = aicen(i,j ,n) & * trcrn(i,j,nt_alvl,n) & * trcrn(i,j,nt_apnd,n) & - * trcrn(i,j,it,n) + * trcrn(i,j,it ,n) enddo enddo elseif (trcr_depend(it) == 2+nt_fbri) then do j = 1, ny_block do i = 1, nx_block - works(i,j,narrays+it) = vicen(i,j,n) & + works(i,j,narrays+it) = vicen(i,j ,n) & * trcrn(i,j,nt_fbri,n) & - * trcrn(i,j,it,n) + * trcrn(i,j,it ,n) enddo enddo endif @@ -1632,23 +1641,23 @@ end subroutine state_to_work ! ! Convert work array back to state variables - subroutine work_to_state (nx_block, ny_block, & - ntrcr, narr, & - trcr_depend, & - trcr_base, & - n_trcr_strata, & - nt_strata, & - tmask, & - aicen, trcrn, & - vicen, vsnon, & - aice0, works) + subroutine work_to_state (nx_block, ny_block, & + ntrcr, narr, & + trcr_depend, & + trcr_base, & + n_trcr_strata, & + nt_strata, & + tmask, & + aicen, trcrn, & + vicen, vsnon, & + aice0, works) use ice_domain_size, only: ncat - integer (kind=int_kind), intent (in) :: & + integer (kind=int_kind), intent (in) :: & nx_block, ny_block, & ! block dimensions ntrcr , & ! number of tracers in use - narr ! number of 2D state variable arrays in works array + narr ! number of 2D state variable arrays in works array integer (kind=int_kind), dimension (ntrcr), intent(in) :: & trcr_depend, & ! = 0 for aicen tracers, 1 for vicen, 2 for vsnon @@ -1661,36 +1670,36 @@ subroutine work_to_state (nx_block, ny_block, & integer (kind=int_kind), dimension (ntrcr,2), intent(in) :: & nt_strata ! indices of underlying tracer layers - logical (kind=log_kind), intent (in) :: & + logical (kind=log_kind), intent (in) :: & tmask (nx_block,ny_block) - real (kind=dbl_kind), intent (in) :: & + real (kind=dbl_kind), intent (in) :: & works (nx_block,ny_block,narr) real (kind=dbl_kind), dimension (nx_block,ny_block,ncat), intent(out) :: & - aicen ,&! concentration of ice - vicen ,&! volume per unit area of ice (m) - vsnon ! volume per unit area of snow (m) + aicen , & ! concentration of ice + vicen , & ! volume per unit area of ice (m) + vsnon ! volume per unit area of snow (m) real (kind=dbl_kind), dimension (nx_block,ny_block,ntrcr,ncat),intent(out) :: & - trcrn ! ice tracers + trcrn ! ice tracers real (kind=dbl_kind), dimension (nx_block,ny_block), intent(out) :: & - aice0 ! concentration of open water + aice0 ! concentration of open water ! local variables - integer (kind=int_kind) :: & - i, j, ij, n ,&! counting indices - narrays ,&! counter for number of state variable arrays - nt_Tsfc ,&! Tsfc tracer number - icells ! number of ocean/ice cells + integer (kind=int_kind) :: & + i, j, ij, n, & ! counting indices + narrays , & ! counter for number of state variable arrays + nt_Tsfc , & ! Tsfc tracer number + icells ! number of ocean/ice cells - integer (kind=int_kind), dimension (nx_block*ny_block) :: & + integer (kind=int_kind), dimension (nx_block*ny_block) :: & indxi, indxj - real (kind=dbl_kind), dimension (nx_block*ny_block,narr) :: & - work + real (kind=dbl_kind), dimension (nx_block*ny_block,narr) :: & + work character(len=*), parameter :: subname = '(work_to_state)' @@ -1732,15 +1741,16 @@ subroutine work_to_state (nx_block, ny_block, & i = indxi(ij) j = indxj(ij) - call icepack_compute_tracers(ntrcr=ntrcr, trcr_depend=trcr_depend(:), & - atrcrn = work (ij,narrays+1:narrays+ntrcr), & - aicen = aicen(i,j,n), & - vicen = vicen(i,j,n), & - vsnon = vsnon(i,j,n), & + call icepack_compute_tracers(ntrcr = ntrcr, & + trcr_depend = trcr_depend(:), & + atrcrn = work (ij,narrays+1:narrays+ntrcr), & + aicen = aicen(i,j,n), & + vicen = vicen(i,j,n), & + vsnon = vsnon(i,j,n), & trcr_base = trcr_base(:,:), & n_trcr_strata = n_trcr_strata(:), & nt_strata = nt_strata(:,:), & - trcrn = trcrn(i,j,:,n)) + trcrn = trcrn(i,j,:,n)) ! tcraig, don't let land points get non-zero Tsfc if (.not.tmask(i,j)) then @@ -1772,53 +1782,53 @@ subroutine upwind_field (nx_block, ny_block, & tarea) integer (kind=int_kind), intent (in) :: & - nx_block, ny_block ,&! block dimensions - ilo,ihi,jlo,jhi ,&! beginning and end of physical domain - narrays ! number of 2D arrays to be transported + nx_block, ny_block, & ! block dimensions + ilo,ihi,jlo,jhi , & ! beginning and end of physical domain + narrays ! number of 2D arrays to be transported real (kind=dbl_kind), intent(in) :: & - dt ! time step + dt ! time step real (kind=dbl_kind), dimension(nx_block,ny_block,narrays), intent(inout) :: & - phi ! scalar field + phi ! scalar field real (kind=dbl_kind), dimension(nx_block,ny_block), intent(in) :: & - uee, vnn ! cell edge velocities + uee, vnn ! cell edge velocities real (kind=dbl_kind), dimension(nx_block,ny_block), intent(in) :: & - HTE ,&! length of east cell edge - HTN ,&! length of north cell edge - tarea ! grid cell area + HTE , & ! length of east cell edge + HTN , & ! length of north cell edge + tarea ! grid cell area ! local variables integer (kind=int_kind) :: & - i, j, n ! standard indices + i, j, n ! standard indices real (kind=dbl_kind), dimension (nx_block,ny_block) :: & worka, workb character(len=*), parameter :: subname = '(upwind_field)' - !------------------------------------------------------------------- - ! upwind transport - !------------------------------------------------------------------- + !------------------------------------------------------------------- + ! upwind transport + !------------------------------------------------------------------- do n = 1, narrays do j = 1, jhi do i = 1, ihi worka(i,j)= & - upwind(phi(i,j,n),phi(i+1,j,n),uee(i,j),HTE(i,j),dt) + upwind(phi(i,j,n),phi(i+1,j ,n),uee(i,j),HTE(i,j),dt) workb(i,j)= & - upwind(phi(i,j,n),phi(i,j+1,n),vnn(i,j),HTN(i,j),dt) + upwind(phi(i,j,n),phi(i ,j+1,n),vnn(i,j),HTN(i,j),dt) enddo enddo do j = jlo, jhi do i = ilo, ihi - phi(i,j,n) = phi(i,j,n) - ( worka(i,j)-worka(i-1,j) & - + workb(i,j)-workb(i,j-1) ) & + phi(i,j,n) = phi(i,j,n) - ( worka(i,j)-worka(i-1,j ) & + + workb(i,j)-workb(i ,j-1) ) & / tarea(i,j) enddo enddo @@ -1828,10 +1838,9 @@ subroutine upwind_field (nx_block, ny_block, & end subroutine upwind_field !======================================================================= - - !------------------------------------------------------------------- - ! Define upwind function - !------------------------------------------------------------------- +! +! Define upwind function +! real(kind=dbl_kind) function upwind(y1,y2,a,h,dt) 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_forcing.F90 b/cicecore/cicedyn/general/ice_forcing.F90 index 541efb282..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,16 +296,8 @@ 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 - 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 @@ -644,15 +634,7 @@ 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 - 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 @@ -1593,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' @@ -1726,23 +1700,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 @@ -1977,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 @@ -2195,352 +2165,117 @@ 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) -! - integer (kind=int_kind), intent(in) :: & - yr ! current forcing year - - character(len=*), parameter :: subname = '(JRA55_gx1_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) - endif - end subroutine JRA55_gx1_files - -!======================================================================= - - subroutine JRA55_tx1_files(yr) -! - integer (kind=int_kind), intent(in) :: & - yr ! current forcing year - - character(len=*), parameter :: subname = '(JRA55_tx1_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_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 + 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 - subroutine JRA55_gx3_files(yr) -! integer (kind=int_kind), intent(in) :: & - yr ! current forcing year - - character(len=*), parameter :: subname = '(JRA55_gx3_files)' + yr ! current forcing year - if (local_debug .and. my_task == master_task) write(nu_diag,*) subname,'fdbg start' - - 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) - endif - end subroutine JRA55_gx3_files - -#ifdef UNDEPRECATE_LYq -!======================================================================= -! -! read Large and Yeager atmospheric data -! note: also uses AOMIP protocol, in part + ! local variables + character(len=16) :: & + grd ! gx3, gx1, tx1 - 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 + character(len=64) :: & + atm_data_type_prefix ! atm_data_type prefix 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 + cnt , & ! search for files + strind ! string index - logical (kind=log_kind) :: readm, read6 - - type (block) :: & - this_block ! block information for current block + logical :: & + exists ! file existance - character(len=*), parameter :: subname = '(LY_data)' + character(len=*), parameter :: subname = '(JRA55_files)' 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. + ! 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 - 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) + ! 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//'nonbinary atm_data_format unavailable', & - file=__FILE__, line=__LINE__) + call abort_ice(error_message=subname//' unknown grid type') 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) + ! 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' - !$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 + 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' - 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 + if (cnt == 3) uwind_file = trim(atm_data_dir)//'/'//trim(atm_data_type_prefix)// & + '/8XDAILY/'//trim(atm_data_type_prefix)// '_03hr_forcing_2005.nc' - ! 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 + if (cnt == 4) uwind_file = trim(atm_data_dir)// & + '/8XDAILY/'//trim(atm_data_type_prefix)//'_'//trim(grd)//'_03hr_forcing_2005.nc' - call compute_shortwave(nx_block, ny_block, & - ilo, ihi, jlo, jhi, & - TLON (:,:,iblk), & - TLAT (:,:,iblk), & - hm (:,:,iblk), & - Qa (:,:,iblk), & - cldf (:,:,iblk), & - fsw (:,:,iblk)) + if (cnt == 5) uwind_file = trim(atm_data_dir)// & + '/8XDAILY/'//trim(atm_data_type_prefix)//'_03hr_forcing_'//trim(grd)//'_2005.nc' - enddo ! iblk - !$OMP END PARALLEL DO + if (cnt == 6) uwind_file = trim(atm_data_dir)// & + '/8XDAILY/'//trim(atm_data_type_prefix)// '_03hr_forcing_2005.nc' - ! Save record number - oldrecnum = recnum + 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 (debug_forcing) then - if (my_task == master_task) write (nu_diag,*) 'LY_bulk_data' - vmin = global_minval(fsw,distrb_info,tmask) + if (.not.exists) then + call abort_ice(error_message=subname//' could not find forcing file') + endif - 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 + if (my_task == master_task) then + write (nu_diag,'(2a)') ' ' + write (nu_diag,'(2a)') subname,'Atmospheric data files:' + write (nu_diag,'(2a)') subname,trim(uwind_file) + endif - endif ! debug_forcing + end subroutine JRA55_files - end subroutine LY_data -#endif !======================================================================= subroutine JRA55_data @@ -2611,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) @@ -2623,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 @@ -2633,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/general/ice_init.F90 b/cicecore/cicedyn/general/ice_init.F90 index d56ad002e..f59004a41 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 @@ -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)' @@ -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, & @@ -322,8 +323,10 @@ 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 + 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 @@ -609,7 +612,7 @@ subroutine input_data call abort_ice(subname//'ERROR: searching for '// trim(nml_name), & file=__FILE__, line=__LINE__) endif - + ! read namelist nml_error = 1 do while (nml_error > 0) @@ -657,7 +660,7 @@ subroutine input_data call abort_ice(subname//'ERROR: searching for '// trim(nml_name), & file=__FILE__, line=__LINE__) endif - + ! read namelist nml_error = 1 do while (nml_error > 0) @@ -681,7 +684,7 @@ subroutine input_data call abort_ice(subname//'ERROR: searching for '// trim(nml_name), & file=__FILE__, line=__LINE__) endif - + ! read namelist nml_error = 1 do while (nml_error > 0) @@ -699,7 +702,7 @@ subroutine input_data ! read dynamics_nml nml_name = 'dynamics_nml' write(nu_diag,*) subname,' Reading ', trim(nml_name) - + ! goto namelist in file call goto_nml(nu_nml,trim(nml_name),nml_error) if (nml_error /= 0) then @@ -724,7 +727,7 @@ subroutine input_data ! read shortwave_nml nml_name = 'shortwave_nml' write(nu_diag,*) subname,' Reading ', trim(nml_name) - + ! goto namelist in file call goto_nml(nu_nml,trim(nml_name),nml_error) if (nml_error /= 0) then @@ -749,14 +752,14 @@ subroutine input_data ! read ponds_nml nml_name = 'ponds_nml' write(nu_diag,*) subname,' Reading ', trim(nml_name) - + ! goto namelist in file call goto_nml(nu_nml,trim(nml_name),nml_error) if (nml_error /= 0) then call abort_ice(subname//'ERROR: searching for '// trim(nml_name), & file=__FILE__, line=__LINE__) endif - + ! read namelist nml_error = 1 do while (nml_error > 0) @@ -774,14 +777,14 @@ subroutine input_data ! read snow_nml nml_name = 'snow_nml' write(nu_diag,*) subname,' Reading ', trim(nml_name) - + ! goto namelist in file call goto_nml(nu_nml,trim(nml_name),nml_error) if (nml_error /= 0) then call abort_ice(subname//'ERROR: searching for '// trim(nml_name), & file=__FILE__, line=__LINE__) endif - + ! read namelist nml_error = 1 do while (nml_error > 0) @@ -821,7 +824,7 @@ subroutine input_data endif end do - ! done reading namelist. + ! done reading namelist. close(nu_nml) call release_fileunit(nu_nml) endif @@ -901,11 +904,12 @@ 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) 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" @@ -2311,12 +2320,12 @@ 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 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) @@ -2533,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, & @@ -2721,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), & @@ -2743,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, & @@ -2761,7 +2771,6 @@ subroutine init_state endif - !----------------------------------------------------------------- ! compute aggregate ice state and open water area !----------------------------------------------------------------- @@ -2820,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, & @@ -2846,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) @@ -3294,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/cicecore/cicedyn/infrastructure/comm/mpi/ice_reprosum.F90 b/cicecore/cicedyn/infrastructure/comm/mpi/ice_reprosum.F90 index dd547c078..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 diff --git a/cicecore/cicedyn/infrastructure/comm/serial/ice_boundary.F90 b/cicecore/cicedyn/infrastructure/comm/serial/ice_boundary.F90 index 757d69d2e..faeaf3227 100644 --- a/cicecore/cicedyn/infrastructure/comm/serial/ice_boundary.F90 +++ b/cicecore/cicedyn/infrastructure/comm/serial/ice_boundary.F90 @@ -12,13 +12,20 @@ module ice_boundary ! fixes for non-existent blocks ! 2008-01-28: Elizabeth Hunke replaced old routines with new POP ! infrastructure +! 2023-03-09: Tony Craig updated the implementation to fix bug in +! tripoleT and reduce number of copies in tripole overall. +! Because all blocks are local, can fill the tripole +! buffer from "north" copies. This is not true for +! the MPI version. use ice_kinds_mod use ice_communicate, only: my_task use ice_constants, only: field_type_scalar, & field_type_vector, field_type_angle, & + field_type_unknown, field_type_noupdate, & field_loc_center, field_loc_NEcorner, & - field_loc_Nface, field_loc_Eface + field_loc_Nface, field_loc_Eface, & + field_loc_unknown, field_loc_noupdate use ice_global_reductions, only: global_maxval use ice_exit, only: abort_ice use icepack_intfc, only: icepack_warnings_flush, icepack_warnings_aborted @@ -310,10 +317,11 @@ function ice_HaloCreate(dist, nsBoundaryType, ewBoundaryType, & !*** for that !echmod if (tripoleBlock .and. dstProc /= srcProc) then - if (tripoleBlock) then - call ice_HaloIncrementMsgCount(sendCount, recvCount, & - srcProc, dstProc, northMsgSize) - endif +! tcx,tcraig, 3/2023, this is not needed +! if (tripoleBlock) then +! call ice_HaloIncrementMsgCount(sendCount, recvCount, & +! srcProc, dstProc, northMsgSize) +! endif !*** find west neighbor block and add to message count @@ -336,10 +344,11 @@ function ice_HaloCreate(dist, nsBoundaryType, ewBoundaryType, & !*** for that !echmod if (tripoleBlock .and. dstProc /= srcProc) then - if (tripoleBlock) then - call ice_HaloIncrementMsgCount(sendCount, recvCount, & - srcProc, dstProc, northMsgSize) - endif +! tcx,tcraig, 3/2023, this is not needed +! if (tripoleBlock) then +! call ice_HaloIncrementMsgCount(sendCount, recvCount, & +! srcProc, dstProc, northMsgSize) +! endif !*** find northeast neighbor block and add to message count @@ -352,11 +361,12 @@ function ice_HaloCreate(dist, nsBoundaryType, ewBoundaryType, & call ice_distributionGetBlockLoc(dist, neBlock, dstProc, & dstLocalID) - else if (neBlock < 0) then ! tripole north row - msgSize = northMsgSize ! tripole needs whole top row of block - - call ice_distributionGetBlockLoc(dist, abs(neBlock), dstProc, & - dstLocalID) +! tcx,tcraig, 3/2023, this is not needed +! else if (neBlock < 0) then ! tripole north row +! msgSize = northMsgSize ! tripole needs whole top row of block +! +! call ice_distributionGetBlockLoc(dist, abs(neBlock), dstProc, & +! dstLocalID) else dstProc = 0 dstLocalID = 0 @@ -376,11 +386,12 @@ function ice_HaloCreate(dist, nsBoundaryType, ewBoundaryType, & call ice_distributionGetBlockLoc(dist, nwBlock, dstProc, & dstLocalID) - else if (nwBlock < 0) then ! tripole north row, count block - msgSize = northMsgSize ! tripole NE corner update - entire row needed - - call ice_distributionGetBlockLoc(dist, abs(nwBlock), dstProc, & - dstLocalID) +! tcx,tcraig, 3/2023, this is not needed +! else if (nwBlock < 0) then ! tripole north row, count block +! msgSize = northMsgSize ! tripole NE corner update - entire row needed +! +! call ice_distributionGetBlockLoc(dist, abs(nwBlock), dstProc, & +! dstLocalID) else dstProc = 0 @@ -482,8 +493,6 @@ function ice_HaloCreate(dist, nsBoundaryType, ewBoundaryType, & northBlock = ice_blocksGetNbrID(iblock, ice_blocksNorth, & ewBoundaryType, nsBoundaryType) - call ice_HaloMsgCreate(halo, dist, iblock, northBlock, 'north') - !*** set tripole flag and add two copies for inserting !*** and extracting info from the tripole buffer @@ -493,6 +502,7 @@ function ice_HaloCreate(dist, nsBoundaryType, ewBoundaryType, & call ice_HaloMsgCreate(halo, dist, -iblock, iblock, 'north') else tripoleBlock = .false. + call ice_HaloMsgCreate(halo, dist, iblock, northBlock, 'north') endif !*** find south neighbor block @@ -513,9 +523,10 @@ function ice_HaloCreate(dist, nsBoundaryType, ewBoundaryType, & !*** the east block to make sure enough information is !*** available for tripole manipulations - if (tripoleBlock) then - call ice_HaloMsgCreate(halo, dist, iblock, -eastBlock, 'north') - endif +! tcx,tcraig, 3/2023, this is not needed +! if (tripoleBlock) then +! call ice_HaloMsgCreate(halo, dist, iblock, -eastBlock, 'north') +! endif !*** find west neighbor block @@ -528,9 +539,10 @@ function ice_HaloCreate(dist, nsBoundaryType, ewBoundaryType, & !*** the west block to make sure enough information is !*** available for tripole manipulations - if (tripoleBlock) then - call ice_HaloMsgCreate(halo, dist, iblock, -westBlock, 'north') - endif +! tcx,tcraig, 3/2023, this is not needed +! if (tripoleBlock) then +! call ice_HaloMsgCreate(halo, dist, iblock, -westBlock, 'north') +! endif !*** find northeast neighbor block @@ -644,7 +656,7 @@ end subroutine ice_HaloMask subroutine ice_HaloUpdate2DR8(array, halo, & fieldLoc, fieldKind, & - fillValue) + fillValue, tripoleOnly) ! This routine updates ghost cells for an input array and is a ! member of a group of routines under the generic interface @@ -666,6 +678,9 @@ subroutine ice_HaloUpdate2DR8(array, halo, & ! (e.g. eliminated land blocks or ! closed boundaries) + logical (log_kind), intent(in), optional :: & + tripoleOnly ! optional flag to execute halo only across tripole seam + real (dbl_kind), dimension(:,:,:), intent(inout) :: & array ! array containing field for which halo ! needs to be updated @@ -691,8 +706,28 @@ subroutine ice_HaloUpdate2DR8(array, halo, & fill, &! value to use for unknown points x1,x2,xavg ! scalars for enforcing symmetry at U pts + logical (log_kind) :: & + ltripoleOnly ! local tripoleOnly value + character(len=*), parameter :: subname = '(ice_HaloUpdate2DR8)' +!----------------------------------------------------------------------- +! +! abort or return on unknown or noupdate field_loc or field_type +! +!----------------------------------------------------------------------- + + if (fieldLoc == field_loc_unknown .or. & + fieldKind == field_type_unknown) then + call abort_ice(subname//'ERROR: use of field_loc/type_unknown not allowed') + return + endif + + if (fieldLoc == field_loc_noupdate .or. & + fieldKind == field_type_noupdate) then + return + endif + !----------------------------------------------------------------------- ! ! initialize error code and fill value @@ -705,6 +740,12 @@ subroutine ice_HaloUpdate2DR8(array, halo, & fill = 0.0_dbl_kind endif + if (present(tripoleOnly)) then + ltripoleOnly = tripoleOnly + else + ltripoleOnly = .false. + endif + nxGlobal = 0 if (allocated(bufTripoleR8)) then nxGlobal = size(bufTripoleR8,dim=1) @@ -719,19 +760,24 @@ subroutine ice_HaloUpdate2DR8(array, halo, & ! !----------------------------------------------------------------------- - do iblk = 1, halo%numLocalBlocks - call get_block_parameter(halo%blockGlobalID(iblk), & - ilo=ilo, ihi=ihi, & - jlo=jlo, jhi=jhi) - do j = 1,nghost - array(1:nx_block, jlo-j,iblk) = fill - array(1:nx_block, jhi+j,iblk) = fill - enddo - do i = 1,nghost - array(ilo-i, 1:ny_block,iblk) = fill - array(ihi+i, 1:ny_block,iblk) = fill + if (ltripoleOnly) then + ! skip fill, not needed since tripole seam always exists if running + ! on tripole grid and set tripoleOnly flag + else + do iblk = 1, halo%numLocalBlocks + call get_block_parameter(halo%blockGlobalID(iblk), & + ilo=ilo, ihi=ihi, & + jlo=jlo, jhi=jhi) + do j = 1,nghost + array(1:nx_block, jlo-j,iblk) = fill + array(1:nx_block, jhi+j,iblk) = fill + enddo + do i = 1,nghost + array(ilo-i, 1:ny_block,iblk) = fill + array(ihi+i, 1:ny_block,iblk) = fill + enddo enddo - enddo + endif !----------------------------------------------------------------------- ! @@ -751,16 +797,25 @@ subroutine ice_HaloUpdate2DR8(array, halo, & jDst = halo%dstLocalAddr(2,nmsg) dstBlock = halo%dstLocalAddr(3,nmsg) - if (srcBlock > 0) then - if (dstBlock > 0) then - array(iDst,jDst,dstBlock) = & - array(iSrc,jSrc,srcBlock) - else if (dstBlock < 0) then ! tripole copy into buffer - bufTripoleR8(iDst,jDst) = & - array(iSrc,jSrc,srcBlock) + if (ltripoleOnly) then + if (srcBlock > 0) then + if (dstBlock < 0) then ! tripole copy into buffer + bufTripoleR8(iDst,jDst) = & + array(iSrc,jSrc,srcBlock) + endif + endif + else + if (srcBlock > 0) then + if (dstBlock > 0) then + array(iDst,jDst,dstBlock) = & + array(iSrc,jSrc,srcBlock) + else if (dstBlock < 0) then ! tripole copy into buffer + bufTripoleR8(iDst,jDst) = & + array(iSrc,jSrc,srcBlock) + endif + else if (srcBlock == 0) then + array(iDst,jDst,dstBlock) = fill endif - else if (srcBlock == 0) then - array(iDst,jDst,dstBlock) = fill endif end do @@ -910,7 +965,7 @@ subroutine ice_HaloUpdate2DR8(array, halo, & !*** correct for offsets iSrc = iSrc - ioffset jSrc = jSrc - joffset - if (iSrc == 0) iSrc = nxGlobal + if (iSrc < 1 ) iSrc = iSrc + nxGlobal if (iSrc > nxGlobal) iSrc = iSrc - nxGlobal !*** for center and Eface on u-fold, and NE corner and Nface @@ -985,6 +1040,23 @@ subroutine ice_HaloUpdate2DR4(array, halo, & character(len=*), parameter :: subname = '(ice_HaloUpdate2DR4)' +!----------------------------------------------------------------------- +! +! abort or return on unknown or noupdate field_loc or field_type +! +!----------------------------------------------------------------------- + + if (fieldLoc == field_loc_unknown .or. & + fieldKind == field_type_unknown) then + call abort_ice(subname//'ERROR: use of field_loc/type_unknown not allowed') + return + endif + + if (fieldLoc == field_loc_noupdate .or. & + fieldKind == field_type_noupdate) then + return + endif + !----------------------------------------------------------------------- ! ! initialize error code and fill value @@ -1202,7 +1274,7 @@ subroutine ice_HaloUpdate2DR4(array, halo, & !*** correct for offsets iSrc = iSrc - ioffset jSrc = jSrc - joffset - if (iSrc == 0) iSrc = nxGlobal + if (iSrc < 1 ) iSrc = iSrc + nxGlobal if (iSrc > nxGlobal) iSrc = iSrc - nxGlobal !*** for center and Eface on u-fold, and NE corner and Nface @@ -1277,6 +1349,23 @@ subroutine ice_HaloUpdate2DI4(array, halo, & character(len=*), parameter :: subname = '(ice_HaloUpdate2DI4)' +!----------------------------------------------------------------------- +! +! abort or return on unknown or noupdate field_loc or field_type +! +!----------------------------------------------------------------------- + + if (fieldLoc == field_loc_unknown .or. & + fieldKind == field_type_unknown) then + call abort_ice(subname//'ERROR: use of field_loc/type_unknown not allowed') + return + endif + + if (fieldLoc == field_loc_noupdate .or. & + fieldKind == field_type_noupdate) then + return + endif + !----------------------------------------------------------------------- ! ! initialize error code and fill value @@ -1494,7 +1583,7 @@ subroutine ice_HaloUpdate2DI4(array, halo, & !*** correct for offsets iSrc = iSrc - ioffset jSrc = jSrc - joffset - if (iSrc == 0) iSrc = nxGlobal + if (iSrc < 1 ) iSrc = iSrc + nxGlobal if (iSrc > nxGlobal) iSrc = iSrc - nxGlobal !*** for center and Eface on u-fold, and NE corner and Nface @@ -1557,6 +1646,23 @@ subroutine ice_HaloUpdate2DL1(array, halo, & character(len=*), parameter :: subname = '(ice_HaloUpdate2DL1)' +!----------------------------------------------------------------------- +! +! abort or return on unknown or noupdate field_loc or field_type +! +!----------------------------------------------------------------------- + + if (fieldLoc == field_loc_unknown .or. & + fieldKind == field_type_unknown) then + call abort_ice(subname//'ERROR: use of field_loc/type_unknown not allowed') + return + endif + + if (fieldLoc == field_loc_noupdate .or. & + fieldKind == field_type_noupdate) then + return + endif + !----------------------------------------------------------------------- ! ! copy logical into integer array and call haloupdate on integer array @@ -1636,6 +1742,23 @@ subroutine ice_HaloUpdate3DR8(array, halo, & character(len=*), parameter :: subname = '(ice_HaloUpdate3DR8)' +!----------------------------------------------------------------------- +! +! abort or return on unknown or noupdate field_loc or field_type +! +!----------------------------------------------------------------------- + + if (fieldLoc == field_loc_unknown .or. & + fieldKind == field_type_unknown) then + call abort_ice(subname//'ERROR: use of field_loc/type_unknown not allowed') + return + endif + + if (fieldLoc == field_loc_noupdate .or. & + fieldKind == field_type_noupdate) then + return + endif + !----------------------------------------------------------------------- ! ! initialize error code and fill value @@ -1870,7 +1993,7 @@ subroutine ice_HaloUpdate3DR8(array, halo, & !*** correct for offsets iSrc = iSrc - ioffset jSrc = jSrc - joffset - if (iSrc == 0) iSrc = nxGlobal + if (iSrc < 1 ) iSrc = iSrc + nxGlobal if (iSrc > nxGlobal) iSrc = iSrc - nxGlobal !*** for center and Eface on u-fold, and NE corner and Nface @@ -1954,6 +2077,23 @@ subroutine ice_HaloUpdate3DR4(array, halo, & character(len=*), parameter :: subname = '(ice_HaloUpdate3DR4)' +!----------------------------------------------------------------------- +! +! abort or return on unknown or noupdate field_loc or field_type +! +!----------------------------------------------------------------------- + + if (fieldLoc == field_loc_unknown .or. & + fieldKind == field_type_unknown) then + call abort_ice(subname//'ERROR: use of field_loc/type_unknown not allowed') + return + endif + + if (fieldLoc == field_loc_noupdate .or. & + fieldKind == field_type_noupdate) then + return + endif + !----------------------------------------------------------------------- ! ! initialize error code and fill value @@ -2188,7 +2328,7 @@ subroutine ice_HaloUpdate3DR4(array, halo, & !*** correct for offsets iSrc = iSrc - ioffset jSrc = jSrc - joffset - if (iSrc == 0) iSrc = nxGlobal + if (iSrc < 1 ) iSrc = iSrc + nxGlobal if (iSrc > nxGlobal) iSrc = iSrc - nxGlobal !*** for center and Eface on u-fold, and NE corner and Nface @@ -2272,6 +2412,23 @@ subroutine ice_HaloUpdate3DI4(array, halo, & character(len=*), parameter :: subname = '(ice_HaloUpdate3DI4)' +!----------------------------------------------------------------------- +! +! abort or return on unknown or noupdate field_loc or field_type +! +!----------------------------------------------------------------------- + + if (fieldLoc == field_loc_unknown .or. & + fieldKind == field_type_unknown) then + call abort_ice(subname//'ERROR: use of field_loc/type_unknown not allowed') + return + endif + + if (fieldLoc == field_loc_noupdate .or. & + fieldKind == field_type_noupdate) then + return + endif + !----------------------------------------------------------------------- ! ! initialize error code and fill value @@ -2506,7 +2663,7 @@ subroutine ice_HaloUpdate3DI4(array, halo, & !*** correct for offsets iSrc = iSrc - ioffset jSrc = jSrc - joffset - if (iSrc == 0) iSrc = nxGlobal + if (iSrc < 1 ) iSrc = iSrc + nxGlobal if (iSrc > nxGlobal) iSrc = iSrc - nxGlobal !*** for center and Eface on u-fold, and NE corner and Nface @@ -2590,6 +2747,23 @@ subroutine ice_HaloUpdate4DR8(array, halo, & character(len=*), parameter :: subname = '(ice_HaloUpdate4DR8)' +!----------------------------------------------------------------------- +! +! abort or return on unknown or noupdate field_loc or field_type +! +!----------------------------------------------------------------------- + + if (fieldLoc == field_loc_unknown .or. & + fieldKind == field_type_unknown) then + call abort_ice(subname//'ERROR: use of field_loc/type_unknown not allowed') + return + endif + + if (fieldLoc == field_loc_noupdate .or. & + fieldKind == field_type_noupdate) then + return + endif + !----------------------------------------------------------------------- ! ! initialize error code and fill value @@ -2839,7 +3013,7 @@ subroutine ice_HaloUpdate4DR8(array, halo, & !*** correct for offsets iSrc = iSrc - ioffset jSrc = jSrc - joffset - if (iSrc == 0) iSrc = nxGlobal + if (iSrc < 1 ) iSrc = iSrc + nxGlobal if (iSrc > nxGlobal) iSrc = iSrc - nxGlobal !*** for center and Eface on u-fold, and NE corner and Nface @@ -2925,6 +3099,23 @@ subroutine ice_HaloUpdate4DR4(array, halo, & character(len=*), parameter :: subname = '(ice_HaloUpdate4DR4)' +!----------------------------------------------------------------------- +! +! abort or return on unknown or noupdate field_loc or field_type +! +!----------------------------------------------------------------------- + + if (fieldLoc == field_loc_unknown .or. & + fieldKind == field_type_unknown) then + call abort_ice(subname//'ERROR: use of field_loc/type_unknown not allowed') + return + endif + + if (fieldLoc == field_loc_noupdate .or. & + fieldKind == field_type_noupdate) then + return + endif + !----------------------------------------------------------------------- ! ! initialize error code and fill value @@ -3174,7 +3365,7 @@ subroutine ice_HaloUpdate4DR4(array, halo, & !*** correct for offsets iSrc = iSrc - ioffset jSrc = jSrc - joffset - if (iSrc == 0) iSrc = nxGlobal + if (iSrc < 1 ) iSrc = iSrc + nxGlobal if (iSrc > nxGlobal) iSrc = iSrc - nxGlobal !*** for center and Eface on u-fold, and NE corner and Nface @@ -3260,6 +3451,23 @@ subroutine ice_HaloUpdate4DI4(array, halo, & character(len=*), parameter :: subname = '(ice_HaloUpdate4DI4)' +!----------------------------------------------------------------------- +! +! abort or return on unknown or noupdate field_loc or field_type +! +!----------------------------------------------------------------------- + + if (fieldLoc == field_loc_unknown .or. & + fieldKind == field_type_unknown) then + call abort_ice(subname//'ERROR: use of field_loc/type_unknown not allowed') + return + endif + + if (fieldLoc == field_loc_noupdate .or. & + fieldKind == field_type_noupdate) then + return + endif + !----------------------------------------------------------------------- ! ! initialize error code and fill value @@ -3509,7 +3717,7 @@ subroutine ice_HaloUpdate4DI4(array, halo, & !*** correct for offsets iSrc = iSrc - ioffset jSrc = jSrc - joffset - if (iSrc == 0) iSrc = nxGlobal + if (iSrc < 1 ) iSrc = iSrc + nxGlobal if (iSrc > nxGlobal) iSrc = iSrc - nxGlobal !*** for center and Eface on u-fold, and NE corner and Nface @@ -3541,6 +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 subroutine ice_HaloUpdate_stress(array1, array2, halo, & fieldLoc, fieldKind, & @@ -3584,6 +3793,23 @@ subroutine ice_HaloUpdate_stress(array1, array2, halo, & character(len=*), parameter :: subname = '(ice_HaloUpdate_stress)' +!----------------------------------------------------------------------- +! +! abort or return on unknown or noupdate field_loc or field_type +! +!----------------------------------------------------------------------- + + if (fieldLoc == field_loc_unknown .or. & + fieldKind == field_type_unknown) then + call abort_ice(subname//'ERROR: use of field_loc/type_unknown not allowed') + return + endif + + if (fieldLoc == field_loc_noupdate .or. & + fieldKind == field_type_noupdate) then + return + endif + !----------------------------------------------------------------------- ! ! initialize error code and fill value @@ -3671,30 +3897,61 @@ subroutine ice_HaloUpdate_stress(array1, array2, halo, & call abort_ice(subname//'ERROR: Unknown field kind') end select - select case (fieldLoc) - case (field_loc_center) ! cell center location + if (halo%tripoleTFlag) then - ioffset = 0 - joffset = 0 + select case (fieldLoc) + case (field_loc_center) ! cell center location - case (field_loc_NEcorner) ! cell corner location + ioffset = -1 + joffset = 0 - ioffset = 1 - joffset = 1 + case (field_loc_NEcorner) ! cell corner location - case (field_loc_Eface) + ioffset = 0 + joffset = 1 - ioffset = 1 - joffset = 0 + case (field_loc_Eface) ! cell center location - case (field_loc_Nface) + ioffset = 0 + joffset = 0 - ioffset = 0 - joffset = 1 + case (field_loc_Nface) ! cell corner (velocity) location - case default - call abort_ice(subname//'ERROR: Unknown field location') - end select + ioffset = -1 + joffset = 1 + + case default + call abort_ice(subname//'ERROR: Unknown field location') + end select + + else ! tripole u-fold + + select case (fieldLoc) + case (field_loc_center) ! cell center location + + ioffset = 0 + joffset = 0 + + case (field_loc_NEcorner) ! cell corner location + + ioffset = 1 + joffset = 1 + + case (field_loc_Eface) + + ioffset = 1 + joffset = 0 + + case (field_loc_Nface) + + ioffset = 0 + joffset = 1 + + case default + call abort_ice(subname//'ERROR: Unknown field location') + end select + + endif !*** copy out of global tripole buffer into local !*** ghost cells @@ -3717,14 +3974,15 @@ subroutine ice_HaloUpdate_stress(array1, array2, halo, & !*** correct for offsets iSrc = iSrc - ioffset jSrc = jSrc - joffset - if (iSrc == 0) iSrc = nxGlobal + if (iSrc < 1 ) iSrc = iSrc + nxGlobal + if (iSrc > nxGlobal) iSrc = iSrc - nxGlobal !*** for center and Eface, do not need to replace !*** top row of physical domain, so jSrc should be !*** out of range and skipped !*** otherwise do the copy - if (jSrc <= nghost+1) then + if (jSrc <= halo%tripoleRows .and. jSrc>0 .and. jDst>0) then array1(iDst,jDst,dstBlock) = isign*bufTripoleR8(iSrc,jSrc) endif @@ -4133,36 +4391,37 @@ subroutine ice_HaloMsgCreate(halo, dist, srcBlock, dstBlock, direction) halo%numLocalCopies = msgIndx - else - - !*** tripole grid - copy entire top halo+1 - !*** rows into global buffer at src location - - msgIndx = halo%numLocalCopies - - do j=1,nghost+1 - do i=1,ieSrc-ibSrc+1 - - msgIndx = msgIndx + 1 - - halo%srcLocalAddr(1,msgIndx) = ibSrc + i - 1 - halo%srcLocalAddr(2,msgIndx) = jeSrc-1-nghost+j - halo%srcLocalAddr(3,msgIndx) = srcLocalID - - halo%dstLocalAddr(1,msgIndx) = iGlobal(ibSrc + i - 1) - halo%dstLocalAddr(2,msgIndx) = j - halo%dstLocalAddr(3,msgIndx) = -dstLocalID - - end do - end do - - halo%numLocalCopies = msgIndx +! tcx,tcraig, 3/2023, this is not needed +! else +! +! !*** tripole grid - copy entire top halo+1 +! !*** rows into global buffer at src location +! +! msgIndx = halo%numLocalCopies +! +! do j=1,nghost+1 +! do i=1,ieSrc-ibSrc+1 +! +! msgIndx = msgIndx + 1 +! +! halo%srcLocalAddr(1,msgIndx) = ibSrc + i - 1 +! halo%srcLocalAddr(2,msgIndx) = jeSrc-1-nghost+j +! halo%srcLocalAddr(3,msgIndx) = srcLocalID +! +! halo%dstLocalAddr(1,msgIndx) = iGlobal(ibSrc + i - 1) +! halo%dstLocalAddr(2,msgIndx) = j +! halo%dstLocalAddr(3,msgIndx) = -dstLocalID +! +! end do +! end do +! +! halo%numLocalCopies = msgIndx endif case ('northwest') - !*** normal northeast boundary - just copy NW corner + !*** normal northwest boundary - just copy NW corner !*** of physical domain into SE halo of NW nbr block if (dstBlock > 0) then @@ -4187,30 +4446,31 @@ subroutine ice_HaloMsgCreate(halo, dist, srcBlock, dstBlock, direction) halo%numLocalCopies = msgIndx - else - - !*** tripole grid - copy entire top halo+1 - !*** rows into global buffer at src location - - msgIndx = halo%numLocalCopies - - do j=1,nghost+1 - do i=1,ieSrc-ibSrc+1 - - msgIndx = msgIndx + 1 - - halo%srcLocalAddr(1,msgIndx) = ibSrc + i - 1 - halo%srcLocalAddr(2,msgIndx) = jeSrc-1-nghost+j - halo%srcLocalAddr(3,msgIndx) = srcLocalID - - halo%dstLocalAddr(1,msgIndx) = iGlobal(ibSrc + i - 1) - halo%dstLocalAddr(2,msgIndx) = j - halo%dstLocalAddr(3,msgIndx) = -dstLocalID - - end do - end do - - halo%numLocalCopies = msgIndx +! tcx,tcraig, 3/2023, this is not needed +! else +! +! !*** tripole grid - copy entire top halo+1 +! !*** rows into global buffer at src location +! +! msgIndx = halo%numLocalCopies +! +! do j=1,nghost+1 +! do i=1,ieSrc-ibSrc+1 +! +! msgIndx = msgIndx + 1 +! +! halo%srcLocalAddr(1,msgIndx) = ibSrc + i - 1 +! halo%srcLocalAddr(2,msgIndx) = jeSrc-1-nghost+j +! halo%srcLocalAddr(3,msgIndx) = srcLocalID +! +! halo%dstLocalAddr(1,msgIndx) = iGlobal(ibSrc + i - 1) +! halo%dstLocalAddr(2,msgIndx) = j +! halo%dstLocalAddr(3,msgIndx) = -dstLocalID +! +! end do +! end do +! +! halo%numLocalCopies = msgIndx endif @@ -4418,7 +4678,7 @@ subroutine ice_HaloMsgCreate(halo, dist, srcBlock, dstBlock, direction) case ('northwest') - !*** normal northeast boundary - just copy NW corner + !*** normal northwest boundary - just copy NW corner !*** of physical domain into SE halo of NW nbr block if (dstBlock > 0) then diff --git a/cicecore/cicedyn/infrastructure/ice_domain.F90 b/cicecore/cicedyn/infrastructure/ice_domain.F90 index ff1fac723..06d0d8ae1 100644 --- a/cicecore/cicedyn/infrastructure/ice_domain.F90 +++ b/cicecore/cicedyn/infrastructure/ice_domain.F90 @@ -172,7 +172,7 @@ subroutine init_domain_blocks if (my_task == master_task) then nml_name = 'domain_nml' write(nu_diag,*) subname,' Reading ', trim(nml_name) - + call get_fileunit(nu_nml) open (nu_nml, file=trim(nml_filename), status='old',iostat=nml_error) if (nml_error /= 0) then @@ -186,7 +186,7 @@ subroutine init_domain_blocks call abort_ice(subname//'ERROR: searching for '// trim(nml_name), & file=__FILE__, line=__LINE__) endif - + nml_error = 1 do while (nml_error > 0) read(nu_nml, nml=domain_nml,iostat=nml_error) diff --git a/cicecore/cicedyn/infrastructure/io/io_netcdf/ice_history_write.F90 b/cicecore/cicedyn/infrastructure/io/io_netcdf/ice_history_write.F90 index 019ab8ce9..51d76a6f4 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 @@ -48,7 +48,7 @@ subroutine ice_write_hist (ns) use ice_blocks, only: nx_block, ny_block use ice_broadcast, only: broadcast_scalar use ice_calendar, only: msec, timesecs, idate, idate0, write_ic, & - histfreq, days_per_year, use_leap_years, dayyr, & + histfreq, histfreq_n, days_per_year, use_leap_years, dayyr, & hh_init, mm_init, ss_init use ice_communicate, only: my_task, master_task use ice_domain, only: distrb_info @@ -86,6 +86,7 @@ subroutine ice_write_hist (ns) integer (kind=int_kind), dimension(6) :: dimidex real (kind=dbl_kind) :: ltime2 character (char_len) :: title + character (char_len) :: time_period_freq = 'none' character (char_len_long) :: ncfile(max_nstrm) real (kind=dbl_kind) :: secday, rad_to_deg @@ -136,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 @@ -158,10 +157,10 @@ subroutine ice_write_hist (ns) ! define dimensions !----------------------------------------------------------------- - if (hist_avg) 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) @@ -212,7 +211,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') @@ -229,7 +228,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 @@ -240,7 +239,7 @@ subroutine ice_write_hist (ns) call abort_ice(subname//'ERROR: invalid calendar settings') endif - if (hist_avg) 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') @@ -250,14 +249,14 @@ subroutine ice_write_hist (ns) ! Define attributes for time bounds if hist_avg is true !----------------------------------------------------------------- - if (hist_avg) 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 @@ -267,6 +266,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 !----------------------------------------------------------------- @@ -682,6 +697,31 @@ subroutine ice_write_hist (ns) if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: global attribute date2') + select case (histfreq(ns)) + case ("y", "Y") + write(time_period_freq,'(a,i0)') 'year_',histfreq_n(ns) + case ("m", "M") + write(time_period_freq,'(a,i0)') 'month_',histfreq_n(ns) + case ("d", "D") + write(time_period_freq,'(a,i0)') 'day_',histfreq_n(ns) + case ("h", "H") + write(time_period_freq,'(a,i0)') 'hour_',histfreq_n(ns) + case ("1") + write(time_period_freq,'(a,i0)') 'step_',histfreq_n(ns) + end select + + if (.not.write_ic .and. trim(time_period_freq) /= 'none') then + status = nf90_put_att(ncid,nf90_global,'time_period_freq',trim(time_period_freq)) + if (status /= nf90_noerr) call abort_ice(subname// & + 'ERROR: global attribute time_period_freq') + endif + + if (hist_avg(ns)) then + status = nf90_put_att(ncid,nf90_global,'time_axis_position',trim(hist_time_axis)) + if (status /= nf90_noerr) call abort_ice(subname// & + 'ERROR: global attribute time axis position') + endif + title = 'CF-1.0' status = & nf90_put_att(ncid,nf90_global,'conventions',title) @@ -714,6 +754,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 = nf90_inq_varid(ncid,'time',varid) if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: getting time varid') @@ -725,7 +774,7 @@ subroutine ice_write_hist (ns) ! write time_bounds info !----------------------------------------------------------------- - if (hist_avg) 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') @@ -1216,7 +1265,7 @@ end subroutine ice_write_hist subroutine ice_write_hist_attrs(ncid, varid, hfield, ns) use ice_kinds_mod - use ice_calendar, only: histfreq, histfreq_n + use ice_calendar, only: histfreq, histfreq_n, write_ic use ice_history_shared, only: ice_hist_field, history_precision, & hist_avg #ifdef USE_NETCDF @@ -1259,7 +1308,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) 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' & @@ -1272,7 +1321,8 @@ 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' & .or.TRIM(hfield%vname(1:4))=='sig1' & 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 6407d8c76..cf2f40521 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 @@ -76,6 +76,7 @@ subroutine ice_write_hist (ns) integer (kind=int_kind), dimension(6) :: dimidex real (kind= dbl_kind) :: ltime2 character (char_len) :: title + character (char_len) :: time_period_freq = 'none' character (char_len_long) :: ncfile(max_nstrm) integer (kind=int_kind) :: iotype @@ -184,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 @@ -194,8 +193,8 @@ subroutine ice_write_hist (ns) ! define dimensions !----------------------------------------------------------------- - if (hist_avg) 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) @@ -214,7 +213,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 ', & @@ -225,24 +224,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) 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) 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),' ', & @@ -649,6 +659,26 @@ subroutine ice_write_hist (ns) write(title,'(a,i6)') 'seconds elapsed into model date: ',msec status = pio_put_att(File,pio_global,'comment3',trim(title)) + select case (histfreq(ns)) + case ("y", "Y") + write(time_period_freq,'(a,i0)') 'year_',histfreq_n(ns) + case ("m", "M") + write(time_period_freq,'(a,i0)') 'month_',histfreq_n(ns) + case ("d", "D") + write(time_period_freq,'(a,i0)') 'day_',histfreq_n(ns) + case ("h", "H") + write(time_period_freq,'(a,i0)') 'hour_',histfreq_n(ns) + case ("1") + write(time_period_freq,'(a,i0)') 'step_',histfreq_n(ns) + end select + + if (.not.write_ic .and. trim(time_period_freq) /= 'none') then + status = 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)) @@ -677,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) @@ -684,7 +723,7 @@ subroutine ice_write_hist (ns) ! write time_bounds info !----------------------------------------------------------------- - if (hist_avg) 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/) @@ -1201,7 +1240,7 @@ end subroutine ice_write_hist subroutine ice_write_hist_attrs(File, varid, hfield, ns) use ice_kinds_mod - use ice_calendar, only: histfreq, histfreq_n + use ice_calendar, only: histfreq, histfreq_n, write_ic use ice_history_shared, only: ice_hist_field, history_precision, & hist_avg use ice_pio @@ -1232,7 +1271,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) 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' & @@ -1243,7 +1282,8 @@ 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' & .or.TRIM(hfield%vname(1:4))=='sig1' & diff --git a/cicecore/drivers/nuopc/cmeps/ice_mesh_mod.F90 b/cicecore/drivers/nuopc/cmeps/ice_mesh_mod.F90 index 688b6066d..5cf23ea5c 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 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 index 5ace27736..79dd06fca 100644 --- a/cicecore/drivers/unittest/opticep/CICE.F90 +++ b/cicecore/drivers/unittest/opticep/CICE.F90 @@ -1,8 +1,8 @@ !======================================================================= -! Copyright (c) 2023, Triad National Security, LLC +! Copyright (c) 2022, Triad National Security, LLC ! All rights reserved. ! -! Copyright 2023. Triad National Security, LLC. This software was +! 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. diff --git a/cicecore/drivers/unittest/opticep/CICE_InitMod.F90 b/cicecore/drivers/unittest/opticep/CICE_InitMod.F90 index 194293118..0371c7f38 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, icepack_init_radiation + 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, & @@ -66,7 +66,7 @@ subroutine cice_init floe_binwidth, c_fsd_range use ice_state, only: alloc_state use ice_flux_bgc, only: alloc_flux_bgc - use ice_calendar, only: dt, 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 @@ -81,8 +81,8 @@ 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, alloc_forcing_bgc, fiso_default - use ice_grid, only: init_grid1, init_grid2, alloc_grid, dealloc_grid + 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 @@ -183,7 +183,6 @@ 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) @@ -191,6 +190,9 @@ 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. @@ -243,8 +245,6 @@ 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 @@ -277,8 +277,7 @@ subroutine init_restart restart_iso, read_restart_iso, & restart_aero, read_restart_aero, & restart_hbrine, read_restart_hbrine, & - restart_bgc - use ice_flux, only: Tf + restart_zsal, restart_bgc use ice_restart_driver, only: restartfile use ice_restart_shared, only: runtype, restart use ice_state ! almost everything @@ -289,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 + skl_bgc, z_tracers, solve_zsal integer(kind=int_kind) :: & ntrcr integer(kind=int_kind) :: & @@ -305,7 +304,7 @@ subroutine init_restart file=__FILE__, line=__LINE__) call icepack_query_parameters(skl_bgc_out=skl_bgc, & - z_tracers_out=z_tracers) + 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, & @@ -451,6 +450,8 @@ 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 @@ -460,7 +461,7 @@ subroutine init_restart if (tr_brine .and. restart_hbrine) call read_restart_hbrine endif - if (skl_bgc .or. z_tracers) then ! biogeochemistry + 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) @@ -493,8 +494,7 @@ subroutine init_restart trcr_depend = trcr_depend, & trcr_base = trcr_base, & n_trcr_strata = n_trcr_strata, & - nt_strata = nt_strata, & - Tf = Tf(i,j,iblk)) + nt_strata = nt_strata) else ! tcraig, reset all tracer values on land to zero trcrn(i,j,:,:,iblk) = c0 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/ice_init_column.F90 b/cicecore/drivers/unittest/opticep/ice_init_column.F90 index a55338556..82f3f4a1e 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 + 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 @@ -184,6 +184,7 @@ 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, & @@ -319,7 +320,7 @@ subroutine init_shortwave do j = jlo, jhi do i = ilo, ihi - if (shortwave(1:4) == 'dEdd') then ! delta Eddington + if (trim(shortwave) == 'dEdd') then ! delta Eddington #ifndef CESMCOUPLED ! initialize orbital parameters @@ -344,7 +345,9 @@ subroutine init_shortwave enddo if (tmask(i,j,iblk)) then - call icepack_step_radiation (dt=dt, & + 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), & @@ -364,6 +367,11 @@ 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),& @@ -381,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), & - rsnow=rsnow(:,:), & +!opt rsnow=rsnow(:,:), & l_print_point=l_print_point, & initonly = .true.) endif @@ -726,14 +734,16 @@ 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 + 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: read_restart_bgc, restart_bgc + use ice_restart_column, only: restart_zsal, & + read_restart_bgc, restart_bgc use ice_state, only: trcrn ! local variables @@ -747,6 +757,10 @@ 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 @@ -756,15 +770,20 @@ 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 + 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) + 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) @@ -785,6 +804,53 @@ 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 @@ -900,7 +966,7 @@ subroutine init_bgc() ! read restart to complete BGC initialization !----------------------------------------------------------------- - if (restart_bgc) call read_restart_bgc + if (restart_zsal .or. restart_bgc) call read_restart_bgc deallocate(trcrn_bgc) @@ -957,9 +1023,10 @@ end subroutine init_hbrine subroutine input_zbgc - use ice_arrays_column, only: restore_bgc + 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_hbrine + use ice_restart_column, only: restart_bgc, restart_zsal, & + restart_hbrine use ice_restart_shared, only: restart character (len=char_len) :: & @@ -978,7 +1045,7 @@ subroutine input_zbgc logical (kind=log_kind) :: & solve_zsal, skl_bgc, z_tracers, scale_bgc, solve_zbgc, dEdd_algae, & - modal_aero, restart_zsal + modal_aero character (char_len) :: & bgc_flux_type @@ -999,7 +1066,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, & + 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 , & @@ -1056,6 +1123,8 @@ 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 @@ -1273,6 +1342,8 @@ 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) @@ -1403,6 +1474,7 @@ 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 @@ -1412,6 +1484,22 @@ 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' @@ -1452,9 +1540,9 @@ subroutine input_zbgc abort_flag = 107 endif - if (dEdd_algae .AND. shortwave(1:4) /= 'dEdd') then + 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 or dEdd_snicar_ad' + write(nu_diag,*) subname,' ERROR: dEdd_algae = T but shortwave /= dEdd' endif abort_flag = 108 endif @@ -1473,9 +1561,9 @@ subroutine input_zbgc abort_flag = 110 endif - if (modal_aero .AND. shortwave(1:4) /= 'dEdd') then + 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 or dEdd_snicar_ad' + write(nu_diag,*) subname,' ERROR: modal_aero = T but shortwave /= dEdd' endif abort_flag = 111 endif @@ -1592,9 +1680,12 @@ 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 (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) ' 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 @@ -1631,6 +1722,8 @@ 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 @@ -1660,7 +1753,7 @@ subroutine input_zbgc !----------------------------------------------------------------- call icepack_init_parameters( & - ktherm_in=ktherm, shortwave_in=shortwave, & + 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, & @@ -1723,7 +1816,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_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, & @@ -1782,13 +1875,14 @@ subroutine count_tracers tr_bgc_hum logical (kind=log_kind) :: & - skl_bgc, z_tracers + 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) @@ -1966,6 +2060,12 @@ 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 @@ -2175,7 +2275,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,*) ' ' @@ -2199,7 +2299,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_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, & @@ -2242,7 +2342,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_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, & @@ -2323,7 +2423,7 @@ subroutine init_zbgc tau_rel ! release timescale (s), stationary to mobile phase logical (kind=log_kind) :: & - skl_bgc, z_tracers, dEdd_algae + skl_bgc, z_tracers, dEdd_algae, solve_zsal real (kind=dbl_kind), dimension(icepack_max_algae) :: & F_abs_chl ! to scale absorption in Dedd @@ -2393,10 +2493,12 @@ 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, & @@ -2422,7 +2524,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_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, & @@ -2583,7 +2685,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, & @@ -2607,6 +2709,18 @@ 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 @@ -2874,8 +2988,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 64320e601..ac66255a4 100644 --- a/cicecore/drivers/unittest/opticep/ice_step_mod.F90 +++ b/cicecore/drivers/unittest/opticep/ice_step_mod.F90 @@ -182,7 +182,8 @@ 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 (scale_factor=scale_factor(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), & @@ -274,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, snwgrain + tr_pond_lvl, tr_pond_topo, calc_Tsfc, highfreq, tr_snow real (kind=dbl_kind) :: & puny ! a very small number @@ -295,12 +296,13 @@ 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(snwgrain_out=snwgrain) + 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_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, & @@ -355,7 +357,7 @@ subroutine step_therm1 (dt, iblk) do j = jlo, jhi do i = ilo, ihi - if (snwgrain) then + if (tr_snow) then do n = 1, ncat do k = 1, nslyr rsnwn (k,n) = trcrn(i,j,nt_rsnw +k-1,n,iblk) @@ -363,7 +365,7 @@ subroutine step_therm1 (dt, iblk) smliqn(k,n) = trcrn(i,j,nt_smliq+k-1,n,iblk) enddo enddo - endif ! snwgrain + endif ! tr_snow if (tr_iso) then ! trcrn(nt_iso*) has units kg/m^3 do n=1,ncat @@ -537,8 +539,9 @@ 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 @@ -555,7 +558,7 @@ subroutine step_therm1 (dt, iblk) endif - if (snwgrain) then + if (tr_snow) then do n = 1, ncat do k = 1, nslyr trcrn(i,j,nt_rsnw +k-1,n,iblk) = rsnwn (k,n) @@ -563,7 +566,7 @@ subroutine step_therm1 (dt, iblk) trcrn(i,j,nt_smliq+k-1,n,iblk) = smliqn(k,n) enddo enddo - endif ! snwgrain + endif ! tr_snow if (tr_iso) then do n = 1, ncat @@ -611,14 +614,14 @@ end subroutine step_therm1 subroutine step_therm2 (dt, iblk) - use ice_arrays_column, only: hin_max, ocean_bio, wave_sig_ht, & + 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, & - fsalt, Tf, sss, salinz, fhocn, rside, fside, wlat, & + 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 @@ -644,14 +647,15 @@ subroutine step_therm2 (dt, iblk) logical (kind=log_kind) :: & tr_fsd, & ! floe size distribution tracers - z_tracers ! vertical biogeochemistry + 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) + 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) @@ -659,7 +663,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) then + if (z_tracers .or. solve_zsal) then nltrcr = 1 else nltrcr = 0 @@ -709,11 +713,13 @@ 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, & 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) & @@ -733,7 +739,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 @@ -752,14 +758,13 @@ end subroutine step_therm2 ! ! authors: Elizabeth Hunke, LANL - subroutine update_state (dt, daidt, dvidt, dvsdt, dagedt, offset) + 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_flux, only: Tf use ice_timers, only: ice_timer_start, ice_timer_stop, timer_bound, timer_updstate real (kind=dbl_kind), intent(in) :: & @@ -768,7 +773,6 @@ subroutine update_state (dt, daidt, dvidt, dvsdt, dagedt, offset) real (kind=dbl_kind), dimension(:,:,:), intent(inout), optional :: & daidt, & ! change in ice area per time step dvidt, & ! change in ice volume per time step - dvsdt, & ! change in snow volume per time step dagedt ! change in ice age per time step real (kind=dbl_kind), intent(in), optional :: & @@ -827,29 +831,27 @@ subroutine update_state (dt, daidt, dvidt, dvsdt, dagedt, offset) trcr_depend = trcr_depend(:), & trcr_base = trcr_base(:,:), & n_trcr_strata = n_trcr_strata(:), & - nt_strata = nt_strata(:,:), & - Tf = Tf(i,j,iblk)) - - if (present(offset)) then - - !----------------------------------------------------------------- - ! Compute thermodynamic area and volume tendencies. - !----------------------------------------------------------------- - - if (present(daidt)) daidt(i,j,iblk) = (aice(i,j,iblk) - daidt(i,j,iblk)) / dt - if (present(dvidt)) dvidt(i,j,iblk) = (vice(i,j,iblk) - dvidt(i,j,iblk)) / dt - if (present(dvsdt)) dvsdt(i,j,iblk) = (vsno(i,j,iblk) - dvsdt(i,j,iblk)) / dt - if (tr_iage .and. present(dagedt)) then - if (offset > c0) then ! thermo - if (trcr(i,j,nt_iage,iblk) > c0) & - dagedt(i,j,iblk) = (trcr(i,j,nt_iage,iblk) & - - dagedt(i,j,iblk) - offset) / dt - else ! dynamics - dagedt(i,j,iblk) = (trcr(i,j,nt_iage,iblk) & - - dagedt(i,j,iblk)) / dt - endif - endif ! tr_iage - endif ! present(offset) + 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 @@ -1040,13 +1042,13 @@ end subroutine step_dyn_horiz subroutine step_dyn_ridge (dt, ndtd, iblk) - use ice_arrays_column, only: hin_max, first_ice + 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, Tf + 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, & @@ -1137,8 +1139,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), & - Tf = Tf(i,j,iblk)) + fzsal = fzsal (i,j, iblk), & + flux_bio = flux_bio (i,j,1:nbtrcr,iblk)) endif ! tmask @@ -1277,7 +1279,8 @@ 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, & - swgrid, igrid + 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 @@ -1384,7 +1387,9 @@ subroutine step_radiation (dt, iblk) if (tmask(i,j,iblk)) then - call icepack_step_radiation (dt=dt, & + 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), & @@ -1404,6 +1409,11 @@ 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), & @@ -1421,7 +1431,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 @@ -1609,12 +1619,12 @@ end subroutine ocean_mixed_layer subroutine biogeochemistry (dt, iblk) use ice_arrays_column, only: upNO, upNH, iDi, iki, zfswin, & - darcy_V, grow_net, & + 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, & - ocean_bio_all, sice_rho, & + 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 @@ -1711,6 +1721,7 @@ 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), & @@ -1729,6 +1740,8 @@ 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), & @@ -1748,6 +1761,7 @@ 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/shared/ice_fileunits.F90 b/cicecore/shared/ice_fileunits.F90 index 72a40f513..d4823d175 100644 --- a/cicecore/shared/ice_fileunits.F90 +++ b/cicecore/shared/ice_fileunits.F90 @@ -328,32 +328,32 @@ end subroutine flush_fileunit subroutine goto_nml(iunit, nml, status) ! Search to namelist group within ice_in file. ! for compilers that do not allow optional namelists - + ! passed variables integer(kind=int_kind), intent(in) :: & iunit ! namelist file unit - + character(len=*), intent(in) :: & nml ! namelist to search for - + integer(kind=int_kind), intent(out) :: & status ! status of subrouine - + ! local variables character(len=char_len) :: & file_str, & ! string in file nml_str ! namelist string to test - + integer(kind=int_kind) :: & i, n ! dummy integers - - + + ! rewind file rewind(iunit) - + ! define test string with ampersand nml_str = '&' // trim(adjustl(nml)) - + ! search for the record containing the namelist group we're looking for do read(iunit, '(a)', iostat=status) file_str @@ -365,10 +365,10 @@ subroutine goto_nml(iunit, nml, status) end if end if end do - + ! backspace to namelist name in file backspace(iunit) - + end subroutine goto_nml !======================================================================= diff --git a/configuration/scripts/Makefile b/configuration/scripts/Makefile index a2f17256f..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 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, optargs" + @echo " Unit Tests : helloworld, calchk, sumchk, bcstchk, gridavgchk, halochk, optargs, opticep" target: targets db_files: @@ -151,6 +151,10 @@ bcstchk: $(EXEC) 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/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/ice_in b/configuration/scripts/ice_in index 32db0270b..e0e317e40 100644 --- a/configuration/scripts/ice_in +++ b/configuration/scripts/ice_in @@ -48,11 +48,12 @@ 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 history_format = 'default' + hist_time_axis = 'end' write_ic = .true. incond_dir = './history/' incond_file = 'iceh_ic' diff --git a/configuration/scripts/machines/Macros.derecho_intel b/configuration/scripts/machines/Macros.derecho_intel index cd349c57d..df0d2320e 100644 --- a/configuration/scripts/machines/Macros.derecho_intel +++ b/configuration/scripts/machines/Macros.derecho_intel @@ -1,5 +1,5 @@ #============================================================================== -# Makefile macros for NCAR derecho, intel compiler +# Makefile macros for NCAR cheyenne, intel compiler #============================================================================== CPP := fpp @@ -37,11 +37,14 @@ NETCDF_PATH := $(NETCDF) #PIO_CONFIG_OPTS:= --enable-filesystem-hints=gpfs -#PNETCDF_PATH := $(PNETCDF) +PNETCDF_PATH := $(PNETCDF) +#PNETCDF_PATH := /glade/u/apps/ch/opt/pio/2.2/mpt/2.15f/intel/17.0.1/lib -#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 @@ -52,11 +55,15 @@ ifeq ($(ICE_THREADED), true) FFLAGS += -qopenmp endif -ifeq ($(ICE_IOTYPE), pio1) - SLIBS := $(SLIBS) -lpio -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/env.derecho_intel b/configuration/scripts/machines/env.derecho_intel index 63626dc33..baa053e75 100644 --- a/configuration/scripts/machines/env.derecho_intel +++ b/configuration/scripts/machines/env.derecho_intel @@ -15,21 +15,17 @@ 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 if ($ICE_IOTYPE =~ pio*) then - module unload netcdf - module load netcdf-mpi/4.9.2 module load parallel-netcdf/1.12.3 if ($ICE_IOTYPE == "pio1") then module load parallelio/1.10.1 else - module load parallelio/2.6.1 + module load parallelio/2.6.0 endif endif endif @@ -61,10 +57,10 @@ 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, 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_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/campaign/cesm/development/pcwg +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 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 3c8deba21..781da3389 100644 --- a/configuration/scripts/options/set_nml.gx1 +++ b/configuration/scripts/options/set_nml.gx1 @@ -15,7 +15,6 @@ 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 bbed11131..3492509c6 100644 --- a/configuration/scripts/options/set_nml.gx3 +++ b/configuration/scripts/options/set_nml.gx3 @@ -12,7 +12,6 @@ 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.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.jra55 b/configuration/scripts/options/set_nml.jra55 index 4c8d41bad..465152498 100644 --- a/configuration/scripts/options/set_nml.jra55 +++ b/configuration/scripts/options/set_nml.jra55 @@ -1,4 +1,2 @@ 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 5e7348c03..5ca4cb397 100644 --- a/configuration/scripts/options/set_nml.jra55do +++ b/configuration/scripts/options/set_nml.jra55do @@ -1,3 +1,2 @@ atm_data_format = 'nc' atm_data_type = 'JRA55do' -atm_data_version = '' diff --git a/configuration/scripts/options/set_nml.qc b/configuration/scripts/options/set_nml.qc index feefb376d..5de4dd28e 100644 --- a/configuration/scripts/options/set_nml.qc +++ b/configuration/scripts/options/set_nml.qc @@ -12,5 +12,5 @@ dumpfreq_n = 12 diagfreq = 24 histfreq = 'd','x','x','x','x' f_hi = 'd' -hist_avg = .false. +hist_avg = .false.,.false.,.false.,.false.,.false. distribution_wght = 'blockall' diff --git a/configuration/scripts/options/set_nml.run3dt b/configuration/scripts/options/set_nml.run3dt index 4ff27ce22..11a8c0f85 100644 --- a/configuration/scripts/options/set_nml.run3dt +++ b/configuration/scripts/options/set_nml.run3dt @@ -2,6 +2,6 @@ npt_unit = '1' npt = 3 dump_last = .true. histfreq = '1','x','x','x','x' -hist_avg = .false. +hist_avg = .false.,.false.,.false.,.false.,.false. f_uvel = '1' f_vvel = '1' diff --git a/configuration/scripts/options/set_nml.tx1 b/configuration/scripts/options/set_nml.tx1 index 8b10a6c62..c21231a0f 100644 --- a/configuration/scripts/options/set_nml.tx1 +++ b/configuration/scripts/options/set_nml.tx1 @@ -9,6 +9,5 @@ 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/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/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 af6b2d76e..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 @@ -55,8 +62,11 @@ if (${filearg} == 1) then touch ${test_out} if (${cicefile} == 1) then - cat ${base_data} | grep -A 99999999 "total ice area (km^2)" | grep -e istep1: -e = | grep -iv "min, max, sum" >&! ${base_out} - cat ${test_data} | grep -A 99999999 "total ice area (km^2)" | grep -e istep1: -e = | grep -iv "min, max, sum" >&! ${test_out} + 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 319c91aa6..840fc822e 100644 --- a/configuration/scripts/tests/unittest_suite.ts +++ b/configuration/scripts/tests/unittest_suite.ts @@ -1,14 +1,35 @@ # Test Grid PEs Sets BFB-compare -unittest gx3 1x1 helloworld -unittest gx3 1x1 optargs -unittest gx3 1x1 calchk,short -unittest gx3 4x1x25x29x4 sumchk -unittest gx3 1x1x25x29x16 sumchk -unittest tx1 8x1 sumchk -unittest gx3 4x1 bcstchk -unittest gx3 1x1 bcstchk -unittest gx3 8x2 gridavgchk,dwblockall -unittest gx3 12x1 gridavgchk -unittest gx1 28x1 gridavgchk,dwblockall -unittest gx1 16x2 gridavgchk -unittest gbox128 8x2 gridavgchk +smoke gx3 8x2 diag1,run5day +smoke gx3 4x2x25x29x4 debug,run2day,dslenderX2 +unittest gx3 1x1 helloworld +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 +unittest gx3 12x1 gridavgchk +unittest gx1 28x1 gridavgchk,dwblockall +unittest gx1 16x2 gridavgchk +unittest gbox128 8x2 gridavgchk +unittest gbox80 1x1x10x10x80 halochk,cyclic,debug +unittest gbox80 1x1x24x23x16 halochk +unittest gbox80 1x1x23x24x16 halochk,cyclic +unittest gbox80 1x1x23x23x16 halochk,open +unittest tx1 1x1x90x60x16 halochk,dwblockall +unittest tx1 1x1x90x60x16 halochk,dwblockall,tripolet +unittest tx1 1x1x95x65x16 halochk,dwblockall +unittest tx1 1x1x95x65x16 halochk,dwblockall,tripolet +unittest gx3 4x2 halochk,dwblockall,debug +unittest gx3 8x2x16x12x10 halochk,cyclic,dwblockall +unittest gx3 17x1x16x12x10 halochk,open,dwblockall +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/cice_index.rst b/doc/source/cice_index.rst index 0e9d21517..93681650d 100644 --- a/doc/source/cice_index.rst +++ b/doc/source/cice_index.rst @@ -314,14 +314,15 @@ 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", "" "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/developer_guide/dg_forcing.rst b/doc/source/developer_guide/dg_forcing.rst index e6dbe92f2..8cf293843 100644 --- a/doc/source/developer_guide/dg_forcing.rst +++ b/doc/source/developer_guide/dg_forcing.rst @@ -21,12 +21,10 @@ 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_$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. +- 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. - 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/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/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 0b928d012..c6b814c0d 100644 --- a/doc/source/master_list.bib +++ b/doc/source/master_list.bib @@ -320,7 +320,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", @@ -503,14 +503,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", @@ -616,7 +616,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", @@ -640,7 +640,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_dynamics.rst b/doc/source/science_guide/sg_dynamics.rst index e6b918538..5cae10dc6 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 ~~~~~~~~~~~~~~~~ @@ -507,7 +507,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_horiztrans.rst b/doc/source/science_guide/sg_horiztrans.rst index d66046465..10b668755 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 @@ -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: @@ -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_case_settings.rst b/doc/source/user_guide/ug_case_settings.rst index 587adcd56..f19ae0317 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", "" @@ -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", "" @@ -595,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", "" diff --git a/doc/source/user_guide/ug_implementation.rst b/doc/source/user_guide/ug_implementation.rst index 5ed2092c0..e08db5d56 100644 --- a/doc/source/user_guide/ug_implementation.rst +++ b/doc/source/user_guide/ug_implementation.rst @@ -994,7 +994,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 @@ -1111,7 +1111,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 @@ -1153,8 +1154,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: @@ -1163,7 +1167,7 @@ For example, in the namelist: histfreq = ’1’, ’h’, ’d’, ’m’, ’y’ histfreq_n = 1, 6, 0, 1, 1 histfreq_base = 'zero' - hist_avg = .true. + hist_avg = .true.,.true.,.true.,.true.,.true. f_hi = ’1’ f_hs = ’h’ f_Tsfc = ’d’ diff --git a/doc/source/user_guide/ug_testing.rst b/doc/source/user_guide/ug_testing.rst index 289f626a9..b55538aed 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. @@ -741,6 +741,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. @@ -756,7 +758,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. @@ -823,7 +825,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 ac96b92af..69363dac4 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. @@ -216,7 +216,7 @@ Interpretation of albedos More information about interpretation of albedos can be found in the -`Icepack documentation `_. +`Icepack documentation `_. VP dynamics results