diff --git a/.readthedocs.yaml b/.readthedocs.yaml new file mode 100644 index 000000000..cc2b2817b --- /dev/null +++ b/.readthedocs.yaml @@ -0,0 +1,29 @@ +# .readthedocs.yaml +# Read the Docs configuration file +# See https://docs.readthedocs.io/en/stable/config-file/v2.html for details + +# Required +version: 2 + +# Set the version of Python and other tools you might need +build: + os: ubuntu-22.04 + tools: + python: "3.7" + # You can also specify other tool versions: + # nodejs: "19" + # rust: "1.64" + # golang: "1.19" + +# Build documentation in the docs/ directory with Sphinx +sphinx: + configuration: doc/source/conf.py + +# If using Sphinx, optionally build your docs in additional formats such as PDF +formats: + - pdf + +# Optionally declare the Python requirements required to build your docs +python: + install: + - requirements: doc/requirements.txt diff --git a/cicecore/cicedyn/analysis/ice_diagnostics.F90 b/cicecore/cicedyn/analysis/ice_diagnostics.F90 index 53631b2d4..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 54b6ce934..3eda456ec 100644 --- a/cicecore/cicedyn/analysis/ice_history.F90 +++ b/cicecore/cicedyn/analysis/ice_history.F90 @@ -263,7 +263,7 @@ subroutine init_hist (dt) trim(tmpstr2), file=__FILE__, line=__LINE__) endif end do - + close(nu_nml) call release_fileunit(nu_nml) endif @@ -2225,7 +2225,7 @@ subroutine accum_hist (dt) n4Dfcum = n4Dscum + num_avail_hist_fields_4Df ! should equal num_avail_hist_fields_tot do ns = 1,nstreams - if (.not. hist_avg) then ! write snapshots + if (.not. hist_avg(ns)) then ! write snapshots do n = 1,n2D if (avail_hist_fields(n)%vhistfreq == histfreq(ns)) & a2D(:,:,n,:) = c0 diff --git a/cicecore/cicedyn/analysis/ice_history_pond.F90 b/cicecore/cicedyn/analysis/ice_history_pond.F90 index d209e6db6..976a87d40 100644 --- a/cicecore/cicedyn/analysis/ice_history_pond.F90 +++ b/cicecore/cicedyn/analysis/ice_history_pond.F90 @@ -100,14 +100,14 @@ subroutine init_hist_pond_2D trim(nml_filename), & file=__FILE__, line=__LINE__) endif - + ! goto this namelist in file call goto_nml(nu_nml,trim(nml_name),nml_error) if (nml_error /= 0) then call abort_ice(subname//'ERROR: searching for '// trim(nml_name), & file=__FILE__, line=__LINE__) endif - + ! read namelist nml_error = 1 do while (nml_error > 0) @@ -121,7 +121,7 @@ subroutine init_hist_pond_2D trim(tmpstr2), file=__FILE__, line=__LINE__) endif end do - + close(nu_nml) call release_fileunit(nu_nml) endif diff --git a/cicecore/cicedyn/analysis/ice_history_shared.F90 b/cicecore/cicedyn/analysis/ice_history_shared.F90 index 70aa5e14c..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 30fe546e0..4f9d84d98 100644 --- a/cicecore/cicedyn/dynamics/ice_transport_driver.F90 +++ b/cicecore/cicedyn/dynamics/ice_transport_driver.F90 @@ -37,9 +37,6 @@ module ice_transport_driver ! 'upwind' => 1st order donor cell scheme ! 'remap' => remapping scheme - logical, parameter :: & - l_fixed_area = .false. ! if true, prescribe area flux across each edge - ! NOTE: For remapping, hice and hsno are considered tracers. ! ntrace is not equal to ntrcr! @@ -81,6 +78,7 @@ subroutine init_transport use ice_state, only: trcr_depend use ice_timers, only: ice_timer_start, ice_timer_stop, timer_advect use ice_transport_remap, only: init_remap + use ice_grid, only: grid_ice integer (kind=int_kind) :: & k, nt, nt1 ! tracer indices @@ -236,7 +234,7 @@ subroutine init_transport endif ! master_task 1000 format (1x,a,2x,i6,2x,i6,2x,i4,4x,l4) - if (trim(advection)=='remap') call init_remap ! grid quantities + if (trim(advection)=='remap') call init_remap ! grid quantities call ice_timer_stop(timer_advect) ! advection @@ -545,19 +543,17 @@ subroutine transport_remap (dt) call horizontal_remap (dt, ntrace, & uvel (:,:,:), vvel (:,:,:), & aim (:,:,:,:), trm(:,:,:,:,:), & - l_fixed_area, & tracer_type, depend, & has_dependents, integral_order, & - l_dp_midpt, grid_ice, & + l_dp_midpt, & uvelE (:,:,:), vvelN (:,:,:)) else call horizontal_remap (dt, ntrace, & uvel (:,:,:), vvel (:,:,:), & aim (:,:,:,:), trm(:,:,:,:,:), & - l_fixed_area, & tracer_type, depend, & has_dependents, integral_order, & - l_dp_midpt, grid_ice) + l_dp_midpt) endif !------------------------------------------------------------------- diff --git a/cicecore/cicedyn/dynamics/ice_transport_remap.F90 b/cicecore/cicedyn/dynamics/ice_transport_remap.F90 index 286a51711..eb0dd17cf 100644 --- a/cicecore/cicedyn/dynamics/ice_transport_remap.F90 +++ b/cicecore/cicedyn/dynamics/ice_transport_remap.F90 @@ -42,6 +42,7 @@ module ice_transport_remap use ice_exit, only: abort_ice use icepack_intfc, only: icepack_warnings_flush, icepack_warnings_aborted use icepack_intfc, only: icepack_query_parameters + use ice_grid, only : grid_ice implicit none private @@ -57,6 +58,11 @@ module ice_transport_remap p5625m = -9._dbl_kind/16._dbl_kind ,& p52083 = 25._dbl_kind/48._dbl_kind + logical :: & + l_fixed_area ! if true, prescribe area flux across each edge + ! if false, area flux is determined internally + ! and is passed out + logical (kind=log_kind), parameter :: bugcheck = .false. !======================================================================= @@ -293,6 +299,29 @@ subroutine init_remap enddo !$OMP END PARALLEL DO + !------------------------------------------------------------------- + ! Set logical l_fixed_area depending of the grid type. + ! + ! If l_fixed_area is true, the area of each departure region is + ! computed in advance (e.g., by taking the divergence of the + ! velocity field and passed to locate_triangles. The departure + ! regions are adjusted to obtain the desired area. + ! If false, edgearea is computed in locate_triangles and passed out. + ! + ! l_fixed_area = .false. has been the default approach in CICE. It is + ! used like this for the B-grid. However, idealized tests with the + ! C-grid have shown that l_fixed_area = .false. leads to a checkerboard + ! pattern in prognostic fields (e.g. aice). Using l_fixed_area = .true. + ! eliminates the checkerboard pattern in C-grid simulations. + ! + !------------------------------------------------------------------- + + if (grid_ice == 'CD' .or. grid_ice == 'C') then + l_fixed_area = .false. !jlem temporary + else + l_fixed_area = .false. + endif + end subroutine init_remap !======================================================================= @@ -316,11 +345,10 @@ end subroutine init_remap subroutine horizontal_remap (dt, ntrace, & uvel, vvel, & mm, tm, & - l_fixed_area, & tracer_type, depend, & has_dependents, & integral_order, & - l_dp_midpt, grid_ice, & + l_dp_midpt, & uvelE, vvelN) use ice_boundary, only: ice_halo, ice_HaloMask, ice_HaloUpdate, & @@ -353,21 +381,6 @@ subroutine horizontal_remap (dt, ntrace, & real (kind=dbl_kind), intent(inout), dimension (nx_block,ny_block,ntrace,ncat,max_blocks) :: & tm ! mean tracer values in each grid cell - character (len=char_len_long), intent(in) :: & - grid_ice ! ice grid, B, C, etc - - !------------------------------------------------------------------- - ! If l_fixed_area is true, the area of each departure region is - ! computed in advance (e.g., by taking the divergence of the - ! velocity field and passed to locate_triangles. The departure - ! regions are adjusted to obtain the desired area. - ! If false, edgearea is computed in locate_triangles and passed out. - !------------------------------------------------------------------- - - logical, intent(in) :: & - l_fixed_area ! if true, edgearea_e and edgearea_n are prescribed - ! if false, edgearea is computed here and passed out - integer (kind=int_kind), dimension (ntrace), intent(in) :: & tracer_type , & ! = 1, 2, or 3 (see comments above) depend ! tracer dependencies (see above) @@ -716,8 +729,7 @@ subroutine horizontal_remap (dt, ntrace, & dxu (:,:,iblk), dyu(:,:,iblk), & xp (:,:,:,:), yp (:,:,:,:), & iflux, jflux, & - triarea, & - l_fixed_area, edgearea_e(:,:)) + triarea, edgearea_e(:,:)) !------------------------------------------------------------------- ! Given triangle vertices, compute coordinates of triangle points @@ -776,8 +788,7 @@ subroutine horizontal_remap (dt, ntrace, & dxu (:,:,iblk), dyu (:,:,iblk), & xp (:,:,:,:), yp(:,:,:,:), & iflux, jflux, & - triarea, & - l_fixed_area, edgearea_n(:,:)) + triarea, edgearea_n(:,:)) call triangle_coordinates (nx_block, ny_block, & integral_order, icellsng(:,iblk), & @@ -1696,8 +1707,7 @@ subroutine locate_triangles (nx_block, ny_block, & dxu, dyu, & xp, yp, & iflux, jflux, & - triarea, & - l_fixed_area, edgearea) + triarea, edgearea) integer (kind=int_kind), intent(in) :: & nx_block, ny_block, & ! block dimensions @@ -1730,12 +1740,6 @@ subroutine locate_triangles (nx_block, ny_block, & indxi , & ! compressed index in i-direction indxj ! compressed index in j-direction - logical, intent(in) :: & - l_fixed_area ! if true, the area of each departure region is - ! passed in as edgearea - ! if false, edgearea if determined internally - ! and is passed out - real (kind=dbl_kind), dimension(nx_block,ny_block), intent(inout) :: & edgearea ! area of departure region for each edge ! edgearea > 0 for eastward/northward flow @@ -1838,7 +1842,7 @@ subroutine locate_triangles (nx_block, ny_block, & ! BL | BC | BR (bottom left, center, right) ! | | ! - ! and the transport is across the edge between cells TC and TB. + ! and the transport is across the edge between cells TC and BC. ! ! Departure points are scaled to a local coordinate system ! whose origin is at the midpoint of the edge. @@ -1951,45 +1955,32 @@ subroutine locate_triangles (nx_block, ny_block, & ! Compute mask for edges with nonzero departure areas !------------------------------------------------------------------- - if (l_fixed_area) then - icellsd = 0 + icellsd = 0 + if (trim(edge) == 'north') then do j = jb, je do i = ib, ie - if (edgearea(i,j) /= c0) then + if (dpx(i-1,j)/=c0 .or. dpy(i-1,j)/=c0 & + .or. & + dpx(i,j)/=c0 .or. dpy(i,j)/=c0) then icellsd = icellsd + 1 indxid(icellsd) = i indxjd(icellsd) = j endif enddo enddo - else - icellsd = 0 - if (trim(edge) == 'north') then - do j = jb, je - do i = ib, ie - if (dpx(i-1,j)/=c0 .or. dpy(i-1,j)/=c0 & - .or. & - dpx(i,j)/=c0 .or. dpy(i,j)/=c0) then - icellsd = icellsd + 1 - indxid(icellsd) = i - indxjd(icellsd) = j - endif - enddo - enddo - else ! east edge - do j = jb, je - do i = ib, ie - if (dpx(i,j-1)/=c0 .or. dpy(i,j-1)/=c0 & - .or. & - dpx(i,j)/=c0 .or. dpy(i,j)/=c0) then - icellsd = icellsd + 1 - indxid(icellsd) = i - indxjd(icellsd) = j - endif - enddo - enddo - endif ! edge = north/east - endif ! l_fixed_area + else ! east edge + do j = jb, je + do i = ib, ie + if (dpx(i,j-1)/=c0 .or. dpy(i,j-1)/=c0 & + .or. & + dpx(i,j)/=c0 .or. dpy(i,j)/=c0) then + icellsd = icellsd + 1 + indxid(icellsd) = i + indxjd(icellsd) = j + endif + enddo + enddo + endif ! edge = north/east !------------------------------------------------------------------- ! Scale the departure points diff --git a/cicecore/cicedyn/general/ice_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 4c8fb1fee..3b8d83d1f 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_exit.F90 b/cicecore/cicedyn/infrastructure/comm/mpi/ice_exit.F90 index eafb3228f..5351a5336 100644 --- a/cicecore/cicedyn/infrastructure/comm/mpi/ice_exit.F90 +++ b/cicecore/cicedyn/infrastructure/comm/mpi/ice_exit.F90 @@ -1,3 +1,4 @@ + !======================================================================= ! ! Exit the model. @@ -8,7 +9,15 @@ module ice_exit use ice_kinds_mod + use ice_fileunits, only: nu_diag, ice_stderr, flush_fileunit use icepack_intfc, only: icepack_warnings_flush, icepack_warnings_aborted +#if (defined CESMCOUPLED) + use shr_sys_mod +#else +#ifndef SERIAL_REMOVE_MPI + use mpi ! MPI Fortran module +#endif +#endif implicit none public @@ -23,14 +32,6 @@ subroutine abort_ice(error_message, file, line, doabort) ! This routine aborts the ice model and prints an error message. -#if (defined CESMCOUPLED) - use ice_fileunits, only: nu_diag, flush_fileunit - use shr_sys_mod -#else - use ice_fileunits, only: nu_diag, ice_stderr, flush_fileunit - use mpi ! MPI Fortran module -#endif - character (len=*), intent(in),optional :: error_message ! error message character (len=*), intent(in),optional :: file ! file integer (kind=int_kind), intent(in), optional :: line ! line number @@ -38,11 +39,10 @@ subroutine abort_ice(error_message, file, line, doabort) ! local variables -#ifndef CESMCOUPLED integer (int_kind) :: & ierr, & ! MPI error flag + outunit, & ! output unit error_code ! return code -#endif logical (log_kind) :: ldoabort ! local doabort flag character(len=*), parameter :: subname='(abort_ice)' @@ -50,30 +50,31 @@ subroutine abort_ice(error_message, file, line, doabort) if (present(doabort)) ldoabort = doabort #if (defined CESMCOUPLED) - call flush_fileunit(nu_diag) - call icepack_warnings_flush(nu_diag) - write(nu_diag,*) ' ' - write(nu_diag,*) subname, 'ABORTED: ' - if (present(file)) write (nu_diag,*) subname,' called from ',trim(file) - if (present(line)) write (nu_diag,*) subname,' line number ',line - if (present(error_message)) write (nu_diag,*) subname,' error = ',trim(error_message) - call flush_fileunit(nu_diag) - if (ldoabort) call shr_sys_abort(subname//trim(error_message)) + outunit = nu_diag #else + outunit = ice_stderr +#endif + call flush_fileunit(nu_diag) call icepack_warnings_flush(nu_diag) - write(ice_stderr,*) ' ' - write(ice_stderr,*) subname, 'ABORTED: ' - if (present(file)) write (ice_stderr,*) subname,' called from ',trim(file) - if (present(line)) write (ice_stderr,*) subname,' line number ',line - if (present(error_message)) write (ice_stderr,*) subname,' error = ',trim(error_message) - call flush_fileunit(ice_stderr) - error_code = 128 + write(outunit,*) ' ' + write(outunit,*) subname, 'ABORTED: ' + if (present(file)) write (outunit,*) subname,' called from ',trim(file) + if (present(line)) write (outunit,*) subname,' line number ',line + if (present(error_message)) write (outunit,*) subname,' error = ',trim(error_message) + call flush_fileunit(outunit) + if (ldoabort) then +#if (defined CESMCOUPLED) + call shr_sys_abort(subname//trim(error_message)) +#else +#ifndef SERIAL_REMOVE_MPI + error_code = 128 call MPI_ABORT(MPI_COMM_WORLD, error_code, ierr) +#endif stop - endif #endif + endif end subroutine abort_ice @@ -81,12 +82,15 @@ end subroutine abort_ice subroutine end_run -! Ends run by calling MPI_FINALIZE. +! Ends run by calling MPI_FINALIZE +! Does nothing in serial runs integer (int_kind) :: ierr ! MPI error flag character(len=*), parameter :: subname = '(end_run)' +#ifndef SERIAL_REMOVE_MPI call MPI_FINALIZE(ierr) +#endif end subroutine end_run diff --git a/cicecore/cicedyn/infrastructure/comm/mpi/ice_global_reductions.F90 b/cicecore/cicedyn/infrastructure/comm/mpi/ice_global_reductions.F90 index 4b94389f7..91daf53a8 100644 --- a/cicecore/cicedyn/infrastructure/comm/mpi/ice_global_reductions.F90 +++ b/cicecore/cicedyn/infrastructure/comm/mpi/ice_global_reductions.F90 @@ -181,7 +181,7 @@ function global_sum_dbl(array, dist, field_loc, mMask, lMask) & if (Nrow .and. this_block%tripoleTFlag) then maxiglob = 0 ! entire u-row on T-fold grid elseif (Nrow .or. this_block%tripoleTFlag) then - maxiglob = nx_global/2 ! half T-row on T-fold and u-row on u-fold + maxiglob = nx_global/2 ! half T-row on T-fold or half u-row on u-fold else maxiglob = -1 ! nothing to do for T-row on u-fold endif @@ -189,25 +189,45 @@ function global_sum_dbl(array, dist, field_loc, mMask, lMask) & n = (iblock-1)*nx_block*ny_block - do j=jb,je - do i=ib,ie - n = n + 1 - ! eliminate redundant points - if (maxiglob > 0 .and. j == je .and. this_block%i_glob(i) > maxiglob) then - work(n,1) = 0._dbl_kind - else - if (present(mMask)) then - work(n,1) = array(i,j,iblock)*mMask(i,j,iblock) - else if (present(lMask)) then - if (lMask(i,j,iblock)) then - work(n,1) = array(i,j,iblock) - endif - else + if (present(mMask)) then + do j=jb,je + do i=ib,ie + n = n + 1 + work(n,1) = array(i,j,iblock)*mMask(i,j,iblock) + end do + end do + elseif (present(lMask)) then + do j=jb,je + do i=ib,ie + n = n + 1 + if (lMask(i,j,iblock)) then work(n,1) = array(i,j,iblock) endif - endif - end do - end do + end do + end do + else + do j=jb,je + do i=ib,ie + n = n + 1 + work(n,1) = array(i,j,iblock) + enddo + enddo + endif + + if (maxiglob >= 0) then + ! eliminate redundant points at je + ! set n to (ib,je) index + n = (iblock-1)*nx_block*ny_block + n = n + (je-1-jb+1)*(ie-ib+1) + j=je + do i=ib,ie + n = n + 1 + if (this_block%i_glob(i) > maxiglob) then + work(n,1) = 0._dbl_kind + endif + end do + endif + end do call compute_sums_dbl(work,sums,communicator,numProcs) @@ -317,7 +337,7 @@ function global_sum_real(array, dist, field_loc, mMask, lMask) & if (Nrow .and. this_block%tripoleTFlag) then maxiglob = 0 ! entire u-row on T-fold grid elseif (Nrow .or. this_block%tripoleTFlag) then - maxiglob = nx_global/2 ! half T-row on T-fold and u-row on u-fold + maxiglob = nx_global/2 ! half T-row on T-fold or half u-row on u-fold else maxiglob = -1 ! nothing to do for T-row on u-fold endif @@ -325,25 +345,45 @@ function global_sum_real(array, dist, field_loc, mMask, lMask) & n = (iblock-1)*nx_block*ny_block - do j=jb,je - do i=ib,ie - n = n + 1 - ! eliminate redundant points - if (maxiglob > 0 .and. j == je .and. this_block%i_glob(i) > maxiglob) then - work(n,1) = 0._dbl_kind - else - if (present(mMask)) then - work(n,1) = real(array(i,j,iblock)*mMask(i,j,iblock),dbl_kind) - else if (present(lMask)) then - if (lMask(i,j,iblock)) then - work(n,1) = real(array(i,j,iblock),dbl_kind) - endif - else + if (present(mMask)) then + do j=jb,je + do i=ib,ie + n = n + 1 + work(n,1) = real(array(i,j,iblock)*mMask(i,j,iblock),dbl_kind) + end do + end do + elseif (present(lMask)) then + do j=jb,je + do i=ib,ie + n = n + 1 + if (lMask(i,j,iblock)) then work(n,1) = real(array(i,j,iblock),dbl_kind) endif - endif - end do - end do + end do + end do + else + do j=jb,je + do i=ib,ie + n = n + 1 + work(n,1) = real(array(i,j,iblock),dbl_kind) + enddo + enddo + endif + + if (maxiglob >= 0) then + ! eliminate redundant points at je + ! set n to (ib,je) index + n = (iblock-1)*nx_block*ny_block + n = n + (je-1-jb+1)*(ie-ib+1) + j=je + do i=ib,ie + n = n + 1 + if (this_block%i_glob(i) > maxiglob) then + work(n,1) = 0._dbl_kind + endif + end do + endif + end do call compute_sums_dbl(work,sums,communicator,numProcs) @@ -445,7 +485,7 @@ function global_sum_int(array, dist, field_loc, mMask, lMask) & if (Nrow .and. this_block%tripoleTFlag) then maxiglob = 0 ! entire u-row on T-fold grid elseif (Nrow .or. this_block%tripoleTFlag) then - maxiglob = nx_global/2 ! half T-row on T-fold and u-row on u-fold + maxiglob = nx_global/2 ! half T-row on T-fold or half u-row on u-fold else maxiglob = -1 ! nothing to do for T-row on u-fold endif @@ -456,7 +496,7 @@ function global_sum_int(array, dist, field_loc, mMask, lMask) & do j=jb,je do i=ib,ie ! eliminate redundant points - if (maxiglob > 0 .and. j == je .and. this_block%i_glob(i) > maxiglob) then + if (maxiglob >= 0 .and. j == je .and. this_block%i_glob(i) > maxiglob) then ! blockSum = blockSum + 0_int_kind else if (present(mMask)) then @@ -798,7 +838,7 @@ function global_sum_prod_dbl (array1, array2, dist, field_loc, & if (Nrow .and. this_block%tripoleTFlag) then maxiglob = 0 ! entire u-row on T-fold grid elseif (Nrow .or. this_block%tripoleTFlag) then - maxiglob = nx_global/2 ! half T-row on T-fold and u-row on u-fold + maxiglob = nx_global/2 ! half T-row on T-fold or half u-row on u-fold else maxiglob = -1 ! nothing to do for T-row on u-fold endif @@ -806,25 +846,45 @@ function global_sum_prod_dbl (array1, array2, dist, field_loc, & n = (iblock-1)*nx_block*ny_block - do j=jb,je - do i=ib,ie - n = n + 1 - ! eliminate redundant points - if (maxiglob > 0 .and. j == je .and. this_block%i_glob(i) > maxiglob) then - work(n,1) = 0._dbl_kind - else - if (present(mMask)) then - work(n,1) = array1(i,j,iblock)*array2(i,j,iblock)*mMask(i,j,iblock) - else if (present(lMask)) then - if (lMask(i,j,iblock)) then - work(n,1) = array1(i,j,iblock)*array2(i,j,iblock) - endif - else + if (present(mMask)) then + do j=jb,je + do i=ib,ie + n = n + 1 + work(n,1) = array1(i,j,iblock)*array2(i,j,iblock)*mMask(i,j,iblock) + end do + end do + elseif (present(lMask)) then + do j=jb,je + do i=ib,ie + n = n + 1 + if (lMask(i,j,iblock)) then work(n,1) = array1(i,j,iblock)*array2(i,j,iblock) endif - endif - end do - end do + end do + end do + else + do j=jb,je + do i=ib,ie + n = n + 1 + work(n,1) = array1(i,j,iblock)*array2(i,j,iblock) + enddo + enddo + endif + + if (maxiglob >= 0) then + ! eliminate redundant points at je + ! set n to (ib,je) index + n = (iblock-1)*nx_block*ny_block + n = n + (je-1-jb+1)*(ie-ib+1) + j=je + do i=ib,ie + n = n + 1 + if (this_block%i_glob(i) > maxiglob) then + work(n,1) = 0._dbl_kind + endif + end do + endif + end do call compute_sums_dbl(work,sums,communicator,numProcs) @@ -936,7 +996,7 @@ function global_sum_prod_real (array1, array2, dist, field_loc, & if (Nrow .and. this_block%tripoleTFlag) then maxiglob = 0 ! entire u-row on T-fold grid elseif (Nrow .or. this_block%tripoleTFlag) then - maxiglob = nx_global/2 ! half T-row on T-fold and u-row on u-fold + maxiglob = nx_global/2 ! half T-row on T-fold or half u-row on u-fold else maxiglob = -1 ! nothing to do for T-row on u-fold endif @@ -944,25 +1004,45 @@ function global_sum_prod_real (array1, array2, dist, field_loc, & n = (iblock-1)*nx_block*ny_block - do j=jb,je - do i=ib,ie - n = n + 1 - ! eliminate redundant points - if (maxiglob > 0 .and. j == je .and. this_block%i_glob(i) > maxiglob) then - work(n,1) = 0._dbl_kind - else - if (present(mMask)) then - work(n,1) = real(array1(i,j,iblock)*array2(i,j,iblock)*mMask(i,j,iblock),dbl_kind) - else if (present(lMask)) then - if (lMask(i,j,iblock)) then - work(n,1) = real(array1(i,j,iblock)*array2(i,j,iblock),dbl_kind) - endif - else + if (present(mMask)) then + do j=jb,je + do i=ib,ie + n = n + 1 + work(n,1) = real(array1(i,j,iblock)*array2(i,j,iblock)*mMask(i,j,iblock),dbl_kind) + end do + end do + elseif (present(lMask)) then + do j=jb,je + do i=ib,ie + n = n + 1 + if (lMask(i,j,iblock)) then work(n,1) = real(array1(i,j,iblock)*array2(i,j,iblock),dbl_kind) endif - endif - end do - end do + end do + end do + else + do j=jb,je + do i=ib,ie + n = n + 1 + work(n,1) = real(array1(i,j,iblock)*array2(i,j,iblock),dbl_kind) + enddo + enddo + endif + + if (maxiglob >= 0) then + ! eliminate redundant points at je + ! set n to (ib,je) index + n = (iblock-1)*nx_block*ny_block + n = n + (je-1-jb+1)*(ie-ib+1) + j=je + do i=ib,ie + n = n + 1 + if (this_block%i_glob(i) > maxiglob) then + work(n,1) = 0._dbl_kind + endif + end do + endif + end do call compute_sums_dbl(work,sums,communicator,numProcs) @@ -1066,7 +1146,7 @@ function global_sum_prod_int (array1, array2, dist, field_loc, & if (Nrow .and. this_block%tripoleTFlag) then maxiglob = 0 ! entire u-row on T-fold grid elseif (Nrow .or. this_block%tripoleTFlag) then - maxiglob = nx_global/2 ! half T-row on T-fold and u-row on u-fold + maxiglob = nx_global/2 ! half T-row on T-fold or half u-row on u-fold else maxiglob = -1 ! nothing to do for T-row on u-fold endif @@ -1077,7 +1157,7 @@ function global_sum_prod_int (array1, array2, dist, field_loc, & do j=jb,je do i=ib,ie ! eliminate redundant points - if (maxiglob > 0 .and. j == je .and. this_block%i_glob(i) > maxiglob) then + if (maxiglob >= 0 .and. j == je .and. this_block%i_glob(i) > maxiglob) then ! blockSum = blockSum + 0_int_kind else if (present(mMask)) then diff --git a/cicecore/cicedyn/infrastructure/comm/mpi/ice_reprosum.F90 b/cicecore/cicedyn/infrastructure/comm/mpi/ice_reprosum.F90 index 8c6f90363..7c6c0eb77 100644 --- a/cicecore/cicedyn/infrastructure/comm/mpi/ice_reprosum.F90 +++ b/cicecore/cicedyn/infrastructure/comm/mpi/ice_reprosum.F90 @@ -87,7 +87,7 @@ MODULE ice_reprosum !----------------------------------------------------------------------- logical :: repro_sum_use_ddpdd = .false. -! logical :: detailed_timing = .false. + logical :: detailed_timing = .false. character(len=char_len_long) :: tmpstr CONTAINS @@ -100,10 +100,10 @@ MODULE ice_reprosum !----------------------------------------------------------------------- subroutine ice_reprosum_setopts(repro_sum_use_ddpdd_in, & - repro_sum_rel_diff_max_in, & - repro_sum_recompute_in, & - repro_sum_master, & - repro_sum_logunit ) + repro_sum_rel_diff_max_in, & + repro_sum_recompute_in, & + repro_sum_master, & + repro_sum_logunit ) !------------------------------Arguments-------------------------------- logical, intent(in), optional :: repro_sum_use_ddpdd_in @@ -260,12 +260,12 @@ end subroutine ice_reprosum_setopts !---------------------------------------------------------------------- subroutine ice_reprosum_calc (arr, arr_gsum, nsummands, dsummands, & - nflds, ddpdd_sum, & - arr_gbl_max, arr_gbl_max_out, & - arr_max_levels, arr_max_levels_out, & - gbl_max_nsummands, gbl_max_nsummands_out,& - gbl_count, repro_sum_validate, & - repro_sum_stats, rel_diff, commid ) + nflds, ddpdd_sum, & + arr_gbl_max, arr_gbl_max_out, & + arr_max_levels, arr_max_levels_out, & + gbl_max_nsummands, gbl_max_nsummands_out,& + gbl_count, repro_sum_validate, & + repro_sum_stats, rel_diff, commid ) !---------------------------------------------------------------------- ! Arguments @@ -434,7 +434,7 @@ subroutine ice_reprosum_calc (arr, arr_gsum, nsummands, dsummands, & ! if (detailed_timing) call xicex_timer_start('ice_reprosum_ddpdd') call ice_reprosum_ddpdd(arr, arr_gsum, nsummands, dsummands, & - nflds, mpi_comm) + nflds, mpi_comm) repro_sum_fast = 1 ! if (detailed_timing) call xicex_timer_stop('ice_reprosum_ddpdd') @@ -774,9 +774,9 @@ end subroutine ice_reprosum_calc !---------------------------------------------------------------------- subroutine ice_reprosum_int (arr, arr_gsum, nsummands, dsummands, nflds, & - arr_max_shift, arr_gmax_exp, max_levels, & - max_level, validate, recompute, & - omp_nthreads, mpi_comm ) + arr_max_shift, arr_gmax_exp, max_levels, & + max_level, validate, recompute, & + omp_nthreads, mpi_comm ) !---------------------------------------------------------------------- @@ -1224,7 +1224,7 @@ end subroutine ice_reprosum_int !---------------------------------------------------------------------- logical function ice_reprosum_tolExceeded (name, nflds, master, & - logunit, rel_diff ) + logunit, rel_diff ) !---------------------------------------------------------------------- ! Arguments @@ -1310,7 +1310,7 @@ end function ice_reprosum_tolExceeded !---------------------------------------------------------------------- subroutine ice_reprosum_ddpdd (arr, arr_gsum, nsummands, dsummands, & - nflds, mpi_comm ) + nflds, mpi_comm ) !---------------------------------------------------------------------- ! Arguments diff --git a/cicecore/cicedyn/infrastructure/comm/serial/ice_boundary.F90 b/cicecore/cicedyn/infrastructure/comm/serial/ice_boundary.F90 index aaebcfaad..faeaf3227 100644 --- a/cicecore/cicedyn/infrastructure/comm/serial/ice_boundary.F90 +++ b/cicecore/cicedyn/infrastructure/comm/serial/ice_boundary.F90 @@ -3749,7 +3749,7 @@ end subroutine ice_HaloUpdate4DI4 !*********************************************************************** ! This routine updates ghost cells for an input array using ! a second array as needed by the stress fields. -! This is just like 2DR8 except no averaging and only on tripole +! This is just like 2DR8 except no averaging and only on tripole subroutine ice_HaloUpdate_stress(array1, array2, halo, & fieldLoc, fieldKind, & diff --git a/cicecore/cicedyn/infrastructure/comm/serial/ice_exit.F90 b/cicecore/cicedyn/infrastructure/comm/serial/ice_exit.F90 index 2daadc0e6..39f2b6702 100644 --- a/cicecore/cicedyn/infrastructure/comm/serial/ice_exit.F90 +++ b/cicecore/cicedyn/infrastructure/comm/serial/ice_exit.F90 @@ -1,7 +1,9 @@ + +#define SERIAL_REMOVE_MPI + !======================================================================= ! ! Exit the model. -! ! authors William H. Lipscomb (LANL) ! Elizabeth C. Hunke (LANL) ! 2006 ECH: separated serial and mpi functionality @@ -9,10 +11,14 @@ module ice_exit use ice_kinds_mod - use ice_fileunits, only: nu_diag, flush_fileunit + use ice_fileunits, only: nu_diag, ice_stderr, flush_fileunit use icepack_intfc, only: icepack_warnings_flush, icepack_warnings_aborted -#ifdef CESMCOUPLED +#if (defined CESMCOUPLED) use shr_sys_mod +#else +#ifndef SERIAL_REMOVE_MPI + use mpi ! MPI Fortran module +#endif #endif implicit none @@ -24,7 +30,7 @@ module ice_exit !======================================================================= - subroutine abort_ice(error_message,file,line,doabort) + subroutine abort_ice(error_message, file, line, doabort) ! This routine aborts the ice model and prints an error message. @@ -33,30 +39,44 @@ subroutine abort_ice(error_message,file,line,doabort) integer (kind=int_kind), intent(in), optional :: line ! line number logical (kind=log_kind), intent(in), optional :: doabort ! abort flag - logical (kind=log_kind) :: ldoabort ! local doabort + ! local variables + + integer (int_kind) :: & + ierr, & ! MPI error flag + outunit, & ! output unit + error_code ! return code + logical (log_kind) :: ldoabort ! local doabort flag character(len=*), parameter :: subname='(abort_ice)' ldoabort = .true. if (present(doabort)) ldoabort = doabort -#ifdef CESMCOUPLED - call icepack_warnings_flush(nu_diag) - write(nu_diag,*) ' ' - write(nu_diag,*) subname, 'ABORTED: ' - if (present(file)) write (nu_diag,*) subname,' called from ',trim(file) - if (present(line)) write (nu_diag,*) subname,' line number ',line - if (present(error_message)) write (nu_diag,*) subname,' error = ',trim(error_message) - if (ldoabort) call shr_sys_abort(subname//trim(error_message)) +#if (defined CESMCOUPLED) + outunit = nu_diag #else - call icepack_warnings_flush(nu_diag) - write(nu_diag,*) ' ' - write(nu_diag,*) subname, 'ABORTED: ' - if (present(file)) write (nu_diag,*) subname,' called from ',trim(file) - if (present(line)) write (nu_diag,*) subname,' line number ',line - if (present(error_message)) write (nu_diag,*) subname,' error = ',trim(error_message) + outunit = ice_stderr +#endif + call flush_fileunit(nu_diag) - if (ldoabort) stop + call icepack_warnings_flush(nu_diag) + write(outunit,*) ' ' + write(outunit,*) subname, 'ABORTED: ' + if (present(file)) write (outunit,*) subname,' called from ',trim(file) + if (present(line)) write (outunit,*) subname,' line number ',line + if (present(error_message)) write (outunit,*) subname,' error = ',trim(error_message) + call flush_fileunit(outunit) + + if (ldoabort) then +#if (defined CESMCOUPLED) + call shr_sys_abort(subname//trim(error_message)) +#else +#ifndef SERIAL_REMOVE_MPI + error_code = 128 + call MPI_ABORT(MPI_COMM_WORLD, error_code, ierr) #endif + stop +#endif + endif end subroutine abort_ice @@ -64,10 +84,15 @@ end subroutine abort_ice subroutine end_run +! Ends run by calling MPI_FINALIZE +! Does nothing in serial runs + + integer (int_kind) :: ierr ! MPI error flag character(len=*), parameter :: subname = '(end_run)' -! Ends parallel run by calling MPI_FINALIZE. -! Does nothing in serial runs. +#ifndef SERIAL_REMOVE_MPI + call MPI_FINALIZE(ierr) +#endif end subroutine end_run diff --git a/cicecore/cicedyn/infrastructure/comm/serial/ice_global_reductions.F90 b/cicecore/cicedyn/infrastructure/comm/serial/ice_global_reductions.F90 index 5fcd45876..ed36cc6c0 100644 --- a/cicecore/cicedyn/infrastructure/comm/serial/ice_global_reductions.F90 +++ b/cicecore/cicedyn/infrastructure/comm/serial/ice_global_reductions.F90 @@ -182,7 +182,7 @@ function global_sum_dbl(array, dist, field_loc, mMask, lMask) & if (Nrow .and. this_block%tripoleTFlag) then maxiglob = 0 ! entire u-row on T-fold grid elseif (Nrow .or. this_block%tripoleTFlag) then - maxiglob = nx_global/2 ! half T-row on T-fold and u-row on u-fold + maxiglob = nx_global/2 ! half T-row on T-fold or half u-row on u-fold else maxiglob = -1 ! nothing to do for T-row on u-fold endif @@ -190,25 +190,45 @@ function global_sum_dbl(array, dist, field_loc, mMask, lMask) & n = (iblock-1)*nx_block*ny_block - do j=jb,je - do i=ib,ie - n = n + 1 - ! eliminate redundant points - if (maxiglob > 0 .and. j == je .and. this_block%i_glob(i) > maxiglob) then - work(n,1) = 0._dbl_kind - else - if (present(mMask)) then - work(n,1) = array(i,j,iblock)*mMask(i,j,iblock) - else if (present(lMask)) then - if (lMask(i,j,iblock)) then - work(n,1) = array(i,j,iblock) - endif - else + if (present(mMask)) then + do j=jb,je + do i=ib,ie + n = n + 1 + work(n,1) = array(i,j,iblock)*mMask(i,j,iblock) + end do + end do + elseif (present(lMask)) then + do j=jb,je + do i=ib,ie + n = n + 1 + if (lMask(i,j,iblock)) then work(n,1) = array(i,j,iblock) endif - endif - end do - end do + end do + end do + else + do j=jb,je + do i=ib,ie + n = n + 1 + work(n,1) = array(i,j,iblock) + enddo + enddo + endif + + if (maxiglob >= 0) then + ! eliminate redundant points at je + ! set n to (ib,je) index + n = (iblock-1)*nx_block*ny_block + n = n + (je-1-jb+1)*(ie-ib+1) + j=je + do i=ib,ie + n = n + 1 + if (this_block%i_glob(i) > maxiglob) then + work(n,1) = 0._dbl_kind + endif + end do + endif + end do call compute_sums_dbl(work,sums,communicator,numProcs) @@ -318,7 +338,7 @@ function global_sum_real(array, dist, field_loc, mMask, lMask) & if (Nrow .and. this_block%tripoleTFlag) then maxiglob = 0 ! entire u-row on T-fold grid elseif (Nrow .or. this_block%tripoleTFlag) then - maxiglob = nx_global/2 ! half T-row on T-fold and u-row on u-fold + maxiglob = nx_global/2 ! half T-row on T-fold or half u-row on u-fold else maxiglob = -1 ! nothing to do for T-row on u-fold endif @@ -326,25 +346,45 @@ function global_sum_real(array, dist, field_loc, mMask, lMask) & n = (iblock-1)*nx_block*ny_block - do j=jb,je - do i=ib,ie - n = n + 1 - ! eliminate redundant points - if (maxiglob > 0 .and. j == je .and. this_block%i_glob(i) > maxiglob) then - work(n,1) = 0._dbl_kind - else - if (present(mMask)) then - work(n,1) = real(array(i,j,iblock)*mMask(i,j,iblock),dbl_kind) - else if (present(lMask)) then - if (lMask(i,j,iblock)) then - work(n,1) = real(array(i,j,iblock),dbl_kind) - endif - else + if (present(mMask)) then + do j=jb,je + do i=ib,ie + n = n + 1 + work(n,1) = real(array(i,j,iblock)*mMask(i,j,iblock),dbl_kind) + end do + end do + elseif (present(lMask)) then + do j=jb,je + do i=ib,ie + n = n + 1 + if (lMask(i,j,iblock)) then work(n,1) = real(array(i,j,iblock),dbl_kind) endif - endif - end do - end do + end do + end do + else + do j=jb,je + do i=ib,ie + n = n + 1 + work(n,1) = real(array(i,j,iblock),dbl_kind) + enddo + enddo + endif + + if (maxiglob >= 0) then + ! eliminate redundant points at je + ! set n to (ib,je) index + n = (iblock-1)*nx_block*ny_block + n = n + (je-1-jb+1)*(ie-ib+1) + j=je + do i=ib,ie + n = n + 1 + if (this_block%i_glob(i) > maxiglob) then + work(n,1) = 0._dbl_kind + endif + end do + endif + end do call compute_sums_dbl(work,sums,communicator,numProcs) @@ -446,7 +486,7 @@ function global_sum_int(array, dist, field_loc, mMask, lMask) & if (Nrow .and. this_block%tripoleTFlag) then maxiglob = 0 ! entire u-row on T-fold grid elseif (Nrow .or. this_block%tripoleTFlag) then - maxiglob = nx_global/2 ! half T-row on T-fold and u-row on u-fold + maxiglob = nx_global/2 ! half T-row on T-fold or half u-row on u-fold else maxiglob = -1 ! nothing to do for T-row on u-fold endif @@ -457,7 +497,7 @@ function global_sum_int(array, dist, field_loc, mMask, lMask) & do j=jb,je do i=ib,ie ! eliminate redundant points - if (maxiglob > 0 .and. j == je .and. this_block%i_glob(i) > maxiglob) then + if (maxiglob >= 0 .and. j == je .and. this_block%i_glob(i) > maxiglob) then ! blockSum = blockSum + 0_int_kind else if (present(mMask)) then @@ -799,7 +839,7 @@ function global_sum_prod_dbl (array1, array2, dist, field_loc, & if (Nrow .and. this_block%tripoleTFlag) then maxiglob = 0 ! entire u-row on T-fold grid elseif (Nrow .or. this_block%tripoleTFlag) then - maxiglob = nx_global/2 ! half T-row on T-fold and u-row on u-fold + maxiglob = nx_global/2 ! half T-row on T-fold or half u-row on u-fold else maxiglob = -1 ! nothing to do for T-row on u-fold endif @@ -807,25 +847,45 @@ function global_sum_prod_dbl (array1, array2, dist, field_loc, & n = (iblock-1)*nx_block*ny_block - do j=jb,je - do i=ib,ie - n = n + 1 - ! eliminate redundant points - if (maxiglob > 0 .and. j == je .and. this_block%i_glob(i) > maxiglob) then - work(n,1) = 0._dbl_kind - else - if (present(mMask)) then - work(n,1) = array1(i,j,iblock)*array2(i,j,iblock)*mMask(i,j,iblock) - else if (present(lMask)) then - if (lMask(i,j,iblock)) then - work(n,1) = array1(i,j,iblock)*array2(i,j,iblock) - endif - else + if (present(mMask)) then + do j=jb,je + do i=ib,ie + n = n + 1 + work(n,1) = array1(i,j,iblock)*array2(i,j,iblock)*mMask(i,j,iblock) + end do + end do + elseif (present(lMask)) then + do j=jb,je + do i=ib,ie + n = n + 1 + if (lMask(i,j,iblock)) then work(n,1) = array1(i,j,iblock)*array2(i,j,iblock) endif - endif - end do - end do + end do + end do + else + do j=jb,je + do i=ib,ie + n = n + 1 + work(n,1) = array1(i,j,iblock)*array2(i,j,iblock) + enddo + enddo + endif + + if (maxiglob >= 0) then + ! eliminate redundant points at je + ! set n to (ib,je) index + n = (iblock-1)*nx_block*ny_block + n = n + (je-1-jb+1)*(ie-ib+1) + j=je + do i=ib,ie + n = n + 1 + if (this_block%i_glob(i) > maxiglob) then + work(n,1) = 0._dbl_kind + endif + end do + endif + end do call compute_sums_dbl(work,sums,communicator,numProcs) @@ -937,7 +997,7 @@ function global_sum_prod_real (array1, array2, dist, field_loc, & if (Nrow .and. this_block%tripoleTFlag) then maxiglob = 0 ! entire u-row on T-fold grid elseif (Nrow .or. this_block%tripoleTFlag) then - maxiglob = nx_global/2 ! half T-row on T-fold and u-row on u-fold + maxiglob = nx_global/2 ! half T-row on T-fold or half u-row on u-fold else maxiglob = -1 ! nothing to do for T-row on u-fold endif @@ -945,25 +1005,45 @@ function global_sum_prod_real (array1, array2, dist, field_loc, & n = (iblock-1)*nx_block*ny_block - do j=jb,je - do i=ib,ie - n = n + 1 - ! eliminate redundant points - if (maxiglob > 0 .and. j == je .and. this_block%i_glob(i) > maxiglob) then - work(n,1) = 0._dbl_kind - else - if (present(mMask)) then - work(n,1) = real(array1(i,j,iblock)*array2(i,j,iblock)*mMask(i,j,iblock),dbl_kind) - else if (present(lMask)) then - if (lMask(i,j,iblock)) then - work(n,1) = real(array1(i,j,iblock)*array2(i,j,iblock),dbl_kind) - endif - else + if (present(mMask)) then + do j=jb,je + do i=ib,ie + n = n + 1 + work(n,1) = real(array1(i,j,iblock)*array2(i,j,iblock)*mMask(i,j,iblock),dbl_kind) + end do + end do + elseif (present(lMask)) then + do j=jb,je + do i=ib,ie + n = n + 1 + if (lMask(i,j,iblock)) then work(n,1) = real(array1(i,j,iblock)*array2(i,j,iblock),dbl_kind) endif - endif - end do - end do + end do + end do + else + do j=jb,je + do i=ib,ie + n = n + 1 + work(n,1) = real(array1(i,j,iblock)*array2(i,j,iblock),dbl_kind) + enddo + enddo + endif + + if (maxiglob >= 0) then + ! eliminate redundant points at je + ! set n to (ib,je) index + n = (iblock-1)*nx_block*ny_block + n = n + (je-1-jb+1)*(ie-ib+1) + j=je + do i=ib,ie + n = n + 1 + if (this_block%i_glob(i) > maxiglob) then + work(n,1) = 0._dbl_kind + endif + end do + endif + end do call compute_sums_dbl(work,sums,communicator,numProcs) @@ -1067,7 +1147,7 @@ function global_sum_prod_int (array1, array2, dist, field_loc, & if (Nrow .and. this_block%tripoleTFlag) then maxiglob = 0 ! entire u-row on T-fold grid elseif (Nrow .or. this_block%tripoleTFlag) then - maxiglob = nx_global/2 ! half T-row on T-fold and u-row on u-fold + maxiglob = nx_global/2 ! half T-row on T-fold or half u-row on u-fold else maxiglob = -1 ! nothing to do for T-row on u-fold endif @@ -1078,7 +1158,7 @@ function global_sum_prod_int (array1, array2, dist, field_loc, & do j=jb,je do i=ib,ie ! eliminate redundant points - if (maxiglob > 0 .and. j == je .and. this_block%i_glob(i) > maxiglob) then + if (maxiglob >= 0 .and. j == je .and. this_block%i_glob(i) > maxiglob) then ! blockSum = blockSum + 0_int_kind else if (present(mMask)) then diff --git a/cicecore/cicedyn/infrastructure/ice_domain.F90 b/cicecore/cicedyn/infrastructure/ice_domain.F90 index ff1fac723..06d0d8ae1 100644 --- a/cicecore/cicedyn/infrastructure/ice_domain.F90 +++ b/cicecore/cicedyn/infrastructure/ice_domain.F90 @@ -172,7 +172,7 @@ subroutine init_domain_blocks if (my_task == master_task) then nml_name = 'domain_nml' write(nu_diag,*) subname,' Reading ', trim(nml_name) - + call get_fileunit(nu_nml) open (nu_nml, file=trim(nml_filename), status='old',iostat=nml_error) if (nml_error /= 0) then @@ -186,7 +186,7 @@ subroutine init_domain_blocks call abort_ice(subname//'ERROR: searching for '// trim(nml_name), & file=__FILE__, line=__LINE__) endif - + nml_error = 1 do while (nml_error > 0) read(nu_nml, nml=domain_nml,iostat=nml_error) diff --git a/cicecore/cicedyn/infrastructure/io/io_binary/ice_history_write.F90 b/cicecore/cicedyn/infrastructure/io/io_binary/ice_history_write.F90 index 9df51635d..526d0d96d 100644 --- a/cicecore/cicedyn/infrastructure/io/io_binary/ice_history_write.F90 +++ b/cicecore/cicedyn/infrastructure/io/io_binary/ice_history_write.F90 @@ -157,7 +157,7 @@ subroutine ice_write_hist(ns) write (nu_hdr, 995) nrec,trim(avail_hist_fields(n)%vname), & trim(avail_hist_fields(n)%vcomment) - if (histfreq(ns) == '1' .or. .not. hist_avg & + if (histfreq(ns) == '1' .or. .not. hist_avg(ns) & .or. write_ic & .or. n==n_divu(ns) .or. n==n_shear(ns) & ! snapshots .or. n==n_sig1(ns) .or. n==n_sig2(ns) & @@ -187,7 +187,7 @@ subroutine ice_write_hist(ns) write (nu_hdr, 994) nrec,trim(avail_hist_fields(n)%vname), & trim(avail_hist_fields(n)%vdesc),trim(avail_hist_fields(n)%vunit),nn - if (histfreq(ns) == '1' .or. .not. hist_avg .or. write_ic) then + if (histfreq(ns) == '1' .or. .not. hist_avg(ns) .or. write_ic) then write (nu_hdr, 996) nrec,trim(avail_hist_fields(n)%vname), & 'time_rep','instantaneous' else @@ -211,7 +211,7 @@ subroutine ice_write_hist(ns) write (nu_hdr, 993) nrec,trim(avail_hist_fields(n)%vname), & trim(avail_hist_fields(n)%vdesc),trim(avail_hist_fields(n)%vunit),k - if (histfreq(ns) == '1' .or. .not. hist_avg .or. write_ic) then + if (histfreq(ns) == '1' .or. .not. hist_avg(ns) .or. write_ic) then write (nu_hdr, 996) nrec,trim(avail_hist_fields(n)%vname), & 'time_rep','instantaneous' else @@ -235,7 +235,7 @@ subroutine ice_write_hist(ns) write (nu_hdr, 993) nrec,trim(avail_hist_fields(n)%vname), & trim(avail_hist_fields(n)%vdesc),trim(avail_hist_fields(n)%vunit),nn,k - if (histfreq(ns) == '1' .or. .not. hist_avg .or. write_ic) then + if (histfreq(ns) == '1' .or. .not. hist_avg(ns) .or. write_ic) then write (nu_hdr, 996) nrec,trim(avail_hist_fields(n)%vname), & 'time_rep','instantaneous' else @@ -259,7 +259,7 @@ subroutine ice_write_hist(ns) write (nu_hdr, 993) nrec,trim(avail_hist_fields(n)%vname), & trim(avail_hist_fields(n)%vdesc),trim(avail_hist_fields(n)%vunit),nn,k - if (histfreq(ns) == '1' .or. .not. hist_avg .or. write_ic) then + if (histfreq(ns) == '1' .or. .not. hist_avg(ns) .or. write_ic) then write (nu_hdr, 996) nrec,trim(avail_hist_fields(n)%vname), & 'time_rep','instantaneous' else @@ -283,7 +283,7 @@ subroutine ice_write_hist(ns) write (nu_hdr, 993) nrec,trim(avail_hist_fields(n)%vname), & trim(avail_hist_fields(n)%vdesc),trim(avail_hist_fields(n)%vunit),nn,k - if (histfreq(ns) == '1' .or. .not. hist_avg .or. write_ic) then + if (histfreq(ns) == '1' .or. .not. hist_avg(ns) .or. write_ic) then write (nu_hdr, 996) nrec,trim(avail_hist_fields(n)%vname), & 'time_rep','instantaneous' else @@ -308,7 +308,7 @@ subroutine ice_write_hist(ns) write (nu_hdr, 993) nrec,trim(avail_hist_fields(n)%vname), & trim(avail_hist_fields(n)%vdesc),trim(avail_hist_fields(n)%vunit),nn,k - if (histfreq(ns) == '1' .or. .not. hist_avg .or. write_ic) then + if (histfreq(ns) == '1' .or. .not. hist_avg(ns) .or. write_ic) then write (nu_hdr, 996) nrec,trim(avail_hist_fields(n)%vname), & 'time_rep','instantaneous' else @@ -334,7 +334,7 @@ subroutine ice_write_hist(ns) write (nu_hdr, 993) nrec,trim(avail_hist_fields(n)%vname), & trim(avail_hist_fields(n)%vdesc),trim(avail_hist_fields(n)%vunit),nn,k - if (histfreq(ns) == '1' .or. .not. hist_avg .or. write_ic) then + if (histfreq(ns) == '1' .or. .not. hist_avg(ns) .or. write_ic) then write (nu_hdr, 996) nrec,trim(avail_hist_fields(n)%vname), & 'time_rep','instantaneous' else @@ -360,7 +360,7 @@ subroutine ice_write_hist(ns) write (nu_hdr, 993) nrec,trim(avail_hist_fields(n)%vname), & trim(avail_hist_fields(n)%vdesc),trim(avail_hist_fields(n)%vunit),nn,k - if (histfreq(ns) == '1' .or. .not. hist_avg .or. write_ic) then + if (histfreq(ns) == '1' .or. .not. hist_avg(ns) .or. write_ic) then write (nu_hdr, 996) nrec,trim(avail_hist_fields(n)%vname), & 'time_rep','instantaneous' else diff --git a/cicecore/cicedyn/infrastructure/io/io_netcdf/ice_history_write.F90 b/cicecore/cicedyn/infrastructure/io/io_netcdf/ice_history_write.F90 index 10d750300..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 @@ -137,8 +137,6 @@ subroutine ice_write_hist (ns) if (my_task == master_task) then - ltime2 = timesecs/secday - call construct_filename(ncfile(ns),'nc',ns) ! add local directory path name to ncfile @@ -159,10 +157,10 @@ subroutine ice_write_hist (ns) ! define dimensions !----------------------------------------------------------------- - if (hist_avg .and. .not. write_ic) then - status = nf90_def_dim(ncid,'d2',2,boundid) + if (hist_avg(ns) .and. .not. write_ic) then + status = nf90_def_dim(ncid,'nbnd',2,boundid) if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: defining dim d2') + 'ERROR: defining dim nbnd') endif status = nf90_def_dim(ncid,'ni',nx_global,imtid) @@ -213,7 +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') @@ -230,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 @@ -241,7 +239,7 @@ subroutine ice_write_hist (ns) call abort_ice(subname//'ERROR: invalid calendar settings') endif - if (hist_avg .and. .not. write_ic) then + if (hist_avg(ns) .and. .not. write_ic) then status = nf90_put_att(ncid,varid,'bounds','time_bounds') if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: time bounds') @@ -251,14 +249,14 @@ subroutine ice_write_hist (ns) ! Define attributes for time bounds if hist_avg is true !----------------------------------------------------------------- - if (hist_avg .and. .not. write_ic) then + if (hist_avg(ns) .and. .not. write_ic) then dimid(1) = boundid dimid(2) = timid status = nf90_def_var(ncid,'time_bounds',lprecision,dimid(1:2),varid) if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: defining var time_bounds') status = nf90_put_att(ncid,varid,'long_name', & - 'boundaries for time-averaging interval') + 'time interval endpoints') if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: time_bounds long_name') write(cdate,'(i8.8)') idate0 @@ -268,6 +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 !----------------------------------------------------------------- @@ -702,6 +716,12 @@ subroutine ice_write_hist (ns) 'ERROR: global attribute time_period_freq') endif + if (hist_avg(ns)) then + status = nf90_put_att(ncid,nf90_global,'time_axis_position',trim(hist_time_axis)) + if (status /= nf90_noerr) call abort_ice(subname// & + 'ERROR: global attribute time axis position') + endif + title = 'CF-1.0' status = & nf90_put_att(ncid,nf90_global,'conventions',title) @@ -734,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') @@ -745,7 +774,7 @@ subroutine ice_write_hist (ns) ! write time_bounds info !----------------------------------------------------------------- - if (hist_avg .and. .not. write_ic) then + if (hist_avg(ns) .and. .not. write_ic) then status = nf90_inq_varid(ncid,'time_bounds',varid) if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: getting time_bounds id') @@ -1279,7 +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 .and. .not. write_ic) then + if (hist_avg(ns) .and. .not. write_ic) then if (TRIM(hfield%vname(1:4))/='sig1' & .and.TRIM(hfield%vname(1:4))/='sig2' & .and.TRIM(hfield%vname(1:9))/='sistreave' & @@ -1292,7 +1321,7 @@ subroutine ice_write_hist_attrs(ncid, varid, hfield, ns) endif if ((histfreq(ns) == '1' .and. histfreq_n(ns) == 1) & - .or..not. hist_avg & + .or..not. hist_avg(ns) & .or. write_ic & .or.TRIM(hfield%vname(1:4))=='divu' & .or.TRIM(hfield%vname(1:5))=='shear' & diff --git a/cicecore/cicedyn/infrastructure/io/io_pio2/ice_history_write.F90 b/cicecore/cicedyn/infrastructure/io/io_pio2/ice_history_write.F90 index 25f9850ce..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 @@ -185,8 +185,6 @@ subroutine ice_write_hist (ns) call ice_pio_initdecomp(ndim3=nzslyr, ndim4=ncat_hist, iodesc=iodesc4ds, precision=history_precision) call ice_pio_initdecomp(ndim3=nfsd_hist, ndim4=ncat_hist, iodesc=iodesc4df, precision=history_precision) - ltime2 = timesecs/secday - ! option of turning on double precision history files lprecision = pio_real if (history_precision == 8) lprecision = pio_double @@ -195,8 +193,8 @@ subroutine ice_write_hist (ns) ! define dimensions !----------------------------------------------------------------- - if (hist_avg .and. .not. write_ic) then - status = pio_def_dim(File,'d2',2,boundid) + if (hist_avg(ns) .and. .not. write_ic) then + status = pio_def_dim(File,'nbnd',2,boundid) endif status = pio_def_dim(File,'ni',nx_global,imtid) @@ -215,7 +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 ', & @@ -226,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 .and. .not. write_ic) then + if (hist_avg(ns) .and. .not. write_ic) then status = pio_put_att(File,varid,'bounds','time_bounds') endif ! Define attributes for time_bounds if hist_avg is true - if (hist_avg .and. .not. write_ic) then + if (hist_avg(ns) .and. .not. write_ic) then dimid2(1) = boundid dimid2(2) = timid status = pio_def_var(File,'time_bounds',pio_double,dimid2,varid) status = pio_put_att(File,varid,'long_name', & - 'boundaries for time-averaging interval') + 'time interval endpoints') + + if (days_per_year == 360) then + status = pio_put_att(File,varid,'calendar','360_day') + elseif (days_per_year == 365 .and. .not.use_leap_years ) then + status = pio_put_att(File,varid,'calendar','noleap') + elseif (use_leap_years) then + status = pio_put_att(File,varid,'calendar','Gregorian') + else + call abort_ice(subname//'ERROR: invalid calendar settings') + endif + write(cdate,'(i8.8)') idate0 write(title,'(a,a4,a1,a2,a1,a2,a1,i2.2,a1,i2.2,a1,i2.2)') 'days since ', & cdate(1:4),'-',cdate(5:6),'-',cdate(7:8),' ', & @@ -667,6 +676,9 @@ subroutine ice_write_hist (ns) status = pio_put_att(File,pio_global,'time_period_freq',trim(time_period_freq)) endif + if (hist_avg(ns)) & + status = pio_put_att(File,pio_global,'time_axis_position',trim(hist_time_axis)) + title = 'CF-1.0' status = & pio_put_att(File,pio_global,'conventions',trim(title)) @@ -695,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) @@ -702,7 +723,7 @@ subroutine ice_write_hist (ns) ! write time_bounds info !----------------------------------------------------------------- - if (hist_avg .and. .not. write_ic) then + if (hist_avg(ns) .and. .not. write_ic) then status = pio_inq_varid(File,'time_bounds',varid) time_bounds=(/time_beg(ns),time_end(ns)/) bnd_start = (/1,1/) @@ -1250,7 +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 .and. .not. write_ic) then + if (hist_avg(ns) .and. .not. write_ic) then if (TRIM(hfield%vname(1:4))/='sig1' & .and.TRIM(hfield%vname(1:4))/='sig2' & .and.TRIM(hfield%vname(1:9))/='sistreave' & @@ -1261,7 +1282,7 @@ subroutine ice_write_hist_attrs(File, varid, hfield, ns) endif if ((histfreq(ns) == '1' .and. histfreq_n(ns) == 1) & - .or..not. hist_avg & + .or..not. hist_avg(ns) & .or. write_ic & .or.TRIM(hfield%vname(1:4))=='divu' & .or.TRIM(hfield%vname(1:5))=='shear' & diff --git a/cicecore/drivers/nuopc/cmeps/ice_mesh_mod.F90 b/cicecore/drivers/nuopc/cmeps/ice_mesh_mod.F90 index a9b19df6b..601e59c7c 100644 --- a/cicecore/drivers/nuopc/cmeps/ice_mesh_mod.F90 +++ b/cicecore/drivers/nuopc/cmeps/ice_mesh_mod.F90 @@ -559,7 +559,7 @@ subroutine ice_mesh_check(gcomp, ice_mesh, rc) ! Check CICE mesh - use ice_constants, only : c1,c0,c360 + use ice_constants, only : c1,c0,c180,c360 use ice_grid , only : tlon, tlat, hm ! input/output parameters @@ -583,7 +583,7 @@ subroutine ice_mesh_check(gcomp, ice_mesh, rc) real(dbl_kind) :: diff_lon real(dbl_kind) :: diff_lat real(dbl_kind) :: rad_to_deg - real(dbl_kind) :: tmplon, eps_imesh + real(dbl_kind) :: eps_imesh logical :: isPresent, isSet logical :: mask_error integer :: mask_internal @@ -637,19 +637,19 @@ subroutine ice_mesh_check(gcomp, ice_mesh, rc) lon(n) = tlon(i,j,iblk)*rad_to_deg lat(n) = tlat(i,j,iblk)*rad_to_deg - tmplon = lon(n) - if(tmplon < c0)tmplon = tmplon + c360 - ! error check differences between internally generated lons and those read in - diff_lon = abs(mod(lonMesh(n) - tmplon,360.0)) - if (diff_lon > eps_imesh ) then - write(6,100)n,lonMesh(n),tmplon, diff_lon - !call abort_ice(error_message=subname, file=__FILE__, line=__LINE__) + diff_lon = mod(abs(lonMesh(n) - lon(n)),360.0) + if (diff_lon > c180) then + diff_lon = diff_lon - c360 + endif + if (abs(diff_lon) > eps_imesh ) then + write(6,100)n,lonMesh(n),lon(n), diff_lon + call abort_ice(error_message=subname, file=__FILE__, line=__LINE__) end if diff_lat = abs(latMesh(n) - lat(n)) if (diff_lat > eps_imesh) then write(6,101)n,latMesh(n),lat(n), diff_lat - !call abort_ice(error_message=subname, file=__FILE__, line=__LINE__) + call abort_ice(error_message=subname, file=__FILE__, line=__LINE__) end if enddo enddo diff --git a/cicecore/drivers/unittest/optargs/optargs.F90 b/cicecore/drivers/unittest/optargs/optargs.F90 index 4acf7ac9f..5d66539b9 100644 --- a/cicecore/drivers/unittest/optargs/optargs.F90 +++ b/cicecore/drivers/unittest/optargs/optargs.F90 @@ -1,45 +1,52 @@ program optargs - use optargs_subs, only: computeA, computeB, computeC, computeD - use optargs_subs, only: oa_error, oa_OK, oa_A, oa_B, oa_C, oa_D + use optargs_subs, only: dp + use optargs_subs, only: computeA, computeB, computeC, computeD, computeE + use optargs_subs, only: oa_error, oa_OK, oa_A, oa_B, oa_C, oa_D, oa_E use optargs_subs, only: oa_layer1, oa_count1 implicit none - real*8 :: Ai1, Ao - real*8 :: B - real*8 :: Ci1, Co - real*8 :: Di1, Di2, Do + real(dp):: Ai1, Ao + real(dp):: B + real(dp):: Ci1, Co + real(dp):: Di1, Di2, Do + real(dp), allocatable :: Ei(:),Eo(:) integer :: ierr, ierrV integer :: n integer, parameter :: ntests = 100 integer :: iresult - real*8 :: result, resultV - real*8, parameter :: errtol = 1.0e-12 + real(dp):: result, resultV + real(dp), parameter :: dpic = -99._dp + real(dp), parameter :: errtol = 1.0e-12 !---------------------- write(6,*) 'RunningUnitTest optargs' write(6,*) ' ' + allocate(Ei(3),Eo(3)) + iresult = 0 do n = 1,ntests - Ai1 = -99.; Ao = -99. - B = -99. - Ci1 = -99.; Co = -99. - Di1 = -99.; Di2 = -99.; Do = -99. + Ai1 = dpic; Ao = dpic + B = dpic + Ci1 = dpic; Co = dpic + Di1 = dpic; Di2 = dpic; Do = dpic + Ei = dpic; Eo = dpic ierr = oa_error - result = -888. - resultV = -999. + result = -888._dp + resultV = -999._dp computeA = .false. computeB = .false. computeC = .false. computeD = .false. + computeE = .false. select case (n) @@ -56,8 +63,8 @@ program optargs call oa_count1(Ai1=Ai1,Ao=Ao,B=B,Ci1=Ci1,Co=Co,Di1=Di1,Di2=Di2,Do=Do,ierr=ierr) case(2) result = -777.; resultV = -777. - ierrV = 9 - call oa_count1(Ai1,Ao,B,Ci1,Co,Di1,Di2,Do,ierr) + ierrV = 11 + call oa_count1(Ai1,Ao,B,Ci1,Co,Di1,Di2,Do,Ei,Eo,ierr) case(3) result = -777.; resultV = -777. ierrV = 3 @@ -66,6 +73,10 @@ program optargs result = -777.; resultV = -777. ierrV = 5 call oa_count1(Ci1=Ci1,Co=Co,ierr=ierr,Ao=Ao,Di1=Di1) + case(5) + result = -777.; resultV = -777. + ierrV = 8 + call oa_count1(Ai1,Ao,B,Ci1,Co,Di1,Di2,ierr=ierr) ! test optional order case(11) @@ -80,6 +91,10 @@ program optargs result = -777.; resultV = -777. ierrV = oa_OK call oa_layer1(Ci1=Ci1,Co=Co,ierr=ierr,Ao=Ao,Di1=Di1) + case(14) + result = -777.; resultV = -777. + ierrV = oa_OK + call oa_layer1(Eo=Eo,Ei=Ei,Ci1=Ci1,Co=Co,ierr=ierr,Ao=Ao,Di1=Di1) ! test optional argument checking case(21) @@ -87,15 +102,17 @@ program optargs computeB = .true. computeC = .true. computeD = .true. + computeE = .true. result = -777.; resultV = -777. ierrV = oa_error ! B missing - call oa_layer1(Ai1=Ai1,Ao=Ao,Ci1=Ci1,Co=Co,Di1=Di1,Di2=Di2,Do=Do,ierr=ierr) + call oa_layer1(Ai1=Ai1,Ao=Ao,Ci1=Ci1,Co=Co,Di1=Di1,Di2=Di2,Do=Do,Ei=Ei,Eo=Eo,ierr=ierr) case(22) computeA = .true. computeB = .true. computeC = .true. computeD = .true. + computeE = .true. result = -777.; resultV = -777. ierrV = oa_error ! all optional missing @@ -105,61 +122,117 @@ program optargs computeB = .true. computeC = .true. computeD = .true. + computeE = .true. result = -777.; resultV = -777. ierrV = oa_error ! some optional missing - call oa_layer1(Ci1=Ci1,Co=Co,ierr=ierr,B=B,Ao=Ao,Di1=Di1) + call oa_layer1(Ci1=Ci1,Co=Co,Eo=Eo,ierr=ierr,B=B,Ao=Ao,Di1=Di1) case(24) computeA = .true. computeB = .true. computeC = .true. computeD = .true. + computeE = .true. result = -777.; resultV = -777. ierrV = oa_error ! one optional missing - call oa_layer1(Ai1=Ai1,Ao=Ao,B=B,Ci1=Ci1,Co=Co,Di1=Di1,Do=Do,ierr=ierr) + call oa_layer1(Ai1=Ai1,Ao=Ao,B=B,Ci1=Ci1,Co=Co,Di1=Di1,Do=Do,Ei=Ei,Eo=Eo,ierr=ierr) + case(25) + computeA = .true. + computeB = .true. + computeC = .true. + computeD = .true. + computeE = .true. + result = -777.; resultV = -777. + ierrV = oa_error + ! Ei missing + call oa_layer1(Ai1=Ai1,Ao=Ao,B=B,Ci1=Ci1,Co=Co,Di1=Di1,Di2=Di2,Do=Do,Eo=Eo,ierr=ierr) - ! test computations individually + ! test computations individually, all args case(31) computeA = .true. ierrV = oa_A Ai1 = 5. resultV = 4. - call oa_layer1(Ai1=Ai1,Ao=Ao,B=B,Ci1=Ci1,Co=Co,Di1=Di1,Di2=Di2,Do=Do,ierr=ierr) + call oa_layer1(Ai1=Ai1,Ao=Ao,B=B,Ci1=Ci1,Co=Co,Di1=Di1,Di2=Di2,Do=Do,Ei=Ei,Eo=Eo,ierr=ierr) result = Ao case(32) computeB = .true. ierrV = oa_B B = 15. resultV = 20. - call oa_layer1(ierr=ierr,Ai1=Ai1,Ao=Ao,B=B,Ci1=Ci1,Co=Co,Di1=Di1,Di2=Di2,Do=Do) + call oa_layer1(ierr=ierr,Ai1=Ai1,Ao=Ao,B=B,Ci1=Ci1,Co=Co,Di1=Di1,Di2=Di2,Do=Do,Ei=Ei,Eo=Eo) result = B case(33) computeC = .true. ierrV = oa_C Ci1 = 7. resultV = 14. - call oa_layer1(B=B,Ci1=Ci1,Co=Co,Di1=Di1,Ai1=Ai1,Ao=Ao,Di2=Di2,Do=Do,ierr=ierr) + call oa_layer1(B=B,Ci1=Ci1,Co=Co,Di1=Di1,Ai1=Ai1,Ao=Ao,Di2=Di2,Do=Do,ierr=ierr,Ei=Ei,Eo=Eo) result = Co case(34) computeD = .true. ierrV = oa_D Di1 = 19; Di2=11. resultV = 30. - call oa_layer1(Ai1=Ai1,Ao=Ao,Ci1=Ci1,Co=Co,Di1=Di1,Di2=Di2,Do=Do,B=B,ierr=ierr) + call oa_layer1(Ai1=Ai1,Ao=Ao,Ci1=Ci1,Co=Co,Di1=Di1,Ei=Ei,Eo=Eo,Di2=Di2,Do=Do,B=B,ierr=ierr) result = Do + case(35) + computeE = .true. + ierrV = oa_E + Ei = 25. + resultV = 81. + call oa_layer1(Ai1=Ai1,Ao=Ao,Ci1=Ci1,Co=Co,Ei=Ei,Eo=Eo,Di1=Di1,Di2=Di2,Do=Do,B=B,ierr=ierr) + result = sum(Eo) - ! test computations individually + ! test computations individually, min args case(41) + computeA = .true. + ierrV = oa_A + Ai1 = 5. + resultV = 4. + call oa_layer1(Ao=Ao,Co=Co,Ai1=Ai1,Ci1=Ci1,ierr=ierr) + result = Ao + case(42) + computeB = .true. + ierrV = oa_B + B = 15. + resultV = 20. + call oa_layer1(ierr=ierr,Ci1=Ci1,Co=Co,B=B) + result = B + case(43) + computeC = .true. + ierrV = oa_C + Ci1 = 7. + resultV = 14. + call oa_layer1(Ci1=Ci1,Co=Co,ierr=ierr) + result = Co + case(44) + computeD = .true. + ierrV = oa_D + Di1 = 19; Di2=11. + resultV = 30. + call oa_layer1(Ci1=Ci1,Di1=Di1,Di2=Di2,Co=Co,Do=Do,ierr=ierr) + result = Do + case(45) + computeE = .true. + ierrV = oa_E + Ei = 25. + resultV = 81. + call oa_layer1(Ci1=Ci1,Co=Co,Ei=Ei,Eo=Eo,ierr=ierr) + result = sum(Eo) + + ! test computations in groups, mix of passed arguments + case(51) computeA = .true. computeC = .true. ierrV = oa_A + oa_C Ai1 = 6. Ci1 = 8. resultV = 21. - call oa_layer1(Ai1=Ai1,Ao=Ao,B=B,Ci1=Ci1,Co=Co,Di1=Di1,Di2=Di2,Do=Do,ierr=ierr) + call oa_layer1(Ai1=Ai1,Ao=Ao,B=B,Ci1=Ci1,Co=Co,Eo=Eo,ierr=ierr) result = Ao + Co - case(42) + case(52) computeB = .true. computeC = .true. ierrV = oa_B + oa_C @@ -168,7 +241,7 @@ program optargs resultV = -11. call oa_layer1(ierr=ierr,Ai1=Ai1,Ao=Ao,B=B,Ci1=Ci1,Co=Co,Di1=Di1,Di2=Di2,Do=Do) result = B + Co - case(43) + case(53) computeB = .true. computeD = .true. ierrV = oa_B + oa_D @@ -177,7 +250,7 @@ program optargs resultV = 31. call oa_layer1(B=B,Ci1=Ci1,Co=Co,Di1=Di1,Ai1=Ai1,Ao=Ao,Di2=Di2,Do=Do,ierr=ierr) result = B + Do - case(44) + case(54) computeC = .true. computeD = .true. ierrV = oa_C + oa_D @@ -186,20 +259,22 @@ program optargs resultV = 27. call oa_layer1(Ai1=Ai1,Ao=Ao,Ci1=Ci1,Co=Co,Di1=Di1,Di2=Di2,Do=Do,B=B,ierr=ierr) result = Co + Do - case(45) + case(55) computeA = .true. computeB = .true. computeC = .true. computeD = .true. - ierrV = oa_A + oa_B + oa_C + oa_D + computeE = .true. + ierrV = oa_A + oa_B + oa_C + oa_D + oa_E Ai1 = 7. B = 9. Ci1 = 7. Di1 = 12; Di2=3. - resultV = 49. - call oa_layer1(Ao=Ao,B=B,Co=Co,Do=Do,Ai1=Ai1,Ci1=Ci1,Di1=Di1,Di2=Di2,ierr=ierr) - result = Ao + B + Co + Do - case(46) + Ei = 5 + resultV = 70. + call oa_layer1(Ao=Ao,B=B,Co=Co,Do=Do,Ai1=Ai1,Ci1=Ci1,Di1=Di1,Di2=Di2,Ei=Ei,Eo=Eo,ierr=ierr) + result = Ao + B + Co + Do + sum(Eo) + case(56) computeA = .true. computeB = .true. computeD = .true. @@ -210,6 +285,15 @@ program optargs resultV = 40. call oa_layer1(Ao=Ao,B=B,Co=Co,Do=Do,Ai1=Ai1,Ci1=Ci1,Di1=Di1,Di2=Di2,ierr=ierr) result = Ao + B + Do + case(57) + computeB = .true. + computeE = .true. + ierrV = oa_B + oa_E + B = 4. + Ei = 8. + resultV = 39. + call oa_layer1(B=B,Ci1=Ci1,Co=Co,Di1=Di1,Ai1=Ai1,Ao=Ao,Di2=Di2,Do=Do,Ei=Ei,Eo=Eo,ierr=ierr) + result = B + sum(Eo) case DEFAULT ierr = -1234 @@ -219,10 +303,10 @@ program optargs ! skip -1234 if (ierr /= -1234) then if (ierr == ierrV .and. abs(result-resultV) < errtol ) then - write(6,101) 'PASS','optarg test',n,ierr,ierrV,result,resultV,Ao,B,Co,Do + write(6,101) 'PASS','optarg test',n,ierr,ierrV,result,resultV,Ao,B,Co,Do,sum(Eo) ! write(6,101) 'PASS','optarg test',n,ierr,ierrV,result,resultV else - write(6,101) 'FAIL','optarg test',n,ierr,ierrV,result,resultV,Ao,B,Co,Do + write(6,101) 'FAIL','optarg test',n,ierr,ierrV,result,resultV,Ao,B,Co,Do,sum(Eo) ! write(6,101) 'FAIL','optarg test',n,ierr,ierrV,result,resultV iresult = 1 endif @@ -230,7 +314,7 @@ program optargs enddo - 101 format(1x,a,1x,a,1x,i2.2,2i6,3x,6g11.4) + 101 format(1x,a,1x,a,1x,i2.2,2i6,3x,8g11.4) write(6,*) ' ' write(6,*) 'optargs COMPLETED SUCCESSFULLY' diff --git a/cicecore/drivers/unittest/optargs/optargs_subs.F90 b/cicecore/drivers/unittest/optargs/optargs_subs.F90 index 7469d6800..4269ed23b 100644 --- a/cicecore/drivers/unittest/optargs/optargs_subs.F90 +++ b/cicecore/drivers/unittest/optargs/optargs_subs.F90 @@ -4,17 +4,21 @@ module optargs_subs implicit none private + integer, public, parameter :: dp = kind(1.d0) + logical, public :: computeA = .false., & computeB = .false., & computeC = .false., & - computeD = .false. + computeD = .false., & + computeE = .false. integer, public :: oa_error = -99, & oa_OK = 0, & oa_A = 1, & oa_B = 2, & oa_C = 4, & - oa_D = 8 + oa_D = 8, & + oa_E = 16 public :: oa_layer1, oa_count1 @@ -22,16 +26,18 @@ module optargs_subs CONTAINS !----------------------------------- - subroutine oa_count1(Ai1,Ao,B,Ci1,Co,Di1,Di2,Do,ierr) + subroutine oa_count1(Ai1,Ao,B,Ci1,Co,Di1,Di2,Do,Ei,Eo,ierr) - real*8 , intent(in) , optional :: Ai1, Di1, Di2 - real*8 , intent(out) , optional :: Ao, Do - real*8 , intent(inout), optional :: B - real*8 , intent(in) :: Ci1 - real*8 , intent(out) :: Co - integer, intent(inout) :: ierr + real(dp), intent(in) , optional :: Ai1, Di1, Di2 + real(dp), intent(out) , optional :: Ao, Do + real(dp), intent(inout), optional :: B + real(dp), intent(in) :: Ci1 + real(dp), intent(out) :: Co + real(dp), intent(in) , optional, dimension(:) :: Ei + real(dp), intent(out) , optional, dimension(:) :: Eo + integer , intent(inout) :: ierr - call oa_count2(Ai1,Ao,B,Ci1,Co,Di1,Di2,Do,ierr) + call oa_count2(Ai1,Ao,B,Ci1,Co,Di1,Di2,Do,Ei,Eo,ierr) ! write(6,*) 'debug oa_count1 ',ierr @@ -39,14 +45,16 @@ end subroutine oa_count1 !----------------------------------- - subroutine oa_count2(Ai1,Ao,B,Ci1,Co,Di1,Di2,Do,ierr) + subroutine oa_count2(Ai1,Ao,B,Ci1,Co,Di1,Di2,Do,Ei,Eo,ierr) - real*8 , intent(in) , optional :: Ai1, Di1, Di2 - real*8 , intent(out) , optional :: Ao, Do - real*8 , intent(inout), optional :: B - real*8 , intent(in) :: Ci1 - real*8 , intent(out) :: Co - integer, intent(inout) :: ierr + real(dp), intent(in) , optional :: Ai1, Di1, Di2 + real(dp), intent(out) , optional :: Ao, Do + real(dp), intent(inout), optional :: B + real(dp), intent(in) :: Ci1 + real(dp), intent(out) :: Co + real(dp), intent(in) , optional, dimension(:) :: Ei + real(dp), intent(out) , optional, dimension(:) :: Eo + integer , intent(inout) :: ierr ierr = 3 ! Ci1, Co, ierr have to be passed if (present(Ai1)) ierr = ierr + 1 @@ -55,6 +63,8 @@ subroutine oa_count2(Ai1,Ao,B,Ci1,Co,Di1,Di2,Do,ierr) if (present(Di1)) ierr = ierr + 1 if (present(Di2)) ierr = ierr + 1 if (present(Do) ) ierr = ierr + 1 + if (present(Ei) ) ierr = ierr + 1 + if (present(Eo) ) ierr = ierr + 1 ! write(6,*) 'debug oa_count2 ',ierr @@ -62,14 +72,16 @@ end subroutine oa_count2 !----------------------------------- - subroutine oa_layer1(Ai1,Ao,B,Ci1,Co,Di1,Di2,Do,ierr) + subroutine oa_layer1(Ai1,Ao,B,Ci1,Co,Di1,Di2,Do,Ei,Eo,ierr) - real*8 , intent(in) , optional :: Ai1, Di1, Di2 - real*8 , intent(out) , optional :: Ao, Do - real*8 , intent(inout), optional :: B - real*8 , intent(in) :: Ci1 - real*8 , intent(out) :: Co - integer, intent(inout) :: ierr + real(dp), intent(in) , optional :: Ai1, Di1, Di2 + real(dp), intent(out) , optional :: Ao, Do + real(dp), intent(inout), optional :: B + real(dp), intent(in) :: Ci1 + real(dp), intent(out) :: Co + real(dp), intent(in) , optional, dimension(:) :: Ei + real(dp), intent(out) , optional, dimension(:) :: Eo + integer , intent(inout) :: ierr ierr = oa_OK if (computeA) then @@ -87,38 +99,55 @@ subroutine oa_layer1(Ai1,Ao,B,Ci1,Co,Di1,Di2,Do,ierr) ierr = oa_error endif endif + if (computeE) then + if (.not.(present(Ei).and.present(Eo))) then + ierr = oa_error + endif + endif if (ierr == oa_OK) then - call oa_layer2(Ai1,Ao,B,Ci1,Co,Di1,Di2,Do,ierr) + call oa_layer2(Ai1,Ao,B,Ci1,Co,Di1,Di2,Do,Ei,Eo,ierr) endif end subroutine oa_layer1 !----------------------------------- - subroutine oa_layer2(Ai1,Ao,B,Ci1,Co,Di1,Di2,Do,ierr) + subroutine oa_layer2(Ai1,Ao,B,Ci1,Co,Di1,Di2,Do,Ei,Eo,ierr) + +! Note: optional arrays must have an optional attribute, otherwise they seg fault +! Scalars do not seem to have this problem - real*8 , intent(in) , optional :: Ai1, Di1, Di2 - real*8 , intent(out) , optional :: Ao, Do - real*8 , intent(inout), optional :: B - real*8 , intent(in) :: Ci1 - real*8 , intent(out) :: Co - integer, intent(inout) :: ierr + real(dp), intent(in) :: Ai1, Di1, Di2 + real(dp), intent(out) :: Ao, Do + real(dp), intent(inout) :: B + real(dp), intent(in) :: Ci1 + real(dp), intent(out) :: Co + real(dp), intent(in) , optional, dimension(:) :: Ei + real(dp), intent(out) , optional, dimension(:) :: Eo + integer , intent(inout) :: ierr - call oa_compute(Ai1,Ao,B,Ci1,Co,Di1,Di2,Do,ierr) + call oa_compute(Ai1,Ao,B,Ci1,Co,Di1,Di2,Do,Ei,Eo,ierr) end subroutine oa_layer2 !----------------------------------- - subroutine oa_compute(Ai1,Ao,B,Ci1,Co,Di1,Di2,Do,ierr) + subroutine oa_compute(Ai1,Ao,B,Ci1,Co,Di1,Di2,Do,Ei,Eo,ierr) - real*8 , intent(in) , optional :: Ai1, Di1, Di2 - real*8 , intent(out) , optional :: Ao, Do - real*8 , intent(inout), optional :: B - real*8 , intent(in) :: Ci1 - real*8 , intent(out) :: Co - integer, intent(inout) :: ierr +! Note: optional arrays must have an optional attribute, otherwise they seg fault +! Scalars do not seem to have this problem + + real(dp), intent(in) :: Ai1, Di1, Di2 + real(dp), intent(out) :: Ao, Do + real(dp), intent(inout) :: B + real(dp), intent(in) :: Ci1 + real(dp), intent(out) :: Co + real(dp), intent(in) , optional, dimension(:) :: Ei + real(dp), intent(out) , optional, dimension(:) :: Eo + integer , intent(inout) :: ierr + + integer :: n if (computeA) then Ao = Ai1 - 1. @@ -140,6 +169,13 @@ subroutine oa_compute(Ai1,Ao,B,Ci1,Co,Di1,Di2,Do,ierr) ierr = ierr + oa_D endif + if (computeE) then + ierr = ierr + oa_E + do n = 1,size(Eo) + Eo(n) = Ei(n) + n + enddo + endif + return end subroutine oa_compute diff --git a/cicecore/drivers/unittest/opticep/CICE.F90 b/cicecore/drivers/unittest/opticep/CICE.F90 new file mode 100644 index 000000000..79dd06fca --- /dev/null +++ b/cicecore/drivers/unittest/opticep/CICE.F90 @@ -0,0 +1,59 @@ +!======================================================================= +! Copyright (c) 2022, Triad National Security, LLC +! All rights reserved. +! +! Copyright 2022. Triad National Security, LLC. This software was +! produced under U.S. Government contract DE-AC52-06NA25396 for Los +! Alamos National Laboratory (LANL), which is operated by Triad +! National Security, LLC for the U.S. Department of Energy. The U.S. +! Government has rights to use, reproduce, and distribute this software. +! NEITHER THE GOVERNMENT NOR TRIAD NATIONAL SECURITY, LLC MAKES ANY +! WARRANTY, EXPRESS OR IMPLIED, OR ASSUMES ANY LIABILITY FOR THE USE OF +! THIS SOFTWARE. If software is modified to produce derivative works, +! such modified software should be clearly marked, so as not to confuse +! it with the version available from LANL. +! +! The full license and distribution policy are available from +! https://github.com/CICE-Consortium +! +!======================================================================= +! +! Main driver routine for CICE. Initializes and steps through the model. +! This program should be compiled if CICE is run as a separate executable, +! but not if CICE subroutines are called from another program (e.g., CAM). +! +! authors Elizabeth C. Hunke and William H. Lipscomb, LANL +! +! 2006: Converted to free form source (F90) by Elizabeth Hunke +! 2008: E. Hunke moved ESMF code to its own driver +! + program icemodel + + use CICE_InitMod + use CICE_RunMod + use CICE_FinalMod + + implicit none + character(len=*), parameter :: subname='(icemodel)' + + !----------------------------------------------------------------- + ! Initialize CICE + !----------------------------------------------------------------- + + call CICE_Initialize + + !----------------------------------------------------------------- + ! Run CICE + !----------------------------------------------------------------- + + call CICE_Run + + !----------------------------------------------------------------- + ! Finalize CICE + !----------------------------------------------------------------- + + call CICE_Finalize + + end program icemodel + +!======================================================================= diff --git a/cicecore/drivers/unittest/opticep/CICE_FinalMod.F90 b/cicecore/drivers/unittest/opticep/CICE_FinalMod.F90 new file mode 100644 index 000000000..02494bd9c --- /dev/null +++ b/cicecore/drivers/unittest/opticep/CICE_FinalMod.F90 @@ -0,0 +1,71 @@ +!======================================================================= +! +! This module contains routines for the final exit of the CICE model, +! including final output and clean exit from any message passing +! environments and frameworks. +! +! authors: Philip W. Jones, LANL +! 2006: Converted to free source form (F90) by Elizabeth Hunke +! 2008: E. Hunke moved ESMF code to its own driver + + module CICE_FinalMod + + use ice_kinds_mod + use ice_communicate, only: my_task, master_task + use ice_exit, only: end_run, abort_ice + use ice_fileunits, only: nu_diag, release_all_fileunits + use icepack_intfc, only: icepack_warnings_flush, icepack_warnings_aborted + + implicit none + private + public :: CICE_Finalize + +!======================================================================= + + contains + +!======================================================================= +! +! This routine shuts down CICE by exiting all relevent environments. + + subroutine CICE_Finalize + + use ice_timers, only: ice_timer_stop, ice_timer_print_all, timer_total, & + timer_stats + + character(len=*), parameter :: subname = '(CICE_Finalize)' + + !------------------------------------------------------------------- + ! stop timers and print timer info + !------------------------------------------------------------------- + + call ice_timer_stop(timer_total) ! stop timing entire run + call ice_timer_print_all(stats=timer_stats) ! print timing information + + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__,line= __LINE__) + + if (my_task == master_task) then + write(nu_diag, *) " " + write(nu_diag, *) "CICE COMPLETED SUCCESSFULLY " + write(nu_diag, *) "OPTICEP TEST COMPLETED SUCCESSFULLY " + write(nu_diag, *) " " + endif + +!echmod if (nu_diag /= 6) close (nu_diag) ! diagnostic output + call release_all_fileunits + + !------------------------------------------------------------------- + ! quit MPI + !------------------------------------------------------------------- + + call end_run ! quit MPI + + end subroutine CICE_Finalize + +!======================================================================= + + end module CICE_FinalMod + +!======================================================================= diff --git a/cicecore/drivers/unittest/opticep/CICE_InitMod.F90 b/cicecore/drivers/unittest/opticep/CICE_InitMod.F90 new file mode 100644 index 000000000..0371c7f38 --- /dev/null +++ b/cicecore/drivers/unittest/opticep/CICE_InitMod.F90 @@ -0,0 +1,517 @@ +!======================================================================= +! +! This module contains the CICE initialization routine that sets model +! parameters and initializes the grid and CICE state variables. +! +! authors Elizabeth C. Hunke, LANL +! William H. Lipscomb, LANL +! Philip W. Jones, LANL +! +! 2006: Converted to free form source (F90) by Elizabeth Hunke +! 2008: E. Hunke moved ESMF code to its own driver + + module CICE_InitMod + + use ice_kinds_mod + use ice_exit, only: abort_ice + use ice_fileunits, only: init_fileunits, nu_diag + use ice_memusage, only: ice_memusage_init, ice_memusage_print + use icepack_intfc, only: icepack_aggregate + use icepack_intfc, only: icepack_init_itd, icepack_init_itd_hist + use icepack_intfc, only: icepack_init_fsd_bounds, icepack_init_wave + use icepack_intfc, only: icepack_init_snow + use icepack_intfc, only: icepack_configure + use icepack_intfc, only: icepack_warnings_flush, icepack_warnings_aborted + use icepack_intfc, only: icepack_query_parameters, icepack_query_tracer_flags, & + icepack_query_tracer_indices, icepack_query_tracer_sizes + + implicit none + private + public :: CICE_Initialize, cice_init + +!======================================================================= + + contains + +!======================================================================= + +! Initialize the basic state, grid and all necessary parameters for +! running the CICE model. Return the initial state in routine +! export state. +! Note: This initialization driver is designed for standalone and +! CESM-coupled applications. For other +! applications (e.g., standalone CAM), this driver would be +! replaced by a different driver that calls subroutine cice_init, +! where most of the work is done. + + subroutine CICE_Initialize + + character(len=*), parameter :: subname='(CICE_Initialize)' + !-------------------------------------------------------------------- + ! model initialization + !-------------------------------------------------------------------- + + call cice_init + + end subroutine CICE_Initialize + +!======================================================================= +! +! Initialize CICE model. + + subroutine cice_init + + use ice_arrays_column, only: hin_max, c_hi_range, alloc_arrays_column + use ice_arrays_column, only: floe_rad_l, floe_rad_c, & + floe_binwidth, c_fsd_range + use ice_state, only: alloc_state + use ice_flux_bgc, only: alloc_flux_bgc + use ice_calendar, only: dt, dt_dyn, write_ic, & + init_calendar, advance_timestep, calc_timesteps + use ice_communicate, only: init_communicate, my_task, master_task + use ice_diagnostics, only: init_diags + use ice_domain, only: init_domain_blocks + use ice_domain_size, only: ncat, nfsd + use ice_dyn_eap, only: init_eap + use ice_dyn_evp, only: init_evp + use ice_dyn_vp, only: init_vp + use ice_dyn_shared, only: kdyn + use ice_flux, only: init_coupler_flux, init_history_therm, & + init_history_dyn, init_flux_atm, init_flux_ocn, alloc_flux + use ice_forcing, only: init_forcing_ocn, init_forcing_atmo, & + get_forcing_atmo, get_forcing_ocn, get_wave_spec, init_snowtable + use ice_forcing_bgc, only: get_forcing_bgc, get_atm_bgc, & + faero_default, faero_optics, alloc_forcing_bgc, fiso_default + use ice_grid, only: init_grid1, init_grid2, alloc_grid + use ice_history, only: init_hist, accum_hist + use ice_restart_shared, only: restart, runtype + use ice_init, only: input_data, init_state + use ice_init_column, only: init_thermo_vertical, init_shortwave, init_zbgc, input_zbgc, count_tracers + use ice_kinds_mod + use ice_restoring, only: ice_HaloRestore_init + use ice_timers, only: timer_total, init_ice_timers, ice_timer_start + use ice_transport_driver, only: init_transport + + logical(kind=log_kind) :: tr_aero, tr_zaero, skl_bgc, z_tracers, & + tr_iso, tr_fsd, wave_spec, tr_snow + character(len=char_len) :: snw_aging_table + character(len=*), parameter :: subname = '(cice_init)' + + call init_communicate ! initial setup for message passing + call init_fileunits ! unit numbers + + ! tcx debug, this will create a different logfile for each pe + ! if (my_task /= master_task) nu_diag = 100+my_task + + call icepack_configure() ! initialize icepack + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(trim(subname), & + file=__FILE__,line= __LINE__) + + call input_data ! namelist variables + call input_zbgc ! vertical biogeochemistry namelist + call count_tracers ! count tracers + + ! Call this as early as possible, must be after memory_stats is read + if (my_task == master_task) then + call ice_memusage_init(nu_diag) + call ice_memusage_print(nu_diag,subname//':start') + endif + + call init_domain_blocks ! set up block decomposition + call init_grid1 ! domain distribution + call alloc_grid ! allocate grid arrays + call alloc_arrays_column ! allocate column arrays + call alloc_state ! allocate state arrays + call alloc_flux_bgc ! allocate flux_bgc arrays + call alloc_flux ! allocate flux arrays + call init_ice_timers ! initialize all timers + call ice_timer_start(timer_total) ! start timing entire run + call init_grid2 ! grid variables + call init_zbgc ! vertical biogeochemistry initialization + call init_calendar ! initialize some calendar stuff + call init_hist (dt) ! initialize output history file + + if (kdyn == 1) then + call init_evp + else if (kdyn == 2) then + call init_eap ! define eap dynamics parameters, variables + else if (kdyn == 3) then + call init_vp ! define vp dynamics parameters, variables + endif + + call init_coupler_flux ! initialize fluxes exchanged with coupler + + call init_thermo_vertical ! initialize vertical thermodynamics + + call icepack_init_itd(ncat=ncat, hin_max=hin_max) ! ice thickness distribution + if (my_task == master_task) then + call icepack_init_itd_hist(ncat=ncat, hin_max=hin_max, c_hi_range=c_hi_range) ! output + endif + + call icepack_query_tracer_flags(tr_fsd_out=tr_fsd) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(trim(subname), & + file=__FILE__,line= __LINE__) + + if (tr_fsd) call icepack_init_fsd_bounds (nfsd, & ! floe size distribution + floe_rad_l, & ! fsd size lower bound in m (radius) + floe_rad_c, & ! fsd size bin centre in m (radius) + floe_binwidth, & ! fsd size bin width in m (radius) + c_fsd_range, & ! string for history output + write_diags=(my_task == master_task)) ! write diag on master only + + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + + call init_forcing_ocn(dt) ! initialize sss and sst from data + call init_state ! initialize the ice state + call init_transport ! initialize horizontal transport + call ice_HaloRestore_init ! restored boundary conditions + + call icepack_query_parameters(skl_bgc_out=skl_bgc, z_tracers_out=z_tracers, & + wave_spec_out=wave_spec, snw_aging_table_out=snw_aging_table) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(trim(subname), & + file=__FILE__,line= __LINE__) + + if (skl_bgc .or. z_tracers) call alloc_forcing_bgc ! allocate biogeochemistry arrays + + call init_restart ! initialize restart variables + call init_diags ! initialize diagnostic output points + call init_history_therm ! initialize thermo history variables + call init_history_dyn ! initialize dynamic history variables + call calc_timesteps ! update timestep counter if not using npt_unit="1" + + call icepack_query_tracer_flags(tr_aero_out=tr_aero, tr_zaero_out=tr_zaero) + call icepack_query_tracer_flags(tr_iso_out=tr_iso, tr_snow_out=tr_snow) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(trim(subname), & + file=__FILE__,line= __LINE__) + + if (tr_aero .or. tr_zaero) call faero_optics !initialize aerosol optical + !property tables + + ! Initialize shortwave components using swdn from previous timestep + ! if restarting. These components will be scaled to current forcing + ! in prep_radiation. + if (trim(runtype) == 'continue' .or. restart) & + call init_shortwave ! initialize radiative transfer + + if (write_ic) call accum_hist(dt) ! write initial conditions + +! tcraig, use advance_timestep here +! istep = istep + 1 ! update time step counters +! istep1 = istep1 + 1 +! time = time + dt ! determine the time and date +! call calendar(time) ! at the end of the first timestep + call advance_timestep() + + !-------------------------------------------------------------------- + ! coupler communication or forcing data initialization + !-------------------------------------------------------------------- + + call init_forcing_atmo ! initialize atmospheric forcing (standalone) + + if (tr_fsd .and. wave_spec) call get_wave_spec ! wave spectrum in ice + call get_forcing_atmo ! atmospheric forcing from data + call get_forcing_ocn(dt) ! ocean forcing from data + + ! snow aging lookup table initialization + if (tr_snow) then ! advanced snow physics + call icepack_init_snow() + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + if (snw_aging_table(1:4) /= 'test') then + call init_snowtable() + endif + endif + + ! isotopes + if (tr_iso) call fiso_default ! default values + + ! aerosols + ! if (tr_aero) call faero_data ! data file + ! if (tr_zaero) call fzaero_data ! data file (gx1) + if (tr_aero .or. tr_zaero) call faero_default ! default values + if (skl_bgc .or. z_tracers) call get_forcing_bgc ! biogeochemistry + if (z_tracers) call get_atm_bgc ! biogeochemistry + + if (runtype == 'initial' .and. .not. restart) & + call init_shortwave ! initialize radiative transfer using current swdn + + call init_flux_atm ! initialize atmosphere fluxes sent to coupler + call init_flux_ocn ! initialize ocean fluxes sent to coupler + + if (my_task == master_task) then + call ice_memusage_print(nu_diag,subname//':end') + endif + + end subroutine cice_init + +!======================================================================= + + subroutine init_restart + + use ice_arrays_column, only: dhsn + use ice_blocks, only: nx_block, ny_block + use ice_calendar, only: calendar + use ice_constants, only: c0 + use ice_domain, only: nblocks + use ice_domain_size, only: ncat, n_iso, n_aero, nfsd, nslyr + use ice_dyn_eap, only: read_restart_eap + use ice_dyn_shared, only: kdyn + use ice_grid, only: tmask + use ice_init, only: ice_ic + use ice_init_column, only: init_age, init_FY, init_lvl, init_snowtracers, & + init_meltponds_lvl, init_meltponds_topo, & + init_isotope, init_aerosol, init_hbrine, init_bgc, init_fsd + use ice_restart_column, only: restart_age, read_restart_age, & + restart_FY, read_restart_FY, restart_lvl, read_restart_lvl, & + restart_pond_lvl, read_restart_pond_lvl, & + restart_pond_topo, read_restart_pond_topo, & + restart_snow, read_restart_snow, & + restart_fsd, read_restart_fsd, & + restart_iso, read_restart_iso, & + restart_aero, read_restart_aero, & + restart_hbrine, read_restart_hbrine, & + restart_zsal, restart_bgc + use ice_restart_driver, only: restartfile + use ice_restart_shared, only: runtype, restart + use ice_state ! almost everything + + integer(kind=int_kind) :: & + i, j , & ! horizontal indices + iblk ! block index + logical(kind=log_kind) :: & + tr_iage, tr_FY, tr_lvl, tr_pond_lvl, & + tr_pond_topo, tr_snow, tr_fsd, tr_iso, tr_aero, tr_brine, & + skl_bgc, z_tracers, solve_zsal + integer(kind=int_kind) :: & + ntrcr + integer(kind=int_kind) :: & + nt_alvl, nt_vlvl, nt_apnd, nt_hpnd, nt_ipnd, & + nt_smice, nt_smliq, nt_rhos, nt_rsnw, & + nt_iage, nt_FY, nt_aero, nt_fsd, nt_isosno, nt_isoice + + character(len=*), parameter :: subname = '(init_restart)' + + call icepack_query_tracer_sizes(ntrcr_out=ntrcr) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + + call icepack_query_parameters(skl_bgc_out=skl_bgc, & + z_tracers_out=z_tracers, solve_zsal_out=solve_zsal) + call icepack_query_tracer_flags(tr_iage_out=tr_iage, tr_FY_out=tr_FY, & + tr_lvl_out=tr_lvl, tr_pond_lvl_out=tr_pond_lvl, & + tr_pond_topo_out=tr_pond_topo, tr_aero_out=tr_aero, tr_brine_out=tr_brine, & + tr_snow_out=tr_snow, tr_fsd_out=tr_fsd, tr_iso_out=tr_iso) + call icepack_query_tracer_indices(nt_alvl_out=nt_alvl, nt_vlvl_out=nt_vlvl, & + nt_apnd_out=nt_apnd, nt_hpnd_out=nt_hpnd, nt_ipnd_out=nt_ipnd, & + nt_iage_out=nt_iage, nt_FY_out=nt_FY, nt_aero_out=nt_aero, nt_fsd_out=nt_fsd, & + nt_smice_out=nt_smice, nt_smliq_out=nt_smliq, & + nt_rhos_out=nt_rhos, nt_rsnw_out=nt_rsnw, & + nt_isosno_out=nt_isosno, nt_isoice_out=nt_isoice) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + + if (trim(runtype) == 'continue') then + ! start from core restart file + call restartfile() ! given by pointer in ice_in + call calendar() ! update time parameters + if (kdyn == 2) call read_restart_eap ! EAP + else if (restart) then ! ice_ic = core restart file + call restartfile (ice_ic) ! or 'default' or 'none' + !!! uncomment to create netcdf + ! call restartfile_v4 (ice_ic) ! CICE v4.1 binary restart file + !!! uncomment if EAP restart data exists + ! if (kdyn == 2) call read_restart_eap + endif + + ! tracers + ! ice age tracer + if (tr_iage) then + if (trim(runtype) == 'continue') & + restart_age = .true. + if (restart_age) then + call read_restart_age + else + do iblk = 1, nblocks + call init_age(trcrn(:,:,nt_iage,:,iblk)) + enddo ! iblk + endif + endif + ! first-year area tracer + if (tr_FY) then + if (trim(runtype) == 'continue') restart_FY = .true. + if (restart_FY) then + call read_restart_FY + else + do iblk = 1, nblocks + call init_FY(trcrn(:,:,nt_FY,:,iblk)) + enddo ! iblk + endif + endif + ! level ice tracer + if (tr_lvl) then + if (trim(runtype) == 'continue') restart_lvl = .true. + if (restart_lvl) then + call read_restart_lvl + else + do iblk = 1, nblocks + call init_lvl(iblk,trcrn(:,:,nt_alvl,:,iblk), & + trcrn(:,:,nt_vlvl,:,iblk)) + enddo ! iblk + endif + endif + ! level-ice melt ponds + if (tr_pond_lvl) then + if (trim(runtype) == 'continue') & + restart_pond_lvl = .true. + if (restart_pond_lvl) then + call read_restart_pond_lvl + else + do iblk = 1, nblocks + call init_meltponds_lvl(trcrn(:,:,nt_apnd,:,iblk), & + trcrn(:,:,nt_hpnd,:,iblk), & + trcrn(:,:,nt_ipnd,:,iblk), & + dhsn(:,:,:,iblk)) + enddo ! iblk + endif + endif + ! topographic melt ponds + if (tr_pond_topo) then + if (trim(runtype) == 'continue') & + restart_pond_topo = .true. + if (restart_pond_topo) then + call read_restart_pond_topo + else + do iblk = 1, nblocks + call init_meltponds_topo(trcrn(:,:,nt_apnd,:,iblk), & + trcrn(:,:,nt_hpnd,:,iblk), & + trcrn(:,:,nt_ipnd,:,iblk)) + enddo ! iblk + endif ! .not. restart_pond + endif + + ! snow redistribution/metamorphism + if (tr_snow) then + if (trim(runtype) == 'continue') restart_snow = .true. + if (restart_snow) then + call read_restart_snow + else + do iblk = 1, nblocks + call init_snowtracers(trcrn(:,:,nt_smice:nt_smice+nslyr-1,:,iblk), & + trcrn(:,:,nt_smliq:nt_smliq+nslyr-1,:,iblk), & + trcrn(:,:,nt_rhos :nt_rhos +nslyr-1,:,iblk), & + trcrn(:,:,nt_rsnw :nt_rsnw +nslyr-1,:,iblk)) + enddo ! iblk + endif + endif + + ! floe size distribution + if (tr_fsd) then + if (trim(runtype) == 'continue') restart_fsd = .true. + if (restart_fsd) then + call read_restart_fsd + else + call init_fsd(trcrn(:,:,nt_fsd:nt_fsd+nfsd-1,:,:)) + endif + endif + + ! isotopes + if (tr_iso) then + if (trim(runtype) == 'continue') restart_iso = .true. + if (restart_iso) then + call read_restart_iso + else + do iblk = 1, nblocks + call init_isotope(trcrn(:,:,nt_isosno:nt_isosno+n_iso-1,:,iblk), & + trcrn(:,:,nt_isoice:nt_isoice+n_iso-1,:,iblk)) + enddo ! iblk + endif + endif + + if (tr_aero) then ! ice aerosol + if (trim(runtype) == 'continue') restart_aero = .true. + if (restart_aero) then + call read_restart_aero + else + do iblk = 1, nblocks + call init_aerosol(trcrn(:,:,nt_aero:nt_aero+4*n_aero-1,:,iblk)) + enddo ! iblk + endif ! .not. restart_aero + endif + + if (trim(runtype) == 'continue') then + if (tr_brine) & + restart_hbrine = .true. + if (solve_zsal) & + restart_zsal = .true. + if (skl_bgc .or. z_tracers) & + restart_bgc = .true. + endif + + if (tr_brine .or. skl_bgc) then ! brine height tracer + call init_hbrine + if (tr_brine .and. restart_hbrine) call read_restart_hbrine + endif + + if (solve_zsal .or. skl_bgc .or. z_tracers) then ! biogeochemistry + if (tr_fsd) then + write (nu_diag,*) 'FSD implementation incomplete for use with BGC' + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + endif + call init_bgc + endif + + !----------------------------------------------------------------- + ! aggregate tracers + !----------------------------------------------------------------- + + !$OMP PARALLEL DO PRIVATE(iblk) + do iblk = 1, nblocks + do j = 1, ny_block + do i = 1, nx_block + if (tmask(i,j,iblk)) then + call icepack_aggregate(ncat = ncat, & + aicen = aicen(i,j,:,iblk), & + trcrn = trcrn(i,j,:,:,iblk), & + vicen = vicen(i,j,:,iblk), & + vsnon = vsnon(i,j,:,iblk), & + aice = aice (i,j, iblk), & + trcr = trcr (i,j,:,iblk), & + vice = vice (i,j, iblk), & + vsno = vsno (i,j, iblk), & + aice0 = aice0(i,j, iblk), & + ntrcr = ntrcr, & + trcr_depend = trcr_depend, & + trcr_base = trcr_base, & + n_trcr_strata = n_trcr_strata, & + nt_strata = nt_strata) + else + ! tcraig, reset all tracer values on land to zero + trcrn(i,j,:,:,iblk) = c0 + endif + enddo + enddo + enddo + !$OMP END PARALLEL DO + + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + + end subroutine init_restart + +!======================================================================= + + end module CICE_InitMod + +!======================================================================= diff --git a/cicecore/drivers/unittest/opticep/CICE_RunMod.F90 b/cicecore/drivers/unittest/opticep/CICE_RunMod.F90 new file mode 100644 index 000000000..ae7f7ab1f --- /dev/null +++ b/cicecore/drivers/unittest/opticep/CICE_RunMod.F90 @@ -0,0 +1,741 @@ +!======================================================================= +! +! Main driver for time stepping of CICE. +! +! authors Elizabeth C. Hunke, LANL +! Philip W. Jones, LANL +! William H. Lipscomb, LANL +! +! 2006 ECH: moved exit timeLoop to prevent execution of unnecessary timestep +! 2006 ECH: Streamlined for efficiency +! 2006 ECH: Converted to free source form (F90) +! 2007 BPB: Modified Delta-Eddington shortwave interface +! 2008 ECH: moved ESMF code to its own driver + + module CICE_RunMod + + use ice_kinds_mod + use ice_communicate, only: my_task, master_task + use ice_fileunits, only: nu_diag + use ice_arrays_column, only: oceanmixed_ice + use ice_constants, only: c0, c1 + use ice_constants, only: field_loc_center, field_type_scalar + use ice_exit, only: abort_ice + use ice_memusage, only: ice_memusage_print + use icepack_intfc, only: icepack_warnings_flush, icepack_warnings_aborted + use icepack_intfc, only: icepack_max_iso, icepack_max_aero + use icepack_intfc, only: icepack_query_parameters + use icepack_intfc, only: icepack_query_tracer_flags, icepack_query_tracer_sizes + + implicit none + private + public :: CICE_Run, ice_step + +!======================================================================= + + contains + +!======================================================================= +! +! This is the main driver routine for advancing CICE forward in time. +! +! author Elizabeth C. Hunke, LANL +! Philip W. Jones, LANL +! William H. Lipscomb, LANL + + subroutine CICE_Run + + use ice_calendar, only: dt, stop_now, advance_timestep + use ice_forcing, only: get_forcing_atmo, get_forcing_ocn, & + get_wave_spec + use ice_forcing_bgc, only: get_forcing_bgc, get_atm_bgc, & + fiso_default, faero_default + use ice_flux, only: init_flux_atm, init_flux_ocn + use ice_timers, only: ice_timer_start, ice_timer_stop, & + timer_couple, timer_step + logical (kind=log_kind) :: & + tr_iso, tr_aero, tr_zaero, skl_bgc, z_tracers, wave_spec, tr_fsd + character(len=*), parameter :: subname = '(CICE_Run)' + + !-------------------------------------------------------------------- + ! initialize error code and step timer + !-------------------------------------------------------------------- + + call ice_timer_start(timer_step) ! start timing entire run + + call icepack_query_parameters(skl_bgc_out=skl_bgc, & + z_tracers_out=z_tracers, & + wave_spec_out=wave_spec) + call icepack_query_tracer_flags(tr_iso_out=tr_iso, & + tr_aero_out=tr_aero, & + tr_zaero_out=tr_zaero, & + tr_fsd_out=tr_fsd) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + +#ifndef CICE_IN_NEMO + !-------------------------------------------------------------------- + ! timestep loop + !-------------------------------------------------------------------- + + timeLoop: do +#endif + + call ice_step + +! tcraig, use advance_timestep now +! istep = istep + 1 ! update time step counters +! istep1 = istep1 + 1 +! time = time + dt ! determine the time and date +! call calendar(time) ! at the end of the timestep + call advance_timestep() ! advance time + +#ifndef CICE_IN_NEMO + if (stop_now >= 1) exit timeLoop +#endif + + call ice_timer_start(timer_couple) ! atm/ocn coupling + +! for now, wave_spectrum is constant in time +! if (tr_fsd .and. wave_spec) call get_wave_spec ! wave spectrum in ice + call get_forcing_atmo ! atmospheric forcing from data + call get_forcing_ocn(dt) ! ocean forcing from data + + ! isotopes + if (tr_iso) call fiso_default ! default values + ! aerosols + ! if (tr_aero) call faero_data ! data file + ! if (tr_zaero) call fzaero_data ! data file (gx1) + if (tr_aero .or. tr_zaero) call faero_default ! default values + + if (skl_bgc .or. z_tracers) call get_forcing_bgc ! biogeochemistry + if (z_tracers) call get_atm_bgc ! biogeochemistry + + call init_flux_atm ! Initialize atmosphere fluxes sent to coupler + call init_flux_ocn ! initialize ocean fluxes sent to coupler + + call ice_timer_stop(timer_couple) ! atm/ocn coupling + +#ifndef CICE_IN_NEMO + enddo timeLoop +#endif + + !-------------------------------------------------------------------- + ! end of timestep loop + !-------------------------------------------------------------------- + + call ice_timer_stop(timer_step) ! end timestepping loop timer + + end subroutine CICE_Run + +!======================================================================= +! +! Calls drivers for physics components, some initialization, and output +! +! author Elizabeth C. Hunke, LANL +! William H. Lipscomb, LANL + + subroutine ice_step + + use ice_boundary, only: ice_HaloUpdate + use ice_calendar, only: dt, dt_dyn, ndtd, diagfreq, write_restart, istep + use ice_diagnostics, only: init_mass_diags, runtime_diags, debug_model, debug_ice + use ice_diagnostics_bgc, only: hbrine_diags, zsal_diags, bgc_diags + use ice_domain, only: halo_info, nblocks + use ice_dyn_eap, only: write_restart_eap + use ice_dyn_shared, only: kdyn, kridge + use ice_flux, only: scale_factor, init_history_therm, & + daidtt, daidtd, dvidtt, dvidtd, dagedtt, dagedtd + use ice_history, only: accum_hist + use ice_history_bgc, only: init_history_bgc + use ice_restart, only: final_restart + use ice_restart_column, only: write_restart_age, write_restart_FY, & + write_restart_lvl, write_restart_pond_lvl, & + write_restart_pond_topo, write_restart_aero, write_restart_fsd, & + write_restart_iso, write_restart_bgc, write_restart_hbrine, & + write_restart_snow + use ice_restart_driver, only: dumpfile + use ice_restoring, only: restore_ice, ice_HaloRestore + use ice_step_mod, only: prep_radiation, step_therm1, step_therm2, & + update_state, step_dyn_horiz, step_dyn_ridge, step_radiation, & + biogeochemistry, step_prep, step_dyn_wave, step_snow + use ice_timers, only: ice_timer_start, ice_timer_stop, & + timer_diags, timer_column, timer_thermo, timer_bound, & + timer_hist, timer_readwrite + + integer (kind=int_kind) :: & + iblk , & ! block index + k , & ! dynamics supercycling index + ktherm ! thermodynamics is off when ktherm = -1 + + real (kind=dbl_kind) :: & + offset ! d(age)/dt time offset + + logical (kind=log_kind) :: & + tr_iage, tr_FY, tr_lvl, tr_fsd, tr_snow, & + tr_pond_lvl, tr_pond_topo, tr_brine, tr_iso, tr_aero, & + calc_Tsfc, skl_bgc, solve_zsal, z_tracers, wave_spec + + character(len=*), parameter :: subname = '(ice_step)' + + character (len=char_len) :: plabeld + + if (debug_model) then + plabeld = 'beginning time step' + do iblk = 1, nblocks + call debug_ice (iblk, plabeld) + enddo + endif + + call icepack_query_parameters(calc_Tsfc_out=calc_Tsfc, skl_bgc_out=skl_bgc, & + solve_zsal_out=solve_zsal, z_tracers_out=z_tracers, ktherm_out=ktherm, & + wave_spec_out=wave_spec) + call icepack_query_tracer_flags(tr_iage_out=tr_iage, tr_FY_out=tr_FY, & + tr_lvl_out=tr_lvl, tr_pond_lvl_out=tr_pond_lvl, & + tr_pond_topo_out=tr_pond_topo, tr_brine_out=tr_brine, tr_aero_out=tr_aero, & + tr_iso_out=tr_iso, tr_fsd_out=tr_fsd, tr_snow_out=tr_snow) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + + !----------------------------------------------------------------- + ! restoring on grid boundaries + !----------------------------------------------------------------- + + if (restore_ice) call ice_HaloRestore + + !----------------------------------------------------------------- + ! initialize diagnostics and save initial state values + !----------------------------------------------------------------- + + call ice_timer_start(timer_diags) ! diagnostics/history + call init_mass_diags ! diagnostics per timestep + call init_history_therm + call init_history_bgc + call ice_timer_stop(timer_diags) ! diagnostics/history + + call ice_timer_start(timer_column) ! column physics + call ice_timer_start(timer_thermo) ! thermodynamics + + call step_prep + + if (ktherm >= 0) then + !$OMP PARALLEL DO PRIVATE(iblk) SCHEDULE(runtime) + do iblk = 1, nblocks + + !----------------------------------------------------------------- + ! scale radiation fields + !----------------------------------------------------------------- + + if (calc_Tsfc) call prep_radiation (iblk) + + if (debug_model) then + plabeld = 'post prep_radiation' + call debug_ice (iblk, plabeld) + endif + + !----------------------------------------------------------------- + ! thermodynamics and biogeochemistry + !----------------------------------------------------------------- + + call step_therm1 (dt, iblk) ! vertical thermodynamics + + if (debug_model) then + plabeld = 'post step_therm1' + call debug_ice (iblk, plabeld) + endif + + call biogeochemistry (dt, iblk) ! biogeochemistry + + if (debug_model) then + plabeld = 'post biogeochemistry' + call debug_ice (iblk, plabeld) + endif + + call step_therm2 (dt, iblk) ! ice thickness distribution thermo + + if (debug_model) then + plabeld = 'post step_therm2' + call debug_ice (iblk, plabeld) + endif + + enddo + !$OMP END PARALLEL DO + endif ! ktherm > 0 + + ! clean up, update tendency diagnostics + offset = dt + call update_state (dt, daidtt, dvidtt, dagedtt, offset) + + call ice_timer_stop(timer_thermo) ! thermodynamics + call ice_timer_stop(timer_column) ! column physics + + !----------------------------------------------------------------- + ! dynamics, transport, ridging + !----------------------------------------------------------------- + + ! wave fracture of the floe size distribution + ! note this is called outside of the dynamics subcycling loop + if (tr_fsd .and. wave_spec) call step_dyn_wave(dt) + + do k = 1, ndtd + + ! momentum, stress, transport + call step_dyn_horiz (dt_dyn) + + if (debug_model) then + plabeld = 'post step_dyn_horiz' + do iblk = 1, nblocks + call debug_ice (iblk, plabeld) + enddo ! iblk + endif + + ! ridging + !$OMP PARALLEL DO PRIVATE(iblk) SCHEDULE(runtime) + do iblk = 1, nblocks + if (kridge > 0) call step_dyn_ridge (dt_dyn, ndtd, iblk) + enddo + !$OMP END PARALLEL DO + + if (debug_model) then + plabeld = 'post step_dyn_ridge' + do iblk = 1, nblocks + call debug_ice (iblk, plabeld) + enddo ! iblk + endif + + ! clean up, update tendency diagnostics + offset = c0 + call update_state (dt_dyn, daidtd, dvidtd, dagedtd, offset) + + enddo + + if (debug_model) then + plabeld = 'post dynamics' + do iblk = 1, nblocks + call debug_ice (iblk, plabeld) + enddo + endif + + call ice_timer_start(timer_column) ! column physics + call ice_timer_start(timer_thermo) ! thermodynamics + + !----------------------------------------------------------------- + ! snow redistribution and metamorphosis + !----------------------------------------------------------------- + + if (tr_snow) then ! advanced snow physics + !$OMP PARALLEL DO PRIVATE(iblk) SCHEDULE(runtime) + do iblk = 1, nblocks + call step_snow (dt, iblk) + enddo + !$OMP END PARALLEL DO + call update_state (dt) ! clean up + endif + + !$OMP PARALLEL DO PRIVATE(iblk) SCHEDULE(runtime) + do iblk = 1, nblocks + + !----------------------------------------------------------------- + ! albedo, shortwave radiation + !----------------------------------------------------------------- + + if (ktherm >= 0) call step_radiation (dt, iblk) + + if (debug_model) then + plabeld = 'post step_radiation' + call debug_ice (iblk, plabeld) + endif + + !----------------------------------------------------------------- + ! get ready for coupling and the next time step + !----------------------------------------------------------------- + + call coupling_prep (iblk) + + if (debug_model) then + plabeld = 'post coupling_prep' + call debug_ice (iblk, plabeld) + endif + + enddo ! iblk + !$OMP END PARALLEL DO + + call ice_timer_start(timer_bound) + call ice_HaloUpdate (scale_factor, halo_info, & + field_loc_center, field_type_scalar) + call ice_timer_stop(timer_bound) + + call ice_timer_stop(timer_thermo) ! thermodynamics + call ice_timer_stop(timer_column) ! column physics + + !----------------------------------------------------------------- + ! write data + !----------------------------------------------------------------- + + call ice_timer_start(timer_diags) ! diagnostics + if (mod(istep,diagfreq) == 0) then + call runtime_diags(dt) ! log file + if (solve_zsal) call zsal_diags + if (skl_bgc .or. z_tracers) call bgc_diags + if (tr_brine) call hbrine_diags + if (my_task == master_task) then + call ice_memusage_print(nu_diag,subname) + endif + endif + call ice_timer_stop(timer_diags) ! diagnostics + + call ice_timer_start(timer_hist) ! history + call accum_hist (dt) ! history file + call ice_timer_stop(timer_hist) ! history + + call ice_timer_start(timer_readwrite) ! reading/writing + if (write_restart == 1) then + call dumpfile ! core variables for restarting + if (tr_iage) call write_restart_age + if (tr_FY) call write_restart_FY + if (tr_lvl) call write_restart_lvl + if (tr_pond_lvl) call write_restart_pond_lvl + if (tr_pond_topo) call write_restart_pond_topo + if (tr_snow) call write_restart_snow + if (tr_fsd) call write_restart_fsd + if (tr_iso) call write_restart_iso + if (tr_aero) call write_restart_aero + if (solve_zsal .or. skl_bgc .or. z_tracers) & + call write_restart_bgc + if (tr_brine) call write_restart_hbrine + if (kdyn == 2) call write_restart_eap + call final_restart + endif + call ice_timer_stop(timer_readwrite) ! reading/writing + + end subroutine ice_step + +!======================================================================= +! +! Prepare for coupling +! +! authors: Elizabeth C. Hunke, LANL + + subroutine coupling_prep (iblk) + + use ice_arrays_column, only: alvdfn, alidfn, alvdrn, alidrn, & + albicen, albsnon, albpndn, apeffn, fzsal_g, fzsal, snowfracn + use ice_blocks, only: nx_block, ny_block, get_block, block + use ice_domain, only: blocks_ice + use ice_calendar, only: dt, nstreams + use ice_domain_size, only: ncat + use ice_flux, only: alvdf, alidf, alvdr, alidr, albice, albsno, & + albpnd, albcnt, apeff_ai, fpond, fresh, l_mpond_fresh, & + alvdf_ai, alidf_ai, alvdr_ai, alidr_ai, fhocn_ai, & + fresh_ai, fsalt_ai, fsalt, & + fswthru_ai, fhocn, scale_factor, snowfrac, & + fswthru, fswthru_vdr, fswthru_vdf, fswthru_idr, fswthru_idf, & + swvdr, swidr, swvdf, swidf, Tf, Tair, Qa, strairxT, strairyT, & + fsens, flat, fswabs, flwout, evap, Tref, Qref, & + scale_fluxes, frzmlt_init, frzmlt + use ice_flux_bgc, only: faero_ocn, fiso_ocn, Qref_iso, fiso_evap, & + fzsal_ai, fzsal_g_ai, flux_bio, flux_bio_ai + use ice_grid, only: tmask + use ice_state, only: aicen, aice +#ifdef CICE_IN_NEMO + use ice_state, only: aice_init + use ice_flux, only: flatn_f, fsurfn_f +#endif + use ice_step_mod, only: ocean_mixed_layer + use ice_timers, only: timer_couple, ice_timer_start, ice_timer_stop + + integer (kind=int_kind), intent(in) :: & + iblk ! block index + + ! local variables + + integer (kind=int_kind) :: & + ilo,ihi,jlo,jhi, & ! beginning and end of physical domain + n , & ! thickness category index + i,j , & ! horizontal indices + k , & ! tracer index + nbtrcr ! + + type (block) :: & + this_block ! block information for current block + + logical (kind=log_kind) :: & + calc_Tsfc ! + + real (kind=dbl_kind) :: & + cszn , & ! counter for history averaging + puny , & ! + rhofresh , & ! + netsw ! flag for shortwave radiation presence + + character(len=*), parameter :: subname = '(coupling_prep)' + + call icepack_query_parameters(puny_out=puny, rhofresh_out=rhofresh) + call icepack_query_tracer_sizes(nbtrcr_out=nbtrcr) + call icepack_query_parameters(calc_Tsfc_out=calc_Tsfc) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + + !----------------------------------------------------------------- + ! Save current value of frzmlt for diagnostics. + ! Update mixed layer with heat and radiation from ice. + !----------------------------------------------------------------- + + do j = 1, ny_block + do i = 1, nx_block + frzmlt_init (i,j,iblk) = frzmlt(i,j,iblk) + enddo + enddo + + call ice_timer_start(timer_couple,iblk) ! atm/ocn coupling + + if (oceanmixed_ice) & + call ocean_mixed_layer (dt,iblk) ! ocean surface fluxes and sst + + !----------------------------------------------------------------- + ! Aggregate albedos + !----------------------------------------------------------------- + + do j = 1, ny_block + do i = 1, nx_block + alvdf(i,j,iblk) = c0 + alidf(i,j,iblk) = c0 + alvdr(i,j,iblk) = c0 + alidr(i,j,iblk) = c0 + + albice(i,j,iblk) = c0 + albsno(i,j,iblk) = c0 + albpnd(i,j,iblk) = c0 + apeff_ai(i,j,iblk) = c0 + snowfrac(i,j,iblk) = c0 + + ! for history averaging + cszn = c0 + netsw = swvdr(i,j,iblk)+swidr(i,j,iblk)+swvdf(i,j,iblk)+swidf(i,j,iblk) + if (netsw > puny) cszn = c1 + do n = 1, nstreams + albcnt(i,j,iblk,n) = albcnt(i,j,iblk,n) + cszn + enddo + enddo + enddo + + this_block = get_block(blocks_ice(iblk),iblk) + ilo = this_block%ilo + ihi = this_block%ihi + jlo = this_block%jlo + jhi = this_block%jhi + + do n = 1, ncat + do j = jlo, jhi + do i = ilo, ihi + if (aicen(i,j,n,iblk) > puny) then + + alvdf(i,j,iblk) = alvdf(i,j,iblk) & + + alvdfn(i,j,n,iblk)*aicen(i,j,n,iblk) + alidf(i,j,iblk) = alidf(i,j,iblk) & + + alidfn(i,j,n,iblk)*aicen(i,j,n,iblk) + alvdr(i,j,iblk) = alvdr(i,j,iblk) & + + alvdrn(i,j,n,iblk)*aicen(i,j,n,iblk) + alidr(i,j,iblk) = alidr(i,j,iblk) & + + alidrn(i,j,n,iblk)*aicen(i,j,n,iblk) + + netsw = swvdr(i,j,iblk) + swidr(i,j,iblk) & + + swvdf(i,j,iblk) + swidf(i,j,iblk) + if (netsw > puny) then ! sun above horizon + albice(i,j,iblk) = albice(i,j,iblk) & + + albicen(i,j,n,iblk)*aicen(i,j,n,iblk) + albsno(i,j,iblk) = albsno(i,j,iblk) & + + albsnon(i,j,n,iblk)*aicen(i,j,n,iblk) + albpnd(i,j,iblk) = albpnd(i,j,iblk) & + + albpndn(i,j,n,iblk)*aicen(i,j,n,iblk) + endif + + apeff_ai(i,j,iblk) = apeff_ai(i,j,iblk) & ! for history + + apeffn(i,j,n,iblk)*aicen(i,j,n,iblk) + snowfrac(i,j,iblk) = snowfrac(i,j,iblk) & ! for history + + snowfracn(i,j,n,iblk)*aicen(i,j,n,iblk) + + endif ! aicen > puny + enddo + enddo + enddo + + do j = 1, ny_block + do i = 1, nx_block + + !----------------------------------------------------------------- + ! reduce fresh by fpond for coupling + !----------------------------------------------------------------- + + if (l_mpond_fresh) then + fpond(i,j,iblk) = fpond(i,j,iblk) * rhofresh/dt + fresh(i,j,iblk) = fresh(i,j,iblk) - fpond(i,j,iblk) + endif + + !---------------------------------------------------------------- + ! Store grid box mean albedos and fluxes before scaling by aice + !---------------------------------------------------------------- + + alvdf_ai (i,j,iblk) = alvdf (i,j,iblk) + alidf_ai (i,j,iblk) = alidf (i,j,iblk) + alvdr_ai (i,j,iblk) = alvdr (i,j,iblk) + alidr_ai (i,j,iblk) = alidr (i,j,iblk) + fresh_ai (i,j,iblk) = fresh (i,j,iblk) + fsalt_ai (i,j,iblk) = fsalt (i,j,iblk) + fhocn_ai (i,j,iblk) = fhocn (i,j,iblk) + fswthru_ai(i,j,iblk) = fswthru(i,j,iblk) + fzsal_ai (i,j,iblk) = fzsal (i,j,iblk) + fzsal_g_ai(i,j,iblk) = fzsal_g(i,j,iblk) + + if (nbtrcr > 0) then + do k = 1, nbtrcr + flux_bio_ai (i,j,k,iblk) = flux_bio (i,j,k,iblk) + enddo + endif + + !----------------------------------------------------------------- + ! Save net shortwave for scaling factor in scale_factor + !----------------------------------------------------------------- + scale_factor(i,j,iblk) = & + swvdr(i,j,iblk)*(c1 - alvdr_ai(i,j,iblk)) & + + swvdf(i,j,iblk)*(c1 - alvdf_ai(i,j,iblk)) & + + swidr(i,j,iblk)*(c1 - alidr_ai(i,j,iblk)) & + + swidf(i,j,iblk)*(c1 - alidf_ai(i,j,iblk)) + + enddo + enddo + + !----------------------------------------------------------------- + ! Divide fluxes by ice area + ! - the CESM coupler assumes fluxes are per unit ice area + ! - also needed for global budget in diagnostics + !----------------------------------------------------------------- + + call scale_fluxes (nx_block, ny_block, & + tmask (:,:,iblk), nbtrcr, & + icepack_max_aero, & + aice (:,:,iblk), Tf (:,:,iblk), & + Tair (:,:,iblk), Qa (:,:,iblk), & + strairxT (:,:,iblk), strairyT(:,:,iblk), & + fsens (:,:,iblk), flat (:,:,iblk), & + fswabs (:,:,iblk), flwout (:,:,iblk), & + evap (:,:,iblk), & + Tref (:,:,iblk), Qref (:,:,iblk), & + fresh (:,:,iblk), fsalt (:,:,iblk), & + fhocn (:,:,iblk), & + fswthru (:,:,iblk), & + fswthru_vdr (:,:,iblk), & + fswthru_vdf (:,:,iblk), & + fswthru_idr (:,:,iblk), & + fswthru_idf (:,:,iblk), & + faero_ocn(:,:,:,iblk), & + alvdr (:,:,iblk), alidr (:,:,iblk), & + alvdf (:,:,iblk), alidf (:,:,iblk), & + fzsal (:,:,iblk), fzsal_g (:,:,iblk), & + flux_bio (:,:,1:nbtrcr,iblk), & + Qref_iso =Qref_iso (:,:,:,iblk), & + fiso_evap=fiso_evap(:,:,:,iblk), & + fiso_ocn =fiso_ocn (:,:,:,iblk)) + +#ifdef CICE_IN_NEMO +!echmod - comment this out for efficiency, if .not. calc_Tsfc + if (.not. calc_Tsfc) then + + !--------------------------------------------------------------- + ! If surface fluxes were provided, conserve these fluxes at ice + ! free points by passing to ocean. + !--------------------------------------------------------------- + + call sfcflux_to_ocn & + (nx_block, ny_block, & + tmask (:,:,iblk), aice_init(:,:,iblk), & + fsurfn_f (:,:,:,iblk), flatn_f(:,:,:,iblk), & + fresh (:,:,iblk), fhocn (:,:,iblk)) + endif +!echmod +#endif + call ice_timer_stop(timer_couple,iblk) ! atm/ocn coupling + + end subroutine coupling_prep + +#ifdef CICE_IN_NEMO + +!======================================================================= +! +! If surface heat fluxes are provided to CICE instead of CICE calculating +! them internally (i.e. .not. calc_Tsfc), then these heat fluxes can +! be provided at points which do not have ice. (This is could be due to +! the heat fluxes being calculated on a lower resolution grid or the +! heat fluxes not recalculated at every CICE timestep.) At ice free points, +! conserve energy and water by passing these fluxes to the ocean. +! +! author: A. McLaren, Met Office + + subroutine sfcflux_to_ocn(nx_block, ny_block, & + tmask, aice, & + fsurfn_f, flatn_f, & + fresh, fhocn) + + use ice_domain_size, only: ncat + + integer (kind=int_kind), intent(in) :: & + nx_block, ny_block ! block dimensions + + logical (kind=log_kind), dimension (nx_block,ny_block), intent(in) :: & + tmask ! land/boundary mask, thickness (T-cell) + + real (kind=dbl_kind), dimension(nx_block,ny_block), intent(in):: & + aice ! initial ice concentration + + real (kind=dbl_kind), dimension(nx_block,ny_block,ncat), intent(in) :: & + fsurfn_f, & ! net surface heat flux (provided as forcing) + flatn_f ! latent heat flux (provided as forcing) + + real (kind=dbl_kind), dimension(nx_block,ny_block), intent(inout):: & + fresh , & ! fresh water flux to ocean (kg/m2/s) + fhocn ! actual ocn/ice heat flx (W/m**2) + + + ! local variables + integer (kind=int_kind) :: & + i, j, n ! horizontal indices + + real (kind=dbl_kind) :: & + puny, & ! + Lsub, & ! + rLsub ! 1/Lsub + + character(len=*), parameter :: subname = '(sfcflux_to_ocn)' + + call icepack_query_parameters(puny_out=puny, Lsub_out=Lsub) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + rLsub = c1 / Lsub + + do n = 1, ncat + do j = 1, ny_block + do i = 1, nx_block + if (tmask(i,j) .and. aice(i,j) <= puny) then + fhocn(i,j) = fhocn(i,j) & + + fsurfn_f(i,j,n) + flatn_f(i,j,n) + fresh(i,j) = fresh(i,j) & + + flatn_f(i,j,n) * rLsub + endif + enddo ! i + enddo ! j + enddo ! n + + + end subroutine sfcflux_to_ocn + +#endif + +!======================================================================= + + end module CICE_RunMod + +!======================================================================= diff --git a/cicecore/drivers/unittest/opticep/README b/cicecore/drivers/unittest/opticep/README new file mode 100644 index 000000000..b5f1bdf9c --- /dev/null +++ b/cicecore/drivers/unittest/opticep/README @@ -0,0 +1,30 @@ + +This unittest tests Icepack optional arguments. The idea is to have source code that is +identical to the standard CICE source code except the significant optional arguments passed +into Icepack are removed from the CICE calls. Then to run a standard CICE case with optional +features (fsd, bgc, isotopes, etc) off in namelist. That results should be bit-for-bit identical +with an equivalent run from the standard source code. + +This unittest will need to be maintained manually. As CICE code changes, the modified files +in the unittest also need to be update manually. Again, it should be as easy as copying the +standard files into this directory and then commenting out the optional arguments. + +NOTES: + +All files from cicecore/drivers/standalone/cice need to be copied to this directory. As of +today, that includes + CICE.F90 + CICE_FinalMod.F90 + CICE_InitMod.F90 + CICE_RunMod.F90 + +Add + write(nu_diag, *) "OPTICEP TEST COMPLETED SUCCESSFULLY " +to CICE_FinalMod.F90 + +Do not worry about the parameter/tracer query/init/write methods + +Interfaces to modify include + ice_init_column.F90 (icepack_step_radiation, icepack_init_zbgc) + ice_step_mod.F90 (icepack_step_therm1, icepack_step_therm2, icepack_prep_radiation, + icepack_step_radiation, icepack_step_ridge) diff --git a/cicecore/drivers/unittest/opticep/ice_init_column.F90 b/cicecore/drivers/unittest/opticep/ice_init_column.F90 new file mode 100644 index 000000000..82f3f4a1e --- /dev/null +++ b/cicecore/drivers/unittest/opticep/ice_init_column.F90 @@ -0,0 +1,3135 @@ +!========================================================================= +! +! Initialization routines for the column package. +! +! author: Elizabeth C. Hunke, LANL +! + module ice_init_column + + use ice_kinds_mod + use ice_blocks, only: nx_block, ny_block + use ice_constants + use ice_communicate, only: my_task, master_task, ice_barrier + use ice_domain_size, only: ncat, max_blocks + use ice_domain_size, only: nblyr, nilyr, nslyr + use ice_domain_size, only: n_aero, n_zaero, n_algae + use ice_domain_size, only: n_doc, n_dic, n_don + use ice_domain_size, only: n_fed, n_fep + use ice_fileunits, only: nu_diag + use ice_fileunits, only: nu_nml, nml_filename, get_fileunit, & + release_fileunit, flush_fileunit + use ice_exit, only: abort_ice + use icepack_intfc, only: icepack_max_don, icepack_max_doc, icepack_max_dic + use icepack_intfc, only: icepack_max_algae, icepack_max_aero, icepack_max_fe + use icepack_intfc, only: icepack_max_nbtrcr + use icepack_intfc, only: icepack_warnings_flush, icepack_warnings_aborted + use icepack_intfc, only: icepack_init_tracer_sizes, icepack_init_tracer_flags + use icepack_intfc, only: icepack_init_tracer_indices + use icepack_intfc, only: icepack_init_parameters + use icepack_intfc, only: icepack_query_tracer_sizes, icepack_query_tracer_flags + use icepack_intfc, only: icepack_query_tracer_indices, icepack_query_tracer_sizes + use icepack_intfc, only: icepack_query_parameters + use icepack_intfc, only: icepack_write_tracer_sizes, icepack_write_tracer_flags + use icepack_intfc, only: icepack_write_tracer_indices, icepack_write_tracer_sizes + use icepack_intfc, only: icepack_init_fsd, icepack_cleanup_fsd + use icepack_intfc, only: icepack_init_zbgc + use icepack_intfc, only: icepack_init_thermo + use icepack_intfc, only: icepack_step_radiation, icepack_init_orbit + use icepack_intfc, only: icepack_init_bgc, icepack_init_zsalinity + use icepack_intfc, only: icepack_init_ocean_bio, icepack_load_ocean_bio_array + use icepack_intfc, only: icepack_init_hbrine + + implicit none + + private + public :: init_thermo_vertical, init_shortwave, & + init_age, init_FY, init_lvl, init_fsd, & + init_meltponds_lvl, init_meltponds_topo, & + init_aerosol, init_bgc, init_hbrine, init_zbgc, input_zbgc, & + count_tracers, init_isotope, init_snowtracers + + ! namelist parameters needed locally + + real (kind=dbl_kind) :: & + tau_min , tau_max , & + nitratetype , ammoniumtype , silicatetype, & + dmspptype , dmspdtype , humtype + + real (kind=dbl_kind), dimension(icepack_max_dic) :: & + dictype + + real (kind=dbl_kind), dimension(icepack_max_algae) :: & + algaltype ! tau_min for both retention and release + + real (kind=dbl_kind), dimension(icepack_max_doc) :: & + doctype + + real (kind=dbl_kind), dimension(icepack_max_don) :: & + dontype + + real (kind=dbl_kind), dimension(icepack_max_fe) :: & + fedtype + + real (kind=dbl_kind), dimension(icepack_max_fe) :: & + feptype + + real (kind=dbl_kind), dimension(icepack_max_aero) :: & + zaerotype + + real (kind=dbl_kind) :: & + grid_o, l_sk, grid_o_t, initbio_frac, & + frazil_scav, grid_oS, l_skS, & + phi_snow, & + ratio_Si2N_diatoms , ratio_Si2N_sp , ratio_Si2N_phaeo , & + ratio_S2N_diatoms , ratio_S2N_sp , ratio_S2N_phaeo , & + ratio_Fe2C_diatoms , ratio_Fe2C_sp , ratio_Fe2C_phaeo , & + ratio_Fe2N_diatoms , ratio_Fe2N_sp , ratio_Fe2N_phaeo , & + ratio_Fe2DON , ratio_Fe2DOC_s , ratio_Fe2DOC_l , & + fr_resp , & + algal_vel , R_dFe2dust , dustFe_sol , & + chlabs_diatoms , chlabs_sp , chlabs_phaeo , & + alpha2max_low_diatoms,alpha2max_low_sp , alpha2max_low_phaeo, & + beta2max_diatoms , beta2max_sp , beta2max_phaeo , & + mu_max_diatoms , mu_max_sp , mu_max_phaeo , & + grow_Tdep_diatoms , grow_Tdep_sp , grow_Tdep_phaeo , & + fr_graze_diatoms , fr_graze_sp , fr_graze_phaeo , & + mort_pre_diatoms , mort_pre_sp , mort_pre_phaeo , & + mort_Tdep_diatoms , mort_Tdep_sp , mort_Tdep_phaeo , & + k_exude_diatoms , k_exude_sp , k_exude_phaeo , & + K_Nit_diatoms , K_Nit_sp , K_Nit_phaeo , & + K_Am_diatoms , K_Am_sp , K_Am_phaeo , & + K_Sil_diatoms , K_Sil_sp , K_Sil_phaeo , & + K_Fe_diatoms , K_Fe_sp , K_Fe_phaeo , & + f_don_protein , kn_bac_protein , f_don_Am_protein , & + f_doc_s , f_doc_l , f_exude_s , & + f_exude_l , k_bac_s , k_bac_l , & + T_max , fsal , op_dep_min , & + fr_graze_s , fr_graze_e , fr_mort2min , & + fr_dFe , k_nitrif , t_iron_conv , & + max_loss , max_dfe_doc1 , fr_resp_s , & + y_sk_DMS , t_sk_conv , t_sk_ox , & + algaltype_diatoms , algaltype_sp , algaltype_phaeo , & + doctype_s , doctype_l , dontype_protein , & + fedtype_1 , feptype_1 , zaerotype_bc1 , & + zaerotype_bc2 , zaerotype_dust1 , zaerotype_dust2 , & + zaerotype_dust3 , zaerotype_dust4 , ratio_C2N_diatoms , & + ratio_C2N_sp , ratio_C2N_phaeo , ratio_chl2N_diatoms, & + ratio_chl2N_sp , ratio_chl2N_phaeo , F_abs_chl_diatoms , & + F_abs_chl_sp , F_abs_chl_phaeo , ratio_C2N_proteins + +!======================================================================= + + contains + +!======================================================================= +! +! Initialize the vertical profile of ice salinity and melting temperature. +! +! authors: C. M. Bitz, UW +! William H. Lipscomb, LANL + + subroutine init_thermo_vertical + + use ice_flux, only: salinz, Tmltz + + integer (kind=int_kind) :: & + i, j, iblk, & ! horizontal indices + k ! ice layer index + + real (kind=dbl_kind), dimension(nilyr+1) :: & + sprofile ! vertical salinity profile + + real (kind=dbl_kind) :: & + depressT + + character(len=*), parameter :: subname='(init_thermo_vertical)' + + !----------------------------------------------------------------- + ! initialize + !----------------------------------------------------------------- + + call icepack_query_parameters(depressT_out=depressT) + call icepack_init_thermo(nilyr=nilyr, sprofile=sprofile) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + + !----------------------------------------------------------------- + ! Prescibe vertical profile of salinity and melting temperature. + ! Note this profile is only used for BL99 thermodynamics. + !----------------------------------------------------------------- + + !$OMP PARALLEL DO PRIVATE(iblk,i,j,k) + do iblk = 1,max_blocks + do j = 1, ny_block + do i = 1, nx_block + do k = 1, nilyr+1 + salinz(i,j,k,iblk) = sprofile(k) + Tmltz (i,j,k,iblk) = -salinz(i,j,k,iblk)*depressT + enddo ! k + enddo ! i + enddo ! j + enddo ! iblk + !$OMP END PARALLEL DO + + end subroutine init_thermo_vertical + +!======================================================================= +! +! Initialize shortwave + + subroutine init_shortwave + + use ice_arrays_column, only: fswpenln, Iswabsn, Sswabsn, albicen, & + albsnon, alvdrn, alidrn, alvdfn, alidfn, fswsfcn, & + fswthrun, fswthrun_vdr, fswthrun_vdf, fswthrun_idr, fswthrun_idf, & + fswintn, albpndn, apeffn, trcrn_sw, dhsn, ffracn, snowfracn, & + kaer_tab, waer_tab, gaer_tab, kaer_bc_tab, waer_bc_tab, gaer_bc_tab, bcenh, & + swgrid, igrid + use ice_blocks, only: block, get_block + use ice_calendar, only: dt, calendar_type, & + days_per_year, nextsw_cday, yday, msec + use ice_diagnostics, only: npnt, print_points, pmloc, piloc, pjloc + use ice_domain, only: nblocks, blocks_ice + use ice_flux, only: alvdf, alidf, alvdr, alidr, & + alvdr_ai, alidr_ai, alvdf_ai, alidf_ai, & + swvdr, swvdf, swidr, swidf, scale_factor, snowfrac, & + albice, albsno, albpnd, apeff_ai, coszen, fsnow + use ice_grid, only: tlat, tlon, tmask + use ice_restart_shared, only: restart, runtype + use ice_state, only: aicen, vicen, vsnon, trcrn + + integer (kind=int_kind) :: & + i, j , k , & ! horizontal indices + iblk , & ! block index + ilo,ihi,jlo,jhi, & ! beginning and end of physical domain + n ! thickness category index + + real (kind=dbl_kind) :: & + netsw ! flag for shortwave radiation presence + + type (block) :: & + this_block ! block information for current block + + logical (kind=log_kind) :: & + l_print_point, & ! flag to print designated grid point diagnostics + debug, & ! if true, print diagnostics + dEdd_algae, & ! use prognostic chla in dEdd radiation + modal_aero, & ! use modal aerosol optical treatment + snwgrain ! use variable snow radius + + character (char_len) :: shortwave + + integer (kind=int_kind) :: & + ipoint + + real (kind=dbl_kind), dimension(ncat) :: & + fbri ! brine height to ice thickness + + real(kind= dbl_kind), dimension(:,:), allocatable :: & + ztrcr_sw, & ! zaerosols (kg/m^3) and chla (mg/m^3) + rsnow ! snow grain radius tracer (10^-6 m) + + logical (kind=log_kind) :: tr_brine, tr_zaero, tr_bgc_n + integer (kind=int_kind) :: nt_alvl, nt_apnd, nt_hpnd, nt_ipnd, nt_aero, & + nt_fbri, nt_tsfc, ntrcr, nbtrcr, nbtrcr_sw, nt_rsnw + integer (kind=int_kind), dimension(icepack_max_algae) :: & + nt_bgc_N + integer (kind=int_kind), dimension(icepack_max_aero) :: & + nt_zaero + real (kind=dbl_kind) :: puny + + character(len=*), parameter :: subname='(init_shortwave)' + + call icepack_query_parameters(puny_out=puny) + call icepack_query_parameters(shortwave_out=shortwave) + call icepack_query_parameters(dEdd_algae_out=dEdd_algae) + call icepack_query_parameters(modal_aero_out=modal_aero) + call icepack_query_parameters(snwgrain_out=snwgrain) + call icepack_query_tracer_sizes(ntrcr_out=ntrcr, nbtrcr_out=nbtrcr, nbtrcr_sw_out=nbtrcr_sw) + call icepack_query_tracer_flags(tr_brine_out=tr_brine, tr_zaero_out=tr_zaero, & + tr_bgc_n_out=tr_bgc_n) + call icepack_query_tracer_indices(nt_alvl_out=nt_alvl, nt_apnd_out=nt_apnd, nt_hpnd_out=nt_hpnd, & + nt_ipnd_out=nt_ipnd, nt_aero_out=nt_aero, nt_fbri_out=nt_fbri, nt_tsfc_out=nt_tsfc, & + nt_bgc_N_out=nt_bgc_N, nt_zaero_out=nt_zaero, nt_rsnw_out=nt_rsnw) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__,line= __LINE__) + + allocate(ztrcr_sw(nbtrcr_sw, ncat)) + allocate(rsnow(nslyr,ncat)) + + do iblk=1,nblocks + + ! Initialize + fswpenln(:,:,:,:,iblk) = c0 + Iswabsn(:,:,:,:,iblk) = c0 + Sswabsn(:,:,:,:,iblk) = c0 + + this_block = get_block(blocks_ice(iblk),iblk) + ilo = this_block%ilo + ihi = this_block%ihi + jlo = this_block%jlo + jhi = this_block%jhi + + do j = 1, ny_block ! can be jlo, jhi + do i = 1, nx_block ! can be ilo, ihi + + l_print_point = .false. + debug = .false. + if (debug .and. print_points) then + do ipoint = 1, npnt + if (my_task == pmloc(ipoint) .and. & + i == piloc(ipoint) .and. & + j == pjloc(ipoint)) & + l_print_point = .true. + write (nu_diag, *) 'my_task = ',my_task + enddo ! n + endif + + alvdf(i,j,iblk) = c0 + alidf(i,j,iblk) = c0 + alvdr(i,j,iblk) = c0 + alidr(i,j,iblk) = c0 + alvdr_ai(i,j,iblk) = c0 + alidr_ai(i,j,iblk) = c0 + alvdf_ai(i,j,iblk) = c0 + alidf_ai(i,j,iblk) = c0 + albice(i,j,iblk) = c0 + albsno(i,j,iblk) = c0 + albpnd(i,j,iblk) = c0 + snowfrac(i,j,iblk) = c0 + apeff_ai(i,j,iblk) = c0 + + do n = 1, ncat + alvdrn(i,j,n,iblk) = c0 + alidrn(i,j,n,iblk) = c0 + alvdfn(i,j,n,iblk) = c0 + alidfn(i,j,n,iblk) = c0 + fswsfcn(i,j,n,iblk) = c0 + fswintn(i,j,n,iblk) = c0 + fswthrun(i,j,n,iblk) = c0 + fswthrun_vdr(i,j,n,iblk) = c0 + fswthrun_vdf(i,j,n,iblk) = c0 + fswthrun_idr(i,j,n,iblk) = c0 + fswthrun_idf(i,j,n,iblk) = c0 + enddo ! ncat + + enddo + enddo + do j = jlo, jhi + do i = ilo, ihi + + if (trim(shortwave) == 'dEdd') then ! delta Eddington + +#ifndef CESMCOUPLED + ! initialize orbital parameters + ! These come from the driver in the coupled model. + call icepack_init_orbit() + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(subname//' init_orbit', & + file=__FILE__, line=__LINE__) +#endif + endif + + fbri(:) = c0 + ztrcr_sw(:,:) = c0 + rsnow (:,:) = c0 + do n = 1, ncat + if (tr_brine) fbri(n) = trcrn(i,j,nt_fbri,n,iblk) + if (snwgrain) then + do k = 1, nslyr + rsnow(k,n) = trcrn(i,j,nt_rsnw+k-1,n,iblk) + enddo + endif + enddo + + if (tmask(i,j,iblk)) then + call icepack_step_radiation (dt=dt, ncat=ncat, & + nblyr=nblyr, nilyr=nilyr, nslyr=nslyr, & + dEdd_algae=dEdd_algae, & + swgrid=swgrid(:), igrid=igrid(:), & + fbri=fbri(:), & + aicen=aicen(i,j,:,iblk), & + vicen=vicen(i,j,:,iblk), & + vsnon=vsnon(i,j,:,iblk), & + Tsfcn=trcrn(i,j,nt_Tsfc,:,iblk), & + alvln=trcrn(i,j,nt_alvl,:,iblk), & + apndn=trcrn(i,j,nt_apnd,:,iblk), & + hpndn=trcrn(i,j,nt_hpnd,:,iblk), & + ipndn=trcrn(i,j,nt_ipnd,:,iblk), & + aeron=trcrn(i,j,nt_aero:nt_aero+4*n_aero-1,:,iblk), & + bgcNn=trcrn(i,j,nt_bgc_N(1):nt_bgc_N(1)+n_algae*(nblyr+3)-1,:,iblk), & + zaeron=trcrn(i,j,nt_zaero(1):nt_zaero(1)+n_zaero*(nblyr+3)-1,:,iblk), & + trcrn_bgcsw=ztrcr_sw, & + TLAT=TLAT(i,j,iblk), TLON=TLON(i,j,iblk), & + calendar_type=calendar_type, & + days_per_year=days_per_year, & + nextsw_cday=nextsw_cday, yday=yday, & + sec=msec, & + kaer_tab=kaer_tab, kaer_bc_tab=kaer_bc_tab(:,:), & + waer_tab=waer_tab, waer_bc_tab=waer_bc_tab(:,:), & + gaer_tab=gaer_tab, gaer_bc_tab=gaer_bc_tab(:,:), & + bcenh=bcenh(:,:,:), & + modal_aero=modal_aero, & + swvdr=swvdr(i,j,iblk), swvdf=swvdf(i,j,iblk),& + swidr=swidr(i,j,iblk), swidf=swidf(i,j,iblk),& + coszen=coszen(i,j,iblk), fsnow=fsnow(i,j,iblk),& + alvdrn=alvdrn(i,j,:,iblk), alvdfn=alvdfn(i,j,:,iblk), & + alidrn=alidrn(i,j,:,iblk), alidfn=alidfn(i,j,:,iblk), & + fswsfcn=fswsfcn(i,j,:,iblk), fswintn=fswintn(i,j,:,iblk), & + fswthrun=fswthrun(i,j,:,iblk), & +!opt fswthrun_vdr=fswthrun_vdr(i,j,:,iblk), & +!opt fswthrun_vdf=fswthrun_vdf(i,j,:,iblk), & +!opt fswthrun_idr=fswthrun_idr(i,j,:,iblk), & +!opt fswthrun_idf=fswthrun_idf(i,j,:,iblk), & + fswpenln=fswpenln(i,j,:,:,iblk), & + Sswabsn=Sswabsn(i,j,:,:,iblk), Iswabsn=Iswabsn(i,j,:,:,iblk), & + albicen=albicen(i,j,:,iblk), albsnon=albsnon(i,j,:,iblk), & + albpndn=albpndn(i,j,:,iblk), apeffn=apeffn(i,j,:,iblk), & + snowfracn=snowfracn(i,j,:,iblk), & + dhsn=dhsn(i,j,:,iblk), ffracn=ffracn(i,j,:,iblk), & +!opt rsnow=rsnow(:,:), & + l_print_point=l_print_point, & + initonly = .true.) + endif + + !----------------------------------------------------------------- + ! Define aerosol tracer on shortwave grid + !----------------------------------------------------------------- + + if (dEdd_algae .and. (tr_zaero .or. tr_bgc_N)) then + do n = 1, ncat + do k = 1, nbtrcr_sw + trcrn_sw(i,j,k,n,iblk) = ztrcr_sw(k,n) + enddo + enddo + endif + + enddo ! i + enddo ! j + + !----------------------------------------------------------------- + ! Aggregate albedos + ! Match loop order in coupling_prep for same order of operations + !----------------------------------------------------------------- + + do n = 1, ncat + do j = jlo, jhi + do i = ilo, ihi + + if (aicen(i,j,n,iblk) > puny) then + + alvdf(i,j,iblk) = alvdf(i,j,iblk) & + + alvdfn(i,j,n,iblk)*aicen(i,j,n,iblk) + alidf(i,j,iblk) = alidf(i,j,iblk) & + + alidfn(i,j,n,iblk)*aicen(i,j,n,iblk) + alvdr(i,j,iblk) = alvdr(i,j,iblk) & + + alvdrn(i,j,n,iblk)*aicen(i,j,n,iblk) + alidr(i,j,iblk) = alidr(i,j,iblk) & + + alidrn(i,j,n,iblk)*aicen(i,j,n,iblk) + + netsw = swvdr(i,j,iblk) + swidr(i,j,iblk) & + + swvdf(i,j,iblk) + swidf(i,j,iblk) + if (netsw > puny) then ! sun above horizon + albice(i,j,iblk) = albice(i,j,iblk) & + + albicen(i,j,n,iblk)*aicen(i,j,n,iblk) + albsno(i,j,iblk) = albsno(i,j,iblk) & + + albsnon(i,j,n,iblk)*aicen(i,j,n,iblk) + albpnd(i,j,iblk) = albpnd(i,j,iblk) & + + albpndn(i,j,n,iblk)*aicen(i,j,n,iblk) + endif + + apeff_ai(i,j,iblk) = apeff_ai(i,j,iblk) & + + apeffn(i,j,n,iblk)*aicen(i,j,n,iblk) + snowfrac(i,j,iblk) = snowfrac(i,j,iblk) & + + snowfracn(i,j,n,iblk)*aicen(i,j,n,iblk) + + endif ! aicen > puny + + enddo ! i + enddo ! j + enddo ! ncat + + do j = 1, ny_block + do i = 1, nx_block + + !---------------------------------------------------------------- + ! Store grid box mean albedos and fluxes before scaling by aice + !---------------------------------------------------------------- + + alvdf_ai (i,j,iblk) = alvdf (i,j,iblk) + alidf_ai (i,j,iblk) = alidf (i,j,iblk) + alvdr_ai (i,j,iblk) = alvdr (i,j,iblk) + alidr_ai (i,j,iblk) = alidr (i,j,iblk) + + ! for history averaging +!echmod? cszn = c0 +!echmod if (coszen(i,j,iblk) > puny) cszn = c1 +!echmod do n = 1, nstreams +!echmod albcnt(i,j,iblk,n) = albcnt(i,j,iblk,n) + cszn +!echmod enddo + + !---------------------------------------------------------------- + ! Save net shortwave for scaling factor in scale_factor + !---------------------------------------------------------------- + if (runtype == 'initial' .and. .not. restart) then + scale_factor(i,j,iblk) = & + swvdr(i,j,iblk)*(c1 - alvdr_ai(i,j,iblk)) & + + swvdf(i,j,iblk)*(c1 - alvdf_ai(i,j,iblk)) & + + swidr(i,j,iblk)*(c1 - alidr_ai(i,j,iblk)) & + + swidf(i,j,iblk)*(c1 - alidf_ai(i,j,iblk)) + endif + + enddo ! i + enddo ! j + enddo ! iblk + + deallocate(ztrcr_sw) + deallocate(rsnow) + + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + + end subroutine init_shortwave + +!======================================================================= + +! Initialize ice age tracer (call prior to reading restart data) + + subroutine init_age(iage) + + real(kind=dbl_kind), dimension(:,:,:), intent(out) :: iage + character(len=*),parameter :: subname='(init_age)' + + iage(:,:,:) = c0 + + end subroutine init_age + +!======================================================================= + +! Initialize ice FY tracer (call prior to reading restart data) + + subroutine init_FY(firstyear) + + real(kind=dbl_kind), dimension(:,:,:), intent(out) :: firstyear + character(len=*),parameter :: subname='(init_FY)' + + firstyear(:,:,:) = c0 + + end subroutine init_FY + +!======================================================================= + +! Initialize ice lvl tracers (call prior to reading restart data) + + subroutine init_lvl(iblk, alvl, vlvl) + + use ice_constants, only: c0, c1 + use ice_arrays_column, only: ffracn, dhsn + + integer (kind=int_kind), intent(in) :: iblk + + real (kind=dbl_kind), dimension(:,:,:), intent(out) :: & + alvl , & ! level ice area fraction + vlvl ! level ice volume + character(len=*),parameter :: subname='(init_lvl)' + + alvl(:,:,:) = c1 ! level ice area fraction + vlvl(:,:,:) = c1 ! level ice volume + ffracn(:,:,:,iblk) = c0 + dhsn(:,:,:,iblk) = c0 + + end subroutine init_lvl + +!======================================================================= + +! Initialize melt ponds. + + subroutine init_meltponds_lvl(apnd, hpnd, ipnd, dhsn) + + real(kind=dbl_kind), dimension(:,:,:), intent(out) :: & + apnd , & ! melt pond area fraction + hpnd , & ! melt pond depth + ipnd , & ! melt pond refrozen lid thickness + dhsn ! depth difference for snow on sea ice and pond ice + character(len=*),parameter :: subname='(init_meltponds_lvl)' + + apnd(:,:,:) = c0 + hpnd(:,:,:) = c0 + ipnd(:,:,:) = c0 + dhsn(:,:,:) = c0 + + end subroutine init_meltponds_lvl + +!======================================================================= + +! Initialize melt ponds. + + subroutine init_meltponds_topo(apnd, hpnd, ipnd) + + real(kind=dbl_kind), dimension(:,:,:), intent(out) :: & + apnd , & ! melt pond area fraction + hpnd , & ! melt pond depth + ipnd ! melt pond refrozen lid thickness + character(len=*),parameter :: subname='(init_meltponds_topo)' + + apnd(:,:,:) = c0 + hpnd(:,:,:) = c0 + ipnd(:,:,:) = c0 + + end subroutine init_meltponds_topo + +!======================================================================= + +! Initialize snow redistribution/metamorphosis tracers (call prior to reading restart data) + + subroutine init_snowtracers(smice, smliq, rhos_cmp, rsnw) + + real(kind=dbl_kind), dimension(:,:,:,:), intent(out) :: & + smice, smliq, rhos_cmp, rsnw + character(len=*),parameter :: subname='(init_snowtracers)' + + real (kind=dbl_kind) :: & + rsnw_fall, & ! snow grain radius of new fallen snow (10^-6 m) + rhos ! snow density (kg/m^3) + + call icepack_query_parameters(rsnw_fall_out=rsnw_fall, rhos_out=rhos) + + rsnw (:,:,:,:) = rsnw_fall + rhos_cmp(:,:,:,:) = rhos + smice (:,:,:,:) = rhos + smliq (:,:,:,:) = c0 + + end subroutine init_snowtracers + +!======================================================================= + +! Initialize floe size distribution tracer (call prior to reading restart data) + + subroutine init_fsd(floesize) + + use ice_arrays_column, only: floe_rad_c, floe_binwidth, & + wavefreq, dwavefreq, wave_sig_ht, wave_spectrum, & + d_afsd_newi, d_afsd_latg, d_afsd_latm, d_afsd_wave, d_afsd_weld + use ice_domain_size, only: ncat, max_blocks, nfsd + use ice_init, only: ice_ic + use ice_state, only: aicen + + real(kind=dbl_kind), dimension(:,:,:,:,:), intent(out) :: & + floesize ! floe size distribution tracer + + ! local variables + + real (kind=dbl_kind), dimension(nfsd) :: & + afsd ! floe size distribution "profile" + + real (kind=dbl_kind), dimension(nfsd,ncat) :: & + afsdn ! floe size distribution "profile" + + real (kind=dbl_kind) :: puny + + integer (kind=int_kind) :: & + i, j, iblk , & ! horizontal indices + n, k ! category index + + logical (kind=log_kind) :: tr_fsd + + character(len=*), parameter :: subname='(init_fsd)' + + call icepack_query_parameters(puny_out=puny) + + wavefreq (:) = c0 + dwavefreq (:) = c0 + wave_sig_ht (:,:,:) = c0 + wave_spectrum (:,:,:,:) = c0 + d_afsd_newi (:,:,:,:) = c0 + d_afsd_latg (:,:,:,:) = c0 + d_afsd_latm (:,:,:,:) = c0 + d_afsd_wave (:,:,:,:) = c0 + d_afsd_weld (:,:,:,:) = c0 + + ! default: floes occupy the smallest size category in all thickness categories + afsdn(:,:) = c0 + afsdn(1,:) = c1 + floesize(:,:,:,:,:) = c0 + floesize(:,:,1,:,:) = c1 + + call icepack_query_tracer_flags(tr_fsd_out=tr_fsd) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__,line= __LINE__) + + if (tr_fsd) then + + ! initialize floe size distribution the same in every column and category + call icepack_init_fsd(nfsd, ice_ic, & + floe_rad_c, & ! fsd size bin centre in m (radius) + floe_binwidth, & ! fsd size bin width in m (radius) + afsd) ! floe size distribution + + do iblk = 1, max_blocks + do j = 1, ny_block + do i = 1, nx_block + do n = 1, ncat + do k = 1, nfsd + if (aicen(i,j,n,iblk) > puny) afsdn(k,n) = afsd(k) + enddo ! k + enddo ! n + + call icepack_cleanup_fsd (ncat, nfsd, afsdn) ! renormalize + + do n = 1, ncat + do k = 1, nfsd + floesize(i,j,k,n,iblk) = afsdn(k,n) + enddo ! k + enddo ! n + enddo ! i + enddo ! j + enddo ! iblk + + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + + endif ! tr_fsd + + end subroutine init_fsd + +!======================================================================= + +! Initialize isotope tracers (call prior to reading restart data) + + subroutine init_isotope(isosno, isoice) + + real(kind=dbl_kind), dimension(:,:,:,:), intent(out) :: & + isosno, isoice + character(len=*),parameter :: subname='(init_isotope)' + + isosno(:,:,:,:) = c0 + isoice(:,:,:,:) = c0 + + end subroutine init_isotope + +!======================================================================= + +! Initialize ice aerosol tracer (call prior to reading restart data) + + subroutine init_aerosol(aero) + + real(kind=dbl_kind), dimension(:,:,:,:), intent(out) :: & + aero ! aerosol tracers + character(len=*),parameter :: subname='(init_aerosol)' + + aero(:,:,:,:) = c0 + + end subroutine init_aerosol + +!======================================================================= + +! Initialize vertical profile for biogeochemistry + + subroutine init_bgc() + + use ice_arrays_column, only: zfswin, trcrn_sw, & + ocean_bio_all, ice_bio_net, snow_bio_net, & + cgrid, igrid, bphi, iDi, bTiz, iki, & + Rayleigh_criteria, Rayleigh_real + use ice_blocks, only: block, get_block + use ice_domain, only: nblocks, blocks_ice + use ice_flux, only: sss + use ice_flux_bgc, only: nit, amm, sil, dmsp, dms, algalN, & + doc, don, dic, fed, fep, zaeros, hum + use ice_forcing_bgc, only: init_bgc_data, get_forcing_bgc + use ice_restart_column, only: restart_zsal, & + read_restart_bgc, restart_bgc + use ice_state, only: trcrn + + ! local variables + + integer (kind=int_kind) :: & + i, j, iblk , & ! horizontal indices + ilo,ihi,jlo,jhi , & ! beginning and end of physical domain + k , & ! vertical index + n ! category index + + integer (kind=int_kind) :: & + max_nbtrcr, max_algae, max_don, max_doc, max_dic, max_aero, max_fe + + logical (kind=log_kind) :: & + RayleighC , & + solve_zsal + + type (block) :: & + this_block ! block information for current block + + real(kind=dbl_kind), allocatable :: & + trcrn_bgc(:,:) + + real(kind=dbl_kind), dimension(nilyr,ncat) :: & + sicen + + real(kind=dbl_kind) :: & + RayleighR + + integer (kind=int_kind) :: & + nbtrcr, ntrcr, ntrcr_o, & + nt_sice, nt_bgc_S + + character(len=*), parameter :: subname='(init_bgc)' + + ! Initialize + + call icepack_query_parameters(solve_zsal_out=solve_zsal) + call icepack_query_tracer_sizes(nbtrcr_out=nbtrcr, ntrcr_out=ntrcr, ntrcr_o_out=ntrcr_o) + call icepack_query_tracer_indices(nt_sice_out=nt_sice, nt_bgc_S_out=nt_bgc_S) + call icepack_query_tracer_sizes(max_nbtrcr_out=max_nbtrcr, & + max_algae_out=max_algae, max_don_out=max_don, max_doc_out=max_doc, & + max_dic_out=max_dic, max_aero_out=max_aero, max_fe_out=max_fe) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__,line= __LINE__) + + allocate(trcrn_bgc(ntrcr,ncat)) + + bphi(:,:,:,:,:) = c0 ! initial porosity for no ice + iDi (:,:,:,:,:) = c0 ! interface diffusivity + bTiz(:,:,:,:,:) = c0 ! initial bio grid ice temperature + iki (:,:,:,:,:) = c0 ! permeability + + ocean_bio_all(:,:,:,:) = c0 + ice_bio_net (:,:,:,:) = c0 ! integrated ice tracer conc (mmol/m^2 or mg/m^2) + snow_bio_net (:,:,:,:) = c0 ! integrated snow tracer conc (mmol/m^2 or mg/m^2) + zfswin (:,:,:,:,:) = c0 ! shortwave flux on bio grid + trcrn_sw (:,:,:,:,:) = c0 ! tracers active in the shortwave calculation + trcrn_bgc (:,:) = c0 + RayleighR = c0 + RayleighC = .false. + + !----------------------------------------------------------------- + ! zsalinity initialization + !----------------------------------------------------------------- + + if (solve_zsal) then ! default values + + !$OMP PARALLEL DO PRIVATE(iblk,i,j,k,n,ilo,ihi,jlo,jhi,this_block,trcrn_bgc) + do iblk = 1, nblocks + + this_block = get_block(blocks_ice(iblk),iblk) + ilo = this_block%ilo + ihi = this_block%ihi + jlo = this_block%jlo + jhi = this_block%jhi + + do j = jlo, jhi + do i = ilo, ihi + call icepack_init_zsalinity(nblyr=nblyr, ntrcr_o=ntrcr_o, & + Rayleigh_criteria = RayleighC, & + Rayleigh_real = RayleighR, & + trcrn_bgc = trcrn_bgc, & + nt_bgc_S = nt_bgc_S, & + ncat = ncat, & + sss = sss(i,j,iblk)) + if (.not. restart_zsal) then + Rayleigh_real (i,j,iblk) = RayleighR + Rayleigh_criteria(i,j,iblk) = RayleighC + do n = 1,ncat + do k = 1, nblyr + trcrn (i,j,nt_bgc_S+k-1, n,iblk) = & + trcrn_bgc( nt_bgc_S+k-1-ntrcr_o,n) + enddo + enddo + endif + enddo ! i + enddo ! j + enddo ! iblk + !$OMP END PARALLEL DO + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + endif ! solve_zsal + + if (.not. solve_zsal) restart_zsal = .false. + + !----------------------------------------------------------------- + ! biogeochemistry initialization + !----------------------------------------------------------------- + + if (.not. restart_bgc) then + + !----------------------------------------------------------------- + ! Initial Ocean Values if not coupled to the ocean bgc + !----------------------------------------------------------------- + !$OMP PARALLEL DO PRIVATE(iblk,i,j,n,ilo,ihi,jlo,jhi,this_block) + do iblk = 1, nblocks + + this_block = get_block(blocks_ice(iblk),iblk) + ilo = this_block%ilo + ihi = this_block%ihi + jlo = this_block%jlo + jhi = this_block%jhi + + do j = jlo, jhi + do i = ilo, ihi + call icepack_init_ocean_bio ( & + amm=amm (i,j, iblk), dmsp=dmsp(i,j, iblk), dms=dms(i,j, iblk), & + algalN=algalN(i,j,:,iblk), doc=doc (i,j,:,iblk), dic=dic(i,j,:,iblk), & + don=don (i,j,:,iblk), fed=fed (i,j,:,iblk), fep=fep(i,j,:,iblk), & + hum=hum (i,j, iblk), nit=nit (i,j, iblk), sil=sil(i,j, iblk), & + zaeros=zaeros(i,j,:,iblk), & + max_dic = icepack_max_dic, max_don = icepack_max_don, & + max_fe = icepack_max_fe, max_aero = icepack_max_aero) + enddo ! i + enddo ! j + + enddo ! iblk + !$OMP END PARALLEL DO + + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + + call init_bgc_data(fed(:,:,1,:),fep(:,:,1,:)) ! input dFe from file + call get_forcing_bgc ! defines nit and sil + + endif ! .not. restart + + !$OMP PARALLEL DO PRIVATE(iblk,i,j,n,ilo,ihi,jlo,jhi,this_block) + do iblk = 1, nblocks + + this_block = get_block(blocks_ice(iblk),iblk) + ilo = this_block%ilo + ihi = this_block%ihi + jlo = this_block%jlo + jhi = this_block%jhi + + do j = jlo, jhi + do i = ilo, ihi + + call icepack_load_ocean_bio_array(max_nbtrcr=icepack_max_nbtrcr, & + max_algae=icepack_max_algae, max_don=icepack_max_don, & + max_doc=icepack_max_doc, max_fe=icepack_max_fe, & + max_dic=icepack_max_dic, max_aero=icepack_max_aero, & + nit =nit (i,j, iblk), amm=amm(i,j, iblk), sil =sil (i,j, iblk), & + dmsp=dmsp(i,j, iblk), dms=dms(i,j, iblk), algalN=algalN(i,j,:,iblk), & + doc =doc (i,j,:,iblk), don=don(i,j,:,iblk), dic =dic (i,j,:,iblk), & + fed =fed (i,j,:,iblk), fep=fep(i,j,:,iblk), zaeros=zaeros(i,j,:,iblk), & + hum=hum (i,j, iblk), ocean_bio_all=ocean_bio_all(i,j,:,iblk)) + + enddo ! i + enddo ! j + + enddo ! iblk + !$OMP END PARALLEL DO + + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + + if (.not. restart_bgc) then + !$OMP PARALLEL DO PRIVATE(iblk,i,j,k,n,ilo,ihi,jlo,jhi,this_block,sicen,trcrn_bgc) + do iblk = 1, nblocks + + this_block = get_block(blocks_ice(iblk),iblk) + ilo = this_block%ilo + ihi = this_block%ihi + jlo = this_block%jlo + jhi = this_block%jhi + + do j = jlo, jhi + do i = ilo, ihi + do n = 1, ncat + do k = 1, nilyr + sicen(k,n) = trcrn(i,j,nt_sice+k-1,n,iblk) + enddo + do k = ntrcr_o+1, ntrcr + trcrn_bgc(k-ntrcr_o,n) = trcrn(i,j,k,n,iblk) + enddo + enddo + call icepack_init_bgc(ncat=ncat, nblyr=nblyr, nilyr=nilyr, ntrcr_o=ntrcr_o, & + cgrid=cgrid, igrid=igrid, ntrcr=ntrcr, nbtrcr=nbtrcr, & + sicen=sicen(:,:), trcrn=trcrn_bgc(:,:), sss=sss(i,j, iblk), & + ocean_bio_all=ocean_bio_all(i,j,:,iblk)) + enddo ! i + enddo ! j + enddo ! iblk + !$OMP END PARALLEL DO + + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + + endif ! .not. restart + + !----------------------------------------------------------------- + ! read restart to complete BGC initialization + !----------------------------------------------------------------- + + if (restart_zsal .or. restart_bgc) call read_restart_bgc + + deallocate(trcrn_bgc) + + end subroutine init_bgc + +!======================================================================= + +! Initialize brine height tracer + + subroutine init_hbrine() + + use ice_arrays_column, only: first_ice, bgrid, igrid, cgrid, & + icgrid, swgrid + use ice_state, only: trcrn + + real (kind=dbl_kind) :: phi_snow + integer (kind=int_kind) :: nt_fbri + logical (kind=log_kind) :: tr_brine + character(len=*), parameter :: subname='(init_hbrine)' + + call icepack_query_parameters(phi_snow_out=phi_snow) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__,line= __LINE__) + + call icepack_init_hbrine(bgrid=bgrid, igrid=igrid, cgrid=cgrid, icgrid=icgrid, & + swgrid=swgrid, nblyr=nblyr, nilyr=nilyr, phi_snow=phi_snow) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + + call icepack_init_parameters(phi_snow_in=phi_snow) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__,line= __LINE__) + + call icepack_query_tracer_flags(tr_brine_out=tr_brine) + call icepack_query_tracer_indices(nt_fbri_out=nt_fbri) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__,line= __LINE__) + + first_ice(:,:,:,:) = .true. + if (tr_brine) trcrn(:,:,nt_fbri,:,:) = c1 + + end subroutine init_hbrine + +!======================================================================= + +! Namelist variables, set to default values; may be altered at run time +! +! author Elizabeth C. Hunke, LANL +! Nicole Jeffery, LANL + + subroutine input_zbgc + + use ice_arrays_column, only: restore_bgc, optics_file, optics_file_fieldname + use ice_broadcast, only: broadcast_scalar + use ice_restart_column, only: restart_bgc, restart_zsal, & + restart_hbrine + use ice_restart_shared, only: restart + + character (len=char_len) :: & + shortwave ! from icepack + + logical (kind=log_kind) :: & + tr_brine, & + tr_bgc_Nit, tr_bgc_Am, tr_bgc_Sil, & + tr_bgc_DMS, tr_bgc_PON, & + tr_bgc_N, tr_bgc_C, tr_bgc_chl, & + tr_bgc_DON, tr_bgc_Fe, tr_zaero, & + tr_bgc_hum, tr_aero + + integer (kind=int_kind) :: & + ktherm + + logical (kind=log_kind) :: & + solve_zsal, skl_bgc, z_tracers, scale_bgc, solve_zbgc, dEdd_algae, & + modal_aero + + character (char_len) :: & + bgc_flux_type + + integer (kind=int_kind) :: & + nml_error, & ! namelist i/o error flag + abort_flag + + character(len=*), parameter :: subname='(input_zbgc)' + + !----------------------------------------------------------------- + ! namelist variables + !----------------------------------------------------------------- + + namelist /zbgc_nml/ & + tr_brine, restart_hbrine, tr_zaero, modal_aero, skl_bgc, & + z_tracers, dEdd_algae, solve_zbgc, bgc_flux_type, & + restore_bgc, restart_bgc, scale_bgc, solve_zsal, restart_zsal, & + tr_bgc_Nit, tr_bgc_C, tr_bgc_chl, tr_bgc_Am, tr_bgc_Sil, & + tr_bgc_DMS, tr_bgc_PON, tr_bgc_hum, tr_bgc_DON, tr_bgc_Fe, & + grid_o, grid_o_t, l_sk, grid_oS, optics_file, optics_file_fieldname, & + l_skS, phi_snow, initbio_frac, frazil_scav, & + ratio_Si2N_diatoms , ratio_Si2N_sp , ratio_Si2N_phaeo , & + ratio_S2N_diatoms , ratio_S2N_sp , ratio_S2N_phaeo , & + ratio_Fe2C_diatoms , ratio_Fe2C_sp , ratio_Fe2C_phaeo , & + ratio_Fe2N_diatoms , ratio_Fe2N_sp , ratio_Fe2N_phaeo , & + ratio_Fe2DON , ratio_Fe2DOC_s , ratio_Fe2DOC_l , & + fr_resp , tau_min , tau_max , & + algal_vel , R_dFe2dust , dustFe_sol , & + chlabs_diatoms , chlabs_sp , chlabs_phaeo , & + alpha2max_low_diatoms,alpha2max_low_sp , alpha2max_low_phaeo, & + beta2max_diatoms , beta2max_sp , beta2max_phaeo , & + mu_max_diatoms , mu_max_sp , mu_max_phaeo , & + grow_Tdep_diatoms , grow_Tdep_sp , grow_Tdep_phaeo , & + fr_graze_diatoms , fr_graze_sp , fr_graze_phaeo , & + mort_pre_diatoms , mort_pre_sp , mort_pre_phaeo , & + mort_Tdep_diatoms , mort_Tdep_sp , mort_Tdep_phaeo , & + k_exude_diatoms , k_exude_sp , k_exude_phaeo , & + K_Nit_diatoms , K_Nit_sp , K_Nit_phaeo , & + K_Am_diatoms , K_Am_sp , K_Am_phaeo , & + K_Sil_diatoms , K_Sil_sp , K_Sil_phaeo , & + K_Fe_diatoms , K_Fe_sp , K_Fe_phaeo , & + f_don_protein , kn_bac_protein , f_don_Am_protein , & + f_doc_s , f_doc_l , f_exude_s , & + f_exude_l , k_bac_s , k_bac_l , & + T_max , fsal , op_dep_min , & + fr_graze_s , fr_graze_e , fr_mort2min , & + fr_dFe , k_nitrif , t_iron_conv , & + max_loss , max_dfe_doc1 , fr_resp_s , & + y_sk_DMS , t_sk_conv , t_sk_ox , & + algaltype_diatoms , algaltype_sp , algaltype_phaeo , & + nitratetype , ammoniumtype , silicatetype , & + dmspptype , dmspdtype , humtype , & + doctype_s , doctype_l , dontype_protein , & + fedtype_1 , feptype_1 , zaerotype_bc1 , & + zaerotype_bc2 , zaerotype_dust1 , zaerotype_dust2 , & + zaerotype_dust3 , zaerotype_dust4 , ratio_C2N_diatoms , & + ratio_C2N_sp , ratio_C2N_phaeo , ratio_chl2N_diatoms, & + ratio_chl2N_sp , ratio_chl2N_phaeo , F_abs_chl_diatoms , & + F_abs_chl_sp , F_abs_chl_phaeo , ratio_C2N_proteins + + !----------------------------------------------------------------- + + abort_flag = 0 + + call icepack_query_tracer_flags(tr_aero_out=tr_aero) + call icepack_query_parameters(ktherm_out=ktherm, shortwave_out=shortwave) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + + !----------------------------------------------------------------- + ! default values + !----------------------------------------------------------------- + tr_brine = .false. ! brine height differs from ice height + tr_zaero = .false. ! z aerosol tracers + modal_aero = .false. ! use modal aerosol treatment of aerosols + optics_file = 'unknown_optics_file' ! modal aerosol optics file + optics_file_fieldname = 'unknown_optics_fieldname' ! modal aerosol optics file fieldname + restore_bgc = .false. ! restore bgc if true + solve_zsal = .false. ! update salinity tracer profile from solve_S_dt + restart_bgc = .false. ! biogeochemistry restart + restart_zsal = .false. ! salinity restart + restart_hbrine = .false. ! hbrine restart + scale_bgc = .false. ! initial bgc tracers proportional to S + skl_bgc = .false. ! solve skeletal biochemistry + z_tracers = .false. ! solve vertically resolved tracers + dEdd_algae = .false. ! dynamic algae contributes to shortwave absorption + ! in delta-Eddington calculation + solve_zbgc = .false. ! turn on z layer biochemistry + tr_bgc_PON = .false. !--------------------------------------------- + tr_bgc_Nit = .false. ! biogeochemistry (skl or zbgc) + tr_bgc_C = .false. ! if skl_bgc = .true. then skl + tr_bgc_chl = .false. ! if z_tracers = .true. then vertically resolved + tr_bgc_Sil = .false. ! if z_tracers + solve_zbgc = .true. then + tr_bgc_Am = .false. ! vertically resolved with reactions + tr_bgc_DMS = .false. !------------------------------------------------ + tr_bgc_DON = .false. ! + tr_bgc_hum = .false. ! + tr_bgc_Fe = .false. ! + tr_bgc_N = .true. ! + + ! brine height parameter + phi_snow = p5 ! snow porosity + + ! skl biology parameters + bgc_flux_type = 'Jin2006'! type of ocean-ice poston velocity ('constant') + + ! z biology parameters + grid_o = c5 ! for bottom flux + grid_o_t = c5 ! for top flux + l_sk = 7.0_dbl_kind ! characteristic diffusive scale (m) + initbio_frac = c1 ! fraction of ocean trcr concentration in bio trcrs + frazil_scav = c1 ! increase in initial bio tracer from ocean scavenging + ratio_Si2N_diatoms = 1.8_dbl_kind ! algal Si to N (mol/mol) + ratio_Si2N_sp = c0 ! diatoms, small plankton, phaeocystis + ratio_Si2N_phaeo = c0 + ratio_S2N_diatoms = 0.03_dbl_kind ! algal S to N (mol/mol) + ratio_S2N_sp = 0.03_dbl_kind + ratio_S2N_phaeo = 0.03_dbl_kind + ratio_Fe2C_diatoms = 0.0033_dbl_kind ! algal Fe to C (umol/mol) + ratio_Fe2C_sp = 0.0033_dbl_kind + ratio_Fe2C_phaeo = p1 + ratio_Fe2N_diatoms = 0.023_dbl_kind ! algal Fe to N (umol/mol) + ratio_Fe2N_sp = 0.023_dbl_kind + ratio_Fe2N_phaeo = 0.7_dbl_kind + ratio_Fe2DON = 0.023_dbl_kind ! Fe to N of DON (nmol/umol) + ratio_Fe2DOC_s = p1 ! Fe to C of DOC (nmol/umol) saccharids + ratio_Fe2DOC_l = 0.033_dbl_kind ! Fe to C of DOC (nmol/umol) lipids + fr_resp = 0.05_dbl_kind ! frac of algal growth lost due to respiration + tau_min = 5200.0_dbl_kind ! rapid mobile to stationary exchanges (s) + tau_max = 1.73e5_dbl_kind ! long time mobile to stationary exchanges (s) + algal_vel = 1.11e-8_dbl_kind! 0.5 cm/d(m/s) Lavoie 2005 1.5 cm/day + R_dFe2dust = 0.035_dbl_kind ! g/g (3.5% content) Tagliabue 2009 + dustFe_sol = 0.005_dbl_kind ! solubility fraction + chlabs_diatoms = 0.03_dbl_kind ! chl absorption (1/m/(mg/m^3)) + chlabs_sp = 0.01_dbl_kind + chlabs_phaeo = 0.05_dbl_kind + alpha2max_low_diatoms = 0.8_dbl_kind ! light limitation (1/(W/m^2)) + alpha2max_low_sp = 0.67_dbl_kind + alpha2max_low_phaeo = 0.67_dbl_kind + beta2max_diatoms = 0.018_dbl_kind ! light inhibition (1/(W/m^2)) + beta2max_sp = 0.0025_dbl_kind + beta2max_phaeo = 0.01_dbl_kind + mu_max_diatoms = 1.2_dbl_kind ! maximum growth rate (1/day) + mu_max_sp = 0.851_dbl_kind + mu_max_phaeo = 0.851_dbl_kind + grow_Tdep_diatoms = 0.06_dbl_kind ! Temperature dependence of growth (1/C) + grow_Tdep_sp = 0.06_dbl_kind + grow_Tdep_phaeo = 0.06_dbl_kind + fr_graze_diatoms = 0.01_dbl_kind ! Fraction grazed + fr_graze_sp = p1 + fr_graze_phaeo = p1 + mort_pre_diatoms = 0.007_dbl_kind! Mortality (1/day) + mort_pre_sp = 0.007_dbl_kind + mort_pre_phaeo = 0.007_dbl_kind + mort_Tdep_diatoms = 0.03_dbl_kind ! T dependence of mortality (1/C) + mort_Tdep_sp = 0.03_dbl_kind + mort_Tdep_phaeo = 0.03_dbl_kind + k_exude_diatoms = c0 ! algal exudation (1/d) + k_exude_sp = c0 + k_exude_phaeo = c0 + K_Nit_diatoms = c1 ! nitrate half saturation (mmol/m^3) + K_Nit_sp = c1 + K_Nit_phaeo = c1 + K_Am_diatoms = 0.3_dbl_kind ! ammonium half saturation (mmol/m^3) + K_Am_sp = 0.3_dbl_kind + K_Am_phaeo = 0.3_dbl_kind + K_Sil_diatoms = 4.0_dbl_kind ! silicate half saturation (mmol/m^3) + K_Sil_sp = c0 + K_Sil_phaeo = c0 + K_Fe_diatoms = c1 ! iron half saturation (nM) + K_Fe_sp = 0.2_dbl_kind + K_Fe_phaeo = p1 + f_don_protein = 0.6_dbl_kind ! fraction of spilled grazing to proteins + kn_bac_protein = 0.03_dbl_kind ! Bacterial degredation of DON (1/d) + f_don_Am_protein = 0.25_dbl_kind ! fraction of remineralized DON to ammonium + f_doc_s = 0.4_dbl_kind ! fraction of mortality to DOC + f_doc_l = 0.4_dbl_kind + f_exude_s = c1 ! fraction of exudation to DOC + f_exude_l = c1 + k_bac_s = 0.03_dbl_kind ! Bacterial degredation of DOC (1/d) + k_bac_l = 0.03_dbl_kind + T_max = c0 ! maximum temperature (C) + fsal = c1 ! Salinity limitation (ppt) + op_dep_min = p1 ! Light attenuates for optical depths exceeding min + fr_graze_s = p5 ! fraction of grazing spilled or slopped + fr_graze_e = p5 ! fraction of assimilation excreted + fr_mort2min = p5 ! fractionation of mortality to Am + fr_dFe = 0.3_dbl_kind ! fraction of remineralized nitrogen + ! (in units of algal iron) + k_nitrif = c0 ! nitrification rate (1/day) + t_iron_conv = 3065.0_dbl_kind ! desorption loss pFe to dFe (day) + max_loss = 0.9_dbl_kind ! restrict uptake to % of remaining value + max_dfe_doc1 = 0.2_dbl_kind ! max ratio of dFe to saccharides in the ice + !(nM Fe/muM C) + fr_resp_s = 0.75_dbl_kind ! DMSPd fraction of respiration loss as DMSPd + y_sk_DMS = p5 ! fraction conversion given high yield + t_sk_conv = 3.0_dbl_kind ! Stefels conversion time (d) + t_sk_ox = 10.0_dbl_kind ! DMS oxidation time (d) + algaltype_diatoms = c0 ! ------------------ + algaltype_sp = p5 ! + algaltype_phaeo = p5 ! + nitratetype = -c1 ! mobility type between + ammoniumtype = c1 ! stationary <--> mobile + silicatetype = -c1 ! + dmspptype = p5 ! + dmspdtype = -c1 ! + humtype = c1 ! + doctype_s = p5 ! + doctype_l = p5 ! + dontype_protein = p5 ! + fedtype_1 = p5 ! + feptype_1 = p5 ! + zaerotype_bc1 = c1 ! + zaerotype_bc2 = c1 ! + zaerotype_dust1 = c1 ! + zaerotype_dust2 = c1 ! + zaerotype_dust3 = c1 ! + zaerotype_dust4 = c1 !-------------------- + ratio_C2N_diatoms = 7.0_dbl_kind ! algal C to N ratio (mol/mol) + ratio_C2N_sp = 7.0_dbl_kind + ratio_C2N_phaeo = 7.0_dbl_kind + ratio_chl2N_diatoms= 2.1_dbl_kind ! algal chlorophyll to N ratio (mg/mmol) + ratio_chl2N_sp = 1.1_dbl_kind + ratio_chl2N_phaeo = 0.84_dbl_kind + F_abs_chl_diatoms = 2.0_dbl_kind ! scales absorbed radiation for dEdd + F_abs_chl_sp = 4.0_dbl_kind + F_abs_chl_phaeo = 5.0 + ratio_C2N_proteins = 7.0_dbl_kind ! ratio of C to N in proteins (mol/mol) + + ! z salinity parameters + grid_oS = c5 ! for bottom flux + l_skS = 7.0_dbl_kind ! characteristic diffusive scale (m) + + !----------------------------------------------------------------- + ! read from input file + !----------------------------------------------------------------- + + if (my_task == master_task) then + write(nu_diag,*) subname,' Reading zbgc_nml' + + call get_fileunit(nu_nml) + open (nu_nml, file=trim(nml_filename), status='old',iostat=nml_error) + if (nml_error /= 0) then + call abort_ice(subname//'ERROR: zbgc_nml open file '// & + trim(nml_filename), & + file=__FILE__, line=__LINE__) + endif + + nml_error = 1 + do while (nml_error > 0) + read(nu_nml, nml=zbgc_nml,iostat=nml_error) + end do + if (nml_error /= 0) then + call abort_ice(subname//'ERROR: zbgc_nml reading ', & + file=__FILE__, line=__LINE__) + endif + close(nu_nml) + call release_fileunit(nu_nml) + endif + + !----------------------------------------------------------------- + ! broadcast + !----------------------------------------------------------------- + + call broadcast_scalar(solve_zsal, master_task) + call broadcast_scalar(restart_zsal, master_task) + call broadcast_scalar(tr_brine, master_task) + call broadcast_scalar(restart_hbrine, master_task) + + call broadcast_scalar(phi_snow, master_task) + call broadcast_scalar(grid_oS, master_task) + call broadcast_scalar(l_skS, master_task) + + call broadcast_scalar(solve_zbgc, master_task) + call broadcast_scalar(skl_bgc, master_task) + call broadcast_scalar(restart_bgc, master_task) + call broadcast_scalar(bgc_flux_type, master_task) + call broadcast_scalar(restore_bgc, master_task) + call broadcast_scalar(tr_bgc_N, master_task) + call broadcast_scalar(tr_bgc_C, master_task) + call broadcast_scalar(tr_bgc_chl, master_task) + call broadcast_scalar(tr_bgc_Nit, master_task) + call broadcast_scalar(tr_bgc_Am, master_task) + call broadcast_scalar(tr_bgc_Sil, master_task) + call broadcast_scalar(tr_bgc_hum, master_task) + call broadcast_scalar(tr_bgc_DMS, master_task) + call broadcast_scalar(tr_bgc_PON, master_task) + call broadcast_scalar(tr_bgc_DON, master_task) + call broadcast_scalar(tr_bgc_Fe, master_task) + + call broadcast_scalar(z_tracers, master_task) + call broadcast_scalar(tr_zaero, master_task) + call broadcast_scalar(dEdd_algae, master_task) + call broadcast_scalar(modal_aero, master_task) + call broadcast_scalar(optics_file, master_task) + call broadcast_scalar(optics_file_fieldname, master_task) + call broadcast_scalar(grid_o, master_task) + call broadcast_scalar(grid_o_t, master_task) + call broadcast_scalar(l_sk, master_task) + call broadcast_scalar(scale_bgc, master_task) + call broadcast_scalar(initbio_frac, master_task) + call broadcast_scalar(frazil_scav, master_task) + call broadcast_scalar(ratio_Si2N_diatoms, master_task) + call broadcast_scalar(ratio_Si2N_sp, master_task) + call broadcast_scalar(ratio_Si2N_phaeo, master_task) + call broadcast_scalar(ratio_S2N_diatoms, master_task) + call broadcast_scalar(ratio_S2N_sp, master_task) + call broadcast_scalar(ratio_S2N_phaeo, master_task) + call broadcast_scalar(ratio_Fe2C_diatoms, master_task) + call broadcast_scalar(ratio_Fe2C_sp, master_task) + call broadcast_scalar(ratio_Fe2C_phaeo, master_task) + call broadcast_scalar(ratio_Fe2N_diatoms, master_task) + call broadcast_scalar(ratio_Fe2N_sp, master_task) + call broadcast_scalar(ratio_Fe2N_phaeo, master_task) + call broadcast_scalar(ratio_Fe2DON , master_task) + call broadcast_scalar(ratio_Fe2DOC_s , master_task) + call broadcast_scalar(ratio_Fe2DOC_l , master_task) + call broadcast_scalar(fr_resp , master_task) + call broadcast_scalar(tau_min , master_task) + call broadcast_scalar(tau_max , master_task) + call broadcast_scalar(algal_vel , master_task) + call broadcast_scalar(R_dFe2dust , master_task) + call broadcast_scalar(dustFe_sol , master_task) + call broadcast_scalar(chlabs_diatoms , master_task) + call broadcast_scalar(chlabs_sp , master_task) + call broadcast_scalar(chlabs_phaeo , master_task) + call broadcast_scalar(alpha2max_low_diatoms , master_task) + call broadcast_scalar(alpha2max_low_sp , master_task) + call broadcast_scalar(alpha2max_low_phaeo , master_task) + call broadcast_scalar(beta2max_diatoms , master_task) + call broadcast_scalar(beta2max_sp , master_task) + call broadcast_scalar(beta2max_phaeo , master_task) + call broadcast_scalar(mu_max_diatoms , master_task) + call broadcast_scalar(mu_max_sp , master_task) + call broadcast_scalar(mu_max_phaeo , master_task) + call broadcast_scalar(grow_Tdep_diatoms, master_task) + call broadcast_scalar(grow_Tdep_sp , master_task) + call broadcast_scalar(grow_Tdep_phaeo , master_task) + call broadcast_scalar(fr_graze_diatoms , master_task) + call broadcast_scalar(fr_graze_sp , master_task) + call broadcast_scalar(fr_graze_phaeo , master_task) + call broadcast_scalar(mort_pre_diatoms , master_task) + call broadcast_scalar(mort_pre_sp , master_task) + call broadcast_scalar(mort_pre_phaeo , master_task) + call broadcast_scalar(mort_Tdep_diatoms, master_task) + call broadcast_scalar(mort_Tdep_sp , master_task) + call broadcast_scalar(mort_Tdep_phaeo , master_task) + call broadcast_scalar(k_exude_diatoms , master_task) + call broadcast_scalar(k_exude_sp , master_task) + call broadcast_scalar(k_exude_phaeo , master_task) + call broadcast_scalar(K_Nit_diatoms , master_task) + call broadcast_scalar(K_Nit_sp , master_task) + call broadcast_scalar(K_Nit_phaeo , master_task) + call broadcast_scalar(K_Am_diatoms , master_task) + call broadcast_scalar(K_Am_sp , master_task) + call broadcast_scalar(K_Am_phaeo , master_task) + call broadcast_scalar(K_Sil_diatoms , master_task) + call broadcast_scalar(K_Sil_sp , master_task) + call broadcast_scalar(K_Sil_phaeo , master_task) + call broadcast_scalar(K_Fe_diatoms , master_task) + call broadcast_scalar(K_Fe_sp , master_task) + call broadcast_scalar(K_Fe_phaeo , master_task) + call broadcast_scalar(f_don_protein , master_task) + call broadcast_scalar(kn_bac_protein , master_task) + call broadcast_scalar(f_don_Am_protein , master_task) + call broadcast_scalar(f_doc_s , master_task) + call broadcast_scalar(f_doc_l , master_task) + call broadcast_scalar(f_exude_s , master_task) + call broadcast_scalar(f_exude_l , master_task) + call broadcast_scalar(k_bac_s , master_task) + call broadcast_scalar(k_bac_l , master_task) + call broadcast_scalar(T_max , master_task) + call broadcast_scalar(fsal , master_task) + call broadcast_scalar(op_dep_min , master_task) + call broadcast_scalar(fr_graze_s , master_task) + call broadcast_scalar(fr_graze_e , master_task) + call broadcast_scalar(fr_mort2min , master_task) + call broadcast_scalar(fr_dFe , master_task) + call broadcast_scalar(k_nitrif , master_task) + call broadcast_scalar(t_iron_conv , master_task) + call broadcast_scalar(max_loss , master_task) + call broadcast_scalar(max_dfe_doc1 , master_task) + call broadcast_scalar(fr_resp_s , master_task) + call broadcast_scalar(y_sk_DMS , master_task) + call broadcast_scalar(t_sk_conv , master_task) + call broadcast_scalar(t_sk_ox , master_task) + call broadcast_scalar(algaltype_diatoms, master_task) + call broadcast_scalar(algaltype_sp , master_task) + call broadcast_scalar(algaltype_phaeo , master_task) + call broadcast_scalar(nitratetype , master_task) + call broadcast_scalar(ammoniumtype , master_task) + call broadcast_scalar(silicatetype , master_task) + call broadcast_scalar(dmspptype , master_task) + call broadcast_scalar(dmspdtype , master_task) + call broadcast_scalar(humtype , master_task) + call broadcast_scalar(doctype_s , master_task) + call broadcast_scalar(doctype_l , master_task) + call broadcast_scalar(dontype_protein , master_task) + call broadcast_scalar(fedtype_1 , master_task) + call broadcast_scalar(feptype_1 , master_task) + call broadcast_scalar(zaerotype_bc1 , master_task) + call broadcast_scalar(zaerotype_bc2 , master_task) + call broadcast_scalar(zaerotype_dust1 , master_task) + call broadcast_scalar(zaerotype_dust2 , master_task) + call broadcast_scalar(zaerotype_dust3 , master_task) + call broadcast_scalar(zaerotype_dust4 , master_task) + call broadcast_scalar(ratio_C2N_diatoms , master_task) + call broadcast_scalar(ratio_C2N_sp , master_task) + call broadcast_scalar(ratio_C2N_phaeo , master_task) + call broadcast_scalar(ratio_chl2N_diatoms, master_task) + call broadcast_scalar(ratio_chl2N_sp , master_task) + call broadcast_scalar(ratio_chl2N_phaeo , master_task) + call broadcast_scalar(F_abs_chl_diatoms , master_task) + call broadcast_scalar(F_abs_chl_sp , master_task) + call broadcast_scalar(F_abs_chl_phaeo , master_task) + call broadcast_scalar(ratio_C2N_proteins , master_task) + + !----------------------------------------------------------------- + ! zsalinity and brine + !----------------------------------------------------------------- + + if (.not.restart) then + if (my_task == master_task) & + write(nu_diag,*) subname//' WARNING: restart = false, setting bgc restart flags to false' + restart_bgc = .false. + restart_hbrine = .false. + restart_zsal = .false. + endif + + if (solve_zsal) then + if (my_task == master_task) then + write(nu_diag,*) subname,' ERROR: solve_zsal=T deprecated' + endif + abort_flag = 101 + endif + +#ifdef UNDEPRECATE_ZSAL + if (solve_zsal .and. nblyr < 1) then + if (my_task == master_task) then + write(nu_diag,*) subname,' ERROR: solve_zsal=T but 0 zsalinity tracers' + endif + abort_flag = 101 + endif + + if (solve_zsal .and. ((.not. tr_brine) .or. (ktherm /= 1))) then + if (my_task == master_task) then + write(nu_diag,*) subname,' ERROR: solve_zsal needs tr_brine=T and ktherm=1' + endif + abort_flag = 102 + endif +#endif + + if (tr_brine .and. nblyr < 1 ) then + if (my_task == master_task) then + write(nu_diag,*) subname,' ERROR: tr_brine=T but no biology layers compiled' + endif + abort_flag = 103 + endif + + !----------------------------------------------------------------- + ! biogeochemistry + !----------------------------------------------------------------- + + if (.not. tr_brine) then + if (solve_zbgc) then + if (my_task == master_task) then + write(nu_diag,*) subname,' ERROR: tr_brine = F and solve_zbgc = T' + endif + abort_flag = 104 + endif + if (tr_zaero) then + if (my_task == master_task) then + write(nu_diag,*) subname,' ERROR: tr_brine = F and tr_zaero = T' + endif + abort_flag = 105 + endif + endif + + if ((skl_bgc .AND. solve_zbgc) .or. (skl_bgc .AND. z_tracers)) then + if (my_task == master_task) then + write(nu_diag,*) subname,' ERROR: skl_bgc and solve_zbgc or z_tracers are both true' + endif + abort_flag = 106 + endif + + if (skl_bgc .AND. tr_zaero) then + if (my_task == master_task) then + write(nu_diag,*) subname,' ERROR: skl_bgc does not use vertical tracers' + endif + abort_flag = 107 + endif + + if (dEdd_algae .AND. trim(shortwave) /= 'dEdd') then + if (my_task == master_task) then + write(nu_diag,*) subname,' ERROR: dEdd_algae = T but shortwave /= dEdd' + endif + abort_flag = 108 + endif + + if (dEdd_algae .AND. (.NOT. tr_bgc_N) .AND. (.NOT. tr_zaero)) then + if (my_task == master_task) then + write(nu_diag,*) subname,' ERROR: need tr_bgc_N or tr_zaero for dEdd_algae' + endif + abort_flag = 109 + endif + + if (modal_aero .AND. (.NOT. tr_zaero) .AND. (.NOT. tr_aero)) then + if (my_task == master_task) then + write(nu_diag,*) subname,' ERROR: modal_aero T with tr_zaero and tr_aero' + endif + abort_flag = 110 + endif + + if (modal_aero .AND. trim(shortwave) /= 'dEdd') then + if (my_task == master_task) then + write(nu_diag,*) subname,' ERROR: modal_aero = T but shortwave /= dEdd' + endif + abort_flag = 111 + endif + if (n_algae > icepack_max_algae) then + if (my_task == master_task) then + write(nu_diag,*) subname//'ERROR: number of algal types exceeds icepack_max_algae' + endif + abort_flag = 112 + endif + if (n_doc > icepack_max_doc) then + if (my_task == master_task) then + write(nu_diag,*) subname//'ERROR: number of doc types exceeds icepack_max_doc' + endif + abort_flag = 113 + endif + if (n_dic > icepack_max_doc) then + if (my_task == master_task) then + write(nu_diag,*) subname//'ERROR: number of dic types exceeds icepack_max_dic' + endif + abort_flag = 114 + endif + if (n_don > icepack_max_don) then + if (my_task == master_task) then + write(nu_diag,*) subname//'ERROR: number of don types exceeds icepack_max_don' + endif + abort_flag = 115 + endif + if (n_fed > icepack_max_fe ) then + if (my_task == master_task) then + write(nu_diag,*) subname//'ERROR: number of dissolved fe types exceeds icepack_max_fe ' + endif + abort_flag = 116 + endif + if (n_fep > icepack_max_fe ) then + if (my_task == master_task) then + write(nu_diag,*) subname//'ERROR: number of particulate fe types exceeds icepack_max_fe ' + endif + abort_flag = 117 + endif + + if (n_algae == 0 .and. skl_bgc) then + if (my_task == master_task) then + write(nu_diag,*) subname//'ERROR: skl_bgc=T but 0 bgc or algal tracers compiled' + endif + abort_flag = 118 + endif + + if (n_algae == 0 .and. solve_zbgc) then + if (my_task == master_task) then + write(nu_diag,*) subname//'ERROR: solve_zbgc=T but 0 zbgc or algal tracers compiled' + endif + abort_flag = 119 + endif + + if (solve_zbgc .and. .not. z_tracers) then + if (my_task == master_task) then + write(nu_diag,*) subname//'ERROR: solve_zbgc=T but not z_tracers' + endif + abort_flag = 120 + endif + + if (skl_bgc .or. solve_zbgc) then + if (.not. tr_bgc_N) then + if (my_task == master_task) then + write(nu_diag,*) subname//'ERROR: tr_bgc_N must be on for bgc' + endif + abort_flag = 121 + endif + if (.not. tr_bgc_Nit) then + if (my_task == master_task) then + write(nu_diag,*) subname//'ERROR: tr_bgc_Nit must be on for bgc' + endif + abort_flag = 122 + endif + else + ! tcraig, allow bgc to be turned off in this case? + tr_bgc_N = .false. + tr_bgc_C = .false. + tr_bgc_chl = .false. + tr_bgc_Nit = .false. + tr_bgc_Am = .false. + tr_bgc_Sil = .false. + tr_bgc_hum = .false. + tr_bgc_DMS = .false. + tr_bgc_PON = .false. + tr_bgc_DON = .false. + tr_bgc_Fe = .false. + endif + + !----------------------------------------------------------------- + ! z layer aerosols + !----------------------------------------------------------------- + if (tr_zaero .and. .not. z_tracers) then + if (my_task == master_task) then + write(nu_diag,*) subname//'ERROR: tr_zaero and not z_tracers' + endif + abort_flag = 123 + endif + + if (n_zaero > icepack_max_aero) then + if (my_task == master_task) then + write(nu_diag,*) subname//'ERROR: number of z aerosols exceeds icepack_max_aero' + endif + abort_flag = 124 + endif + + !----------------------------------------------------------------- + ! output + !----------------------------------------------------------------- + + if (my_task == master_task) then + write(nu_diag,1010) ' tr_brine = ', tr_brine + if (tr_brine) then + write(nu_diag,1010) ' restart_hbrine = ', restart_hbrine + write(nu_diag,1005) ' phi_snow = ', phi_snow + endif + write(nu_diag,1010) ' solve_zsal = ', solve_zsal + if (solve_zsal) then + write(nu_diag,1010) ' restart_zsal = ', restart_zsal + write(nu_diag,1000) ' grid_oS = ', grid_oS + write(nu_diag,1005) ' l_skS = ', l_skS + endif + + write(nu_diag,1010) ' skl_bgc = ', skl_bgc + write(nu_diag,1010) ' restart_bgc = ', restart_bgc + write(nu_diag,1010) ' tr_bgc_N = ', tr_bgc_N + write(nu_diag,1010) ' tr_bgc_C = ', tr_bgc_C + write(nu_diag,1010) ' tr_bgc_chl = ', tr_bgc_chl + write(nu_diag,1010) ' tr_bgc_Nit = ', tr_bgc_Nit + write(nu_diag,1010) ' tr_bgc_Am = ', tr_bgc_Am + write(nu_diag,1010) ' tr_bgc_Sil = ', tr_bgc_Sil + write(nu_diag,1010) ' tr_bgc_hum = ', tr_bgc_hum + write(nu_diag,1010) ' tr_bgc_DMS = ', tr_bgc_DMS + write(nu_diag,1010) ' tr_bgc_PON = ', tr_bgc_PON + write(nu_diag,1010) ' tr_bgc_DON = ', tr_bgc_DON + write(nu_diag,1010) ' tr_bgc_Fe = ', tr_bgc_Fe + write(nu_diag,1020) ' n_aero = ', n_aero + write(nu_diag,1020) ' n_zaero = ', n_zaero + write(nu_diag,1020) ' n_algae = ', n_algae + write(nu_diag,1020) ' n_doc = ', n_doc + write(nu_diag,1020) ' n_dic = ', n_dic + write(nu_diag,1020) ' n_don = ', n_don + write(nu_diag,1020) ' n_fed = ', n_fed + write(nu_diag,1020) ' n_fep = ', n_fep + + if (skl_bgc) then + + write(nu_diag,1030) ' bgc_flux_type = ', bgc_flux_type + write(nu_diag,1010) ' restore_bgc = ', restore_bgc + + elseif (z_tracers) then + + write(nu_diag,1010) ' dEdd_algae = ', dEdd_algae + write(nu_diag,1010) ' modal_aero = ', modal_aero + write(nu_diag,1010) ' scale_bgc = ', scale_bgc + write(nu_diag,1010) ' solve_zbgc = ', solve_zbgc + write(nu_diag,1010) ' tr_zaero = ', tr_zaero + write(nu_diag,1020) ' number of aerosols = ', n_zaero + write(nu_diag,1031) ' optics_file = ', trim(optics_file) + write(nu_diag,1031) ' optics_file_fieldname = ', trim(optics_file_fieldname) + ! bio parameters + write(nu_diag,1000) ' grid_o = ', grid_o + write(nu_diag,1000) ' grid_o_t = ', grid_o_t + write(nu_diag,1005) ' l_sk = ', l_sk + write(nu_diag,1000) ' initbio_frac = ', initbio_frac + write(nu_diag,1000) ' frazil_scav = ', frazil_scav + + endif ! skl_bgc or solve_bgc + endif + + !----------------------------------------------------------------- + ! abort if abort flag is set + !----------------------------------------------------------------- + + if (abort_flag /= 0) then + call flush_fileunit(nu_diag) + endif + call ice_barrier() + if (abort_flag /= 0) then + write(nu_diag,*) subname,' ERROR: abort_flag=',abort_flag + call abort_ice (subname//' ABORTING on input ERRORS', & + file=__FILE__, line=__LINE__) + endif + + !----------------------------------------------------------------- + ! set values in icepack + !----------------------------------------------------------------- + + call icepack_init_parameters( & + ktherm_in=ktherm, shortwave_in=shortwave, solve_zsal_in=solve_zsal, & + skl_bgc_in=skl_bgc, z_tracers_in=z_tracers, scale_bgc_in=scale_bgc, & + dEdd_algae_in=dEdd_algae, & + solve_zbgc_in=solve_zbgc, & + bgc_flux_type_in=bgc_flux_type, grid_o_in=grid_o, l_sk_in=l_sk, & + initbio_frac_in=initbio_frac, & + grid_oS_in=grid_oS, l_skS_in=l_skS, & + phi_snow_in=phi_snow, frazil_scav_in = frazil_scav, & + modal_aero_in=modal_aero) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + + call icepack_init_tracer_flags(tr_brine_in=tr_brine, & + tr_bgc_Nit_in=tr_bgc_Nit, tr_bgc_Am_in =tr_bgc_Am, tr_bgc_Sil_in=tr_bgc_Sil, & + tr_bgc_DMS_in=tr_bgc_DMS, tr_bgc_PON_in=tr_bgc_PON, & + tr_bgc_N_in =tr_bgc_N, tr_bgc_C_in =tr_bgc_C, tr_bgc_chl_in=tr_bgc_chl, & + tr_bgc_DON_in=tr_bgc_DON, tr_bgc_Fe_in =tr_bgc_Fe, tr_zaero_in =tr_zaero, & + tr_bgc_hum_in=tr_bgc_hum) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + + 1000 format (a30,2x,f9.2) ! a30 to align formatted, unformatted statements + 1005 format (a30,2x,f9.6) ! float + 1010 format (a30,2x,l6) ! logical + 1020 format (a30,2x,i6) ! integer + 1030 format (a30, a8) ! character + 1031 format (a30, a ) ! character + + end subroutine input_zbgc + +!======================================================================= + +! Count and index tracers +! +! author Elizabeth C. Hunke, LANL + + subroutine count_tracers + + use ice_domain_size, only: nilyr, nslyr, nblyr, nfsd, n_iso, & + n_aero, n_zaero, n_algae, n_doc, n_dic, n_don, n_fed, n_fep + + ! local variables + + integer (kind=int_kind) :: & + k, mm , & ! loop index + nk , & ! layer index + nk_bgc ! layer index + + integer (kind=int_kind) :: ntrcr + logical (kind=log_kind) :: tr_iage, tr_FY, tr_lvl, tr_pond, tr_aero, tr_fsd + logical (kind=log_kind) :: tr_snow + logical (kind=log_kind) :: tr_iso, tr_pond_lvl, tr_pond_topo + integer (kind=int_kind) :: nt_Tsfc, nt_sice, nt_qice, nt_qsno, nt_iage, nt_FY + integer (kind=int_kind) :: nt_alvl, nt_vlvl, nt_apnd, nt_hpnd, nt_ipnd, nt_aero + integer (kind=int_kind) :: nt_fsd, nt_isosno, nt_isoice + integer (kind=int_kind) :: nt_smice, nt_smliq, nt_rhos, nt_rsnw + + integer (kind=int_kind) :: & + nbtrcr, nbtrcr_sw, & + ntrcr_o, nt_fbri, & + nt_bgc_Nit, nt_bgc_Am, nt_bgc_Sil, & + nt_bgc_DMS, nt_bgc_PON, nt_bgc_S, & + nt_bgc_DMSPp, nt_bgc_DMSPd, & + nt_zbgc_frac, nlt_chl_sw, & + nlt_bgc_Nit, nlt_bgc_Am, nlt_bgc_Sil, & + nlt_bgc_DMS, nlt_bgc_DMSPp, nlt_bgc_DMSPd, & + nlt_bgc_PON, nt_bgc_hum, nlt_bgc_hum + + integer (kind=int_kind), dimension(icepack_max_aero) :: & + nlt_zaero_sw ! points to aerosol in trcrn_sw + + integer (kind=int_kind), dimension(icepack_max_algae) :: & + nlt_bgc_N , & ! algae + nlt_bgc_chl + + integer (kind=int_kind), dimension(icepack_max_doc) :: & + nlt_bgc_DOC ! disolved organic carbon + + integer (kind=int_kind), dimension(icepack_max_don) :: & + nlt_bgc_DON ! + + integer (kind=int_kind), dimension(icepack_max_dic) :: & + nlt_bgc_DIC ! disolved inorganic carbon + + integer (kind=int_kind), dimension(icepack_max_fe) :: & + nlt_bgc_Fed , & ! + nlt_bgc_Fep ! + + integer (kind=int_kind), dimension(icepack_max_aero) :: & + nlt_zaero ! non-reacting layer aerosols + + integer (kind=int_kind), dimension(icepack_max_algae) :: & + nt_bgc_N , & ! diatoms, phaeocystis, pico/small + nt_bgc_chl ! diatoms, phaeocystis, pico/small + + integer (kind=int_kind), dimension(icepack_max_doc) :: & + nt_bgc_DOC ! dissolved organic carbon + + integer (kind=int_kind), dimension(icepack_max_don) :: & + nt_bgc_DON ! dissolved organic nitrogen + + integer (kind=int_kind), dimension(icepack_max_dic) :: & + nt_bgc_DIC ! dissolved inorganic carbon + + integer (kind=int_kind), dimension(icepack_max_fe) :: & + nt_bgc_Fed, & ! dissolved iron + nt_bgc_Fep ! particulate iron + + integer (kind=int_kind), dimension(icepack_max_aero) :: & + nt_zaero ! black carbon and other aerosols + + logical (kind=log_kind) :: & + tr_brine, & + tr_bgc_Nit, tr_bgc_Am, tr_bgc_Sil, & + tr_bgc_DMS, tr_bgc_PON, & + tr_bgc_N, tr_bgc_C, tr_bgc_chl, & + tr_bgc_DON, tr_bgc_Fe, tr_zaero, & + tr_bgc_hum + + logical (kind=log_kind) :: & + solve_zsal, skl_bgc, z_tracers + + character(len=*), parameter :: subname='(count_tracers)' + + !----------------------------------------------------------------- + + call icepack_query_parameters( & + solve_zsal_out=solve_zsal, & + skl_bgc_out=skl_bgc, z_tracers_out=z_tracers) + + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + + call icepack_query_tracer_flags(tr_iage_out=tr_iage, tr_FY_out=tr_FY, & + tr_lvl_out=tr_lvl, tr_aero_out=tr_aero, tr_pond_out=tr_pond, & + tr_pond_lvl_out=tr_pond_lvl, & + tr_pond_topo_out=tr_pond_topo, tr_brine_out=tr_brine, tr_fsd_out=tr_fsd, & + tr_snow_out=tr_snow, tr_iso_out=tr_iso, & + tr_bgc_Nit_out=tr_bgc_Nit, tr_bgc_Am_out =tr_bgc_Am, tr_bgc_Sil_out=tr_bgc_Sil, & + tr_bgc_DMS_out=tr_bgc_DMS, tr_bgc_PON_out=tr_bgc_PON, & + tr_bgc_N_out =tr_bgc_N, tr_bgc_C_out =tr_bgc_C, tr_bgc_chl_out=tr_bgc_chl, & + tr_bgc_DON_out=tr_bgc_DON, tr_bgc_Fe_out =tr_bgc_Fe, tr_zaero_out =tr_zaero, & + tr_bgc_hum_out=tr_bgc_hum) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + + ntrcr = 0 + + ntrcr = ntrcr + 1 ! count tracers, starting with Tsfc = 1 + nt_Tsfc = ntrcr ! index tracers, starting with Tsfc = 1 + + nt_qice = ntrcr + 1 + ntrcr = ntrcr + nilyr ! qice in nilyr layers + + nt_qsno = ntrcr + 1 + ntrcr = ntrcr + nslyr ! qsno in nslyr layers + + nt_sice = ntrcr + 1 + ntrcr = ntrcr + nilyr ! sice in nilyr layers + + nt_iage = 0 + if (tr_iage) then + ntrcr = ntrcr + 1 + nt_iage = ntrcr ! chronological ice age + endif + + nt_FY = 0 + if (tr_FY) then + ntrcr = ntrcr + 1 + nt_FY = ntrcr ! area of first year ice + endif + + nt_alvl = 0 + nt_vlvl = 0 + if (tr_lvl) then + ntrcr = ntrcr + 1 + nt_alvl = ntrcr + ntrcr = ntrcr + 1 + nt_vlvl = ntrcr + endif + + nt_apnd = 0 + nt_hpnd = 0 + nt_ipnd = 0 + if (tr_pond) then ! all explicit melt pond schemes + ntrcr = ntrcr + 1 + nt_apnd = ntrcr + ntrcr = ntrcr + 1 + nt_hpnd = ntrcr + if (tr_pond_lvl) then + ntrcr = ntrcr + 1 ! refrozen pond ice lid thickness + nt_ipnd = ntrcr ! on level-ice ponds (if frzpnd='hlid') + endif + if (tr_pond_topo) then + ntrcr = ntrcr + 1 ! + nt_ipnd = ntrcr ! refrozen pond ice lid thickness + endif + endif + + nt_smice = 0 + nt_smliq = 0 + nt_rhos = 0 + nt_rsnw = 0 + if (tr_snow) then + nt_smice = ntrcr + 1 + ntrcr = ntrcr + nslyr ! mass of ice in nslyr snow layers + nt_smliq = ntrcr + 1 + ntrcr = ntrcr + nslyr ! mass of liquid in nslyr snow layers + nt_rhos = ntrcr + 1 + ntrcr = ntrcr + nslyr ! snow density in nslyr layers + nt_rsnw = ntrcr + 1 + ntrcr = ntrcr + nslyr ! snow grain radius in nslyr layers + endif + + nt_fsd = 0 + if (tr_fsd) then + nt_fsd = ntrcr + 1 ! floe size distribution + ntrcr = ntrcr + nfsd + endif + + nt_isosno = 0 + nt_isoice = 0 + if (tr_iso) then + nt_isosno = ntrcr + 1 ! isotopes in snow + ntrcr = ntrcr + n_iso + nt_isoice = ntrcr + 1 ! isotopes in ice + ntrcr = ntrcr + n_iso + endif + + nt_aero = 0 + if (tr_aero) then + nt_aero = ntrcr + 1 + ntrcr = ntrcr + 4*n_aero ! 4 dEdd layers, n_aero species + else +!tcx, modify code so we don't have to reset n_aero here + n_aero = 0 !echmod - this is not getting set correctly (overwritten later?) + endif + + !----------------------------------------------------------------- + ! initialize zbgc tracer indices + !----------------------------------------------------------------- + + nbtrcr = 0 + nbtrcr_sw = 0 + nt_zbgc_frac = 0 + + ! vectors of size icepack_max_algae + nlt_bgc_N(:) = 0 + nlt_bgc_chl(:) = 0 + nt_bgc_N(:) = 0 + nt_bgc_chl(:) = 0 + + ! vectors of size icepack_max_dic + nlt_bgc_DIC(:) = 0 + nt_bgc_DIC(:) = 0 + + ! vectors of size icepack_max_doc + nlt_bgc_DOC(:) = 0 + nt_bgc_DOC(:) = 0 + + ! vectors of size icepack_max_don + nlt_bgc_DON(:) = 0 + nt_bgc_DON(:) = 0 + + ! vectors of size icepack_max_fe + nlt_bgc_Fed(:) = 0 + nlt_bgc_Fep(:) = 0 + nt_bgc_Fed(:) = 0 + nt_bgc_Fep(:) = 0 + + ! vectors of size icepack_max_aero + nlt_zaero(:) = 0 + nlt_zaero_sw(:) = 0 + nt_zaero(:) = 0 + + nlt_bgc_Nit = 0 + nlt_bgc_Am = 0 + nlt_bgc_Sil = 0 + nlt_bgc_DMSPp = 0 + nlt_bgc_DMSPd = 0 + nlt_bgc_DMS = 0 + nlt_bgc_PON = 0 + nlt_bgc_hum = 0 +! nlt_bgc_C = 0 + nlt_chl_sw = 0 + + nt_bgc_Nit = 0 + nt_bgc_Am = 0 + nt_bgc_Sil = 0 + nt_bgc_DMSPp = 0 + nt_bgc_DMSPd = 0 + nt_bgc_DMS = 0 + nt_bgc_PON = 0 + nt_bgc_hum = 0 +! nt_bgc_C = 0 + + ntrcr_o = ntrcr + nt_fbri = 0 + if (tr_brine) then + nt_fbri = ntrcr + 1 ! ice volume fraction with salt + ntrcr = ntrcr + 1 + endif + + nt_bgc_S = 0 + if (solve_zsal) then ! .true. only if tr_brine = .true. + nt_bgc_S = ntrcr + 1 + ntrcr = ntrcr + nblyr + endif + + if (skl_bgc .or. z_tracers) then + + if (skl_bgc) then + nk = 1 + elseif (z_tracers) then ! defined on nblyr+1 in ice + ! and 2 snow layers (snow surface + interior) + nk = nblyr + 1 + endif ! skl_bgc or z_tracers + nk_bgc = nk ! number of bgc layers in ice + if (nk > 1) nk_bgc = nk + 2 ! number of bgc layers in ice and snow + + !----------------------------------------------------------------- + ! count tracers and assign tracer indices + !----------------------------------------------------------------- + + if (tr_bgc_N) then + do mm = 1, n_algae + nt_bgc_N(mm) = ntrcr + 1 + do k = 1, nk_bgc + ntrcr = ntrcr + 1 + enddo + nbtrcr = nbtrcr + 1 + nlt_bgc_N(mm) = nbtrcr + enddo ! mm + endif ! tr_bgc_N + + if (tr_bgc_Nit) then + nt_bgc_Nit = ntrcr + 1 + do k = 1, nk_bgc + ntrcr = ntrcr + 1 + enddo + nbtrcr = nbtrcr + 1 + nlt_bgc_Nit = nbtrcr + endif ! tr_bgc_Nit + + if (tr_bgc_C) then + ! + ! Algal C is not yet distinct from algal N + ! * Reqires exudation and/or changing C:N ratios + ! for implementation + ! + ! do mm = 1,n_algae + ! nt_bgc_C(mm) = ntrcr + 1 + ! do k = 1, nk_bgc + ! ntrcr = ntrcr + 1 + ! enddo + ! nbtrcr = nbtrcr + 1 + ! nlt_bgc_C(mm) = nbtrcr + ! enddo ! mm + + do mm = 1, n_doc + nt_bgc_DOC(mm) = ntrcr + 1 + do k = 1, nk_bgc + ntrcr = ntrcr + 1 + enddo + nbtrcr = nbtrcr + 1 + nlt_bgc_DOC(mm) = nbtrcr + enddo ! mm + do mm = 1, n_dic + nt_bgc_DIC(mm) = ntrcr + 1 + do k = 1, nk_bgc + ntrcr = ntrcr + 1 + enddo + nbtrcr = nbtrcr + 1 + nlt_bgc_DIC(mm) = nbtrcr + enddo ! mm + endif ! tr_bgc_C + + if (tr_bgc_chl) then + do mm = 1, n_algae + nt_bgc_chl(mm) = ntrcr + 1 + do k = 1, nk_bgc + ntrcr = ntrcr + 1 + enddo + nbtrcr = nbtrcr + 1 + nlt_bgc_chl(mm) = nbtrcr + enddo ! mm + endif ! tr_bgc_chl + + if (tr_bgc_Am) then + nt_bgc_Am = ntrcr + 1 + do k = 1, nk_bgc + ntrcr = ntrcr + 1 + enddo + nbtrcr = nbtrcr + 1 + nlt_bgc_Am = nbtrcr + endif + if (tr_bgc_Sil) then + nt_bgc_Sil = ntrcr + 1 + do k = 1, nk_bgc + ntrcr = ntrcr + 1 + enddo + nbtrcr = nbtrcr + 1 + nlt_bgc_Sil = nbtrcr + endif + + if (tr_bgc_DMS) then ! all together + nt_bgc_DMSPp = ntrcr + 1 + do k = 1, nk_bgc + ntrcr = ntrcr + 1 + enddo + nbtrcr = nbtrcr + 1 + nlt_bgc_DMSPp = nbtrcr + + nt_bgc_DMSPd = ntrcr + 1 + do k = 1, nk_bgc + ntrcr = ntrcr + 1 + enddo + nbtrcr = nbtrcr + 1 + nlt_bgc_DMSPd = nbtrcr + + nt_bgc_DMS = ntrcr + 1 + do k = 1, nk_bgc + ntrcr = ntrcr + 1 + enddo + nbtrcr = nbtrcr + 1 + nlt_bgc_DMS = nbtrcr + endif + + if (tr_bgc_PON) then + nt_bgc_PON = ntrcr + 1 + do k = 1, nk_bgc + ntrcr = ntrcr + 1 + enddo + nbtrcr = nbtrcr + 1 + nlt_bgc_PON = nbtrcr + endif + + if (tr_bgc_DON) then + do mm = 1, n_don + nt_bgc_DON(mm) = ntrcr + 1 + do k = 1, nk_bgc + ntrcr = ntrcr + 1 + enddo + nbtrcr = nbtrcr + 1 + nlt_bgc_DON(mm) = nbtrcr + enddo ! mm + endif ! tr_bgc_DON + + if (tr_bgc_Fe) then + do mm = 1, n_fed + nt_bgc_Fed(mm) = ntrcr + 1 + do k = 1, nk_bgc + ntrcr = ntrcr + 1 + enddo + nbtrcr = nbtrcr + 1 + nlt_bgc_Fed(mm) = nbtrcr + enddo ! mm + do mm = 1, n_fep + nt_bgc_Fep(mm) = ntrcr + 1 + do k = 1, nk_bgc + ntrcr = ntrcr + 1 + enddo + nbtrcr = nbtrcr + 1 + nlt_bgc_Fep(mm) = nbtrcr + enddo ! mm + endif ! tr_bgc_Fe + + if (tr_bgc_hum) then + nt_bgc_hum = ntrcr + 1 + do k = 1, nk_bgc + ntrcr = ntrcr + 1 + enddo + nbtrcr = nbtrcr + 1 + nlt_bgc_hum = nbtrcr + endif + + endif ! skl_bgc .or. z_tracers + + if (z_tracers) then ! defined on nblyr+1 in ice + ! and 2 snow layers (snow surface + interior) + ! z layer aerosols + if (tr_zaero) then + do mm = 1, n_zaero + nt_zaero(mm) = ntrcr + 1 + do k = 1, nk_bgc + ntrcr = ntrcr + 1 + enddo + nbtrcr = nbtrcr + 1 + nlt_zaero(mm) = nbtrcr + enddo ! mm + endif ! tr_zaero + + if (nbtrcr > 0) then + nt_zbgc_frac = ntrcr + 1 + ntrcr = ntrcr + nbtrcr + endif + endif ! z_tracers + +!tcx, +1 here is the unused tracer, want to get rid of it + ntrcr = ntrcr + 1 + +!tcx, reset unused tracer index, eventually get rid of it. + if (nt_iage <= 0) nt_iage = ntrcr + if (nt_FY <= 0) nt_FY = ntrcr + if (nt_alvl <= 0) nt_alvl = ntrcr + if (nt_vlvl <= 0) nt_vlvl = ntrcr + if (nt_apnd <= 0) nt_apnd = ntrcr + if (nt_hpnd <= 0) nt_hpnd = ntrcr + if (nt_ipnd <= 0) nt_ipnd = ntrcr + if (nt_smice <= 0) nt_smice = ntrcr + if (nt_smliq <= 0) nt_smliq = ntrcr + if (nt_rhos <= 0) nt_rhos = ntrcr + if (nt_rsnw <= 0) nt_rsnw = ntrcr + if (nt_fsd <= 0) nt_fsd = ntrcr + if (nt_isosno<= 0) nt_isosno= ntrcr + if (nt_isoice<= 0) nt_isoice= ntrcr + if (nt_aero <= 0) nt_aero = ntrcr + if (nt_fbri <= 0) nt_fbri = ntrcr + if (nt_bgc_S <= 0) nt_bgc_S = ntrcr + + if (my_task == master_task) then + write(nu_diag,*) ' ' + write(nu_diag,1020) ' ntrcr = ', ntrcr + write(nu_diag,1020) ' nbtrcr = ', nbtrcr + write(nu_diag,1020) ' nbtrcr_sw = ', nbtrcr_sw + write(nu_diag,*) ' ' + write(nu_diag,1020) ' nt_sice = ', nt_sice + write(nu_diag,1020) ' nt_qice = ', nt_qice + write(nu_diag,1020) ' nt_qsno = ', nt_qsno + write(nu_diag,*)' ' + 1020 format (a30,2x,i6) ! integer + call flush_fileunit(nu_diag) + endif ! my_task = master_task + call icepack_init_tracer_sizes(ntrcr_in=ntrcr, & + ntrcr_o_in=ntrcr_o, nbtrcr_in=nbtrcr, nbtrcr_sw_in=nbtrcr_sw) + call icepack_init_tracer_indices(nt_Tsfc_in=nt_Tsfc, nt_sice_in=nt_sice, & + nt_qice_in=nt_qice, nt_qsno_in=nt_qsno, nt_iage_in=nt_iage, nt_fy_in=nt_fy, & + nt_alvl_in=nt_alvl, nt_vlvl_in=nt_vlvl, nt_apnd_in=nt_apnd, nt_hpnd_in=nt_hpnd, & + nt_ipnd_in=nt_ipnd, nt_fsd_in=nt_fsd, nt_aero_in=nt_aero, & + nt_smice_in=nt_smice, nt_smliq_in=nt_smliq, nt_rhos_in=nt_rhos, nt_rsnw_in=nt_rsnw, & + nt_isosno_in=nt_isosno, nt_isoice_in=nt_isoice, nt_fbri_in=nt_fbri, & + nt_bgc_Nit_in=nt_bgc_Nit, nt_bgc_Am_in=nt_bgc_Am, nt_bgc_Sil_in=nt_bgc_Sil, & + nt_bgc_DMS_in=nt_bgc_DMS, nt_bgc_PON_in=nt_bgc_PON, nt_bgc_S_in=nt_bgc_S, & + nt_bgc_N_in=nt_bgc_N, nt_bgc_chl_in=nt_bgc_chl, & + nt_bgc_DOC_in=nt_bgc_DOC, nt_bgc_DON_in=nt_bgc_DON, nt_bgc_DIC_in=nt_bgc_DIC, & + nt_zaero_in=nt_zaero, nt_bgc_DMSPp_in=nt_bgc_DMSPp, nt_bgc_DMSPd_in=nt_bgc_DMSPd, & + nt_bgc_Fed_in=nt_bgc_Fed, nt_bgc_Fep_in=nt_bgc_Fep, nt_zbgc_frac_in=nt_zbgc_frac, & + nlt_zaero_sw_in=nlt_zaero_sw, nlt_chl_sw_in=nlt_chl_sw, nlt_bgc_Sil_in=nlt_bgc_Sil, & + nlt_bgc_N_in=nlt_bgc_N, nlt_bgc_Nit_in=nlt_bgc_Nit, nlt_bgc_Am_in=nlt_bgc_Am, & + nlt_bgc_DMS_in=nlt_bgc_DMS, nlt_bgc_DMSPp_in=nlt_bgc_DMSPp, nlt_bgc_DMSPd_in=nlt_bgc_DMSPd, & + nlt_zaero_in=nlt_zaero, nlt_bgc_chl_in=nlt_bgc_chl, & + nlt_bgc_DIC_in=nlt_bgc_DIC, nlt_bgc_DOC_in=nlt_bgc_DOC, nlt_bgc_PON_in=nlt_bgc_PON, & + nlt_bgc_DON_in=nlt_bgc_DON, nlt_bgc_Fed_in=nlt_bgc_Fed, nlt_bgc_Fep_in=nlt_bgc_Fep, & + nt_bgc_hum_in=nt_bgc_hum, nlt_bgc_hum_in=nlt_bgc_hum) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname//' Icepack Abort2', & + file=__FILE__, line=__LINE__) + + if (my_task == master_task) then + call icepack_write_tracer_flags(nu_diag) + call icepack_write_tracer_sizes(nu_diag) + call icepack_write_tracer_indices(nu_diag) + endif + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname//' Icepack Abort3', & + file=__FILE__, line=__LINE__) + + end subroutine count_tracers + +!======================================================================= + +! Initialize vertical biogeochemistry +! +! author Elizabeth C. Hunke, LANL +! Nicole Jeffery, LANL + + subroutine init_zbgc + + use ice_state, only: trcr_base, trcr_depend, n_trcr_strata, & + nt_strata + use ice_arrays_column, only: R_C2N, R_chl2N, R_C2N_DON, R_Si2N, trcrn_sw + + integer (kind=int_kind) :: & + nbtrcr, nbtrcr_sw, nt_fbri, & + nt_bgc_Nit, nt_bgc_Am, nt_bgc_Sil, & + nt_bgc_DMS, nt_bgc_PON, nt_bgc_S, & + nt_bgc_DMSPp, nt_bgc_DMSPd, & + nt_zbgc_frac, nlt_chl_sw, & + nlt_bgc_Nit, nlt_bgc_Am, nlt_bgc_Sil, & + nlt_bgc_DMS, nlt_bgc_DMSPp, nlt_bgc_DMSPd, & + nlt_bgc_PON, nt_bgc_hum, nlt_bgc_hum + + integer (kind=int_kind), dimension(icepack_max_aero) :: & + nlt_zaero_sw ! points to aerosol in trcrn_sw + + integer (kind=int_kind), dimension(icepack_max_algae) :: & + nlt_bgc_N , & ! algae + nlt_bgc_chl + + integer (kind=int_kind), dimension(icepack_max_doc) :: & + nlt_bgc_DOC ! disolved organic carbon + + integer (kind=int_kind), dimension(icepack_max_don) :: & + nlt_bgc_DON ! + + integer (kind=int_kind), dimension(icepack_max_dic) :: & + nlt_bgc_DIC ! disolved inorganic carbon + + integer (kind=int_kind), dimension(icepack_max_fe) :: & + nlt_bgc_Fed , & ! + nlt_bgc_Fep ! + + integer (kind=int_kind), dimension(icepack_max_aero) :: & + nlt_zaero ! non-reacting layer aerosols + + integer (kind=int_kind), dimension(icepack_max_algae) :: & + nt_bgc_N , & ! diatoms, phaeocystis, pico/small + nt_bgc_chl ! diatoms, phaeocystis, pico/small + + integer (kind=int_kind), dimension(icepack_max_doc) :: & + nt_bgc_DOC ! dissolved organic carbon + + integer (kind=int_kind), dimension(icepack_max_don) :: & + nt_bgc_DON ! dissolved organic nitrogen + + integer (kind=int_kind), dimension(icepack_max_dic) :: & + nt_bgc_DIC ! dissolved inorganic carbon + + integer (kind=int_kind), dimension(icepack_max_fe) :: & + nt_bgc_Fed, & ! dissolved iron + nt_bgc_Fep ! particulate iron + + integer (kind=int_kind), dimension(icepack_max_aero) :: & + nt_zaero ! black carbon and other aerosols + + integer (kind=int_kind), dimension(icepack_max_nbtrcr) :: & + bio_index_o ! relates nlt_bgc_NO to ocean concentration index + + integer (kind=int_kind), dimension(icepack_max_nbtrcr) :: & + bio_index ! relates bio indices, ie. nlt_bgc_N to nt_bgc_N + + logical (kind=log_kind) :: & + tr_brine, & + tr_bgc_Nit, tr_bgc_Am, tr_bgc_Sil, & + tr_bgc_DMS, tr_bgc_PON, & + tr_bgc_N, tr_bgc_C, tr_bgc_chl, & + tr_bgc_DON, tr_bgc_Fe, tr_zaero, & + tr_bgc_hum + + real (kind=dbl_kind) :: & + initbio_frac, & + frazil_scav + + real (kind=dbl_kind), dimension(icepack_max_nbtrcr) :: & + zbgc_frac_init,&! initializes mobile fraction + bgc_tracer_type ! described tracer in mobile or stationary phases + ! < 0 is purely mobile (eg. nitrate) + ! > 0 has timescales for transitions between + ! phases based on whether the ice is melting or growing + + real (kind=dbl_kind), dimension(icepack_max_nbtrcr) :: & + zbgc_init_frac, & ! fraction of ocean tracer concentration in new ice + tau_ret, & ! retention timescale (s), mobile to stationary phase + tau_rel ! release timescale (s), stationary to mobile phase + + logical (kind=log_kind) :: & + skl_bgc, z_tracers, dEdd_algae, solve_zsal + + real (kind=dbl_kind), dimension(icepack_max_algae) :: & + F_abs_chl ! to scale absorption in Dedd + + real (kind=dbl_kind), dimension(icepack_max_algae) :: & + R_S2N , & ! algal S to N (mole/mole) + ! Marchetti et al 2006, 3 umol Fe/mol C for iron limited Pseudo-nitzschia + R_Fe2C , & ! algal Fe to carbon (umol/mmol) + R_Fe2N ! algal Fe to N (umol/mmol) + + real (kind=dbl_kind), dimension(icepack_max_don) :: & + R_Fe2DON ! Fe to N of DON (nmol/umol) + + real (kind=dbl_kind), dimension(icepack_max_doc) :: & + R_Fe2DOC ! Fe to C of DOC (nmol/umol) + + real (kind=dbl_kind), dimension(icepack_max_algae) :: & + chlabs , & ! chla absorption 1/m/(mg/m^3) + alpha2max_low , & ! light limitation (1/(W/m^2)) + beta2max , & ! light inhibition (1/(W/m^2)) + mu_max , & ! maximum growth rate (1/d) + grow_Tdep , & ! T dependence of growth (1/C) + fr_graze , & ! fraction of algae grazed + mort_pre , & ! mortality (1/day) + mort_Tdep , & ! T dependence of mortality (1/C) + k_exude , & ! algal carbon exudation rate (1/d) + K_Nit , & ! nitrate half saturation (mmol/m^3) + K_Am , & ! ammonium half saturation (mmol/m^3) + K_Sil , & ! silicon half saturation (mmol/m^3) + K_Fe ! iron half saturation or micromol/m^3 + + real (kind=dbl_kind), dimension(icepack_max_DON) :: & + f_don , & ! fraction of spilled grazing to DON + kn_bac , & ! Bacterial degredation of DON (1/d) + f_don_Am ! fraction of remineralized DON to Am + + real (kind=dbl_kind), dimension(icepack_max_DOC) :: & + f_doc , & ! fraction of mort_N that goes to each doc pool + f_exude , & ! fraction of exuded carbon to each DOC pool + k_bac ! Bacterial degredation of DOC (1/d) + + integer (kind=int_kind) :: & + k, mm , & ! loop index + nk , & ! layer index + ierr + + integer (kind=int_kind) :: & + ntd , & ! for tracer dependency calculation + nt_depend + + character(len=*), parameter :: subname='(init_zbgc)' + + !------------------------------------------------------------ + ! Tracers have mobile and stationary phases. + ! ice growth allows for retention, ice melt facilitates mobility + ! bgc_tracer_type defines the exchange timescales between these phases + ! -1 : entirely in the mobile phase, no exchange (this is the default) + ! 0 : retention time scale is tau_min, release time scale is tau_max + ! 1 : retention time scale is tau_max, release time scale is tau_min + ! 0.5: retention time scale is tau_min, release time scale is tau_min + ! 2 : retention time scale is tau_max, release time scale is tau_max + ! tau_min and tau_max are defined in icepack_intfc.f90 + !------------------------------------------------------------ + + !----------------------------------------------------------------- + ! get values from icepack + !----------------------------------------------------------------- + + call icepack_query_parameters( & + solve_zsal_out=solve_zsal, & + skl_bgc_out=skl_bgc, z_tracers_out=z_tracers, & + dEdd_algae_out=dEdd_algae, & + grid_o_out=grid_o, l_sk_out=l_sk, & + initbio_frac_out=initbio_frac, & + grid_oS_out=grid_oS, l_skS_out=l_skS, & + phi_snow_out=phi_snow, frazil_scav_out = frazil_scav) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + + call icepack_query_tracer_sizes( & + nbtrcr_out=nbtrcr, nbtrcr_sw_out=nbtrcr_sw) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + + call icepack_query_tracer_flags( & + tr_brine_out =tr_brine, & + tr_bgc_Nit_out=tr_bgc_Nit, tr_bgc_Am_out=tr_bgc_Am, tr_bgc_Sil_out=tr_bgc_Sil, & + tr_bgc_DMS_out=tr_bgc_DMS, tr_bgc_PON_out=tr_bgc_PON, & + tr_bgc_N_out =tr_bgc_N, tr_bgc_C_out =tr_bgc_C, tr_bgc_chl_out=tr_bgc_chl, & + tr_bgc_DON_out=tr_bgc_DON, tr_bgc_Fe_out=tr_bgc_Fe, tr_zaero_out =tr_zaero, & + tr_bgc_hum_out=tr_bgc_hum) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + + call icepack_query_tracer_indices( & + nt_fbri_out=nt_fbri, & + nt_bgc_Nit_out=nt_bgc_Nit, nt_bgc_Am_out=nt_bgc_Am, nt_bgc_Sil_out=nt_bgc_Sil, & + nt_bgc_DMS_out=nt_bgc_DMS, nt_bgc_PON_out=nt_bgc_PON, nt_bgc_S_out=nt_bgc_S, & + nt_bgc_N_out=nt_bgc_N, nt_bgc_chl_out=nt_bgc_chl, & + nt_bgc_DOC_out=nt_bgc_DOC, nt_bgc_DON_out=nt_bgc_DON, nt_bgc_DIC_out=nt_bgc_DIC, & + nt_zaero_out=nt_zaero, nt_bgc_DMSPp_out=nt_bgc_DMSPp, nt_bgc_DMSPd_out=nt_bgc_DMSPd, & + nt_bgc_Fed_out=nt_bgc_Fed, nt_bgc_Fep_out=nt_bgc_Fep, nt_zbgc_frac_out=nt_zbgc_frac, & + nlt_zaero_sw_out=nlt_zaero_sw, nlt_chl_sw_out=nlt_chl_sw, nlt_bgc_Sil_out=nlt_bgc_Sil, & + nlt_bgc_N_out=nlt_bgc_N, nlt_bgc_Nit_out=nlt_bgc_Nit, nlt_bgc_Am_out=nlt_bgc_Am, & + nlt_bgc_DMS_out=nlt_bgc_DMS, nlt_bgc_DMSPp_out=nlt_bgc_DMSPp, nlt_bgc_DMSPd_out=nlt_bgc_DMSPd, & + nlt_zaero_out=nlt_zaero, nlt_bgc_chl_out=nlt_bgc_chl, & + nlt_bgc_DIC_out=nlt_bgc_DIC, nlt_bgc_DOC_out=nlt_bgc_DOC, nlt_bgc_PON_out=nlt_bgc_PON, & + nlt_bgc_DON_out=nlt_bgc_DON, nlt_bgc_Fed_out=nlt_bgc_Fed, nlt_bgc_Fep_out=nlt_bgc_Fep, & + nt_bgc_hum_out=nt_bgc_hum, nlt_bgc_hum_out=nlt_bgc_hum) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + + !----------------------------------------------------------------- + ! Define array parameters + !----------------------------------------------------------------- + + allocate( & + R_C2N_DON(icepack_max_don), & ! carbon to nitrogen mole ratio of DON pool + R_C2N(icepack_max_algae), & ! algal C to N (mole/mole) + R_chl2N(icepack_max_algae), & ! 3 algal chlorophyll to N (mg/mmol) + R_Si2N(icepack_max_algae), & ! silica to nitrogen mole ratio for algal groups + stat=ierr) + if (ierr/=0) call abort_ice(subname//' Out of Memory') + + R_Si2N(1) = ratio_Si2N_diatoms + R_Si2N(2) = ratio_Si2N_sp + R_Si2N(3) = ratio_Si2N_phaeo + + R_S2N(1) = ratio_S2N_diatoms + R_S2N(2) = ratio_S2N_sp + R_S2N(3) = ratio_S2N_phaeo + + R_Fe2C(1) = ratio_Fe2C_diatoms + R_Fe2C(2) = ratio_Fe2C_sp + R_Fe2C(3) = ratio_Fe2C_phaeo + + R_Fe2N(1) = ratio_Fe2N_diatoms + R_Fe2N(2) = ratio_Fe2N_sp + R_Fe2N(3) = ratio_Fe2N_phaeo + + R_C2N(1) = ratio_C2N_diatoms + R_C2N(2) = ratio_C2N_sp + R_C2N(3) = ratio_C2N_phaeo + + R_chl2N(1) = ratio_chl2N_diatoms + R_chl2N(2) = ratio_chl2N_sp + R_chl2N(3) = ratio_chl2N_phaeo + + F_abs_chl(1) = F_abs_chl_diatoms + F_abs_chl(2) = F_abs_chl_sp + F_abs_chl(3) = F_abs_chl_phaeo + + R_Fe2DON(1) = ratio_Fe2DON + R_C2N_DON(1) = ratio_C2N_proteins + + R_Fe2DOC(1) = ratio_Fe2DOC_s + R_Fe2DOC(2) = ratio_Fe2DOC_l + R_Fe2DOC(3) = c0 + + chlabs(1) = chlabs_diatoms + chlabs(2) = chlabs_sp + chlabs(3) = chlabs_phaeo + + alpha2max_low(1) = alpha2max_low_diatoms + alpha2max_low(2) = alpha2max_low_sp + alpha2max_low(3) = alpha2max_low_phaeo + + beta2max(1) = beta2max_diatoms + beta2max(2) = beta2max_sp + beta2max(3) = beta2max_phaeo + + mu_max(1) = mu_max_diatoms + mu_max(2) = mu_max_sp + mu_max(3) = mu_max_phaeo + + grow_Tdep(1) = grow_Tdep_diatoms + grow_Tdep(2) = grow_Tdep_sp + grow_Tdep(3) = grow_Tdep_phaeo + + fr_graze(1) = fr_graze_diatoms + fr_graze(2) = fr_graze_sp + fr_graze(3) = fr_graze_phaeo + + mort_pre(1) = mort_pre_diatoms + mort_pre(2) = mort_pre_sp + mort_pre(3) = mort_pre_phaeo + + mort_Tdep(1) = mort_Tdep_diatoms + mort_Tdep(2) = mort_Tdep_sp + mort_Tdep(3) = mort_Tdep_phaeo + + k_exude(1) = k_exude_diatoms + k_exude(2) = k_exude_sp + k_exude(3) = k_exude_phaeo + + K_Nit(1) = K_Nit_diatoms + K_Nit(2) = K_Nit_sp + K_Nit(3) = K_Nit_phaeo + + K_Am(1) = K_Am_diatoms + K_Am(2) = K_Am_sp + K_Am(3) = K_Am_phaeo + + K_Sil(1) = K_Sil_diatoms + K_Sil(2) = K_Sil_sp + K_Sil(3) = K_Sil_phaeo + + K_Fe(1) = K_Fe_diatoms + K_Fe(2) = K_Fe_sp + K_Fe(3) = K_Fe_phaeo + + f_don(1) = f_don_protein + kn_bac(1) = kn_bac_protein + f_don_Am(1) = f_don_Am_protein + + f_doc(1) = f_doc_s + f_doc(2) = f_doc_l + + f_exude(1) = f_exude_s + f_exude(2) = f_exude_l + k_bac(1) = k_bac_s + k_bac(2) = k_bac_l + + dictype(:) = -c1 + + algaltype(1) = algaltype_diatoms + algaltype(2) = algaltype_sp + algaltype(3) = algaltype_phaeo + + doctype(1) = doctype_s + doctype(2) = doctype_l + + dontype(1) = dontype_protein + + fedtype(1) = fedtype_1 + feptype(1) = feptype_1 + + zaerotype(1) = zaerotype_bc1 + zaerotype(2) = zaerotype_bc2 + zaerotype(3) = zaerotype_dust1 + zaerotype(4) = zaerotype_dust2 + zaerotype(5) = zaerotype_dust3 + zaerotype(6) = zaerotype_dust4 + + call icepack_init_zbgc ( & +!opt R_S2N_in=R_S2N, R_Fe2C_in=R_Fe2C, R_Fe2N_in=R_Fe2N, R_C2N_in=R_C2N, & +!opt R_chl2N_in=R_chl2N, F_abs_chl_in=F_abs_chl, R_Fe2DON_in=R_Fe2DON, R_Fe2DOC_in=R_Fe2DOC, & +!opt mort_Tdep_in=mort_Tdep, k_exude_in=k_exude, & +!opt K_Nit_in=K_Nit, K_Am_in=K_Am, K_sil_in=K_Sil, K_Fe_in=K_Fe, & +!opt f_don_in=f_don, kn_bac_in=kn_bac, f_don_Am_in=f_don_Am, f_exude_in=f_exude, k_bac_in=k_bac, & +!opt fr_resp_in=fr_resp, algal_vel_in=algal_vel, R_dFe2dust_in=R_dFe2dust, & +!opt dustFe_sol_in=dustFe_sol, T_max_in=T_max, fr_mort2min_in=fr_mort2min, fr_dFe_in=fr_dFe, & +!opt op_dep_min_in=op_dep_min, fr_graze_s_in=fr_graze_s, fr_graze_e_in=fr_graze_e, & +!opt k_nitrif_in=k_nitrif, t_iron_conv_in=t_iron_conv, max_loss_in=max_loss, max_dfe_doc1_in=max_dfe_doc1, & +!opt fr_resp_s_in=fr_resp_s, y_sk_DMS_in=y_sk_DMS, t_sk_conv_in=t_sk_conv, t_sk_ox_in=t_sk_ox, & +!opt mu_max_in=mu_max, R_Si2N_in=R_Si2N, R_C2N_DON_in=R_C2N_DON, chlabs_in=chlabs, & +!opt alpha2max_low_in=alpha2max_low, beta2max_in=beta2max, grow_Tdep_in=grow_Tdep, & +!opt fr_graze_in=fr_graze, mort_pre_in=mort_pre, f_doc_in=f_doc,fsal_in=fsal, & + ) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + + !----------------------------------------------------------------- + ! assign tracer dependencies + ! bgc_tracer_type: < 0 purely mobile , >= 0 stationary + !------------------------------------------------------------------ + + if (tr_brine) then + trcr_depend(nt_fbri) = 1 ! volume-weighted + trcr_base (nt_fbri,1) = c0 ! volume-weighted + trcr_base (nt_fbri,2) = c1 ! volume-weighted + trcr_base (nt_fbri,3) = c0 ! volume-weighted + n_trcr_strata(nt_fbri) = 0 + nt_strata (nt_fbri,1) = 0 + nt_strata (nt_fbri,2) = 0 + endif + + ntd = 0 ! if nt_fbri /= 0 then use fbri dependency + if (nt_fbri == 0) ntd = -1 ! otherwise make tracers depend on ice volume + + if (solve_zsal) then ! .true. only if tr_brine = .true. + do k = 1,nblyr + trcr_depend(nt_bgc_S + k - 1) = 2 + nt_fbri + ntd + trcr_base (nt_bgc_S,1) = c0 ! default: ice area + trcr_base (nt_bgc_S,2) = c1 + trcr_base (nt_bgc_S,3) = c0 + n_trcr_strata(nt_bgc_S) = 1 + nt_strata(nt_bgc_S,1) = nt_fbri + nt_strata(nt_bgc_S,2) = 0 + enddo + endif + + bio_index(:) = 0 + bio_index_o(:) = 0 + + if (skl_bgc) then + nk = 1 + nt_depend = 0 + elseif (z_tracers) then ! defined on nblyr+1 in ice + ! and 2 snow layers (snow surface + interior) + nk = nblyr + 1 + nt_depend = 2 + nt_fbri + ntd + endif ! skl_bgc or z_tracers + + if (skl_bgc .or. z_tracers) then + + if (tr_bgc_N) then + do mm = 1, n_algae + call init_bgc_trcr(nk, nt_fbri, & + nt_bgc_N(mm), nlt_bgc_N(mm), & + algaltype(mm), nt_depend, & + bgc_tracer_type, trcr_depend, & + trcr_base, n_trcr_strata, & + nt_strata, bio_index) + bio_index_o(nlt_bgc_N(mm)) = mm + enddo ! mm + endif ! tr_bgc_N + + if (tr_bgc_Nit) then + call init_bgc_trcr(nk, nt_fbri, & + nt_bgc_Nit, nlt_bgc_Nit, & + nitratetype, nt_depend, & + bgc_tracer_type, trcr_depend, & + trcr_base, n_trcr_strata, & + nt_strata, bio_index) + bio_index_o(nlt_bgc_Nit) = icepack_max_algae + 1 + endif ! tr_bgc_Nit + + if (tr_bgc_C) then + ! + ! Algal C is not yet distinct from algal N + ! * Reqires exudation and/or changing C:N ratios + ! for implementation + ! + ! do mm = 1,n_algae + ! call init_bgc_trcr(nk, nt_fbri, & + ! nt_bgc_C(mm), nlt_bgc_C(mm), & + ! algaltype(mm), nt_depend, & + ! bgc_tracer_type, trcr_depend, & + ! trcr_base, n_trcr_strata, & + ! nt_strata, bio_index) + ! bio_index_o(nlt_bgc_C(mm)) = icepack_max_algae + 1 + mm + ! enddo ! mm + + do mm = 1, n_doc + call init_bgc_trcr(nk, nt_fbri, & + nt_bgc_DOC(mm), nlt_bgc_DOC(mm), & + doctype(mm), nt_depend, & + bgc_tracer_type, trcr_depend, & + trcr_base, n_trcr_strata, & + nt_strata, bio_index) + bio_index_o(nlt_bgc_DOC(mm)) = icepack_max_algae + 1 + mm + enddo ! mm + do mm = 1, n_dic + call init_bgc_trcr(nk, nt_fbri, & + nt_bgc_DIC(mm), nlt_bgc_DIC(mm), & + dictype(mm), nt_depend, & + bgc_tracer_type, trcr_depend, & + trcr_base, n_trcr_strata, & + nt_strata, bio_index) + bio_index_o(nlt_bgc_DIC(mm)) = icepack_max_algae + icepack_max_doc + 1 + mm + enddo ! mm + endif ! tr_bgc_C + + if (tr_bgc_chl) then + do mm = 1, n_algae + call init_bgc_trcr(nk, nt_fbri, & + nt_bgc_chl(mm), nlt_bgc_chl(mm), & + algaltype(mm), nt_depend, & + bgc_tracer_type, trcr_depend, & + trcr_base, n_trcr_strata, & + nt_strata, bio_index) + bio_index_o(nlt_bgc_chl(mm)) = icepack_max_algae + 1 + icepack_max_doc + icepack_max_dic + mm + enddo ! mm + endif ! tr_bgc_chl + + if (tr_bgc_Am) then + call init_bgc_trcr(nk, nt_fbri, & + nt_bgc_Am, nlt_bgc_Am, & + ammoniumtype, nt_depend, & + bgc_tracer_type, trcr_depend, & + trcr_base, n_trcr_strata, & + nt_strata, bio_index) + bio_index_o(nlt_bgc_Am) = 2*icepack_max_algae + icepack_max_doc + icepack_max_dic + 2 + endif + if (tr_bgc_Sil) then + call init_bgc_trcr(nk, nt_fbri, & + nt_bgc_Sil, nlt_bgc_Sil, & + silicatetype, nt_depend, & + bgc_tracer_type, trcr_depend, & + trcr_base, n_trcr_strata, & + nt_strata, bio_index) + bio_index_o(nlt_bgc_Sil) = 2*icepack_max_algae + icepack_max_doc + icepack_max_dic + 3 + endif + if (tr_bgc_DMS) then ! all together + call init_bgc_trcr(nk, nt_fbri, & + nt_bgc_DMSPp, nlt_bgc_DMSPp, & + dmspptype, nt_depend, & + bgc_tracer_type, trcr_depend, & + trcr_base, n_trcr_strata, & + nt_strata, bio_index) + bio_index_o(nlt_bgc_DMSPp) = 2*icepack_max_algae + icepack_max_doc + icepack_max_dic + 4 + + call init_bgc_trcr(nk, nt_fbri, & + nt_bgc_DMSPd, nlt_bgc_DMSPd, & + dmspdtype, nt_depend, & + bgc_tracer_type, trcr_depend, & + trcr_base, n_trcr_strata, & + nt_strata, bio_index) + bio_index_o(nlt_bgc_DMSPd) = 2*icepack_max_algae + icepack_max_doc + icepack_max_dic + 5 + + call init_bgc_trcr(nk, nt_fbri, & + nt_bgc_DMS, nlt_bgc_DMS, & + dmspdtype, nt_depend, & + bgc_tracer_type, trcr_depend, & + trcr_base, n_trcr_strata, & + nt_strata, bio_index) + bio_index_o(nlt_bgc_DMS) = 2*icepack_max_algae + icepack_max_doc + icepack_max_dic + 6 + endif + if (tr_bgc_PON) then + call init_bgc_trcr(nk, nt_fbri, & + nt_bgc_PON, nlt_bgc_PON, & + nitratetype, nt_depend, & + bgc_tracer_type, trcr_depend, & + trcr_base, n_trcr_strata, & + nt_strata, bio_index) + bio_index_o(nlt_bgc_PON) = 2*icepack_max_algae + icepack_max_doc + icepack_max_dic + 7 + endif + if (tr_bgc_DON) then + do mm = 1, n_don + call init_bgc_trcr(nk, nt_fbri, & + nt_bgc_DON(mm), nlt_bgc_DON(mm), & + dontype(mm), nt_depend, & + bgc_tracer_type, trcr_depend, & + trcr_base, n_trcr_strata, & + nt_strata, bio_index) + bio_index_o(nlt_bgc_DON(mm)) = 2*icepack_max_algae + icepack_max_doc + icepack_max_dic + 7 + mm + enddo ! mm + endif ! tr_bgc_DON + if (tr_bgc_Fe) then + do mm = 1, n_fed + call init_bgc_trcr(nk, nt_fbri, & + nt_bgc_Fed(mm), nlt_bgc_Fed(mm), & + fedtype(mm), nt_depend, & + bgc_tracer_type, trcr_depend, & + trcr_base, n_trcr_strata, & + nt_strata, bio_index) + bio_index_o(nlt_bgc_Fed(mm)) = 2*icepack_max_algae + icepack_max_doc + icepack_max_dic & + + icepack_max_don + 7 + mm + enddo ! mm + do mm = 1, n_fep + call init_bgc_trcr(nk, nt_fbri, & + nt_bgc_Fep(mm), nlt_bgc_Fep(mm), & + feptype(mm), nt_depend, & + bgc_tracer_type, trcr_depend, & + trcr_base, n_trcr_strata, & + nt_strata, bio_index) + bio_index_o(nlt_bgc_Fep(mm)) = 2*icepack_max_algae + icepack_max_doc + icepack_max_dic & + + icepack_max_don + icepack_max_fe + 7 + mm + enddo ! mm + endif ! tr_bgc_Fe + + if (tr_bgc_hum) then + call init_bgc_trcr(nk, nt_fbri, & + nt_bgc_hum, nlt_bgc_hum, & + humtype, nt_depend, & + bgc_tracer_type, trcr_depend, & + trcr_base, n_trcr_strata, & + nt_strata, bio_index) + bio_index_o(nlt_bgc_hum) = 2*icepack_max_algae + icepack_max_doc + 8 + icepack_max_dic & + + icepack_max_don + 2*icepack_max_fe + icepack_max_aero + endif + endif ! skl_bgc or z_tracers + + if (skl_bgc) then + if (dEdd_algae) then + nlt_chl_sw = 1 + nbtrcr_sw = nilyr+nslyr+2 ! only the bottom layer will be nonzero + endif + + elseif (z_tracers) then ! defined on nblyr+1 in ice + ! and 2 snow layers (snow surface + interior) + if (tr_bgc_N) then + if (dEdd_algae) then + nlt_chl_sw = 1 + nbtrcr_sw = nilyr+nslyr+2 + endif + endif ! tr_bgc_N + endif ! skl_bgc or z_tracers + + if (z_tracers) then ! defined on nblyr+1 in ice + ! and 2 snow layers (snow surface + interior) + + nk = nblyr + 1 + nt_depend = 2 + nt_fbri + ntd + + ! z layer aerosols + if (tr_zaero) then + do mm = 1, n_zaero + if (dEdd_algae) then + nlt_zaero_sw(mm) = nbtrcr_sw + 1 + nbtrcr_sw = nbtrcr_sw + nilyr + nslyr+2 + endif + call init_bgc_trcr(nk, nt_fbri, & + nt_zaero(mm), nlt_zaero(mm), & + zaerotype(mm), nt_depend, & + bgc_tracer_type, trcr_depend, & + trcr_base, n_trcr_strata, & + nt_strata, bio_index) + bio_index_o(nlt_zaero(mm)) = 2*icepack_max_algae + icepack_max_doc + icepack_max_dic & + + icepack_max_don + 2*icepack_max_fe + 7 + mm + enddo ! mm + endif ! tr_zaero + + if (nbtrcr > 0) then + do k = 1,nbtrcr + zbgc_frac_init(k) = c1 + trcr_depend(nt_zbgc_frac+k-1) = 2+nt_fbri + trcr_base(nt_zbgc_frac+ k - 1,1) = c0 + trcr_base(nt_zbgc_frac+ k - 1,2) = c1 + trcr_base(nt_zbgc_frac+ k - 1,3) = c0 + n_trcr_strata(nt_zbgc_frac+ k - 1)= 1 + nt_strata(nt_zbgc_frac+ k - 1,1) = nt_fbri + nt_strata(nt_zbgc_frac+ k - 1,2) = 0 + tau_ret(k) = c1 + tau_rel(k) = c1 + if (bgc_tracer_type(k) >= c0 .and. bgc_tracer_type(k) < p5) then + tau_ret(k) = tau_min + tau_rel(k) = tau_max + zbgc_frac_init(k) = c1 + elseif (bgc_tracer_type(k) >= p5 .and. bgc_tracer_type(k) < c1) then + tau_ret(k) = tau_min + tau_rel(k) = tau_min + zbgc_frac_init(k) = c1 + elseif (bgc_tracer_type(k) >= c1 .and. bgc_tracer_type(k) < c2) then + tau_ret(k) = tau_max + tau_rel(k) = tau_min + zbgc_frac_init(k) = c1 + elseif (bgc_tracer_type(k) >= c2 ) then + tau_ret(k) = tau_max + tau_rel(k) = tau_max + zbgc_frac_init(k) = c1 + endif + enddo + endif + + endif ! z_tracers + + do k = 1, nbtrcr + zbgc_init_frac(k) = frazil_scav + if (bgc_tracer_type(k) < c0) zbgc_init_frac(k) = initbio_frac + enddo + + !----------------------------------------------------------------- + ! set values in icepack + !----------------------------------------------------------------- + + call icepack_init_zbgc( & +!opt zbgc_init_frac_in=zbgc_init_frac, tau_ret_in=tau_ret, tau_rel_in=tau_rel, & +!opt zbgc_frac_init_in=zbgc_frac_init, bgc_tracer_type_in=bgc_tracer_type, & + ) + call icepack_init_tracer_indices( & + bio_index_o_in=bio_index_o, bio_index_in=bio_index) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + + !----------------------------------------------------------------- + ! final consistency checks + !----------------------------------------------------------------- + if (nbtrcr > icepack_max_nbtrcr) then + write (nu_diag,*) subname,' ' + write (nu_diag,*) subname,'nbtrcr > icepack_max_nbtrcr' + write (nu_diag,*) subname,'nbtrcr, icepack_max_nbtrcr:',nbtrcr, icepack_max_nbtrcr + call abort_ice (subname//'ERROR: nbtrcr > icepack_max_nbtrcr') + endif + if (.NOT. dEdd_algae) nbtrcr_sw = 1 + + ! tcraig, added 6/1/21, why is nbtrcr_sw set here? + call icepack_init_tracer_sizes(nbtrcr_sw_in=nbtrcr_sw) + allocate(trcrn_sw(nx_block,ny_block,nbtrcr_sw,ncat,max_blocks)) ! bgc tracers active in the delta-Eddington shortwave + + !----------------------------------------------------------------- + ! spew + !----------------------------------------------------------------- + if (my_task == master_task) then + if (skl_bgc) then + + write(nu_diag,1020) ' number of bio tracers = ', nbtrcr + write(nu_diag,1020) ' number of Isw tracers = ', nbtrcr_sw + + elseif (z_tracers) then + + write(nu_diag,1020) ' number of ztracers = ', nbtrcr + write(nu_diag,1020) ' number of Isw tracers = ', nbtrcr_sw + write(nu_diag,1000) ' initbio_frac = ', initbio_frac + write(nu_diag,1000) ' frazil_scav = ', frazil_scav + + endif ! skl_bgc or solve_bgc + endif ! master_task + + 1000 format (a30,2x,f9.2) ! a30 to align formatted, unformatted statements + 1020 format (a30,2x,i6) ! integer + + end subroutine init_zbgc + +!======================================================================= + + subroutine init_bgc_trcr(nk, nt_fbri, & + nt_bgc, nlt_bgc, & + bgctype, nt_depend, & + bgc_tracer_type, trcr_depend, & + trcr_base, n_trcr_strata, & + nt_strata, bio_index) + + integer (kind=int_kind), intent(in) :: & + nk , & ! counter + nt_depend , & ! tracer dependency index + nt_bgc , & ! tracer index + nlt_bgc , & ! bio tracer index + nt_fbri + + integer (kind=int_kind), dimension(:), intent(inout) :: & + trcr_depend , & ! tracer dependencies + n_trcr_strata, & ! number of underlying tracer layers + bio_index ! + + integer (kind=int_kind), dimension(:,:), intent(inout) :: & + nt_strata ! indices of underlying tracer layers + + real (kind=dbl_kind), dimension(:,:), intent(inout) :: & + trcr_base ! = 0 or 1 depending on tracer dependency + ! argument 2: (1) aice, (2) vice, (3) vsno + + real (kind=dbl_kind), intent(in) :: & + bgctype ! bio tracer transport type (mobile vs stationary) + + real (kind=dbl_kind), dimension(:), intent(inout) :: & + bgc_tracer_type ! bio tracer transport type array + + ! local variables + + integer (kind=int_kind) :: & + k , & ! loop index + n_strata , & ! temporary values + nt_strata1, & ! + nt_strata2 + + real (kind=dbl_kind) :: & + trcr_base1, & ! temporary values + trcr_base2, & + trcr_base3 + + character(len=*), parameter :: subname='(init_bgc_trcr)' + + !-------- + + bgc_tracer_type(nlt_bgc) = bgctype + + if (nk > 1) then ! include vertical bgc in snow + do k = nk, nk+1 + trcr_depend (nt_bgc + k ) = 2 ! snow volume + trcr_base (nt_bgc + k,1) = c0 + trcr_base (nt_bgc + k,2) = c0 + trcr_base (nt_bgc + k,3) = c1 + n_trcr_strata(nt_bgc + k ) = 0 + nt_strata (nt_bgc + k,1) = 0 + nt_strata (nt_bgc + k,2) = 0 + enddo + + trcr_base1 = c0 + trcr_base2 = c1 + trcr_base3 = c0 + n_strata = 1 + nt_strata1 = nt_fbri + nt_strata2 = 0 + else ! nk = 1 + trcr_base1 = c1 + trcr_base2 = c0 + trcr_base3 = c0 + n_strata = 0 + nt_strata1 = 0 + nt_strata2 = 0 + endif ! nk + + do k = 1, nk ! in ice + trcr_depend (nt_bgc + k - 1 ) = nt_depend + trcr_base (nt_bgc + k - 1,1) = trcr_base1 + trcr_base (nt_bgc + k - 1,2) = trcr_base2 + trcr_base (nt_bgc + k - 1,3) = trcr_base3 + n_trcr_strata(nt_bgc + k - 1 ) = n_strata + nt_strata (nt_bgc + k - 1,1) = nt_strata1 + nt_strata (nt_bgc + k - 1,2) = nt_strata2 + enddo + + bio_index (nlt_bgc) = nt_bgc + + end subroutine init_bgc_trcr + +!======================================================================= + + end module ice_init_column + +!======================================================================= diff --git a/cicecore/drivers/unittest/opticep/ice_step_mod.F90 b/cicecore/drivers/unittest/opticep/ice_step_mod.F90 new file mode 100644 index 000000000..ac66255a4 --- /dev/null +++ b/cicecore/drivers/unittest/opticep/ice_step_mod.F90 @@ -0,0 +1,1784 @@ +!======================================================================= +! +! Contains CICE component driver routines common to all drivers. +! +! authors Elizabeth C. Hunke, LANL +! Philip W. Jones, LANL +! William H. Lipscomb, LANL +! +! 2008 ECH: created module by moving subroutines from drivers/cice4/ +! 2014 ECH: created column package + + module ice_step_mod + + use ice_kinds_mod + use ice_blocks, only: block, get_block + use ice_blocks, only: nx_block, ny_block + use ice_constants, only: c0, c1, c1000, c4, p25 + use ice_constants, only: field_loc_center, field_loc_NEcorner, & + field_loc_Nface, field_loc_Eface, & + field_type_scalar, field_type_vector + use ice_domain, only: halo_info, nblocks, blocks_ice + use ice_domain_size, only: max_blocks + use ice_exit, only: abort_ice + use ice_fileunits, only: nu_diag + use icepack_intfc, only: icepack_warnings_flush, icepack_warnings_aborted + use icepack_intfc, only: icepack_prep_radiation + use icepack_intfc, only: icepack_step_therm1 + use icepack_intfc, only: icepack_step_therm2 + use icepack_intfc, only: icepack_aggregate + use icepack_intfc, only: icepack_step_ridge + use icepack_intfc, only: icepack_step_wavefracture + use icepack_intfc, only: icepack_step_radiation + use icepack_intfc, only: icepack_ocn_mixed_layer, icepack_atm_boundary + use icepack_intfc, only: icepack_biogeochemistry, icepack_load_ocean_bio_array + use icepack_intfc, only: icepack_max_algae, icepack_max_nbtrcr, icepack_max_don + use icepack_intfc, only: icepack_max_doc, icepack_max_dic, icepack_max_aero + use icepack_intfc, only: icepack_max_fe, icepack_max_iso + use icepack_intfc, only: icepack_query_parameters + use icepack_intfc, only: icepack_query_tracer_flags, icepack_query_tracer_sizes + use icepack_intfc, only: icepack_query_tracer_indices + + implicit none + private + + public :: step_therm1, step_therm2, step_dyn_horiz, step_dyn_ridge, & + step_snow, prep_radiation, step_radiation, ocean_mixed_layer, & + update_state, biogeochemistry, step_dyn_wave, step_prep + + real (kind=dbl_kind), dimension (:,:,:), allocatable :: & + uvelT_icep, & ! uvel for wind stress computation in icepack + vvelT_icep ! vvel for wind stress computation in icepack + +!======================================================================= + + contains + +!======================================================================= + + subroutine save_init +! saves initial values for aice, aicen, vicen, vsnon + + use ice_state, only: aice, aicen, aice_init, aicen_init, & + vicen, vicen_init, vsnon, vsnon_init + + character(len=*), parameter :: subname = '(save_init)' + + !----------------------------------------------------------------- + ! Save the ice area passed to the coupler (so that history fields + ! can be made consistent with coupler fields). + ! Save the initial ice area and volume in each category. + !----------------------------------------------------------------- + + aice_init = aice + aicen_init = aicen + vicen_init = vicen + vsnon_init = vsnon + + end subroutine save_init + +!======================================================================= + + subroutine step_prep +! prep for step, called outside nblock loop + + use ice_flux, only: uatm, vatm, uatmT, vatmT + use ice_grid, only: grid_atm_dynu, grid_atm_dynv, grid_average_X2Y + use ice_state, only: uvel, vvel + + logical (kind=log_kind) :: & + highfreq ! highfreq flag + + logical (kind=log_kind), save :: & + first_call = .true. ! first call flag + + character(len=*), parameter :: subname = '(step_prep)' + + ! Save initial state + + call save_init + + ! Compute uatmT, vatmT + + call grid_average_X2Y('S',uatm,grid_atm_dynu,uatmT,'T') + call grid_average_X2Y('S',vatm,grid_atm_dynv,vatmT,'T') + + !----------------------------------------------------------------- + ! Compute uvelT_icep, vvelT_icep + !----------------------------------------------------------------- + + if (first_call) then + allocate(uvelT_icep(nx_block,ny_block,max_blocks)) + allocate(vvelT_icep(nx_block,ny_block,max_blocks)) + uvelT_icep = c0 + vvelT_icep = c0 + endif + + call icepack_query_parameters(highfreq_out=highfreq) + + if (highfreq) then + call grid_average_X2Y('A', uvel, 'U', uvelT_icep, 'T') + call grid_average_X2Y('A', vvel, 'U', vvelT_icep, 'T') + endif + + first_call = .false. + + end subroutine step_prep + +!======================================================================= +! +! Scales radiation fields computed on the previous time step. +! +! authors: Elizabeth Hunke, LANL + + subroutine prep_radiation (iblk) + + use ice_domain_size, only: ncat, nilyr, nslyr + use ice_flux, only: scale_factor, swvdr, swvdf, swidr, swidf, & + alvdr_ai, alvdf_ai, alidr_ai, alidf_ai, & + alvdr_init, alvdf_init, alidr_init, alidf_init + use ice_arrays_column, only: fswsfcn, fswintn, & + fswthrun, fswthrun_vdr, fswthrun_vdf, fswthrun_idr, fswthrun_idf, & + fswpenln, Sswabsn, Iswabsn + use ice_state, only: aice, aicen + use ice_timers, only: ice_timer_start, ice_timer_stop, timer_sw + + integer (kind=int_kind), intent(in) :: & + iblk ! block index + + ! local variables + + integer (kind=int_kind) :: & + ilo,ihi,jlo,jhi, & ! beginning and end of physical domain + i, j ! horizontal indices + + type (block) :: & + this_block ! block information for current block + + character(len=*), parameter :: subname = '(prep_radiation)' + + call ice_timer_start(timer_sw,iblk) ! shortwave + + alvdr_init(:,:,iblk) = c0 + alvdf_init(:,:,iblk) = c0 + alidr_init(:,:,iblk) = c0 + alidf_init(:,:,iblk) = c0 + + this_block = get_block(blocks_ice(iblk),iblk) + ilo = this_block%ilo + ihi = this_block%ihi + jlo = this_block%jlo + jhi = this_block%jhi + + !----------------------------------------------------------------- + ! Compute netsw scaling factor (new netsw / old netsw) + !----------------------------------------------------------------- + + do j = jlo, jhi + do i = ilo, ihi + + alvdr_init(i,j,iblk) = alvdr_ai(i,j,iblk) + alvdf_init(i,j,iblk) = alvdf_ai(i,j,iblk) + alidr_init(i,j,iblk) = alidr_ai(i,j,iblk) + alidf_init(i,j,iblk) = alidf_ai(i,j,iblk) + + call icepack_prep_radiation (ncat=ncat, nilyr=nilyr, nslyr=nslyr, & + scale_factor=scale_factor(i,j,iblk), & + aice = aice (i,j, iblk), aicen = aicen (i,j, :,iblk), & + swvdr = swvdr (i,j, iblk), swvdf = swvdf (i,j, iblk), & + swidr = swidr (i,j, iblk), swidf = swidf (i,j, iblk), & + alvdr_ai = alvdr_ai(i,j, iblk), alvdf_ai = alvdf_ai(i,j, iblk), & + alidr_ai = alidr_ai(i,j, iblk), alidf_ai = alidf_ai(i,j, iblk), & + fswsfcn = fswsfcn (i,j, :,iblk), fswintn = fswintn (i,j, :,iblk), & + fswthrun = fswthrun(i,j, :,iblk), & +!opt fswthrun_vdr = fswthrun_vdr(i,j, :,iblk), & +!opt fswthrun_vdf = fswthrun_vdf(i,j, :,iblk), & +!opt fswthrun_idr = fswthrun_idr(i,j, :,iblk), & +!opt fswthrun_idf = fswthrun_idf(i,j, :,iblk), & + fswpenln = fswpenln(i,j,:,:,iblk), & + Sswabsn = Sswabsn (i,j,:,:,iblk), Iswabsn = Iswabsn (i,j,:,:,iblk)) + + enddo ! i + enddo ! j + + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + + call ice_timer_stop(timer_sw,iblk) ! shortwave + + end subroutine prep_radiation + +!======================================================================= +! +! Driver for updating ice and snow internal temperatures and +! computing thermodynamic growth rates and coupler fluxes. +! +! authors: William H. Lipscomb, LANL + + subroutine step_therm1 (dt, iblk) + + use ice_arrays_column, only: ffracn, dhsn, & + Cdn_ocn, Cdn_ocn_skin, Cdn_ocn_floe, Cdn_ocn_keel, Cdn_atm_ratio, & + Cdn_atm, Cdn_atm_skin, Cdn_atm_floe, Cdn_atm_rdg, Cdn_atm_pond, & + hfreebd, hdraft, hridge, distrdg, hkeel, dkeel, lfloe, dfloe, & + fswsfcn, fswintn, Sswabsn, Iswabsn, meltsliqn, meltsliq, & + fswthrun, fswthrun_vdr, fswthrun_vdf, fswthrun_idr, fswthrun_idf + use ice_calendar, only: yday + use ice_domain_size, only: ncat, nilyr, nslyr, n_iso, n_aero + use ice_flux, only: frzmlt, sst, Tf, strocnxT_iavg, strocnyT_iavg, rside, fbot, Tbot, Tsnice, & + meltsn, melttn, meltbn, congeln, snoicen, uatmT, vatmT, fside, wlat, & + wind, rhoa, potT, Qa, zlvl, zlvs, strax, stray, flatn, fsensn, fsurfn, fcondtopn, & + flw, fsnow, fpond, sss, mlt_onset, frz_onset, fcondbotn, fcondbot, fsloss, & + frain, Tair, strairxT, strairyT, fsurf, fcondtop, fsens, & + flat, fswabs, flwout, evap, evaps, evapi, Tref, Qref, Uref, fresh, fsalt, fhocn, & + fswthru, fswthru_vdr, fswthru_vdf, fswthru_idr, fswthru_idf, & + meltt, melts, meltb, congel, snoice, & + flatn_f, fsensn_f, fsurfn_f, fcondtopn_f, & + send_i2x_per_cat, fswthrun_ai, dsnow + use ice_flux_bgc, only: dsnown, faero_atm, faero_ocn, fiso_atm, fiso_ocn, & + Qa_iso, Qref_iso, fiso_evap, HDO_ocn, H2_16O_ocn, H2_18O_ocn + use ice_grid, only: lmask_n, lmask_s, tmask + use ice_state, only: aice, aicen, aicen_init, vicen_init, & + vice, vicen, vsno, vsnon, trcrn, vsnon_init +#ifdef CICE_IN_NEMO + use ice_state, only: aice_init +#endif + +#ifdef CESMCOUPLED + use ice_prescribed_mod, only: prescribed_ice +#else + logical (kind=log_kind) :: & + prescribed_ice ! if .true., use prescribed ice instead of computed +#endif + real (kind=dbl_kind), intent(in) :: & + dt ! time step (s) + + integer (kind=int_kind), intent(in) :: & + iblk ! block index + + ! local variables +#ifdef CICE_IN_NEMO + real (kind=dbl_kind) :: & + raice ! reciprocal of ice concentration +#endif + integer (kind=int_kind) :: & + ilo,ihi,jlo,jhi, & ! beginning and end of physical domain + i, j , & ! horizontal indices + n , & ! thickness category index + k, kk ! indices for aerosols + + integer (kind=int_kind) :: & + ntrcr, nt_apnd, nt_hpnd, nt_ipnd, nt_alvl, nt_vlvl, nt_Tsfc, & + nt_iage, nt_FY, nt_qice, nt_sice, nt_aero, nt_qsno, & + nt_isosno, nt_isoice, nt_rsnw, nt_smice, nt_smliq + + logical (kind=log_kind) :: & + tr_iage, tr_FY, tr_iso, tr_aero, tr_pond, & + tr_pond_lvl, tr_pond_topo, calc_Tsfc, highfreq, tr_snow + + real (kind=dbl_kind) :: & + puny ! a very small number + + real (kind=dbl_kind), dimension(n_aero,2,ncat) :: & + aerosno, aeroice ! kg/m^2 + + real (kind=dbl_kind), dimension(n_iso,ncat) :: & + isosno, isoice ! kg/m^2 + + real (kind=dbl_kind), dimension(nslyr,ncat) :: & + rsnwn, smicen, smliqn + + type (block) :: & + this_block ! block information for current block + + character(len=*), parameter :: subname = '(step_therm1)' + + call icepack_query_parameters(puny_out=puny) + call icepack_query_parameters(calc_Tsfc_out=calc_Tsfc) + call icepack_query_parameters(highfreq_out=highfreq) + call icepack_query_tracer_sizes(ntrcr_out=ntrcr) + call icepack_query_tracer_flags( & + tr_iage_out=tr_iage, tr_FY_out=tr_FY, tr_iso_out=tr_iso, & + tr_aero_out=tr_aero, tr_pond_out=tr_pond, & + tr_pond_lvl_out=tr_pond_lvl, tr_pond_topo_out=tr_pond_topo, & + tr_snow_out=tr_snow) + call icepack_query_tracer_indices( & + nt_apnd_out=nt_apnd, nt_hpnd_out=nt_hpnd, nt_ipnd_out=nt_ipnd, & + nt_alvl_out=nt_alvl, nt_vlvl_out=nt_vlvl, nt_Tsfc_out=nt_Tsfc, & + nt_iage_out=nt_iage, nt_FY_out=nt_FY, & + nt_qice_out=nt_qice, nt_sice_out=nt_sice, & + nt_aero_out=nt_aero, nt_qsno_out=nt_qsno, & + nt_rsnw_out=nt_rsnw, nt_smice_out=nt_smice, nt_smliq_out=nt_smliq, & + nt_isosno_out=nt_isosno, nt_isoice_out=nt_isoice) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + +#ifndef CESMCOUPLED + prescribed_ice = .false. +#endif + + rsnwn (:,:) = c0 + smicen (:,:) = c0 + smliqn (:,:) = c0 + isoice (:,:) = c0 + aerosno(:,:,:) = c0 + aeroice(:,:,:) = c0 + +#ifdef CICE_IN_NEMO + do j = 1, ny_block + do i = 1, nx_block + + !--------------------------------------------------------------- + ! Scale frain and fsnow by ice concentration as these fields + ! are supplied by NEMO multiplied by ice concentration + !--------------------------------------------------------------- + + if (aice_init(i,j,iblk) > puny) then + raice = c1 / aice_init(i,j,iblk) + frain(i,j,iblk) = frain(i,j,iblk)*raice + fsnow(i,j,iblk) = fsnow(i,j,iblk)*raice + else + frain(i,j,iblk) = c0 + fsnow(i,j,iblk) = c0 + endif + + enddo ! i + enddo ! j +#endif + + this_block = get_block(blocks_ice(iblk),iblk) + ilo = this_block%ilo + ihi = this_block%ihi + jlo = this_block%jlo + jhi = this_block%jhi + + do j = jlo, jhi + do i = ilo, ihi + + if (tr_snow) then + do n = 1, ncat + do k = 1, nslyr + rsnwn (k,n) = trcrn(i,j,nt_rsnw +k-1,n,iblk) + smicen(k,n) = trcrn(i,j,nt_smice+k-1,n,iblk) + smliqn(k,n) = trcrn(i,j,nt_smliq+k-1,n,iblk) + enddo + enddo + endif ! tr_snow + + if (tr_iso) then ! trcrn(nt_iso*) has units kg/m^3 + do n=1,ncat + do k=1,n_iso + isosno(k,n) = trcrn(i,j,nt_isosno+k-1,n,iblk) * vsnon_init(i,j,n,iblk) + isoice(k,n) = trcrn(i,j,nt_isoice+k-1,n,iblk) * vicen_init(i,j,n,iblk) + enddo + enddo + endif ! tr_iso + + if (tr_aero) then ! trcrn(nt_aero) has units kg/m^3 + do n=1,ncat + do k=1,n_aero + aerosno (k,:,n) = & + trcrn(i,j,nt_aero+(k-1)*4 :nt_aero+(k-1)*4+1,n,iblk) & + * vsnon_init(i,j,n,iblk) + aeroice (k,:,n) = & + trcrn(i,j,nt_aero+(k-1)*4+2:nt_aero+(k-1)*4+3,n,iblk) & + * vicen_init(i,j,n,iblk) + enddo + enddo + endif ! tr_aero + + if (tmask(i,j,iblk)) then + + call icepack_step_therm1(dt=dt, ncat=ncat, & + nilyr=nilyr, nslyr=nslyr, & + aicen_init = aicen_init (i,j,:,iblk), & + vicen_init = vicen_init (i,j,:,iblk), & + vsnon_init = vsnon_init (i,j,:,iblk), & + aice = aice (i,j, iblk), & + aicen = aicen (i,j,:,iblk), & + vice = vice (i,j, iblk), & + vicen = vicen (i,j,:,iblk), & + vsno = vsno (i,j, iblk), & + vsnon = vsnon (i,j,:,iblk), & + uvel = uvelT_icep (i,j, iblk), & + vvel = vvelT_icep (i,j, iblk), & + Tsfc = trcrn (i,j,nt_Tsfc,:,iblk), & + zqsn = trcrn (i,j,nt_qsno:nt_qsno+nslyr-1,:,iblk), & + zqin = trcrn (i,j,nt_qice:nt_qice+nilyr-1,:,iblk), & + zSin = trcrn (i,j,nt_sice:nt_sice+nilyr-1,:,iblk), & + alvl = trcrn (i,j,nt_alvl,:,iblk), & + vlvl = trcrn (i,j,nt_vlvl,:,iblk), & + apnd = trcrn (i,j,nt_apnd,:,iblk), & + hpnd = trcrn (i,j,nt_hpnd,:,iblk), & + ipnd = trcrn (i,j,nt_ipnd,:,iblk), & + iage = trcrn (i,j,nt_iage,:,iblk), & + FY = trcrn (i,j,nt_FY ,:,iblk), & +!opt rsnwn = rsnwn (:,:), & +!opt smicen = smicen (:,:), & +!opt smliqn = smliqn (:,:), & + aerosno = aerosno (:,:,:), & + aeroice = aeroice (:,:,:), & +!opt isosno = isosno (:,:), & +!opt isoice = isoice (:,:), & + uatm = uatmT (i,j, iblk), & + vatm = vatmT (i,j, iblk), & + wind = wind (i,j, iblk), & + zlvl = zlvl (i,j, iblk), & +!opt zlvs = zlvs (i,j, iblk), & + Qa = Qa (i,j, iblk), & +!opt Qa_iso = Qa_iso (i,j,:,iblk), & + rhoa = rhoa (i,j, iblk), & + Tair = Tair (i,j, iblk), & + Tref = Tref (i,j, iblk), & + Qref = Qref (i,j, iblk), & +!opt Qref_iso = Qref_iso (i,j,:,iblk), & + Uref = Uref (i,j, iblk), & + Cdn_atm_ratio= Cdn_atm_ratio(i,j, iblk), & + Cdn_ocn = Cdn_ocn (i,j, iblk), & + Cdn_ocn_skin = Cdn_ocn_skin(i,j, iblk), & + Cdn_ocn_floe = Cdn_ocn_floe(i,j, iblk), & + Cdn_ocn_keel = Cdn_ocn_keel(i,j, iblk), & + Cdn_atm = Cdn_atm (i,j, iblk), & + Cdn_atm_skin = Cdn_atm_skin(i,j, iblk), & + Cdn_atm_floe = Cdn_atm_floe(i,j, iblk), & + Cdn_atm_pond = Cdn_atm_pond(i,j, iblk), & + Cdn_atm_rdg = Cdn_atm_rdg (i,j, iblk), & + hfreebd = hfreebd (i,j, iblk), & + hdraft = hdraft (i,j, iblk), & + hridge = hridge (i,j, iblk), & + distrdg = distrdg (i,j, iblk), & + hkeel = hkeel (i,j, iblk), & + dkeel = dkeel (i,j, iblk), & + lfloe = lfloe (i,j, iblk), & + dfloe = dfloe (i,j, iblk), & + strax = strax (i,j, iblk), & + stray = stray (i,j, iblk), & + strairxT = strairxT (i,j, iblk), & + strairyT = strairyT (i,j, iblk), & + potT = potT (i,j, iblk), & + sst = sst (i,j, iblk), & + sss = sss (i,j, iblk), & + Tf = Tf (i,j, iblk), & + strocnxT = strocnxT_iavg(i,j, iblk), & + strocnyT = strocnyT_iavg(i,j, iblk), & + fbot = fbot (i,j, iblk), & + Tbot = Tbot (i,j, iblk), & + Tsnice = Tsnice (i,j, iblk), & + frzmlt = frzmlt (i,j, iblk), & + rside = rside (i,j, iblk), & + fside = fside (i,j, iblk), & +!opt wlat = wlat (i,j, iblk), & + fsnow = fsnow (i,j, iblk), & + frain = frain (i,j, iblk), & + fpond = fpond (i,j, iblk), & +!opt fsloss = fsloss (i,j, iblk), & + fsurf = fsurf (i,j, iblk), & + fsurfn = fsurfn (i,j,:,iblk), & + fcondtop = fcondtop (i,j, iblk), & + fcondtopn = fcondtopn (i,j,:,iblk), & + fcondbot = fcondbot (i,j, iblk), & + fcondbotn = fcondbotn (i,j,:,iblk), & + fswsfcn = fswsfcn (i,j,:,iblk), & + fswintn = fswintn (i,j,:,iblk), & + fswthrun = fswthrun (i,j,:,iblk), & +!opt fswthrun_vdr = fswthrun_vdr (i,j,:,iblk),& +!opt fswthrun_vdf = fswthrun_vdf (i,j,:,iblk),& +!opt fswthrun_idr = fswthrun_idr (i,j,:,iblk),& +!opt fswthrun_idf = fswthrun_idf (i,j,:,iblk),& + fswabs = fswabs (i,j, iblk), & + flwout = flwout (i,j, iblk), & + Sswabsn = Sswabsn (i,j,:,:,iblk), & + Iswabsn = Iswabsn (i,j,:,:,iblk), & + flw = flw (i,j, iblk), & + fsens = fsens (i,j, iblk), & + fsensn = fsensn (i,j,:,iblk), & + flat = flat (i,j, iblk), & + flatn = flatn (i,j,:,iblk), & + evap = evap (i,j, iblk), & + evaps = evaps (i,j, iblk), & + evapi = evapi (i,j, iblk), & + fresh = fresh (i,j, iblk), & + fsalt = fsalt (i,j, iblk), & + fhocn = fhocn (i,j, iblk), & + fswthru = fswthru (i,j, iblk), & +!opt fswthru_vdr = fswthru_vdr (i,j, iblk), & +!opt fswthru_vdf = fswthru_vdf (i,j, iblk), & +!opt fswthru_idr = fswthru_idr (i,j, iblk), & +!opt fswthru_idf = fswthru_idf (i,j, iblk), & + flatn_f = flatn_f (i,j,:,iblk), & + fsensn_f = fsensn_f (i,j,:,iblk), & + fsurfn_f = fsurfn_f (i,j,:,iblk), & + fcondtopn_f = fcondtopn_f (i,j,:,iblk), & + faero_atm = faero_atm (i,j,1:n_aero,iblk), & + faero_ocn = faero_ocn (i,j,1:n_aero,iblk), & +!opt fiso_atm = fiso_atm (i,j,:,iblk), & +!opt fiso_ocn = fiso_ocn (i,j,:,iblk), & +!opt fiso_evap = fiso_evap (i,j,:,iblk), & +!opt HDO_ocn = HDO_ocn (i,j, iblk), & +!opt H2_16O_ocn = H2_16O_ocn (i,j, iblk), & +!opt H2_18O_ocn = H2_18O_ocn (i,j, iblk), & + dhsn = dhsn (i,j,:,iblk), & + ffracn = ffracn (i,j,:,iblk), & + meltt = meltt (i,j, iblk), & + melttn = melttn (i,j,:,iblk), & + meltb = meltb (i,j, iblk), & + meltbn = meltbn (i,j,:,iblk), & + melts = melts (i,j, iblk), & + meltsn = meltsn (i,j,:,iblk), & + congel = congel (i,j, iblk), & + congeln = congeln (i,j,:,iblk), & + snoice = snoice (i,j, iblk), & + snoicen = snoicen (i,j,:,iblk), & +!opt dsnow = dsnow (i,j, iblk), & + dsnown = dsnown (i,j,:,iblk), & +!opt meltsliq = meltsliq (i,j, iblk), & +!opt meltsliqn = meltsliqn (i,j,:,iblk), & + lmask_n = lmask_n (i,j, iblk), & + lmask_s = lmask_s (i,j, iblk), & + mlt_onset = mlt_onset (i,j, iblk), & + frz_onset = frz_onset (i,j, iblk), & + yday=yday & +!opt prescribed_ice=prescribed_ice, & + ) + + !----------------------------------------------------------------- + ! handle per-category i2x fields, no merging + !----------------------------------------------------------------- + + if (send_i2x_per_cat) then + do n = 1, ncat + ! TODO (mvertens, 2018-12-22): do we need to add the band separated quantities + ! for MOM6 here also? + + fswthrun_ai(i,j,n,iblk) = fswthrun(i,j,n,iblk)*aicen_init(i,j,n,iblk) + enddo ! ncat + endif + + endif + + if (tr_snow) then + do n = 1, ncat + do k = 1, nslyr + trcrn(i,j,nt_rsnw +k-1,n,iblk) = rsnwn (k,n) + trcrn(i,j,nt_smice+k-1,n,iblk) = smicen(k,n) + trcrn(i,j,nt_smliq+k-1,n,iblk) = smliqn(k,n) + enddo + enddo + endif ! tr_snow + + if (tr_iso) then + do n = 1, ncat + if (vicen(i,j,n,iblk) > puny) & + isoice(:,n) = isoice(:,n)/vicen(i,j,n,iblk) + if (vsnon(i,j,n,iblk) > puny) & + isosno(:,n) = isosno(:,n)/vsnon(i,j,n,iblk) + do k = 1, n_iso + trcrn(i,j,nt_isosno+k-1,n,iblk) = isosno(k,n) + trcrn(i,j,nt_isoice+k-1,n,iblk) = isoice(k,n) + enddo + enddo + endif ! tr_iso + + if (tr_aero) then + do n = 1, ncat + if (vicen(i,j,n,iblk) > puny) & + aeroice(:,:,n) = aeroice(:,:,n)/vicen(i,j,n,iblk) + if (vsnon(i,j,n,iblk) > puny) & + aerosno(:,:,n) = aerosno(:,:,n)/vsnon(i,j,n,iblk) + do k = 1, n_aero + do kk = 1, 2 + trcrn(i,j,nt_aero+(k-1)*4+kk-1,n,iblk)=aerosno(k,kk,n) + trcrn(i,j,nt_aero+(k-1)*4+kk+1,n,iblk)=aeroice(k,kk,n) + enddo + enddo + enddo + endif ! tr_aero + + enddo ! i + enddo ! j + + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + + end subroutine step_therm1 + +!======================================================================= +! Driver for thermodynamic changes not needed for coupling: +! transport in thickness space, lateral growth and melting. +! +! authors: William H. Lipscomb, LANL +! Elizabeth C. Hunke, LANL + + subroutine step_therm2 (dt, iblk) + + use ice_arrays_column, only: hin_max, fzsal, ocean_bio, wave_sig_ht, & + wave_spectrum, wavefreq, dwavefreq, & + first_ice, bgrid, cgrid, igrid, floe_rad_c, floe_binwidth, & + d_afsd_latg, d_afsd_newi, d_afsd_latm, d_afsd_weld + use ice_calendar, only: yday + use ice_domain_size, only: ncat, nilyr, nslyr, nblyr, nfsd + use ice_flux, only: fresh, frain, fpond, frzmlt, frazil, frz_onset, & + update_ocn_f, fsalt, Tf, sss, salinz, fhocn, rside, fside, wlat, & + meltl, frazil_diag + use ice_flux_bgc, only: flux_bio, faero_ocn, & + fiso_ocn, HDO_ocn, H2_16O_ocn, H2_18O_ocn + use ice_grid, only: tmask + use ice_state, only: aice, aicen, aice0, trcr_depend, & + aicen_init, vicen_init, trcrn, vicen, vsnon, & + trcr_base, n_trcr_strata, nt_strata + + real (kind=dbl_kind), intent(in) :: & + dt ! time step + + integer (kind=int_kind), intent(in) :: & + iblk ! block index + + ! local variables + + integer (kind=int_kind) :: & + ilo,ihi,jlo,jhi, & ! beginning and end of physical domain + i, j ! horizontal indices + + integer (kind=int_kind) :: & + ntrcr, nbtrcr, nltrcr + + logical (kind=log_kind) :: & + tr_fsd, & ! floe size distribution tracers + z_tracers, & ! vertical biogeochemistry + solve_zsal ! zsalinity + + type (block) :: & + this_block ! block information for current block + + character(len=*), parameter :: subname = '(step_therm2)' + + call icepack_query_parameters(z_tracers_out=z_tracers,solve_zsal_out=solve_zsal) + call icepack_query_tracer_sizes(ntrcr_out=ntrcr, nbtrcr_out=nbtrcr) + call icepack_query_tracer_flags(tr_fsd_out=tr_fsd) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + + ! nltrcr is only used as a zbgc flag in icepack (number of zbgc tracers > 0) + if (z_tracers .or. solve_zsal) then + nltrcr = 1 + else + nltrcr = 0 + endif + + this_block = get_block(blocks_ice(iblk),iblk) + ilo = this_block%ilo + ihi = this_block%ihi + jlo = this_block%jlo + jhi = this_block%jhi + + do j = jlo, jhi + do i = ilo, ihi + + if (tmask(i,j,iblk)) then + + ! significant wave height for FSD + if (tr_fsd) & + wave_sig_ht(i,j,iblk) = c4*SQRT(SUM(wave_spectrum(i,j,:,iblk)*dwavefreq(:))) + + call icepack_step_therm2(dt=dt, ncat=ncat, & + nltrcr=nltrcr, nilyr=nilyr, nslyr=nslyr, nblyr=nblyr, & + hin_max = hin_max (:), & + aicen = aicen (i,j,:,iblk), & + vicen = vicen (i,j,:,iblk), & + vsnon = vsnon (i,j,:,iblk), & + aicen_init = aicen_init(i,j,:,iblk), & + vicen_init = vicen_init(i,j,:,iblk), & + trcrn = trcrn (i,j,:,:,iblk), & + aice0 = aice0 (i,j, iblk), & + aice = aice (i,j, iblk), & + trcr_depend= trcr_depend(:), & + trcr_base = trcr_base(:,:), & + n_trcr_strata = n_trcr_strata(:), & + nt_strata = nt_strata(:,:), & + Tf = Tf (i,j, iblk), & + sss = sss (i,j, iblk), & + salinz = salinz (i,j,:,iblk), & + rside = rside (i,j, iblk), & + meltl = meltl (i,j, iblk), & + fside = fside (i,j, iblk), & +!opt wlat = wlat (i,j, iblk), & + frzmlt = frzmlt (i,j, iblk), & + frazil = frazil (i,j, iblk), & + frain = frain (i,j, iblk), & + fpond = fpond (i,j, iblk), & + fresh = fresh (i,j, iblk), & + fsalt = fsalt (i,j, iblk), & + fhocn = fhocn (i,j, iblk), & + update_ocn_f = update_ocn_f, & + bgrid = bgrid, & + cgrid = cgrid, & + igrid = igrid, & + faero_ocn = faero_ocn (i,j,:,iblk), & + first_ice = first_ice (i,j,:,iblk), & + fzsal = fzsal (i,j, iblk), & + flux_bio = flux_bio (i,j,1:nbtrcr,iblk), & + ocean_bio = ocean_bio (i,j,1:nbtrcr,iblk), & + frazil_diag= frazil_diag(i,j,iblk) & +!opt frz_onset = frz_onset (i,j, iblk), & +!opt yday = yday, & +!opt fiso_ocn = fiso_ocn (i,j,:,iblk), & +!opt HDO_ocn = HDO_ocn (i,j, iblk), & +!opt H2_16O_ocn = H2_16O_ocn(i,j, iblk), & +!opt H2_18O_ocn = H2_18O_ocn(i,j, iblk), & +!opt nfsd = nfsd, & +!opt wave_sig_ht= wave_sig_ht(i,j,iblk), & +!opt wave_spectrum = wave_spectrum(i,j,:,iblk), & +!opt wavefreq = wavefreq(:), & +!opt dwavefreq = dwavefreq(:), & +!opt d_afsd_latg= d_afsd_latg(i,j,:,iblk),& +!opt d_afsd_newi= d_afsd_newi(i,j,:,iblk),& +!opt d_afsd_latm= d_afsd_latm(i,j,:,iblk),& +!opt d_afsd_weld= d_afsd_weld(i,j,:,iblk),& +!opt floe_rad_c = floe_rad_c(:), & +!opt floe_binwidth = floe_binwidth(:) & + ) + endif ! tmask + + enddo ! i + enddo ! j + + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + + end subroutine step_therm2 + +!======================================================================= +! +! finalize thermo updates +! +! authors: Elizabeth Hunke, LANL + + subroutine update_state (dt, daidt, dvidt, dagedt, offset) + + use ice_domain_size, only: ncat +! use ice_grid, only: tmask + use ice_state, only: aicen, trcrn, vicen, vsnon, & + aice, trcr, vice, vsno, aice0, trcr_depend, & + bound_state, trcr_base, nt_strata, n_trcr_strata + use ice_timers, only: ice_timer_start, ice_timer_stop, timer_bound, timer_updstate + + real (kind=dbl_kind), intent(in) :: & + dt ! time step + + real (kind=dbl_kind), dimension(:,:,:), intent(inout), optional :: & + daidt, & ! change in ice area per time step + dvidt, & ! change in ice volume per time step + dagedt ! change in ice age per time step + + real (kind=dbl_kind), intent(in), optional :: & + offset ! d(age)/dt time offset = dt for thermo, 0 for dyn + + integer (kind=int_kind) :: & + iblk, & ! block index + i,j, & ! horizontal indices + ntrcr, & ! + nt_iage ! + + logical (kind=log_kind) :: & + tr_iage ! + + character(len=*), parameter :: subname='(update_state)' + + call ice_timer_start(timer_updstate) + call icepack_query_tracer_flags(tr_iage_out=tr_iage) + call icepack_query_tracer_sizes(ntrcr_out=ntrcr) + call icepack_query_tracer_indices(nt_iage_out=nt_iage) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + + !------------------------------------------------------------------- + ! Ghost cell updates for state variables. + !------------------------------------------------------------------- + + call ice_timer_start(timer_bound) + call bound_state (aicen, & + vicen, vsnon, & + ntrcr, trcrn) + call ice_timer_stop(timer_bound) + + !$OMP PARALLEL DO PRIVATE(iblk,i,j) SCHEDULE(runtime) + do iblk = 1, nblocks + do j = 1, ny_block + do i = 1, nx_block + + !----------------------------------------------------------------- + ! Aggregate the updated state variables (includes ghost cells). + !----------------------------------------------------------------- + +! if (tmask(i,j,iblk)) & + call icepack_aggregate(ncat = ncat, & + aicen = aicen(i,j,:,iblk), & + trcrn = trcrn(i,j,:,:,iblk), & + vicen = vicen(i,j,:,iblk), & + vsnon = vsnon(i,j,:,iblk), & + aice = aice (i,j, iblk), & + trcr = trcr (i,j,:,iblk), & + vice = vice (i,j, iblk), & + vsno = vsno (i,j, iblk), & + aice0 = aice0(i,j, iblk), & + ntrcr = ntrcr, & + trcr_depend = trcr_depend(:), & + trcr_base = trcr_base(:,:), & + n_trcr_strata = n_trcr_strata(:), & + nt_strata = nt_strata(:,:)) + + if (present(offset)) then + + !----------------------------------------------------------------- + ! Compute thermodynamic area and volume tendencies. + !----------------------------------------------------------------- + + daidt(i,j,iblk) = (aice(i,j,iblk) - daidt(i,j,iblk)) / dt + dvidt(i,j,iblk) = (vice(i,j,iblk) - dvidt(i,j,iblk)) / dt + if (tr_iage) then + if (offset > c0) then ! thermo + if (trcr(i,j,nt_iage,iblk) > c0) & + dagedt(i,j,iblk) = (trcr(i,j,nt_iage,iblk) & + - dagedt(i,j,iblk) - offset) / dt + else ! dynamics + dagedt(i,j,iblk) = (trcr(i,j,nt_iage,iblk) & + - dagedt(i,j,iblk)) / dt + endif + endif ! tr_iage + endif ! present(offset) + + enddo ! i + enddo ! j + enddo ! iblk + !$OMP END PARALLEL DO + + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + call ice_timer_stop(timer_updstate) + + end subroutine update_state + +!======================================================================= +! +! Run one time step of wave-fracturing the floe size distribution +! +! authors: Lettie Roach, NIWA +! Elizabeth C. Hunke, LANL + + subroutine step_dyn_wave (dt) + + use ice_arrays_column, only: wave_spectrum, & + d_afsd_wave, floe_rad_l, floe_rad_c, wavefreq, dwavefreq + use ice_domain_size, only: ncat, nfsd, nfreq + use ice_state, only: trcrn, aicen, aice, vice + use ice_timers, only: ice_timer_start, ice_timer_stop, timer_column, & + timer_fsd + + real (kind=dbl_kind), intent(in) :: & + dt ! time step + + ! local variables + + type (block) :: & + this_block ! block information for current block + + integer (kind=int_kind) :: & + ilo,ihi,jlo,jhi, & ! beginning and end of physical domain + iblk, & ! block index + i, j ! horizontal indices + + character (len=char_len) :: wave_spec_type + + character(len=*), parameter :: subname = '(step_dyn_wave)' + + call ice_timer_start(timer_column) + call ice_timer_start(timer_fsd) + + call icepack_query_parameters(wave_spec_type_out=wave_spec_type) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + + !$OMP PARALLEL DO PRIVATE(iblk,i,j,ilo,ihi,jlo,jhi,this_block) + do iblk = 1, nblocks + + this_block = get_block(blocks_ice(iblk),iblk) + ilo = this_block%ilo + ihi = this_block%ihi + jlo = this_block%jlo + jhi = this_block%jhi + + do j = jlo, jhi + do i = ilo, ihi + d_afsd_wave(i,j,:,iblk) = c0 + call icepack_step_wavefracture (wave_spec_type, & + dt, ncat, nfsd, nfreq, & + aice (i,j, iblk), & + vice (i,j, iblk), & + aicen (i,j,:, iblk), & + floe_rad_l(:), floe_rad_c(:), & + wave_spectrum (i,j,:, iblk), & + wavefreq(:), dwavefreq(:), & + trcrn (i,j,:,:,iblk), & + d_afsd_wave (i,j,:, iblk)) + end do ! i + end do ! j + end do ! iblk + !$OMP END PARALLEL DO + + call ice_timer_stop(timer_fsd) + call ice_timer_stop(timer_column) + + end subroutine step_dyn_wave + +!======================================================================= +! +! Run one time step of dynamics and horizontal transport. +! NOTE: The evp and transport modules include boundary updates, so +! they cannot be done inside a single block loop. +! +! authors: William H. Lipscomb, LANL +! Elizabeth C. Hunke, LANL + + subroutine step_dyn_horiz (dt) + + use ice_boundary, only: ice_HaloUpdate + use ice_dyn_evp, only: evp + use ice_dyn_eap, only: eap + use ice_dyn_vp, only: implicit_solver + use ice_dyn_shared, only: kdyn + use ice_flux, only: strocnxU, strocnyU, strocnxT_iavg, strocnyT_iavg + use ice_flux, only: init_history_dyn + use ice_grid, only: grid_average_X2Y + use ice_state, only: aiU + use ice_transport_driver, only: advection, transport_upwind, transport_remap + + real (kind=dbl_kind), intent(in) :: & + dt ! dynamics time step + + ! local variables + + type (block) :: & + this_block ! block information for current block + + integer (kind=int_kind) :: & + ilo,ihi,jlo,jhi, & ! beginning and end of physical domain + iblk, & ! block index + i, j ! horizontal indices + + real (kind=dbl_kind), dimension (nx_block,ny_block,max_blocks) :: & + work1, & ! temporary + work2 ! temporary + + character(len=*), parameter :: subname = '(step_dyn_horiz)' + + call init_history_dyn ! initialize dynamic history variables + + !----------------------------------------------------------------- + ! Ice dynamics (momentum equation) + !----------------------------------------------------------------- + + if (kdyn == 1) call evp (dt) + if (kdyn == 2) call eap (dt) + if (kdyn == 3) call implicit_solver (dt) + + !----------------------------------------------------------------- + ! Compute strocnxT_iavg, strocnyT_iavg for thermo and coupling + !----------------------------------------------------------------- + + ! strocn computed on U, N, E as needed. Map strocn U divided by aiU to T + ! conservation requires aiU be divided before averaging + work1 = c0 + work2 = c0 + !$OMP PARALLEL DO PRIVATE(iblk,i,j,ilo,ihi,jlo,jhi,this_block) + do iblk = 1, nblocks + this_block = get_block(blocks_ice(iblk), iblk) + ilo = this_block%ilo + ihi = this_block%ihi + jlo = this_block%jlo + jhi = this_block%jhi + do j = jlo, jhi + do i = ilo, ihi + if (aiU(i,j,iblk) /= c0) then + work1(i,j,iblk) = strocnxU(i,j,iblk)/aiU(i,j,iblk) + work2(i,j,iblk) = strocnyU(i,j,iblk)/aiU(i,j,iblk) + endif + enddo + enddo + enddo + !$OMP END PARALLEL DO + call ice_HaloUpdate (work1, halo_info, & + field_loc_NEcorner, field_type_vector) + call ice_HaloUpdate (work2, halo_info, & + field_loc_NEcorner, field_type_vector) + call grid_average_X2Y('F', work1, 'U', strocnxT_iavg, 'T') ! shift + call grid_average_X2Y('F', work2, 'U', strocnyT_iavg, 'T') + + !----------------------------------------------------------------- + ! Horizontal ice transport + !----------------------------------------------------------------- + + if (advection == 'upwind') then + call transport_upwind (dt) ! upwind + elseif (advection == 'remap') then + call transport_remap (dt) ! incremental remapping + endif + + end subroutine step_dyn_horiz + +!======================================================================= +! +! Run one time step of ridging. +! +! authors: William H. Lipscomb, LANL +! Elizabeth C. Hunke, LANL + + subroutine step_dyn_ridge (dt, ndtd, iblk) + + use ice_arrays_column, only: hin_max, fzsal, first_ice + use ice_domain_size, only: ncat, nilyr, nslyr, n_aero, nblyr + use ice_flux, only: & + rdg_conv, rdg_shear, dardg1dt, dardg2dt, & + dvirdgdt, opening, fpond, fresh, fhocn, & + aparticn, krdgn, aredistn, vredistn, dardg1ndt, dardg2ndt, & + dvirdgndt, araftn, vraftn, fsalt + use ice_flux_bgc, only: flux_bio, faero_ocn, fiso_ocn + use ice_grid, only: tmask + use ice_state, only: trcrn, vsnon, aicen, vicen, & + aice, aice0, trcr_depend, n_trcr_strata, & + trcr_base, nt_strata + use ice_timers, only: ice_timer_start, ice_timer_stop, timer_column, & + timer_ridge + + real (kind=dbl_kind), intent(in) :: & + dt ! time step + + integer (kind=int_kind), intent(in) :: & + ndtd, & ! number of dynamics subcycles + iblk ! block index + + ! local variables + + type (block) :: & + this_block ! block information for current block + + integer (kind=int_kind) :: & + ilo,ihi,jlo,jhi, & ! beginning and end of physical domain + i, j, & ! horizontal indices + ntrcr, & ! + nbtrcr ! + + character(len=*), parameter :: subname = '(step_dyn_ridge)' + + !----------------------------------------------------------------- + ! Ridging + !----------------------------------------------------------------- + + call ice_timer_start(timer_column,iblk) + call ice_timer_start(timer_ridge,iblk) + + call icepack_query_tracer_sizes(ntrcr_out=ntrcr, nbtrcr_out=nbtrcr) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + + this_block = get_block(blocks_ice(iblk), iblk) + ilo = this_block%ilo + ihi = this_block%ihi + jlo = this_block%jlo + jhi = this_block%jhi + + do j = jlo, jhi + do i = ilo, ihi + +!echmod: this changes the answers, continue using tmask for now +! call aggregate_area (ncat, aicen(i,j,:,iblk), atmp, atmp0) +! if (atmp > c0) then + + if (tmask(i,j,iblk)) then + + call icepack_step_ridge (dt=dt, ndtd=ndtd, & + nilyr=nilyr, nslyr=nslyr, nblyr=nblyr, & + ncat=ncat, n_aero=n_aero, hin_max=hin_max(:), & + trcr_depend = trcr_depend (:), & + trcr_base = trcr_base (:,:), & + n_trcr_strata = n_trcr_strata(:), & + nt_strata = nt_strata (:,:), & + trcrn = trcrn (i,j,:,:,iblk), & + rdg_conv = rdg_conv (i,j, iblk), & + rdg_shear = rdg_shear(i,j, iblk), & + aicen = aicen (i,j,:,iblk), & + vicen = vicen (i,j,:,iblk), & + vsnon = vsnon (i,j,:,iblk), & + aice0 = aice0 (i,j, iblk), & + dardg1dt = dardg1dt (i,j, iblk), & + dardg2dt = dardg2dt (i,j, iblk), & + dvirdgdt = dvirdgdt (i,j, iblk), & + opening = opening (i,j, iblk), & + fpond = fpond (i,j, iblk), & + fresh = fresh (i,j, iblk), & + fhocn = fhocn (i,j, iblk), & + faero_ocn = faero_ocn(i,j,:,iblk), & +!opt fiso_ocn = fiso_ocn (i,j,:,iblk), & + aparticn = aparticn (i,j,:,iblk), & + krdgn = krdgn (i,j,:,iblk), & + aredistn = aredistn (i,j,:,iblk), & + vredistn = vredistn (i,j,:,iblk), & + dardg1ndt = dardg1ndt(i,j,:,iblk), & + dardg2ndt = dardg2ndt(i,j,:,iblk), & + dvirdgndt = dvirdgndt(i,j,:,iblk), & + araftn = araftn (i,j,:,iblk), & + vraftn = vraftn (i,j,:,iblk), & + aice = aice (i,j, iblk), & + fsalt = fsalt (i,j, iblk), & + first_ice = first_ice(i,j,:,iblk), & + fzsal = fzsal (i,j, iblk), & + flux_bio = flux_bio (i,j,1:nbtrcr,iblk)) + + endif ! tmask + + enddo ! i + enddo ! j + + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + + call ice_timer_stop(timer_ridge,iblk) + call ice_timer_stop(timer_column,iblk) + + end subroutine step_dyn_ridge + +!======================================================================= +! +! Updates snow tracers +! +! authors: Elizabeth C. Hunke, LANL +! Nicole Jeffery, LANL + + subroutine step_snow (dt, iblk) + + use ice_calendar, only: nstreams + use ice_domain_size, only: ncat, nslyr, nilyr + use ice_flux, only: snwcnt, wind, fresh, fhocn, fsloss, fsnow + use ice_state, only: trcrn, vsno, vsnon, vicen, aicen, aice + use icepack_intfc, only: icepack_step_snow + + real (kind=dbl_kind), intent(in) :: & + dt ! time step + + integer (kind=int_kind), intent(in) :: & + iblk ! block index + + ! local variables + + integer (kind=int_kind) :: & + nt_smice, nt_smliq, nt_rsnw, & + nt_Tsfc, nt_qice, nt_sice, nt_qsno, & + nt_alvl, nt_vlvl, nt_rhos + + integer (kind=int_kind) :: & + ilo,ihi,jlo,jhi, & ! beginning and end of physical domain + i, j, & ! horizontal indices + ns ! history streams index + + real (kind=dbl_kind) :: & + puny + + real (kind=dbl_kind) :: & + fhs ! flag for presence of snow + + character(len=*), parameter :: subname = '(step_snow)' + + type (block) :: & + this_block ! block information for current block + + this_block = get_block(blocks_ice(iblk),iblk) + ilo = this_block%ilo + ihi = this_block%ihi + jlo = this_block%jlo + jhi = this_block%jhi + + !----------------------------------------------------------------- + ! query icepack values + !----------------------------------------------------------------- + + call icepack_query_parameters(puny_out=puny) + call icepack_query_tracer_indices( & + nt_smice_out=nt_smice, nt_smliq_out=nt_smliq, & + nt_rsnw_out=nt_rsnw, nt_Tsfc_out=nt_Tsfc, & + nt_qice_out=nt_qice, nt_sice_out=nt_sice, nt_qsno_out=nt_qsno, & + nt_alvl_out=nt_alvl, nt_vlvl_out=nt_vlvl, nt_rhos_out=nt_rhos) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + + !----------------------------------------------------------------- + ! Snow redistribution and metamorphosis + !----------------------------------------------------------------- + + do j = jlo, jhi + do i = ilo, ihi + + call icepack_step_snow (dt, nilyr, & + nslyr, ncat, & + wind (i,j, iblk), & + aice (i,j, iblk), & + aicen(i,j,:,iblk), & + vicen(i,j,:,iblk), & + vsnon(i,j,:,iblk), & + trcrn(i,j,nt_Tsfc,:,iblk), & + trcrn(i,j,nt_qice,:,iblk), & ! top layer only + trcrn(i,j,nt_sice,:,iblk), & ! top layer only + trcrn(i,j,nt_qsno:nt_qsno+nslyr-1,:,iblk), & + trcrn(i,j,nt_alvl,:,iblk), & + trcrn(i,j,nt_vlvl,:,iblk), & + trcrn(i,j,nt_smice:nt_smice+nslyr-1,:,iblk), & + trcrn(i,j,nt_smliq:nt_smliq+nslyr-1,:,iblk), & + trcrn(i,j,nt_rsnw:nt_rsnw+nslyr-1,:,iblk), & + trcrn(i,j,nt_rhos:nt_rhos+nslyr-1,:,iblk), & + fresh (i,j,iblk), & + fhocn (i,j,iblk), & + fsloss (i,j,iblk), & + fsnow (i,j,iblk)) + enddo + enddo + + ! increment counter for history averaging + do j = jlo, jhi + do i = ilo, ihi + fhs = c0 + if (vsno(i,j,iblk) > puny) fhs = c1 + do ns = 1, nstreams + snwcnt(i,j,iblk,ns) = snwcnt(i,j,iblk,ns) + fhs + enddo + enddo + enddo + + end subroutine step_snow + +!======================================================================= +! +! Computes radiation fields +! +! authors: William H. Lipscomb, LANL +! David Bailey, NCAR +! Elizabeth C. Hunke, LANL + + subroutine step_radiation (dt, iblk) + + use ice_arrays_column, only: ffracn, dhsn, & + fswsfcn, fswintn, fswpenln, Sswabsn, Iswabsn, & + fswthrun, fswthrun_vdr, fswthrun_vdf, fswthrun_idr, fswthrun_idf, & + albicen, albsnon, albpndn, & + alvdrn, alidrn, alvdfn, alidfn, apeffn, trcrn_sw, snowfracn, & + kaer_tab, waer_tab, gaer_tab, kaer_bc_tab, waer_bc_tab, & + gaer_bc_tab, bcenh, swgrid, igrid + use ice_calendar, only: calendar_type, days_per_year, nextsw_cday, yday, msec + use ice_domain_size, only: ncat, n_aero, nilyr, nslyr, n_zaero, n_algae, nblyr + use ice_flux, only: swvdr, swvdf, swidr, swidf, coszen, fsnow + use ice_grid, only: TLAT, TLON, tmask + use ice_state, only: aicen, vicen, vsnon, trcrn + use ice_timers, only: ice_timer_start, ice_timer_stop, timer_sw + use ice_communicate, only: my_task + use ice_diagnostics, only: npnt, print_points, pmloc, piloc, pjloc + + real (kind=dbl_kind), intent(in) :: & + dt ! time step + + integer (kind=int_kind), intent(in) :: & + iblk ! block index + + ! local variables + + integer (kind=int_kind) :: & + ilo,ihi,jlo,jhi, & ! beginning and end of physical domain + i, j, n, k, & ! horizontal indices + ipoint ! index for print diagnostic + + type (block) :: & + this_block ! block information for current block + + integer (kind=int_kind) :: & + nt_Tsfc, nt_alvl, nt_rsnw, & + nt_apnd, nt_hpnd, nt_ipnd, nt_aero, nlt_chl_sw, & + ntrcr, nbtrcr, nbtrcr_sw, nt_fbri + + integer (kind=int_kind), dimension(icepack_max_algae) :: & + nt_bgc_N + + integer (kind=int_kind), dimension(icepack_max_aero) :: & + nlt_zaero_sw, nt_zaero + + logical (kind=log_kind) :: & + tr_bgc_N, tr_zaero, tr_brine, dEdd_algae, modal_aero, snwgrain + + real (kind=dbl_kind), dimension(ncat) :: & + fbri ! brine height to ice thickness + + real(kind= dbl_kind), dimension(:,:), allocatable :: & + ztrcr_sw, & ! zaerosols (kg/m^3) and chla (mg/m^3) + rsnow ! snow grain radius tracer (10^-6 m) + + logical (kind=log_kind) :: & + debug, & ! flag for printing debugging information + l_print_point ! flag for printing debugging information + + character(len=*), parameter :: subname = '(step_radiation)' + + call ice_timer_start(timer_sw,iblk) ! shortwave + + call icepack_query_tracer_sizes(ntrcr_out=ntrcr, & + nbtrcr_out=nbtrcr, nbtrcr_sw_out=nbtrcr_sw) + call icepack_query_tracer_flags( & + tr_brine_out=tr_brine, tr_bgc_N_out=tr_bgc_N, tr_zaero_out=tr_zaero) + call icepack_query_tracer_indices( & + nt_Tsfc_out=nt_Tsfc, nt_alvl_out=nt_alvl, nt_rsnw_out=nt_rsnw, & + nt_apnd_out=nt_apnd, nt_hpnd_out=nt_hpnd, nt_ipnd_out=nt_ipnd, nt_aero_out=nt_aero, & + nlt_chl_sw_out=nlt_chl_sw, nlt_zaero_sw_out=nlt_zaero_sw, & + nt_fbri_out=nt_fbri, nt_zaero_out=nt_zaero, nt_bgc_N_out=nt_bgc_N) + call icepack_query_parameters(dEdd_algae_out=dEdd_algae, modal_aero_out=modal_aero, & + snwgrain_out=snwgrain) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + + allocate(ztrcr_sw(nbtrcr_sw,ncat)) + allocate(rsnow(nslyr,ncat)) + + this_block = get_block(blocks_ice(iblk),iblk) + ilo = this_block%ilo + ihi = this_block%ihi + jlo = this_block%jlo + jhi = this_block%jhi + + do j = jlo, jhi + do i = ilo, ihi + + l_print_point = .false. + debug = .false. + if (debug .and. print_points) then + do ipoint = 1, npnt + if (my_task == pmloc(ipoint) .and. & + i == piloc(ipoint) .and. & + j == pjloc(ipoint)) & + l_print_point = .true. + write (nu_diag, *) 'my_task = ',my_task + enddo ! ipoint + endif + fbri (:) = c0 + ztrcr_sw(:,:) = c0 + rsnow (:,:) = c0 + do n = 1, ncat + if (tr_brine) fbri(n) = trcrn(i,j,nt_fbri,n,iblk) + if (snwgrain) then + do k = 1, nslyr + rsnow(k,n) = trcrn(i,j,nt_rsnw+k-1,n,iblk) + enddo + endif + enddo + + if (tmask(i,j,iblk)) then + + call icepack_step_radiation (dt=dt, ncat=ncat, & + nblyr=nblyr, nilyr=nilyr, nslyr=nslyr, & + dEdd_algae=dEdd_algae, & + swgrid=swgrid(:), igrid=igrid(:), & + fbri=fbri(:), & + aicen=aicen(i,j, :,iblk), & + vicen=vicen(i,j, :,iblk), & + vsnon=vsnon(i,j, :,iblk), & + Tsfcn=trcrn(i,j,nt_Tsfc,:,iblk), & + alvln=trcrn(i,j,nt_alvl,:,iblk), & + apndn=trcrn(i,j,nt_apnd,:,iblk), & + hpndn=trcrn(i,j,nt_hpnd,:,iblk), & + ipndn=trcrn(i,j,nt_ipnd,:,iblk), & + aeron=trcrn(i,j,nt_aero:nt_aero+4*n_aero-1,:,iblk), & + bgcNn=trcrn(i,j,nt_bgc_N(1):nt_bgc_N(1)+n_algae*(nblyr+3)-1,:,iblk), & + zaeron=trcrn(i,j,nt_zaero(1):nt_zaero(1)+n_zaero*(nblyr+3)-1,:,iblk), & + trcrn_bgcsw=ztrcr_sw, & + TLAT=TLAT(i,j,iblk), TLON=TLON(i,j,iblk), & + calendar_type=calendar_type, & + days_per_year=days_per_year, & + nextsw_cday=nextsw_cday, yday=yday, & + sec=msec, & + kaer_tab=kaer_tab, kaer_bc_tab=kaer_bc_tab(:,:), & + waer_tab=waer_tab, waer_bc_tab=waer_bc_tab(:,:), & + gaer_tab=gaer_tab, gaer_bc_tab=gaer_bc_tab(:,:), & + bcenh=bcenh(:,:,:), & + modal_aero=modal_aero, & + swvdr =swvdr (i,j ,iblk), swvdf =swvdf (i,j ,iblk), & + swidr =swidr (i,j ,iblk), swidf =swidf (i,j ,iblk), & + coszen =coszen (i,j ,iblk), fsnow =fsnow (i,j ,iblk), & + alvdrn =alvdrn (i,j,: ,iblk), alvdfn =alvdfn (i,j,: ,iblk), & + alidrn =alidrn (i,j,: ,iblk), alidfn =alidfn (i,j,: ,iblk), & + fswsfcn =fswsfcn (i,j,: ,iblk), fswintn =fswintn (i,j,: ,iblk), & + fswthrun =fswthrun (i,j,: ,iblk), & +!opt fswthrun_vdr =fswthrun_vdr (i,j,: ,iblk), & +!opt fswthrun_vdf =fswthrun_vdf (i,j,: ,iblk), & +!opt fswthrun_idr =fswthrun_idr (i,j,: ,iblk), & +!opt fswthrun_idf =fswthrun_idf (i,j,: ,iblk), & + fswpenln=fswpenln(i,j,:,:,iblk), & + Sswabsn =Sswabsn (i,j,:,:,iblk), Iswabsn =Iswabsn (i,j,:,:,iblk), & + albicen =albicen (i,j,: ,iblk), albsnon =albsnon (i,j,: ,iblk), & + albpndn =albpndn (i,j,: ,iblk), apeffn =apeffn (i,j,: ,iblk), & + snowfracn=snowfracn(i,j,: ,iblk), & + dhsn =dhsn (i,j,: ,iblk), ffracn =ffracn(i,j,:,iblk), & +!opt rsnow =rsnow (:,:), & + l_print_point=l_print_point) + endif + + if (dEdd_algae .and. (tr_zaero .or. tr_bgc_N)) then + do n = 1, ncat + do k = 1, nbtrcr_sw + trcrn_sw(i,j,k,n,iblk) = ztrcr_sw(k,n) + enddo + enddo + endif + + enddo ! i + enddo ! j + + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + + deallocate(ztrcr_sw) + deallocate(rsnow) + + call ice_timer_stop(timer_sw,iblk) ! shortwave + + end subroutine step_radiation + +!======================================================================= +! Ocean mixed layer calculation (internal to sea ice model). +! Allows heat storage in ocean for uncoupled runs. +! +! authors: John Weatherly, CRREL +! C.M. Bitz, UW +! Elizabeth C. Hunke, LANL +! Bruce P. Briegleb, NCAR +! William H. Lipscomb, LANL + + subroutine ocean_mixed_layer (dt, iblk) + + use ice_arrays_column, only: Cdn_atm, Cdn_atm_ratio + use ice_flux, only: sst, Tf, Qa, uatmT, vatmT, wind, potT, rhoa, zlvl, & + frzmlt, fhocn, fswthru, flw, flwout_ocn, fsens_ocn, flat_ocn, evap_ocn, & + alvdr_ocn, alidr_ocn, alvdf_ocn, alidf_ocn, swidf, swvdf, swidr, swvdr, & + qdp, hmix, strairx_ocn, strairy_ocn, Tref_ocn, Qref_ocn + use ice_grid, only: tmask + use ice_state, only: aice + + real (kind=dbl_kind), intent(in) :: & + dt ! time step + + integer (kind=int_kind), intent(in) :: & + iblk ! block index + + ! local variables + + real (kind=dbl_kind) :: albocn + + real (kind=dbl_kind), parameter :: & + frzmlt_max = c1000 ! max magnitude of frzmlt (W/m^2) + + integer (kind=int_kind) :: & + i, j , & ! horizontal indices + ij ! combined ij index + + real (kind=dbl_kind), dimension(nx_block,ny_block) :: & + delt , & ! potential temperature difference (K) + delq , & ! specific humidity difference (kg/kg) + shcoef, & ! transfer coefficient for sensible heat + lhcoef ! transfer coefficient for latent heat + + integer (kind=int_kind) :: & + icells ! number of ocean cells + + integer (kind=int_kind), dimension(nx_block*ny_block) :: & + indxi, indxj ! compressed indices for ocean cells + + character(len=*), parameter :: subname = '(ocn_mixed_layer)' + + !----------------------------------------------------------------- + + call icepack_query_parameters(albocn_out=albocn) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + + !----------------------------------------------------------------- + ! Identify ocean cells. + ! Set fluxes to zero in land cells. + !----------------------------------------------------------------- + + icells = 0 + indxi(:) = 0 + indxj(:) = 0 + + do j = 1, ny_block + do i = 1, nx_block + + if (tmask(i,j,iblk)) then + icells = icells + 1 + indxi(icells) = i + indxj(icells) = j + else + sst (i,j,iblk) = c0 + frzmlt (i,j,iblk) = c0 + flwout_ocn(i,j,iblk) = c0 + fsens_ocn (i,j,iblk) = c0 + flat_ocn (i,j,iblk) = c0 + evap_ocn (i,j,iblk) = c0 + endif + enddo ! i + enddo ! j + + !----------------------------------------------------------------- + ! Compute boundary layer quantities + !----------------------------------------------------------------- + + do ij = 1, icells + i = indxi(ij) + j = indxj(ij) + + call icepack_atm_boundary(sfctype = 'ocn', & + Tsf = sst (i,j,iblk), & + potT = potT (i,j,iblk), & + uatm = uatmT (i,j,iblk), & + vatm = vatmT (i,j,iblk), & + wind = wind (i,j,iblk), & + zlvl = zlvl (i,j,iblk), & + Qa = Qa (i,j,iblk), & + rhoa = rhoa (i,j,iblk), & + strx = strairx_ocn(i,j,iblk), & + stry = strairy_ocn(i,j,iblk), & + Tref = Tref_ocn (i,j,iblk), & + Qref = Qref_ocn (i,j,iblk), & + delt = delt (i,j), & + delq = delq (i,j), & + lhcoef = lhcoef (i,j), & + shcoef = shcoef (i,j), & + Cdn_atm = Cdn_atm (i,j,iblk), & + Cdn_atm_ratio_n = Cdn_atm_ratio(i,j,iblk)) + enddo ! ij + + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + + !----------------------------------------------------------------- + ! Ocean albedo + ! For now, assume albedo = albocn in each spectral band. + !----------------------------------------------------------------- + + alvdr_ocn(:,:,iblk) = albocn + alidr_ocn(:,:,iblk) = albocn + alvdf_ocn(:,:,iblk) = albocn + alidf_ocn(:,:,iblk) = albocn + + !----------------------------------------------------------------- + ! Compute ocean fluxes and update SST + !----------------------------------------------------------------- + + do ij = 1, icells + i = indxi(ij) + j = indxj(ij) + + call icepack_ocn_mixed_layer(alvdr_ocn=alvdr_ocn(i,j,iblk), swvdr =swvdr (i,j,iblk), & + alidr_ocn=alidr_ocn(i,j,iblk), swidr =swidr (i,j,iblk), & + alvdf_ocn=alvdf_ocn(i,j,iblk), swvdf =swvdf (i,j,iblk), & + alidf_ocn=alidf_ocn(i,j,iblk), swidf =swidf (i,j,iblk), & + sst =sst (i,j,iblk), flwout_ocn=flwout_ocn(i,j,iblk), & + fsens_ocn=fsens_ocn(i,j,iblk), shcoef=shcoef(i,j), & + flat_ocn =flat_ocn (i,j,iblk), lhcoef=lhcoef(i,j), & + evap_ocn =evap_ocn (i,j,iblk), flw =flw (i,j,iblk), & + delt =delt (i,j), delq =delq (i,j), & + aice =aice (i,j,iblk), fhocn =fhocn (i,j,iblk), & + fswthru =fswthru (i,j,iblk), hmix =hmix (i,j,iblk), & + Tf =Tf (i,j,iblk), qdp =qdp (i,j,iblk), & + frzmlt =frzmlt (i,j,iblk), dt =dt) + enddo ! ij + + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + + end subroutine ocean_mixed_layer + +!======================================================================= + + subroutine biogeochemistry (dt, iblk) + + use ice_arrays_column, only: upNO, upNH, iDi, iki, zfswin, & + zsal_tot, darcy_V, grow_net, & + PP_net, hbri,dhbr_bot, dhbr_top, Zoo,& + fbio_snoice, fbio_atmice, ocean_bio, & + first_ice, fswpenln, bphi, bTiz, ice_bio_net, & + snow_bio_net, fswthrun, Rayleigh_criteria, & + ocean_bio_all, sice_rho, fzsal, fzsal_g, & + bgrid, igrid, icgrid, cgrid + use ice_domain_size, only: nblyr, nilyr, nslyr, n_algae, n_zaero, ncat, & + n_doc, n_dic, n_don, n_fed, n_fep + use ice_flux, only: meltbn, melttn, congeln, snoicen, & + sst, sss, fsnow, meltsn + use ice_flux_bgc, only: hin_old, flux_bio, flux_bio_atm, faero_atm, & + nit, amm, sil, dmsp, dms, algalN, doc, don, dic, fed, fep, zaeros, hum + use ice_state, only: aicen_init, vicen_init, aicen, vicen, vsnon, & + trcrn, vsnon_init, aice0 + use ice_timers, only: timer_bgc, ice_timer_start, ice_timer_stop + + real (kind=dbl_kind), intent(in) :: & + dt ! time step + + integer (kind=int_kind), intent(in) :: & + iblk ! block index + + ! local variables + + integer (kind=int_kind) :: & + i, j , & ! horizontal indices + ilo,ihi,jlo,jhi, & ! beginning and end of physical domain + mm ! tracer index + + type (block) :: & + this_block ! block information for current block + + integer (kind=int_kind) :: & + nbtrcr, ntrcr + + integer (kind=int_kind), dimension(icepack_max_aero) :: & + nlt_zaero + + integer (kind=int_kind), dimension(icepack_max_nbtrcr) :: & + bio_index_o + + logical (kind=log_kind) :: & + skl_bgc, tr_brine, tr_zaero + + character(len=*), parameter :: subname='(biogeochemistry)' + + call icepack_query_tracer_flags(tr_brine_out=tr_brine) + call icepack_query_parameters(skl_bgc_out=skl_bgc) + call icepack_query_tracer_sizes(ntrcr_out=ntrcr, nbtrcr_out=nbtrcr) + call icepack_query_tracer_flags(tr_zaero_out=tr_zaero) + call icepack_query_tracer_indices(nlt_zaero_out=nlt_zaero) + call icepack_query_tracer_indices(bio_index_o_out=bio_index_o) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + + if (tr_brine .or. skl_bgc) then + + call ice_timer_start(timer_bgc,iblk) ! biogeochemistry + + this_block = get_block(blocks_ice(iblk),iblk) + ilo = this_block%ilo + ihi = this_block%ihi + jlo = this_block%jlo + jhi = this_block%jhi + + ! Define ocean concentrations for tracers used in simulation + do j = jlo, jhi + do i = ilo, ihi + + call icepack_load_ocean_bio_array(max_nbtrcr = icepack_max_nbtrcr, & + max_algae = icepack_max_algae, max_don = icepack_max_don, & + max_doc = icepack_max_doc, max_dic = icepack_max_dic, & + max_aero = icepack_max_aero, max_fe = icepack_max_fe, & + nit = nit(i,j, iblk), amm = amm (i,j, iblk), & + sil = sil(i,j, iblk), dmsp = dmsp (i,j, iblk), & + dms = dms(i,j, iblk), algalN = algalN(i,j,:,iblk), & + doc = doc(i,j,:,iblk), don = don (i,j,:,iblk), & + dic = dic(i,j,:,iblk), fed = fed (i,j,:,iblk), & + fep = fep(i,j,:,iblk), zaeros = zaeros(i,j,:,iblk), & + hum = hum(i,j, iblk), & + ocean_bio_all = ocean_bio_all(i,j,:,iblk)) + + do mm = 1,nbtrcr + ocean_bio(i,j,mm,iblk) = ocean_bio_all(i,j,bio_index_o(mm),iblk) + enddo ! mm + if (tr_zaero) then + do mm = 1, n_zaero ! update aerosols + flux_bio_atm(i,j,nlt_zaero(mm),iblk) = faero_atm(i,j,mm,iblk) + enddo ! mm + endif + + call icepack_biogeochemistry(dt=dt, ntrcr=ntrcr, nbtrcr=nbtrcr,& + bgrid=bgrid, igrid=igrid, icgrid=icgrid, cgrid=cgrid, & + nblyr=nblyr, nilyr=nilyr, nslyr=nslyr, n_algae=n_algae, n_zaero=n_zaero, & + ncat=ncat, n_doc=n_doc, n_dic=n_dic, n_don=n_don, n_fed=n_fed, n_fep=n_fep, & + upNO = upNO (i,j, iblk), & + upNH = upNH (i,j, iblk), & + iDi = iDi (i,j,:,:, iblk), & + iki = iki (i,j,:,:, iblk), & + zfswin = zfswin (i,j,:,:, iblk), & + zsal_tot = zsal_tot (i,j, iblk), & + darcy_V = darcy_V (i,j,:, iblk), & + grow_net = grow_net (i,j, iblk), & + PP_net = PP_net (i,j, iblk), & + hbri = hbri (i,j, iblk), & + dhbr_bot = dhbr_bot (i,j,:, iblk), & + dhbr_top = dhbr_top (i,j,:, iblk), & + Zoo = Zoo (i,j,:,:, iblk), & + fbio_snoice = fbio_snoice (i,j,:, iblk), & + fbio_atmice = fbio_atmice (i,j,:, iblk), & + ocean_bio = ocean_bio (i,j,1:nbtrcr, iblk), & + first_ice = first_ice (i,j,:, iblk), & + fswpenln = fswpenln (i,j,:,:, iblk), & + bphi = bphi (i,j,:,:, iblk), & + bTiz = bTiz (i,j,:,:, iblk), & + ice_bio_net = ice_bio_net (i,j,1:nbtrcr, iblk), & + snow_bio_net = snow_bio_net(i,j,1:nbtrcr, iblk), & + fswthrun = fswthrun (i,j,:, iblk), & + sice_rho = sice_rho (i,j,:, iblk), & + fzsal = fzsal (i,j, iblk), & + fzsal_g = fzsal_g (i,j, iblk), & + meltbn = meltbn (i,j,:, iblk), & + melttn = melttn (i,j,:, iblk), & + congeln = congeln (i,j,:, iblk), & + snoicen = snoicen (i,j,:, iblk), & + sst = sst (i,j, iblk), & + sss = sss (i,j, iblk), & + fsnow = fsnow (i,j, iblk), & + meltsn = meltsn (i,j,:, iblk), & + hin_old = hin_old (i,j,:, iblk), & + flux_bio = flux_bio (i,j,1:nbtrcr, iblk), & + flux_bio_atm = flux_bio_atm(i,j,1:nbtrcr, iblk), & + aicen_init = aicen_init (i,j,:, iblk), & + vicen_init = vicen_init (i,j,:, iblk), & + aicen = aicen (i,j,:, iblk), & + vicen = vicen (i,j,:, iblk), & + vsnon = vsnon (i,j,:, iblk), & + aice0 = aice0 (i,j, iblk), & + trcrn = trcrn (i,j,:,:, iblk), & + vsnon_init = vsnon_init (i,j,:, iblk), & + Rayleigh_criteria = Rayleigh_criteria(i,j,iblk), & + skl_bgc = skl_bgc) + + enddo ! i + enddo ! j + + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + + call ice_timer_stop(timer_bgc,iblk) ! biogeochemistry + + endif ! tr_brine .or. skl_bgc + + end subroutine biogeochemistry + +!======================================================================= + + end module ice_step_mod + +!======================================================================= diff --git a/cicecore/drivers/unittest/sumchk/sumchk.F90 b/cicecore/drivers/unittest/sumchk/sumchk.F90 index d9ea72d8c..1a2745aea 100644 --- a/cicecore/drivers/unittest/sumchk/sumchk.F90 +++ b/cicecore/drivers/unittest/sumchk/sumchk.F90 @@ -16,10 +16,10 @@ program sumchk use ice_communicate, only: my_task, master_task, get_num_procs use ice_domain_size, only: nx_global, ny_global use ice_domain_size, only: block_size_x, block_size_y, max_blocks - use ice_domain, only: distrb_info + use ice_domain, only: distrb_info, ns_boundary_type use ice_blocks, only: block, get_block, nx_block, ny_block, nblocks_tot use ice_distribution, only: ice_distributionGetBlockID, ice_distributionGet - use ice_constants, only: field_loc_center, field_loc_Nface + use ice_constants, only: field_loc_center, field_loc_Nface, field_loc_Eface, field_loc_NEcorner use ice_fileunits, only: bfbflag use ice_global_reductions use ice_exit, only: abort_ice, end_run @@ -113,6 +113,13 @@ program sumchk write(6,*) ' block_size_y = ',block_size_y write(6,*) ' nblocks_tot = ',nblocks_tot write(6,*) ' ' + write(6,*) ' Values are generally O(1.), lscale is the relative size of' + write(6,*) ' values set in the array to test precision. A pair of equal' + write(6,*) ' and opposite values of O(lscale) are placed in the array.' + write(6,*) ' "easy" sets the lscaled values at the start of the array so' + write(6,*) ' are added to the sum first. Otherwise, the lscaled values' + write(6,*) ' are set near the end of the array and to create precision' + write(6,*) ' challenges in the global sums' endif ! --------------------------- @@ -165,7 +172,7 @@ program sumchk reldigchk(4,4) = 0. reldigchk(5,4) = 15. if (nx_global == 360 .and. ny_global == 240) then - reldigchk(1:3,1) = 13. + reldigchk(1:3,1) = 12.5 reldigchk(5,4) = 14. endif #else @@ -181,7 +188,7 @@ program sumchk reldigchk(4,4) = 0. reldigchk(5,4) = 15. if (nx_global == 360 .and. ny_global == 240) then - reldigchk(1:2,1) = 13. + reldigchk(1:2,1) = 12.5 reldigchk(5,4) = 14. endif #endif @@ -212,20 +219,22 @@ program sumchk ! set corval to something a little interesting (not 1.0 for instance which gives atypical results) corval = 4.0_dbl_kind/3.0_dbl_kind iocval = 8 - ! tuned for gx3 and tx1 only - if ((nx_global == 100 .and. ny_global == 116) .or. & - (nx_global == 360 .and. ny_global == 240)) then - if (field_loc(m) == field_loc_Nface .and. nx_global == 360 .and. ny_global == 240) then - ! tx1 tripole face, need to adjust local value to remove half of row at ny_global - ! or modify corval to account for different sum - locval = corval / real((nblocks_tot*(block_size_x*block_size_y-2)-nx_global/2),dbl_kind) - corvali = (nblocks_tot*(block_size_x*block_size_y-2)-nx_global/2)*iocval - else - locval = corval / real(nblocks_tot*(block_size_x*block_size_y-2),dbl_kind) - corvali = nblocks_tot*(block_size_x*block_size_y-2)*iocval - endif + if ((ns_boundary_type == 'tripoleT' .and. field_loc(m) == field_loc_Nface ) .or. & + (ns_boundary_type == 'tripoleT' .and. field_loc(m) == field_loc_NEcorner)) then + ! remove full row at ny_global + locval = corval / real((nblocks_tot*(block_size_x*block_size_y-2)-nx_global),dbl_kind) + corvali = (nblocks_tot*(block_size_x*block_size_y-2)-nx_global)*iocval + elseif ((ns_boundary_type == 'tripoleT' .and. field_loc(m) == field_loc_center ) .or. & + (ns_boundary_type == 'tripoleT' .and. field_loc(m) == field_loc_Eface ) .or. & + (ns_boundary_type == 'tripole' .and. field_loc(m) == field_loc_NEcorner) .or. & + (ns_boundary_type == 'tripole' .and. field_loc(m) == field_loc_Nface )) then + ! remove half of row at ny_global + locval = corval / real((nblocks_tot*(block_size_x*block_size_y-2)-nx_global/2),dbl_kind) + corvali = (nblocks_tot*(block_size_x*block_size_y-2)-nx_global/2)*iocval else - call abort_ice(subname//' ERROR not set for this grid ') + ! all gridcells + locval = corval / real(nblocks_tot*(block_size_x*block_size_y-2),dbl_kind) + corvali = nblocks_tot*(block_size_x*block_size_y-2)*iocval endif do l = 1, nscale @@ -253,18 +262,18 @@ program sumchk jb = this_block%jlo je = this_block%jhi - lmask(ie,je-1,iblock) = .false. - lmask(ie,je-2,iblock) = .false. - arrayA(ie,je-1,iblock) = locval * lscale(l) + lmask(ie,je-1,iblock) = .false. + lmask(ie,je-2,iblock) = .false. + arrayA(ie,je-1,iblock) = locval * lscale(l) arrayA(ie,je-2,iblock) = -arrayA(ie,je-1,iblock) - arrayB(ie,je-1,iblock) = locval * lscale(l) + arrayB(ie,je-1,iblock) = locval * lscale(l) arrayB(ie,je-2,iblock) = arrayB(ie,je-1,iblock) arrayC(ib,jb,iblock) = locval * lscale(l) arrayC(ib+1,jb,iblock) = -arrayC(ib,jb,iblock) - arrayiA(:,:,iblock) = iocval - arrayiB(:,:,iblock) = iocval - arrayiA(ie,je-1,iblock) = 13 * iocval - arrayiA(ie,je-2,iblock) = -arrayiA(ie,je-1,iblock) + arrayiA(:,:,iblock) = iocval + arrayiB(:,:,iblock) = iocval + arrayiA(ie,je-1,iblock)= 13 * iocval + arrayiA(ie,je-2,iblock)= -arrayiA(ie,je-1,iblock) enddo do k = 1,ntests1 diff --git a/cicecore/shared/ice_fileunits.F90 b/cicecore/shared/ice_fileunits.F90 index 72a40f513..d4823d175 100644 --- a/cicecore/shared/ice_fileunits.F90 +++ b/cicecore/shared/ice_fileunits.F90 @@ -328,32 +328,32 @@ end subroutine flush_fileunit subroutine goto_nml(iunit, nml, status) ! Search to namelist group within ice_in file. ! for compilers that do not allow optional namelists - + ! passed variables integer(kind=int_kind), intent(in) :: & iunit ! namelist file unit - + character(len=*), intent(in) :: & nml ! namelist to search for - + integer(kind=int_kind), intent(out) :: & status ! status of subrouine - + ! local variables character(len=char_len) :: & file_str, & ! string in file nml_str ! namelist string to test - + integer(kind=int_kind) :: & i, n ! dummy integers - - + + ! rewind file rewind(iunit) - + ! define test string with ampersand nml_str = '&' // trim(adjustl(nml)) - + ! search for the record containing the namelist group we're looking for do read(iunit, '(a)', iostat=status) file_str @@ -365,10 +365,10 @@ subroutine goto_nml(iunit, nml, status) end if end if end do - + ! backspace to namelist name in file backspace(iunit) - + end subroutine goto_nml !======================================================================= diff --git a/configuration/scripts/Makefile b/configuration/scripts/Makefile index 872f426ad..d109472b0 100644 --- a/configuration/scripts/Makefile +++ b/configuration/scripts/Makefile @@ -74,7 +74,7 @@ AR := ar .SUFFIXES: -.PHONY: all cice libcice targets target db_files db_flags clean realclean helloworld calchk sumchk bcstchk gridavgchk halochk optargs +.PHONY: all cice libcice targets target db_files db_flags clean realclean helloworld calchk sumchk bcstchk gridavgchk halochk optargs opticep all: $(EXEC) cice: $(EXEC) @@ -93,7 +93,7 @@ targets: @echo " " @echo "Supported Makefile Targets are: cice, libcice, makdep, depends, clean, realclean" @echo " Diagnostics: targets, db_files, db_flags" - @echo " Unit Tests : helloworld, calchk, sumchk, bcstchk, gridavgchk, halochk, optargs" + @echo " Unit Tests : helloworld, calchk, sumchk, bcstchk, gridavgchk, halochk, optargs, opticep" target: targets db_files: @@ -153,6 +153,8 @@ gridavgchk: $(EXEC) halochk: $(EXEC) +opticep: $(EXEC) + # this builds just a subset of source code specified explicitly and requires a separate target HWOBJS := helloworld.o diff --git a/configuration/scripts/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 new file mode 100644 index 000000000..df0d2320e --- /dev/null +++ b/configuration/scripts/machines/Macros.derecho_intel @@ -0,0 +1,69 @@ +#============================================================================== +# Makefile macros for NCAR cheyenne, intel compiler +#============================================================================== + +CPP := fpp +CPPDEFS := -DFORTRANUNDERSCORE ${ICE_CPPDEFS} +CFLAGS := -c -O2 -fp-model precise -march=core-avx2 + +FIXEDFLAGS := -fixed -132 +FREEFLAGS := -free +FFLAGS := -fp-model precise -convert big_endian -assume byterecl -ftz -traceback -march=core-avx2 +FFLAGS_NOOPT:= -O0 + +ifeq ($(ICE_BLDDEBUG), true) + FFLAGS += -O0 -g -check uninit -check bounds -check pointers -fpe0 -check noarg_temp_created -link_mpi=dbg +# FFLAGS += -O0 -g -check all -fpe0 -ftrapuv -fp-model except -check noarg_temp_created -link_mpi=dbg -stand f08 +# FFLAGS += -O0 -g -check all -fpe0 -ftrapuv -fp-model except -check noarg_temp_created -init=snan,arrays -link_mpi=dbg +else + FFLAGS += -O2 +endif + +SCC := icx +SFC := ifort +MPICC := mpicc +MPIFC := mpif90 + +ifeq ($(ICE_COMMDIR), mpi) + FC := $(MPIFC) + CC := $(MPICC) +else + FC := $(SFC) + CC := $(SCC) +endif +LD:= $(FC) + +NETCDF_PATH := $(NETCDF) + +#PIO_CONFIG_OPTS:= --enable-filesystem-hints=gpfs + +PNETCDF_PATH := $(PNETCDF) +#PNETCDF_PATH := /glade/u/apps/ch/opt/pio/2.2/mpt/2.15f/intel/17.0.1/lib + +INCLDIR := $(INCLDIR) + +LIB_NETCDF := $(NETCDF)/lib +#LIB_PNETCDF := $(PNETCDF_PATH)/lib +#LIB_MPI := $(IMPILIBDIR) + +#SLIBS := -L$(LIB_NETCDF) -lnetcdf -lnetcdff -L$(LIB_PNETCDF) -lpnetcdf -lgptl +SLIBS := -L$(LIB_NETCDF) -lnetcdf -lnetcdff + +ifeq ($(ICE_THREADED), true) + LDFLAGS += -qopenmp + CFLAGS += -qopenmp + FFLAGS += -qopenmp +endif + +#ifeq ($(ICE_IOTYPE), pio1) +# LIB_PIO := $(PIO_LIBDIR) +# SLIBS := $(SLIBS) -L$(LIB_PIO) -lpio +#endif + +ifeq ($(ICE_IOTYPE), pio2) +# CPPDEFS := $(CPPDEFS) -DGPTL +# LIB_PIO := $(PIO_LIBDIR) +# SLIBS := $(SLIBS) -L$(LIB_PIO) -lpiof -lpioc -lgptl + SLIBS := $(SLIBS) -lpiof -lpioc +endif + diff --git a/configuration/scripts/machines/Macros.onyx_intel b/configuration/scripts/machines/Macros.onyx_intel index 92879ee82..17cec8c74 100644 --- a/configuration/scripts/machines/Macros.onyx_intel +++ b/configuration/scripts/machines/Macros.onyx_intel @@ -4,11 +4,11 @@ CPP := fpp CPPDEFS := -DFORTRANUNDERSCORE ${ICE_CPPDEFS} -CFLAGS := -c -O2 -fp-model precise -xHost +CFLAGS := -c -O2 -fp-model precise FIXEDFLAGS := -132 FREEFLAGS := -FR -FFLAGS := -fp-model precise -convert big_endian -assume byterecl -ftz -traceback -xHost +FFLAGS := -fp-model precise -convert big_endian -assume byterecl -ftz -traceback FFLAGS_NOOPT:= -O0 ifeq ($(ICE_BLDDEBUG), true) diff --git a/configuration/scripts/machines/env.derecho_intel b/configuration/scripts/machines/env.derecho_intel new file mode 100644 index 000000000..baa053e75 --- /dev/null +++ b/configuration/scripts/machines/env.derecho_intel @@ -0,0 +1,70 @@ +#!/bin/csh -f + +set inp = "undefined" +if ($#argv == 1) then + set inp = $1 +endif + +if ("$inp" != "-nomodules") then + +source ${MODULESHOME}/init/csh + +module --force purge +module load ncarenv/23.06 +module load craype +module load intel/2023.0.0 +module load ncarcompilers +module load cray-mpich/8.1.25 +#module load hdf5/1.12.2 +module load netcdf-mpi/4.9.2 +module load cray-libsci/23.02.1.1 + +if ($?ICE_IOTYPE) then +if ($ICE_IOTYPE =~ pio*) then + module load parallel-netcdf/1.12.3 + if ($ICE_IOTYPE == "pio1") then + module load parallelio/1.10.1 + else + module load parallelio/2.6.0 + endif +endif +endif + +if ($?ICE_BFBTYPE) then +if ($ICE_BFBTYPE =~ qcchk*) then + module load conda +# conda env create -f ../../configuration/scripts/tests/qctest.yml + conda activate qctest +endif +endif + +# For perftools with mpiexec +# module load perftools-base +# module load perftools +#setenv PALS_TRANSFER FALSE + +endif + +limit coredumpsize unlimited +limit stacksize unlimited +setenv PALS_QUIET TRUE + +# May be needed for OpenMP memory +setenv OMP_STACKSIZE 64M +# OMP runtime diagnostics +#setenv OMP_DISPLAY_ENV TRUE + +setenv ICE_MACHINE_MACHNAME derecho +setenv ICE_MACHINE_MACHINFO "HPE Cray EX Milan Slingshot 11" +setenv ICE_MACHINE_ENVNAME intel +setenv ICE_MACHINE_ENVINFO "ifort 2021.8.0 20221119, cray-mpich 2.25, netcdf-mpi4.9.2, pnetcdf1.12.3, pio2.6.0" +setenv ICE_MACHINE_MAKE gmake +setenv ICE_MACHINE_WKDIR /glade/derecho/scratch/$user/CICE_RUNS +setenv ICE_MACHINE_INPUTDATA /glade/p/cesm/pcwg_dev +setenv ICE_MACHINE_BASELINE /glade/derecho/scratch/$user/CICE_BASELINE +setenv ICE_MACHINE_SUBMIT "qsub" +setenv ICE_MACHINE_ACCT P00000000 +setenv ICE_MACHINE_QUEUE "main" +setenv ICE_MACHINE_TPNODE 128 +setenv ICE_MACHINE_BLDTHRDS 8 +setenv ICE_MACHINE_QSTAT "qstat " diff --git a/configuration/scripts/machines/env.nrlssc_gnu b/configuration/scripts/machines/env.nrlssc_gnu index 1f8dd4441..94025ddf9 100644 --- a/configuration/scripts/machines/env.nrlssc_gnu +++ b/configuration/scripts/machines/env.nrlssc_gnu @@ -5,12 +5,12 @@ setenv ICE_MACHINE_MACHINFO "nrlssc" setenv ICE_MACHINE_ENVNAME gnu setenv ICE_MACHINE_ENVINFO "gnu" setenv ICE_MACHINE_MAKE gmake -setenv ICE_MACHINE_WKDIR /u/data/hebert/CICE_RUNS -setenv ICE_MACHINE_INPUTDATA /u/data/hebert/CICE_RUNS -setenv ICE_MACHINE_BASELINE /u/data/hebert/CICE_BASELINE +setenv ICE_MACHINE_WKDIR /u/hebert/data/CICE_RUNS +setenv ICE_MACHINE_INPUTDATA /u/hebert/data/ +setenv ICE_MACHINE_BASELINE /u/hebert/data/CICE_BASELINE setenv ICE_MACHINE_SUBMIT "qsub " setenv ICE_MACHINE_ACCT P00000000 setenv ICE_MACHINE_QUEUE "standard" -setenv ICE_MACHINE_TPNODE 20 # tasks per node -setenv ICE_MACHINE_BLDTHRDS 1 +setenv ICE_MACHINE_TPNODE 28 # tasks per node +setenv ICE_MACHINE_BLDTHRDS 8 setenv ICE_MACHINE_QSTAT "qstat " diff --git a/configuration/scripts/machines/env.onyx_cray b/configuration/scripts/machines/env.onyx_cray index e696d1b98..e879cdf03 100644 --- a/configuration/scripts/machines/env.onyx_cray +++ b/configuration/scripts/machines/env.onyx_cray @@ -13,14 +13,14 @@ module unload PrgEnv-cray module unload PrgEnv-gnu module unload PrgEnv-intel module unload PrgEnv-pgi -module load PrgEnv-cray/6.0.9 +module load PrgEnv-cray/6.0.10 module unload cce -module load cce/11.0.2 +module load cce/14.0.3 module unload cray-mpich module unload cray-mpich2 -module load cray-mpich/7.7.16 +module load cray-mpich/7.7.20 module unload netcdf module unload cray-netcdf @@ -28,8 +28,8 @@ module unload cray-hdf5 module unload cray-hdf5-parallel module unload cray-netcdf-hdf5parallel module unload cray-parallel-netcdf -module load cray-netcdf/4.7.4.0 -module load cray-hdf5/1.12.0.0 +module load cray-netcdf/4.8.1.3 +module load cray-hdf5/1.12.1.3 module unload cray-libsci module unload craype-hugepages2M @@ -46,7 +46,7 @@ endif setenv ICE_MACHINE_MACHNAME onyx setenv ICE_MACHINE_MACHINFO "Cray XC40/50 Xeon E5-2699v4 Broadwell" setenv ICE_MACHINE_ENVNAME cray -setenv ICE_MACHINE_ENVINFO "Cray cce/11.0.2, cray-mpich/7.7.16, netcdf/4.7.4.0" +setenv ICE_MACHINE_ENVINFO "Cray cce/14.0.3, cray-mpich/7.7.20, netcdf/4.8.1.3" setenv ICE_MACHINE_MAKE gmake setenv ICE_MACHINE_WKDIR $WORKDIR/CICE_RUNS setenv ICE_MACHINE_INPUTDATA /p/app/unsupported/RASM/cice_consortium diff --git a/configuration/scripts/machines/env.onyx_gnu b/configuration/scripts/machines/env.onyx_gnu index 80ebb8e43..19a4eb701 100644 --- a/configuration/scripts/machines/env.onyx_gnu +++ b/configuration/scripts/machines/env.onyx_gnu @@ -13,14 +13,14 @@ module unload PrgEnv-cray module unload PrgEnv-gnu module unload PrgEnv-intel module unload PrgEnv-pgi -module load PrgEnv-gnu/6.0.9 +module load PrgEnv-gnu/6.0.10 module unload gcc -module load gcc/10.2.0 +module load gcc/12.1.0 module unload cray-mpich module unload cray-mpich2 -module load cray-mpich/7.7.16 +module load cray-mpich/7.7.20 module unload netcdf module unload cray-netcdf @@ -28,8 +28,8 @@ module unload cray-hdf5 module unload cray-hdf5-parallel module unload cray-netcdf-hdf5parallel module unload cray-parallel-netcdf -module load cray-netcdf/4.7.4.0 -module load cray-hdf5/1.12.0.0 +module load cray-netcdf/4.8.1.3 +module load cray-hdf5/1.12.1.3 module unload cray-libsci module unload craype-hugepages2M @@ -46,7 +46,7 @@ endif setenv ICE_MACHINE_MACHNAME onyx setenv ICE_MACHINE_MACHINFO "Cray XC40/50 Xeon E5-2699v4 Broadwell" setenv ICE_MACHINE_ENVNAME gnu -setenv ICE_MACHINE_ENVINFO "GNU Fortran (GCC) 10.2.0, cray-mpich/7.7.16, netcdf/4.7.4.0" +setenv ICE_MACHINE_ENVINFO "GNU Fortran (GCC) 12.1.0, cray-mpich/7.7.20, netcdf/4.8.1.3" setenv ICE_MACHINE_MAKE gmake setenv ICE_MACHINE_WKDIR $WORKDIR/CICE_RUNS setenv ICE_MACHINE_INPUTDATA /p/app/unsupported/RASM/cice_consortium diff --git a/configuration/scripts/machines/env.onyx_intel b/configuration/scripts/machines/env.onyx_intel index 362454dd4..999d5a2bd 100644 --- a/configuration/scripts/machines/env.onyx_intel +++ b/configuration/scripts/machines/env.onyx_intel @@ -13,14 +13,14 @@ module unload PrgEnv-cray module unload PrgEnv-gnu module unload PrgEnv-intel module unload PrgEnv-pgi -module load PrgEnv-intel/6.0.9 +module load PrgEnv-intel/6.0.10 module unload intel -module load intel/19.1.3.304 +module load intel/2021.4.0 module unload cray-mpich module unload cray-mpich2 -module load cray-mpich/7.7.16 +module load cray-mpich/7.7.20 module unload netcdf module unload cray-netcdf @@ -28,8 +28,8 @@ module unload cray-hdf5 module unload cray-hdf5-parallel module unload cray-netcdf-hdf5parallel module unload cray-parallel-netcdf -module load cray-netcdf/4.7.4.0 -module load cray-hdf5/1.12.0.0 +module load cray-netcdf/4.8.1.3 +module load cray-hdf5/1.12.1.3 module unload cray-libsci module unload craype-hugepages2M @@ -46,7 +46,7 @@ endif setenv ICE_MACHINE_MACHNAME onyx setenv ICE_MACHINE_MACHINFO "Cray XC40/50 Xeon E5-2699v4 Broadwell" setenv ICE_MACHINE_ENVNAME intel -setenv ICE_MACHINE_ENVINFO "ifort 19.1.3.304, cray-mpich/7.7.16, netcdf/4.7.4.0" +setenv ICE_MACHINE_ENVINFO "ifort 2021.4.0, cray-mpich/7.7.20, netcdf/4.8.1.3" setenv ICE_MACHINE_MAKE gmake setenv ICE_MACHINE_WKDIR $WORKDIR/CICE_RUNS setenv ICE_MACHINE_INPUTDATA /p/app/unsupported/RASM/cice_consortium diff --git a/configuration/scripts/options/set_env.opticep b/configuration/scripts/options/set_env.opticep new file mode 100644 index 000000000..81339ea42 --- /dev/null +++ b/configuration/scripts/options/set_env.opticep @@ -0,0 +1,2 @@ +setenv ICE_DRVOPT unittest/opticep +setenv ICE_TARGET opticep diff --git a/configuration/scripts/options/set_nml.gx1 b/configuration/scripts/options/set_nml.gx1 index 50615e81e..781da3389 100644 --- a/configuration/scripts/options/set_nml.gx1 +++ b/configuration/scripts/options/set_nml.gx1 @@ -14,8 +14,8 @@ maskhalo_remap = .true. maskhalo_bound = .true. fyear_init = 2005 atm_data_format = 'nc' -atm_data_type = 'JRA55_gx1' -atm_data_dir = 'ICE_MACHINE_INPUTDATA/CICE_data/forcing/gx1/JRA55' +atm_data_type = 'JRA55' +atm_data_dir = 'ICE_MACHINE_INPUTDATA/CICE_data/forcing/gx1' precip_units = 'mks' ocn_data_dir = 'ICE_MACHINE_INPUTDATA/CICE_data/forcing/gx1/CESM/MONTHLY' bgc_data_dir = 'ICE_MACHINE_INPUTDATA/CICE_data/forcing/gx1/WOA/MONTHLY' diff --git a/configuration/scripts/options/set_nml.gx3 b/configuration/scripts/options/set_nml.gx3 index 1a2fe62a5..3492509c6 100644 --- a/configuration/scripts/options/set_nml.gx3 +++ b/configuration/scripts/options/set_nml.gx3 @@ -11,8 +11,8 @@ kmt_file = 'ICE_MACHINE_INPUTDATA/CICE_data/grid/gx3/kmt_gx3.bin' bathymetry_file = 'ICE_MACHINE_INPUTDATA/CICE_data/grid/gx3/global_gx3.bathy.nc' fyear_init = 2005 atm_data_format = 'nc' -atm_data_type = 'JRA55_gx3' -atm_data_dir = 'ICE_MACHINE_INPUTDATA/CICE_data/forcing/gx3/JRA55' +atm_data_type = 'JRA55' +atm_data_dir = 'ICE_MACHINE_INPUTDATA/CICE_data/forcing/gx3' precip_units = 'mks' ocn_data_format = 'bin' ocn_data_dir = 'ICE_MACHINE_INPUTDATA/CICE_data/forcing/gx3/' diff --git a/configuration/scripts/options/set_nml.gx3ncarbulk b/configuration/scripts/options/set_nml.gx3ncarbulk index fbe0f7ae7..044c77a54 100644 --- a/configuration/scripts/options/set_nml.gx3ncarbulk +++ b/configuration/scripts/options/set_nml.gx3ncarbulk @@ -4,6 +4,6 @@ use_restart_time = .true. fyear_init = 1997 atm_data_format = 'bin' atm_data_type = 'ncar' -atm_data_dir = 'ICE_MACHINE_INPUTDATA/CICE_data/forcing/gx3/NCAR_bulk' +atm_data_dir = 'ICE_MACHINE_INPUTDATA/CICE_data/forcing/gx3' precip_units = 'mm_per_month' diff --git a/configuration/scripts/options/set_nml.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 new file mode 100644 index 000000000..465152498 --- /dev/null +++ b/configuration/scripts/options/set_nml.jra55 @@ -0,0 +1,2 @@ +atm_data_format = 'nc' +atm_data_type = 'JRA55' diff --git a/configuration/scripts/options/set_nml.jra55do b/configuration/scripts/options/set_nml.jra55do new file mode 100644 index 000000000..5ca4cb397 --- /dev/null +++ b/configuration/scripts/options/set_nml.jra55do @@ -0,0 +1,2 @@ +atm_data_format = 'nc' +atm_data_type = 'JRA55do' diff --git a/configuration/scripts/options/set_nml.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 5e66db871..c21231a0f 100644 --- a/configuration/scripts/options/set_nml.tx1 +++ b/configuration/scripts/options/set_nml.tx1 @@ -6,8 +6,8 @@ grid_type = 'tripole' ns_boundary_type = 'tripole' grid_file = 'ICE_MACHINE_INPUTDATA/CICE_data/grid/tx1/grid_tx1.bin' kmt_file = 'ICE_MACHINE_INPUTDATA/CICE_data/grid/tx1/kmt_tx1.bin' -atm_data_dir = 'ICE_MACHINE_INPUTDATA/CICE_data/forcing/tx1/JRA55' +atm_data_dir = 'ICE_MACHINE_INPUTDATA/CICE_data/forcing/tx1' atm_data_format = 'nc' -atm_data_type = 'JRA55_tx1' +atm_data_type = 'JRA55' year_init = 2005 fyear_init = 2005 diff --git a/configuration/scripts/tests/base_suite.ts b/configuration/scripts/tests/base_suite.ts index 8685ab9a8..906aae08d 100644 --- a/configuration/scripts/tests/base_suite.ts +++ b/configuration/scripts/tests/base_suite.ts @@ -12,6 +12,7 @@ smoke gx3 4x1 diag1,run5day,thread smoke_gx3_8x2_diag1_ smoke gx3 1x8 diag1,run5day,evp1d restart gx1 40x4 droundrobin,medium restart tx1 40x4 dsectrobin,medium +restart tx1 40x4 dsectrobin,medium,jra55do restart gx3 4x4 none restart gx3 10x4 maskhalo restart gx3 6x2 alt01 @@ -46,12 +47,14 @@ smoke gbox80 1x1 boxslotcyl smoke gbox12 1x1x12x12x1 boxchan,diag1,debug restart gx3 8x2 modal smoke gx3 8x2 bgcz +smoke gx3 8x2 jra55do smoke gx3 8x2 bgczm,debug smoke gx3 8x1 bgcskl,debug #smoke gx3 4x1 bgcz,thread smoke_gx3_8x2_bgcz restart gx1 4x2 bgcsklclim,medium restart gx1 8x1 bgczclim,medium smoke gx1 24x1 medium,run90day,yi2008 +smoke gx1 24x1 medium,run90day,yi2008,jra55do smoke gx3 8x1 medium,run90day,yi2008 restart gx1 24x1 short restart gx1 16x2 seabedLKD,gx1apr,short,debug diff --git a/configuration/scripts/tests/baseline.script b/configuration/scripts/tests/baseline.script index 2700fe71f..a24236c9e 100644 --- a/configuration/scripts/tests/baseline.script +++ b/configuration/scripts/tests/baseline.script @@ -33,8 +33,13 @@ if (${ICE_BASECOM} != ${ICE_SPVAL}) then echo "base_file: ${base_file}" echo "test_file: ${test_file}" - ${ICE_CASEDIR}/casescripts/comparelog.csh ${base_file} ${test_file} notcicefile - set bfbstatus = $status + if (${ICE_TARGET} == "opticep") then + ${ICE_CASEDIR}/casescripts/comparelog.csh ${base_file} ${test_file} modcicefile + set bfbstatus = $status + else + ${ICE_CASEDIR}/casescripts/comparelog.csh ${base_file} ${test_file} notcicefile + set bfbstatus = $status + endif else if (${ICE_BFBTYPE} =~ qcchk*) then set test_dir = ${ICE_RUNDIR} @@ -160,8 +165,13 @@ if (${ICE_BFBCOMP} != ${ICE_SPVAL}) then echo "base_file: ${base_file}" echo "test_file: ${test_file}" - ${ICE_CASEDIR}/casescripts/comparelog.csh ${base_file} ${test_file} - set bfbstatus = $status + if (${ICE_TARGET} == "opticep") then + ${ICE_CASEDIR}/casescripts/comparelog.csh ${base_file} ${test_file} modcicefile + set bfbstatus = $status + else + ${ICE_CASEDIR}/casescripts/comparelog.csh ${base_file} ${test_file} + set bfbstatus = $status + endif else if (${ICE_BFBTYPE} == "logrest") then set test_file = `ls -1t ${ICE_RUNDIR}/cice.runlog* | head -1` @@ -172,8 +182,13 @@ if (${ICE_BFBCOMP} != ${ICE_SPVAL}) then echo "base_file: ${base_file}" echo "test_file: ${test_file}" - ${ICE_CASEDIR}/casescripts/comparelog.csh ${base_file} ${test_file} - set bfbstatusl = $status + if (${ICE_TARGET} == "opticep") then + ${ICE_CASEDIR}/casescripts/comparelog.csh ${base_file} ${test_file} modcicefile + set bfbstatus = $status + else + ${ICE_CASEDIR}/casescripts/comparelog.csh ${base_file} ${test_file} + set bfbstatusl = $status + endif set test_dir = ${ICE_RUNDIR}/restart set base_dir = ${ICE_RUNDIR}/../${ICE_BFBCOMP}.${ICE_TESTID}/restart diff --git a/configuration/scripts/tests/comparelog.csh b/configuration/scripts/tests/comparelog.csh index 576289cd7..6659906b8 100755 --- a/configuration/scripts/tests/comparelog.csh +++ b/configuration/scripts/tests/comparelog.csh @@ -16,6 +16,7 @@ set filearg = 0 set cicefile = 0 set notcicefile = "notcicefile" +set modcicefile = "modcicefile" if ( $#argv == 2 ) then set cicefile = 1 set filearg = 1 @@ -23,12 +24,18 @@ if ( $#argv == 2 ) then set test_data = $argv[2] if ("$argv[1]" == "${notcicefile}") set filearg = 0 if ("$argv[2]" == "${notcicefile}") set filearg = 0 + if ("$argv[1]" == "${modcicefile}") set filearg = 0 + if ("$argv[2]" == "${modcicefile}") set filearg = 0 else if ( $#argv == 3 ) then set cicefile = 0 set filearg = 1 set base_data = $argv[1] set test_data = $argv[2] - if ("$argv[3]" != "${notcicefile}") set filearg = 0 + if ("$argv[3]" == "${modcicefile}") then + set cicefile = 2 + else if ("$argv[3]" != "${notcicefile}") then + set filearg = 0 + endif endif if (${filearg} == 0) then @@ -57,6 +64,9 @@ if (${filearg} == 1) then if (${cicefile} == 1) then cat ${base_data} | grep -A 99999999 "total ice area (km^2)" | grep -e istep1: -e = | grep -iv "min, max, sum" | grep -iv "init_vert" | grep -iv "ridge_ice" >&! ${base_out} cat ${test_data} | grep -A 99999999 "total ice area (km^2)" | grep -e istep1: -e = | grep -iv "min, max, sum" | grep -iv "init_vert" | grep -iv "ridge_ice" >&! ${test_out} + else if (${cicefile} == 2) then + cat ${base_data} | grep -A 99999999 "total ice area (km^2)" | grep -e "total " -e "arwt " -e "max " -e "kinetic" >&! ${base_out} + cat ${test_data} | grep -A 99999999 "total ice area (km^2)" | grep -e "total " -e "arwt " -e "max " -e "kinetic" >&! ${test_out} else sed -n '/RunningUnitTest/,$p' ${base_data} >! ${base_out} sed -n '/RunningUnitTest/,$p' ${test_data} >! ${test_out} diff --git a/configuration/scripts/tests/unittest_suite.ts b/configuration/scripts/tests/unittest_suite.ts index 7486e87aa..840fc822e 100644 --- a/configuration/scripts/tests/unittest_suite.ts +++ b/configuration/scripts/tests/unittest_suite.ts @@ -1,10 +1,12 @@ # Test Grid PEs Sets BFB-compare +smoke gx3 8x2 diag1,run5day +smoke gx3 4x2x25x29x4 debug,run2day,dslenderX2 unittest gx3 1x1 helloworld -unittest gx3 1x1 optargs unittest gx3 1x1 calchk,short unittest gx3 4x1x25x29x4 sumchk unittest gx3 1x1x25x29x16 sumchk unittest tx1 8x1 sumchk +unittest tx1 8x1 sumchk,tripolet unittest gx3 4x1 bcstchk unittest gx3 1x1 bcstchk unittest gx3 8x2 gridavgchk,dwblockall @@ -27,3 +29,7 @@ unittest tx1 4x2 halochk,dwblockall unittest tx1 4x2 halochk,dwblockall,tripolet unittest tx1 4x2x65x45x10 halochk,dwblockall unittest tx1 4x2x57x43x12 halochk,dwblockall,tripolet +unittest gx3 1x1 optargs +unittest gx3 1x1 opticep +unittest gx3 4x2x25x29x4 debug,run2day,dslenderX2,opticep,cmplog smoke_gx3_4x2x25x29x4_debug_dslenderX2_run2day +unittest gx3 8x2 diag1,run5day,opticep,cmplog smoke_gx3_8x2_diag1_run5day diff --git a/doc/source/cice_index.rst b/doc/source/cice_index.rst index 000004bb9..36c772eff 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 0b90a9b2e..8cf293843 100644 --- a/doc/source/developer_guide/dg_forcing.rst +++ b/doc/source/developer_guide/dg_forcing.rst @@ -21,12 +21,12 @@ primitive, in part due to historical reasons and in part because standalone runs are discouraged for evaluating complex science. In general, most implementations use aspects of the following approach, -- Input files are organized by year. +- Input files are organized by year. The underlying implementation provides for some flexibility and extensibility in filenames. For instance, JRA55 and JRA55do filenames can have syntax like ``[JRA55,JRA55do][_$grid,'']_03hr_forcing[_$grid,'']_$year.nc`` where $grid is optional or may be present at one of two locations within the filename. This implementation exists to support the current naming conventions within the gx1, gx3, and tx1 JRA55 and JRA55do CICE_DATA directory structure automatically. See **JRA55_files** in **ice_forcing.F90** for more details. - Namelist inputs ``fyear`` and ``ycycle`` specify the forcing year dataset. - The forcing year is computed on the fly and is assumed to be cyclical over the forcing dataset length defined by ``ycycle``. -- The namelist ``atm_dat_dir`` specifies the directory of the atmosphere input data files and the namelist ``atm_data_type`` defines the atmospheric forcing mode. -- The namelist ``ocn_dat_dir`` specifies the directory of the ocean input data files and the namelist ``ocn_data_type`` defines the ocean forcing mode. -- The filenames follow a particular naming convention that is defined in the source code (ie. subroutine **JRA55_gx1_files**). The forcing year is typically found just before the **.nc** part of the filename and there are tools (subroutine **file_year**) to update the filename based on the model year and appropriate forcing year. +- The namelist ``atm_data_dir`` specifies the path or partial path for the atmosphere input data files and the namelist ``atm_data_type`` defines the atmospheric forcing mode. ``atm_data_type`` values of ``JRA55``, ``JRA55do``, or ``ncar`` provide some flexibility for directory paths and filenames. Many details can be gleaned from the CICE_data directory structure and file names as well as from the implementation in **ice_forcing.F90**. But the main point is that atm_data_dir should be set to ${CICE_DATA_root}/forcing/$grid/[JRA55,JRA55do,NCAR_bulk,''] where [JRA55,JRA55do,NCAR_bulk] are optional but provided for backwards compatibility. grid is typically gx1, gx3, tx1, or similar. +- The namelist ``ocn_data_dir`` specifies the directory of the ocean input data files and the namelist ``ocn_data_type`` defines the ocean forcing mode. +- The filenames follow a particular naming convention that is defined in the source code (ie. subroutine **JRA55_files**). The forcing year is typically found just before the **.nc** part of the filename and there are tools (subroutine **file_year**) to update the filename based on the model year and appropriate forcing year. - The input data time axis is generally NOT read by the forcing subroutine. The forcing frequency is hardwired into the model and the file record number is computed based on the forcing frequency and model time. Mixing leap year input data and noleap model calendars (and vice versa) is not handled particularly gracefully. The CICE model does not read or check against the input data time axis. - Data is read on the model grid, no spatial interpolation exists. - Data is often time interpolated linearly between two input timestamps to the model time each model timestep. @@ -79,8 +79,8 @@ input data fields to model forcing fields. .. _JRA55forcing: -JRA55 Atmosphere Forcing -------------------------- +JRA55 and JRA55do Atmosphere Forcing +------------------------------------ The current default atmosphere forcing for gx3, gx1, and tx1 standalone grids for Consortium testing is the JRA55 forcing @@ -136,6 +136,11 @@ March 1, and all data after March 1 will be shifted one day. December 31 in leap years will be skipped when running with a CICE calendar with no leap days. +JRA55do forcing is also provided by the Consortium in the same format and scheme. The JRA55do +dataset is more focused on forcing for ocean and ice models, but provides a very similar climate +as the JRA55 forcing. To switch to JRA55do, set the namelist ``atm_data_type`` to ``JRA55do`` +and populate the input data directory with the JRA55do dataset provided by the Consortium. + .. _NCARforcing: diff --git a/doc/source/developer_guide/dg_other.rst b/doc/source/developer_guide/dg_other.rst index 308c2629c..a8f6e8b15 100644 --- a/doc/source/developer_guide/dg_other.rst +++ b/doc/source/developer_guide/dg_other.rst @@ -177,14 +177,14 @@ the tracer dependencies (weights), which are tracked using the arrays ``trcr_base`` (a dependency mask), ``n_trcr_strata`` (the number of underlying tracer layers), and ``nt_strata`` (indices of underlying layers). Additional information about tracers can be found in the -`Icepack documentation `__. +`Icepack documentation `__. To add a tracer, follow these steps using one of the existing tracers as a pattern. 1) **icepack\_tracers.F90** and **icepack\_[tracer].F90**: declare tracers, add flags and indices, and create physics routines as described in the - `Icepack documentation `__ + `Icepack documentation `__ 2) **ice_arrays_column.F90**: declare arrays @@ -233,6 +233,6 @@ a pattern. configuration in **configuration/scripts/options**. 12) If strict conservation is necessary, add diagnostics as noted for - topo ponds in the `Icepack documentation `__. + topo ponds in the `Icepack documentation `__. 13) Update documentation, including **cice_index.rst** and **ug_case_settings.rst** diff --git a/doc/source/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/about.rst b/doc/source/intro/about.rst index b249a8dfb..3845cfbc0 100644 --- a/doc/source/intro/about.rst +++ b/doc/source/intro/about.rst @@ -23,7 +23,7 @@ coupled with other earth system model components, routines external to the CICE model prepare and execute data exchanges with an external “flux coupler”. Icepack is implemented in CICE as a git submodule, and it is documented at -https://cice-consortium-icepack.readthedocs.io/en/master/index.html. +https://cice-consortium-icepack.readthedocs.io/en/main/index.html. Development and testing of CICE and Icepack may be done together, but the repositories are independent. This document describes the remainder of the CICE model. The CICE code is diff --git a/doc/source/intro/citing.rst b/doc/source/intro/citing.rst index c128bc4e6..593041b21 100644 --- a/doc/source/intro/citing.rst +++ b/doc/source/intro/citing.rst @@ -15,7 +15,7 @@ More information can be found by following the DOI link to zenodo. If you use CICE, please cite the version number of the code you are using or modifying. -If using code from the CICE-Consortium repository ``master`` branch +If using code from the CICE-Consortium repository ``main`` branch that includes modifications that have not yet been released with a version number, then in addition to the most recent version number, the hash at time of diff --git a/doc/source/master_list.bib b/doc/source/master_list.bib index 9e387efb9..a7c3a1174 100644 --- a/doc/source/master_list.bib +++ b/doc/source/master_list.bib @@ -331,7 +331,7 @@ @Manual{Smith95 title = "{Curvilinear coordinates for global ocean models}", organization = "Technical Report LA-UR-95-1146, Los Alamos National Laboratory", year = {1995}, - url = {https://github.com/CICE-Consortium/CICE/blob/master/doc/PDF/LAUR-95-1146.pdf} + url = {https://github.com/CICE-Consortium/CICE/blob/main/doc/PDF/LAUR-95-1146.pdf} } @Article{Zwiers95, author = "F.W. Zwiers and H. von Storch", @@ -523,14 +523,14 @@ @Manual{Kauffman02 title = "{The CCSM coupler, version 5.0.1}", journal = NTN, year = {2002}, - url = {https://github.com/CICE-Consortium/CICE/blob/master/doc/PDF/KL_NCAR2002.pdf} + url = {https://github.com/CICE-Consortium/CICE/blob/main/doc/PDF/KL_NCAR2002.pdf} } @Manual{Hunke03, author = "E.C. Hunke and J.K. Dukowicz", title = "{The sea ice momentum equation in the free drift regime}", organization = "Technical Report LA-UR-03-2219, Los Alamos National Laboratory", year = {2003}, - url = {https://github.com/CICE-Consortium/CICE/blob/master/doc/PDF/LAUR-03-2219.pdf} + url = {https://github.com/CICE-Consortium/CICE/blob/main/doc/PDF/LAUR-03-2219.pdf} } @Article{Amundrud04, author = "T.L. Amundrud and H. Malling and R.G. Ingram", @@ -636,7 +636,7 @@ @Article{Jin06 year = {2006}, volume = {44}, pages = {63-72}, - url = {https://github.com/CICE-Consortium/CICE/blob/master/doc/PDF/JDWSTWLG06.pdf} + url = {https://github.com/CICE-Consortium/CICE/blob/main/doc/PDF/JDWSTWLG06.pdf} } @Article{Wilchinsky06, author = "A.V. Wilchinsky and D.L. Feltham", @@ -660,7 +660,7 @@ @Manual{Briegleb07 title = "{A Delta-Eddington multiple scattering parameterization for solar radiation in the sea ice component of the Community Climate System Model}", organization = "NCAR Technical Note NCAR/TN-472+STR, National Center for Atmospheric Research", year = {2007}, - url = {https://github.com/CICE-Consortium/CICE/blob/master/doc/PDF/BL_NCAR2007.pdf} + url = {https://github.com/CICE-Consortium/CICE/blob/main/doc/PDF/BL_NCAR2007.pdf} } @Article{Flocco07, author = "D. Flocco and D.L. Feltham", diff --git a/doc/source/science_guide/sg_coupling.rst b/doc/source/science_guide/sg_coupling.rst index c01e2bea5..666c13ed4 100644 --- a/doc/source/science_guide/sg_coupling.rst +++ b/doc/source/science_guide/sg_coupling.rst @@ -27,7 +27,7 @@ variables for each cell. These considerations are explained in more detail below. The fluxes and state variables passed between the sea ice model and the -CESM flux coupler are listed in the `Icepack documentation `_. +CESM flux coupler are listed in the `Icepack documentation `_. By convention, directional fluxes are positive downward. In CESM, the sea ice model may exchange coupling fluxes using a different grid than the computational @@ -135,6 +135,6 @@ thin compared to the typical depth of the Ekman spiral, then :math:`\theta=0` is a good approximation. Here we assume that the top layer is thin enough. -Please see the `Icepack documentation `_ for additional information about +Please see the `Icepack documentation `_ for additional information about atmospheric and oceanic forcing and other data exchanged between the flux coupler and the sea ice model. diff --git a/doc/source/science_guide/sg_dynamics.rst b/doc/source/science_guide/sg_dynamics.rst index 585c18616..1ddf94472 100644 --- a/doc/source/science_guide/sg_dynamics.rst +++ b/doc/source/science_guide/sg_dynamics.rst @@ -284,7 +284,7 @@ Parameters for the FGMRES linear solver and the preconditioner can be controlled Surface stress terms ******************** -The formulation for the wind stress is described in `Icepack Documentation `_. Below, some details about the ice-ocean stress and the seabed stress are given. +The formulation for the wind stress is described in `Icepack Documentation `_. Below, some details about the ice-ocean stress and the seabed stress are given. Ice-Ocean stress ~~~~~~~~~~~~~~~~ @@ -515,7 +515,7 @@ where When the deformation :math:`\Delta` tends toward zero, the viscosities tend toward infinity. To avoid this issue, :math:`\Delta` needs to be limited and is replaced by :math:`\Delta^*` in equation :eq:`zeta`. Two methods for limiting :math:`\Delta` (or for capping the viscosities) are available in the code. If the namelist parameter ``capping_method`` is set to ``max``, :math:`\Delta^*=max(\Delta, \Delta_{min})` :cite:`Hibler79` while with ``capping_method`` set to ``sum``, the smoother formulation :math:`\Delta^*=(\Delta + \Delta_{min})` of :cite:`Kreyscher00` is used. The ice strength :math:`P` is a function of the ice thickness distribution as -described in the `Icepack Documentation `_. +described in the `Icepack Documentation `_. Two other modifications to the standard VP rheology of :cite:`Hibler79` are available. First, following the approach of :cite:`Konig10` (see also :cite:`Lemieux16`), the diff --git a/doc/source/science_guide/sg_fundvars.rst b/doc/source/science_guide/sg_fundvars.rst index 5b5703266..2d6f50328 100644 --- a/doc/source/science_guide/sg_fundvars.rst +++ b/doc/source/science_guide/sg_fundvars.rst @@ -17,7 +17,7 @@ In addition to an ice thickness distribution, CICE includes an optional capabili Ice floe horizontal size may change through vertical and lateral growth and melting of existing floes, freezing of new ice, wave breaking, and welding of floes in freezing conditions. The floe size distribution (FSD) is a probability function that characterizes this variability. The scheme is based on the theoretical framework described in :cite:`Horvat15` for a joint floe size and thickness distribution (FSTD), and was implemented by :cite:`Roach18` and :cite:`Roach19`. The joint floe size distribution is carried as an area-weighted tracer, defined as the fraction of ice belonging to a given thickness category with lateral floe size belong to a given floe size class. This development includes interactions between sea ice and ocean surface waves. Input data on ocean surface wave spectra at a single time is provided for testing, but as with the other CICE datasets, it should not be used for production runs or publications. It is not recommended to use the FSD without ocean surface waves. Additional information about the ITD and joint FSTD for CICE can be found in the -`Icepack documentation `_. +`Icepack documentation `_. The fundamental equation solved by CICE is :cite:`Thorndike75`: @@ -87,7 +87,7 @@ Section :ref:`horiz-trans`. Ice is transported in thickness space using the remapping scheme of :cite:`Lipscomb01`. The mechanical redistribution scheme, based on :cite:`Thorndike75`, :cite:`Rothrock75`, :cite:`Hibler80`, :cite:`Flato95`, and :cite:`Lipscomb07` is outlined -in the `Icepack Documentation `_. +in the `Icepack Documentation `_. To solve the horizontal transport and ridging equations, we need the ice velocity :math:`{\bf u}`, and to compute transport in thickness space, we must know the the ice growth diff --git a/doc/source/science_guide/sg_horiztrans.rst b/doc/source/science_guide/sg_horiztrans.rst index d66046465..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 9906fba87..516f3238d 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 d9ea07a02..9bcf205b4 100644 --- a/doc/source/user_guide/ug_implementation.rst +++ b/doc/source/user_guide/ug_implementation.rst @@ -1037,7 +1037,7 @@ used in coupled models. MPI is initialized in *init\_communicate* for both coupled and stand-alone MPI runs. The ice component communicates with a flux coupler or other climate components via external routines that handle the -variables listed in the `Icepack documentation `_. +variables listed in the `Icepack documentation `_. For stand-alone runs, routines in **ice\_forcing.F90** read and interpolate data from files, and are intended merely to provide guidance for the user to write his or @@ -1154,7 +1154,8 @@ io package. The namelist variable ``history_format`` further refines the format approach or style for some io packages. Model output data can be written as instantaneous or average data as specified -by the ``hist_avg`` namelist flag. The data is written at the period(s) given by ``histfreq`` and +by the ``hist_avg`` namelist array and is customizable by stream. The data is +written at the period(s) given by ``histfreq`` and ``histfreq_n`` relative to a reference date specified by ``histfreq_base``. The files are written to binary or netCDF files prepended by ``history_file`` in **ice_in**. These settings for history files are set in the @@ -1196,8 +1197,11 @@ with a given ``histfreq`` value, or if an element of ``histfreq_n`` is 0, then no file will be written at that frequency. The output period can be discerned from the filenames. All history streams will be either instantaneous or averaged as specified by the ``hist_avg`` namelist setting and the frequency -will be relative to a reference date specified by ``histfreq_base``. More -information about how the frequency is computed is found in :ref:`timemanager`. +will be relative to a reference date specified by ``histfreq_base``. Also, some +Earth Sytem Models require the history file time axis to be centered in the averaging +interval. The flag ``hist_time_axis`` will allow the user to chose ``begin``, ``middle``, +or ``end`` for the time stamp. More information about how the frequency is +computed is found in :ref:`timemanager`. For example, in the namelist: @@ -1206,7 +1210,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 606ae1397..e382eba17 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. @@ -742,6 +742,8 @@ The following are brief descriptions of some of the current unit tests, in the Makefile - **optargs** is a unit test that tests passing optional arguments down a calling tree and verifying that the optional attribute is preserved correctly. + - **opticep** is a cice test that turns off the icepack optional arguments passed into icepack. This + can only be run with a subset of CICE/Icepack cases to verify the optional arguments are working correctly. - **sumchk** is a unit test that exercises the methods in ice_global_reductions.F90. This test requires that a CICE grid and decomposition be initialized, so CICE_InitMod.F90 is leveraged to initialize the model prior to running a suite of unit validation tests to verify correctness. @@ -757,7 +759,7 @@ to the official CICE Consortium Test-Results `wiki page `_. You may need write permission on the wiki. If you are interested in using the wiki, please contact the Consortium. Note that in order for code to be -accepted to the CICE master through a Pull Request it is necessary +accepted to the CICE main branch through a Pull Request it is necessary for the developer to provide proof that their code passes relevant tests. This can be accomplished by posting the full results to the wiki, or by copying the testing summary to the Pull Request comments. @@ -824,7 +826,7 @@ assess test coverage. ..Because codecov.io does not support git submodule analysis right now, a customized ..repository has to be created to test CICE with Icepack integrated directly. The repository ..https://github.com/apcraig/Test_CICE_Icepack serves as the current default test repository. -..In general, to setup the code coverage test in CICE, the current CICE master has +..In general, to setup the code coverage test in CICE, the current CICE main has ..to be copied into the Test_CICE_Icepack repository, then the full test suite ..can be run with the gnu compiler with the ``--coverage`` argument. diff --git a/doc/source/user_guide/ug_troubleshooting.rst b/doc/source/user_guide/ug_troubleshooting.rst index 315b2f869..9d8c49a72 100644 --- a/doc/source/user_guide/ug_troubleshooting.rst +++ b/doc/source/user_guide/ug_troubleshooting.rst @@ -106,7 +106,7 @@ parameterizations are used, the code should be able to execute from these files. However if different physics is used (for instance, mushy thermo instead of BL99), the code may still fail. To convert a v4.1 restart file, consult section 5.2 in the `CICE v5 documentation -`_. +`_. If restart files are taking a long time to be written serially (i.e., not using PIO), see the next section. @@ -228,7 +228,7 @@ Interpretation of albedos More information about interpretation of albedos can be found in the -`Icepack documentation `_. +`Icepack documentation `_. VP dynamics results diff --git a/icepack b/icepack index a4779cc71..4728746ea 160000 --- a/icepack +++ b/icepack @@ -1 +1 @@ -Subproject commit a4779cc71125b40a7db3a4da8512247cbf2b0955 +Subproject commit 4728746ea2926bf10acc5de354b3eae16d418af5