From 955ef8d6b2615f6a35f6961258b0a8d9eb62ecd3 Mon Sep 17 00:00:00 2001 From: Denise Worthen Date: Thu, 16 Sep 2021 08:28:30 -0400 Subject: [PATCH] Update CICE for latest Consortium master (#38) * Implement advanced snow physics in icepack and CICE * Fix time-stamping of CICE history files * Fix CICE history file precision --- cicecore/cicedyn/analysis/ice_diagnostics.F90 | 143 +- .../cicedyn/analysis/ice_diagnostics_bgc.F90 | 507 ++- cicecore/cicedyn/analysis/ice_history.F90 | 210 +- .../cicedyn/analysis/ice_history_pond.F90 | 94 +- .../cicedyn/analysis/ice_history_shared.F90 | 2 +- .../cicedyn/analysis/ice_history_snow.F90 | 79 +- cicecore/cicedyn/dynamics/ice_dyn_eap.F90 | 12 +- .../cicedyn/dynamics/ice_transport_driver.F90 | 25 +- cicecore/cicedyn/general/ice_flux.F90 | 7 + cicecore/cicedyn/general/ice_forcing.F90 | 209 +- cicecore/cicedyn/general/ice_step_mod.F90 | 220 +- .../infrastructure/comm/mpi/ice_boundary.F90 | 133 +- .../comm/serial/ice_boundary.F90 | 133 +- .../cicedyn/infrastructure/ice_domain.F90 | 2 +- .../io/io_binary/ice_restart.F90 | 61 +- .../io/io_netcdf/ice_restart.F90 | 15 +- cicecore/cicedynB/dynamics/ice_dyn_evp.F90 | 262 +- cicecore/cicedynB/dynamics/ice_dyn_evp_1d.F90 | 3906 ++++++++--------- cicecore/cicedynB/dynamics/ice_dyn_shared.F90 | 303 +- cicecore/cicedynB/dynamics/ice_dyn_vp.F90 | 44 +- cicecore/cicedynB/general/ice_init.F90 | 444 +- cicecore/cicedynB/infrastructure/ice_grid.F90 | 54 +- .../infrastructure/ice_read_write.F90 | 288 +- .../io/io_netcdf/ice_history_write.F90 | 327 +- .../io/io_pio2/ice_history_write.F90 | 377 +- .../infrastructure/io/io_pio2/ice_restart.F90 | 86 +- .../drivers/standalone/cice/CICE_InitMod.F90 | 52 +- .../drivers/standalone/cice/CICE_RunMod.F90 | 27 +- cicecore/drivers/unittest/calchk/calchk.F90 | 12 +- cicecore/shared/ice_arrays_column.F90 | 169 +- cicecore/shared/ice_init_column.F90 | 77 +- cicecore/shared/ice_restart_column.F90 | 91 +- cicecore/version.txt | 2 +- configuration/scripts/cice.batch.csh | 17 + configuration/scripts/cice.launch.csh | 6 + configuration/scripts/cice.run.setup.csh | 2 +- configuration/scripts/ice_in | 41 +- .../scripts/machines/Macros.onyx_gnu | 2 +- configuration/scripts/machines/env.gaea_intel | 5 +- configuration/scripts/machines/env.onyx_cray | 13 +- configuration/scripts/machines/env.onyx_gnu | 13 +- configuration/scripts/machines/env.onyx_intel | 13 +- configuration/scripts/options/set_nml.gx1prod | 4 +- .../scripts/options/set_nml.snwITDrdg | 10 + configuration/scripts/tests/base_suite.ts | 3 + configuration/scripts/tests/prod_suite.ts | 3 +- configuration/scripts/tests/reprosum_suite.ts | 21 +- .../scripts/tests/test_unittest.script | 24 +- doc/source/cice_index.rst | 347 +- doc/source/conf.py | 4 +- doc/source/developer_guide/dg_dynamics.rst | 40 +- doc/source/science_guide/sg_dynamics.rst | 250 +- doc/source/science_guide/sg_tracers.rst | 6 +- doc/source/user_guide/ug_case_settings.rst | 39 +- doc/source/user_guide/ug_implementation.rst | 39 +- 55 files changed, 5638 insertions(+), 3637 deletions(-) mode change 100644 => 100755 cicecore/cicedynB/dynamics/ice_dyn_evp_1d.F90 mode change 100644 => 100755 cicecore/cicedynB/dynamics/ice_dyn_shared.F90 mode change 100644 => 100755 configuration/scripts/machines/env.gaea_intel mode change 100644 => 100755 configuration/scripts/machines/env.onyx_cray mode change 100644 => 100755 configuration/scripts/machines/env.onyx_gnu mode change 100644 => 100755 configuration/scripts/machines/env.onyx_intel create mode 100644 configuration/scripts/options/set_nml.snwITDrdg diff --git a/cicecore/cicedyn/analysis/ice_diagnostics.F90 b/cicecore/cicedyn/analysis/ice_diagnostics.F90 index 027db5d71..d4e7066fb 100644 --- a/cicecore/cicedyn/analysis/ice_diagnostics.F90 +++ b/cicecore/cicedyn/analysis/ice_diagnostics.F90 @@ -14,6 +14,7 @@ module ice_diagnostics use ice_communicate, only: my_task, master_task use ice_constants, only: c0, c1 use ice_calendar, only: istep1 + use ice_domain_size, only: nslyr use ice_fileunits, only: nu_diag use ice_fileunits, only: flush_fileunit use ice_exit, only: abort_ice @@ -39,7 +40,7 @@ module ice_diagnostics print_global ! if true, print global data integer (kind=int_kind), public :: & - debug_model_step = 999999999 ! begin printing at istep1=debug_model_step + debug_model_step = 0 ! begin printing at istep1=debug_model_step integer (kind=int_kind), parameter, public :: & npnt = 2 ! total number of points to be printed @@ -73,6 +74,12 @@ module ice_diagnostics integer (kind=int_kind), dimension(npnt), public :: & piloc, pjloc, pbloc, pmloc ! location of diagnostic points + integer (kind=int_kind), public :: & + debug_model_i = -1, & ! location of debug_model point, local i index + debug_model_j = -1, & ! location of debug_model point, local j index + debug_model_iblk = -1, & ! location of debug_model point, local block number + debug_model_task = -1 ! location of debug_model point, local task number + ! for hemispheric water and heat budgets real (kind=dbl_kind) :: & totmn , & ! total ice/snow water mass (nh) @@ -136,15 +143,19 @@ subroutine runtime_diags (dt) i, j, k, n, iblk, nc, & ktherm, & nt_tsfc, nt_aero, nt_fbri, nt_apnd, nt_hpnd, nt_fsd, & - nt_isosno, nt_isoice + nt_isosno, nt_isoice, nt_rsnw, nt_rhos, nt_smice, nt_smliq logical (kind=log_kind) :: & - tr_pond_topo, tr_brine, tr_iso, tr_aero, calc_Tsfc, tr_fsd + tr_pond_topo, tr_brine, tr_iso, tr_aero, calc_Tsfc, tr_fsd, & + tr_snow, snwgrain real (kind=dbl_kind) :: & rhow, rhos, rhoi, puny, awtvdr, awtidr, awtvdf, awtidf, & rhofresh, lfresh, lvap, ice_ref_salinity, Tffresh + character (len=char_len) :: & + snwredist + ! hemispheric state quantities real (kind=dbl_kind) :: & umaxn, hmaxn, shmaxn, arean, snwmxn, extentn, shmaxnt, & @@ -184,7 +195,8 @@ subroutine runtime_diags (dt) pTsfc, pevap, pfswabs, pflwout, pflat, pfsens, & pfsurf, pfcondtop, psst, psss, pTf, hiavg, hsavg, hbravg, & pfhocn, psalt, fsdavg, & - pmeltt, pmeltb, pmeltl, psnoice, pdsnow, pfrazil, pcongel + pmeltt, pmeltb, pmeltl, psnoice, pdsnow, pfrazil, pcongel, & + prsnwavg, prhosavg, psmicetot, psmliqtot, psmtot real (kind=dbl_kind), dimension (nx_block,ny_block,max_blocks) :: & work1, work2 @@ -193,15 +205,19 @@ subroutine runtime_diags (dt) call icepack_query_parameters(ktherm_out=ktherm, calc_Tsfc_out=calc_Tsfc) call icepack_query_tracer_flags(tr_brine_out=tr_brine, tr_aero_out=tr_aero, & - tr_pond_topo_out=tr_pond_topo, tr_fsd_out=tr_fsd, tr_iso_out=tr_iso) + tr_pond_topo_out=tr_pond_topo, tr_fsd_out=tr_fsd, tr_iso_out=tr_iso, & + tr_snow_out=tr_snow) call icepack_query_tracer_indices(nt_fbri_out=nt_fbri, nt_Tsfc_out=nt_Tsfc, & nt_aero_out=nt_aero, nt_apnd_out=nt_apnd, nt_hpnd_out=nt_hpnd, & - nt_fsd_out=nt_fsd,nt_isosno_out=nt_isosno, nt_isoice_out=nt_isoice) + nt_fsd_out=nt_fsd,nt_isosno_out=nt_isosno, nt_isoice_out=nt_isoice, & + nt_rsnw_out=nt_rsnw, nt_rhos_out=nt_rhos, & + nt_smice_out=nt_smice, nt_smliq_out=nt_smliq) call icepack_query_parameters(Tffresh_out=Tffresh, rhos_out=rhos, & rhow_out=rhow, rhoi_out=rhoi, puny_out=puny, & awtvdr_out=awtvdr, awtidr_out=awtidr, awtvdf_out=awtvdf, awtidf_out=awtidf, & rhofresh_out=rhofresh, lfresh_out=lfresh, lvap_out=lvap, & - ice_ref_salinity_out=ice_ref_salinity) + ice_ref_salinity_out=ice_ref_salinity,snwredist_out=snwredist, & + snwgrain_out=snwgrain) call icepack_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & file=__FILE__, line=__LINE__) @@ -819,6 +835,27 @@ subroutine runtime_diags (dt) enddo endif endif + if (tr_snow) then ! snow tracer quantities + prsnwavg (n) = c0 ! avg snow grain radius + prhosavg (n) = c0 ! avg snow density + psmicetot(n) = c0 ! total mass of ice in snow (kg/m2) + psmliqtot(n) = c0 ! total mass of liquid in snow (kg/m2) + psmtot (n) = c0 ! total mass of snow volume (kg/m2) + if (vsno(i,j,iblk) > c0) then + do k = 1, nslyr + prsnwavg (n) = prsnwavg (n) + trcr(i,j,nt_rsnw +k-1,iblk) ! snow grain radius + prhosavg (n) = prhosavg (n) + trcr(i,j,nt_rhos +k-1,iblk) ! compacted snow density + psmicetot(n) = psmicetot(n) + trcr(i,j,nt_smice+k-1,iblk) * vsno(i,j,iblk) + psmliqtot(n) = psmliqtot(n) + trcr(i,j,nt_smliq+k-1,iblk) * vsno(i,j,iblk) + end do + endif + psmtot (n) = rhos * vsno(i,j,iblk) ! mass of ice in standard density snow + prsnwavg (n) = prsnwavg (n) / real(nslyr,kind=dbl_kind) ! snow grain radius + prhosavg (n) = prhosavg (n) / real(nslyr,kind=dbl_kind) ! compacted snow density + psmicetot(n) = psmicetot(n) / real(nslyr,kind=dbl_kind) ! mass of ice in snow + psmliqtot(n) = psmliqtot(n) / real(nslyr,kind=dbl_kind) ! mass of liquid in snow + end if + psalt(n) = c0 if (vice(i,j,iblk) /= c0) psalt(n) = work2(i,j,iblk)/vice(i,j,iblk) pTsfc(n) = trcr(i,j,nt_Tsfc,iblk) ! ice/snow sfc temperature pevap(n) = evap(i,j,iblk)*dt/rhoi ! sublimation/condensation @@ -870,6 +907,11 @@ subroutine runtime_diags (dt) call broadcast_scalar(pmeltl (n), pmloc(n)) call broadcast_scalar(psnoice (n), pmloc(n)) call broadcast_scalar(pdsnow (n), pmloc(n)) + call broadcast_scalar(psmtot (n), pmloc(n)) + call broadcast_scalar(prsnwavg (n), pmloc(n)) + call broadcast_scalar(prhosavg (n), pmloc(n)) + call broadcast_scalar(psmicetot(n), pmloc(n)) + call broadcast_scalar(psmliqtot(n), pmloc(n)) call broadcast_scalar(pfrazil (n), pmloc(n)) call broadcast_scalar(pcongel (n), pmloc(n)) call broadcast_scalar(pdhi (n), pmloc(n)) @@ -1053,6 +1095,26 @@ subroutine runtime_diags (dt) write(nu_diag,900) 'effective dhi (m) = ',pdhi(1),pdhi(2) write(nu_diag,900) 'effective dhs (m) = ',pdhs(1),pdhs(2) write(nu_diag,900) 'intnl enrgy chng(W/m^2)= ',pde (1),pde (2) + + if (tr_snow) then + if (trim(snwredist) /= 'none') then + write(nu_diag,900) 'avg snow density(kg/m3)= ',prhosavg(1) & + ,prhosavg(2) + endif + if (snwgrain) then + write(nu_diag,900) 'avg snow grain radius = ',prsnwavg(1) & + ,prsnwavg(2) + write(nu_diag,900) 'mass ice in snow(kg/m2)= ',psmicetot(1) & + ,psmicetot(2) + write(nu_diag,900) 'mass liq in snow(kg/m2)= ',psmliqtot(1) & + ,psmliqtot(2) + write(nu_diag,900) 'mass std snow (kg/m2)= ',psmtot(1) & + ,psmtot(2) + write(nu_diag,900) 'max ice+liq (kg/m2)= ',rhow * hsavg(1) & + ,rhow * hsavg(2) + endif + endif + write(nu_diag,*) '----------ocn----------' write(nu_diag,900) 'sst (C) = ',psst(1),psst(2) write(nu_diag,900) 'sss (ppt) = ',psss(1),psss(2) @@ -1432,9 +1494,9 @@ subroutine init_diags write(nu_diag,*) ' Find indices of diagnostic points ' endif - piloc(:) = 0 - pjloc(:) = 0 - pbloc(:) = 0 + piloc(:) = -1 + pjloc(:) = -1 + pbloc(:) = -1 pmloc(:) = -999 plat(:) = -999._dbl_kind plon(:) = -999._dbl_kind @@ -1535,16 +1597,29 @@ subroutine debug_ice(iblk, plabeld) integer (kind=int_kind) :: i, j, m character(len=*), parameter :: subname='(debug_ice)' -! tcraig, do this only on one point, the first point -! do m = 1, npnt - m = 1 - if (istep1 >= debug_model_step .and. & - iblk == pbloc(m) .and. my_task == pmloc(m)) then - i = piloc(m) - j = pjloc(m) - call print_state(plabeld,i,j,iblk) + if (istep1 >= debug_model_step) then + + ! set debug point to 1st global point if not set as local values + if (debug_model_i < 0 .and. debug_model_j < 0 .and. & + debug_model_iblk < 0 .and. debug_model_task < 0) then + debug_model_i = piloc(1) + debug_model_j = pjloc(1) + debug_model_task = pmloc(1) + debug_model_iblk = pbloc(1) + endif + + ! if debug point is messed up, abort + if (debug_model_i < 0 .or. debug_model_j < 0 .or. & + debug_model_iblk < 0 .or. debug_model_task < 0) then + call abort_ice (subname//'ERROR: debug_model_[i,j,iblk,mytask] not set correctly') endif -! enddo + + ! write out debug info + if (debug_model_iblk == iblk .and. debug_model_task == my_task) then + call print_state(plabeld,debug_model_i,debug_model_j,debug_model_iblk) + endif + + endif end subroutine debug_ice @@ -1573,23 +1648,25 @@ subroutine print_state(plabel,i,j,iblk) real (kind=dbl_kind) :: & eidebug, esdebug, & - qi, qs, Tsnow, & + qi, qs, Tsnow, si, & rad_to_deg, puny, rhoi, lfresh, rhos, cp_ice integer (kind=int_kind) :: n, k, nt_Tsfc, nt_qice, nt_qsno, nt_fsd, & - nt_isosno, nt_isoice + nt_isosno, nt_isoice, nt_sice, nt_smice, nt_smliq - logical (kind=log_kind) :: tr_fsd, tr_iso + logical (kind=log_kind) :: tr_fsd, tr_iso, tr_snow type (block) :: & this_block ! block information for current block character(len=*), parameter :: subname = '(print_state)' - call icepack_query_tracer_flags(tr_fsd_out=tr_fsd, tr_iso_out=tr_iso) + call icepack_query_tracer_flags(tr_fsd_out=tr_fsd, tr_iso_out=tr_iso, & + tr_snow_out=tr_snow) call icepack_query_tracer_indices(nt_Tsfc_out=nt_Tsfc, nt_qice_out=nt_qice, & - nt_qsno_out=nt_qsno, nt_fsd_out=nt_fsd, & - nt_isosno_out=nt_isosno, nt_isoice_out=nt_isoice) + nt_qsno_out=nt_qsno, nt_sice_out=nt_sice, nt_fsd_out=nt_fsd, & + nt_isosno_out=nt_isosno, nt_isoice_out=nt_isoice, & + nt_smice_out=nt_smice, nt_smliq_out=nt_smliq) call icepack_query_parameters( & rad_to_deg_out=rad_to_deg, puny_out=puny, rhoi_out=rhoi, lfresh_out=lfresh, & rhos_out=rhos, cp_ice_out=cp_ice) @@ -1619,8 +1696,11 @@ subroutine print_state(plabel,i,j,iblk) endif write(nu_diag,*) 'Tsfcn',trcrn(i,j,nt_Tsfc,n,iblk) if (tr_fsd) write(nu_diag,*) 'afsdn',trcrn(i,j,nt_fsd,n,iblk) ! fsd cat 1 -! if (tr_iso) write(nu_diag,*) 'isosno',trcrn(i,j,nt_isosno,n,iblk) ! isotopes in snow -! if (tr_iso) write(nu_diag,*) 'isoice',trcrn(i,j,nt_isoice,n,iblk) ! isotopes in ice +! layer 1 diagnostics +! if (tr_iso) write(nu_diag,*) 'isosno',trcrn(i,j,nt_isosno,n,iblk) ! isotopes in snow +! if (tr_iso) write(nu_diag,*) 'isoice',trcrn(i,j,nt_isoice,n,iblk) ! isotopes in ice +! if (tr_snow) write(nu_diag,*) 'smice', trcrn(i,j,nt_smice, n,iblk) ! ice mass in snow +! if (tr_snow) write(nu_diag,*) 'smliq', trcrn(i,j,nt_smliq, n,iblk) ! liquid mass in snow write(nu_diag,*) ' ' ! dynamics (transport and/or ridging) causes the floe size distribution to become non-normal @@ -1633,7 +1713,6 @@ subroutine print_state(plabel,i,j,iblk) enddo ! n - eidebug = c0 do n = 1,ncat do k = 1,nilyr @@ -1666,6 +1745,14 @@ subroutine print_state(plabel,i,j,iblk) write(nu_diag,*) 'qsnow(i,j)',esdebug write(nu_diag,*) ' ' + do n = 1,ncat + do k = 1,nilyr + si = trcrn(i,j,nt_sice+k-1,n,iblk) + write(nu_diag,*) 'sice, cat ',n,' layer ',k, si + enddo + enddo + write(nu_diag,*) ' ' + write(nu_diag,*) 'uvel(i,j)',uvel(i,j,iblk) write(nu_diag,*) 'vvel(i,j)',vvel(i,j,iblk) diff --git a/cicecore/cicedyn/analysis/ice_diagnostics_bgc.F90 b/cicecore/cicedyn/analysis/ice_diagnostics_bgc.F90 index 1caabab02..74485a5e2 100644 --- a/cicecore/cicedyn/analysis/ice_diagnostics_bgc.F90 +++ b/cicecore/cicedyn/analysis/ice_diagnostics_bgc.F90 @@ -24,7 +24,7 @@ module ice_diagnostics_bgc implicit none private - public :: hbrine_diags, bgc_diags + public :: hbrine_diags, bgc_diags, zsal_diags !======================================================================= @@ -41,7 +41,7 @@ module ice_diagnostics_bgc ! Nicole Jeffery, LANL subroutine hbrine_diags - + use ice_arrays_column, only: darcy_V use ice_broadcast, only: broadcast_scalar, broadcast_array use ice_diagnostics, only: npnt, print_points, pmloc, piloc, pjloc, pbloc @@ -84,27 +84,27 @@ subroutine hbrine_diags if (my_task == pmloc(n)) then i = piloc(n) j = pjloc(n) - iblk = pbloc(n) - phinS1(n) = c0 - phinS(n) = c0 - pfbri(n) = trcrn(i,j,nt_fbri,1,iblk) + iblk = pbloc(n) + phinS1(n) = c0 + phinS(n) = c0 + pfbri(n) = trcrn(i,j,nt_fbri,1,iblk) pdarcy_V(n) = darcy_V(i,j,1,iblk) if (aice(i,j,iblk) > c0) & phinS(n) = trcr(i,j,nt_fbri,iblk)*vice(i,j,iblk)/aice(i,j,iblk) if (aicen(i,j,1,iblk)> c0) & phinS1(n) = trcrn(i,j,nt_fbri,1,iblk)*vicen(i,j,1,iblk)/& - aicen(i,j,1,iblk) + aicen(i,j,1,iblk) do k = 1,nilyr pSin1(n,k) = trcrn(i,j,nt_sice+k-1,1,iblk) pSin(n,k) = trcr(i,j,nt_sice+k-1,iblk) enddo endif ! my_task = pmloc - - call broadcast_array (pSin (n,:), pmloc(n)) - call broadcast_array (pSin1 (n,:), pmloc(n)) - call broadcast_scalar(pfbri (n), pmloc(n)) - call broadcast_scalar(phinS1 (n), pmloc(n)) - call broadcast_scalar(phinS (n), pmloc(n)) + + call broadcast_array (pSin (n,:), pmloc(n)) + call broadcast_array (pSin1 (n,:), pmloc(n)) + call broadcast_scalar(pfbri (n), pmloc(n)) + call broadcast_scalar(phinS1 (n), pmloc(n)) + call broadcast_scalar(phinS (n), pmloc(n)) call broadcast_scalar(pdarcy_V(n), pmloc(n)) enddo ! npnt endif ! print_points @@ -125,22 +125,22 @@ subroutine hbrine_diags write(nu_diag,*) '------ hbrine ------' write(nu_diag,900) 'hbrine, (m) = ',phinS(1),phinS(2) write(nu_diag,900) 'fbri, cat1 (m) = ',pfbri(1),pfbri(2) - write(nu_diag,900) 'hbrine cat1, (m) = ',phinS1(1),phinS1(2) - write(nu_diag,900) 'darcy_V cat1, (m/s)= ',pdarcy_V(1),pdarcy_V(2) - if (ktherm == 2) then + write(nu_diag,900) 'hbrine cat1, (m) = ',phinS1(1),phinS1(2) + write(nu_diag,900) 'darcy_V cat1, (m/s)= ',pdarcy_V(1),pdarcy_V(2) + if (ktherm == 2) then write(nu_diag,*) ' ' write(nu_diag,*) '------ Thermosaline Salinity ------' write(nu_diag,803) 'Sice1(1) cat1 S (ppt)','Sice1(2) cat1 S' write(nu_diag,*) '---------------------------------------------------' - write(nu_diag,802) ((pSin1(n,k),n=1,2), k = 1,nilyr) + write(nu_diag,802) ((pSin1(n,k),n=1,2), k = 1,nilyr) write(nu_diag,*) ' ' write(nu_diag,803) 'Sice(1) bulk S (ppt) ','Sice(2) bulk S' write(nu_diag,*) '---------------------------------------------------' - write(nu_diag,802) ((pSin(n,k),n=1,2), k = 1,nilyr) + write(nu_diag,802) ((pSin(n,k),n=1,2), k = 1,nilyr) write(nu_diag,*) ' ' endif endif ! print_points - endif ! my_task = master_task + endif ! my_task = master_task 802 format (f24.17,2x,f24.17) 803 format (a25,2x,a25) @@ -198,7 +198,7 @@ subroutine bgc_diags integer (kind=int_kind), dimension(icepack_max_doc) :: & nt_bgc_doc, nlt_bgc_DOC integer (kind=int_kind), dimension(icepack_max_don) :: & - nt_bgc_don, nlt_bgc_DON + nt_bgc_don, nlt_bgc_DON integer (kind=int_kind), dimension(icepack_max_aero) :: & nt_zaero, nlt_zaero, nlt_zaero_sw integer (kind=int_kind), dimension(icepack_max_fe) :: & @@ -211,7 +211,7 @@ subroutine bgc_diags real (kind=dbl_kind), dimension(npnt,icepack_max_don) :: & pDON_ac, pDON_sk real (kind=dbl_kind), dimension(npnt,icepack_max_fe ) :: & - pFed_ac, pFed_sk, pFep_ac, pFep_sk + pFed_ac, pFed_sk, pFep_ac, pFep_sk real (kind=dbl_kind), dimension(npnt,icepack_max_aero) :: & pflux_zaero, pflux_snow_zaero, pflux_atm_zaero, & pflux_atm_zaero_s @@ -226,7 +226,7 @@ subroutine bgc_diags real (kind=dbl_kind), dimension(npnt,2,icepack_max_don) :: & pDONs real (kind=dbl_kind), dimension(npnt,2,icepack_max_fe ) :: & - pFeds, pFeps + pFeds, pFeps real (kind=dbl_kind), dimension(npnt,2,icepack_max_aero) :: & pzaeros real (kind=dbl_kind), dimension(npnt,nblyr+1) :: & @@ -240,10 +240,10 @@ subroutine bgc_diags real (kind=dbl_kind), dimension(npnt,nblyr+1,icepack_max_don) :: & pDON real (kind=dbl_kind), dimension(npnt,nblyr+1,icepack_max_fe ) :: & - pFed, pFep - real (kind=dbl_kind), dimension (nblyr+1) :: & + pFed, pFep + real (kind=dbl_kind), dimension (nblyr+1) :: & zspace - real (kind=dbl_kind), dimension (npnt,nslyr+nilyr+2) :: & + real (kind=dbl_kind), dimension (npnt,nslyr+nilyr+2) :: & pchlsw real (kind=dbl_kind), dimension(npnt,nslyr+nilyr+2,icepack_max_aero) :: & pzaerosw @@ -275,7 +275,7 @@ subroutine bgc_diags zspace(:) = c1/real(nblyr,kind=dbl_kind) zspace(1) = zspace(1)*p5 - zspace(nblyr+1) = zspace(nblyr+1)*p5 + zspace(nblyr+1) = zspace(nblyr+1)*p5 klev = 1+nilyr+nslyr !----------------------------------------------------------------- @@ -307,26 +307,26 @@ subroutine bgc_diags pNit_ac(n) = c0 if (tr_bgc_N) then do k = 1,n_algae - pN_ac(n,k) = ocean_bio(i,j,nlt_bgc_N(k),iblk) + pN_ac(n,k) = ocean_bio(i,j,nlt_bgc_N(k),iblk) enddo !n_algae endif !tr_bgc_N if (tr_bgc_C) then do k = 1,n_doc - pDOC_ac(n,k) = ocean_bio(i,j,nlt_bgc_DOC(k),iblk) + pDOC_ac(n,k) = ocean_bio(i,j,nlt_bgc_DOC(k),iblk) enddo !n_algae endif !tr_bgc_N if (tr_bgc_DON) then do k = 1,n_don - pDON_ac(n,k) = ocean_bio(i,j,nlt_bgc_DON(k),iblk) - enddo + pDON_ac(n,k) = ocean_bio(i,j,nlt_bgc_DON(k),iblk) + enddo endif if (tr_bgc_Fe ) then - do k = 1,n_fed - pFed_ac (n,k) = ocean_bio(i,j,nlt_bgc_Fed (k),iblk) - enddo - do k = 1,n_fep - pFep_ac (n,k) = ocean_bio(i,j,nlt_bgc_Fep (k),iblk) - enddo + do k = 1,n_fed + pFed_ac (n,k) = ocean_bio(i,j,nlt_bgc_Fed (k),iblk) + enddo + do k = 1,n_fep + pFep_ac (n,k) = ocean_bio(i,j,nlt_bgc_Fep (k),iblk) + enddo endif if (tr_bgc_Nit) & pNit_ac(n) = ocean_bio(i,j,nlt_bgc_Nit,iblk) ! nit(i,j,iblk) @@ -359,10 +359,10 @@ subroutine bgc_diags pDON_sk(n,:) = c0 pFed_sk(n,:) = c0 pFep_sk(n,:) = c0 - - do k = 1,n_algae + + do k = 1,n_algae pN_sk(n,k) = trcr (i,j,nt_bgc_N(k), iblk) - pflux_N(n,k) = flux_bio(i,j,nlt_bgc_N(k), iblk)*mps_to_cmpdy/c100 + pflux_N(n,k) = flux_bio(i,j,nlt_bgc_N(k), iblk)*mps_to_cmpdy/c100 enddo if (tr_bgc_C) then do k = 1,n_doc @@ -375,27 +375,27 @@ subroutine bgc_diags enddo endif if (tr_bgc_Fe ) then - do k = 1,n_fed + do k = 1,n_fed pFed_sk (n,k)= trcr (i,j,nt_bgc_Fed(k), iblk) enddo - do k = 1,n_fep + do k = 1,n_fep pFep_sk (n,k)= trcr (i,j,nt_bgc_Fep(k), iblk) enddo endif if (tr_bgc_Nit) then - pNit_sk(n) = trcr (i,j, nt_bgc_Nit, iblk) - pflux_NO(n) = flux_bio(i,j,nlt_bgc_Nit, iblk)*mps_to_cmpdy/c100 + pNit_sk(n) = trcr (i,j, nt_bgc_Nit, iblk) + pflux_NO(n) = flux_bio(i,j,nlt_bgc_Nit, iblk)*mps_to_cmpdy/c100 endif if (tr_bgc_Am) then pAm_sk(n) = trcr (i,j, nt_bgc_Am, iblk) - pflux_Am(n) = flux_bio(i,j,nlt_bgc_Am, iblk)*mps_to_cmpdy/c100 + pflux_Am(n) = flux_bio(i,j,nlt_bgc_Am, iblk)*mps_to_cmpdy/c100 endif if (tr_bgc_Sil) then - pSil_sk(n) = trcr (i,j, nt_bgc_Sil, iblk) + pSil_sk(n) = trcr (i,j, nt_bgc_Sil, iblk) endif if (tr_bgc_hum) then - phum_sk(n) = trcr (i,j, nt_bgc_hum, iblk) - pflux_hum(n)= flux_bio(i,j,nlt_bgc_hum, iblk)*mps_to_cmpdy/c100 + phum_sk(n) = trcr (i,j, nt_bgc_hum, iblk) + pflux_hum(n)= flux_bio(i,j,nlt_bgc_hum, iblk)*mps_to_cmpdy/c100 endif if (tr_bgc_DMS) then pDMSPp_sk(n) = trcr (i,j,nt_bgc_DMSPp,iblk) @@ -419,26 +419,26 @@ subroutine bgc_diags pflux_atm_zaero(n,:) = c0 pflux_snow_zaero(n,:) = c0 if (tr_bgc_Nit) then - pflux_NO(n) = flux_bio(i,j,nlt_bgc_Nit,iblk)*mps_to_cmpdy/c100 - pflux_atm_NO(n) = fbio_atmice(i,j,nlt_bgc_Nit,iblk)*mps_to_cmpdy/c100 + pflux_NO(n) = flux_bio(i,j,nlt_bgc_Nit,iblk)*mps_to_cmpdy/c100 + pflux_atm_NO(n) = fbio_atmice(i,j,nlt_bgc_Nit,iblk)*mps_to_cmpdy/c100 pflux_snow_NO(n) = fbio_snoice(i,j,nlt_bgc_Nit,iblk)*mps_to_cmpdy/c100 endif if (tr_bgc_Am) then - pflux_Am(n) = flux_bio(i,j,nlt_bgc_Am,iblk)*mps_to_cmpdy/c100 - pflux_atm_Am(n) = fbio_atmice(i,j,nlt_bgc_Am,iblk)*mps_to_cmpdy/c100 + pflux_Am(n) = flux_bio(i,j,nlt_bgc_Am,iblk)*mps_to_cmpdy/c100 + pflux_atm_Am(n) = fbio_atmice(i,j,nlt_bgc_Am,iblk)*mps_to_cmpdy/c100 pflux_snow_Am(n) = fbio_snoice(i,j,nlt_bgc_Am,iblk)*mps_to_cmpdy/c100 - endif + endif if (tr_bgc_hum) then - pflux_hum(n) = flux_bio(i,j,nlt_bgc_hum,iblk)*mps_to_cmpdy/c100 + pflux_hum(n) = flux_bio(i,j,nlt_bgc_hum,iblk)*mps_to_cmpdy/c100 endif if (tr_bgc_N) then do k = 1,n_algae - pflux_N(n,k) = flux_bio(i,j,nlt_bgc_N(k),iblk)*mps_to_cmpdy/c100 + pflux_N(n,k) = flux_bio(i,j,nlt_bgc_N(k),iblk)*mps_to_cmpdy/c100 enddo endif if (tr_zaero) then do k = 1,n_zaero - pflux_zaero(n,k) = flux_bio(i,j,nlt_zaero(k),iblk)*mps_to_cmpdy/c100 + pflux_zaero(n,k) = flux_bio(i,j,nlt_zaero(k),iblk)*mps_to_cmpdy/c100 pflux_atm_zaero_s(n,k)= flux_bio_atm(i,j,nlt_zaero(k),iblk)*mps_to_cmpdy/c100 !*aice pflux_atm_zaero(n,k) = fbio_atmice(i,j,nlt_zaero(k),iblk)*mps_to_cmpdy/c100 pflux_snow_zaero(n,k) = fbio_snoice(i,j,nlt_zaero(k),iblk)*mps_to_cmpdy/c100 @@ -465,35 +465,35 @@ subroutine bgc_diags pPON(n,k) = c0 phum(n,k) = c0 pNO(n,k) = c0 - if (tr_bgc_Nit) pNO(n,k) = trcr(i,j,nt_bgc_Nit+k-1,iblk) - if (tr_bgc_Am) pAm(n,k) = trcr(i,j,nt_bgc_Am+k-1,iblk) + if (tr_bgc_Nit) pNO(n,k) = trcr(i,j,nt_bgc_Nit+k-1,iblk) + if (tr_bgc_Am) pAm(n,k) = trcr(i,j,nt_bgc_Am+k-1,iblk) if (tr_bgc_N) then do nn = 1, n_algae pN(n,k,nn) = trcr(i,j,nt_bgc_N(nn)+k-1,iblk) - enddo - endif + enddo + endif if (tr_bgc_C) then do nn = 1, n_doc pDOC(n,k,nn) = trcr(i,j,nt_bgc_DOC(nn)+k-1,iblk) - enddo - endif + enddo + endif if (tr_bgc_DON) then do nn = 1, n_don pDON(n,k,nn) = trcr(i,j,nt_bgc_DON(nn)+k-1,iblk) - enddo - endif + enddo + endif if (tr_bgc_Fe) then do nn = 1, n_fed pFed(n,k,nn) = trcr(i,j,nt_bgc_Fed(nn)+k-1,iblk) - enddo + enddo do nn = 1, n_fep pFep(n,k,nn) = trcr(i,j,nt_bgc_Fep(nn)+k-1,iblk) - enddo - endif + enddo + endif if (tr_zaero) then do nn = 1, n_zaero pzaero(n,k,nn) = trcr(i,j,nt_zaero(nn)+k-1,iblk) - enddo + enddo endif if (tr_bgc_PON) pPON(n,k) = trcr(i,j,nt_bgc_PON+k-1,iblk) if (tr_bgc_hum) phum(n,k) = trcr(i,j,nt_bgc_hum+k-1,iblk) @@ -515,7 +515,7 @@ subroutine bgc_diags pPONs(n,k) = c0 phums(n,k) = c0 pNOs(n,k) = c0 - if (tr_bgc_Nit) pNOs(n,k) = trcr(i,j,nt_bgc_Nit+nblyr+k,iblk) + if (tr_bgc_Nit) pNOs(n,k) = trcr(i,j,nt_bgc_Nit+nblyr+k,iblk) if (tr_bgc_Am) pAms(n,k) = trcr(i,j,nt_bgc_Am+nblyr+k,iblk) if (tr_bgc_N) then do nn = 1, n_algae @@ -533,10 +533,10 @@ subroutine bgc_diags enddo endif if (tr_bgc_Fe ) then - do nn = 1, n_fed + do nn = 1, n_fed pFeds(n,k,nn) = trcr(i,j,nt_bgc_Fed(nn)+nblyr+k,iblk) enddo - do nn = 1, n_fep + do nn = 1, n_fep pFeps(n,k,nn) = trcr(i,j,nt_bgc_Fep(nn)+nblyr+k,iblk) enddo endif @@ -547,7 +547,7 @@ subroutine bgc_diags endif if (tr_bgc_PON)pPONs(n,k) =trcr(i,j,nt_bgc_PON+nblyr+k,iblk) if (tr_bgc_hum)phums(n,k) =trcr(i,j,nt_bgc_hum+nblyr+k,iblk) - enddo !k + enddo !k endif pchlsw(n,:) = c0 pzaerosw(n,:,:) = c0 @@ -560,17 +560,17 @@ subroutine bgc_diags enddo endif enddo - endif ! dEdd_algae + endif ! dEdd_algae endif ! my_task = pmloc - - call broadcast_scalar (pNit_ac (n), pmloc(n)) - call broadcast_scalar (pAm_ac (n), pmloc(n)) - call broadcast_scalar (pSil_ac (n), pmloc(n)) - call broadcast_scalar (phum_ac (n), pmloc(n)) - call broadcast_scalar (pDMSP_ac (n), pmloc(n)) - call broadcast_scalar (pDMS_ac (n), pmloc(n)) - call broadcast_scalar (pflux_NO (n), pmloc(n)) - call broadcast_scalar (pflux_Am (n), pmloc(n)) + + call broadcast_scalar (pNit_ac (n), pmloc(n)) + call broadcast_scalar (pAm_ac (n), pmloc(n)) + call broadcast_scalar (pSil_ac (n), pmloc(n)) + call broadcast_scalar (phum_ac (n), pmloc(n)) + call broadcast_scalar (pDMSP_ac (n), pmloc(n)) + call broadcast_scalar (pDMS_ac (n), pmloc(n)) + call broadcast_scalar (pflux_NO (n), pmloc(n)) + call broadcast_scalar (pflux_Am (n), pmloc(n)) call broadcast_scalar (pflux_hum (n), pmloc(n)) call broadcast_array (pN_ac (n,:), pmloc(n)) call broadcast_array (pflux_N (n,:), pmloc(n)) @@ -578,8 +578,8 @@ subroutine bgc_diags call broadcast_array (pDON_ac (n,:), pmloc(n)) call broadcast_array (pFed_ac (n,:), pmloc(n)) call broadcast_array (pFep_ac (n,:), pmloc(n)) - call broadcast_array (pchlsw (n,:), pmloc(n)) - call broadcast_array (pzaerosw (n,:,:), pmloc(n)) + call broadcast_array (pchlsw (n,:), pmloc(n)) + call broadcast_array (pzaerosw (n,:,:), pmloc(n)) if (skl_bgc) then ! skl_bgc call broadcast_array (pN_sk (n,:), pmloc(n)) call broadcast_array (pDOC_sk (n,:), pmloc(n)) @@ -587,24 +587,24 @@ subroutine bgc_diags call broadcast_array (pFed_sk (n,:), pmloc(n)) call broadcast_array (pFep_sk (n,:), pmloc(n)) - call broadcast_scalar(pNit_sk (n), pmloc(n)) - call broadcast_scalar(pAm_sk (n), pmloc(n)) - call broadcast_scalar(pSil_sk (n), pmloc(n)) - call broadcast_scalar(phum_sk (n), pmloc(n)) - call broadcast_scalar(pDMSPp_sk (n), pmloc(n)) - call broadcast_scalar(pDMSPd_sk (n), pmloc(n)) - call broadcast_scalar(pDMS_sk (n), pmloc(n)) + call broadcast_scalar(pNit_sk (n), pmloc(n)) + call broadcast_scalar(pAm_sk (n), pmloc(n)) + call broadcast_scalar(pSil_sk (n), pmloc(n)) + call broadcast_scalar(phum_sk (n), pmloc(n)) + call broadcast_scalar(pDMSPp_sk (n), pmloc(n)) + call broadcast_scalar(pDMSPd_sk (n), pmloc(n)) + call broadcast_scalar(pDMS_sk (n), pmloc(n)) endif !tr_bgc_sk if (z_tracers) then ! z_bgc - call broadcast_array (pN_tot (n,:), pmloc(n)) - call broadcast_array (pflux_zaero (n,:), pmloc(n)) - call broadcast_array (pflux_atm_zaero_s(n,:), pmloc(n)) - call broadcast_array (pflux_atm_zaero (n,:), pmloc(n)) + call broadcast_array (pN_tot (n,:), pmloc(n)) + call broadcast_array (pflux_zaero (n,:), pmloc(n)) + call broadcast_array (pflux_atm_zaero_s(n,:), pmloc(n)) + call broadcast_array (pflux_atm_zaero (n,:), pmloc(n)) call broadcast_array (pflux_snow_zaero (n,:), pmloc(n)) - call broadcast_scalar(pflux_atm_NO (n), pmloc(n)) - call broadcast_scalar(pflux_atm_Am (n), pmloc(n)) - call broadcast_scalar(pflux_snow_NO (n), pmloc(n)) + call broadcast_scalar(pflux_atm_NO (n), pmloc(n)) + call broadcast_scalar(pflux_atm_Am (n), pmloc(n)) + call broadcast_scalar(pflux_snow_NO (n), pmloc(n)) call broadcast_scalar(pflux_snow_Am (n), pmloc(n)) call broadcast_scalar(pgrow_net (n), pmloc(n)) call broadcast_array (pzfswin (n,:), pmloc(n)) @@ -623,12 +623,12 @@ subroutine bgc_diags call broadcast_array (pAms (n,:), pmloc(n)) call broadcast_array (pPONs (n,:), pmloc(n)) call broadcast_array (phums (n,:), pmloc(n)) - call broadcast_array (pNs (n,:,:), pmloc(n)) - call broadcast_array (pDOCs (n,:,:), pmloc(n)) - call broadcast_array (pDONs (n,:,:), pmloc(n)) - call broadcast_array (pFeds (n,:,:), pmloc(n)) - call broadcast_array (pFeps (n,:,:), pmloc(n)) - call broadcast_array (pzaeros (n,:,:), pmloc(n)) + call broadcast_array (pNs (n,:,:), pmloc(n)) + call broadcast_array (pDOCs (n,:,:), pmloc(n)) + call broadcast_array (pDONs (n,:,:), pmloc(n)) + call broadcast_array (pFeds (n,:,:), pmloc(n)) + call broadcast_array (pFeps (n,:,:), pmloc(n)) + call broadcast_array (pzaeros (n,:,:), pmloc(n)) endif ! z_tracers enddo ! npnt endif ! print_points @@ -649,14 +649,14 @@ subroutine bgc_diags if (z_tracers) then write(nu_diag,803) 'zfswin(1) PAR ','zfswin(2) PAR ' write(nu_diag,*) '---------------------------------------------------' - write(nu_diag,802) ((pzfswin(n,k),n=1,2), k = 1,nblyr+1) - write(nu_diag,*) ' ' + write(nu_diag,802) ((pzfswin(n,k),n=1,2), k = 1,nblyr+1) + write(nu_diag,*) ' ' write(nu_diag,803) 'Losses: Zoo(1)(mmol/m^3) ','Zoo(2)' write(nu_diag,803) ' Brine Conc. ',' Brine Conc' write(nu_diag,*) '---------------------------------------------------' - write(nu_diag,802) ((pZoo(n,k),n=1,2), k = 1,nblyr+1) - write(nu_diag,*) ' ' - endif + write(nu_diag,802) ((pZoo(n,k),n=1,2), k = 1,nblyr+1) + write(nu_diag,*) ' ' + endif if (tr_bgc_Nit) then write(nu_diag,*) '---------------------------------------------------' write(nu_diag,*) ' nitrate conc. (mmol/m^3) or flux (mmol/m^2/d)' @@ -669,17 +669,17 @@ subroutine bgc_diags write(nu_diag,900) 'snow-ice flux = ',pflux_snow_NO(1),pflux_snow_NO(2) write(nu_diag,*) ' snow + ice conc' write(nu_diag,803) ' nitrate(1)',' nitrate(2)' - write(nu_diag,802) ((pNOs(n,k),n=1,2), k = 1,2) - write(nu_diag,802) ((pNO(n,k),n=1,2), k = 1,nblyr+1) - write(nu_diag,*) ' ' + write(nu_diag,802) ((pNOs(n,k),n=1,2), k = 1,2) + write(nu_diag,802) ((pNO(n,k),n=1,2), k = 1,nblyr+1) + write(nu_diag,*) ' ' endif endif if (tr_bgc_PON .and. z_tracers) then write(nu_diag,*) '---------------------------------------------------' write(nu_diag,*) ' PON snow + ice conc. (mmol/m^3)' write(nu_diag,803) ' PON(1)',' PON(2)' - write(nu_diag,802) ((pPONs(n,k),n=1,2), k = 1,2) - write(nu_diag,802) ((pPON(n,k),n=1,2), k = 1,nblyr+1) + write(nu_diag,802) ((pPONs(n,k),n=1,2), k = 1,2) + write(nu_diag,802) ((pPON(n,k),n=1,2), k = 1,nblyr+1) write(nu_diag,*) ' ' endif if (tr_bgc_hum) then @@ -691,8 +691,8 @@ subroutine bgc_diags write(nu_diag,900) 'Bulk ice conc. = ',phum_sk(1),phum_sk(2) elseif (z_tracers) then write(nu_diag,803) ' hum(1)',' hum(2)' - write(nu_diag,802) ((phums(n,k),n=1,2), k = 1,2) - write(nu_diag,802) ((phum(n,k),n=1,2), k = 1,nblyr+1) + write(nu_diag,802) ((phums(n,k),n=1,2), k = 1,2) + write(nu_diag,802) ((phum(n,k),n=1,2), k = 1,nblyr+1) write(nu_diag,*) ' ' endif endif @@ -708,14 +708,14 @@ subroutine bgc_diags write(nu_diag,900) 'snow-ice flux = ',pflux_snow_Am(1),pflux_snow_Am(2) write(nu_diag,*) ' snow + ice conc.' write(nu_diag,803) ' ammonium(1)',' ammonium (2)' - write(nu_diag,802) ((pAms(n,k),n=1,2), k = 1,2) - write(nu_diag,802) ((pAm(n,k),n=1,2), k = 1,nblyr+1) - write(nu_diag,*) ' ' + write(nu_diag,802) ((pAms(n,k),n=1,2), k = 1,2) + write(nu_diag,802) ((pAm(n,k),n=1,2), k = 1,nblyr+1) + write(nu_diag,*) ' ' endif endif if (tr_bgc_N) then write(nu_diag,*) '---------------------------------------------------' - write(nu_diag,901) 'tot algal growth (1/d) = ',pgrow_net(1),pgrow_net(2) + write(nu_diag,900) 'tot algal growth (1/d) = ',pgrow_net(1),pgrow_net(2) do kk = 1,n_algae write(nu_diag,*) ' algal conc. (mmol N/m^3) or flux (mmol N/m^2/d)' write(nu_diag,1020) ' type:', kk @@ -727,9 +727,9 @@ subroutine bgc_diags write(nu_diag,900) 'Tot ice (mmolN/m^2) = ',pN_tot(1,kk),pN_tot(2,kk) write(nu_diag,*) ' snow + ice conc.' write(nu_diag,803) ' algal N(1)',' algal N(2) ' - write(nu_diag,802) ((pNs(n,k,kk),n=1,2), k = 1,2) - write(nu_diag,802) ((pN(n,k,kk),n=1,2), k = 1,nblyr+1) - write(nu_diag,*) ' ' + write(nu_diag,802) ((pNs(n,k,kk),n=1,2), k = 1,2) + write(nu_diag,802) ((pN(n,k,kk),n=1,2), k = 1,nblyr+1) + write(nu_diag,*) ' ' endif enddo endif @@ -744,9 +744,9 @@ subroutine bgc_diags elseif (z_tracers) then write(nu_diag,*) ' snow + ice conc.' write(nu_diag,803) ' DOC(1)',' DOC(2) ' - write(nu_diag,802) ((pDOCs(n,k,kk),n=1,2), k = 1,2) - write(nu_diag,802) ((pDOC(n,k,kk),n=1,2), k = 1,nblyr+1) - write(nu_diag,*) ' ' + write(nu_diag,802) ((pDOCs(n,k,kk),n=1,2), k = 1,2) + write(nu_diag,802) ((pDOC(n,k,kk),n=1,2), k = 1,nblyr+1) + write(nu_diag,*) ' ' endif enddo endif @@ -761,9 +761,9 @@ subroutine bgc_diags elseif (z_tracers) then write(nu_diag,*) ' snow + ice conc.' write(nu_diag,803) ' DON(1)',' DON(2) ' - write(nu_diag,802) ((pDONs(n,k,kk),n=1,2), k = 1,2) - write(nu_diag,802) ((pDON(n,k,kk),n=1,2), k = 1,nblyr+1) - write(nu_diag,*) ' ' + write(nu_diag,802) ((pDONs(n,k,kk),n=1,2), k = 1,2) + write(nu_diag,802) ((pDON(n,k,kk),n=1,2), k = 1,nblyr+1) + write(nu_diag,*) ' ' endif enddo endif @@ -778,9 +778,9 @@ subroutine bgc_diags elseif (z_tracers) then write(nu_diag,*) ' snow + ice conc.' write(nu_diag,803) ' Fed (1)',' Fed (2) ' - write(nu_diag,802) ((pFeds (n,k,kk),n=1,2), k = 1,2) - write(nu_diag,802) ((pFed (n,k,kk),n=1,2), k = 1,nblyr+1) - write(nu_diag,*) ' ' + write(nu_diag,802) ((pFeds (n,k,kk),n=1,2), k = 1,2) + write(nu_diag,802) ((pFed (n,k,kk),n=1,2), k = 1,nblyr+1) + write(nu_diag,*) ' ' endif enddo do kk = 1,n_fep @@ -793,9 +793,9 @@ subroutine bgc_diags elseif (z_tracers) then write(nu_diag,*) ' snow + ice conc.' write(nu_diag,803) ' Fep (1)',' Fep (2) ' - write(nu_diag,802) ((pFeps (n,k,kk),n=1,2), k = 1,2) - write(nu_diag,802) ((pFep (n,k,kk),n=1,2), k = 1,nblyr+1) - write(nu_diag,*) ' ' + write(nu_diag,802) ((pFeps (n,k,kk),n=1,2), k = 1,2) + write(nu_diag,802) ((pFep (n,k,kk),n=1,2), k = 1,nblyr+1) + write(nu_diag,*) ' ' endif enddo endif @@ -807,7 +807,7 @@ subroutine bgc_diags if (skl_bgc) then write(nu_diag,900) 'Ice DMSPp = ',pDMSPp_sk(1),pDMSPp_sk(2) write(nu_diag,900) 'Ice DMSPd = ',pDMSPd_sk(1),pDMSPd_sk(2) - write(nu_diag,900) 'Ice DMS = ',pDMS_sk(1),pDMS_sk(2) + write(nu_diag,900) 'Ice DMS = ',pDMS_sk(1),pDMS_sk(2) endif endif if (tr_zaero .and. z_tracers) then @@ -821,8 +821,8 @@ subroutine bgc_diags write(nu_diag,900) 'snow-ice flux*aice = ',pflux_snow_zaero(1,kk),pflux_snow_zaero(2,kk) write(nu_diag,*) ' snow + ice conc.' write(nu_diag,803) ' aerosol(1)',' aerosol(2) ' - write(nu_diag,802) ((pzaeros(n,k,kk),n=1,2), k = 1,2) - write(nu_diag,802) ((pzaero(n,k,kk),n=1,2), k = 1,nblyr+1) + write(nu_diag,802) ((pzaeros(n,k,kk),n=1,2), k = 1,2) + write(nu_diag,802) ((pzaero(n,k,kk),n=1,2), k = 1,nblyr+1) write(nu_diag,*) ' ' enddo endif @@ -830,27 +830,248 @@ subroutine bgc_diags if (tr_zaero) then do kk = 1,n_zaero write(nu_diag,*) '---------------------------------------------------' - write(nu_diag,*) ' Cat 1 aerosol conc. (kg/m^3) on delta-Eddington grid ' - write(nu_diag,802) ((pzaerosw(n,k,kk),n=1,2), k = 1,klev +1) + write(nu_diag,*) ' Cat 1 aerosol conc. (kg/m^3) on delta-Eddington grid ' + write(nu_diag,802) ((pzaerosw(n,k,kk),n=1,2), k = 1,klev +1) enddo endif if (tr_bgc_N) then write(nu_diag,*) '---------------------------------------------------' - write(nu_diag,*) ' Cat 1 chl (mg/m^3) on delta-Eddington grid ' - write(nu_diag,802) ((pchlsw(n,k),n=1,2), k = 1,klev +1) + write(nu_diag,*) ' Cat 1 chl (mg/m^3) on delta-Eddington grid ' + write(nu_diag,802) ((pchlsw(n,k),n=1,2), k = 1,klev +1) endif endif endif ! print_points - endif ! my_task = master_task + endif ! my_task = master_task 802 format (f24.17,2x,f24.17) 803 format (a25,2x,a25) 900 format (a25,2x,f24.17,2x,f24.17) - 901 format (a25,2x,g24.17,2x,g24.17) + 902 format (a25,10x,f6.1,1x,f6.1,9x,f6.1,1x,f6.1) 1020 format (a30,2x,i6) ! integer end subroutine bgc_diags +!======================================================================= +! +! Writes diagnostic info (max, min, global sums, etc) to standard out +! +! authors: Elizabeth C. Hunke, LANL +! Bruce P. Briegleb, NCAR +! Cecilia M. Bitz, UW +! Nicole Jeffery, LANL + + subroutine zsal_diags + + use ice_arrays_column, only: fzsal, fzsal_g, sice_rho, bTiz, & + iDi, bphi, dhbr_top, dhbr_bot, darcy_V + use ice_broadcast, only: broadcast_scalar, broadcast_array + use ice_diagnostics, only: npnt, print_points, pmloc, piloc, pjloc, & + pbloc + use ice_domain_size, only: nblyr, ncat, nilyr + use ice_state, only: aicen, aice, vice, trcr, trcrn, vicen, vsno + + ! local variables + + integer (kind=int_kind) :: & + i, j, k, n, nn, iblk + + ! fields at diagnostic points + real (kind=dbl_kind), dimension(npnt) :: & + phinS, phinS1,& + phbrn,pdh_top1,pdh_bot1, psice_rho, pfzsal, & + pfzsal_g, pdarcy_V1 + + ! vertical fields of category 1 at diagnostic points for bgc layer model + real (kind=dbl_kind), dimension(npnt,nblyr+2) :: & + pphin, pphin1 + real (kind=dbl_kind), dimension(npnt,nblyr) :: & + pSin, pSice, pSin1 + + real (kind=dbl_kind), dimension(npnt,nblyr+1) :: & + pbTiz, piDin + + real (kind=dbl_kind) :: & + rhosi, rhow, rhos + + logical (kind=log_kind) :: tr_brine + + integer (kind=int_kind) :: nt_fbri, nt_bgc_S, nt_sice + character(len=*), parameter :: subname = '(zsal_diags)' + + call icepack_query_parameters(rhosi_out=rhosi, rhow_out=rhow, rhos_out=rhos) + call icepack_query_tracer_flags(tr_brine_out=tr_brine) + call icepack_query_tracer_indices(nt_fbri_out=nt_fbri, nt_bgc_S_out=nt_bgc_S, & + nt_sice_out=nt_sice) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + + !----------------------------------------------------------------- + ! salinity and microstructure of the ice + !----------------------------------------------------------------- + + if (print_points) then + + !----------------------------------------------------------------- + ! state of the ice and associated fluxes for 2 defined points + ! NOTE these are computed for the last timestep only (not avg) + !----------------------------------------------------------------- + + do n = 1, npnt + if (my_task == pmloc(n)) then + i = piloc(n) + j = pjloc(n) + iblk = pbloc(n) + + pfzsal(n) = fzsal(i,j,iblk) + pfzsal_g(n) = fzsal_g(i,j,iblk) + phinS(n) = c0 + phinS1(n) = c0 + phbrn(n) = c0 + psice_rho(n) = c0 + pdh_top1(n) = c0 + pdh_bot1(n) = c0 + pdarcy_V1(n) = c0 + do nn = 1,ncat + psice_rho(n) = psice_rho(n) + sice_rho(i,j,nn,iblk)*aicen(i,j,nn,iblk) + enddo + if (aice(i,j,iblk) > c0) & + psice_rho(n) = psice_rho(n)/aice(i,j,iblk) + if (tr_brine .and. aice(i,j,iblk) > c0) then + phinS(n) = trcr(i,j,nt_fbri,iblk)*vice(i,j,iblk)/aice(i,j,iblk) + phbrn(n) = (c1 - rhosi/rhow)*vice(i,j,iblk)/aice(i,j,iblk) & + - rhos/rhow *vsno(i,j,iblk)/aice(i,j,iblk) + endif + if (tr_brine .and. aicen(i,j,1,iblk)> c0) then + phinS1(n) = trcrn(i,j,nt_fbri,1,iblk) & + * vicen(i,j,1,iblk)/aicen(i,j,1,iblk) + pdh_top1(n) = dhbr_top(i,j,1,iblk) + pdh_bot1(n) = dhbr_bot(i,j,1,iblk) + pdarcy_V1(n) = darcy_V(i,j,1,iblk) + endif + do k = 1, nblyr+1 + pbTiz(n,k) = c0 + piDin(n,k) = c0 + do nn = 1,ncat + pbTiz(n,k) = pbTiz(n,k) + bTiz(i,j,k,nn,iblk)*vicen(i,j,nn,iblk) + piDin(n,k) = piDin(n,k) + iDi(i,j,k,nn,iblk)*vicen(i,j,nn,iblk) + enddo + if (vice(i,j,iblk) > c0) then + pbTiz(n,k) = pbTiz(n,k)/vice(i,j,iblk) + piDin(n,k) = piDin(n,k)/vice(i,j,iblk) + endif + enddo ! k + do k = 1, nblyr+2 + pphin(n,k) = c0 + pphin1(n,k) = c0 + if (aicen(i,j,1,iblk) > c0) pphin1(n,k) = bphi(i,j,k,1,iblk) + do nn = 1,ncat + pphin(n,k) = pphin(n,k) + bphi(i,j,k,nn,iblk)*vicen(i,j,nn,iblk) + enddo + if (vice(i,j,iblk) > c0) then + pphin(n,k) = pphin(n,k)/vice(i,j,iblk) + endif + enddo + do k = 1,nblyr + pSin(n,k) = c0 + pSin1(n,k) = c0 + pSin(n,k)= trcr(i,j,nt_bgc_S+k-1,iblk) + if (aicen(i,j,1,iblk) > c0) pSin1(n,k) = trcrn(i,j,nt_bgc_S+k-1,1,iblk) + enddo + do k = 1,nilyr + pSice(n,k) = trcr(i,j,nt_sice+k-1,iblk) + enddo + endif ! my_task = pmloc + + call broadcast_scalar(phinS (n), pmloc(n)) + call broadcast_scalar(phinS1 (n), pmloc(n)) + call broadcast_scalar(phbrn (n), pmloc(n)) + call broadcast_scalar(pdh_top1 (n), pmloc(n)) + call broadcast_scalar(pdh_bot1 (n), pmloc(n)) + call broadcast_scalar(psice_rho(n), pmloc(n)) + call broadcast_scalar(pfzsal_g (n), pmloc(n)) + call broadcast_scalar(pdarcy_V1(n), pmloc(n)) + call broadcast_scalar(pfzsal (n), pmloc(n)) + call broadcast_array (pbTiz (n,:), pmloc(n)) + call broadcast_array (piDin (n,:), pmloc(n)) + call broadcast_array (pphin (n,:), pmloc(n)) + call broadcast_array (pphin1 (n,:), pmloc(n)) + call broadcast_array (pSin (n,:), pmloc(n)) + call broadcast_array (pSin1 (n,:), pmloc(n)) + call broadcast_array (pSice (n,:), pmloc(n)) + enddo ! npnt + endif ! print_points + + !----------------------------------------------------------------- + ! start spewing + !----------------------------------------------------------------- + + if (my_task == master_task) then + + call flush_fileunit(nu_diag) + + !----------------------------------------------------------------- + ! diagnostics for Arctic and Antarctic points + !----------------------------------------------------------------- + + if (print_points) then + + write(nu_diag,*) ' ' + write(nu_diag,902) ' Brine height ' + write(nu_diag,900) 'hbrin = ',phinS(1),phinS(2) + write(nu_diag,900) 'hbrin cat 1 = ',phinS1(1),phinS1(2) + write(nu_diag,900) 'Freeboard = ',phbrn(1),phbrn(2) + write(nu_diag,900) 'dhbrin cat 1 top = ',pdh_top1(1),pdh_top1(2) + write(nu_diag,900) 'dhbrin cat 1 bottom = ',pdh_bot1(1),pdh_bot1(2) + write(nu_diag,*) ' ' + write(nu_diag,902) ' zSalinity ' + write(nu_diag,900) 'Avg density (kg/m^3) = ',psice_rho(1),psice_rho(2) + write(nu_diag,900) 'Salt flux (kg/m^2/s) = ',pfzsal(1),pfzsal(2) + write(nu_diag,900) 'Grav. Drain. Salt flux = ',pfzsal_g(1),pfzsal_g(2) + write(nu_diag,900) 'Darcy V cat 1 (m/s) = ',pdarcy_V1(1),pdarcy_V1(2) + write(nu_diag,*) ' ' + write(nu_diag,*) ' Top down bgc Layer Model' + write(nu_diag,*) ' ' + write(nu_diag,803) 'bTiz(1) ice temp',' bTiz(2) ice temp ' + write(nu_diag,*) '---------------------------------------------------' + write(nu_diag,802) ((pbTiz(n,k),n = 1,2), k = 1,nblyr+1) + write(nu_diag,*) ' ' + write(nu_diag,803) 'iDi(1) diffusivity ','iDi(2) diffusivity ' + write(nu_diag,*) '---------------------------------------------------' + write(nu_diag,802) ((piDin(n,k),n=1,2), k = 1,nblyr+1) + write(nu_diag,*) ' ' + write(nu_diag,803) 'bphi(1) porosity ','bphi(2) porosity ' + write(nu_diag,*) '---------------------------------------------------' + write(nu_diag,802) ((pphin(n,k),n=1,2), k = 1,nblyr+1) + write(nu_diag,*) ' ' + write(nu_diag,803) 'phi1(1) porosity ','phi1(2) porosity ' + write(nu_diag,*) '---------------------------------------------------' + write(nu_diag,802) ((pphin1(n,k),n=1,2), k = 1,nblyr+1) + write(nu_diag,*) ' ' + write(nu_diag,803) 'zsal(1) cat 1 ','zsal(2) cat 1 ' + write(nu_diag,*) '---------------------------------------------------' + write(nu_diag,802) ((pSin1(n,k),n=1,2), k = 1,nblyr) + write(nu_diag,*) ' ' + write(nu_diag,803) 'zsal(1) Avg S ','zsal(2) Avg S ' + write(nu_diag,*) '---------------------------------------------------' + write(nu_diag,802) ((pSin(n,k),n=1,2), k = 1,nblyr) + write(nu_diag,*) ' ' + write(nu_diag,803) 'Sice(1) Ice S ','Sice(2) Ice S ' + write(nu_diag,*) '---------------------------------------------------' + write(nu_diag,802) ((pSice(n,k),n=1,2), k = 1,nilyr) + write(nu_diag,*) ' ' + + endif ! print_points + endif ! my_task = master_task + + 802 format (f24.17,2x,f24.17) + 803 format (a25,2x,a25) + 900 format (a25,2x,f24.17,2x,f24.17) + 902 format (a25,10x,f6.1,1x,f6.1,9x,f6.1,1x,f6.1) + 903 format (a25,5x,i4,1x,i4,1x,i4,1x,i4,7x,i4,1x,i4,1x,i4,1x,i4) + + end subroutine zsal_diags + !======================================================================= end module ice_diagnostics_bgc diff --git a/cicecore/cicedyn/analysis/ice_history.F90 b/cicecore/cicedyn/analysis/ice_history.F90 index c50ec7b9f..0ecc2ee5a 100644 --- a/cicecore/cicedyn/analysis/ice_history.F90 +++ b/cicecore/cicedyn/analysis/ice_history.F90 @@ -32,7 +32,7 @@ module ice_history use ice_kinds_mod use ice_communicate, only: my_task, master_task use ice_constants, only: c0, c1, c2, c100, c360, c180, & - p001, p25, p5, mps_to_cmpdy, kg_to_g, spval + p001, p25, p5, mps_to_cmpdy, kg_to_g, spval_dbl use ice_fileunits, only: nu_nml, nml_filename, nu_diag, & get_fileunit, release_fileunit, flush_fileunit use ice_exit, only: abort_ice @@ -67,10 +67,11 @@ subroutine init_hist (dt) histfreq_n, nstreams use ice_domain_size, only: max_blocks, max_nstrm, nilyr, nslyr, nblyr, ncat, nfsd use ice_dyn_shared, only: kdyn - use ice_flux, only: mlt_onset, frz_onset, albcnt + use ice_flux, only: mlt_onset, frz_onset, albcnt, snwcnt use ice_history_shared ! everything use ice_history_mechred, only: init_hist_mechred_2D, init_hist_mechred_3Dc use ice_history_pond, only: init_hist_pond_2D, init_hist_pond_3Dc + use ice_history_snow, only: init_hist_snow_2D, init_hist_snow_3Dc use ice_history_bgc, only:init_hist_bgc_2D, init_hist_bgc_3Dc, & init_hist_bgc_3Db, init_hist_bgc_3Da use ice_history_drag, only: init_hist_drag_2D @@ -86,7 +87,7 @@ subroutine init_hist (dt) real (kind=dbl_kind) :: rhofresh, Tffresh, secday, rad_to_deg logical (kind=log_kind) :: formdrag logical (kind=log_kind) :: tr_iage, tr_FY, tr_lvl, tr_pond, tr_aero, tr_brine - logical (kind=log_kind) :: tr_fsd + logical (kind=log_kind) :: tr_fsd, tr_snow logical (kind=log_kind) :: skl_bgc, solve_zsal, solve_zbgc, z_tracers integer (kind=int_kind) :: n, ns, ns1, ns2 integer (kind=int_kind), dimension(max_nstrm) :: & @@ -115,7 +116,7 @@ subroutine init_hist (dt) solve_zsal_out=solve_zsal, solve_zbgc_out=solve_zbgc, z_tracers_out=z_tracers) call icepack_query_tracer_flags(tr_iage_out=tr_iage, tr_FY_out=tr_FY, & tr_lvl_out=tr_lvl, tr_pond_out=tr_pond, tr_aero_out=tr_aero, & - tr_brine_out=tr_brine, tr_fsd_out=tr_fsd) + tr_brine_out=tr_brine, 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__) @@ -1426,6 +1427,9 @@ subroutine init_hist (dt) ! floe size distribution call init_hist_fsd_2D + ! advanced snow physics + call init_hist_snow_2D (dt) + !----------------------------------------------------------------- ! 3D (category) variables looped separately for ordering !----------------------------------------------------------------- @@ -1501,6 +1505,9 @@ subroutine init_hist (dt) ! biogeochemistry call init_hist_bgc_3Dc + ! advanced snow physics + call init_hist_snow_3Dc + !----------------------------------------------------------------- ! 3D (vertical) variables must be looped separately !----------------------------------------------------------------- @@ -1688,6 +1695,7 @@ subroutine init_hist (dt) if (allocated(a4Df)) a4Df(:,:,:,:,:,:) = c0 avgct(:) = c0 albcnt(:,:,:,:) = c0 + snwcnt(:,:,:,:) = c0 if (restart .and. yday >= c2) then ! restarting midyear gives erroneous onset dates @@ -1726,7 +1734,7 @@ subroutine accum_hist (dt) fhocn, fhocn_ai, uatm, vatm, fbot, Tbot, Tsnice, & fswthru_ai, strairx, strairy, strtltx, strtlty, strintx, strinty, & taubx, tauby, strocnx, strocny, fm, daidtt, dvidtt, daidtd, dvidtd, fsurf, & - fcondtop, fcondbot, fsurfn, fcondtopn, flatn, fsensn, albcnt, & + fcondtop, fcondbot, fsurfn, fcondtopn, flatn, fsensn, albcnt, snwcnt, & stressp_1, stressm_1, stress12_1, & stressp_2, & stressp_3, & @@ -1739,6 +1747,8 @@ subroutine accum_hist (dt) use ice_history_bgc, only: accum_hist_bgc use ice_history_mechred, only: accum_hist_mechred use ice_history_pond, only: accum_hist_pond + use ice_history_snow, only: accum_hist_snow, & + f_rhos_cmp, f_rhos_cnt, n_rhos_cmp, n_rhos_cnt use ice_history_drag, only: accum_hist_drag use icepack_intfc, only: icepack_mushy_density_brine, icepack_mushy_liquid_fraction use icepack_intfc, only: icepack_mushy_temperature_mush @@ -1776,7 +1786,7 @@ subroutine accum_hist (dt) real (kind=dbl_kind) :: Tffresh, rhoi, rhos, rhow, ice_ref_salinity real (kind=dbl_kind) :: rho_ice, rho_ocn, Tice, Sbr, phi, rhob, dfresh, dfsalt logical (kind=log_kind) :: formdrag, skl_bgc - logical (kind=log_kind) :: tr_pond, tr_aero, tr_brine + logical (kind=log_kind) :: tr_pond, tr_aero, tr_brine, tr_snow integer (kind=int_kind) :: ktherm integer (kind=int_kind) :: nt_sice, nt_qice, nt_qsno, nt_iage, nt_FY, nt_Tsfc, & nt_alvl, nt_vlvl @@ -1792,7 +1802,7 @@ subroutine accum_hist (dt) rhow_out=rhow, ice_ref_salinity_out=ice_ref_salinity) call icepack_query_parameters(formdrag_out=formdrag, skl_bgc_out=skl_bgc, ktherm_out=ktherm) call icepack_query_tracer_flags(tr_pond_out=tr_pond, tr_aero_out=tr_aero, & - tr_brine_out=tr_brine) + tr_brine_out=tr_brine, tr_snow_out=tr_snow) call icepack_query_tracer_indices(nt_sice_out=nt_sice, nt_qice_out=nt_qice, & nt_qsno_out=nt_qsno, nt_iage_out=nt_iage, nt_FY_out=nt_FY, nt_Tsfc_out=nt_Tsfc, & nt_alvl_out=nt_alvl, nt_vlvl_out=nt_vlvl) @@ -3040,6 +3050,9 @@ subroutine accum_hist (dt) ! floe size distribution call accum_hist_fsd (iblk) + ! advanced snow physics + call accum_hist_snow (iblk) + enddo ! iblk !$OMP END PARALLEL DO @@ -3105,7 +3118,7 @@ subroutine accum_hist (dt) do j = jlo, jhi do i = ilo, ihi if (.not. tmask(i,j,iblk)) then ! mask out land points - a2D(i,j,n,iblk) = spval + a2D(i,j,n,iblk) = spval_dbl else ! convert units a2D(i,j,n,iblk) = avail_hist_fields(n)%cona*a2D(i,j,n,iblk) & * ravgct + avail_hist_fields(n)%conb @@ -3122,7 +3135,7 @@ subroutine accum_hist (dt) a2D(i,j,n_sithick(ns),iblk) = & a2D(i,j,n_sithick(ns),iblk)*avgct(ns)*ravgip(i,j) endif - if (ravgip(i,j) == c0) a2D(i,j,n_sithick(ns),iblk) = spval + if (ravgip(i,j) == c0) a2D(i,j,n_sithick(ns),iblk) = spval_dbl enddo ! i enddo ! j endif @@ -3135,7 +3148,7 @@ subroutine accum_hist (dt) a2D(i,j,n_siage(ns),iblk) = & a2D(i,j,n_siage(ns),iblk)*avgct(ns)*ravgip(i,j) endif - if (ravgip(i,j) == c0) a2D(i,j,n_siage(ns),iblk) = spval + if (ravgip(i,j) == c0) a2D(i,j,n_siage(ns),iblk) = spval_dbl enddo ! i enddo ! j endif @@ -3148,7 +3161,7 @@ subroutine accum_hist (dt) a2D(i,j,n_sisnthick(ns),iblk) = & a2D(i,j,n_sisnthick(ns),iblk)*avgct(ns)*ravgip(i,j) endif - if (ravgip(i,j) == c0) a2D(i,j,n_sisnthick(ns),iblk) = spval + if (ravgip(i,j) == c0) a2D(i,j,n_sisnthick(ns),iblk) = spval_dbl enddo ! i enddo ! j endif @@ -3161,7 +3174,7 @@ subroutine accum_hist (dt) a2D(i,j,n_sitemptop(ns),iblk) = & a2D(i,j,n_sitemptop(ns),iblk)*avgct(ns)*ravgip(i,j) endif - if (ravgip(i,j) == c0) a2D(i,j,n_sitemptop(ns),iblk) = spval + if (ravgip(i,j) == c0) a2D(i,j,n_sitemptop(ns),iblk) = spval_dbl enddo ! i enddo ! j endif @@ -3174,7 +3187,7 @@ subroutine accum_hist (dt) a2D(i,j,n_sitempsnic(ns),iblk) = & a2D(i,j,n_sitempsnic(ns),iblk)*avgct(ns)*ravgip(i,j) endif - if (ravgip(i,j) == c0) a2D(i,j,n_sitempsnic(ns),iblk) = spval + if (ravgip(i,j) == c0) a2D(i,j,n_sitempsnic(ns),iblk) = spval_dbl enddo ! i enddo ! j endif @@ -3187,7 +3200,7 @@ subroutine accum_hist (dt) a2D(i,j,n_sitempbot(ns),iblk) = & a2D(i,j,n_sitempbot(ns),iblk)*avgct(ns)*ravgip(i,j) endif - if (ravgip(i,j) == c0) a2D(i,j,n_sitempbot(ns),iblk) = spval + if (ravgip(i,j) == c0) a2D(i,j,n_sitempbot(ns),iblk) = spval_dbl enddo ! i enddo ! j endif @@ -3200,7 +3213,7 @@ subroutine accum_hist (dt) a2D(i,j,n_siu(ns),iblk) = & a2D(i,j,n_siu(ns),iblk)*avgct(ns)*ravgip(i,j) endif - if (ravgip(i,j) == c0) a2D(i,j,n_siu(ns),iblk) = spval + if (ravgip(i,j) == c0) a2D(i,j,n_siu(ns),iblk) = spval_dbl enddo ! i enddo ! j endif @@ -3213,7 +3226,7 @@ subroutine accum_hist (dt) a2D(i,j,n_siv(ns),iblk) = & a2D(i,j,n_siv(ns),iblk)*avgct(ns)*ravgip(i,j) endif - if (ravgip(i,j) == c0) a2D(i,j,n_siv(ns),iblk) = spval + if (ravgip(i,j) == c0) a2D(i,j,n_siv(ns),iblk) = spval_dbl enddo ! i enddo ! j endif @@ -3226,7 +3239,7 @@ subroutine accum_hist (dt) a2D(i,j,n_sistrxdtop(ns),iblk) = & a2D(i,j,n_sistrxdtop(ns),iblk)*avgct(ns)*ravgip(i,j) endif - if (ravgip(i,j) == c0) a2D(i,j,n_sistrxdtop(ns),iblk) = spval + if (ravgip(i,j) == c0) a2D(i,j,n_sistrxdtop(ns),iblk) = spval_dbl enddo ! i enddo ! j endif @@ -3239,7 +3252,7 @@ subroutine accum_hist (dt) a2D(i,j,n_sistrydtop(ns),iblk) = & a2D(i,j,n_sistrydtop(ns),iblk)*avgct(ns)*ravgip(i,j) endif - if (ravgip(i,j) == c0) a2D(i,j,n_sistrydtop(ns),iblk) = spval + if (ravgip(i,j) == c0) a2D(i,j,n_sistrydtop(ns),iblk) = spval_dbl enddo ! i enddo ! j endif @@ -3252,7 +3265,7 @@ subroutine accum_hist (dt) a2D(i,j,n_sistrxubot(ns),iblk) = & a2D(i,j,n_sistrxubot(ns),iblk)*avgct(ns)*ravgip(i,j) endif - if (ravgip(i,j) == c0) a2D(i,j,n_sistrxubot(ns),iblk) = spval + if (ravgip(i,j) == c0) a2D(i,j,n_sistrxubot(ns),iblk) = spval_dbl enddo ! i enddo ! j endif @@ -3265,7 +3278,7 @@ subroutine accum_hist (dt) a2D(i,j,n_sistryubot(ns),iblk) = & a2D(i,j,n_sistryubot(ns),iblk)*avgct(ns)*ravgip(i,j) endif - if (ravgip(i,j) == c0) a2D(i,j,n_sistryubot(ns),iblk) = spval + if (ravgip(i,j) == c0) a2D(i,j,n_sistryubot(ns),iblk) = spval_dbl enddo ! i enddo ! j endif @@ -3278,7 +3291,7 @@ subroutine accum_hist (dt) a2D(i,j,n_sicompstren(ns),iblk) = & a2D(i,j,n_sicompstren(ns),iblk)*avgct(ns)*ravgip(i,j) endif - if (ravgip(i,j) == c0) a2D(i,j,n_sicompstren(ns),iblk) = spval + if (ravgip(i,j) == c0) a2D(i,j,n_sicompstren(ns),iblk) = spval_dbl enddo ! i enddo ! j endif @@ -3291,7 +3304,7 @@ subroutine accum_hist (dt) a2D(i,j,n_sispeed(ns),iblk) = & a2D(i,j,n_sispeed(ns),iblk)*avgct(ns)*ravgip(i,j) endif - if (ravgip(i,j) == c0) a2D(i,j,n_sispeed(ns),iblk) = spval + if (ravgip(i,j) == c0) a2D(i,j,n_sispeed(ns),iblk) = spval_dbl enddo ! i enddo ! j endif @@ -3304,8 +3317,8 @@ subroutine accum_hist (dt) a2D(i,j,n_sialb(ns),iblk) = & a2D(i,j,n_sialb(ns),iblk)*avgct(ns)*ravgip(i,j) endif - if (ravgip(i,j) == c0) a2D(i,j,n_sialb(ns),iblk) = spval - if (albcnt(i,j,iblk,ns) <= puny) a2D(i,j,n_sialb(ns),iblk) = spval + if (ravgip(i,j) == c0) a2D(i,j,n_sialb(ns),iblk) = spval_dbl + if (albcnt(i,j,iblk,ns) <= puny) a2D(i,j,n_sialb(ns),iblk) = spval_dbl enddo ! i enddo ! j endif @@ -3318,7 +3331,7 @@ subroutine accum_hist (dt) a2D(i,j,n_siflswdtop(ns),iblk) = & a2D(i,j,n_siflswdtop(ns),iblk)*avgct(ns)*ravgip(i,j) endif - if (ravgip(i,j) == c0) a2D(i,j,n_siflswdtop(ns),iblk) = spval + if (ravgip(i,j) == c0) a2D(i,j,n_siflswdtop(ns),iblk) = spval_dbl enddo ! i enddo ! j endif @@ -3331,7 +3344,7 @@ subroutine accum_hist (dt) a2D(i,j,n_siflswutop(ns),iblk) = & a2D(i,j,n_siflswutop(ns),iblk)*avgct(ns)*ravgip(i,j) endif - if (ravgip(i,j) == c0) a2D(i,j,n_siflswutop(ns),iblk) = spval + if (ravgip(i,j) == c0) a2D(i,j,n_siflswutop(ns),iblk) = spval_dbl enddo ! i enddo ! j endif @@ -3344,7 +3357,7 @@ subroutine accum_hist (dt) a2D(i,j,n_siflswdbot(ns),iblk) = & a2D(i,j,n_siflswdbot(ns),iblk)*avgct(ns)*ravgip(i,j) endif - if (ravgip(i,j) == c0) a2D(i,j,n_siflswdbot(ns),iblk) = spval + if (ravgip(i,j) == c0) a2D(i,j,n_siflswdbot(ns),iblk) = spval_dbl enddo ! i enddo ! j endif @@ -3357,7 +3370,7 @@ subroutine accum_hist (dt) a2D(i,j,n_sifllwdtop(ns),iblk) = & a2D(i,j,n_sifllwdtop(ns),iblk)*avgct(ns)*ravgip(i,j) endif - if (ravgip(i,j) == c0) a2D(i,j,n_sifllwdtop(ns),iblk) = spval + if (ravgip(i,j) == c0) a2D(i,j,n_sifllwdtop(ns),iblk) = spval_dbl enddo ! i enddo ! j endif @@ -3370,7 +3383,7 @@ subroutine accum_hist (dt) a2D(i,j,n_sifllwutop(ns),iblk) = & a2D(i,j,n_sifllwutop(ns),iblk)*avgct(ns)*ravgip(i,j) endif - if (ravgip(i,j) == c0) a2D(i,j,n_sifllwutop(ns),iblk) = spval + if (ravgip(i,j) == c0) a2D(i,j,n_sifllwutop(ns),iblk) = spval_dbl enddo ! i enddo ! j endif @@ -3383,7 +3396,7 @@ subroutine accum_hist (dt) a2D(i,j,n_siflsenstop(ns),iblk) = & a2D(i,j,n_siflsenstop(ns),iblk)*avgct(ns)*ravgip(i,j) endif - if (ravgip(i,j) == c0) a2D(i,j,n_siflsenstop(ns),iblk) = spval + if (ravgip(i,j) == c0) a2D(i,j,n_siflsenstop(ns),iblk) = spval_dbl enddo ! i enddo ! j endif @@ -3396,7 +3409,7 @@ subroutine accum_hist (dt) a2D(i,j,n_siflsensupbot(ns),iblk) = & a2D(i,j,n_siflsensupbot(ns),iblk)*avgct(ns)*ravgip(i,j) endif - if (ravgip(i,j) == c0) a2D(i,j,n_siflsensupbot(ns),iblk) = spval + if (ravgip(i,j) == c0) a2D(i,j,n_siflsensupbot(ns),iblk) = spval_dbl enddo ! i enddo ! j endif @@ -3409,7 +3422,7 @@ subroutine accum_hist (dt) a2D(i,j,n_sifllatstop(ns),iblk) = & a2D(i,j,n_sifllatstop(ns),iblk)*avgct(ns)*ravgip(i,j) endif - if (ravgip(i,j) == c0) a2D(i,j,n_sifllatstop(ns),iblk) = spval + if (ravgip(i,j) == c0) a2D(i,j,n_sifllatstop(ns),iblk) = spval_dbl enddo ! i enddo ! j endif @@ -3422,7 +3435,7 @@ subroutine accum_hist (dt) a2D(i,j,n_sipr(ns),iblk) = & a2D(i,j,n_sipr(ns),iblk)*avgct(ns)*ravgip(i,j) endif - if (ravgip(i,j) == c0) a2D(i,j,n_sipr(ns),iblk) = spval + if (ravgip(i,j) == c0) a2D(i,j,n_sipr(ns),iblk) = spval_dbl enddo ! i enddo ! j endif @@ -3435,7 +3448,7 @@ subroutine accum_hist (dt) a2D(i,j,n_sifb(ns),iblk) = & a2D(i,j,n_sifb(ns),iblk)*avgct(ns)*ravgip(i,j) endif - if (ravgip(i,j) == c0) a2D(i,j,n_sifb(ns),iblk) = spval + if (ravgip(i,j) == c0) a2D(i,j,n_sifb(ns),iblk) = spval_dbl enddo ! i enddo ! j endif @@ -3448,7 +3461,7 @@ subroutine accum_hist (dt) a2D(i,j,n_siflcondtop(ns),iblk) = & a2D(i,j,n_siflcondtop(ns),iblk)*avgct(ns)*ravgip(i,j) endif - if (ravgip(i,j) == c0) a2D(i,j,n_siflcondtop(ns),iblk) = spval + if (ravgip(i,j) == c0) a2D(i,j,n_siflcondtop(ns),iblk) = spval_dbl enddo ! i enddo ! j endif @@ -3461,7 +3474,7 @@ subroutine accum_hist (dt) a2D(i,j,n_siflcondbot(ns),iblk) = & a2D(i,j,n_siflcondbot(ns),iblk)*avgct(ns)*ravgip(i,j) endif - if (ravgip(i,j) == c0) a2D(i,j,n_siflcondbot(ns),iblk) = spval + if (ravgip(i,j) == c0) a2D(i,j,n_siflcondbot(ns),iblk) = spval_dbl enddo ! i enddo ! j endif @@ -3474,7 +3487,7 @@ subroutine accum_hist (dt) a2D(i,j,n_siflsaltbot(ns),iblk) = & a2D(i,j,n_siflsaltbot(ns),iblk)*avgct(ns)*ravgip(i,j) endif - if (ravgip(i,j) == c0) a2D(i,j,n_siflsaltbot(ns),iblk) = spval + if (ravgip(i,j) == c0) a2D(i,j,n_siflsaltbot(ns),iblk) = spval_dbl enddo ! i enddo ! j endif @@ -3487,7 +3500,7 @@ subroutine accum_hist (dt) a2D(i,j,n_siflfwbot(ns),iblk) = & a2D(i,j,n_siflfwbot(ns),iblk)*avgct(ns)*ravgip(i,j) endif - if (ravgip(i,j) == c0) a2D(i,j,n_siflfwbot(ns),iblk) = spval + if (ravgip(i,j) == c0) a2D(i,j,n_siflfwbot(ns),iblk) = spval_dbl enddo ! i enddo ! j endif @@ -3500,7 +3513,7 @@ subroutine accum_hist (dt) a2D(i,j,n_siflfwdrain(ns),iblk) = & a2D(i,j,n_siflfwdrain(ns),iblk)*avgct(ns)*ravgip(i,j) endif - if (ravgip(i,j) == c0) a2D(i,j,n_siflfwdrain(ns),iblk) = spval + if (ravgip(i,j) == c0) a2D(i,j,n_siflfwdrain(ns),iblk) = spval_dbl enddo ! i enddo ! j endif @@ -3513,7 +3526,7 @@ subroutine accum_hist (dt) a2D(i,j,n_sidragtop(ns),iblk) = & a2D(i,j,n_sidragtop(ns),iblk)*avgct(ns)*ravgip(i,j) endif - if (ravgip(i,j) == c0) a2D(i,j,n_sidragtop(ns),iblk) = spval + if (ravgip(i,j) == c0) a2D(i,j,n_sidragtop(ns),iblk) = spval_dbl enddo ! i enddo ! j endif @@ -3526,7 +3539,7 @@ subroutine accum_hist (dt) a2D(i,j,n_sirdgthick(ns),iblk) = & a2D(i,j,n_sirdgthick(ns),iblk)*avgct(ns)*ravgip(i,j) endif - if (ravgip(i,j) == c0) a2D(i,j,n_sirdgthick(ns),iblk) = spval + if (ravgip(i,j) == c0) a2D(i,j,n_sirdgthick(ns),iblk) = spval_dbl enddo ! i enddo ! j endif @@ -3539,7 +3552,7 @@ subroutine accum_hist (dt) a2D(i,j,n_siforcetiltx(ns),iblk) = & a2D(i,j,n_siforcetiltx(ns),iblk)*avgct(ns)*ravgip(i,j) endif - if (ravgip(i,j) == c0) a2D(i,j,n_siforcetiltx(ns),iblk) = spval + if (ravgip(i,j) == c0) a2D(i,j,n_siforcetiltx(ns),iblk) = spval_dbl enddo ! i enddo ! j endif @@ -3552,7 +3565,7 @@ subroutine accum_hist (dt) a2D(i,j,n_siforcetilty(ns),iblk) = & a2D(i,j,n_siforcetilty(ns),iblk)*avgct(ns)*ravgip(i,j) endif - if (ravgip(i,j) == c0) a2D(i,j,n_siforcetilty(ns),iblk) = spval + if (ravgip(i,j) == c0) a2D(i,j,n_siforcetilty(ns),iblk) = spval_dbl enddo ! i enddo ! j endif @@ -3565,7 +3578,7 @@ subroutine accum_hist (dt) a2D(i,j,n_siforcecoriolx(ns),iblk) = & a2D(i,j,n_siforcecoriolx(ns),iblk)*avgct(ns)*ravgip(i,j) endif - if (ravgip(i,j) == c0) a2D(i,j,n_siforcecoriolx(ns),iblk) = spval + if (ravgip(i,j) == c0) a2D(i,j,n_siforcecoriolx(ns),iblk) = spval_dbl enddo ! i enddo ! j endif @@ -3578,7 +3591,7 @@ subroutine accum_hist (dt) a2D(i,j,n_siforcecorioly(ns),iblk) = & a2D(i,j,n_siforcecorioly(ns),iblk)*avgct(ns)*ravgip(i,j) endif - if (ravgip(i,j) == c0) a2D(i,j,n_siforcecorioly(ns),iblk) = spval + if (ravgip(i,j) == c0) a2D(i,j,n_siforcecorioly(ns),iblk) = spval_dbl enddo ! i enddo ! j endif @@ -3591,7 +3604,7 @@ subroutine accum_hist (dt) a2D(i,j,n_siforceintstrx(ns),iblk) = & a2D(i,j,n_siforceintstrx(ns),iblk)*avgct(ns)*ravgip(i,j) endif - if (ravgip(i,j) == c0) a2D(i,j,n_siforceintstrx(ns),iblk) = spval + if (ravgip(i,j) == c0) a2D(i,j,n_siforceintstrx(ns),iblk) = spval_dbl enddo ! i enddo ! j endif @@ -3604,7 +3617,7 @@ subroutine accum_hist (dt) a2D(i,j,n_siforceintstry(ns),iblk) = & a2D(i,j,n_siforceintstry(ns),iblk)*avgct(ns)*ravgip(i,j) endif - if (ravgip(i,j) == c0) a2D(i,j,n_siforceintstry(ns),iblk) = spval + if (ravgip(i,j) == c0) a2D(i,j,n_siforceintstry(ns),iblk) = spval_dbl enddo ! i enddo ! j endif @@ -3669,7 +3682,38 @@ subroutine accum_hist (dt) enddo ! j endif - endif +! snwcnt averaging is not working correctly +! for now, these history fields will have zeroes includes in the averages +! if (avail_hist_fields(n)%vname(1:8) == 'rhos_cmp') then +! do j = jlo, jhi +! do i = ilo, ihi +! if (tmask(i,j,iblk)) then +! ravgctz = c0 +! if (snwcnt(i,j,iblk,ns) > puny) & +! ravgctz = c1/snwcnt(i,j,iblk,ns) +! if (f_rhos_cmp (1:1) /= 'x' .and. n_rhos_cmp(ns) /= 0) & +! a2D(i,j,n_rhos_cmp(ns),iblk) = & +! a2D(i,j,n_rhos_cmp(ns),iblk)*avgct(ns)*ravgctz +! endif +! enddo ! i +! enddo ! j +! endif +! if (avail_hist_fields(n)%vname(1:8) == 'rhos_cnt') then +! do j = jlo, jhi +! do i = ilo, ihi +! if (tmask(i,j,iblk)) then +! ravgctz = c0 +! if (snwcnt(i,j,iblk,ns) > puny) & +! ravgctz = c1/snwcnt(i,j,iblk,ns) +! if (f_rhos_cnt (1:1) /= 'x' .and. n_rhos_cnt(ns) /= 0) & +! a2D(i,j,n_rhos_cnt(ns),iblk) = & +! a2D(i,j,n_rhos_cnt(ns),iblk)*avgct(ns)*ravgctz +! endif +! enddo ! i +! enddo ! j +! endif + + endif ! avail_hist_fields(n)%vhistfreq == histfreq(ns) enddo ! n do n = 1, num_avail_hist_fields_3Dc @@ -3680,7 +3724,7 @@ subroutine accum_hist (dt) do j = jlo, jhi do i = ilo, ihi if (.not. tmask(i,j,iblk)) then ! mask out land points - a3Dc(i,j,k,n,iblk) = spval + a3Dc(i,j,k,n,iblk) = spval_dbl else ! convert units a3Dc(i,j,k,n,iblk) = avail_hist_fields(nn)%cona*a3Dc(i,j,k,n,iblk) & * ravgct + avail_hist_fields(nn)%conb @@ -3729,7 +3773,7 @@ subroutine accum_hist (dt) do j = jlo, jhi do i = ilo, ihi if (.not. tmask(i,j,iblk)) then ! mask out land points - a3Dz(i,j,k,n,iblk) = spval + a3Dz(i,j,k,n,iblk) = spval_dbl else ! convert units a3Dz(i,j,k,n,iblk) = avail_hist_fields(nn)%cona*a3Dz(i,j,k,n,iblk) & * ravgct + avail_hist_fields(nn)%conb @@ -3746,7 +3790,7 @@ subroutine accum_hist (dt) do j = jlo, jhi do i = ilo, ihi if (.not. tmask(i,j,iblk)) then ! mask out land points - a3Db(i,j,k,n,iblk) = spval + a3Db(i,j,k,n,iblk) = spval_dbl else ! convert units a3Db(i,j,k,n,iblk) = avail_hist_fields(nn)%cona*a3Db(i,j,k,n,iblk) & * ravgct + avail_hist_fields(nn)%conb @@ -3764,7 +3808,7 @@ subroutine accum_hist (dt) do j = jlo, jhi do i = ilo, ihi if (.not. tmask(i,j,iblk)) then ! mask out land points - a3Da(i,j,k,n,iblk) = spval + a3Da(i,j,k,n,iblk) = spval_dbl else ! convert units a3Da(i,j,k,n,iblk) = avail_hist_fields(nn)%cona*a3Da(i,j,k,n,iblk) & * ravgct + avail_hist_fields(nn)%conb @@ -3782,7 +3826,7 @@ subroutine accum_hist (dt) do j = jlo, jhi do i = ilo, ihi if (.not. tmask(i,j,iblk)) then ! mask out land points - a3Df(i,j,k,n,iblk) = spval + a3Df(i,j,k,n,iblk) = spval_dbl else ! convert units a3Df(i,j,k,n,iblk) = avail_hist_fields(nn)%cona*a3Df(i,j,k,n,iblk) & * ravgct + avail_hist_fields(nn)%conb @@ -3801,7 +3845,7 @@ subroutine accum_hist (dt) do j = jlo, jhi do i = ilo, ihi if (.not. tmask(i,j,iblk)) then ! mask out land points - a4Di(i,j,k,ic,n,iblk) = spval + a4Di(i,j,k,ic,n,iblk) = spval_dbl else ! convert units a4Di(i,j,k,ic,n,iblk) = avail_hist_fields(nn)%cona*a4Di(i,j,k,ic,n,iblk) & * ravgct + avail_hist_fields(nn)%conb @@ -3821,7 +3865,7 @@ subroutine accum_hist (dt) do j = jlo, jhi do i = ilo, ihi if (.not. tmask(i,j,iblk)) then ! mask out land points - a4Ds(i,j,k,ic,n,iblk) = spval + a4Ds(i,j,k,ic,n,iblk) = spval_dbl else ! convert units a4Ds(i,j,k,ic,n,iblk) = avail_hist_fields(nn)%cona*a4Ds(i,j,k,ic,n,iblk) & * ravgct + avail_hist_fields(nn)%conb @@ -3841,7 +3885,7 @@ subroutine accum_hist (dt) do j = jlo, jhi do i = ilo, ihi if (.not. tmask(i,j,iblk)) then ! mask out land points - a4Df(i,j,k,ic,n,iblk) = spval + a4Df(i,j,k,ic,n,iblk) = spval_dbl else ! convert units a4Df(i,j,k,ic,n,iblk) = avail_hist_fields(nn)%cona*a4Df(i,j,k,ic,n,iblk) & * ravgct + avail_hist_fields(nn)%conb @@ -3871,32 +3915,32 @@ subroutine accum_hist (dt) do j = jlo, jhi do i = ilo, ihi if (.not. tmask(i,j,iblk)) then ! mask out land points - if (n_divu (ns) /= 0) a2D(i,j,n_divu(ns), iblk) = spval - if (n_shear (ns) /= 0) a2D(i,j,n_shear(ns), iblk) = spval - if (n_sig1 (ns) /= 0) a2D(i,j,n_sig1(ns), iblk) = spval - if (n_sig2 (ns) /= 0) a2D(i,j,n_sig2(ns), iblk) = spval - if (n_sigP (ns) /= 0) a2D(i,j,n_sigP(ns), iblk) = spval - if (n_sistreave(ns) /= 0) a2D(i,j,n_sistreave(ns),iblk) = spval - if (n_sistremax(ns) /= 0) a2D(i,j,n_sistremax(ns),iblk) = spval - if (n_mlt_onset(ns) /= 0) a2D(i,j,n_mlt_onset(ns),iblk) = spval - if (n_frz_onset(ns) /= 0) a2D(i,j,n_frz_onset(ns),iblk) = spval - if (n_hisnap (ns) /= 0) a2D(i,j,n_hisnap(ns), iblk) = spval - if (n_aisnap (ns) /= 0) a2D(i,j,n_aisnap(ns), iblk) = spval - if (n_trsig (ns) /= 0) a2D(i,j,n_trsig(ns), iblk) = spval - if (n_iage (ns) /= 0) a2D(i,j,n_iage(ns), iblk) = spval - if (n_FY (ns) /= 0) a2D(i,j,n_FY(ns), iblk) = spval - - if (n_a11 (ns) /= 0) a2D(i,j,n_a11(ns), iblk) = spval - if (n_a12 (ns) /= 0) a2D(i,j,n_a12(ns), iblk) = spval - if (n_e11 (ns) /= 0) a2D(i,j,n_e11(ns), iblk) = spval - if (n_e12 (ns) /= 0) a2D(i,j,n_e12(ns), iblk) = spval - if (n_e22 (ns) /= 0) a2D(i,j,n_e22(ns), iblk) = spval - if (n_s11 (ns) /= 0) a2D(i,j,n_s11(ns), iblk) = spval - if (n_s12 (ns) /= 0) a2D(i,j,n_s12(ns), iblk) = spval - if (n_s22 (ns) /= 0) a2D(i,j,n_s22(ns), iblk) = spval - if (n_yieldstress11 (ns) /= 0) a2D(i,j,n_yieldstress11(ns),iblk) = spval - if (n_yieldstress12 (ns) /= 0) a2D(i,j,n_yieldstress12(ns),iblk) = spval - if (n_yieldstress22 (ns) /= 0) a2D(i,j,n_yieldstress22(ns),iblk) = spval + if (n_divu (ns) /= 0) a2D(i,j,n_divu(ns), iblk) = spval_dbl + if (n_shear (ns) /= 0) a2D(i,j,n_shear(ns), iblk) = spval_dbl + if (n_sig1 (ns) /= 0) a2D(i,j,n_sig1(ns), iblk) = spval_dbl + if (n_sig2 (ns) /= 0) a2D(i,j,n_sig2(ns), iblk) = spval_dbl + if (n_sigP (ns) /= 0) a2D(i,j,n_sigP(ns), iblk) = spval_dbl + if (n_sistreave(ns) /= 0) a2D(i,j,n_sistreave(ns),iblk) = spval_dbl + if (n_sistremax(ns) /= 0) a2D(i,j,n_sistremax(ns),iblk) = spval_dbl + if (n_mlt_onset(ns) /= 0) a2D(i,j,n_mlt_onset(ns),iblk) = spval_dbl + if (n_frz_onset(ns) /= 0) a2D(i,j,n_frz_onset(ns),iblk) = spval_dbl + if (n_hisnap (ns) /= 0) a2D(i,j,n_hisnap(ns), iblk) = spval_dbl + if (n_aisnap (ns) /= 0) a2D(i,j,n_aisnap(ns), iblk) = spval_dbl + if (n_trsig (ns) /= 0) a2D(i,j,n_trsig(ns), iblk) = spval_dbl + if (n_iage (ns) /= 0) a2D(i,j,n_iage(ns), iblk) = spval_dbl + if (n_FY (ns) /= 0) a2D(i,j,n_FY(ns), iblk) = spval_dbl + + if (n_a11 (ns) /= 0) a2D(i,j,n_a11(ns), iblk) = spval_dbl + if (n_a12 (ns) /= 0) a2D(i,j,n_a12(ns), iblk) = spval_dbl + if (n_e11 (ns) /= 0) a2D(i,j,n_e11(ns), iblk) = spval_dbl + if (n_e12 (ns) /= 0) a2D(i,j,n_e12(ns), iblk) = spval_dbl + if (n_e22 (ns) /= 0) a2D(i,j,n_e22(ns), iblk) = spval_dbl + if (n_s11 (ns) /= 0) a2D(i,j,n_s11(ns), iblk) = spval_dbl + if (n_s12 (ns) /= 0) a2D(i,j,n_s12(ns), iblk) = spval_dbl + if (n_s22 (ns) /= 0) a2D(i,j,n_s22(ns), iblk) = spval_dbl + if (n_yieldstress11 (ns) /= 0) a2D(i,j,n_yieldstress11(ns),iblk) = spval_dbl + if (n_yieldstress12 (ns) /= 0) a2D(i,j,n_yieldstress12(ns),iblk) = spval_dbl + if (n_yieldstress22 (ns) /= 0) a2D(i,j,n_yieldstress22(ns),iblk) = spval_dbl else if (n_divu (ns) /= 0) a2D(i,j,n_divu(ns),iblk) = & divu (i,j,iblk)*avail_hist_fields(n_divu(ns))%cona @@ -3992,10 +4036,12 @@ subroutine accum_hist (dt) if (allocated(a4Df)) a4Df(:,:,:,:,:,:) = c0 avgct(:) = c0 albcnt(:,:,:,:) = c0 + snwcnt(:,:,:,:) = c0 write_ic = .false. ! write initial condition once at most else avgct(ns) = c0 albcnt(:,:,:,ns) = c0 + snwcnt(:,:,:,ns) = c0 endif ! if (write_history(ns)) albcnt(:,:,:,ns) = c0 diff --git a/cicecore/cicedyn/analysis/ice_history_pond.F90 b/cicecore/cicedyn/analysis/ice_history_pond.F90 index 976a87d40..182865fec 100644 --- a/cicecore/cicedyn/analysis/ice_history_pond.F90 +++ b/cicecore/cicedyn/analysis/ice_history_pond.F90 @@ -20,7 +20,7 @@ module ice_history_pond implicit none private public :: accum_hist_pond, init_hist_pond_2D, init_hist_pond_3Dc - + !--------------------------------------------------------------- ! flags: write to output file if true or histfreq value !--------------------------------------------------------------- @@ -40,9 +40,9 @@ module ice_history_pond namelist / icefields_pond_nml / & f_apondn, f_apeffn , & f_hpondn, & - f_apond, f_apond_ai , & - f_hpond, f_hpond_ai , & - f_ipond, f_ipond_ai , & + f_apond, f_apond_ai , & + f_hpond, f_hpond_ai , & + f_ipond, f_ipond_ai , & f_apeff, f_apeff_ai !--------------------------------------------------------------- @@ -50,7 +50,7 @@ module ice_history_pond !--------------------------------------------------------------- integer (kind=int_kind), dimension(max_nstrm) :: & - n_apondn , n_apeffn , & + n_apondn , n_apeffn , & n_hpondn , & n_apond , n_apond_ai, & n_hpond , n_hpond_ai, & @@ -69,14 +69,10 @@ subroutine init_hist_pond_2D use ice_calendar, only: nstreams, histfreq use ice_communicate, only: my_task, master_task use ice_history_shared, only: tstr2D, tcstr, define_hist_field - use ice_fileunits, only: goto_nml integer (kind=int_kind) :: ns integer (kind=int_kind) :: nml_error ! namelist i/o error flag logical (kind=log_kind) :: tr_pond - character(len=char_len_long) :: tmpstr2 ! for namelist check - character(len=char_len) :: nml_name ! text namelist name - character(len=*), parameter :: subname = '(init_hist_pond_2D)' call icepack_query_tracer_flags(tr_pond_out=tr_pond) @@ -88,42 +84,25 @@ subroutine init_hist_pond_2D ! read namelist !----------------------------------------------------------------- + call get_fileunit(nu_nml) if (my_task == master_task) then - nml_name = 'icefields_pond_nml' - write(nu_diag,*) subname,' Reading ', trim(nml_name) - - ! open namelist file - call get_fileunit(nu_nml) - open (nu_nml, file=trim(nml_filename), status='old',iostat=nml_error) + open (nu_nml, file=nml_filename, status='old',iostat=nml_error) if (nml_error /= 0) then - call abort_ice(subname//'ERROR: '//trim(nml_name)//' open file '// & - trim(nml_filename), & - file=__FILE__, line=__LINE__) + nml_error = -1 + else + nml_error = 1 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) read(nu_nml, nml=icefields_pond_nml,iostat=nml_error) - ! check if error - if (nml_error /= 0) then - ! backspace and re-read erroneous line - backspace(nu_nml) - read(nu_nml,fmt='(A)') tmpstr2 - call abort_ice(subname//'ERROR: ' // trim(nml_name) // ' reading ' // & - trim(tmpstr2), file=__FILE__, line=__LINE__) - endif end do + if (nml_error == 0) close(nu_nml) + endif + call release_fileunit(nu_nml) - close(nu_nml) - call release_fileunit(nu_nml) + call broadcast_scalar(nml_error, master_task) + if (nml_error /= 0) then + close (nu_nml) + call abort_ice(subname//'ERROR: reading icefields_pond_nml') endif if (.not. tr_pond) then @@ -165,7 +144,7 @@ subroutine init_hist_pond_2D ns, f_apond) if (f_apond_ai(1:1) /= 'x') & - call define_hist_field(n_apond_ai,"apond_ai","1",tstr2D, tcstr, & + call define_hist_field(n_apond_ai,"apond_ai","1",tstr2D, tcstr, & "melt pond fraction of grid cell", & "weighted by ice area", c1, c0, & ns, f_apond_ai) @@ -177,7 +156,7 @@ subroutine init_hist_pond_2D ns, f_hpond) if (f_hpond_ai(1:1) /= 'x') & - call define_hist_field(n_hpond_ai,"hpond_ai","m",tstr2D, tcstr, & + call define_hist_field(n_hpond_ai,"hpond_ai","m",tstr2D, tcstr, & "mean melt pond depth over grid cell", & "weighted by ice area", c1, c0, & ns, f_hpond) @@ -189,7 +168,7 @@ subroutine init_hist_pond_2D ns, f_ipond) if (f_ipond_ai(1:1) /= 'x') & - call define_hist_field(n_ipond_ai,"ipond_ai","m",tstr2D, tcstr, & + call define_hist_field(n_ipond_ai,"ipond_ai","m",tstr2D, tcstr, & "mean pond ice thickness over grid cell", & "weighted by ice area", c1, c0, & ns, f_ipond_ai) @@ -210,7 +189,7 @@ subroutine init_hist_pond_2D enddo ! nstreams endif ! tr_pond - + end subroutine init_hist_pond_2D !======================================================================= @@ -230,14 +209,14 @@ subroutine init_hist_pond_3Dc file=__FILE__, line=__LINE__) if (tr_pond) then - + ! 3D (category) variables must be looped separately do ns = 1, nstreams if (histfreq(ns) /= 'x') then if (f_apondn(1:1) /= 'x') & call define_hist_field(n_apondn,"apondn","1",tstr3Dc, tcstr, & - "melt pond fraction, category","none", c1, c0, & + "melt pond fraction, category","none", c1, c0, & ns, f_apondn) if (f_hpondn(1:1) /= 'x') & @@ -286,8 +265,9 @@ subroutine accum_hist_pond (iblk) integer (kind=int_kind) :: & nt_apnd, nt_hpnd, nt_alvl, nt_ipnd + logical (kind=log_kind) :: & - tr_pond_lvl, tr_pond_topo + tr_pond_cesm, tr_pond_lvl, tr_pond_topo real (kind=dbl_kind) :: & puny @@ -302,8 +282,8 @@ subroutine accum_hist_pond (iblk) !--------------------------------------------------------------- call icepack_query_parameters(puny_out=puny) - call icepack_query_tracer_flags(tr_pond_lvl_out=tr_pond_lvl, & - tr_pond_topo_out=tr_pond_topo) + call icepack_query_tracer_flags(tr_pond_cesm_out=tr_pond_cesm, & + tr_pond_lvl_out=tr_pond_lvl, tr_pond_topo_out=tr_pond_topo) call icepack_query_tracer_indices(nt_apnd_out=nt_apnd, nt_hpnd_out=nt_hpnd, & nt_alvl_out=nt_alvl, nt_ipnd_out=nt_ipnd) call icepack_warnings_flush(nu_diag) @@ -311,9 +291,23 @@ subroutine accum_hist_pond (iblk) file=__FILE__, line=__LINE__) if (allocated(a2D)) then + if (tr_pond_cesm) then + if (f_apond(1:1)/= 'x') & + call accum_hist_field(n_apond, iblk, & + trcr(:,:,nt_apnd,iblk), a2D) + if (f_apond_ai(1:1)/= 'x') & + call accum_hist_field(n_apond_ai, iblk, & + aice(:,:,iblk) * trcr(:,:,nt_apnd,iblk), a2D) + if (f_hpond(1:1)/= 'x') & + call accum_hist_field(n_hpond, iblk, & + trcr(:,:,nt_apnd,iblk) & + * trcr(:,:,nt_hpnd,iblk), a2D) + if (f_hpond_ai(1:1)/= 'x') & + call accum_hist_field(n_hpond_ai, iblk, & + aice(:,:,iblk) * trcr(:,:,nt_apnd,iblk) & + * trcr(:,:,nt_hpnd,iblk), a2D) - if (tr_pond_lvl) then - + elseif (tr_pond_lvl) then if (f_apond(1:1)/= 'x') & call accum_hist_field(n_apond, iblk, & trcr(:,:,nt_alvl,iblk) * trcr(:,:,nt_apnd,iblk), a2D) @@ -366,7 +360,7 @@ subroutine accum_hist_pond (iblk) * trcr(:,:,nt_ipnd,iblk), a2D) endif ! ponds - this_block = get_block(blocks_ice(iblk),iblk) + this_block = get_block(blocks_ice(iblk),iblk) ilo = this_block%ilo ihi = this_block%ihi jlo = this_block%jlo diff --git a/cicecore/cicedyn/analysis/ice_history_shared.F90 b/cicecore/cicedyn/analysis/ice_history_shared.F90 index f0343f320..9b58deeec 100644 --- a/cicecore/cicedyn/analysis/ice_history_shared.F90 +++ b/cicecore/cicedyn/analysis/ice_history_shared.F90 @@ -59,7 +59,7 @@ module ice_history_shared !--------------------------------------------------------------- ! Instructions for adding a field: (search for 'example') - ! Here: + ! Here or in ice_history_[process].F90: ! (1) Add to frequency flags (f_) ! (2) Add to namelist (here and also in ice_in) ! (3) Add to index list diff --git a/cicecore/cicedyn/analysis/ice_history_snow.F90 b/cicecore/cicedyn/analysis/ice_history_snow.F90 index 19722b014..5a590af2b 100644 --- a/cicecore/cicedyn/analysis/ice_history_snow.F90 +++ b/cicecore/cicedyn/analysis/ice_history_snow.F90 @@ -18,7 +18,7 @@ module ice_history_snow implicit none private public :: accum_hist_snow, init_hist_snow_2D, init_hist_snow_3Dc - + !--------------------------------------------------------------- ! flags: write to output file if true or histfreq value !--------------------------------------------------------------- @@ -69,7 +69,6 @@ subroutine init_hist_snow_2D (dt) use ice_history_shared, only: tstr2D, tcstr, define_hist_field use ice_fileunits, only: nu_nml, nml_filename, & get_fileunit, release_fileunit - use ice_fileunits, only: goto_nml real (kind=dbl_kind), intent(in) :: & dt ! time step @@ -78,9 +77,6 @@ subroutine init_hist_snow_2D (dt) integer (kind=int_kind) :: nml_error ! namelist i/o error flag real (kind=dbl_kind) :: rhofresh, secday logical (kind=log_kind) :: tr_snow - character(len=char_len_long) :: tmpstr2 ! for namelist check - character(len=char_len) :: nml_name ! for namelist check - character(len=*), parameter :: subname = '(init_hist_snow_2D)' call icepack_query_tracer_flags(tr_snow_out=tr_snow) @@ -91,48 +87,30 @@ subroutine init_hist_snow_2D (dt) if (tr_snow) then - !----------------------------------------------------------------- - ! read namelist - !----------------------------------------------------------------- - - if (my_task == master_task) then - nml_name = 'icefields_snow_nml' - write(nu_diag,*) subname,' Reading ', trim(nml_name) - - ! open namelist file - 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: '//trim(nml_name)//' open file '// & - trim(nml_filename), & - file=__FILE__, line=__LINE__) - endif - - ! 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) - read(nu_nml, nml=icefields_snow_nml,iostat=nml_error) - ! check if error - if (nml_error /= 0) then - ! backspace and re-read erroneous line - backspace(nu_nml) - read(nu_nml,fmt='(A)') tmpstr2 - call abort_ice(subname//'ERROR: ' // trim(nml_name) // ' reading ' // & - trim(tmpstr2), file=__FILE__, line=__LINE__) - endif - end do - - close(nu_nml) - call release_fileunit(nu_nml) + !----------------------------------------------------------------- + ! read namelist + !----------------------------------------------------------------- + call get_fileunit(nu_nml) + if (my_task == master_task) then + open (nu_nml, file=nml_filename, status='old',iostat=nml_error) + if (nml_error /= 0) then + nml_error = -1 + else + nml_error = 1 endif + do while (nml_error > 0) + read(nu_nml, nml=icefields_snow_nml,iostat=nml_error) + end do + if (nml_error == 0) close(nu_nml) + endif + call release_fileunit(nu_nml) + + call broadcast_scalar(nml_error, master_task) + if (nml_error /= 0) then + close (nu_nml) + call abort_ice('ice: error reading icefields_snow_nml') + endif else ! .not. tr_snow f_smassice = 'x' @@ -213,7 +191,7 @@ subroutine init_hist_snow_2D (dt) endif ! histfreq(ns) /= 'x' enddo ! nstreams endif ! tr_snow - + end subroutine init_hist_snow_2D !======================================================================= @@ -226,7 +204,7 @@ subroutine init_hist_snow_3Dc integer (kind=int_kind) :: ns logical (kind=log_kind) :: tr_snow character(len=*), parameter :: subname = '(init_hist_pond_3Dc)' - + call icepack_query_tracer_flags(tr_snow_out=tr_snow) call icepack_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & @@ -283,6 +261,7 @@ subroutine accum_hist_snow (iblk) use ice_arrays_column, only: meltsliq use ice_blocks, only: block, nx_block, ny_block + use ice_domain, only: blocks_ice use ice_flux, only: fsloss use ice_history_shared, only: n2D, a2D, a3Dc, ncat_hist, & accum_hist_field, nzslyr @@ -294,7 +273,7 @@ subroutine accum_hist_snow (iblk) ! local variables integer (kind=int_kind) :: & - k, n + i, j, k, n integer (kind=int_kind) :: & nt_smice, nt_smliq, nt_rhos, nt_rsnw @@ -375,7 +354,7 @@ subroutine accum_hist_snow (iblk) if (f_fsloss(1:1)/= 'x') & call accum_hist_field(n_fsloss, iblk, & fsloss(:,:,iblk), a2D) - + endif ! allocated(a2D) ! 3D category fields @@ -441,7 +420,7 @@ subroutine accum_hist_snow (iblk) endif ! allocated(a3Dc) endif ! tr_snow - + end subroutine accum_hist_snow !======================================================================= diff --git a/cicecore/cicedyn/dynamics/ice_dyn_eap.F90 b/cicecore/cicedyn/dynamics/ice_dyn_eap.F90 index e6bb86bff..fd4c2812e 100644 --- a/cicecore/cicedyn/dynamics/ice_dyn_eap.F90 +++ b/cicecore/cicedyn/dynamics/ice_dyn_eap.F90 @@ -1191,12 +1191,12 @@ subroutine stress_eap (nx_block, ny_block, & vvel , & ! y-component of velocity (m/s) dxt , & ! width of T-cell through the middle (m) dyt , & ! height of T-cell through the middle (m) - dxhy , & ! 0.5*(HTE - HTE) - dyhx , & ! 0.5*(HTN - HTN) - cyp , & ! 1.5*HTE - 0.5*HTE - cxp , & ! 1.5*HTN - 0.5*HTN - cym , & ! 0.5*HTE - 1.5*HTE - cxm , & ! 0.5*HTN - 1.5*HTN + dxhy , & ! 0.5*(HTE - HTW) + dyhx , & ! 0.5*(HTN - HTS) + cyp , & ! 1.5*HTE - 0.5*HTW + cxp , & ! 1.5*HTN - 0.5*HTS + cym , & ! 0.5*HTE - 1.5*HTW + cxm , & ! 0.5*HTN - 1.5*HTS tarear ! 1/tarea real (kind=dbl_kind), dimension (nx_block,ny_block), intent(inout) :: & diff --git a/cicecore/cicedyn/dynamics/ice_transport_driver.F90 b/cicecore/cicedyn/dynamics/ice_transport_driver.F90 index e3da6390b..f2dff2367 100644 --- a/cicecore/cicedyn/dynamics/ice_transport_driver.F90 +++ b/cicecore/cicedyn/dynamics/ice_transport_driver.F90 @@ -85,7 +85,9 @@ subroutine init_transport integer (kind=int_kind) :: ntrcr, nt_Tsfc, nt_qice, nt_qsno, & nt_sice, nt_fbri, nt_iage, nt_FY, nt_alvl, nt_vlvl, & - nt_apnd, nt_hpnd, nt_ipnd, nt_fsd, nt_isosno, nt_isoice, nt_bgc_Nit, nt_bgc_S + nt_apnd, nt_hpnd, nt_ipnd, nt_fsd, & + nt_smice, nt_smliq, nt_rhos, nt_rsnw, & + nt_isosno, nt_isoice, nt_bgc_Nit, nt_bgc_S character(len=*), parameter :: subname = '(init_transport)' @@ -94,9 +96,12 @@ subroutine init_transport call icepack_query_tracer_sizes(ntrcr_out=ntrcr) call icepack_query_tracer_indices(nt_Tsfc_out=nt_Tsfc, nt_qice_out=nt_qice, & nt_qsno_out=nt_qsno, nt_sice_out=nt_sice, nt_fbri_out=nt_fbri, & - nt_iage_out=nt_iage, nt_FY_out=nt_FY, nt_alvl_out=nt_alvl, nt_fsd_out=nt_fsd, & - nt_vlvl_out=nt_vlvl, nt_apnd_out=nt_apnd, nt_hpnd_out=nt_hpnd, & - nt_ipnd_out=nt_ipnd, nt_bgc_Nit_out=nt_bgc_Nit, nt_bgc_S_out=nt_bgc_S, & + nt_iage_out=nt_iage, nt_FY_out=nt_FY, nt_fsd_out=nt_fsd, & + nt_alvl_out=nt_alvl, nt_vlvl_out=nt_vlvl, & + nt_apnd_out=nt_apnd, nt_hpnd_out=nt_hpnd, nt_ipnd_out=nt_ipnd, & + nt_smice_out=nt_smice, nt_smliq_out=nt_smliq, nt_rhos_out=nt_rhos, & + nt_rsnw_out=nt_rsnw, & + nt_bgc_Nit_out=nt_bgc_Nit, nt_bgc_S_out=nt_bgc_S, & nt_isosno_out=nt_isosno, nt_isoice_out=nt_isoice) call icepack_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & @@ -195,6 +200,18 @@ subroutine init_transport if (nt-k==nt_ipnd) & write(nu_diag,1000) 'nt_ipnd ',nt,depend(nt),tracer_type(nt),& has_dependents(nt) + if (nt-k==nt_smice) & + write(nu_diag,1000) 'nt_smice ',nt,depend(nt),tracer_type(nt),& + has_dependents(nt) + if (nt-k==nt_smliq) & + write(nu_diag,1000) 'nt_smliq ',nt,depend(nt),tracer_type(nt),& + has_dependents(nt) + if (nt-k==nt_rhos) & + write(nu_diag,1000) 'nt_rhos ',nt,depend(nt),tracer_type(nt),& + has_dependents(nt) + if (nt-k==nt_rsnw) & + write(nu_diag,1000) 'nt_rsnw ',nt,depend(nt),tracer_type(nt),& + has_dependents(nt) if (nt-k==nt_fsd) & write(nu_diag,1000) 'nt_fsd ',nt,depend(nt),tracer_type(nt),& has_dependents(nt) diff --git a/cicecore/cicedyn/general/ice_flux.F90 b/cicecore/cicedyn/general/ice_flux.F90 index 53b326808..fd721522f 100644 --- a/cicecore/cicedyn/general/ice_flux.F90 +++ b/cicecore/cicedyn/general/ice_flux.F90 @@ -218,6 +218,7 @@ module ice_flux fresh , & ! fresh water flux to ocean (kg/m^2/s) fsalt , & ! salt flux to ocean (kg/m^2/s) fhocn , & ! net heat flux to ocean (W/m^2) + fsloss , & ! rate of snow loss to leads (kg/m^2/s) fswthru , & ! shortwave penetrating to ocean (W/m^2) fswthru_vdr , & ! vis dir shortwave penetrating to ocean (W/m^2) fswthru_vdf , & ! vis dif shortwave penetrating to ocean (W/m^2) @@ -294,6 +295,10 @@ module ice_flux fsensn, & ! category sensible heat flux flatn ! category latent heat flux + real (kind=dbl_kind), & + dimension (:,:,:,:), allocatable, public :: & + snwcnt ! counter for presence of snow + ! As above but these remain grid box mean values i.e. they are not ! divided by aice at end of ice_dynamics. These are used in ! CICE_IN_NEMO for coupling and also for generating @@ -448,6 +453,7 @@ subroutine alloc_flux fresh (nx_block,ny_block,max_blocks), & ! fresh water flux to ocean (kg/m^2/s) fsalt (nx_block,ny_block,max_blocks), & ! salt flux to ocean (kg/m^2/s) fhocn (nx_block,ny_block,max_blocks), & ! net heat flux to ocean (W/m^2) + fsloss (nx_block,ny_block,max_blocks), & ! rate of snow loss to leads (kg/m^2/s) fswthru (nx_block,ny_block,max_blocks), & ! shortwave penetrating to ocean (W/m^2) fswthru_vdr (nx_block,ny_block,max_blocks), & ! vis dir shortwave penetrating to ocean (W/m^2) fswthru_vdf (nx_block,ny_block,max_blocks), & ! vis dif shortwave penetrating to ocean (W/m^2) @@ -525,6 +531,7 @@ subroutine alloc_flux fsensn (nx_block,ny_block,ncat,max_blocks), & ! category sensible heat flux flatn (nx_block,ny_block,ncat,max_blocks), & ! category latent heat flux albcnt (nx_block,ny_block,max_blocks,max_nstrm), & ! counter for zenith angle + snwcnt (nx_block,ny_block,max_blocks,max_nstrm), & ! counter for snow salinz (nx_block,ny_block,nilyr+1,max_blocks), & ! initial salinity profile (ppt) Tmltz (nx_block,ny_block,nilyr+1,max_blocks), & ! initial melting temperature (^oC) stat=ierr) diff --git a/cicecore/cicedyn/general/ice_forcing.F90 b/cicecore/cicedyn/general/ice_forcing.F90 index 200b3d00b..a016a9b21 100755 --- a/cicecore/cicedyn/general/ice_forcing.F90 +++ b/cicecore/cicedyn/general/ice_forcing.F90 @@ -41,7 +41,7 @@ module ice_forcing field_type_vector, field_loc_NEcorner use icepack_intfc, only: icepack_warnings_flush, icepack_warnings_aborted use icepack_intfc, only: icepack_sea_freezing_temperature - use icepack_intfc, only: icepack_init_wave + use icepack_intfc, only: icepack_init_wave, icepack_init_parameters use icepack_intfc, only: icepack_query_tracer_indices, icepack_query_parameters implicit none @@ -50,7 +50,8 @@ module ice_forcing get_forcing_atmo, get_forcing_ocn, get_wave_spec, & read_clim_data, read_clim_data_nc, & interpolate_data, interp_coeff_monthly, & - read_data_nc_point, interp_coeff + read_data_nc_point, interp_coeff, & + init_snowtable integer (kind=int_kind), public :: & ycycle , & ! number of years in forcing cycle, set by namelist @@ -166,6 +167,16 @@ module ice_forcing integer (kind=int_kind), public :: & Njday_atm ! Number of atm forcing timesteps + character (len=char_len_long), public :: & + snw_filename ! filename for snow lookup table + + character (char_len), public :: & + snw_rhos_fname , & ! snow table 1d rhos field name + snw_Tgrd_fname , & ! snow table 1d Tgrd field name + snw_T_fname , & ! snow table 1d T field name + snw_tau_fname , & ! snow table 3d tau field name + snw_kappa_fname, & ! snow table 3d kappa field name + snw_drdt0_fname ! snow table 3d drdt0 field name ! PRIVATE: @@ -5398,7 +5409,199 @@ end subroutine get_wave_spec !======================================================================= - end module ice_forcing +! initial snow aging lookup table +! +! Dry snow metamorphism table +! snicar_drdt_bst_fit_60_c070416.nc +! Flanner (file metadata units mislabelled) +! drdsdt0 (10^-6 m/hr) tau (10^-6 m) +! + subroutine init_snowtable + + use ice_broadcast, only: broadcast_array, broadcast_scalar + integer (kind=int_kind) :: & + idx_T_max , & ! Table dimensions + idx_rhos_max, & + idx_Tgrd_max + real (kind=dbl_kind), allocatable :: & + snowage_rhos (:), & + snowage_Tgrd (:), & + snowage_T (:), & + snowage_tau (:,:,:), & + snowage_kappa(:,:,:), & + snowage_drdt0(:,:,:) + + ! local variables + + logical (kind=log_kind) :: diag = .false. + + integer (kind=int_kind) :: & + fid ! file id for netCDF file + + character (char_len) :: & + snw_aging_table, & ! aging table setting + fieldname ! field name in netcdf file + + integer (kind=int_kind) :: & + j, k ! indices + + character(len=*), parameter :: subname = '(init_snowtable)' + + !----------------------------------------------------------------- + ! read table of snow aging parameters + !----------------------------------------------------------------- + + call icepack_query_parameters(snw_aging_table_out=snw_aging_table, & + isnw_rhos_out=idx_rhos_max, isnw_Tgrd_out=idx_Tgrd_max, isnw_T_out=idx_T_max) + + if (my_task == master_task) then + write (nu_diag,*) ' ' + write (nu_diag,*) 'Snow aging file:', trim(snw_filename) + endif + + if (snw_aging_table == 'snicar') then + ! just read the 3d data and pass it in + + call ice_open_nc(snw_filename,fid) + + allocate(snowage_tau (idx_rhos_max, idx_Tgrd_max, idx_T_max)) + allocate(snowage_kappa(idx_rhos_max, idx_Tgrd_max, idx_T_max)) + allocate(snowage_drdt0(idx_rhos_max, idx_Tgrd_max, idx_T_max)) + + fieldname = trim(snw_tau_fname) + call ice_read_nc(fid,fieldname,snowage_tau, diag, & + idx_rhos_max,idx_Tgrd_max,idx_T_max) + fieldname = trim(snw_kappa_fname) + call ice_read_nc(fid,fieldname,snowage_kappa,diag, & + idx_rhos_max,idx_Tgrd_max,idx_T_max) + fieldname = trim(snw_drdt0_fname) + call ice_read_nc(fid,fieldname,snowage_drdt0,diag, & + idx_rhos_max,idx_Tgrd_max,idx_T_max) + + call ice_close_nc(fid) + + call broadcast_array(snowage_tau , master_task) + call broadcast_array(snowage_kappa, master_task) + call broadcast_array(snowage_drdt0, master_task) + + if (my_task == master_task) then + write(nu_diag,*) subname,' ' + write(nu_diag,*) subname,' Successfully read snow aging properties:' + write(nu_diag,*) subname,' snw_aging_table = ',trim(snw_aging_table) + write(nu_diag,*) subname,' idx_rhos_max = ',idx_rhos_max + write(nu_diag,*) subname,' idx_Tgrd_max = ',idx_Tgrd_max + write(nu_diag,*) subname,' idx_T_max = ',idx_T_max + write(nu_diag,*) subname,' Data at rhos, Tgrd, T at first index ' + write(nu_diag,*) subname,' snoage_tau (1,1,1) = ',snowage_tau (1,1,1) + write(nu_diag,*) subname,' snoage_kappa (1,1,1) = ',snowage_kappa(1,1,1) + write(nu_diag,*) subname,' snoage_drdt0 (1,1,1) = ',snowage_drdt0(1,1,1) + write(nu_diag,*) subname,' Data at rhos, Tgrd, T at max index' + write(nu_diag,*) subname,' snoage_tau (max,max,max) = ',snowage_tau (idx_rhos_max, idx_Tgrd_max, idx_T_max) + write(nu_diag,*) subname,' snoage_kappa (max,max,max) = ',snowage_kappa(idx_rhos_max, idx_Tgrd_max, idx_T_max) + write(nu_diag,*) subname,' snoage_drdt0 (max,max,max) = ',snowage_drdt0(idx_rhos_max, idx_Tgrd_max, idx_T_max) + endif + + call icepack_init_parameters( & + snowage_tau_in = snowage_tau, & + snowage_kappa_in = snowage_kappa, & + snowage_drdt0_in = snowage_drdt0 ) + + deallocate(snowage_tau) + deallocate(snowage_kappa) + deallocate(snowage_drdt0) + + else + ! read everything and pass it in + + call ice_open_nc(snw_filename,fid) + + fieldname = trim(snw_rhos_fname) + call ice_get_ncvarsize(fid,fieldname,idx_rhos_max) + fieldname = trim(snw_Tgrd_fname) + call ice_get_ncvarsize(fid,fieldname,idx_Tgrd_max) + fieldname = trim(snw_T_fname) + call ice_get_ncvarsize(fid,fieldname,idx_T_max) + + call broadcast_scalar(idx_rhos_max, master_task) + call broadcast_scalar(idx_Tgrd_max, master_task) + call broadcast_scalar(idx_T_max , master_task) + + allocate(snowage_rhos (idx_rhos_max)) + allocate(snowage_Tgrd (idx_Tgrd_max)) + allocate(snowage_T (idx_T_max)) + allocate(snowage_tau (idx_rhos_max, idx_Tgrd_max, idx_T_max)) + allocate(snowage_kappa(idx_rhos_max, idx_Tgrd_max, idx_T_max)) + allocate(snowage_drdt0(idx_rhos_max, idx_Tgrd_max, idx_T_max)) + + fieldname = trim(snw_rhos_fname) + call ice_read_nc(fid,fieldname,snowage_rhos, diag, & + idx_rhos_max) + fieldname = trim(snw_Tgrd_fname) + call ice_read_nc(fid,fieldname,snowage_Tgrd, diag, & + idx_Tgrd_max) + fieldname = trim(snw_T_fname) + call ice_read_nc(fid,fieldname,snowage_T, diag, & + idx_T_max) + + fieldname = trim(snw_tau_fname) + call ice_read_nc(fid,fieldname,snowage_tau, diag, & + idx_rhos_max,idx_Tgrd_max,idx_T_max) + fieldname = trim(snw_kappa_fname) + call ice_read_nc(fid,fieldname,snowage_kappa,diag, & + idx_rhos_max,idx_Tgrd_max,idx_T_max) + fieldname = trim(snw_drdt0_fname) + call ice_read_nc(fid,fieldname,snowage_drdt0,diag, & + idx_rhos_max,idx_Tgrd_max,idx_T_max) + + call ice_close_nc(fid) + + call broadcast_array(snowage_rhos , master_task) + call broadcast_array(snowage_Tgrd , master_task) + call broadcast_array(snowage_T , master_task) + call broadcast_array(snowage_tau , master_task) + call broadcast_array(snowage_kappa, master_task) + call broadcast_array(snowage_drdt0, master_task) + + if (my_task == master_task) then + write(nu_diag,*) subname,' ' + write(nu_diag,*) subname,' Successfully read snow aging properties:' + write(nu_diag,*) subname,' idx_rhos_max = ',idx_rhos_max + write(nu_diag,*) subname,' idx_Tgrd_max = ',idx_Tgrd_max + write(nu_diag,*) subname,' idx_T_max = ',idx_T_max + write(nu_diag,*) subname,' Data at rhos, Tgrd, T = ',snowage_rhos(1),snowage_Tgrd(1),snowage_T(1) + write(nu_diag,*) subname,' snoage_tau (1,1,1) = ',snowage_tau (1,1,1) + write(nu_diag,*) subname,' snoage_kappa (1,1,1) = ',snowage_kappa(1,1,1) + write(nu_diag,*) subname,' snoage_drdt0 (1,1,1) = ',snowage_drdt0(1,1,1) + write(nu_diag,*) subname,' Data at rhos, Tgrd, T = ',snowage_rhos(idx_rhos_max),snowage_Tgrd(idx_Tgrd_max),snowage_T(idx_T_max) + write(nu_diag,*) subname,' snoage_tau (max,max,max) = ',snowage_tau (idx_rhos_max, idx_Tgrd_max, idx_T_max) + write(nu_diag,*) subname,' snoage_kappa (max,max,max) = ',snowage_kappa(idx_rhos_max, idx_Tgrd_max, idx_T_max) + write(nu_diag,*) subname,' snoage_drdt0 (max,max,max) = ',snowage_drdt0(idx_rhos_max, idx_Tgrd_max, idx_T_max) + endif + + call icepack_init_parameters( & + isnw_t_in = idx_T_max, & + isnw_Tgrd_in = idx_Tgrd_max, & + isnw_rhos_in = idx_rhos_max, & + snowage_rhos_in = snowage_rhos, & + snowage_Tgrd_in = snowage_Tgrd, & + snowage_T_in = snowage_T, & + snowage_tau_in = snowage_tau, & + snowage_kappa_in = snowage_kappa, & + snowage_drdt0_in = snowage_drdt0 ) + + deallocate(snowage_rhos) + deallocate(snowage_Tgrd) + deallocate(snowage_T) + deallocate(snowage_tau) + deallocate(snowage_kappa) + deallocate(snowage_drdt0) + + endif + + end subroutine init_snowtable !======================================================================= + end module ice_forcing + +!======================================================================= diff --git a/cicecore/cicedyn/general/ice_step_mod.F90 b/cicecore/cicedyn/general/ice_step_mod.F90 index d65cf52d3..976e95361 100644 --- a/cicecore/cicedyn/general/ice_step_mod.F90 +++ b/cicecore/cicedyn/general/ice_step_mod.F90 @@ -36,7 +36,7 @@ module ice_step_mod private public :: step_therm1, step_therm2, step_dyn_horiz, step_dyn_ridge, & - prep_radiation, step_radiation, ocean_mixed_layer, & + step_snow, prep_radiation, step_radiation, ocean_mixed_layer, & update_state, biogeochemistry, save_init, step_dyn_wave !======================================================================= @@ -163,7 +163,7 @@ subroutine step_therm1 (dt, iblk) 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, & + fswsfcn, fswintn, Sswabsn, Iswabsn, meltsliqn, meltsliq, & fswthrun, fswthrun_vdr, fswthrun_vdf, fswthrun_idr, fswthrun_idf use ice_blocks, only: block, get_block, nx_block, ny_block use ice_calendar, only: yday @@ -172,13 +172,13 @@ subroutine step_therm1 (dt, iblk) use ice_flux, only: frzmlt, sst, Tf, strocnxT, strocnyT, rside, fbot, Tbot, Tsnice, & meltsn, melttn, meltbn, congeln, snoicen, uatm, vatm, fside, & wind, rhoa, potT, Qa, zlvl, zlvs, strax, stray, flatn, fsensn, fsurfn, fcondtopn, & - flw, fsnow, fpond, sss, mlt_onset, frz_onset, fcondbotn, fcondbot, & + 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 + 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 @@ -211,11 +211,11 @@ subroutine step_therm1 (dt, iblk) 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_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_cesm, & - tr_pond_lvl, tr_pond_topo, calc_Tsfc, highfreq + tr_pond_lvl, tr_pond_topo, calc_Tsfc, highfreq, tr_snow real (kind=dbl_kind) :: & uvel_center, & ! cell-centered velocity, x component (m/s) @@ -228,6 +228,9 @@ subroutine step_therm1 (dt, iblk) 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 @@ -240,13 +243,15 @@ subroutine step_therm1 (dt, iblk) 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_cesm_out=tr_pond_cesm, & - tr_pond_lvl_out=tr_pond_lvl, tr_pond_topo_out=tr_pond_topo) + tr_pond_lvl_out=tr_pond_lvl, tr_pond_topo_out=tr_pond_topo, & + tr_snow_out=tr_snow) call icepack_query_tracer_indices( & nt_apnd_out=nt_apnd, nt_hpnd_out=nt_hpnd, nt_ipnd_out=nt_ipnd, & nt_alvl_out=nt_alvl, nt_vlvl_out=nt_vlvl, nt_Tsfc_out=nt_Tsfc, & 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, & @@ -256,7 +261,9 @@ subroutine step_therm1 (dt, iblk) prescribed_ice = .false. #endif - isosno (:,:) = c0 + rsnwn (:,:) = c0 + smicen (:,:) = c0 + smliqn (:,:) = c0 isoice (:,:) = c0 aerosno(:,:,:) = c0 aeroice(:,:,:) = c0 @@ -302,6 +309,16 @@ subroutine step_therm1 (dt, iblk) vvel_center = c0 endif ! highfreq + 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 @@ -350,6 +367,9 @@ subroutine step_therm1 (dt, iblk) ipnd = trcrn (i,j,nt_ipnd,:,iblk), & iage = trcrn (i,j,nt_iage,:,iblk), & FY = trcrn (i,j,nt_FY ,:,iblk), & + rsnwn = rsnwn (:,:), & + smicen = smicen (:,:), & + smliqn = smliqn (:,:), & aerosno = aerosno (:,:,:), & aeroice = aeroice (:,:,:), & isosno = isosno (:,:), & @@ -397,13 +417,14 @@ subroutine step_therm1 (dt, iblk) strocnyT = strocnyT (i,j, iblk), & fbot = fbot (i,j, iblk), & Tbot = Tbot (i,j, iblk), & - Tsnice = Tsnice (i,j, iblk), & + Tsnice = Tsnice (i,j, iblk), & frzmlt = frzmlt (i,j, iblk), & rside = rside (i,j, iblk), & fside = fside (i,j, iblk), & fsnow = fsnow (i,j, iblk), & frain = frain (i,j, iblk), & fpond = fpond (i,j, iblk), & + fsloss = fsloss (i,j, iblk), & fsurf = fsurf (i,j, iblk), & fsurfn = fsurfn (i,j,:,iblk), & fcondtop = fcondtop (i,j, iblk), & @@ -433,10 +454,10 @@ subroutine step_therm1 (dt, iblk) fsalt = fsalt (i,j, iblk), & fhocn = fhocn (i,j, iblk), & fswthru = fswthru (i,j, iblk), & - fswthru_vdr = fswthru_vdr (i,j, iblk),& - fswthru_vdf = fswthru_vdf (i,j, iblk),& - fswthru_idr = fswthru_idr (i,j, iblk),& - fswthru_idf = fswthru_idf (i,j, iblk),& + fswthru_vdr = fswthru_vdr (i,j, iblk), & + fswthru_vdf = fswthru_vdf (i,j, iblk), & + fswthru_idr = fswthru_idr (i,j, iblk), & + 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), & @@ -461,7 +482,10 @@ subroutine step_therm1 (dt, iblk) congeln = congeln (i,j,:,iblk), & snoice = snoice (i,j, iblk), & snoicen = snoicen (i,j,:,iblk), & + dsnow = dsnow (i,j, iblk), & dsnown = dsnown (i,j,:,iblk), & + meltsliq = meltsliq (i,j, iblk), & + 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), & @@ -483,6 +507,16 @@ subroutine step_therm1 (dt, iblk) 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) & @@ -685,13 +719,15 @@ subroutine update_state (dt, daidt, dvidt, dagedt, offset) use ice_timers, only: ice_timer_start, ice_timer_stop, timer_bound real (kind=dbl_kind), intent(in) :: & - dt , & ! time step - offset ! d(age)/dt time offset = dt for thermo, 0 for dyn + dt ! time step - real (kind=dbl_kind), dimension(:,:,:), intent(inout) :: & - 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), 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 @@ -747,6 +783,8 @@ subroutine update_state (dt, daidt, dvidt, dagedt, offset) n_trcr_strata = n_trcr_strata(:), & nt_strata = nt_strata(:,:)) + if (present(offset)) then + !----------------------------------------------------------------- ! Compute thermodynamic area and volume tendencies. !----------------------------------------------------------------- @@ -762,7 +800,8 @@ subroutine update_state (dt, daidt, dvidt, dagedt, offset) dagedt(i,j,iblk) = (trcr(i,j,nt_iage,iblk) & - dagedt(i,j,iblk)) / dt endif - endif + endif ! tr_iage + endif ! present(offset) enddo ! i enddo ! j @@ -1022,6 +1061,118 @@ subroutine step_dyn_ridge (dt, ndtd, iblk) end subroutine step_dyn_ridge +!======================================================================= +! +! Updates snow tracers +! +! authors: Elizabeth C. Hunke, LANL +! Nicole Jeffery, LANL + + subroutine step_snow (dt, iblk) + + use ice_blocks, only: block, get_block + use ice_calendar, only: nstreams + use ice_domain, only: blocks_ice + 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 + n, & ! category index + ns, & ! history streams index + ipoint ! index for print diagnostic + + 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 @@ -1067,7 +1218,7 @@ subroutine step_radiation (dt, iblk) this_block ! block information for current block integer (kind=int_kind) :: & - nt_Tsfc, nt_alvl, & + nt_Tsfc, nt_alvl, nt_rsnw, & nt_apnd, nt_hpnd, nt_ipnd, nt_aero, nlt_chl_sw, & ntrcr, nbtrcr, nbtrcr_sw, nt_fbri @@ -1078,13 +1229,14 @@ subroutine step_radiation (dt, iblk) nlt_zaero_sw, nt_zaero logical (kind=log_kind) :: & - tr_bgc_N, tr_zaero, tr_brine, dEdd_algae, modal_aero + tr_bgc_N, tr_zaero, tr_brine, dEdd_algae, modal_aero, snwgrain real (kind=dbl_kind), dimension(ncat) :: & - fbri ! brine height to ice thickness + fbri ! brine height to ice thickness real(kind= dbl_kind), dimension(:,:), allocatable :: & - ztrcr_sw + 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 @@ -1099,16 +1251,18 @@ subroutine step_radiation (dt, iblk) 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_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) + 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 @@ -1130,10 +1284,16 @@ subroutine step_radiation (dt, iblk) write (nu_diag, *) 'my_task = ',my_task enddo ! ipoint endif - fbri(:) = c0 + fbri (:) = c0 ztrcr_sw(:,:) = c0 + rsnow (:,:) = c0 do n = 1, ncat - if (tr_brine) fbri(n) = trcrn(i,j,nt_fbri,n,iblk) + 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 @@ -1182,8 +1342,7 @@ subroutine step_radiation (dt, iblk) albpndn =albpndn (i,j,: ,iblk), apeffn =apeffn (i,j,: ,iblk), & snowfracn=snowfracn(i,j,: ,iblk), & dhsn =dhsn (i,j,: ,iblk), ffracn =ffracn(i,j,:,iblk), & - l_print_point=l_print_point) - + rsnow =rsnow (:,:), l_print_point=l_print_point) endif if (dEdd_algae .and. (tr_zaero .or. tr_bgc_N)) then @@ -1202,6 +1361,7 @@ subroutine step_radiation (dt, iblk) file=__FILE__, line=__LINE__) deallocate(ztrcr_sw) + deallocate(rsnow) call ice_timer_stop(timer_sw) ! shortwave diff --git a/cicecore/cicedyn/infrastructure/comm/mpi/ice_boundary.F90 b/cicecore/cicedyn/infrastructure/comm/mpi/ice_boundary.F90 index 635bbbeb4..3959f12cf 100644 --- a/cicecore/cicedyn/infrastructure/comm/mpi/ice_boundary.F90 +++ b/cicecore/cicedyn/infrastructure/comm/mpi/ice_boundary.F90 @@ -74,7 +74,8 @@ module ice_boundary ice_HaloUpdate, & ice_HaloUpdate_stress, & ice_HaloExtrapolate, & - ice_HaloDestroy + ice_HaloDestroy, & + primary_grid_lengths_global_ext interface ice_HaloUpdate ! generic interface module procedure ice_HaloUpdate2DR8, & @@ -6807,6 +6808,136 @@ subroutine ice_HaloDestroy(halo) endif end subroutine ice_HaloDestroy +!*********************************************************************** + + subroutine primary_grid_lengths_global_ext( & + ARRAY_O, ARRAY_I, ew_boundary_type, ns_boundary_type) + +! This subroutine adds ghost cells to global primary grid lengths array +! ARRAY_I and outputs result to array ARRAY_O + +! Note duplicate implementation of this subroutine in: +! cicecore/cicedynB/infrastructure/comm/serial/ice_boundary.F90 + + use ice_constants, only: c0 + use ice_domain_size, only: nx_global, ny_global + + real (kind=dbl_kind), dimension(:,:), intent(in) :: & + ARRAY_I + + character (*), intent(in) :: & + ew_boundary_type, ns_boundary_type + + real (kind=dbl_kind), dimension(:,:), intent(out) :: & + ARRAY_O + +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer (kind=int_kind) :: & + ii, io, ji, jo + + character(len=*), parameter :: & + subname = '(primary_grid_lengths_global_ext)' + +!----------------------------------------------------------------------- +! +! add ghost cells to global primary grid lengths array +! +!----------------------------------------------------------------------- + + if (trim(ns_boundary_type) == 'tripole' .or. & + trim(ns_boundary_type) == 'tripoleT') then + call abort_ice(subname//' ERROR: '//ns_boundary_type & + //' boundary type not implemented for configuration') + endif + + do jo = 1,ny_global+2*nghost + ji = -nghost + jo + + !*** Southern ghost cells + + if (ji < 1) then + select case (trim(ns_boundary_type)) + case ('cyclic') + ji = ji + ny_global + case ('open') + ji = nghost - jo + 1 + case ('closed') + ji = 0 + case default + call abort_ice( & + subname//' ERROR: unknown north-south boundary type') + end select + endif + + !*** Northern ghost cells + + if (ji > ny_global) then + select case (trim(ns_boundary_type)) + case ('cyclic') + ji = ji - ny_global + case ('open') + ji = 2 * ny_global - ji + 1 + case ('closed') + ji = 0 + case default + call abort_ice( & + subname//' ERROR: unknown north-south boundary type') + end select + endif + + do io = 1,nx_global+2*nghost + ii = -nghost + io + + !*** Western ghost cells + + if (ii < 1) then + select case (trim(ew_boundary_type)) + case ('cyclic') + ii = ii + nx_global + case ('open') + ii = nghost - io + 1 + case ('closed') + ii = 0 + case default + call abort_ice( & + subname//' ERROR: unknown east-west boundary type') + end select + endif + + !*** Eastern ghost cells + + if (ii > nx_global) then + select case (trim(ew_boundary_type)) + case ('cyclic') + ii = ii - nx_global + case ('open') + ii = 2 * nx_global - ii + 1 + case ('closed') + ii = 0 + case default + call abort_ice( & + subname//' ERROR: unknown east-west boundary type') + end select + endif + + if (ii == 0 .or. ji == 0) then + ARRAY_O(io, jo) = c0 + else + ARRAY_O(io, jo) = ARRAY_I(ii, ji) + endif + + enddo + enddo + +!----------------------------------------------------------------------- + + end subroutine primary_grid_lengths_global_ext + !*********************************************************************** end module ice_boundary diff --git a/cicecore/cicedyn/infrastructure/comm/serial/ice_boundary.F90 b/cicecore/cicedyn/infrastructure/comm/serial/ice_boundary.F90 index c66cdd13c..f3fffba59 100644 --- a/cicecore/cicedyn/infrastructure/comm/serial/ice_boundary.F90 +++ b/cicecore/cicedyn/infrastructure/comm/serial/ice_boundary.F90 @@ -61,7 +61,8 @@ module ice_boundary ice_HaloUpdate, & ice_HaloUpdate_stress, & ice_HaloExtrapolate, & - ice_HaloDestroy + ice_HaloDestroy, & + primary_grid_lengths_global_ext interface ice_HaloUpdate ! generic interface module procedure ice_HaloUpdate2DR8, & @@ -4587,6 +4588,136 @@ subroutine ice_HaloDestroy(halo) end subroutine ice_HaloDestroy +!*********************************************************************** + + subroutine primary_grid_lengths_global_ext( & + ARRAY_O, ARRAY_I, ew_boundary_type, ns_boundary_type) + +! This subroutine adds ghost cells to global primary grid lengths array +! ARRAY_I and outputs result to array ARRAY_O + +! Note duplicate implementation of this subroutine in: +! cicecore/cicedynB/infrastructure/comm/mpi/ice_boundary.F90 + + use ice_constants, only: c0 + use ice_domain_size, only: nx_global, ny_global + + real (kind=dbl_kind), dimension(:,:), intent(in) :: & + ARRAY_I + + character (*), intent(in) :: & + ew_boundary_type, ns_boundary_type + + real (kind=dbl_kind), dimension(:,:), intent(out) :: & + ARRAY_O + +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer (kind=int_kind) :: & + ii, io, ji, jo + + character(len=*), parameter :: & + subname = '(primary_grid_lengths_global_ext)' + +!----------------------------------------------------------------------- +! +! add ghost cells to global primary grid lengths array +! +!----------------------------------------------------------------------- + + if (trim(ns_boundary_type) == 'tripole' .or. & + trim(ns_boundary_type) == 'tripoleT') then + call abort_ice(subname//' ERROR: '//ns_boundary_type & + //' boundary type not implemented for configuration') + endif + + do jo = 1,ny_global+2*nghost + ji = -nghost + jo + + !*** Southern ghost cells + + if (ji < 1) then + select case (trim(ns_boundary_type)) + case ('cyclic') + ji = ji + ny_global + case ('open') + ji = nghost - jo + 1 + case ('closed') + ji = 0 + case default + call abort_ice( & + subname//' ERROR: unknown north-south boundary type') + end select + endif + + !*** Northern ghost cells + + if (ji > ny_global) then + select case (trim(ns_boundary_type)) + case ('cyclic') + ji = ji - ny_global + case ('open') + ji = 2 * ny_global - ji + 1 + case ('closed') + ji = 0 + case default + call abort_ice( & + subname//' ERROR: unknown north-south boundary type') + end select + endif + + do io = 1,nx_global+2*nghost + ii = -nghost + io + + !*** Western ghost cells + + if (ii < 1) then + select case (trim(ew_boundary_type)) + case ('cyclic') + ii = ii + nx_global + case ('open') + ii = nghost - io + 1 + case ('closed') + ii = 0 + case default + call abort_ice( & + subname//' ERROR: unknown east-west boundary type') + end select + endif + + !*** Eastern ghost cells + + if (ii > nx_global) then + select case (trim(ew_boundary_type)) + case ('cyclic') + ii = ii - nx_global + case ('open') + ii = 2 * nx_global - ii + 1 + case ('closed') + ii = 0 + case default + call abort_ice( & + subname//' ERROR: unknown east-west boundary type') + end select + endif + + if (ii == 0 .or. ji == 0) then + ARRAY_O(io, jo) = c0 + else + ARRAY_O(io, jo) = ARRAY_I(ii, ji) + endif + + enddo + enddo + +!----------------------------------------------------------------------- + + end subroutine primary_grid_lengths_global_ext + !*********************************************************************** end module ice_boundary diff --git a/cicecore/cicedyn/infrastructure/ice_domain.F90 b/cicecore/cicedyn/infrastructure/ice_domain.F90 index 4f714195f..a2559c30b 100644 --- a/cicecore/cicedyn/infrastructure/ice_domain.F90 +++ b/cicecore/cicedyn/infrastructure/ice_domain.F90 @@ -439,7 +439,7 @@ subroutine init_domain_distribution(KMTG,ULATG) !---------------------------------------------------------------------- if (distribution_wght == 'latitude') then - flat = NINT(abs(ULATG*rad_to_deg), int_kind) ! linear function + flat = max(NINT(abs(ULATG*rad_to_deg), int_kind),1) ! linear function else flat = 1 endif diff --git a/cicecore/cicedyn/infrastructure/io/io_binary/ice_restart.F90 b/cicecore/cicedyn/infrastructure/io/io_binary/ice_restart.F90 index 94c1ce148..b7bb06d6c 100644 --- a/cicecore/cicedyn/infrastructure/io/io_binary/ice_restart.F90 +++ b/cicecore/cicedyn/infrastructure/io/io_binary/ice_restart.F90 @@ -15,11 +15,12 @@ module ice_restart use ice_fileunits, only: nu_diag, nu_rst_pointer use ice_fileunits, only: nu_dump, nu_dump_eap, nu_dump_FY, nu_dump_age use ice_fileunits, only: nu_dump_lvl, nu_dump_pond, nu_dump_hbrine - use ice_fileunits, only: nu_dump_bgc, nu_dump_aero, nu_dump_fsd, nu_dump_iso + use ice_fileunits, only: nu_dump_iso, nu_dump_snow + use ice_fileunits, only: nu_dump_bgc, nu_dump_aero, nu_dump_fsd use ice_fileunits, only: nu_restart, nu_restart_eap, nu_restart_FY, nu_restart_age use ice_fileunits, only: nu_restart_lvl, nu_restart_pond, nu_restart_hbrine use ice_fileunits, only: nu_restart_bgc, nu_restart_aero, nu_restart_fsd - use ice_fileunits, only: nu_restart_iso + use ice_fileunits, only: nu_restart_iso, nu_restart_snow use ice_exit, only: abort_ice use icepack_intfc, only: icepack_query_parameters use icepack_intfc, only: icepack_query_tracer_sizes @@ -57,7 +58,7 @@ subroutine init_restart_read(ice_ic) logical (kind=log_kind) :: & solve_zsal, tr_fsd, & tr_iage, tr_FY, tr_lvl, tr_iso, tr_aero, tr_pond_cesm, & - tr_pond_topo, tr_pond_lvl, tr_brine + tr_pond_topo, tr_pond_lvl, tr_brine, tr_snow character(len=char_len_long) :: & filename, filename0 @@ -82,7 +83,8 @@ subroutine init_restart_read(ice_ic) call icepack_query_tracer_flags( & tr_iage_out=tr_iage, tr_FY_out=tr_FY, tr_lvl_out=tr_lvl, tr_fsd_out=tr_fsd, & tr_iso_out=tr_iso, tr_aero_out=tr_aero, tr_pond_cesm_out=tr_pond_cesm, & - tr_pond_topo_out=tr_pond_topo, tr_pond_lvl_out=tr_pond_lvl, tr_brine_out=tr_brine) + tr_pond_topo_out=tr_pond_topo, tr_pond_lvl_out=tr_pond_lvl, & + tr_snow_out=tr_snow, tr_brine_out=tr_brine) call icepack_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & file=__FILE__, line=__LINE__) @@ -285,6 +287,26 @@ subroutine init_restart_read(ice_ic) endif endif + if (tr_snow) then + if (my_task == master_task) then + n = index(filename0,trim(restart_file)) + if (n == 0) call abort_ice(subname//'ERROR: snow restart: filename discrepancy') + string1 = trim(filename0(1:n-1)) + string2 = trim(filename0(n+lenstr(restart_file):lenstr(filename0))) + write(filename,'(a,a,a,a)') & + string1(1:lenstr(string1)), & + restart_file(1:lenstr(restart_file)),'.snow', & + string2(1:lenstr(string2)) + if (restart_ext) then + call ice_open_ext(nu_restart_snow,filename,0) + else + call ice_open(nu_restart_snow,filename,0) + endif + read (nu_restart_snow) iignore,rignore,rignore + write(nu_diag,*) 'Reading ',filename(1:lenstr(filename)) + endif + endif + if (tr_brine) then if (my_task == master_task) then n = index(filename0,trim(restart_file)) @@ -392,7 +414,7 @@ subroutine init_restart_write(filename_spec) logical (kind=log_kind) :: & solve_zsal, tr_fsd, & tr_iage, tr_FY, tr_lvl, tr_iso, tr_aero, tr_pond_cesm, & - tr_pond_topo, tr_pond_lvl, tr_brine + tr_pond_topo, tr_pond_lvl, tr_brine, tr_snow integer (kind=int_kind) :: & nbtrcr ! number of bgc tracers @@ -408,7 +430,8 @@ subroutine init_restart_write(filename_spec) call icepack_query_tracer_flags( & tr_iage_out=tr_iage, tr_FY_out=tr_FY, tr_lvl_out=tr_lvl, tr_fsd_out=tr_fsd, & tr_iso_out=tr_iso, tr_aero_out=tr_aero, tr_pond_cesm_out=tr_pond_cesm, & - tr_pond_topo_out=tr_pond_topo, tr_pond_lvl_out=tr_pond_lvl, tr_brine_out=tr_brine) + tr_pond_topo_out=tr_pond_topo, tr_pond_lvl_out=tr_pond_lvl, & + tr_snow_out=tr_snow, tr_brine_out=tr_brine) call icepack_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & file=__FILE__, line=__LINE__) @@ -599,6 +622,26 @@ subroutine init_restart_write(filename_spec) endif + if (tr_snow) then + + write(filename,'(a,a,a,i4.4,a,i2.2,a,i2.2,a,i5.5)') & + restart_dir(1:lenstr(restart_dir)), & + restart_file(1:lenstr(restart_file)),'.snow.', & + myear,'-',mmonth,'-',mday,'-',msec + + if (restart_ext) then + call ice_open_ext(nu_dump_snow,filename,0) + else + call ice_open(nu_dump_snow,filename,0) + endif + + if (my_task == master_task) then + write(nu_dump_snow) istep1,timesecs,time_forc + write(nu_diag,*) 'Writing ',filename(1:lenstr(filename)) + endif + + endif + if (tr_brine) then write(filename,'(a,a,a,i4.4,a,i2.2,a,i2.2,a,i5.5)') & @@ -808,7 +851,7 @@ subroutine final_restart() logical (kind=log_kind) :: & solve_zsal, & tr_iage, tr_FY, tr_lvl, tr_iso, tr_aero, tr_pond_cesm, & - tr_pond_topo, tr_pond_lvl, tr_brine + tr_pond_topo, tr_pond_lvl, tr_brine, tr_snow integer (kind=int_kind) :: & nbtrcr ! number of bgc tracers @@ -822,7 +865,8 @@ subroutine final_restart() call icepack_query_tracer_flags( & tr_iage_out=tr_iage, tr_FY_out=tr_FY, tr_lvl_out=tr_lvl, & tr_iso_out=tr_iso, tr_aero_out=tr_aero, tr_pond_cesm_out=tr_pond_cesm, & - tr_pond_topo_out=tr_pond_topo, tr_pond_lvl_out=tr_pond_lvl, tr_brine_out=tr_brine) + tr_pond_topo_out=tr_pond_topo, tr_pond_lvl_out=tr_pond_lvl, & + tr_snow_out=tr_snow, tr_brine_out=tr_brine) call icepack_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & file=__FILE__, line=__LINE__) @@ -838,6 +882,7 @@ subroutine final_restart() if (tr_pond_cesm) close(nu_dump_pond) if (tr_pond_lvl) close(nu_dump_pond) if (tr_pond_topo) close(nu_dump_pond) + if (tr_snow) close(nu_dump_snow) if (tr_brine) close(nu_dump_hbrine) if (solve_zsal .or. nbtrcr > 0) & close(nu_dump_bgc) diff --git a/cicecore/cicedyn/infrastructure/io/io_netcdf/ice_restart.F90 b/cicecore/cicedyn/infrastructure/io/io_netcdf/ice_restart.F90 index 6d0bf7221..5aaad8382 100644 --- a/cicecore/cicedyn/infrastructure/io/io_netcdf/ice_restart.F90 +++ b/cicecore/cicedyn/infrastructure/io/io_netcdf/ice_restart.F90 @@ -145,7 +145,7 @@ subroutine init_restart_write(filename_spec) logical (kind=log_kind) :: & solve_zsal, skl_bgc, z_tracers, tr_fsd, & tr_iage, tr_FY, tr_lvl, tr_iso, tr_aero, tr_pond_cesm, & - tr_pond_topo, tr_pond_lvl, tr_brine, & + tr_pond_topo, tr_pond_lvl, tr_brine, tr_snow, & tr_bgc_N, tr_bgc_C, tr_bgc_Nit, & tr_bgc_Sil, tr_bgc_DMS, & tr_bgc_chl, tr_bgc_Am, & @@ -181,7 +181,8 @@ subroutine init_restart_write(filename_spec) call icepack_query_tracer_flags( & tr_iage_out=tr_iage, tr_FY_out=tr_FY, tr_lvl_out=tr_lvl, tr_fsd_out=tr_fsd, & tr_iso_out=tr_iso, tr_aero_out=tr_aero, tr_pond_cesm_out=tr_pond_cesm, & - tr_pond_topo_out=tr_pond_topo, tr_pond_lvl_out=tr_pond_lvl, tr_brine_out=tr_brine, & + tr_pond_topo_out=tr_pond_topo, tr_pond_lvl_out=tr_pond_lvl, & + tr_snow_out=tr_snow, tr_brine_out=tr_brine, & tr_bgc_N_out=tr_bgc_N, tr_bgc_C_out=tr_bgc_C, tr_bgc_Nit_out=tr_bgc_Nit, & tr_bgc_Sil_out=tr_bgc_Sil, tr_bgc_DMS_out=tr_bgc_DMS, & tr_bgc_chl_out=tr_bgc_chl, tr_bgc_Am_out=tr_bgc_Am, & @@ -479,6 +480,16 @@ subroutine init_restart_write(filename_spec) call define_rest_field(ncid,'qsno'//trim(nchar),dims) enddo + if (tr_snow) then + do k=1,nslyr + write(nchar,'(i3.3)') k + call define_rest_field(ncid,'smice'//trim(nchar),dims) + call define_rest_field(ncid,'smliq'//trim(nchar),dims) + call define_rest_field(ncid, 'rhos'//trim(nchar),dims) + call define_rest_field(ncid, 'rsnw'//trim(nchar),dims) + enddo + endif + if (tr_fsd) then do k=1,nfsd write(nchar,'(i3.3)') k diff --git a/cicecore/cicedynB/dynamics/ice_dyn_evp.F90 b/cicecore/cicedynB/dynamics/ice_dyn_evp.F90 index bfe442085..276c8bb79 100644 --- a/cicecore/cicedynB/dynamics/ice_dyn_evp.F90 +++ b/cicecore/cicedynB/dynamics/ice_dyn_evp.F90 @@ -34,14 +34,15 @@ module ice_dyn_evp use ice_kinds_mod - use ice_communicate, only: my_task + use ice_communicate, only: my_task, master_task use ice_constants, only: field_loc_center, field_loc_NEcorner, & field_type_scalar, field_type_vector use ice_constants, only: c0, p027, p055, p111, p166, & p222, p25, p333, p5, c1 use ice_dyn_shared, only: stepu, dyn_prep1, dyn_prep2, dyn_finish, & - ndte, yield_curve, ecci, denom1, arlx1i, fcor_blk, uvel_init, & - vvel_init, basal_stress_coeff, basalstress, Ktens, revp + ndte, yield_curve, ecci, denom1, arlx1i, fcor_blk, uvel_init, vvel_init, & + seabed_stress_factor_LKD, seabed_stress_factor_prob, seabed_stress_method, & + seabed_stress, Ktens, revp use ice_fileunits, only: nu_diag use ice_exit, only: abort_ice use icepack_intfc, only: icepack_warnings_flush, icepack_warnings_aborted @@ -87,14 +88,14 @@ subroutine evp (dt) stress12_1, stress12_2, stress12_3, stress12_4 use ice_grid, only: tmask, umask, dxt, dyt, dxhy, dyhx, cxp, cyp, cxm, cym, & tarear, uarear, tinyarea, to_ugrid, t2ugrid_vector, u2tgrid_vector, & - grid_type, HTE, HTN + grid_type use ice_state, only: aice, vice, vsno, uvel, vvel, divu, shear, & aice_init, aice0, aicen, vicen, strength use ice_timers, only: timer_dynamics, timer_bound, & ice_timer_start, ice_timer_stop, timer_evp_1d, timer_evp_2d use ice_dyn_evp_1d, only: ice_dyn_evp_1d_copyin, ice_dyn_evp_1d_kernel, & ice_dyn_evp_1d_copyout - use ice_dyn_shared, only: kevp_kernel, stack_velocity_field, unstack_velocity_field + use ice_dyn_shared, only: evp_algorithm, stack_velocity_field, unstack_velocity_field real (kind=dbl_kind), intent(in) :: & dt ! time step @@ -325,129 +326,140 @@ subroutine evp (dt) endif !----------------------------------------------------------------- - ! basal stress coefficients (landfast ice) + ! seabed stress factor Tbu (Tbu is part of Cb coefficient) !----------------------------------------------------------------- - if (basalstress) then - !$OMP PARALLEL DO PRIVATE(iblk) - do iblk = 1, nblocks - call basal_stress_coeff (nx_block, ny_block, & - icellu (iblk), & - indxui(:,iblk), indxuj(:,iblk), & - vice(:,:,iblk), aice(:,:,iblk), & - hwater(:,:,iblk), Tbu(:,:,iblk)) - enddo + if (seabed_stress) then + + !$OMP PARALLEL DO PRIVATE(iblk) + do iblk = 1, nblocks + + if ( seabed_stress_method == 'LKD' ) then + + call seabed_stress_factor_LKD (nx_block, ny_block, & + icellu (iblk), & + indxui(:,iblk), indxuj(:,iblk), & + vice(:,:,iblk), aice(:,:,iblk), & + hwater(:,:,iblk), Tbu(:,:,iblk)) + + elseif ( seabed_stress_method == 'probabilistic' ) then + + call seabed_stress_factor_prob (nx_block, ny_block, & + icellt(iblk), indxti(:,iblk), indxtj(:,iblk), & + icellu(iblk), indxui(:,iblk), indxuj(:,iblk), & + aicen(:,:,:,iblk), vicen(:,:,:,iblk), & + hwater(:,:,iblk), Tbu(:,:,iblk)) + endif + + enddo !$OMP END PARALLEL DO endif + call ice_timer_start(timer_evp_2d) - if (kevp_kernel > 0) then - if (first_time .and. my_task == 0) then - write(nu_diag,'(2a,i6)') subname,' Entering kevp_kernel version ',kevp_kernel - first_time = .false. - endif - if (trim(grid_type) == 'tripole') then - call abort_ice(trim(subname)//' Kernel not tested on tripole grid. Set kevp_kernel=0') - endif - call ice_dyn_evp_1d_copyin( & - nx_block,ny_block,nblocks,nx_global+2*nghost,ny_global+2*nghost, & - HTE,HTN, & -!v1 dxhy,dyhx,cyp,cxp,cym,cxm,tinyarea, & -!v1 waterx,watery, & - icetmask, iceumask, & - cdn_ocn,aiu,uocn,vocn,forcex,forcey,Tbu, & - umassdti,fm,uarear,tarear,strintx,strinty,uvel_init,vvel_init,& - strength,uvel,vvel,dxt,dyt, & - stressp_1 ,stressp_2, stressp_3, stressp_4, & - stressm_1 ,stressm_2, stressm_3, stressm_4, & - stress12_1,stress12_2,stress12_3,stress12_4 ) - if (kevp_kernel == 2) then - call ice_timer_start(timer_evp_1d) - call ice_dyn_evp_1d_kernel() - call ice_timer_stop(timer_evp_1d) -!v1 else if (kevp_kernel == 1) then -!v1 call evp_kernel_v1() - else - if (my_task == 0) write(nu_diag,*) subname,' ERROR: kevp_kernel = ',kevp_kernel - call abort_ice(subname//' kevp_kernel not supported.') - endif - call ice_dyn_evp_1d_copyout( & - nx_block,ny_block,nblocks,nx_global+2*nghost,ny_global+2*nghost,& -!strocn uvel,vvel, strocnx,strocny, strintx,strinty, & - uvel,vvel, strintx,strinty, & - stressp_1, stressp_2, stressp_3, stressp_4, & - stressm_1, stressm_2, stressm_3, stressm_4, & - stress12_1,stress12_2,stress12_3,stress12_4, & - divu,rdg_conv,rdg_shear,shear,taubx,tauby ) - - else ! kevp_kernel == 0 (Standard CICE) - - do ksub = 1,ndte ! subcycling - - !----------------------------------------------------------------- - ! stress tensor equation, total surface stress - !----------------------------------------------------------------- - - !$TCXOMP PARALLEL DO PRIVATE(iblk,strtmp) - do iblk = 1, nblocks -! if (trim(yield_curve) == 'ellipse') then - call stress (nx_block, ny_block, & - ksub, icellt(iblk), & - indxti (:,iblk), indxtj (:,iblk), & - uvel (:,:,iblk), vvel (:,:,iblk), & - dxt (:,:,iblk), dyt (:,:,iblk), & - dxhy (:,:,iblk), dyhx (:,:,iblk), & - cxp (:,:,iblk), cyp (:,:,iblk), & - cxm (:,:,iblk), cym (:,:,iblk), & - tarear (:,:,iblk), tinyarea (:,:,iblk), & - strength (:,:,iblk), & - stressp_1 (:,:,iblk), stressp_2 (:,:,iblk), & - stressp_3 (:,:,iblk), stressp_4 (:,:,iblk), & - stressm_1 (:,:,iblk), stressm_2 (:,:,iblk), & - stressm_3 (:,:,iblk), stressm_4 (:,:,iblk), & - stress12_1(:,:,iblk), stress12_2(:,:,iblk), & - stress12_3(:,:,iblk), stress12_4(:,:,iblk), & - shear (:,:,iblk), divu (:,:,iblk), & - rdg_conv (:,:,iblk), rdg_shear (:,:,iblk), & - strtmp (:,:,:) ) -! endif ! yield_curve - - !----------------------------------------------------------------- - ! momentum equation - !----------------------------------------------------------------- - - call stepu (nx_block, ny_block, & - icellu (iblk), Cdn_ocn (:,:,iblk), & - indxui (:,iblk), indxuj (:,iblk), & - ksub, & - aiu (:,:,iblk), strtmp (:,:,:), & - uocn (:,:,iblk), vocn (:,:,iblk), & - waterx (:,:,iblk), watery (:,:,iblk), & - forcex (:,:,iblk), forcey (:,:,iblk), & - umassdti (:,:,iblk), fm (:,:,iblk), & - uarear (:,:,iblk), & - strintx (:,:,iblk), strinty (:,:,iblk), & - taubx (:,:,iblk), tauby (:,:,iblk), & - uvel_init(:,:,iblk), vvel_init(:,:,iblk),& - uvel (:,:,iblk), vvel (:,:,iblk), & - Tbu (:,:,iblk)) - enddo - !$TCXOMP END PARALLEL DO + if (evp_algorithm == "shared_mem_1d" ) then - call stack_velocity_field(uvel, vvel, 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) + if (first_time .and. my_task == master_task) then + write(nu_diag,'(3a)') subname,' Entering evp_algorithm version ',evp_algorithm + first_time = .false. endif - call ice_timer_stop(timer_bound) - call unstack_velocity_field(fld2, uvel, vvel) + if (trim(grid_type) == 'tripole') then + call abort_ice(trim(subname)//' & + & Kernel not tested on tripole grid. Set evp_algorithm=standard_2d') + endif + + call ice_dyn_evp_1d_copyin( & + nx_block,ny_block,nblocks,nx_global+2*nghost,ny_global+2*nghost, & + icetmask, iceumask, & + cdn_ocn,aiu,uocn,vocn,forcex,forcey,Tbu, & + umassdti,fm,uarear,tarear,strintx,strinty,uvel_init,vvel_init,& + strength,uvel,vvel,dxt,dyt, & + stressp_1 ,stressp_2, stressp_3, stressp_4, & + stressm_1 ,stressm_2, stressm_3, stressm_4, & + stress12_1,stress12_2,stress12_3,stress12_4 ) + call ice_timer_start(timer_evp_1d) + call ice_dyn_evp_1d_kernel() + call ice_timer_stop(timer_evp_1d) + call ice_dyn_evp_1d_copyout( & + nx_block,ny_block,nblocks,nx_global+2*nghost,ny_global+2*nghost,& +!strocn uvel,vvel, strocnx,strocny, strintx,strinty, & + uvel,vvel, strintx,strinty, & + stressp_1, stressp_2, stressp_3, stressp_4, & + stressm_1, stressm_2, stressm_3, stressm_4, & + stress12_1,stress12_2,stress12_3,stress12_4, & + divu,rdg_conv,rdg_shear,shear,taubx,tauby ) + + else ! evp_algorithm == standard_2d (Standard CICE) + + do ksub = 1,ndte ! subcycling + + !----------------------------------------------------------------- + ! stress tensor equation, total surface stress + !----------------------------------------------------------------- + + !$TCXOMP PARALLEL DO PRIVATE(iblk,strtmp) + do iblk = 1, nblocks + +! if (trim(yield_curve) == 'ellipse') then + call stress (nx_block, ny_block, & + ksub, icellt(iblk), & + indxti (:,iblk), indxtj (:,iblk), & + uvel (:,:,iblk), vvel (:,:,iblk), & + dxt (:,:,iblk), dyt (:,:,iblk), & + dxhy (:,:,iblk), dyhx (:,:,iblk), & + cxp (:,:,iblk), cyp (:,:,iblk), & + cxm (:,:,iblk), cym (:,:,iblk), & + tarear (:,:,iblk), tinyarea (:,:,iblk), & + strength (:,:,iblk), & + stressp_1 (:,:,iblk), stressp_2 (:,:,iblk), & + stressp_3 (:,:,iblk), stressp_4 (:,:,iblk), & + stressm_1 (:,:,iblk), stressm_2 (:,:,iblk), & + stressm_3 (:,:,iblk), stressm_4 (:,:,iblk), & + stress12_1(:,:,iblk), stress12_2(:,:,iblk), & + stress12_3(:,:,iblk), stress12_4(:,:,iblk), & + shear (:,:,iblk), divu (:,:,iblk), & + rdg_conv (:,:,iblk), rdg_shear (:,:,iblk), & + strtmp (:,:,:) ) +! endif ! yield_curve + + !----------------------------------------------------------------- + ! momentum equation + !----------------------------------------------------------------- + + call stepu (nx_block, ny_block, & + icellu (iblk), Cdn_ocn (:,:,iblk), & + indxui (:,iblk), indxuj (:,iblk), & + ksub, & + aiu (:,:,iblk), strtmp (:,:,:), & + uocn (:,:,iblk), vocn (:,:,iblk), & + waterx (:,:,iblk), watery (:,:,iblk), & + forcex (:,:,iblk), forcey (:,:,iblk), & + umassdti (:,:,iblk), fm (:,:,iblk), & + uarear (:,:,iblk), & + strintx (:,:,iblk), strinty (:,:,iblk), & + taubx (:,:,iblk), tauby (:,:,iblk), & + uvel_init(:,:,iblk), vvel_init(:,:,iblk),& + uvel (:,:,iblk), vvel (:,:,iblk), & + Tbu (:,:,iblk)) + + enddo + !$TCXOMP END PARALLEL DO + + call stack_velocity_field(uvel, vvel, 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_velocity_field(fld2, uvel, vvel) - enddo ! subcycling - endif ! kevp_kernel + enddo ! subcycling + endif ! evp_algorithm + call ice_timer_stop(timer_evp_2d) deallocate(fld2) @@ -595,12 +607,12 @@ subroutine stress (nx_block, ny_block, & vvel , & ! y-component of velocity (m/s) dxt , & ! width of T-cell through the middle (m) dyt , & ! height of T-cell through the middle (m) - dxhy , & ! 0.5*(HTE - HTE) - dyhx , & ! 0.5*(HTN - HTN) - cyp , & ! 1.5*HTE - 0.5*HTE - cxp , & ! 1.5*HTN - 0.5*HTN - cym , & ! 0.5*HTE - 1.5*HTE - cxm , & ! 0.5*HTN - 1.5*HTN + dxhy , & ! 0.5*(HTE - HTW) + dyhx , & ! 0.5*(HTN - HTS) + cyp , & ! 1.5*HTE - 0.5*HTW + cxp , & ! 1.5*HTN - 0.5*HTS + cym , & ! 0.5*HTE - 1.5*HTW + cxm , & ! 0.5*HTN - 1.5*HTS tarear , & ! 1/tarea tinyarea ! puny*tarea diff --git a/cicecore/cicedynB/dynamics/ice_dyn_evp_1d.F90 b/cicecore/cicedynB/dynamics/ice_dyn_evp_1d.F90 old mode 100644 new mode 100755 index 9fac97a89..c691453cb --- a/cicecore/cicedynB/dynamics/ice_dyn_evp_1d.F90 +++ b/cicecore/cicedynB/dynamics/ice_dyn_evp_1d.F90 @@ -1,2135 +1,1941 @@ -! ice_dyn_evp_1d +!======================================================================= ! -! Contained 3 Fortran modules, -! * dmi_omp -! * bench_v2 -! * ice_dyn_evp_1d -! These were merged into one module, ice_dyn_evp_1d to support some -! coupled build systems. +! Elastic-viscous-plastic sea ice dynamics model (1D implementations) +! Computes ice velocity and deformation ! -! Modules used for: -! * convert 2D arrays into 1D vectors -! * Do stress/stepu/halo_update interations -! * convert 1D vectors into 2D matrices -! -! Call from ice_dyn_evp.F90: -! call ice_dyn_evp_1d_copyin(...) -! call ice_dyn_evp_1d_kernel() -! call ice_dyn_evp_1d_copyout(...) -! -! * REAL4 internal version: -! mv evp_kernel1d.F90 evp_kernel1d_r8.F90 -! cat evp_kernel1d_r8.F90 | sed s/DBL_KIND/REAL_KIND/g > evp_kernel1d.F90 -! -! * !v1 : a) "dxhy,dyhx,cyp,cxp,cym,cxm,tinyarea" input variables is replaced by -! "HTE,HTN"->"HTE,HTN,HTEm1,HTNm1" and variables are calculated in-line -! b) "waterx,watery" is calculated using existing input "uocn,vocn" -! -! Jacob Weismann Poulsen (JWP), Mads Hvid Ribergaard (MHRI), DMI -!=============================================================================== +! authors: Jacob Weismann Poulsen, DMI +! Mads Hvid Ribergaard, DMI -!=============================================================================== - -!-- One dimension representation of EVP 2D arrays used for EVP kernels module ice_dyn_evp_1d - use ice_kinds_mod - use ice_fileunits, only: nu_diag - use ice_exit, only: abort_ice - use icepack_intfc, only: icepack_query_parameters - use icepack_intfc, only: icepack_warnings_flush, icepack_warnings_aborted - - implicit none - private - public :: ice_dyn_evp_1d_copyin, ice_dyn_evp_1d_copyout, ice_dyn_evp_1d_kernel - - interface ice_dyn_evp_1d_copyin -! module procedure evp_copyin_v1 - module procedure evp_copyin_v2 - end interface - - interface ice_dyn_evp_1d_kernel -! module procedure evp_kernel_v1 - module procedure evp_kernel_v2 - end interface - - interface ice_dyn_evp_1d_copyout - module procedure evp_copyout - end interface - - interface convert_2d_1d -! module procedure convert_2d_1d_v1 - module procedure convert_2d_1d_v2 - end interface - - integer(kind=int_kind) :: & - NA_len, NAVEL_len - logical(kind=log_kind), dimension(:), allocatable :: & - skipucell - integer(kind=int_kind), dimension(:), allocatable :: & - ee,ne,se,nw,sw,sse,indi,indj,indij , halo_parent - real (kind=dbl_kind), dimension(:), allocatable :: & - cdn_ocn,aiu,uocn,vocn,forcex,forcey,Tbu,tarear, & - umassdti,fm,uarear,strintx,strinty,uvel_init,vvel_init - real (kind=dbl_kind), dimension(:), allocatable :: & - strength,uvel,vvel,dxt,dyt, & -!v1 dxhy,dyhx,cyp,cxp,cym,cxm,tinyarea, & -!v1 waterx,watery, & - stressp_1, stressp_2, stressp_3, stressp_4, & - stressm_1, stressm_2, stressm_3, stressm_4, & - stress12_1,stress12_2,stress12_3,stress12_4, & - divu,rdg_conv,rdg_shear,shear,taubx,tauby - real (kind=DBL_KIND), dimension(:), allocatable :: & - str1, str2, str3, str4, str5, str6, str7, str8 - real (kind=dbl_kind), dimension(:), allocatable :: & - HTE,HTN, & - HTEm1,HTNm1 - logical(kind=log_kind),parameter :: dbug = .false. - - -!--- dmi_omp --------------------------- - interface domp_get_domain - module procedure domp_get_domain_rlu - end interface - - INTEGER, PARAMETER :: JPIM = SELECTED_INT_KIND(9) - integer(int_kind) :: domp_iam, domp_nt + use ice_kinds_mod + use ice_fileunits, only : nu_diag + use ice_exit, only : abort_ice + use icepack_intfc, only : icepack_query_parameters + use icepack_intfc, only : icepack_warnings_flush, & + icepack_warnings_aborted + implicit none + private + public :: ice_dyn_evp_1d_copyin, ice_dyn_evp_1d_copyout, & + ice_dyn_evp_1d_kernel + + integer(kind=int_kind) :: NA_len, NAVEL_len, domp_iam, domp_nt #if defined (_OPENMP) - ! Please note, this constant will create a compiler info for a constant - ! expression in IF statements: - real(kind=dbl_kind) :: rdomp_iam, rdomp_nt - !$OMP THREADPRIVATE(domp_iam,domp_nt,rdomp_iam,rdomp_nt) + real(kind=dbl_kind) :: rdomp_iam, rdomp_nt + !$OMP THREADPRIVATE(domp_iam, domp_nt, rdomp_iam, rdomp_nt) #endif -!--- dmi_omp --------------------------- - -!--- bench_v2 -------------------------- - interface evp1d_stress - module procedure stress_i - module procedure stress_l - end interface - interface evp1d_stepu - module procedure stepu_iter - module procedure stepu_last - end interface -!--- bench_v2 -------------------------- + logical(kind=log_kind), dimension(:), allocatable :: skiptcell, skipucell + integer(kind=int_kind), dimension(:), allocatable :: ee, ne, se, & + nw, sw, sse, indi, indj, indij, halo_parent + real(kind=dbl_kind), dimension(:), allocatable :: cdn_ocn, aiu, & + uocn, vocn, forcex, forcey, Tbu, tarear, umassdti, fm, uarear, & + strintx, strinty, uvel_init, vvel_init, strength, uvel, vvel, & + dxt, dyt, stressp_1, stressp_2, stressp_3, stressp_4, stressm_1, & + stressm_2, stressm_3, stressm_4, stress12_1, stress12_2, & + stress12_3, stress12_4, divu, rdg_conv, rdg_shear, shear, taubx, & + tauby, str1, str2, str3, str4, str5, str6, str7, str8, HTE, HTN, & + HTEm1, HTNm1 + integer, parameter :: JPIM = selected_int_kind(9) + + interface evp1d_stress + module procedure stress_iter + module procedure stress_last + end interface + + interface evp1d_stepu + module procedure stepu_iter + module procedure stepu_last + end interface + +!======================================================================= + +contains + +!======================================================================= + + subroutine domp_init +#if defined (_OPENMP) - contains + use omp_lib, only : omp_get_thread_num, omp_get_num_threads +#endif -!=============================================================================== -!former module dmi_omp + implicit none - subroutine domp_init(nt_out) + character(len=*), parameter :: subname = '(domp_init)' + !$OMP PARALLEL DEFAULT(none) #if defined (_OPENMP) - use omp_lib, only : omp_get_thread_num, omp_get_num_threads + domp_iam = omp_get_thread_num() + rdomp_iam = real(domp_iam, dbl_kind) + domp_nt = omp_get_num_threads() + rdomp_nt = real(domp_nt, dbl_kind) +#else + domp_iam = 0 + domp_nt = 1 #endif + !$OMP END PARALLEL - integer(int_kind), intent(out) :: nt_out + end subroutine domp_init - character(len=*), parameter :: subname = '(domp_init)' - !--------------------------------------- +!======================================================================= - !$OMP PARALLEL DEFAULT(none) + subroutine domp_get_domain(lower, upper, d_lower, d_upper) #if defined (_OPENMP) - domp_iam = omp_get_thread_num() - rdomp_iam = real(domp_iam,dbl_kind) - domp_nt = omp_get_num_threads() - rdomp_nt = real(domp_nt,dbl_kind) -#else - domp_iam = 0 - domp_nt = 1 -#endif - !$OMP END PARALLEL - - if (dbug) then -#if defined (_OPENACC) - write(nu_diag,'(2a)') subname,' Build with openACC support' -!#elif defined (_OPENMP) -! write(nu_diag,'(2a)') subname,' Build with openMP support' -!#else -! write(nu_diag,'(2a)') subname,' Build without openMP and openACC support' + + use omp_lib, only : omp_in_parallel + use ice_constants, only : p5 #endif - !- echo #threads: - if (domp_nt > 1) then - write(nu_diag,'(2a,i5,a)') subname,' Running openMP with ', domp_nt, ' threads' - else + implicit none + + integer(kind=JPIM), intent(in) :: lower, upper + integer(kind=JPIM), intent(out) :: d_lower, d_upper + + ! local variables #if defined (_OPENMP) - write(nu_diag,'(2a)') subname,' Running openMP with a single thread' -#else - write(nu_diag,'(2a)') subname,' Running without openMP' -#endif - endif - endif - !- return value of #threads: - nt_out = domp_nt + real(kind=dbl_kind) :: dlen +#endif - end subroutine domp_init - -!---------------------------------------------------------------------------- + character(len=*), parameter :: subname = '(domp_get_domain)' - subroutine domp_get_domain_rlu(lower,upper,d_lower,d_upper) + ! proper action in "null" case + if (upper <= 0 .or. upper < lower) then + d_lower = 0 + d_upper = -1 + return + end if + ! proper action in serial case + d_lower = lower + d_upper = upper #if defined (_OPENMP) - use omp_lib, only : omp_in_parallel - use ice_constants, only: p5 + + if (omp_in_parallel()) then + dlen = real((upper - lower + 1), dbl_kind) + d_lower = lower + floor(((rdomp_iam * dlen + p5) / rdomp_nt), JPIM) + d_upper = lower - 1 + floor(((rdomp_iam * dlen + dlen + p5) / rdomp_nt), JPIM) + end if #endif - integer(KIND=JPIM), intent(in) :: lower,upper - integer(KIND=JPIM), intent(out) :: d_lower,d_upper + end subroutine domp_get_domain + +!======================================================================= + + subroutine stress_iter(NA_len, ee, ne, se, lb, ub, uvel, vvel, dxt, & + dyt, hte, htn, htem1, htnm1, strength, stressp_1, stressp_2, & + stressp_3, stressp_4, stressm_1, stressm_2, stressm_3, & + stressm_4, stress12_1, stress12_2, stress12_3, stress12_4, str1, & + str2, str3, str4, str5, str6, str7, str8, skiptcell) + + use ice_kinds_mod + use ice_constants, only : p027, p055, p111, p166, p222, p25, & + p333, p5, c1p5, c1 + use ice_dyn_shared, only : ecci, denom1, arlx1i, Ktens, revp + + implicit none + + integer(kind=int_kind), intent(in) :: NA_len, lb, ub + integer(kind=int_kind), dimension(:), intent(in), contiguous :: & + ee, ne, se + real(kind=dbl_kind), dimension(:), intent(in), contiguous :: & + strength, uvel, vvel, dxt, dyt, hte, htn, htem1, htnm1 + logical(kind=log_kind), intent(in), dimension(:) :: skiptcell + real(kind=dbl_kind), dimension(:), intent(inout), contiguous :: & + stressp_1, stressp_2, stressp_3, stressp_4, stressm_1, & + stressm_2, stressm_3, stressm_4, stress12_1, stress12_2, & + stress12_3, stress12_4 + real(kind=dbl_kind), dimension(:), intent(out), contiguous :: & + str1, str2, str3, str4, str5, str6, str7, str8 + + ! local variables + + integer(kind=int_kind) :: iw, il, iu + real(kind=dbl_kind) :: puny, divune, divunw, divuse, divusw, & + tensionne, tensionnw, tensionse, tensionsw, shearne, shearnw, & + shearse, shearsw, Deltane, Deltanw, Deltase, Deltasw, c0ne, & + c0nw, c0se, c0sw, c1ne, c1nw, c1se, c1sw, ssigpn, ssigps, & + ssigpe, ssigpw, ssigmn, ssigms, ssigme, ssigmw, ssig12n, & + ssig12s, ssig12e, ssig12w, ssigp1, ssigp2, ssigm1, ssigm2, & + ssig121, ssig122, csigpne, csigpnw, csigpse, csigpsw, & + csigmne, csigmnw, csigmse, csigmsw, csig12ne, csig12nw, & + csig12se, csig12sw, str12ew, str12we, str12ns, str12sn, & + strp_tmp, strm_tmp, tmp_uvel_ee, tmp_vvel_se, tmp_vvel_ee, & + tmp_vvel_ne, tmp_uvel_ne, tmp_uvel_se, dxhy, dyhx, cxp, cyp, & + cxm, cym, tinyarea,tmparea + + character(len=*), parameter :: subname = '(stress_iter)' + + call icepack_query_parameters(puny_out=puny) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) then + call abort_ice(error_message=subname, file=__FILE__, & + line=__LINE__) + end if -#if defined (_OPENMP) - !-- local variables - real(kind=dbl_kind) :: dlen +#ifdef _OPENACC + !$acc parallel & + !$acc present(ee, ne, se, strength, uvel, vvel, dxt, dyt, hte, & + !$acc htn, htem1, htnm1, str1, str2, str3, str4, str5, str6, & + !$acc str7, str8, stressp_1, stressp_2, stressp_3, stressp_4, & + !$acc stressm_1, stressm_2, stressm_3, stressm_4, stress12_1, & + !$acc stress12_2, stress12_3, stress12_4, skiptcell) + !$acc loop + do iw = 1, NA_len +#else + call domp_get_domain(lb, ub, il, iu) + do iw = il, iu #endif - character(len=*), parameter :: subname = '(domp_get_domain_rlu)' - !--------------------------------------- + if (skiptcell(iw)) cycle + + tmparea = dxt(iw) * dyt(iw) ! necessary to split calc of tinyarea. Otherwize not binary identical + tinyarea = puny * tmparea + dxhy = p5 * (hte(iw) - htem1(iw)) + dyhx = p5 * (htn(iw) - htnm1(iw)) + cxp = c1p5 * htn(iw) - p5 * htnm1(iw) + cyp = c1p5 * hte(iw) - p5 * htem1(iw) + cxm = -(c1p5 * htnm1(iw) - p5 * htn(iw)) + cym = -(c1p5 * htem1(iw) - p5 * hte(iw)) + + !-------------------------------------------------------------- + ! strain rates + ! NOTE: these are actually strain rates * area (m^2/s) + !-------------------------------------------------------------- + + tmp_uvel_ne = uvel(ne(iw)) + tmp_uvel_se = uvel(se(iw)) + tmp_uvel_ee = uvel(ee(iw)) + + tmp_vvel_ee = vvel(ee(iw)) + tmp_vvel_se = vvel(se(iw)) + tmp_vvel_ne = vvel(ne(iw)) + ! divergence = e_11 + e_22 + divune = cyp * uvel(iw) - dyt(iw) * tmp_uvel_ee & + + cxp * vvel(iw) - dxt(iw) * tmp_vvel_se + divunw = cym * tmp_uvel_ee + dyt(iw) * uvel(iw) & + + cxp * tmp_vvel_ee - dxt(iw) * tmp_vvel_ne + divusw = cym * tmp_uvel_ne + dyt(iw) * tmp_uvel_se & + + cxm * tmp_vvel_ne + dxt(iw) * tmp_vvel_ee + divuse = cyp * tmp_uvel_se - dyt(iw) * tmp_uvel_ne & + + cxm * tmp_vvel_se + dxt(iw) * vvel(iw) + + ! tension strain rate = e_11 - e_22 + tensionne = -cym * uvel(iw) - dyt(iw) * tmp_uvel_ee & + + cxm * vvel(iw) + dxt(iw) * tmp_vvel_se + tensionnw = -cyp * tmp_uvel_ee + dyt(iw) * uvel(iw) & + + cxm * tmp_vvel_ee + dxt(iw) * tmp_vvel_ne + tensionsw = -cyp * tmp_uvel_ne + dyt(iw) * tmp_uvel_se & + + cxp * tmp_vvel_ne - dxt(iw) * tmp_vvel_ee + tensionse = -cym * tmp_uvel_se - dyt(iw) * tmp_uvel_ne & + + cxp * tmp_vvel_se - dxt(iw) * vvel(iw) + + ! shearing strain rate = 2 * e_12 + shearne = -cym * vvel(iw) - dyt(iw) * tmp_vvel_ee & + - cxm * uvel(iw) - dxt(iw) * tmp_uvel_se + shearnw = -cyp * tmp_vvel_ee + dyt(iw) * vvel(iw) & + - cxm * tmp_uvel_ee - dxt(iw) * tmp_uvel_ne + shearsw = -cyp * tmp_vvel_ne + dyt(iw) * tmp_vvel_se & + - cxp * tmp_uvel_ne + dxt(iw) * tmp_uvel_ee + shearse = -cym * tmp_vvel_se - dyt(iw) * tmp_vvel_ne & + - cxp * tmp_uvel_se + dxt(iw) * uvel(iw) + + ! Delta (in the denominator of zeta and eta) + Deltane = sqrt(divune**2 + ecci * (tensionne**2 + shearne**2)) + Deltanw = sqrt(divunw**2 + ecci * (tensionnw**2 + shearnw**2)) + Deltasw = sqrt(divusw**2 + ecci * (tensionsw**2 + shearsw**2)) + Deltase = sqrt(divuse**2 + ecci * (tensionse**2 + shearse**2)) + + !-------------------------------------------------------------- + ! replacement pressure/Delta (kg/s) + ! save replacement pressure for principal stress calculation + !-------------------------------------------------------------- + + c0ne = strength(iw) / max(Deltane, tinyarea) + c0nw = strength(iw) / max(Deltanw, tinyarea) + c0sw = strength(iw) / max(Deltasw, tinyarea) + c0se = strength(iw) / max(Deltase, tinyarea) + + c1ne = c0ne * arlx1i + c1nw = c0nw * arlx1i + c1sw = c0sw * arlx1i + c1se = c0se * arlx1i + + c0ne = c1ne * ecci + c0nw = c1nw * ecci + c0sw = c1sw * ecci + c0se = c1se * ecci + + !-------------------------------------------------------------- + ! the stresses (kg/s^2) + ! (1) northeast, (2) northwest, (3) southwest, (4) southeast + !-------------------------------------------------------------- + + stressp_1(iw) = (stressp_1(iw) * (c1 - arlx1i * revp) & + + c1ne * (divune * (c1 + Ktens) - Deltane * (c1 - Ktens))) * denom1 + stressp_2(iw) = (stressp_2(iw) * (c1 - arlx1i * revp) & + + c1nw * (divunw * (c1 + Ktens) - Deltanw * (c1 - Ktens))) * denom1 + stressp_3(iw) = (stressp_3(iw) * (c1 - arlx1i * revp) & + + c1sw * (divusw * (c1 + Ktens) - Deltasw * (c1 - Ktens))) * denom1 + stressp_4(iw) = (stressp_4(iw) * (c1 - arlx1i * revp) & + + c1se * (divuse * (c1 + Ktens) - Deltase * (c1 - Ktens))) * denom1 + + stressm_1(iw) = (stressm_1(iw) * (c1 - arlx1i * revp) + c0ne * tensionne * (c1 + Ktens)) * denom1 + stressm_2(iw) = (stressm_2(iw) * (c1 - arlx1i * revp) + c0nw * tensionnw * (c1 + Ktens)) * denom1 + stressm_3(iw) = (stressm_3(iw) * (c1 - arlx1i * revp) + c0sw * tensionsw * (c1 + Ktens)) * denom1 + stressm_4(iw) = (stressm_4(iw) * (c1 - arlx1i * revp) + c0se * tensionse * (c1 + Ktens)) * denom1 + + stress12_1(iw) = (stress12_1(iw) * (c1 - arlx1i * revp) + c0ne * shearne * p5 * (c1 + Ktens)) * denom1 + stress12_2(iw) = (stress12_2(iw) * (c1 - arlx1i * revp) + c0nw * shearnw * p5 * (c1 + Ktens)) * denom1 + stress12_3(iw) = (stress12_3(iw) * (c1 - arlx1i * revp) + c0sw * shearsw * p5 * (c1 + Ktens)) * denom1 + stress12_4(iw) = (stress12_4(iw) * (c1 - arlx1i * revp) + c0se * shearse * p5 * (c1 + Ktens)) * denom1 + + !-------------------------------------------------------------- + ! combinations of the stresses for the momentum equation + ! (kg/s^2) + !-------------------------------------------------------------- + + ssigpn = stressp_1(iw) + stressp_2(iw) + ssigps = stressp_3(iw) + stressp_4(iw) + ssigpe = stressp_1(iw) + stressp_4(iw) + ssigpw = stressp_2(iw) + stressp_3(iw) + ssigp1 = (stressp_1(iw) + stressp_3(iw)) * p055 + ssigp2 = (stressp_2(iw) + stressp_4(iw)) * p055 + + ssigmn = stressm_1(iw) + stressm_2(iw) + ssigms = stressm_3(iw) + stressm_4(iw) + ssigme = stressm_1(iw) + stressm_4(iw) + ssigmw = stressm_2(iw) + stressm_3(iw) + ssigm1 = (stressm_1(iw) + stressm_3(iw)) * p055 + ssigm2 = (stressm_2(iw) + stressm_4(iw)) * p055 + + ssig12n = stress12_1(iw) + stress12_2(iw) + ssig12s = stress12_3(iw) + stress12_4(iw) + ssig12e = stress12_1(iw) + stress12_4(iw) + ssig12w = stress12_2(iw) + stress12_3(iw) + ssig121 = (stress12_1(iw) + stress12_3(iw)) * p111 + ssig122 = (stress12_2(iw) + stress12_4(iw)) * p111 + + csigpne = p111 * stressp_1(iw) + ssigp2 + p027 * stressp_3(iw) + csigpnw = p111 * stressp_2(iw) + ssigp1 + p027 * stressp_4(iw) + csigpsw = p111 * stressp_3(iw) + ssigp2 + p027 * stressp_1(iw) + csigpse = p111 * stressp_4(iw) + ssigp1 + p027 * stressp_2(iw) + + csigmne = p111 * stressm_1(iw) + ssigm2 + p027 * stressm_3(iw) + csigmnw = p111 * stressm_2(iw) + ssigm1 + p027 * stressm_4(iw) + csigmsw = p111 * stressm_3(iw) + ssigm2 + p027 * stressm_1(iw) + csigmse = p111 * stressm_4(iw) + ssigm1 + p027 * stressm_2(iw) + + csig12ne = p222 * stress12_1(iw) + ssig122 + p055 * stress12_3(iw) + csig12nw = p222 * stress12_2(iw) + ssig121 + p055 * stress12_4(iw) + csig12sw = p222 * stress12_3(iw) + ssig122 + p055 * stress12_1(iw) + csig12se = p222 * stress12_4(iw) + ssig121 + p055 * stress12_2(iw) + + str12ew = p5 * dxt(iw) * (p333 * ssig12e + p166 * ssig12w) + str12we = p5 * dxt(iw) * (p333 * ssig12w + p166 * ssig12e) + str12ns = p5 * dyt(iw) * (p333 * ssig12n + p166 * ssig12s) + str12sn = p5 * dyt(iw) * (p333 * ssig12s + p166 * ssig12n) + + !-------------------------------------------------------------- + ! for dF/dx (u momentum) + !-------------------------------------------------------------- + + strp_tmp = p25 * dyt(iw) * (p333 * ssigpn + p166 * ssigps) + strm_tmp = p25 * dyt(iw) * (p333 * ssigmn + p166 * ssigms) + + ! northeast (i,j) + str1(iw) = -strp_tmp - strm_tmp - str12ew & + + dxhy * (-csigpne + csigmne) + dyhx * csig12ne + + ! northwest (i+1,j) + str2(iw) = strp_tmp + strm_tmp - str12we & + + dxhy * (-csigpnw + csigmnw) + dyhx * csig12nw + + strp_tmp = p25 * dyt(iw) * (p333 * ssigps + p166 * ssigpn) + strm_tmp = p25 * dyt(iw) * (p333 * ssigms + p166 * ssigmn) + + ! southeast (i,j+1) + str3(iw) = -strp_tmp - strm_tmp + str12ew & + + dxhy * (-csigpse + csigmse) + dyhx * csig12se + + ! southwest (i+1,j+1) + str4(iw) = strp_tmp + strm_tmp + str12we & + + dxhy * (-csigpsw + csigmsw) + dyhx * csig12sw + + !-------------------------------------------------------------- + ! for dF/dy (v momentum) + !-------------------------------------------------------------- + + strp_tmp = p25 * dxt(iw) * (p333 * ssigpe + p166 * ssigpw) + strm_tmp = p25 * dxt(iw) * (p333 * ssigme + p166 * ssigmw) + + ! northeast (i,j) + str5(iw) = -strp_tmp + strm_tmp - str12ns & + - dyhx * (csigpne + csigmne) + dxhy * csig12ne + + ! southeast (i,j+1) + str6(iw) = strp_tmp - strm_tmp - str12sn & + - dyhx * (csigpse + csigmse) + dxhy * csig12se + + strp_tmp = p25 * dxt(iw) * (p333 * ssigpw + p166 * ssigpe) + strm_tmp = p25 * dxt(iw) * (p333 * ssigmw + p166 * ssigme) + + ! northwest (i+1,j) + str7(iw) = -strp_tmp + strm_tmp + str12ns & + - dyhx * (csigpnw + csigmnw) + dxhy * csig12nw + + ! southwest (i+1,j+1) + str8(iw) = strp_tmp - strm_tmp + str12sn & + - dyhx * (csigpsw + csigmsw) + dxhy * csig12sw + + end do +#ifdef _OPENACC + !$acc end parallel +#endif - ! proper action in "null" cases: - if (upper <= 0 .or. upper < lower) then - d_lower = 0 - d_upper = -1 - return - endif + end subroutine stress_iter + +!======================================================================= + + subroutine stress_last(NA_len, ee, ne, se, lb, ub, uvel, vvel, dxt, & + dyt, hte, htn, htem1, htnm1, strength, stressp_1, stressp_2, & + stressp_3, stressp_4, stressm_1, stressm_2, stressm_3, & + stressm_4, stress12_1, stress12_2, stress12_3, stress12_4, str1, & + str2, str3, str4, str5, str6, str7, str8, skiptcell, tarear, divu, & + rdg_conv, rdg_shear, shear) + + use ice_kinds_mod + use ice_constants, only : p027, p055, p111, p166, p222, p25, & + p333, p5, c1p5, c1, c0 + use ice_dyn_shared, only : ecci, denom1, arlx1i, Ktens, revp + + implicit none + + integer(kind=int_kind), intent(in) :: NA_len, lb, ub + integer(kind=int_kind), dimension(:), intent(in), contiguous :: & + ee, ne, se + real(kind=dbl_kind), dimension(:), intent(in), contiguous :: & + strength, uvel, vvel, dxt, dyt, hte, htn, htem1, htnm1, tarear + logical(kind=log_kind), intent(in), dimension(:) :: skiptcell + real(kind=dbl_kind), dimension(:), intent(inout), contiguous :: & + stressp_1, stressp_2, stressp_3, stressp_4, stressm_1, & + stressm_2, stressm_3, stressm_4, stress12_1, stress12_2, & + stress12_3, stress12_4 + real(kind=dbl_kind), dimension(:), intent(out), contiguous :: & + str1, str2, str3, str4, str5, str6, str7, str8, divu, & + rdg_conv, rdg_shear, shear + + ! local variables + + integer(kind=int_kind) :: iw, il, iu + real(kind=dbl_kind) :: puny, divune, divunw, divuse, divusw, & + tensionne, tensionnw, tensionse, tensionsw, shearne, shearnw, & + shearse, shearsw, Deltane, Deltanw, Deltase, Deltasw, c0ne, & + c0nw, c0se, c0sw, c1ne, c1nw, c1se, c1sw, ssigpn, ssigps, & + ssigpe, ssigpw, ssigmn, ssigms, ssigme, ssigmw, ssig12n, & + ssig12s, ssig12e, ssig12w, ssigp1, ssigp2, ssigm1, ssigm2, & + ssig121, ssig122, csigpne, csigpnw, csigpse, csigpsw, & + csigmne, csigmnw, csigmse, csigmsw, csig12ne, csig12nw, & + csig12se, csig12sw, str12ew, str12we, str12ns, str12sn, & + strp_tmp, strm_tmp, tmp_uvel_ee, tmp_vvel_se, tmp_vvel_ee, & + tmp_vvel_ne, tmp_uvel_ne, tmp_uvel_se, dxhy, dyhx, cxp, cyp, & + cxm, cym, tinyarea, tmparea + + character(len=*), parameter :: subname = '(stress_last)' + + call icepack_query_parameters(puny_out=puny) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) then + call abort_ice(error_message=subname, file=__FILE__, & + line=__LINE__) + end if - ! proper action in serial sections - d_lower = lower - d_upper = upper +#ifdef _OPENACC + !$acc parallel & + !$acc present(ee, ne, se, strength, uvel, vvel, dxt, dyt, hte, & + !$acc htn, htem1, htnm1, str1, str2, str3, str4, str5, str6, & + !$acc str7, str8, stressp_1, stressp_2, stressp_3, stressp_4, & + !$acc stressm_1, stressm_2, stressm_3, stressm_4, stress12_1, & + !$acc stress12_2, stress12_3, stress12_4, tarear, divu, & + !$acc rdg_conv, rdg_shear, shear, skiptcell) + !$acc loop + do iw = 1, NA_len +#else + call domp_get_domain(lb, ub, il, iu) + do iw = il, iu +#endif -#if defined (_OPENMP) - if (omp_in_parallel()) then - dlen = real(upper-lower+1, dbl_kind) - d_lower = lower + floor((rdomp_iam*dlen+p5)/rdomp_nt, JPIM) - d_upper = lower -1 + floor((rdomp_iam*dlen+dlen+p5)/rdomp_nt, JPIM) - endif + if (skiptcell(iw)) cycle + + tmparea = dxt(iw) * dyt(iw) ! necessary to split calc of tinyarea. Otherwize not binary identical + tinyarea = puny * tmparea + dxhy = p5 * (hte(iw) - htem1(iw)) + dyhx = p5 * (htn(iw) - htnm1(iw)) + cxp = c1p5 * htn(iw) - p5 * htnm1(iw) + cyp = c1p5 * hte(iw) - p5 * htem1(iw) + cxm = -(c1p5 * htnm1(iw) - p5 * htn(iw)) + cym = -(c1p5 * htem1(iw) - p5 * hte(iw)) + + !-------------------------------------------------------------- + ! strain rates + ! NOTE: these are actually strain rates * area (m^2/s) + !-------------------------------------------------------------- + + tmp_uvel_ne = uvel(ne(iw)) + tmp_uvel_se = uvel(se(iw)) + tmp_uvel_ee = uvel(ee(iw)) + + tmp_vvel_ee = vvel(ee(iw)) + tmp_vvel_se = vvel(se(iw)) + tmp_vvel_ne = vvel(ne(iw)) + + ! divergence = e_11 + e_22 + divune = cyp * uvel(iw) - dyt(iw) * tmp_uvel_ee & + + cxp * vvel(iw) - dxt(iw) * tmp_vvel_se + divunw = cym * tmp_uvel_ee + dyt(iw) * uvel(iw) & + + cxp * tmp_vvel_ee - dxt(iw) * tmp_vvel_ne + divusw = cym * tmp_uvel_ne + dyt(iw) * tmp_uvel_se & + + cxm * tmp_vvel_ne + dxt(iw) * tmp_vvel_ee + divuse = cyp * tmp_uvel_se - dyt(iw) * tmp_uvel_ne & + + cxm * tmp_vvel_se + dxt(iw) * vvel(iw) + + ! tension strain rate = e_11 - e_22 + tensionne = -cym * uvel(iw) - dyt(iw) * tmp_uvel_ee & + + cxm * vvel(iw) + dxt(iw) * tmp_vvel_se + tensionnw = -cyp * tmp_uvel_ee + dyt(iw) * uvel(iw) & + + cxm * tmp_vvel_ee + dxt(iw) * tmp_vvel_ne + tensionsw = -cyp * tmp_uvel_ne + dyt(iw) * tmp_uvel_se & + + cxp * tmp_vvel_ne - dxt(iw) * tmp_vvel_ee + tensionse = -cym * tmp_uvel_se - dyt(iw) * tmp_uvel_ne & + + cxp * tmp_vvel_se - dxt(iw) * vvel(iw) + + ! shearing strain rate = 2 * e_12 + shearne = -cym * vvel(iw) - dyt(iw) * tmp_vvel_ee & + - cxm * uvel(iw) - dxt(iw) * tmp_uvel_se + shearnw = -cyp * tmp_vvel_ee + dyt(iw) * vvel(iw) & + - cxm * tmp_uvel_ee - dxt(iw) * tmp_uvel_ne + shearsw = -cyp * tmp_vvel_ne + dyt(iw) * tmp_vvel_se & + - cxp * tmp_uvel_ne + dxt(iw) * tmp_uvel_ee + shearse = -cym * tmp_vvel_se - dyt(iw) * tmp_vvel_ne & + - cxp * tmp_uvel_se + dxt(iw) * uvel(iw) + + ! Delta (in the denominator of zeta and eta) + Deltane = sqrt(divune**2 + ecci * (tensionne**2 + shearne**2)) + Deltanw = sqrt(divunw**2 + ecci * (tensionnw**2 + shearnw**2)) + Deltasw = sqrt(divusw**2 + ecci * (tensionsw**2 + shearsw**2)) + Deltase = sqrt(divuse**2 + ecci * (tensionse**2 + shearse**2)) + + !-------------------------------------------------------------- + ! on last subcycle, save quantities for mechanical + ! redistribution + !-------------------------------------------------------------- + + divu(iw) = p25 * (divune + divunw + divuse + divusw) * tarear(iw) + rdg_conv(iw) = -min(divu(iw), c0) ! TODO: Could move outside the entire kernel + rdg_shear(iw) = p5 * (p25 * (Deltane + Deltanw + Deltase + Deltasw) * tarear(iw) - abs(divu(iw))) + + ! diagnostic only + ! shear = sqrt(tension**2 + shearing**2) + shear(iw) = p25 * tarear(iw) * sqrt((tensionne + tensionnw + tensionse + tensionsw)**2 & + + (shearne + shearnw + shearse + shearsw)**2) + + !-------------------------------------------------------------- + ! replacement pressure/Delta (kg/s) + ! save replacement pressure for principal stress calculation + !-------------------------------------------------------------- + + c0ne = strength(iw) / max(Deltane, tinyarea) + c0nw = strength(iw) / max(Deltanw, tinyarea) + c0sw = strength(iw) / max(Deltasw, tinyarea) + c0se = strength(iw) / max(Deltase, tinyarea) + + c1ne = c0ne * arlx1i + c1nw = c0nw * arlx1i + c1sw = c0sw * arlx1i + c1se = c0se * arlx1i + + c0ne = c1ne * ecci + c0nw = c1nw * ecci + c0sw = c1sw * ecci + c0se = c1se * ecci + + !-------------------------------------------------------------- + ! the stresses (kg/s^2) + ! (1) northeast, (2) northwest, (3) southwest, (4) southeast + !-------------------------------------------------------------- + + stressp_1(iw) = (stressp_1(iw) * (c1 - arlx1i * revp) & + + c1ne * (divune * (c1 + Ktens) - Deltane * (c1 - Ktens))) * denom1 + stressp_2(iw) = (stressp_2(iw) * (c1 - arlx1i * revp) & + + c1nw * (divunw * (c1 + Ktens) - Deltanw * (c1 - Ktens))) * denom1 + stressp_3(iw) = (stressp_3(iw) * (c1 - arlx1i * revp) & + + c1sw * (divusw * (c1 + Ktens) - Deltasw * (c1 - Ktens))) * denom1 + stressp_4(iw) = (stressp_4(iw) * (c1 - arlx1i * revp) & + + c1se * (divuse * (c1 + Ktens) - Deltase * (c1 - Ktens))) * denom1 + + stressm_1(iw) = (stressm_1(iw) * (c1 - arlx1i * revp) + c0ne * tensionne * (c1 + Ktens)) * denom1 + stressm_2(iw) = (stressm_2(iw) * (c1 - arlx1i * revp) + c0nw * tensionnw * (c1 + Ktens)) * denom1 + stressm_3(iw) = (stressm_3(iw) * (c1 - arlx1i * revp) + c0sw * tensionsw * (c1 + Ktens)) * denom1 + stressm_4(iw) = (stressm_4(iw) * (c1 - arlx1i * revp) + c0se * tensionse * (c1 + Ktens)) * denom1 + + stress12_1(iw) = (stress12_1(iw) * (c1 - arlx1i * revp) + c0ne * shearne * p5 * (c1 + Ktens)) * denom1 + stress12_2(iw) = (stress12_2(iw) * (c1 - arlx1i * revp) + c0nw * shearnw * p5 * (c1 + Ktens)) * denom1 + stress12_3(iw) = (stress12_3(iw) * (c1 - arlx1i * revp) + c0sw * shearsw * p5 * (c1 + Ktens)) * denom1 + stress12_4(iw) = (stress12_4(iw) * (c1 - arlx1i * revp) + c0se * shearse * p5 * (c1 + Ktens)) * denom1 + + !-------------------------------------------------------------- + ! combinations of the stresses for the momentum equation + ! (kg/s^2) + !-------------------------------------------------------------- + + ssigpn = stressp_1(iw) + stressp_2(iw) + ssigps = stressp_3(iw) + stressp_4(iw) + ssigpe = stressp_1(iw) + stressp_4(iw) + ssigpw = stressp_2(iw) + stressp_3(iw) + ssigp1 = (stressp_1(iw) + stressp_3(iw)) * p055 + ssigp2 = (stressp_2(iw) + stressp_4(iw)) * p055 + + ssigmn = stressm_1(iw) + stressm_2(iw) + ssigms = stressm_3(iw) + stressm_4(iw) + ssigme = stressm_1(iw) + stressm_4(iw) + ssigmw = stressm_2(iw) + stressm_3(iw) + ssigm1 = (stressm_1(iw) + stressm_3(iw)) * p055 + ssigm2 = (stressm_2(iw) + stressm_4(iw)) * p055 + + ssig12n = stress12_1(iw) + stress12_2(iw) + ssig12s = stress12_3(iw) + stress12_4(iw) + ssig12e = stress12_1(iw) + stress12_4(iw) + ssig12w = stress12_2(iw) + stress12_3(iw) + ssig121 = (stress12_1(iw) + stress12_3(iw)) * p111 + ssig122 = (stress12_2(iw) + stress12_4(iw)) * p111 + + csigpne = p111 * stressp_1(iw) + ssigp2 + p027 * stressp_3(iw) + csigpnw = p111 * stressp_2(iw) + ssigp1 + p027 * stressp_4(iw) + csigpsw = p111 * stressp_3(iw) + ssigp2 + p027 * stressp_1(iw) + csigpse = p111 * stressp_4(iw) + ssigp1 + p027 * stressp_2(iw) + + csigmne = p111 * stressm_1(iw) + ssigm2 + p027 * stressm_3(iw) + csigmnw = p111 * stressm_2(iw) + ssigm1 + p027 * stressm_4(iw) + csigmsw = p111 * stressm_3(iw) + ssigm2 + p027 * stressm_1(iw) + csigmse = p111 * stressm_4(iw) + ssigm1 + p027 * stressm_2(iw) + + csig12ne = p222 * stress12_1(iw) + ssig122 + p055 * stress12_3(iw) + csig12nw = p222 * stress12_2(iw) + ssig121 + p055 * stress12_4(iw) + csig12sw = p222 * stress12_3(iw) + ssig122 + p055 * stress12_1(iw) + csig12se = p222 * stress12_4(iw) + ssig121 + p055 * stress12_2(iw) + + str12ew = p5 * dxt(iw) * (p333 * ssig12e + p166 * ssig12w) + str12we = p5 * dxt(iw) * (p333 * ssig12w + p166 * ssig12e) + str12ns = p5 * dyt(iw) * (p333 * ssig12n + p166 * ssig12s) + str12sn = p5 * dyt(iw) * (p333 * ssig12s + p166 * ssig12n) + + !-------------------------------------------------------------- + ! for dF/dx (u momentum) + !-------------------------------------------------------------- + + strp_tmp = p25 * dyt(iw) * (p333 * ssigpn + p166 * ssigps) + strm_tmp = p25 * dyt(iw) * (p333 * ssigmn + p166 * ssigms) + + ! northeast (i,j) + str1(iw) = -strp_tmp - strm_tmp - str12ew & + + dxhy * (-csigpne + csigmne) + dyhx * csig12ne + + ! northwest (i+1,j) + str2(iw) = strp_tmp + strm_tmp - str12we & + + dxhy * (-csigpnw + csigmnw) + dyhx * csig12nw + + strp_tmp = p25 * dyt(iw) * (p333 * ssigps + p166 * ssigpn) + strm_tmp = p25 * dyt(iw) * (p333 * ssigms + p166 * ssigmn) + + ! southeast (i,j+1) + str3(iw) = -strp_tmp - strm_tmp + str12ew & + + dxhy * (-csigpse + csigmse) + dyhx * csig12se + + ! southwest (i+1,j+1) + str4(iw) = strp_tmp + strm_tmp + str12we & + + dxhy * (-csigpsw + csigmsw) + dyhx * csig12sw + + !-------------------------------------------------------------- + ! for dF/dy (v momentum) + !-------------------------------------------------------------- + + strp_tmp = p25 * dxt(iw) * (p333 * ssigpe + p166 * ssigpw) + strm_tmp = p25 * dxt(iw) * (p333 * ssigme + p166 * ssigmw) + + ! northeast (i,j) + str5(iw) = -strp_tmp + strm_tmp - str12ns & + - dyhx * (csigpne + csigmne) + dxhy * csig12ne + + ! southeast (i,j+1) + str6(iw) = strp_tmp - strm_tmp - str12sn & + - dyhx * (csigpse + csigmse) + dxhy * csig12se + + strp_tmp = p25 * dxt(iw) * (p333 * ssigpw + p166 * ssigpe) + strm_tmp = p25 * dxt(iw) * (p333 * ssigmw + p166 * ssigme) + + ! northwest (i+1,j) + str7(iw) = -strp_tmp + strm_tmp + str12ns & + - dyhx * (csigpnw + csigmnw) + dxhy * csig12nw + + ! southwest (i+1,j+1) + str8(iw) = strp_tmp - strm_tmp + str12sn & + - dyhx * (csigpsw + csigmsw) + dxhy * csig12sw + + end do +#ifdef _OPENACC + !$acc end parallel #endif - if (.false.) then - write(nu_diag,'(2a,i3,a,2i10)') subname,' openMP thread ', domp_iam, & - ' handles range: ', d_lower, d_upper - endif + end subroutine stress_last - end subroutine domp_get_domain_rlu +!======================================================================= -!---------------------------------------------------------------------------- + subroutine stepu_iter(NA_len, rhow, lb, ub, Cw, aiu, uocn, vocn, & + forcex, forcey, umassdti, fm, uarear, Tbu, uvel_init, vvel_init, & + uvel, vvel, str1, str2, str3, str4, str5, str6, str7, str8, nw, & + sw, sse, skipucell) - subroutine domp_get_thread_no (tnum) + use ice_kinds_mod + use ice_constants, only : c0, c1 + use ice_dyn_shared, only : brlx, revp, u0, cosw, sinw - implicit none - integer(int_kind), intent(out) :: tnum - character(len=*), parameter :: subname = '(domp_get_thread_no)' + implicit none - tnum = domp_iam + 1 + integer(kind=int_kind), intent(in) :: NA_len, lb, ub + real(kind=dbl_kind), intent(in) :: rhow + logical(kind=log_kind), intent(in), dimension(:) :: skipucell + integer(kind=int_kind), dimension(:), intent(in), contiguous :: & + nw, sw, sse + real(kind=dbl_kind), dimension(:), intent(in), contiguous :: & + uvel_init, vvel_init, aiu, forcex, forcey, umassdti, Tbu, & + uocn, vocn, fm, uarear, Cw, str1, str2, str3, str4, str5, & + str6, str7, str8 + real(kind=dbl_kind), dimension(:), intent(inout), contiguous :: & + uvel, vvel - end subroutine domp_get_thread_no + ! local variables -!---------------------------------------------------------------------------- + integer(kind=int_kind) :: iw, il, iu + real(kind=dbl_kind) :: uold, vold, vrel, cca, ccb, ab2, cc1, & + cc2, taux, tauy, Cb, tmp_str2_nw, tmp_str3_sse, tmp_str4_sw, & + tmp_str6_sse, tmp_str7_nw, tmp_str8_sw, waterx, watery, & + tmp_strintx, tmp_strinty -!former end module dmi_omp + character(len=*), parameter :: subname = '(stepu_iter)' -!=============================================================================== +#ifdef _OPENACC + !$acc parallel & + !$acc present(Cw, aiu, uocn, vocn, forcex, forcey, umassdti, fm, & + !$acc uarear, Tbu, uvel_init, vvel_init, nw, sw, sse, skipucell, & + !$acc str1, str2, str3, str4, str5, str6, str7, str8, uvel, & + !$acc vvel) + !$acc loop + do iw = 1, NA_len +#else + call domp_get_domain(lb, ub, il, iu) + do iw = il, iu +#endif -!former module bench_v2 + if (skipucell(iw)) cycle -!---------------------------------------------------------------------------- + uold = uvel(iw) + vold = vvel(iw) - subroutine stress_i(NA_len, & - ee,ne,se,lb,ub,uvel,vvel,dxt,dyt, & - hte,htn,htem1,htnm1, & - strength,stressp_1,stressp_2,stressp_3,stressp_4, & - stressm_1,stressm_2,stressm_3,stressm_4,stress12_1, & - stress12_2,stress12_3,stress12_4,str1,str2,str3,str4,str5, & - str6,str7,str8) + vrel = aiu(iw) * rhow * Cw(iw) * sqrt((uocn(iw) - uold)**2 + (vocn(iw) - vold)**2) - use ice_kinds_mod - use ice_constants, only: p027, p055, p111, p166, p222, p25, p333, p5, c1p5, c1 - use ice_dyn_shared, only: ecci, denom1, arlx1i, Ktens, revp + waterx = uocn(iw) * cosw - vocn(iw) * sinw * sign(c1, fm(iw)) + watery = vocn(iw) * cosw + uocn(iw) * sinw * sign(c1, fm(iw)) - implicit none + taux = vrel * waterx + tauy = vrel * watery - integer (kind=int_kind), intent(in) :: NA_len - integer (kind=int_kind), intent(in) :: lb,ub - integer (kind=int_kind), dimension(:), intent(in), contiguous :: ee,ne,se - real (kind=dbl_kind), dimension(:), intent(in), contiguous :: & - strength, uvel, vvel, dxt, dyt, & - hte,htn,htem1,htnm1 - real (kind=dbl_kind), dimension(:), intent(inout), contiguous :: & - stressp_1,stressp_2, stressp_3, stressp_4, stressm_1, stressm_2, & - stressm_3,stressm_4, stress12_1,stress12_2,stress12_3, stress12_4 - real (kind=DBL_KIND), dimension(:), intent(out), contiguous :: & - str1,str2,str3,str4,str5,str6,str7,str8 + Cb = Tbu(iw) / (sqrt(uold**2 + vold**2) + u0) - !-- local variables + cca = (brlx + revp) * umassdti(iw) + vrel * cosw + Cb + ccb = fm(iw) + sign(c1, fm(iw)) * vrel * sinw - integer (kind=int_kind) :: iw,il,iu - real (kind=dbl_kind) :: & - puny - real (kind=DBL_KIND) :: & - divune, divunw, divuse, divusw,tensionne, tensionnw, tensionse, tensionsw, & - shearne, shearnw, shearse, shearsw, Deltane, Deltanw, Deltase, Deltasw , & - c0ne, c0nw, c0se, c0sw, c1ne, c1nw, c1se, c1sw , & - ssigpn, ssigps, ssigpe, ssigpw, ssigmn, ssigms, ssigme, ssigmw , & - ssig12n, ssig12s, ssig12e, ssig12w, ssigp1, ssigp2,ssigm1, ssigm2,ssig121, & - ssig122, csigpne, csigpnw, csigpse, csigpsw,csigmne, csigmnw, csigmse , & - csigmsw, csig12ne, csig12nw, csig12se, csig12sw, str12ew, str12we,str12ns, & - str12sn, strp_tmp, strm_tmp, tmp_uvel_ee, tmp_vvel_se, tmp_vvel_ee, & - tmp_vvel_ne, tmp_uvel_ne, tmp_uvel_se - real (kind=DBL_KIND) :: dxhy,dyhx,cxp,cyp,cxm,cym,tinyarea - - character(len=*), parameter :: subname = '(stress_i)' - !--------------------------------------- + ab2 = cca**2 + ccb**2 - 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__) + tmp_str2_nw = str2(nw(iw)) + tmp_str3_sse = str3(sse(iw)) + tmp_str4_sw = str4(sw(iw)) + tmp_str6_sse = str6(sse(iw)) + tmp_str7_nw = str7(nw(iw)) + tmp_str8_sw = str8(sw(iw)) -#ifdef _OPENACC - !$acc parallel & - !$acc present(ee,ne,se,strength,uvel,vvel,dxt,dyt, & - !$acc hte, htn, htem1, htnm1, & - !$acc str1,str2,str3,str4,str5,str6,str7,str8, & - !$acc stressp_1,stressp_2,stressp_3,stressp_4, & - !$acc stressm_1,stressm_2,stressm_3,stressm_4, & - !$acc stress12_1,stress12_2,stress12_3,stress12_4) - !$acc loop - do iw = 1,NA_len -#else - call domp_get_domain(lb,ub,il,iu) - do iw = il, iu -#endif - tinyarea = puny*dxt(iw)*dyt(iw) - dxhy = p5*(hte(iw) - htem1(iw)) - dyhx = p5*(htn(iw) - htnm1(iw)) - cxp = c1p5*htn(iw) - p5*htnm1(iw) - cyp = c1p5*hte(iw) - p5*htem1(iw) - cxm = -(c1p5*htnm1(iw) - p5*htn(iw)) - cym = -(c1p5*htem1(iw) - p5*hte(iw)) - - !----------------------------------------------------------------- - ! strain rates - ! NOTE these are actually strain rates * area (m^2/s) - !----------------------------------------------------------------- - ! divergence = e_11 + e_22 - tmp_uvel_ee = uvel(ee(iw)) - tmp_vvel_ee = vvel(ee(iw)) - - tmp_vvel_se = vvel(se(iw)) - tmp_uvel_se = uvel(se(iw)) - - ! ne - divune = cyp*uvel(iw) - dyt(iw)*tmp_uvel_ee & - + cxp*vvel(iw) - dxt(iw)*tmp_vvel_se - ! tension strain rate = e_11 - e_22 - tensionne = -cym*uvel(iw) - dyt(iw)*tmp_uvel_ee & - + cxm*vvel(iw) + dxt(iw)*tmp_vvel_se - ! shearing strain rate = 2*e_12 - shearne = -cym*vvel(iw) - dyt(iw)*tmp_vvel_ee & - - cxm*uvel(iw) - dxt(iw)*tmp_uvel_se - ! Delta (in the denominator of zeta, eta) - Deltane = sqrt(divune**2 + ecci*(tensionne**2 + shearne**2)) - - ! These two can move after ne block - ! - tmp_uvel_ne = uvel(ne(iw)) - tmp_vvel_ne = vvel(ne(iw)) - - ! nw - divunw = cym*tmp_uvel_ee + dyt(iw)*uvel(iw) & - + cxp*tmp_vvel_ee - dxt(iw)*tmp_vvel_ne - tensionnw = -cyp*tmp_uvel_ee + dyt(iw)*uvel(iw) & - + cxm*tmp_vvel_ee + dxt(iw)*tmp_vvel_ne - shearnw = -cyp*tmp_vvel_ee + dyt(iw)*vvel(iw) & - - cxm*tmp_uvel_ee - dxt(iw)*tmp_uvel_ne - Deltanw = sqrt(divunw**2 + ecci*(tensionnw**2 + shearnw**2)) - - ! sw - divusw = cym*tmp_uvel_ne + dyt(iw)*tmp_uvel_se & - + cxm*tmp_vvel_ne + dxt(iw)*tmp_vvel_ee - tensionsw = -cyp*tmp_uvel_ne + dyt(iw)*tmp_uvel_se & - + cxp*tmp_vvel_ne - dxt(iw)*tmp_vvel_ee - shearsw = -cyp*tmp_vvel_ne + dyt(iw)*tmp_vvel_se & - - cxp*tmp_uvel_ne + dxt(iw)*tmp_uvel_ee - Deltasw = sqrt(divusw**2 + ecci*(tensionsw**2 + shearsw**2)) - - ! se - divuse = cyp*tmp_uvel_se - dyt(iw)*tmp_uvel_ne & - + cxm*tmp_vvel_se + dxt(iw)*vvel(iw) - tensionse = -cym*tmp_uvel_se - dyt(iw)*tmp_uvel_ne & - + cxp*tmp_vvel_se - dxt(iw)*vvel(iw) - shearse = -cym*tmp_vvel_se - dyt(iw)*tmp_vvel_ne & - - cxp*tmp_uvel_se + dxt(iw)*uvel(iw) - Deltase = sqrt(divuse**2 + ecci*(tensionse**2 + shearse**2)) - - !----------------------------------------------------------------- - ! replacement pressure/Delta ! kg/s - ! save replacement pressure for principal stress calculation - !----------------------------------------------------------------- - c0ne = strength(iw)/max(Deltane,tinyarea) - c0nw = strength(iw)/max(Deltanw,tinyarea) - c0sw = strength(iw)/max(Deltasw,tinyarea) - c0se = strength(iw)/max(Deltase,tinyarea) - - c1ne = c0ne*arlx1i - c1nw = c0nw*arlx1i - c1sw = c0sw*arlx1i - c1se = c0se*arlx1i - - c0ne = c1ne*ecci - c0nw = c1nw*ecci - c0sw = c1sw*ecci - c0se = c1se*ecci - - !----------------------------------------------------------------- - ! the stresses ! kg/s^2 - ! (1) northeast, (2) northwest, (3) southwest, (4) southeast - !----------------------------------------------------------------- - - stressp_1(iw) = (stressp_1(iw)*(c1-arlx1i*revp) + c1ne*(divune*(c1+Ktens) - Deltane*(c1-Ktens))) * denom1 - stressp_2(iw) = (stressp_2(iw)*(c1-arlx1i*revp) + c1nw*(divunw*(c1+Ktens) - Deltanw*(c1-Ktens))) * denom1 - stressp_3(iw) = (stressp_3(iw)*(c1-arlx1i*revp) + c1sw*(divusw*(c1+Ktens) - Deltasw*(c1-Ktens))) * denom1 - stressp_4(iw) = (stressp_4(iw)*(c1-arlx1i*revp) + c1se*(divuse*(c1+Ktens) - Deltase*(c1-Ktens))) * denom1 - - stressm_1(iw) = (stressm_1(iw)*(c1-arlx1i*revp) + c0ne*tensionne*(c1+Ktens)) * denom1 - stressm_2(iw) = (stressm_2(iw)*(c1-arlx1i*revp) + c0nw*tensionnw*(c1+Ktens)) * denom1 - stressm_3(iw) = (stressm_3(iw)*(c1-arlx1i*revp) + c0sw*tensionsw*(c1+Ktens)) * denom1 - stressm_4(iw) = (stressm_4(iw)*(c1-arlx1i*revp) + c0se*tensionse*(c1+Ktens)) * denom1 - - stress12_1(iw) = (stress12_1(iw)*(c1-arlx1i*revp) + c0ne*shearne*p5*(c1+Ktens)) * denom1 - stress12_2(iw) = (stress12_2(iw)*(c1-arlx1i*revp) + c0nw*shearnw*p5*(c1+Ktens)) * denom1 - stress12_3(iw) = (stress12_3(iw)*(c1-arlx1i*revp) + c0sw*shearsw*p5*(c1+Ktens)) * denom1 - stress12_4(iw) = (stress12_4(iw)*(c1-arlx1i*revp) + c0se*shearse*p5*(c1+Ktens)) * denom1 - - !----------------------------------------------------------------- - ! combinations of the stresses for the momentum equation ! kg/s^2 - !----------------------------------------------------------------- - - ssigpn = stressp_1(iw) + stressp_2(iw) - ssigps = stressp_3(iw) + stressp_4(iw) - ssigpe = stressp_1(iw) + stressp_4(iw) - ssigpw = stressp_2(iw) + stressp_3(iw) - ssigp1 =(stressp_1(iw) + stressp_3(iw))*p055 - ssigp2 =(stressp_2(iw) + stressp_4(iw))*p055 - - ssigmn = stressm_1(iw) + stressm_2(iw) - ssigms = stressm_3(iw) + stressm_4(iw) - ssigme = stressm_1(iw) + stressm_4(iw) - ssigmw = stressm_2(iw) + stressm_3(iw) - ssigm1 =(stressm_1(iw) + stressm_3(iw))*p055 - ssigm2 =(stressm_2(iw) + stressm_4(iw))*p055 - - ssig12n = stress12_1(iw) + stress12_2(iw) - ssig12s = stress12_3(iw) + stress12_4(iw) - ssig12e = stress12_1(iw) + stress12_4(iw) - ssig12w = stress12_2(iw) + stress12_3(iw) - ssig121 =(stress12_1(iw) + stress12_3(iw))*p111 - ssig122 =(stress12_2(iw) + stress12_4(iw))*p111 - - csigpne = p111*stressp_1(iw) + ssigp2 + p027*stressp_3(iw) - csigpnw = p111*stressp_2(iw) + ssigp1 + p027*stressp_4(iw) - csigpsw = p111*stressp_3(iw) + ssigp2 + p027*stressp_1(iw) - csigpse = p111*stressp_4(iw) + ssigp1 + p027*stressp_2(iw) - - csigmne = p111*stressm_1(iw) + ssigm2 + p027*stressm_3(iw) - csigmnw = p111*stressm_2(iw) + ssigm1 + p027*stressm_4(iw) - csigmsw = p111*stressm_3(iw) + ssigm2 + p027*stressm_1(iw) - csigmse = p111*stressm_4(iw) + ssigm1 + p027*stressm_2(iw) - - csig12ne = p222*stress12_1(iw) + ssig122 + p055*stress12_3(iw) - csig12nw = p222*stress12_2(iw) + ssig121 + p055*stress12_4(iw) - csig12sw = p222*stress12_3(iw) + ssig122 + p055*stress12_1(iw) - csig12se = p222*stress12_4(iw) + ssig121 + p055*stress12_2(iw) - - str12ew = p5*dxt(iw)*(p333*ssig12e + p166*ssig12w) - str12we = p5*dxt(iw)*(p333*ssig12w + p166*ssig12e) - str12ns = p5*dyt(iw)*(p333*ssig12n + p166*ssig12s) - str12sn = p5*dyt(iw)*(p333*ssig12s + p166*ssig12n) - - !----------------------------------------------------------------- - ! for dF/dx (u momentum) - !----------------------------------------------------------------- - strp_tmp = p25*dyt(iw)*(p333*ssigpn + p166*ssigps) - strm_tmp = p25*dyt(iw)*(p333*ssigmn + p166*ssigms) - - ! northeast (iw) - str1(iw) = -strp_tmp - strm_tmp - str12ew & - + dxhy*(-csigpne + csigmne) + dyhx*csig12ne - - ! northwest (i+1,j) - str2(iw) = strp_tmp + strm_tmp - str12we & - + dxhy*(-csigpnw + csigmnw) + dyhx*csig12nw - - strp_tmp = p25*dyt(iw)*(p333*ssigps + p166*ssigpn) - strm_tmp = p25*dyt(iw)*(p333*ssigms + p166*ssigmn) - - ! southeast (i,j+1) - str3(iw) = -strp_tmp - strm_tmp + str12ew & - + dxhy*(-csigpse + csigmse) + dyhx*csig12se - - ! southwest (i+1,j+1) - str4(iw) = strp_tmp + strm_tmp + str12we & - + dxhy*(-csigpsw + csigmsw) + dyhx*csig12sw - - !----------------------------------------------------------------- - ! for dF/dy (v momentum) - !----------------------------------------------------------------- - strp_tmp = p25*dxt(iw)*(p333*ssigpe + p166*ssigpw) - strm_tmp = p25*dxt(iw)*(p333*ssigme + p166*ssigmw) - - ! northeast (i,j) - str5(iw) = -strp_tmp + strm_tmp - str12ns & - - dyhx*(csigpne + csigmne) + dxhy*csig12ne - - ! southeast (i,j+1) - str6(iw) = strp_tmp - strm_tmp - str12sn & - - dyhx*(csigpse + csigmse) + dxhy*csig12se - - strp_tmp = p25*dxt(iw)*(p333*ssigpw + p166*ssigpe) - strm_tmp = p25*dxt(iw)*(p333*ssigmw + p166*ssigme) - - ! northwest (i+1,j) - str7(iw) = -strp_tmp + strm_tmp + str12ns & - - dyhx*(csigpnw + csigmnw) + dxhy*csig12nw - - ! southwest (i+1,j+1) - str8(iw) = strp_tmp - strm_tmp + str12sn & - - dyhx*(csigpsw + csigmsw) + dxhy*csig12sw - enddo -#ifdef _OPENACC - !$acc end parallel -#endif + tmp_strintx = uarear(iw) * (str1(iw) + tmp_str2_nw + tmp_str3_sse + tmp_str4_sw) + tmp_strinty = uarear(iw) * (str5(iw) + tmp_str6_sse + tmp_str7_nw + tmp_str8_sw) - end subroutine stress_i - -!---------------------------------------------------------------------------- - - subroutine stress_l(NA_len, tarear, & - ee,ne,se,lb,ub,uvel,vvel,dxt,dyt, & - hte,htn,htem1,htnm1, & - strength,stressp_1,stressp_2,stressp_3,stressp_4, & - stressm_1,stressm_2,stressm_3,stressm_4,stress12_1, & - stress12_2,stress12_3,stress12_4, & - divu,rdg_conv,rdg_shear,shear, & - str1,str2,str3,str4,str5,str6,str7,str8 ) - - use ice_kinds_mod - use ice_constants, only: p027, p055, p111, p166, p222, p25, p333, p5, c1p5, c0, c1 - use ice_dyn_shared, only: ecci, denom1, arlx1i, Ktens, revp - - implicit none - - integer (kind=int_kind), intent(in) :: NA_len - integer (kind=int_kind), intent(in) :: lb,ub - integer (kind=int_kind), dimension(:), intent(in), contiguous :: ee,ne,se - real (kind=dbl_kind), dimension(:), intent(in), contiguous :: & - strength, uvel, vvel, dxt, dyt, tarear, & - hte,htn,htem1,htnm1 - real (kind=dbl_kind), dimension(:), intent(inout), contiguous :: & - stressp_1,stressp_2, stressp_3, stressp_4, stressm_1, stressm_2, & - stressm_3,stressm_4, stress12_1,stress12_2,stress12_3, stress12_4 - real (kind=DBL_KIND), dimension(:), intent(out), contiguous :: & - str1,str2,str3,str4,str5,str6,str7,str8 - real (kind=dbl_kind), dimension(:), intent(out), contiguous :: & - divu,rdg_conv,rdg_shear,shear - - !-- local variables - - integer (kind=int_kind) :: iw,il,iu - real (kind=dbl_kind) :: & - puny - real (kind=DBL_KIND) :: & - divune, divunw, divuse, divusw,tensionne, tensionnw, tensionse, tensionsw, & - shearne, shearnw, shearse, shearsw, Deltane, Deltanw, Deltase, Deltasw , & - c0ne, c0nw, c0se, c0sw, c1ne, c1nw, c1se, c1sw , & - ssigpn, ssigps, ssigpe, ssigpw, ssigmn, ssigms, ssigme, ssigmw , & - ssig12n, ssig12s, ssig12e, ssig12w, ssigp1, ssigp2,ssigm1, ssigm2,ssig121, & - ssig122, csigpne, csigpnw, csigpse, csigpsw,csigmne, csigmnw, csigmse , & - csigmsw, csig12ne, csig12nw, csig12se, csig12sw, str12ew, str12we,str12ns, & - str12sn, strp_tmp, strm_tmp, tmp_uvel_ee, tmp_vvel_se, tmp_vvel_ee, & - tmp_vvel_ne, tmp_uvel_ne, tmp_uvel_se - real (kind=DBL_KIND) :: dxhy,dyhx,cxp,cyp,cxm,cym,tinyarea - - character(len=*), parameter :: subname = '(stress_l)' - !--------------------------------------- - - 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__) + cc1 = tmp_strintx + forcex(iw) + taux & + + umassdti(iw) * (brlx * uold + revp * uvel_init(iw)) + cc2 = tmp_strinty + forcey(iw) + tauy & + + umassdti(iw) * (brlx * vold + revp * vvel_init(iw)) -#ifdef _OPENACC - !$acc parallel & - !$acc present(ee,ne,se,strength,uvel,vvel,dxt,dyt,tarear, & - !$acc hte,htn,htem1,htnm1, & - !$acc str1,str2,str3,str4,str5,str6,str7,str8, & - !$acc stressp_1,stressp_2,stressp_3,stressp_4, & - !$acc stressm_1,stressm_2,stressm_3,stressm_4, & - !$acc stress12_1,stress12_2,stress12_3,stress12_4, & - !$acc divu,rdg_conv,rdg_shear,shear) - !$acc loop - do iw = 1,NA_len -#else - call domp_get_domain(lb,ub,il,iu) - do iw = il, iu -#endif - tinyarea = puny*dxt(iw)*dyt(iw) - dxhy = p5*(hte(iw) - htem1(iw)) - dyhx = p5*(htn(iw) - htnm1(iw)) - cxp = c1p5*htn(iw) - p5*htnm1(iw) - cyp = c1p5*hte(iw) - p5*htem1(iw) - cxm = -(c1p5*htnm1(iw) - p5*htn(iw)) - cym = -(c1p5*htem1(iw) - p5*hte(iw)) - - !----------------------------------------------------------------- - ! strain rates - ! NOTE these are actually strain rates * area (m^2/s) - !----------------------------------------------------------------- - ! divergence = e_11 + e_22 - tmp_uvel_ee = uvel(ee(iw)) - tmp_vvel_se = vvel(se(iw)) - tmp_vvel_ee = vvel(ee(iw)) - tmp_vvel_ne = vvel(ne(iw)) - tmp_uvel_ne = uvel(ne(iw)) - tmp_uvel_se = uvel(se(iw)) - - divune = cyp*uvel(iw) - dyt(iw)*tmp_uvel_ee & - + cxp*vvel(iw) - dxt(iw)*tmp_vvel_se - divunw = cym*tmp_uvel_ee + dyt(iw)*uvel(iw) & - + cxp*tmp_vvel_ee - dxt(iw)*tmp_vvel_ne - divusw = cym*tmp_uvel_ne + dyt(iw)*tmp_uvel_se & - + cxm*tmp_vvel_ne + dxt(iw)*tmp_vvel_ee - divuse = cyp*tmp_uvel_se - dyt(iw)*tmp_uvel_ne & - + cxm*tmp_vvel_se + dxt(iw)*vvel(iw) - - ! tension strain rate = e_11 - e_22 - tensionne = -cym*uvel(iw) - dyt(iw)*tmp_uvel_ee & - + cxm*vvel(iw) + dxt(iw)*tmp_vvel_se - tensionnw = -cyp*tmp_uvel_ee + dyt(iw)*uvel(iw) & - + cxm*tmp_vvel_ee + dxt(iw)*tmp_vvel_ne - tensionsw = -cyp*tmp_uvel_ne + dyt(iw)*tmp_uvel_se & - + cxp*tmp_vvel_ne - dxt(iw)*tmp_vvel_ee - tensionse = -cym*tmp_uvel_se - dyt(iw)*tmp_uvel_ne & - + cxp*tmp_vvel_se - dxt(iw)*vvel(iw) - - ! shearing strain rate = 2*e_12 - shearne = -cym*vvel(iw) - dyt(iw)*tmp_vvel_ee & - - cxm*uvel(iw) - dxt(iw)*tmp_uvel_se - shearnw = -cyp*tmp_vvel_ee + dyt(iw)*vvel(iw) & - - cxm*tmp_uvel_ee - dxt(iw)*tmp_uvel_ne - shearsw = -cyp*tmp_vvel_ne + dyt(iw)*tmp_vvel_se & - - cxp*tmp_uvel_ne + dxt(iw)*tmp_uvel_ee - shearse = -cym*tmp_vvel_se - dyt(iw)*tmp_vvel_ne & - - cxp*tmp_uvel_se + dxt(iw)*uvel(iw) - - ! Delta (in the denominator of zeta, eta) - Deltane = sqrt(divune**2 + ecci*(tensionne**2 + shearne**2)) - Deltanw = sqrt(divunw**2 + ecci*(tensionnw**2 + shearnw**2)) - Deltase = sqrt(divuse**2 + ecci*(tensionse**2 + shearse**2)) - Deltasw = sqrt(divusw**2 + ecci*(tensionsw**2 + shearsw**2)) - - !----------------------------------------------------------------- - ! on last subcycle, save quantities for mechanical redistribution - !----------------------------------------------------------------- - divu(iw) = p25*(divune + divunw + divuse + divusw) * tarear(iw) - rdg_conv(iw) = -min(divu(iw),c0) ! Could move outside the entire "kernel" - rdg_shear(iw) = p5*( p25*(Deltane + Deltanw + Deltase + Deltasw) * tarear(iw) -abs(divu(iw)) ) - - ! diagnostic only - ! shear = sqrt(tension**2 + shearing**2) - shear(iw) = p25*tarear(iw)*sqrt( & - (tensionne + tensionnw + tensionse + tensionsw)**2 & - + (shearne + shearnw + shearse + shearsw)**2) - - !----------------------------------------------------------------- - ! replacement pressure/Delta ! kg/s - ! save replacement pressure for principal stress calculation - !----------------------------------------------------------------- - c0ne = strength(iw)/max(Deltane,tinyarea) - c0nw = strength(iw)/max(Deltanw,tinyarea) - c0sw = strength(iw)/max(Deltasw,tinyarea) - c0se = strength(iw)/max(Deltase,tinyarea) - - c1ne = c0ne*arlx1i - c1nw = c0nw*arlx1i - c1sw = c0sw*arlx1i - c1se = c0se*arlx1i - - c0ne = c1ne*ecci - c0nw = c1nw*ecci - c0sw = c1sw*ecci - c0se = c1se*ecci - - !----------------------------------------------------------------- - ! the stresses ! kg/s^2 - ! (1) northeast, (2) northwest, (3) southwest, (4) southeast - !----------------------------------------------------------------- - - stressp_1(iw) = (stressp_1(iw)*(c1-arlx1i*revp) + c1ne*(divune*(c1+Ktens) - Deltane*(c1-Ktens))) * denom1 - stressp_2(iw) = (stressp_2(iw)*(c1-arlx1i*revp) + c1nw*(divunw*(c1+Ktens) - Deltanw*(c1-Ktens))) * denom1 - stressp_3(iw) = (stressp_3(iw)*(c1-arlx1i*revp) + c1sw*(divusw*(c1+Ktens) - Deltasw*(c1-Ktens))) * denom1 - stressp_4(iw) = (stressp_4(iw)*(c1-arlx1i*revp) + c1se*(divuse*(c1+Ktens) - Deltase*(c1-Ktens))) * denom1 - - stressm_1(iw) = (stressm_1(iw)*(c1-arlx1i*revp) + c0ne*tensionne*(c1+Ktens)) * denom1 - stressm_2(iw) = (stressm_2(iw)*(c1-arlx1i*revp) + c0nw*tensionnw*(c1+Ktens)) * denom1 - stressm_3(iw) = (stressm_3(iw)*(c1-arlx1i*revp) + c0sw*tensionsw*(c1+Ktens)) * denom1 - stressm_4(iw) = (stressm_4(iw)*(c1-arlx1i*revp) + c0se*tensionse*(c1+Ktens)) * denom1 - - stress12_1(iw) = (stress12_1(iw)*(c1-arlx1i*revp) + c0ne*shearne*p5*(c1+Ktens)) * denom1 - stress12_2(iw) = (stress12_2(iw)*(c1-arlx1i*revp) + c0nw*shearnw*p5*(c1+Ktens)) * denom1 - stress12_3(iw) = (stress12_3(iw)*(c1-arlx1i*revp) + c0sw*shearsw*p5*(c1+Ktens)) * denom1 - stress12_4(iw) = (stress12_4(iw)*(c1-arlx1i*revp) + c0se*shearse*p5*(c1+Ktens)) * denom1 - - !----------------------------------------------------------------- - ! combinations of the stresses for the momentum equation ! kg/s^2 - !----------------------------------------------------------------- - - ssigpn = stressp_1(iw) + stressp_2(iw) - ssigps = stressp_3(iw) + stressp_4(iw) - ssigpe = stressp_1(iw) + stressp_4(iw) - ssigpw = stressp_2(iw) + stressp_3(iw) - ssigp1 =(stressp_1(iw) + stressp_3(iw))*p055 - ssigp2 =(stressp_2(iw) + stressp_4(iw))*p055 - - ssigmn = stressm_1(iw) + stressm_2(iw) - ssigms = stressm_3(iw) + stressm_4(iw) - ssigme = stressm_1(iw) + stressm_4(iw) - ssigmw = stressm_2(iw) + stressm_3(iw) - ssigm1 =(stressm_1(iw) + stressm_3(iw))*p055 - ssigm2 =(stressm_2(iw) + stressm_4(iw))*p055 - - ssig12n = stress12_1(iw) + stress12_2(iw) - ssig12s = stress12_3(iw) + stress12_4(iw) - ssig12e = stress12_1(iw) + stress12_4(iw) - ssig12w = stress12_2(iw) + stress12_3(iw) - ssig121 =(stress12_1(iw) + stress12_3(iw))*p111 - ssig122 =(stress12_2(iw) + stress12_4(iw))*p111 - - csigpne = p111*stressp_1(iw) + ssigp2 + p027*stressp_3(iw) - csigpnw = p111*stressp_2(iw) + ssigp1 + p027*stressp_4(iw) - csigpsw = p111*stressp_3(iw) + ssigp2 + p027*stressp_1(iw) - csigpse = p111*stressp_4(iw) + ssigp1 + p027*stressp_2(iw) - - csigmne = p111*stressm_1(iw) + ssigm2 + p027*stressm_3(iw) - csigmnw = p111*stressm_2(iw) + ssigm1 + p027*stressm_4(iw) - csigmsw = p111*stressm_3(iw) + ssigm2 + p027*stressm_1(iw) - csigmse = p111*stressm_4(iw) + ssigm1 + p027*stressm_2(iw) - - csig12ne = p222*stress12_1(iw) + ssig122 + p055*stress12_3(iw) - csig12nw = p222*stress12_2(iw) + ssig121 + p055*stress12_4(iw) - csig12sw = p222*stress12_3(iw) + ssig122 + p055*stress12_1(iw) - csig12se = p222*stress12_4(iw) + ssig121 + p055*stress12_2(iw) - - str12ew = p5*dxt(iw)*(p333*ssig12e + p166*ssig12w) - str12we = p5*dxt(iw)*(p333*ssig12w + p166*ssig12e) - str12ns = p5*dyt(iw)*(p333*ssig12n + p166*ssig12s) - str12sn = p5*dyt(iw)*(p333*ssig12s + p166*ssig12n) - - !----------------------------------------------------------------- - ! for dF/dx (u momentum) - !----------------------------------------------------------------- - strp_tmp = p25*dyt(iw)*(p333*ssigpn + p166*ssigps) - strm_tmp = p25*dyt(iw)*(p333*ssigmn + p166*ssigms) - - ! northeast (iw) - str1(iw) = -strp_tmp - strm_tmp - str12ew & - + dxhy*(-csigpne + csigmne) + dyhx*csig12ne - - ! northwest (i+1,j) - str2(iw) = strp_tmp + strm_tmp - str12we & - + dxhy*(-csigpnw + csigmnw) + dyhx*csig12nw - - strp_tmp = p25*dyt(iw)*(p333*ssigps + p166*ssigpn) - strm_tmp = p25*dyt(iw)*(p333*ssigms + p166*ssigmn) - - ! southeast (i,j+1) - str3(iw) = -strp_tmp - strm_tmp + str12ew & - + dxhy*(-csigpse + csigmse) + dyhx*csig12se - - ! southwest (i+1,j+1) - str4(iw) = strp_tmp + strm_tmp + str12we & - + dxhy*(-csigpsw + csigmsw) + dyhx*csig12sw - - !----------------------------------------------------------------- - ! for dF/dy (v momentum) - !----------------------------------------------------------------- - strp_tmp = p25*dxt(iw)*(p333*ssigpe + p166*ssigpw) - strm_tmp = p25*dxt(iw)*(p333*ssigme + p166*ssigmw) - - ! northeast (i,j) - str5(iw) = -strp_tmp + strm_tmp - str12ns & - - dyhx*(csigpne + csigmne) + dxhy*csig12ne - - ! southeast (i,j+1) - str6(iw) = strp_tmp - strm_tmp - str12sn & - - dyhx*(csigpse + csigmse) + dxhy*csig12se - - strp_tmp = p25*dxt(iw)*(p333*ssigpw + p166*ssigpe) - strm_tmp = p25*dxt(iw)*(p333*ssigmw + p166*ssigme) - - ! northwest (i+1,j) - str7(iw) = -strp_tmp + strm_tmp + str12ns & - - dyhx*(csigpnw + csigmnw) + dxhy*csig12nw - - ! southwest (i+1,j+1) - str8(iw) = strp_tmp - strm_tmp + str12sn & - - dyhx*(csigpsw + csigmsw) + dxhy*csig12sw - enddo -#ifdef _OPENACC - !$acc end parallel -#endif - end subroutine stress_l - -!---------------------------------------------------------------------------- - - subroutine stepu_iter(NA_len,rhow, & - lb,ub,Cw,aiu,uocn,vocn,forcex,forcey,umassdti,fm,uarear,Tbu, & - uvel_init,vvel_init,uvel,vvel, & - str1,str2,str3,str4,str5,str6,str7,str8, nw,sw,se,skipme) - - use ice_kinds_mod - use ice_dyn_shared, only: brlx, revp - use ice_constants, only: c0, c1 - - implicit none - - integer (kind=int_kind), intent(in) :: NA_len - real (kind=dbl_kind), intent(in) :: rhow - integer(kind=int_kind),intent(in) :: lb,ub - logical(kind=log_kind),intent(in), dimension(:) :: skipme - integer(kind=int_kind),dimension(:), intent(in), contiguous :: nw,sw,se - real(kind=dbl_kind),dimension(:), intent(in), contiguous :: & - uvel_init, vvel_init, aiu, forcex, forcey, umassdti, Tbu, & - uocn, vocn, fm, uarear,Cw - real(kind=DBL_KIND),dimension(:), intent(in), contiguous :: & - str1,str2,str3,str4,str5,str6,str7,str8 - real(kind=dbl_kind),dimension(:), intent(inout), contiguous :: & - uvel,vvel - real (kind=dbl_kind), parameter :: & - cosw = c1 , & ! cos(ocean turning angle) ! turning angle = 0 - sinw = c0 - - !-- local variables - - integer (kind=int_kind) :: iw,il,iu - real (kind=dbl_kind) :: uold, vold, vrel,cca,ccb,ab2,cc1,cc2,taux,tauy,Cb - real (kind=dbl_kind) :: tmp_str2_nw,tmp_str3_se,tmp_str4_sw, tmp_strintx - real (kind=dbl_kind) :: tmp_str6_se,tmp_str7_nw,tmp_str8_sw, tmp_strinty - real (kind=dbl_kind) :: waterx,watery - real (kind=dbl_kind) :: u0 = 5.e-5_dbl_kind ! residual velocity for basal stress (m/s) - - character(len=*), parameter :: subname = '(stepu_iter)' - !--------------------------------------- + uvel(iw) = (cca * cc1 + ccb * cc2) / ab2 + vvel(iw) = (cca * cc2 - ccb * cc1) / ab2 + end do #ifdef _OPENACC - !$acc parallel & - !$acc present(Cw,aiu,uocn,vocn,forcex,forcey,umassdti,fm,uarear,Tbu, & - !$acc uvel_init,vvel_init,nw,sw,se,skipme, & - !$acc str1,str2,str3,str4,str5,str6,str7,str8,uvel,vvel) - !$acc loop - do iw = 1,NA_len -#else - call domp_get_domain(lb,ub,il,iu) - do iw = il, iu -#endif - if (skipme(iw)) cycle - uold = uvel(iw) - vold = vvel(iw) - vrel = aiu(iw)*rhow*Cw(iw)*sqrt((uocn(iw)-uold)**2+(vocn(iw)-vold)**2) - waterx = uocn(iw)*cosw - vocn(iw)*sinw*sign(c1,fm(iw)) - watery = vocn(iw)*cosw + uocn(iw)*sinw*sign(c1,fm(iw)) - taux = vrel*waterx - tauy = vrel*watery - Cb = Tbu(iw) / (sqrt(uold**2 + vold**2) + u0) - cca = (brlx + revp)*umassdti(iw) + vrel * cosw + Cb - ccb = fm(iw) + sign(c1,fm(iw)) * vrel * sinw - ab2 = cca**2 + ccb**2 - ! southeast(i,j+1) = se - ! northwest(i+1,j) = nw - ! southwest(i+1,j+1) = sw - tmp_str2_nw = str2(nw(iw)) - tmp_str3_se = str3(se(iw)) - tmp_str4_sw = str4(sw(iw)) - tmp_str6_se = str6(se(iw)) - tmp_str7_nw = str7(nw(iw)) - tmp_str8_sw = str8(sw(iw)) - - tmp_strintx = uarear(iw)*(str1(iw)+tmp_str2_nw+tmp_str3_se+tmp_str4_sw) - tmp_strinty = uarear(iw)*(str5(iw)+tmp_str6_se+tmp_str7_nw+tmp_str8_sw) - cc1 = tmp_strintx + forcex(iw) + taux & - + umassdti(iw)*(brlx*uold + revp*uvel_init(iw)) - cc2 = tmp_strinty + forcey(iw) + tauy & - + umassdti(iw)*(brlx*vold + revp*vvel_init(iw)) - uvel(iw) = (cca*cc1 + ccb*cc2) / ab2 - vvel(iw) = (cca*cc2 - ccb*cc1) / ab2 - enddo -#ifdef _OPENACC - !$acc end parallel + !$acc end parallel #endif - end subroutine stepu_iter - -!---------------------------------------------------------------------------- - - subroutine stepu_last(NA_len, rhow, & - lb,ub,Cw,aiu,uocn,vocn,forcex,forcey,umassdti,fm,uarear,Tbu, & - strintx,strinty,taubx,tauby, & - uvel_init,vvel_init,uvel,vvel, & - str1,str2,str3,str4,str5,str6,str7,str8, nw,sw,se,skipme) - - use ice_kinds_mod - use ice_constants, only: c0, c1 - use ice_dyn_shared, only: brlx, revp, basalstress - - implicit none - - integer (kind=int_kind), intent(in) :: NA_len - real (kind=dbl_kind), intent(in) :: rhow - logical(kind=log_kind),intent(in), dimension(:) :: skipme - integer(kind=int_kind),intent(in) :: lb,ub - integer(kind=int_kind),dimension(:), intent(in), contiguous :: nw,sw,se - real(kind=dbl_kind),dimension(:), intent(in), contiguous :: & - uvel_init, vvel_init, aiu, forcex, forcey, umassdti, Tbu, & - uocn, vocn, fm, uarear,Cw - real(kind=DBL_KIND),dimension(:), intent(in), contiguous :: & - str1,str2,str3,str4,str5,str6,str7,str8 - real(kind=dbl_kind),dimension(:), intent(inout), contiguous :: & - uvel,vvel, strintx,strinty, taubx,tauby - real (kind=dbl_kind), parameter :: & - cosw = c1 , & ! cos(ocean turning angle) ! turning angle = 0 - sinw = c0 - - !-- local variables - - integer (kind=int_kind) :: iw,il,iu - real (kind=dbl_kind) :: uold, vold, vrel,cca,ccb,ab2,cc1,cc2,taux,tauy,Cb - real (kind=dbl_kind) :: tmp_str2_nw,tmp_str3_se,tmp_str4_sw - real (kind=dbl_kind) :: tmp_str6_se,tmp_str7_nw,tmp_str8_sw - real (kind=dbl_kind) :: waterx,watery - real (kind=dbl_kind) :: u0 = 5.e-5_dbl_kind ! residual velocity for basal stress (m/s) - - character(len=*), parameter :: subname = '(stepu_last)' - !--------------------------------------- + end subroutine stepu_iter + +!======================================================================= + + subroutine stepu_last(NA_len, rhow, lb, ub, Cw, aiu, uocn, vocn, & + forcex, forcey, umassdti, fm, uarear, Tbu, uvel_init, vvel_init, & + uvel, vvel, str1, str2, str3, str4, str5, str6, str7, str8, nw, & + sw, sse, skipucell, strintx, strinty, taubx, tauby) + + use ice_kinds_mod + use ice_constants, only : c0, c1 + use ice_dyn_shared, only : brlx, revp, u0, cosw, sinw, & + seabed_stress + + implicit none + + integer(kind=int_kind), intent(in) :: NA_len, lb, ub + real(kind=dbl_kind), intent(in) :: rhow + logical(kind=log_kind), intent(in), dimension(:) :: skipucell + integer(kind=int_kind), dimension(:), intent(in), contiguous :: & + nw, sw, sse + real(kind=dbl_kind), dimension(:), intent(in), contiguous :: & + uvel_init, vvel_init, aiu, forcex, forcey, umassdti, Tbu, & + uocn, vocn, fm, uarear, Cw, str1, str2, str3, str4, str5, & + str6, str7, str8 + real(kind=dbl_kind), dimension(:), intent(inout), contiguous :: & + uvel, vvel, strintx, strinty, taubx, tauby + + ! local variables + + integer(kind=int_kind) :: iw, il, iu + real(kind=dbl_kind) :: uold, vold, vrel, cca, ccb, ab2, cc1, & + cc2, taux, tauy, Cb, tmp_str2_nw, tmp_str3_sse, tmp_str4_sw, & + tmp_str6_sse, tmp_str7_nw, tmp_str8_sw, waterx, watery + + character(len=*), parameter :: subname = '(stepu_last)' #ifdef _OPENACC - !$acc parallel & - !$acc present(Cw,aiu,uocn,vocn,forcex,forcey,umassdti,fm,uarear,Tbu, & - !$acc strintx,strinty,taubx,tauby,uvel_init,vvel_init,nw,sw,se,skipme, & - !$acc str1,str2,str3,str4,str5,str6,str7,str8,uvel,vvel ) - !$acc loop - do iw = 1,NA_len + !$acc parallel & + !$acc present(Cw, aiu, uocn, vocn, forcex, forcey, umassdti, fm, & + !$acc uarear, Tbu, uvel_init, vvel_init, nw, sw, sse, skipucell, & + !$acc str1, str2, str3, str4, str5, str6, str7, str8, uvel, & + !$acc vvel, strintx, strinty, taubx, tauby) + !$acc loop + do iw = 1, NA_len #else - call domp_get_domain(lb,ub,il,iu) - do iw = il, iu + call domp_get_domain(lb, ub, il, iu) + do iw = il, iu #endif - if (skipme(iw)) cycle - uold = uvel(iw) - vold = vvel(iw) - vrel = aiu(iw)*rhow*Cw(iw)*sqrt((uocn(iw)-uold)**2+(vocn(iw)-vold)**2) - waterx = uocn(iw)*cosw - vocn(iw)*sinw*sign(c1,fm(iw)) - watery = vocn(iw)*cosw + uocn(iw)*sinw*sign(c1,fm(iw)) - taux = vrel*waterx - tauy = vrel*watery - Cb = Tbu(iw) / (sqrt(uold**2 + vold**2) + u0) - cca = (brlx + revp)*umassdti(iw) + vrel * cosw + Cb - ccb = fm(iw) + sign(c1,fm(iw)) * vrel * sinw - ab2 = cca**2 + ccb**2 - ! southeast(i,j+1) = se - ! northwest(i+1,j) = nw - ! southwest(i+1,j+1) = sw - tmp_str2_nw = str2(nw(iw)) - tmp_str3_se = str3(se(iw)) - tmp_str4_sw = str4(sw(iw)) - tmp_str6_se = str6(se(iw)) - tmp_str7_nw = str7(nw(iw)) - tmp_str8_sw = str8(sw(iw)) - - strintx(iw) = uarear(iw)*(str1(iw)+tmp_str2_nw+tmp_str3_se+tmp_str4_sw) - strinty(iw) = uarear(iw)*(str5(iw)+tmp_str6_se+tmp_str7_nw+tmp_str8_sw) - cc1 = strintx(iw) + forcex(iw) + taux & - + umassdti(iw)*(brlx*uold + revp*uvel_init(iw)) - cc2 = strinty(iw) + forcey(iw) + tauy & - + umassdti(iw)*(brlx*vold + revp*vvel_init(iw)) - uvel(iw) = (cca*cc1 + ccb*cc2) / ab2 - vvel(iw) = (cca*cc2 - ccb*cc1) / ab2 - ! calculate basal stress component for outputs - if ( basalstress ) then - taubx(iw) = -uvel(iw)*Tbu(iw) / (sqrt(uold**2 + vold**2) + u0) - tauby(iw) = -vvel(iw)*Tbu(iw) / (sqrt(uold**2 + vold**2) + u0) - endif - enddo + + if (skipucell(iw)) cycle + + uold = uvel(iw) + vold = vvel(iw) + + vrel = aiu(iw) * rhow * Cw(iw) * sqrt((uocn(iw) - uold)**2 + (vocn(iw) - vold)**2) + + waterx = uocn(iw) * cosw - vocn(iw) * sinw * sign(c1, fm(iw)) + watery = vocn(iw) * cosw + uocn(iw) * sinw * sign(c1, fm(iw)) + + taux = vrel * waterx + tauy = vrel * watery + + Cb = Tbu(iw) / (sqrt(uold**2 + vold**2) + u0) + + cca = (brlx + revp) * umassdti(iw) + vrel * cosw + Cb + ccb = fm(iw) + sign(c1, fm(iw)) * vrel * sinw + + ab2 = cca**2 + ccb**2 + + tmp_str2_nw = str2(nw(iw)) + tmp_str3_sse = str3(sse(iw)) + tmp_str4_sw = str4(sw(iw)) + tmp_str6_sse = str6(sse(iw)) + tmp_str7_nw = str7(nw(iw)) + tmp_str8_sw = str8(sw(iw)) + + strintx(iw) = uarear(iw) * (str1(iw) + tmp_str2_nw + tmp_str3_sse + tmp_str4_sw) + strinty(iw) = uarear(iw) * (str5(iw) + tmp_str6_sse + tmp_str7_nw + tmp_str8_sw) + + cc1 = strintx(iw) + forcex(iw) + taux & + + umassdti(iw) * (brlx * uold + revp * uvel_init(iw)) + cc2 = strinty(iw) + forcey(iw) + tauy & + + umassdti(iw) * (brlx * vold + revp * vvel_init(iw)) + + uvel(iw) = (cca * cc1 + ccb * cc2) / ab2 + vvel(iw) = (cca * cc2 - ccb * cc1) / ab2 + + ! calculate seabed stress component for outputs + if (seabed_stress) then + taubx(iw) = -uvel(iw) * Tbu(iw) / (sqrt(uold**2 + vold**2) + u0) + tauby(iw) = -vvel(iw) * Tbu(iw) / (sqrt(uold**2 + vold**2) + u0) + end if + + end do #ifdef _OPENACC - !$acc end parallel + !$acc end parallel #endif - end subroutine stepu_last + end subroutine stepu_last -!---------------------------------------------------------------------------- +!======================================================================= - subroutine evp1d_halo_update(NAVEL_len,lb,ub,uvel,vvel, halo_parent) + subroutine evp1d_halo_update(NAVEL_len, lb, ub, uvel, vvel, & + halo_parent) - use ice_kinds_mod + use ice_kinds_mod - implicit none + implicit none - integer (kind=int_kind), intent(in) :: NAVEL_len - integer(kind=int_kind),intent(in) :: lb,ub - integer(kind=int_kind),dimension(:), intent(in), contiguous :: halo_parent - real(kind=dbl_kind),dimension(:), intent(inout), contiguous :: uvel,vvel + integer(kind=int_kind), intent(in) :: NAVEL_len, lb, ub + integer(kind=int_kind), dimension(:), intent(in), contiguous :: & + halo_parent + real(kind=dbl_kind), dimension(:), intent(inout), contiguous :: & + uvel, vvel - !-- local variables + ! local variables - integer (kind=int_kind) :: iw,il,iu + integer (kind=int_kind) :: iw, il, iu - character(len=*), parameter :: subname = '(evp1d_halo_update)' - !--------------------------------------- + character(len=*), parameter :: subname = '(evp1d_halo_update)' #ifdef _OPENACC - !$acc parallel & - !$acc present(uvel,vvel) & - !$acc loop - do iw = 1,NAVEL_len + !$acc parallel & + !$acc present(uvel, vvel) & + !$acc loop + do iw = 1, NAVEL_len + if (halo_parent(iw) == 0) cycle + uvel(iw) = uvel(halo_parent(iw)) + vvel(iw) = vvel(halo_parent(iw)) + end do + !$acc end parallel #else - call domp_get_domain(lb,ub,il,iu) - do iw = il, iu -#endif - if (halo_parent(iw)==0) cycle - uvel(iw) = uvel(halo_parent(iw)) - vvel(iw) = vvel(halo_parent(iw)) - enddo -#ifdef _OPENACC - !$acc end parallel + call domp_get_domain(lb, ub, il, iu) + do iw = il, iu + if (halo_parent(iw) == 0) cycle + uvel(iw) = uvel(halo_parent(iw)) + vvel(iw) = vvel(halo_parent(iw)) + end do + call domp_get_domain(ub + 1, NAVEL_len, il, iu) + do iw = il, iu + if (halo_parent(iw) == 0) cycle + uvel(iw) = uvel(halo_parent(iw)) + vvel(iw) = vvel(halo_parent(iw)) + end do #endif - end subroutine evp1d_halo_update - -!---------------------------------------------------------------------------- - -!former end module bench_v2 - -!=============================================================================== -!---------------------------------------------------------------------------- - - subroutine alloc1d(na) - - implicit none - - integer(kind=int_kind),intent(in) :: na - integer(kind=int_kind) :: ierr,nb - - character(len=*), parameter :: subname = '(alloc1d)' - !--------------------------------------- - - nb=na - allocate( & - ! U+T cells - ! Helper index for neighbours - indj(1:na),indi(1:na), & - ee(1:na),ne(1:na),se(1:na), & - nw(1:nb),sw(1:nb),sse(1:nb), & - skipucell(1:na), & - ! Grid distances: HTE,HTN + "-1 neighbours" - HTE(1:na),HTN(1:na), & - HTEm1(1:na),HTNm1(1:na), & - ! T cells -!v1 dxhy(1:na),dyhx(1:na),cyp(1:na),cxp(1:na),cym(1:na),cxm(1:na),tinyarea(1:na),& - strength(1:na),dxt(1:na),dyt(1:na), tarear(1:na), & - stressp_1(1:na), stressp_2(1:na), stressp_3(1:na), stressp_4(1:na), & - stressm_1(1:na), stressm_2(1:na), stressm_3(1:na), stressm_4(1:na), & - stress12_1(1:na),stress12_2(1:na),stress12_3(1:na),stress12_4(1:na),& - divu(1:na),rdg_conv(1:na),rdg_shear(1:na),shear(1:na), & - ! U cells -!v1 waterx(1:nb),watery(1:nb), & - cdn_ocn(1:nb),aiu(1:nb),uocn(1:nb),vocn(1:nb), & - forcex(1:nb),forcey(1:nb),Tbu(1:nb), & - umassdti(1:nb),fm(1:nb),uarear(1:nb), & - strintx(1:nb),strinty(1:nb), & - uvel_init(1:nb),vvel_init(1:nb), & - taubx(1:nb),tauby(1:nb), & - stat=ierr) - - if (ierr/=0) call abort_ice(subname//': ERROR allocating 1D') - - end subroutine alloc1d - -!---------------------------------------------------------------------------- - - subroutine alloc1d_navel(navel) - - implicit none - - integer(kind=int_kind),intent(in) :: navel - integer(kind=int_kind) :: ierr - - character(len=*), parameter :: subname = '(alloc1d_navel)' - !--------------------------------------- - - allocate( & - uvel(1:navel),vvel(1:navel), indij(1:navel), halo_parent(1:navel), & - str1(1:navel),str2(1:navel),str3(1:navel),str4(1:navel), & - str5(1:navel),str6(1:navel),str7(1:navel),str8(1:navel), & - stat=ierr) - if (ierr/=0) call abort_ice(subname// ': Error allocating 1D navel') - - end subroutine alloc1d_navel - -!---------------------------------------------------------------------------- - - subroutine dealloc1d - - implicit none - - integer(kind=int_kind) :: ierr - - character(len=*), parameter :: subname = '(dealloc1d)' - !--------------------------------------- - - deallocate( & - ! U+T cells - ! Helper index for neighbours - indj,indi, & - ee,ne,se, & - nw,sw,sse, & - skipucell, & - ! T cells - strength,dxt,dyt,tarear, & - stressp_1, stressp_2, stressp_3, stressp_4, & - stressm_1, stressm_2, stressm_3, stressm_4, & - stress12_1,stress12_2,stress12_3,stress12_4,& - str1, str2,str3,str4, & - str5, str6,str7,str8, & - divu,rdg_conv,rdg_shear,shear, & - ! U cells - cdn_ocn,aiu,uocn,vocn, & - forcex,forcey,Tbu, & - umassdti,fm,uarear, & - strintx,strinty, & - uvel_init,vvel_init, & - taubx,tauby, & - ! NAVEL - uvel,vvel, indij, halo_parent, & - stat=ierr) - - if (ierr/=0) call abort_ice(subname//': Error de-allocating 1D') - -!v1 if (allocated(tinyarea)) then -!v1 deallocate( & -!v1 dxhy,dyhx,cyp,cxp,cym,cxm,tinyarea, & -!v1 waterx,watery, & -!v1 stat=ierr) -!v1 if (ierr/=0) call abort_ice(subname//': Error de-allocating 1D, v1') -!v1 endif - - if (allocated(HTE)) then - deallocate( & - ! Grid distances: HTE,HTN + "-1 neighbours" - HTE,HTN, HTEm1,HTNm1, & - stat=ierr) - if (ierr/=0) call abort_ice(subname//': Error de-allocating 1D, v2') - endif - - end subroutine dealloc1d - -!---------------------------------------------------------------------------- - - subroutine evp_copyin_v2(nx,ny,nblk,nx_glob,ny_glob, & - I_HTE,I_HTN, & -!v1 I_dxhy,I_dyhx,I_cyp,I_cxp,I_cym,I_cxm,I_tinyarea, & -!v1 I_waterx,I_watery, & - I_icetmask,I_iceumask, & - I_cdn_ocn,I_aiu,I_uocn,I_vocn,I_forcex,I_forcey,I_Tbu, & - I_umassdti,I_fm,I_uarear,I_tarear,I_strintx,I_strinty,I_uvel_init,I_vvel_init, & - I_strength,I_uvel,I_vvel,I_dxt,I_dyt, & - I_stressp_1 ,I_stressp_2, I_stressp_3, I_stressp_4, & - I_stressm_1 ,I_stressm_2, I_stressm_3, I_stressm_4, & - I_stress12_1,I_stress12_2,I_stress12_3,I_stress12_4 ) - - use ice_gather_scatter, only: gather_global_ext - use ice_domain, only: distrb_info - use ice_communicate, only: my_task, master_task - - implicit none - - integer(int_kind), intent(in) :: nx, ny, nblk, nx_glob, ny_glob - integer (kind=int_kind),dimension (nx,ny,nblk), intent(in) :: I_icetmask - logical (kind=log_kind),dimension (nx,ny,nblk), intent(in) :: I_iceumask - real (kind=dbl_kind), dimension(nx,ny,nblk), intent(in) :: & - I_HTE,I_HTN, & -!v1 I_dxhy,I_dyhx,I_cyp,I_cxp,I_cym,I_cxm,I_tinyarea, & -!v1 I_waterx,I_watery, & - I_cdn_ocn,I_aiu,I_uocn,I_vocn,I_forcex,I_forcey,I_Tbu, & - I_umassdti,I_fm,I_uarear,I_tarear,I_strintx,I_strinty,I_uvel_init,I_vvel_init, & - I_strength,I_uvel,I_vvel,I_dxt,I_dyt, & - I_stressp_1, I_stressp_2, I_stressp_3, I_stressp_4, & - I_stressm_1, I_stressm_2, I_stressm_3, I_stressm_4, & - I_stress12_1,I_stress12_2,I_stress12_3,I_stress12_4 - - !-- local variables - - integer (kind=int_kind),dimension (nx_glob,ny_glob) :: G_icetmask - logical (kind=log_kind),dimension (nx_glob,ny_glob) :: G_iceumask - real (kind=dbl_kind), dimension(nx_glob,ny_glob) :: & - G_HTE,G_HTN, & -!v1 G_dxhy,G_dyhx,G_cyp,G_cxp,G_cym,G_cxm,G_tinyarea, & -!v1 G_waterx,G_watery, & - G_cdn_ocn,G_aiu,G_uocn,G_vocn,G_forcex,G_forcey,G_Tbu, & - G_umassdti,G_fm,G_uarear,G_tarear,G_strintx,G_strinty,G_uvel_init,G_vvel_init, & - G_strength,G_uvel,G_vvel,G_dxt,G_dyt, & - G_stressp_1, G_stressp_2, G_stressp_3, G_stressp_4, & - G_stressm_1, G_stressm_2, G_stressm_3, G_stressm_4, & - G_stress12_1,G_stress12_2,G_stress12_3,G_stress12_4 - integer(kind=int_kind) :: na, navel - - character(len=*), parameter :: subname = '(evp_copyin_v2)' - !--------------------------------------- - !-- Gather data into one single block -- - - call gather_global_ext(G_icetmask, I_icetmask, master_task, distrb_info) - call gather_global_ext(G_iceumask, I_iceumask, master_task, distrb_info) - call gather_global_ext(G_HTE, I_HTE, master_task, distrb_info) - call gather_global_ext(G_HTN, I_HTN, master_task, distrb_info) -!v1 call gather_global_ext(G_dxhy, I_dxhy, master_task, distrb_info) -!v1 call gather_global_ext(G_dyhx, I_dyhx, master_task, distrb_info) -!v1 call gather_global_ext(G_cyp, I_cyp, master_task, distrb_info) -!v1 call gather_global_ext(G_cxp, I_cxp, master_task, distrb_info) -!v1 call gather_global_ext(G_cym, I_cym, master_task, distrb_info) -!v1 call gather_global_ext(G_cxm, I_cxm, master_task, distrb_info) -!v1 call gather_global_ext(G_tinyarea, I_tinyarea, master_task, distrb_info) -!v1 call gather_global_ext(G_waterx, I_waterx, master_task, distrb_info) -!v1 call gather_global_ext(G_watery, I_watery, master_task, distrb_info) - call gather_global_ext(G_cdn_ocn, I_cdn_ocn, master_task, distrb_info) - call gather_global_ext(G_aiu, I_aiu, master_task, distrb_info) - call gather_global_ext(G_uocn, I_uocn, master_task, distrb_info) - call gather_global_ext(G_vocn, I_vocn, master_task, distrb_info) - call gather_global_ext(G_forcex, I_forcex, master_task, distrb_info) - call gather_global_ext(G_forcey, I_forcey, master_task, distrb_info) - call gather_global_ext(G_Tbu, I_Tbu, master_task, distrb_info) - call gather_global_ext(G_umassdti, I_umassdti, master_task, distrb_info) - call gather_global_ext(G_fm, I_fm, master_task, distrb_info) - call gather_global_ext(G_uarear, I_uarear, master_task, distrb_info) - call gather_global_ext(G_tarear, I_tarear, master_task, distrb_info) - call gather_global_ext(G_strintx, I_strintx, master_task, distrb_info) - call gather_global_ext(G_strinty, I_strinty, master_task, distrb_info) - call gather_global_ext(G_uvel_init, I_uvel_init, master_task, distrb_info) - call gather_global_ext(G_vvel_init, I_vvel_init, master_task, distrb_info) - call gather_global_ext(G_strength, I_strength, master_task, distrb_info) - call gather_global_ext(G_uvel, I_uvel, master_task, distrb_info) - call gather_global_ext(G_vvel, I_vvel, master_task, distrb_info) - call gather_global_ext(G_dxt, I_dxt, master_task, distrb_info) - call gather_global_ext(G_dyt, I_dyt, master_task, distrb_info) - call gather_global_ext(G_stressp_1, I_stressp_1, master_task, distrb_info) - call gather_global_ext(G_stressp_2, I_stressp_2, master_task, distrb_info) - call gather_global_ext(G_stressp_3, I_stressp_3, master_task, distrb_info) - call gather_global_ext(G_stressp_4, I_stressp_4, master_task, distrb_info) - call gather_global_ext(G_stressm_1, I_stressm_1, master_task, distrb_info) - call gather_global_ext(G_stressm_2, I_stressm_2, master_task, distrb_info) - call gather_global_ext(G_stressm_3, I_stressm_3, master_task, distrb_info) - call gather_global_ext(G_stressm_4, I_stressm_4, master_task, distrb_info) - call gather_global_ext(G_stress12_1, I_stress12_1, master_task, distrb_info) - call gather_global_ext(G_stress12_2, I_stress12_2, master_task, distrb_info) - call gather_global_ext(G_stress12_3, I_stress12_3, master_task, distrb_info) - call gather_global_ext(G_stress12_4, I_stress12_4, master_task, distrb_info) - - !-- All calculations has to be done on the master-task -- - - if (my_task == master_task) then - !-- Find number of active points and allocate vectors -- - call calc_na(nx_glob,ny_glob,na,G_icetmask) - call alloc1d(na) - call calc_2d_indices(nx_glob,ny_glob,na, G_icetmask, G_iceumask) - call calc_navel(nx_glob,ny_glob,na,navel) - call alloc1d_navel(navel) -!MHRI !$OMP PARALLEL DEFAULT(shared) - call numainit(1,na,navel) -!MHRI !$OMP END PARALLEL - ! Remap 2d to 1d and fill in - call convert_2d_1d(nx_glob,ny_glob,na,navel, & - G_HTE,G_HTN, & -!v1 G_dxhy,G_dyhx,G_cyp,G_cxp,G_cym,G_cxm,G_tinyarea, & -!v1 G_waterx,G_watery, & - G_cdn_ocn,G_aiu,G_uocn,G_vocn,G_forcex,G_forcey,G_Tbu, & - G_umassdti,G_fm,G_uarear,G_tarear,G_strintx,G_strinty,G_uvel_init,G_vvel_init, & - G_strength,G_uvel,G_vvel,G_dxt,G_dyt, & - G_stressp_1, G_stressp_2, G_stressp_3, G_stressp_4, & - G_stressm_1, G_stressm_2, G_stressm_3, G_stressm_4, & - G_stress12_1,G_stress12_2,G_stress12_3,G_stress12_4 ) - call calc_halo_parent(nx_glob,ny_glob,na,navel, G_icetmask) - NA_len=na - NAVEL_len=navel - endif - - !-- write check -!if (1 == 1) then -! write(nu_diag,*) subname,' MHRI: INDICES start:' -! write(nu_diag,*) 'na,navel ', na,navel -! write(nu_diag,*) 'Min/max ee', minval(ee(1:na)), maxval(ee(1:na)) -! write(nu_diag,*) 'Min/max ne', minval(ne(1:na)), maxval(ne(1:na)) -! write(nu_diag,*) 'Min/max se', minval(se(1:na)), maxval(se(1:na)) -! write(nu_diag,*) 'Min/max nw', minval(nw(1:na)), maxval(nw(1:na)) -! write(nu_diag,*) 'Min/max sw', minval(sw(1:na)), maxval(sw(1:na)) -! write(nu_diag,*) 'Min/max sse', minval(sse(1:na)), maxval(sse(1:na)) -! write(nu_diag,*) subname,' MHRI: INDICES end:' -!endif - - end subroutine evp_copyin_v2 - -!---------------------------------------------------------------------------- - - subroutine evp_copyout(nx,ny,nblk,nx_glob,ny_glob, & - I_uvel,I_vvel, I_strintx,I_strinty, & - I_stressp_1, I_stressp_2, I_stressp_3, I_stressp_4, & - I_stressm_1, I_stressm_2, I_stressm_3, I_stressm_4, & - I_stress12_1,I_stress12_2,I_stress12_3,I_stress12_4, & - I_divu,I_rdg_conv,I_rdg_shear,I_shear,I_taubx,I_tauby ) - - use ice_constants, only : c0 - use ice_gather_scatter, only: scatter_global_ext - use ice_domain, only: distrb_info - use ice_communicate, only: my_task, master_task - - implicit none - - integer(int_kind), intent(in) :: nx,ny,nblk, nx_glob,ny_glob - real(dbl_kind), dimension(nx,ny,nblk), intent(out) :: & - I_uvel,I_vvel, I_strintx,I_strinty, & - I_stressp_1, I_stressp_2, I_stressp_3, I_stressp_4, & - I_stressm_1, I_stressm_2, I_stressm_3, I_stressm_4, & - I_stress12_1,I_stress12_2,I_stress12_3,I_stress12_4, & - I_divu,I_rdg_conv, I_rdg_shear,I_shear, I_taubx,I_tauby - - !-- local variables - - real(dbl_kind), dimension(nx_glob,ny_glob) :: & - G_uvel,G_vvel, G_strintx,G_strinty, & - G_stressp_1, G_stressp_2, G_stressp_3, G_stressp_4, & - G_stressm_1, G_stressm_2, G_stressm_3, G_stressm_4, & - G_stress12_1,G_stress12_2,G_stress12_3,G_stress12_4, & - G_divu,G_rdg_conv, G_rdg_shear,G_shear, G_taubx,G_tauby - integer(int_kind) :: i,j,iw, nx_block - - character(len=*), parameter :: subname = '(evp_copyout)' - !--------------------------------------- - ! Remap 1d to 2d and fill in - nx_block=nx_glob ! Total block size in x-dir - - if (my_task == master_task) then - G_uvel = c0 - G_vvel = c0 - G_strintx = c0 - G_strinty = c0 - G_stressp_1 = c0 - G_stressp_2 = c0 - G_stressp_3 = c0 - G_stressp_4 = c0 - G_stressm_1 = c0 - G_stressm_2 = c0 - G_stressm_3 = c0 - G_stressm_4 = c0 - G_stress12_1 = c0 - G_stress12_2 = c0 - G_stress12_3 = c0 - G_stress12_4 = c0 - G_divu = c0 - G_rdg_conv = c0 - G_rdg_shear = c0 - G_shear = c0 - G_taubx = c0 - G_tauby = c0 - !$OMP PARALLEL PRIVATE(iw,i,j) - do iw=1,NAVEL_len - j=int((indij(iw)-1)/(nx_block))+1 - i=indij(iw)-(j-1)*nx_block - G_uvel(i,j) = uvel(iw) - G_vvel(i,j) = vvel(iw) - enddo - !$OMP END PARALLEL - !$OMP PARALLEL PRIVATE(iw,i,j) - do iw=1,NA_len - i=indi(iw) - j=indj(iw) -! G_uvel(i,j) = uvel(iw) ! done above -! G_vvel(i,j) = vvel(iw) ! done above - G_strintx(i,j) = strintx(iw) - G_strinty(i,j) = strinty(iw) - G_stressp_1(i,j) = stressp_1(iw) - G_stressp_2(i,j) = stressp_2(iw) - G_stressp_3(i,j) = stressp_3(iw) - G_stressp_4(i,j) = stressp_4(iw) - G_stressm_1(i,j) = stressm_1(iw) - G_stressm_2(i,j) = stressm_2(iw) - G_stressm_3(i,j) = stressm_3(iw) - G_stressm_4(i,j) = stressm_4(iw) - G_stress12_1(i,j) = stress12_1(iw) - G_stress12_2(i,j) = stress12_2(iw) - G_stress12_3(i,j) = stress12_3(iw) - G_stress12_4(i,j) = stress12_4(iw) - G_divu(i,j) = divu(iw) - G_rdg_conv(i,j) = rdg_conv(iw) - G_rdg_shear(i,j) = rdg_shear(iw) - G_shear(i,j) = shear(iw) - G_taubx(i,j) = taubx(iw) - G_tauby(i,j) = tauby(iw) - enddo - !$OMP END PARALLEL - call dealloc1d() - endif - - !-- Scatter data into blocks -- - !-- has to be done on all tasks -- - - call scatter_global_ext(I_uvel, G_uvel, master_task, distrb_info) - call scatter_global_ext(I_vvel, G_vvel, master_task, distrb_info) - call scatter_global_ext(I_strintx, G_strintx, master_task, distrb_info) - call scatter_global_ext(I_strinty, G_strinty, master_task, distrb_info) - call scatter_global_ext(I_stressp_1, G_stressp_1, master_task, distrb_info) - call scatter_global_ext(I_stressp_2, G_stressp_2, master_task, distrb_info) - call scatter_global_ext(I_stressp_3, G_stressp_3, master_task, distrb_info) - call scatter_global_ext(I_stressp_4, G_stressp_4, master_task, distrb_info) - call scatter_global_ext(I_stressm_1, G_stressm_1, master_task, distrb_info) - call scatter_global_ext(I_stressm_2, G_stressm_2, master_task, distrb_info) - call scatter_global_ext(I_stressm_3, G_stressm_3, master_task, distrb_info) - call scatter_global_ext(I_stressm_4, G_stressm_4, master_task, distrb_info) - call scatter_global_ext(I_stress12_1, G_stress12_1, master_task, distrb_info) - call scatter_global_ext(I_stress12_2, G_stress12_2, master_task, distrb_info) - call scatter_global_ext(I_stress12_3, G_stress12_3, master_task, distrb_info) - call scatter_global_ext(I_stress12_4, G_stress12_4, master_task, distrb_info) - call scatter_global_ext(I_divu, G_divu, master_task, distrb_info) - call scatter_global_ext(I_rdg_conv, G_rdg_conv, master_task, distrb_info) - call scatter_global_ext(I_rdg_shear, G_rdg_shear, master_task, distrb_info) - call scatter_global_ext(I_shear, G_shear, master_task, distrb_info) - call scatter_global_ext(I_taubx, G_taubx, master_task, distrb_info) - call scatter_global_ext(I_tauby, G_tauby, master_task, distrb_info) - - end subroutine evp_copyout - -!---------------------------------------------------------------------------- - - subroutine evp_kernel_v2 - - use ice_constants, only : c0 - use ice_dyn_shared, only: ndte - use ice_communicate, only: my_task, master_task - implicit none - - real(kind=dbl_kind) :: rhow - integer (kind=int_kind) :: i, nthreads - integer (kind=int_kind) :: na,nb,navel - - character(len=*), parameter :: subname = '(evp_kernel_v2)' - !--------------------------------------- - !-- All calculations has to be done on one single node (choose master-task) -- - - if (my_task == master_task) then - - !- Read constants... - call icepack_query_parameters(rhow_out=rhow) - call icepack_warnings_flush(nu_diag) - if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & - file=__FILE__, line=__LINE__) - na=NA_len - nb=NA_len - navel=NAVEL_len - - !- Initialize openmp --------------------------------------------------------- - call domp_init(nthreads) ! ought to be called from main - - !- Initialize timers --------------------------------------------------------- - str1=c0 - str2=c0 - str3=c0 - str4=c0 - str5=c0 - str6=c0 - str7=c0 - str8=c0 - - if (ndte<2) call abort_ice(subname//' ERROR: ndte must be 2 or higher for this kernel') - - !$OMP PARALLEL PRIVATE(i) - do i = 1, ndte-1 - call evp1d_stress(NA_len, & - ee,ne,se,1,na,uvel,vvel,dxt,dyt, & - hte,htn,htem1,htnm1, & - strength,stressp_1,stressp_2,stressp_3,stressp_4, & - stressm_1,stressm_2,stressm_3,stressm_4,stress12_1, & - stress12_2,stress12_3,stress12_4,str1,str2,str3, & - str4,str5,str6,str7,str8) - !$OMP BARRIER - call evp1d_stepu(NA_len, rhow, & - 1,nb,cdn_ocn,aiu,uocn,vocn,forcex,forcey,umassdti,fm,uarear,Tbu,& - uvel_init,vvel_init,uvel,vvel, & - str1,str2,str3,str4,str5,str6,str7,str8, nw,sw,sse,skipucell) - !$OMP BARRIER - call evp1d_halo_update(NA_len,1,navel,uvel,vvel, halo_parent) - !$OMP BARRIER - enddo - - call evp1d_stress(NA_len, tarear, & - ee,ne,se,1,na,uvel,vvel,dxt,dyt, & - hte,htn,htem1,htnm1, & - strength,stressp_1,stressp_2,stressp_3,stressp_4, & - stressm_1,stressm_2,stressm_3,stressm_4,stress12_1, & - stress12_2,stress12_3,stress12_4, & - divu,rdg_conv,rdg_shear,shear, & - str1,str2,str3,str4,str5,str6,str7,str8) - !$OMP BARRIER - call evp1d_stepu(NA_len, rhow, & - 1,nb,cdn_ocn,aiu,uocn,vocn,forcex,forcey,umassdti,fm,uarear,Tbu,& - strintx,strinty,taubx,tauby, & - uvel_init,vvel_init,uvel,vvel, & - str1,str2,str3,str4,str5,str6,str7,str8, nw,sw,sse,skipucell) - !$OMP BARRIER - call evp1d_halo_update(NA_len,1,navel,uvel,vvel, halo_parent) + end subroutine evp1d_halo_update + +!======================================================================= + + subroutine alloc1d(na) + + implicit none + + integer(kind=int_kind), intent(in) :: na + + ! local variables + + integer(kind=int_kind) :: ierr + + character(len=*), parameter :: subname = '(alloc1d)' + + allocate( & + ! helper indices for neighbours + indj(1:na), indi(1:na), ee(1:na), ne(1:na), se(1:na), & + nw(1:na), sw(1:na), sse(1:na), skipucell(1:na), & + skiptcell(1:na), & + ! grid distances and their "-1 neighbours" + HTE(1:na), HTN(1:na), HTEm1(1:na), HTNm1(1:na), & + ! T cells + strength(1:na), dxt(1:na), dyt(1:na), tarear(1:na), & + stressp_1(1:na), stressp_2(1:na), stressp_3(1:na), & + stressp_4(1:na), stressm_1(1:na), stressm_2(1:na), & + stressm_3(1:na), stressm_4(1:na), stress12_1(1:na), & + stress12_2(1:na), stress12_3(1:na), stress12_4(1:na), & + divu(1:na), rdg_conv(1:na), rdg_shear(1:na), shear(1:na), & + ! U cells + cdn_ocn(1:na), aiu(1:na), uocn(1:na), vocn(1:na), & + forcex(1:na), forcey(1:na), Tbu(1:na), umassdti(1:na), & + fm(1:na), uarear(1:na), strintx(1:na), strinty(1:na), & + uvel_init(1:na), vvel_init(1:na), taubx(1:na), tauby(1:na), & + ! error handling + stat=ierr) + + if (ierr /= 0) call abort_ice(subname & + // ' ERROR: could not allocate 1D arrays') + + end subroutine alloc1d + +!======================================================================= + + subroutine alloc1d_navel(navel) + + implicit none + + integer(kind=int_kind), intent(in) :: navel + + ! local variables + + integer(kind=int_kind) :: ierr + + character(len=*), parameter :: subname = '(alloc1d_navel)' + + allocate(uvel(1:navel), vvel(1:navel), indij(1:navel), & + halo_parent(1:navel), str1(1:navel), str2(1:navel), & + str3(1:navel), str4(1:navel), str5(1:navel), str6(1:navel), & + str7(1:navel), str8(1:navel), stat=ierr) + + if (ierr /= 0) call abort_ice(subname & + // ' ERROR: could not allocate 1D arrays') + + end subroutine alloc1d_navel + +!======================================================================= + + subroutine dealloc1d + + implicit none + + ! local variables + + integer(kind=int_kind) :: ierr + + character(len=*), parameter :: subname = '(dealloc1d)' + + deallocate( & + ! helper indices for neighbours + indj, indi, ee, ne, se, nw, sw, sse, skipucell, skiptcell, & + ! grid distances and their "-1 neighbours" + HTE, HTN, HTEm1, HTNm1, & + ! T cells + strength, dxt, dyt, tarear, stressp_1, stressp_2, stressp_3, & + stressp_4, stressm_1, stressm_2, stressm_3, stressm_4, & + stress12_1, stress12_2, stress12_3, stress12_4, str1, str2, & + str3, str4, str5, str6, str7, str8, divu, rdg_conv, & + rdg_shear, shear, & + ! U cells + cdn_ocn, aiu, uocn, vocn, forcex, forcey, Tbu, umassdti, fm, & + uarear, strintx, strinty, uvel_init, vvel_init, taubx, tauby, & + uvel, vvel, indij, halo_parent, & + ! error handling + stat=ierr) + + if (ierr /= 0) call abort_ice(subname & + // ' ERROR: could not deallocate 1D arrays') + + end subroutine dealloc1d + +!======================================================================= + + subroutine ice_dyn_evp_1d_copyin(nx, ny, nblk, nx_glob, ny_glob, & + I_icetmask, I_iceumask, I_cdn_ocn, I_aiu, I_uocn, I_vocn, & + I_forcex, I_forcey, I_Tbu, I_umassdti, I_fm, I_uarear, I_tarear, & + I_strintx, I_strinty, I_uvel_init, I_vvel_init, I_strength, & + I_uvel, I_vvel, I_dxt, I_dyt, I_stressp_1, I_stressp_2, & + I_stressp_3, I_stressp_4, I_stressm_1, I_stressm_2, I_stressm_3, & + I_stressm_4, I_stress12_1, I_stress12_2, I_stress12_3, & + I_stress12_4) + + use ice_gather_scatter, only : gather_global_ext + use ice_domain, only : distrb_info + use ice_communicate, only : my_task, master_task + use ice_grid, only : G_HTE, G_HTN + use ice_constants, only : c0 + + implicit none + + integer(int_kind), intent(in) :: nx, ny, nblk, nx_glob, ny_glob + logical(kind=log_kind), dimension(nx, ny, nblk), intent(in) :: & + I_iceumask + integer(kind=int_kind), dimension(nx, ny, nblk), intent(in) :: & + I_icetmask + real(kind=dbl_kind), dimension(nx, ny, nblk), intent(in) :: & + I_cdn_ocn, I_aiu, I_uocn, I_vocn, I_forcex, I_forcey, I_Tbu, & + I_umassdti, I_fm, I_uarear, I_tarear, I_strintx, I_strinty, & + I_uvel_init, I_vvel_init, I_strength, I_uvel, I_vvel, I_dxt, & + I_dyt, I_stressp_1, I_stressp_2, I_stressp_3, I_stressp_4, & + I_stressm_1, I_stressm_2, I_stressm_3, I_stressm_4, & + I_stress12_1, I_stress12_2, I_stress12_3, I_stress12_4 + + ! local variables + + logical(kind=log_kind), dimension(nx_glob, ny_glob) :: & + G_iceumask + integer(kind=int_kind), dimension(nx_glob, ny_glob) :: & + G_icetmask + real(kind=dbl_kind), dimension(nx_glob, ny_glob) :: & + G_cdn_ocn, G_aiu, G_uocn, G_vocn, G_forcex, G_forcey, G_Tbu, & + G_umassdti, G_fm, G_uarear, G_tarear, G_strintx, G_strinty, & + G_uvel_init, G_vvel_init, G_strength, G_uvel, G_vvel, G_dxt, & + G_dyt, G_stressp_1, G_stressp_2, G_stressp_3, G_stressp_4, & + G_stressm_1, G_stressm_2, G_stressm_3, G_stressm_4, & + G_stress12_1, G_stress12_2, G_stress12_3, G_stress12_4 + + character(len=*), parameter :: & + subname = '(ice_dyn_evp_1d_copyin)' + + call gather_global_ext(G_icetmask, I_icetmask, master_task, distrb_info ) + call gather_global_ext(G_iceumask, I_iceumask, master_task, distrb_info ) + call gather_global_ext(G_cdn_ocn, I_cdn_ocn, master_task, distrb_info ) + call gather_global_ext(G_aiu, I_aiu, master_task, distrb_info ) + call gather_global_ext(G_uocn, I_uocn, master_task, distrb_info ) + call gather_global_ext(G_vocn, I_vocn, master_task, distrb_info ) + call gather_global_ext(G_forcex, I_forcex, master_task, distrb_info ) + call gather_global_ext(G_forcey, I_forcey, master_task, distrb_info ) + call gather_global_ext(G_Tbu, I_Tbu, master_task, distrb_info ) + call gather_global_ext(G_umassdti, I_umassdti, master_task, distrb_info ) + call gather_global_ext(G_fm, I_fm, master_task, distrb_info ) + call gather_global_ext(G_uarear, I_uarear, master_task, distrb_info ) + call gather_global_ext(G_tarear, I_tarear, master_task, distrb_info ) + call gather_global_ext(G_strintx, I_strintx, master_task, distrb_info ) + call gather_global_ext(G_strinty, I_strinty, master_task, distrb_info ) + call gather_global_ext(G_uvel_init, I_uvel_init, master_task, distrb_info ) + call gather_global_ext(G_vvel_init, I_vvel_init, master_task, distrb_info ) + call gather_global_ext(G_strength, I_strength, master_task, distrb_info ) + call gather_global_ext(G_uvel, I_uvel, master_task, distrb_info, c0) + call gather_global_ext(G_vvel, I_vvel, master_task, distrb_info, c0) + call gather_global_ext(G_dxt, I_dxt, master_task, distrb_info ) + call gather_global_ext(G_dyt, I_dyt, master_task, distrb_info ) + call gather_global_ext(G_stressp_1, I_stressp_1, master_task, distrb_info ) + call gather_global_ext(G_stressp_2, I_stressp_2, master_task, distrb_info ) + call gather_global_ext(G_stressp_3, I_stressp_3, master_task, distrb_info ) + call gather_global_ext(G_stressp_4, I_stressp_4, master_task, distrb_info ) + call gather_global_ext(G_stressm_1, I_stressm_1, master_task, distrb_info ) + call gather_global_ext(G_stressm_2, I_stressm_2, master_task, distrb_info ) + call gather_global_ext(G_stressm_3, I_stressm_3, master_task, distrb_info ) + call gather_global_ext(G_stressm_4, I_stressm_4, master_task, distrb_info ) + call gather_global_ext(G_stress12_1, I_stress12_1, master_task, distrb_info ) + call gather_global_ext(G_stress12_2, I_stress12_2, master_task, distrb_info ) + call gather_global_ext(G_stress12_3, I_stress12_3, master_task, distrb_info ) + call gather_global_ext(G_stress12_4, I_stress12_4, master_task, distrb_info ) + + ! all calculations id done on master task + if (my_task == master_task) then + ! find number of active points and allocate 1D vectors + call calc_na(nx_glob, ny_glob, NA_len, G_icetmask, G_iceumask) + call alloc1d(NA_len) + call calc_2d_indices(nx_glob, ny_glob, NA_len, G_icetmask, G_iceumask) + call calc_navel(nx_glob, ny_glob, NA_len, NAVEL_len) + call alloc1d_navel(NAVEL_len) + ! initialize OpenMP. FIXME: ought to be called from main + call domp_init() + !$OMP PARALLEL DEFAULT(shared) + call numainit(1, NA_len, NAVEL_len) + !$OMP END PARALLEL + ! map 2D arrays to 1D arrays + call convert_2d_1d(nx_glob, ny_glob, NA_len, NAVEL_len, & + G_HTE, G_HTN, G_cdn_ocn, G_aiu, G_uocn, G_vocn, G_forcex, & + G_forcey, G_Tbu, G_umassdti, G_fm, G_uarear, G_tarear, & + G_strintx, G_strinty, G_uvel_init, G_vvel_init, & + G_strength, G_uvel, G_vvel, G_dxt, G_dyt, G_stressp_1, & + G_stressp_2, G_stressp_3, G_stressp_4, G_stressm_1, & + G_stressm_2, G_stressm_3, G_stressm_4, G_stress12_1, & + G_stress12_2, G_stress12_3, G_stress12_4) + call calc_halo_parent(nx_glob, ny_glob, NA_len, NAVEL_len, G_icetmask) + end if + + end subroutine ice_dyn_evp_1d_copyin + +!======================================================================= + + subroutine ice_dyn_evp_1d_copyout(nx, ny, nblk, nx_glob, ny_glob, & + I_uvel, I_vvel, I_strintx, I_strinty, I_stressp_1, I_stressp_2, & + I_stressp_3, I_stressp_4, I_stressm_1, I_stressm_2, I_stressm_3, & + I_stressm_4, I_stress12_1, I_stress12_2, I_stress12_3, & + I_stress12_4, I_divu, I_rdg_conv, I_rdg_shear, I_shear, I_taubx, & + I_tauby) + + use ice_constants, only : c0 + use ice_gather_scatter, only : scatter_global_ext + use ice_domain, only : distrb_info + use ice_communicate, only : my_task, master_task + + implicit none + + integer(int_kind), intent(in) :: nx, ny, nblk, nx_glob, ny_glob + real(dbl_kind), dimension(nx, ny, nblk), intent(out) :: I_uvel, & + I_vvel, I_strintx, I_strinty, I_stressp_1, I_stressp_2, & + I_stressp_3, I_stressp_4, I_stressm_1, I_stressm_2, & + I_stressm_3, I_stressm_4, I_stress12_1, I_stress12_2, & + I_stress12_3, I_stress12_4, I_divu, I_rdg_conv, I_rdg_shear, & + I_shear, I_taubx, I_tauby + + ! local variables + + integer(int_kind) :: iw, lo, up, j, i + real(dbl_kind), dimension(nx_glob, ny_glob) :: G_uvel, G_vvel, & + G_strintx, G_strinty, G_stressp_1, G_stressp_2, G_stressp_3, & + G_stressp_4, G_stressm_1, G_stressm_2, G_stressm_3, & + G_stressm_4, G_stress12_1, G_stress12_2, G_stress12_3, & + G_stress12_4, G_divu, G_rdg_conv, G_rdg_shear, G_shear, & + G_taubx, G_tauby + + character(len=*), parameter :: & + subname = '(ice_dyn_evp_1d_copyout)' + + ! remap 1D arrays into 2D arrays + if (my_task == master_task) then + + G_uvel = c0 + G_vvel = c0 + G_strintx = c0 + G_strinty = c0 + G_stressp_1 = c0 + G_stressp_2 = c0 + G_stressp_3 = c0 + G_stressp_4 = c0 + G_stressm_1 = c0 + G_stressm_2 = c0 + G_stressm_3 = c0 + G_stressm_4 = c0 + G_stress12_1 = c0 + G_stress12_2 = c0 + G_stress12_3 = c0 + G_stress12_4 = c0 + G_divu = c0 + G_rdg_conv = c0 + G_rdg_shear = c0 + G_shear = c0 + G_taubx = c0 + G_tauby = c0 + + !$OMP PARALLEL PRIVATE(iw, lo, up, j, i) + call domp_get_domain(1, NA_len, lo, up) + do iw = lo, up + ! get 2D indices + i = indi(iw) + j = indj(iw) + ! remap + G_strintx(i, j) = strintx(iw) + G_strinty(i, j) = strinty(iw) + G_stressp_1(i, j) = stressp_1(iw) + G_stressp_2(i, j) = stressp_2(iw) + G_stressp_3(i, j) = stressp_3(iw) + G_stressp_4(i, j) = stressp_4(iw) + G_stressm_1(i, j) = stressm_1(iw) + G_stressm_2(i, j) = stressm_2(iw) + G_stressm_3(i, j) = stressm_3(iw) + G_stressm_4(i, j) = stressm_4(iw) + G_stress12_1(i, j) = stress12_1(iw) + G_stress12_2(i, j) = stress12_2(iw) + G_stress12_3(i, j) = stress12_3(iw) + G_stress12_4(i, j) = stress12_4(iw) + G_divu(i, j) = divu(iw) + G_rdg_conv(i, j) = rdg_conv(iw) + G_rdg_shear(i, j) = rdg_shear(iw) + G_shear(i, j) = shear(iw) + G_taubx(i, j) = taubx(iw) + G_tauby(i, j) = tauby(iw) + G_uvel(i, j) = uvel(iw) + G_vvel(i, j) = vvel(iw) + end do + call domp_get_domain(NA_len + 1, NAVEL_len, lo, up) + do iw = lo, up + ! get 2D indices + j = int((indij(iw) - 1) / (nx_glob)) + 1 + i = indij(iw) - (j - 1) * nx_glob + ! remap + G_uvel(i, j) = uvel(iw) + G_vvel(i, j) = vvel(iw) + end do + !$OMP END PARALLEL + + call dealloc1d() + + end if + + ! scatter data on all tasks + call scatter_global_ext(I_uvel, G_uvel, master_task, distrb_info) + call scatter_global_ext(I_vvel, G_vvel, master_task, distrb_info) + call scatter_global_ext(I_strintx, G_strintx, master_task, distrb_info) + call scatter_global_ext(I_strinty, G_strinty, master_task, distrb_info) + call scatter_global_ext(I_stressp_1, G_stressp_1, master_task, distrb_info) + call scatter_global_ext(I_stressp_2, G_stressp_2, master_task, distrb_info) + call scatter_global_ext(I_stressp_3, G_stressp_3, master_task, distrb_info) + call scatter_global_ext(I_stressp_4, G_stressp_4, master_task, distrb_info) + call scatter_global_ext(I_stressm_1, G_stressm_1, master_task, distrb_info) + call scatter_global_ext(I_stressm_2, G_stressm_2, master_task, distrb_info) + call scatter_global_ext(I_stressm_3, G_stressm_3, master_task, distrb_info) + call scatter_global_ext(I_stressm_4, G_stressm_4, master_task, distrb_info) + call scatter_global_ext(I_stress12_1, G_stress12_1, master_task, distrb_info) + call scatter_global_ext(I_stress12_2, G_stress12_2, master_task, distrb_info) + call scatter_global_ext(I_stress12_3, G_stress12_3, master_task, distrb_info) + call scatter_global_ext(I_stress12_4, G_stress12_4, master_task, distrb_info) + call scatter_global_ext(I_divu, G_divu, master_task, distrb_info) + call scatter_global_ext(I_rdg_conv, G_rdg_conv, master_task, distrb_info) + call scatter_global_ext(I_rdg_shear, G_rdg_shear, master_task, distrb_info) + call scatter_global_ext(I_shear, G_shear, master_task, distrb_info) + call scatter_global_ext(I_taubx, G_taubx, master_task, distrb_info) + call scatter_global_ext(I_tauby, G_tauby, master_task, distrb_info) + + end subroutine ice_dyn_evp_1d_copyout + +!======================================================================= + + subroutine ice_dyn_evp_1d_kernel + + use ice_constants, only : c0 + use ice_dyn_shared, only : ndte + use ice_communicate, only : my_task, master_task + + implicit none + + ! local variables + + real(kind=dbl_kind) :: rhow + integer(kind=int_kind) :: ksub + + character(len=*), parameter :: & + subname = '(ice_dyn_evp_1d_kernel)' + + ! all calculations is done on master task + if (my_task == master_task) then + + ! read constants + call icepack_query_parameters(rhow_out = rhow) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) then + call abort_ice(error_message=subname, file=__FILE__, & + line=__LINE__) + end if + + if (ndte < 2) call abort_ice(subname & + // ' ERROR: ndte must be 2 or higher for this kernel') + + !$OMP PARALLEL PRIVATE(ksub) + do ksub = 1, ndte - 1 + call evp1d_stress(NA_len, ee, ne, se, 1, NA_len, uvel, & + vvel, dxt, dyt, hte, htn, htem1, htnm1, strength, & + stressp_1, stressp_2, stressp_3, stressp_4, stressm_1, & + stressm_2, stressm_3, stressm_4, stress12_1, & + stress12_2, stress12_3, stress12_4, str1, str2, str3, & + str4, str5, str6, str7, str8, skiptcell) + !$OMP BARRIER + call evp1d_stepu(NA_len, rhow, 1, NA_len, cdn_ocn, aiu, & + uocn, vocn, forcex, forcey, umassdti, fm, uarear, Tbu, & + uvel_init, vvel_init, uvel, vvel, str1, str2, str3, & + str4, str5, str6, str7, str8, nw, sw, sse, skipucell) + !$OMP BARRIER + call evp1d_halo_update(NAVEL_len, 1, NA_len, uvel, vvel, & + halo_parent) + !$OMP BARRIER + end do + + call evp1d_stress(NA_len, ee, ne, se, 1, NA_len, uvel, vvel, & + dxt, dyt, hte, htn, htem1, htnm1, strength, stressp_1, & + stressp_2, stressp_3, stressp_4, stressm_1, stressm_2, & + stressm_3, stressm_4, stress12_1, stress12_2, stress12_3, & + stress12_4, str1, str2, str3, str4, str5, str6, str7, & + str8, skiptcell, tarear, divu, rdg_conv, rdg_shear, shear) + !$OMP BARRIER + call evp1d_stepu(NA_len, rhow, 1, NA_len, cdn_ocn, aiu, uocn, & + vocn, forcex, forcey, umassdti, fm, uarear, Tbu, & + uvel_init, vvel_init, uvel, vvel, str1, str2, str3, str4, & + str5, str6, str7, str8, nw, sw, sse, skipucell, strintx, & + strinty, taubx, tauby) + !$OMP BARRIER + call evp1d_halo_update(NAVEL_len, 1, NA_len, uvel, vvel, & + halo_parent) + !$OMP END PARALLEL + + end if ! master task + + end subroutine ice_dyn_evp_1d_kernel + +!======================================================================= + + subroutine calc_na(nx, ny, na, icetmask, iceumask) + ! Calculate number of active points + + use ice_blocks, only : nghost + + implicit none + + integer(kind=int_kind), intent(in) :: nx, ny + integer(kind=int_kind), dimension(nx, ny), intent(in) :: & + icetmask + logical(kind=log_kind), dimension(nx, ny), intent(in) :: & + iceumask + integer(kind=int_kind), intent(out) :: na + + ! local variables + + integer(kind=int_kind) :: i, j + + character(len=*), parameter :: subname = '(calc_na)' + + na = 0 + ! NOTE: T mask includes northern and eastern ghost cells + do j = 1 + nghost, ny + do i = 1 + nghost, nx + if (icetmask(i,j) == 1 .or. iceumask(i,j)) na = na + 1 + end do + end do + + end subroutine calc_na + +!======================================================================= + + subroutine calc_2d_indices(nx, ny, na, icetmask, iceumask) + + use ice_blocks, only : nghost + + implicit none + + integer(kind=int_kind), intent(in) :: nx, ny, na + integer(kind=int_kind), dimension(nx, ny), intent(in) :: & + icetmask + logical(kind=log_kind), dimension(nx, ny), intent(in) :: & + iceumask + + ! local variables + + integer(kind=int_kind) :: i, j, Nmaskt + + character(len=*), parameter :: subname = '(calc_2d_indices)' + + skipucell(:) = .false. + skiptcell(:) = .false. + indi = 0 + indj = 0 + Nmaskt = 0 + ! NOTE: T mask includes northern and eastern ghost cells + do j = 1 + nghost, ny + do i = 1 + nghost, nx + if (icetmask(i,j) == 1 .or. iceumask(i,j)) then + Nmaskt = Nmaskt + 1 + indi(Nmaskt) = i + indj(Nmaskt) = j + if (icetmask(i,j) /= 1) skiptcell(Nmaskt) = .true. + if (.not. iceumask(i,j)) skipucell(Nmaskt) = .true. + ! NOTE: U mask does not include northern and eastern + ! ghost cells. Skip northern and eastern ghost cells + if (i == nx) skipucell(Nmaskt) = .true. + if (j == ny) skipucell(Nmaskt) = .true. + end if + end do + end do + + end subroutine calc_2d_indices + +!======================================================================= + + subroutine calc_navel(nx_block, ny_block, na, navel) + ! Calculate number of active points, including halo points + + implicit none + + integer(kind=int_kind), intent(in) :: nx_block, ny_block, na + integer(kind=int_kind), intent(out) :: navel + + ! local variables + + integer(kind=int_kind) :: iw, i, j + integer(kind=int_kind), dimension(1:na) :: Iin, Iee, Ine, Ise, & + Inw, Isw, Isse + integer(kind=int_kind), dimension(1:7 * na) :: util1, util2 + + character(len=*), parameter :: subname = '(calc_navel)' + + ! calculate additional 1D indices used for finite differences + do iw = 1, na + ! get 2D indices + i = indi(iw) + j = indj(iw) + ! calculate 1D indices + Iin(iw) = i + (j - 1) * nx_block ! ( 0, 0) target point + Iee(iw) = i - 1 + (j - 1) * nx_block ! (-1, 0) + Ine(iw) = i - 1 + (j - 2) * nx_block ! (-1, -1) + Ise(iw) = i + (j - 2) * nx_block ! ( 0, -1) + Inw(iw) = i + 1 + (j - 1) * nx_block ! (+1, 0) + Isw(iw) = i + 1 + (j - 0) * nx_block ! (+1, +1) + Isse(iw) = i + (j - 0) * nx_block ! ( 0, +1) + end do + + ! find number of points needed for finite difference calculations + call union(Iin, Iee, na, na, util1, i ) + call union(util1, Ine, i, na, util2, j ) + call union(util2, Ise, j, na, util1, i ) + call union(util1, Inw, i, na, util2, j ) + call union(util2, Isw, j, na, util1, i ) + call union(util1, Isse, i, na, util2, navel) + + end subroutine calc_navel + +!======================================================================= + + subroutine convert_2d_1d(nx, ny, na, navel, I_HTE, I_HTN, & + I_cdn_ocn, I_aiu, I_uocn, I_vocn, I_forcex, I_forcey, I_Tbu, & + I_umassdti, I_fm, I_uarear, I_tarear, I_strintx, I_strinty, & + I_uvel_init, I_vvel_init, I_strength, I_uvel, I_vvel, I_dxt, & + I_dyt, I_stressp_1, I_stressp_2, I_stressp_3, I_stressp_4, & + I_stressm_1, I_stressm_2, I_stressm_3, I_stressm_4, & + I_stress12_1, I_stress12_2, I_stress12_3, I_stress12_4) + + implicit none + + integer(kind=int_kind), intent(in) :: nx, ny, na, navel + real (kind=dbl_kind), dimension(nx, ny), intent(in) :: I_HTE, & + I_HTN, I_cdn_ocn, I_aiu, I_uocn, I_vocn, I_forcex, I_forcey, & + I_Tbu, I_umassdti, I_fm, I_uarear, I_tarear, I_strintx, & + I_strinty, I_uvel_init, I_vvel_init, I_strength, I_uvel, & + I_vvel, I_dxt, I_dyt, I_stressp_1, I_stressp_2, I_stressp_3, & + I_stressp_4, I_stressm_1, I_stressm_2, I_stressm_3, & + I_stressm_4, I_stress12_1, I_stress12_2, I_stress12_3, & + I_stress12_4 + + ! local variables + + integer(kind=int_kind) :: iw, lo, up, j, i, nachk + integer(kind=int_kind), dimension(1:na) :: Iin, Iee, Ine, Ise, & + Inw, Isw, Isse + integer(kind=int_kind), dimension(1:7 * na) :: util1, util2 + + character(len=*), parameter :: subname = '(convert_2d_1d)' + + ! calculate additional 1D indices used for finite differences + do iw = 1, na + ! get 2D indices + i = indi(iw) + j = indj(iw) + ! calculate 1D indices + Iin(iw) = i + (j - 1) * nx ! ( 0, 0) target point + Iee(iw) = i - 1 + (j - 1) * nx ! (-1, 0) + Ine(iw) = i - 1 + (j - 2) * nx ! (-1,-1) + Ise(iw) = i + (j - 2) * nx ! ( 0,-1) + Inw(iw) = i + 1 + (j - 1) * nx ! (+1, 0) + Isw(iw) = i + 1 + (j - 0) * nx ! (+1,+1) + Isse(iw) = i + (j - 0) * nx ! ( 0,+1) + end do + + ! find number of points needed for finite difference calculations + call union(Iin, Iee, na, na, util1, i ) + call union(util1, Ine, i, na, util2, j ) + call union(util2, Ise, j, na, util1, i ) + call union(util1, Inw, i, na, util2, j ) + call union(util2, Isw, j, na, util1, i ) + call union(util1, Isse, i, na, util2, nachk) + + ! index vector with sorted target points + do iw = 1, na + indij(iw) = Iin(iw) + end do + + ! sorted additional points + call setdiff(util2, Iin, navel, na, util1, j) + do iw = na + 1, navel + indij(iw) = util1(iw - na) + end do + + ! indices for additional points needed for uvel and vvel + call findXinY(Iee, indij, na, navel, ee) + call findXinY(Ine, indij, na, navel, ne) + call findXinY(Ise, indij, na, navel, se) + call findXinY(Inw, indij, na, navel, nw) + call findXinY(Isw, indij, na, navel, sw) + call findXinY(Isse, indij, na, navel, sse) + + !$OMP PARALLEL PRIVATE(iw, lo, up, j, i) + ! write 1D arrays from 2D arrays (target points) + call domp_get_domain(1, na, lo, up) + do iw = lo, up + ! get 2D indices + i = indi(iw) + j = indj(iw) + ! map + uvel(iw) = I_uvel(i, j) + vvel(iw) = I_vvel(i, j) + cdn_ocn(iw) = I_cdn_ocn(i, j) + aiu(iw) = I_aiu(i, j) + uocn(iw) = I_uocn(i, j) + vocn(iw) = I_vocn(i, j) + forcex(iw) = I_forcex(i, j) + forcey(iw) = I_forcey(i, j) + Tbu(iw) = I_Tbu(i, j) + umassdti(iw) = I_umassdti(i, j) + fm(iw) = I_fm(i, j) + tarear(iw) = I_tarear(i, j) + uarear(iw) = I_uarear(i, j) + strintx(iw) = I_strintx(i, j) + strinty(iw) = I_strinty(i, j) + uvel_init(iw) = I_uvel_init(i, j) + vvel_init(iw) = I_vvel_init(i, j) + strength(iw) = I_strength(i, j) + dxt(iw) = I_dxt(i, j) + dyt(iw) = I_dyt(i, j) + stressp_1(iw) = I_stressp_1(i, j) + stressp_2(iw) = I_stressp_2(i, j) + stressp_3(iw) = I_stressp_3(i, j) + stressp_4(iw) = I_stressp_4(i, j) + stressm_1(iw) = I_stressm_1(i, j) + stressm_2(iw) = I_stressm_2(i, j) + stressm_3(iw) = I_stressm_3(i, j) + stressm_4(iw) = I_stressm_4(i, j) + stress12_1(iw) = I_stress12_1(i, j) + stress12_2(iw) = I_stress12_2(i, j) + stress12_3(iw) = I_stress12_3(i, j) + stress12_4(iw) = I_stress12_4(i, j) + HTE(iw) = I_HTE(i, j) + HTN(iw) = I_HTN(i, j) + HTEm1(iw) = I_HTE(i - 1, j) + HTNm1(iw) = I_HTN(i, j - 1) + end do + ! write 1D arrays from 2D arrays (additional points) + call domp_get_domain(na + 1, navel, lo, up) + do iw = lo, up + ! get 2D indices + j = int((indij(iw) - 1) / (nx)) + 1 + i = indij(iw) - (j - 1) * nx + ! map + uvel(iw) = I_uvel(i, j) + vvel(iw) = I_vvel(i, j) + end do !$OMP END PARALLEL - endif - - end subroutine evp_kernel_v2 - -!---------------------------------------------------------------------------- - - subroutine calc_na(nx,ny,na,icetmask) - ! Calculate number of active points (na) - use ice_blocks, only: nghost - - implicit none - - integer(int_kind),intent(in) :: nx,ny - integer(int_kind),intent(out) :: na - integer (kind=int_kind),dimension (nx,ny), intent(in) :: icetmask - integer(int_kind) :: i,j - - character(len=*), parameter :: subname = '(calc_na)' - !--------------------------------------- - - na = 0 -! Note: The icellt mask includes north and east ghost cells. (ice_dyn_shared.F90) - do j = 1+nghost, ny ! -nghost - do i = 1+nghost, nx ! -nghost - if (icetmask(i,j)==1) then - na=na+1 - endif - enddo - enddo - - end subroutine calc_na - -!---------------------------------------------------------------------------- - - subroutine calc_2d_indices(nx,ny,na,icetmask,iceumask) - - use ice_blocks, only: nghost - - implicit none - - integer(int_kind),intent(in) :: nx,ny,na - integer (kind=int_kind),dimension (nx,ny), intent(in) :: icetmask - logical (kind=log_kind),dimension (nx,ny), intent(in) :: iceumask - integer(int_kind) :: i,j,Nmaskt - - character(len=*), parameter :: subname = '(calc_2d_indices)' - !--------------------------------------- - - skipucell(:)=.false. - indi=0 - indj=0 - Nmaskt=0 -! Note: The icellt mask includes north and east ghost cells. (ice_dyn_shared.F90) - do j = 1+nghost, ny ! -nghost - do i = 1+nghost, nx ! -nghost - if (icetmask(i,j)==1) then - Nmaskt=Nmaskt+1 - indi(Nmaskt) = i - indj(Nmaskt) = j - ! Umask do NOT include north/east ghost cells ... skip these as well - if (iceumask(i,j) .eqv. .false. ) skipucell(Nmaskt) = .true. - if (i==nx) skipucell(Nmaskt) = .true. - if (j==ny) skipucell(Nmaskt) = .true. - endif - enddo - enddo - if (Nmaskt.ne.na) then - write(nu_diag,*) subname,' Nmaskt,na: ',Nmaskt,na - call abort_ice(subname//': ERROR Problem Nmaskt != na') - endif - if (Nmaskt==0) then - write(nu_diag,*) subname,' WARNING: NO ICE' - endif - - end subroutine calc_2d_indices - -!---------------------------------------------------------------------------- - - subroutine calc_navel(nx_block,ny_block,na,navel) - ! Calculate number of active points including needed halo points (navel) - - implicit none - - integer(int_kind),intent(in) :: nx_block,ny_block,na - integer(int_kind),intent(out) :: navel - - integer(int_kind) :: iw,i,j - integer(int_kind),dimension(1:na) :: Iin,Iee,Ine,Ise,Inw,Isw,Isse - integer(int_kind),dimension(1:7*na) :: util1,util2 - - character(len=*), parameter :: subname = '(calc_navel)' - - !--------------------------------------- - ! Additional indices used for finite differences (FD) - do iw=1,na - i=indi(iw) - j=indj(iw) - Iin(iw) = i + (j-1)*nx_block ! ( 0, 0) Target point - Iee(iw) = i-1 + (j-1)*nx_block ! (-1, 0) - Ine(iw) = i-1 + (j-2)*nx_block ! (-1,-1) - Ise(iw) = i + (j-2)*nx_block ! ( 0,-1) - Inw(iw) = i+1 + (j-1)*nx_block ! (+1, 0) - Isw(iw) = i+1 + (j-0)*nx_block ! (+1,+1) - Isse(iw)= i + (j-0)*nx_block ! ( 0,+1) - enddo - - !-- Find number of points needed for finite difference calculations - call union(Iin, Iee,na,na,util1,i) - call union(util1,Ine, i,na,util2,j) - call union(util2,Ise, j,na,util1,i) - call union(util1,Inw, i,na,util2,j) - call union(util2,Isw, j,na,util1,i) - call union(util1,Isse,i,na,util2,navel) - - !-- Check bounds - do iw=1,navel - if (util2(iw)>nx_block*ny_block .or. util2(iw)<1) then - write(nu_diag,*) subname,' nx_block,ny_block,nx_block*ny_block: ',nx_block,ny_block,nx_block*ny_block - write(nu_diag,*) subname,' na,navel,iw,util2(iw): ',na,navel,iw,util2(iw) - call abort_ice(subname//': Problem with boundary. Check halo zone values') - endif - enddo - - end subroutine calc_navel - -!---------------------------------------------------------------------------- - - subroutine convert_2d_1d_v2(nx,ny, na,navel, & - I_HTE,I_HTN, & -!v1 I_dxhy,I_dyhx,I_cyp,I_cxp,I_cym,I_cxm,I_tinyarea, & -!v1 I_waterx,I_watery, & - I_cdn_ocn,I_aiu,I_uocn,I_vocn,I_forcex,I_forcey,I_Tbu, & - I_umassdti,I_fm,I_uarear,I_tarear,I_strintx,I_strinty, & - I_uvel_init,I_vvel_init, & - I_strength,I_uvel,I_vvel,I_dxt,I_dyt, & - I_stressp_1 ,I_stressp_2, I_stressp_3, I_stressp_4, & - I_stressm_1 ,I_stressm_2, I_stressm_3, I_stressm_4, & - I_stress12_1,I_stress12_2,I_stress12_3,I_stress12_4 ) - - implicit none - - integer(int_kind),intent(in) :: nx,ny,na,navel - real (kind=dbl_kind), dimension(nx,ny), intent(in) :: & - I_HTE,I_HTN, & -!v1 I_dxhy,I_dyhx,I_cyp,I_cxp,I_cym,I_cxm,I_tinyarea, & -!v1 I_waterx,I_watery, & - I_cdn_ocn,I_aiu,I_uocn,I_vocn,I_forcex,I_forcey,I_Tbu, & - I_umassdti,I_fm,I_uarear,I_tarear,I_strintx,I_strinty, & - I_uvel_init,I_vvel_init, & - I_strength,I_uvel,I_vvel,I_dxt,I_dyt, & - I_stressp_1 ,I_stressp_2, I_stressp_3, I_stressp_4, & - I_stressm_1 ,I_stressm_2, I_stressm_3, I_stressm_4, & - I_stress12_1,I_stress12_2,I_stress12_3,I_stress12_4 - - integer(int_kind) :: iw,i,j, nx_block - integer(int_kind),dimension(1:na) :: Iin,Iee,Ine,Ise,Inw,Isw,Isse - integer(int_kind),dimension(1:7*na) :: util1,util2 - integer(int_kind) :: nachk - - character(len=*), parameter :: subname = '(convert_2d_1d_v2)' - - !--------------------------------------- - ! Additional indices used for finite differences (FD) - nx_block=nx ! Total block size in x-dir - do iw=1,na - i=indi(iw) - j=indj(iw) - Iin(iw) = i + (j-1)*nx_block ! ( 0, 0) Target point - Iee(iw) = i-1 + (j-1)*nx_block ! (-1, 0) - Ine(iw) = i-1 + (j-2)*nx_block ! (-1,-1) - Ise(iw) = i + (j-2)*nx_block ! ( 0,-1) - Inw(iw) = i+1 + (j-1)*nx_block ! (+1, 0) - Isw(iw) = i+1 + (j-0)*nx_block ! (+1,+1) - Isse(iw)= i + (j-0)*nx_block ! ( 0,+1) - enddo - - !-- Find number of points needed for finite difference calculations - call union(Iin, Iee,na,na,util1,i) - call union(util1,Ine, i,na,util2,j) - call union(util2,Ise, j,na,util1,i) - call union(util1,Inw, i,na,util2,j) - call union(util2,Isw, j,na,util1,i) - call union(util1,Isse,i,na,util2,nachk) - - if (nachk .ne. navel) then - write(nu_diag,*) subname,' ERROR: navel badly chosen: na,navel,nachk = ',na,navel,nachk - call abort_ice(subname//': ERROR: navel badly chosen') - endif - - ! indij: vector with target points (sorted) ... - do iw=1,na - indij(iw)=Iin(iw) - enddo - - ! indij: ... followed by extra points (sorted) - call setdiff(util2,Iin,navel,na,util1,j) - do iw=na+1,navel - indij(iw)=util1(iw-na) - enddo - - !-- Create indices for additional points needed for uvel,vvel: - call findXinY(Iee ,indij,na,navel, ee) - call findXinY(Ine ,indij,na,navel, ne) - call findXinY(Ise ,indij,na,navel, se) - call findXinY(Inw ,indij,na,navel, nw) - call findXinY(Isw ,indij,na,navel, sw) - call findXinY(Isse,indij,na,navel,sse) - - !-- write check -!if (1 == 2) then -! write(nu_diag,*) subname,' MHRI: INDICES start:' -! write(nu_diag,*) 'Min/max ee', minval(ee), maxval(ee) -! write(nu_diag,*) 'Min/max ne', minval(ne), maxval(ne) -! write(nu_diag,*) 'Min/max se', minval(se), maxval(se) -! write(nu_diag,*) 'Min/max nw', minval(nw), maxval(nw) -! write(nu_diag,*) 'Min/max sw', minval(sw), maxval(sw) -! write(nu_diag,*) 'Min/max sse',minval(sse),maxval(sse) -! write(nu_diag,*) subname,' MHRI: INDICES end:' -!endif - - ! Write 1D data from 2D: Here only extra FD part, the rest follows... - !$OMP PARALLEL DO PRIVATE(iw,i,j) - do iw=na+1,navel - j=int((indij(iw)-1)/(nx_block))+1 - i=indij(iw)-(j-1)*nx_block - uvel(iw)= I_uvel(i,j) - vvel(iw)= I_vvel(i,j) - enddo - !$OMP END PARALLEL DO - - ! Write 1D data from 2D - !$OMP PARALLEL DO PRIVATE(iw,i,j) - do iw=1,na - i=indi(iw) - j=indj(iw) - uvel(iw)= I_uvel(i,j) - vvel(iw)= I_vvel(i,j) - cdn_ocn(iw)= I_cdn_ocn(i,j) - aiu(iw)= I_aiu(i,j) - uocn(iw)= I_uocn(i,j) - vocn(iw)= I_vocn(i,j) - forcex(iw)= I_forcex(i,j) - forcey(iw)= I_forcey(i,j) - Tbu(iw)= I_Tbu(i,j) - umassdti(iw)= I_umassdti(i,j) - fm(iw)= I_fm(i,j) - tarear(iw)= I_tarear(i,j) - uarear(iw)= I_uarear(i,j) - strintx(iw)= I_strintx(i,j) - strinty(iw)= I_strinty(i,j) - uvel_init(iw)= I_uvel_init(i,j) - vvel_init(iw)= I_vvel_init(i,j) - strength(iw)= I_strength(i,j) - dxt(iw)= I_dxt(i,j) - dyt(iw)= I_dyt(i,j) - stressp_1(iw)= I_stressp_1(i,j) - stressp_2(iw)= I_stressp_2(i,j) - stressp_3(iw)= I_stressp_3(i,j) - stressp_4(iw)= I_stressp_4(i,j) - stressm_1(iw)= I_stressm_1(i,j) - stressm_2(iw)= I_stressm_2(i,j) - stressm_3(iw)= I_stressm_3(i,j) - stressm_4(iw)= I_stressm_4(i,j) - stress12_1(iw)=I_stress12_1(i,j) - stress12_2(iw)=I_stress12_2(i,j) - stress12_3(iw)=I_stress12_3(i,j) - stress12_4(iw)=I_stress12_4(i,j) -!v1 dxhy(iw)= I_dxhy(i,j) -!v1 dyhx(iw)= I_dyhx(i,j) -!v1 cyp(iw)= I_cyp(i,j) -!v1 cxp(iw)= I_cxp(i,j) -!v1 cym(iw)= I_cym(i,j) -!v1 cxm(iw)= I_cxm(i,j) -!v1 tinyarea(iw)= I_tinyarea(i,j) -!v1 waterx(iw)= I_waterx(i,j) -!v1 watery(iw)= I_watery(i,j) - HTE(iw) = I_HTE(i,j) - HTN(iw) = I_HTN(i,j) - HTEm1(iw) = I_HTE(i-1,j) - HTNm1(iw) = I_HTN(i,j-1) - enddo - !$OMP END PARALLEL DO - - end subroutine convert_2d_1d_v2 - -!---------------------------------------------------------------------------- - - subroutine calc_halo_parent(nx,ny,na,navel, I_icetmask) - - implicit none - - integer(kind=int_kind),intent(in) :: nx,ny,na,navel - integer(kind=int_kind), dimension(nx,ny), intent(in) :: I_icetmask - - integer(kind=int_kind) :: iw,i,j !,masku,maskt - integer(kind=int_kind),dimension(1:navel) :: Ihalo - - character(len=*), parameter :: subname = '(calc_halo_parent)' - - !--------------------------------------- - ! Indices for halo update: - ! 0: no halo point - ! >0: index for halo point parent. Finally related to indij vector - ! TODO: ONLY for nghost==1 - ! TODO: ONLY for circular grids - NOT tripole grids - - Ihalo(:)=0 - halo_parent(:)=0 - - !$OMP PARALLEL DO PRIVATE(iw,i,j) - do iw=1,navel - j=int((indij(iw)-1)/(nx))+1 - i=indij(iw)-(j-1)*nx - ! If within ghost-zone: - if (i==nx .and. I_icetmask( 2,j)==1) Ihalo(iw)= 2+ (j-1)*nx - if (i==1 .and. I_icetmask(nx-1,j)==1) Ihalo(iw)=(nx-1)+ (j-1)*nx - if (j==ny .and. I_icetmask(i, 2)==1) Ihalo(iw)= i+ nx - if (j==1 .and. I_icetmask(i,ny-1)==1) Ihalo(iw)= i+(ny-2)*nx - enddo - !$OMP END PARALLEL DO - - ! Relate halo indices to indij vector - call findXinY_halo(Ihalo,indij,navel,navel,halo_parent) - - !-- write check -!if (1 == 1) then -! integer(kind=int_kind) :: iiw,ii,jj !,masku,maskt MHRI -! write(nu_diag,*) subname,' MHRI: halo boundary start:' -! do iw=1,navel -! if (halo_parent(iw)>0) then -! iiw=halo_parent(iw) -! j=int((indij(iiw)-1)/(nx))+1 -! i=indij(iiw)-(j-1)*nx -! ii=i -! jj=j -! j=int((indij(iw)-1)/(nx))+1 -! i=indij(iw)-(j-1)*nx -! write(nu_diag,*)iw,i,j,iiw,ii,jj -! endif -! enddo -! write(nu_diag,*) subname,' MHRI: halo boundary end:' -!endif - - end subroutine calc_halo_parent - -!---------------------------------------------------------------------------- - - subroutine union(x,y,nx,ny,xy,nxy) - ! Find union (xy) of two sorted integer vectors (x and y) - ! ie. Combined values of the two vectors with no repetitions. - !use ice_kinds_mod - - implicit none - - integer (int_kind) :: i,j,k - integer (int_kind),intent(in) :: nx,ny - integer (int_kind),intent(in) :: x(1:nx),y(1:ny) - integer (int_kind),intent(out) :: xy(1:nx+ny) - integer (int_kind),intent(out) :: nxy - - character(len=*), parameter :: subname = '(union)' - - !--------------------------------------- - - i=1 - j=1 - k=1 - do while (i<=nx .and. j<=ny) - if (x(i)y(j)) then - xy(k)=y(j) - j=j+1 - else !if (x(i)==y(j)) then - xy(k)=x(i) - i=i+1 - j=j+1 - endif - k=k+1 - enddo - - ! The rest - do while (i<=nx) - xy(k)=x(i) - i=i+1 - k=k+1 - enddo - do while (j<=ny) - xy(k)=y(j) - j=j+1 - k=k+1 - enddo - nxy=k-1 - - end subroutine union - -!---------------------------------------------------------------------------- - - subroutine setdiff(x,y,nx,ny,xy,nxy) - ! Find element (xy) of two sorted integer vectors (x and y) - ! that are in x, but not in y ... or in y, but not in x - !use ice_kinds_mod - - implicit none - - integer (int_kind) :: i,j,k - integer (int_kind),intent(in) :: nx,ny - integer (int_kind),intent(in) :: x(1:nx),y(1:ny) - integer (int_kind),intent(out) :: xy(1:nx+ny) - integer (int_kind),intent(out) :: nxy - - character(len=*), parameter :: subname = '(setdiff)' - !--------------------------------------- - - i=1 - j=1 - k=1 - do while (i<=nx .and. j<=ny) - if (x(i)y(j)) then - xy(k)=y(j) - j=j+1 - k=k+1 - else !if (x(i)==y(j)) then - i=i+1 - j=j+1 - endif - enddo - - ! The rest - do while (i<=nx) - xy(k)=x(i) - i=i+1 - k=k+1 - enddo - do while (j<=ny) - xy(k)=y(j) - j=j+1 - k=k+1 - enddo - nxy=k-1 - - end subroutine setdiff - -!---------------------------------------------------------------------------- - - subroutine findXinY(x,y,nx,ny,indx) - ! Find indx vector so that x(1:na)=y(indx(1:na)) - ! - ! Conditions: - ! * EVERY item in x is found in y. - ! * x(1:nx) is a sorted integer vector. - ! * y(1:ny) consists of two sorted integer vectors: - ! [y(1:nx) ; y(nx+1:ny)] - ! * ny>=nx - ! Return: indx(1:na) - ! - !use ice_kinds_mod - - implicit none - - integer (int_kind),intent(in) :: nx,ny - integer (int_kind),intent(in) :: x(1:nx),y(1:ny) - integer (int_kind),intent(out) :: indx(1:nx) - integer (int_kind) :: i,j1,j2 - - character(len=*), parameter :: subname = '(findXinY)' - !--------------------------------------- - - i=1 - j1=1 - j2=nx+1 - do while (i<=nx) - if (x(i)==y(j1)) then - indx(i)=j1 - i=i+1 - j1=j1+1 - else if (x(i)==y(j2)) then - indx(i)=j2 - i=i+1 - j2=j2+1 - else if (x(i)>y(j1) ) then !.and. j1y(j2) ) then !.and. j2=nx - ! Return: indx(1:na) - ! - !use ice_kinds_mod - - implicit none - - integer (int_kind),intent(in) :: nx,ny - integer (int_kind),intent(in) :: x(1:nx),y(1:ny) - integer (int_kind),intent(out) :: indx(1:nx) - integer (int_kind) :: i,j1,nloop - - character(len=*), parameter :: subname = '(findXinY_halo)' - !--------------------------------------- - - nloop=1 - i=1 - j1=int((ny+1)/2) ! initial guess in the middle - do while (i<=nx) - if (x(i)==0) then - indx(i)=0 - i=i+1 - nloop=1 - else if (x(i)==y(j1)) then - indx(i)=j1 - i=i+1 - j1=j1+1 - if (j1>ny) j1=int((ny+1)/2) ! initial guess in the middle - nloop=1 - else if (x(i)y(j1) ) then - j1=j1+1 - if (j1>ny) then - j1=1 - nloop=nloop+1 - if (nloop>2) then - ! Stop for inf. loop. This check should not be necessary for halo - write(nu_diag,*) subname,' nx,ny: ',nx,ny - write(nu_diag,*) subname,' i,j1: ',i,j1 - write(nu_diag,*) subname,' x(i),y(j1): ',x(i),y(j1) - call abort_ice(subname//': ERROR too many loops') - endif - endif - endif - end do - - end subroutine findXinY_halo - -!---------------------------------------------------------------------------- - - subroutine numainit(l,u,uu) - - use ice_constants, only: c0 - - implicit none - - integer(kind=int_kind),intent(in) :: l,u,uu - - integer(kind=int_kind) :: lo,up - - character(len=*), parameter :: subname = '(numainit)' - !--------------------------------------- - - call domp_get_domain(l,u,lo,up) - ee(lo:up)=0 - ne(lo:up)=0 - se(lo:up)=0 - sse(lo:up)=0 - nw(lo:up)=0 - sw(lo:up)=0 - halo_parent(lo:up)=0 - strength(lo:up)=c0 - uvel(lo:up)=c0 - vvel(lo:up)=c0 - uvel_init(lo:up)=c0 - vvel_init(lo:up)=c0 - uocn(lo:up)=c0 - vocn(lo:up)=c0 - dxt(lo:up)=c0 - dyt(lo:up)=c0 - HTE(lo:up)=c0 - HTN(lo:up)=c0 - HTEm1(lo:up)=c0 - HTNm1(lo:up)=c0 -!v1 dxhy(lo:up)=c0 -!v1 dyhx(lo:up)=c0 -!v1 cyp(lo:up)=c0 -!v1 cxp(lo:up)=c0 -!v1 cym(lo:up)=c0 -!v1 cxm(lo:up)=c0 -!v1 tinyarea(lo:up)=c0 - stressp_1(lo:up)=c0 - stressp_2(lo:up)=c0 - stressp_3(lo:up)=c0 - stressp_4(lo:up)=c0 - stressm_1(lo:up)=c0 - stressm_2(lo:up)=c0 - stressm_3(lo:up)=c0 - stressm_4(lo:up)=c0 - stress12_1(lo:up)=c0 - stress12_2(lo:up)=c0 - stress12_3(lo:up)=c0 - stress12_4(lo:up)=c0 - tarear(lo:up)=c0 - Tbu(lo:up)=c0 - taubx(lo:up)=c0 - tauby(lo:up)=c0 - divu(lo:up)=c0 - rdg_conv(lo:up)=c0 - rdg_shear(lo:up)=c0 - shear(lo:up)=c0 - str1(lo:up)=c0 - str2(lo:up)=c0 - str3(lo:up)=c0 - str4(lo:up)=c0 - str5(lo:up)=c0 - str6(lo:up)=c0 - str7(lo:up)=c0 - str8(lo:up)=c0 - call domp_get_domain(u+1,uu,lo,up) - halo_parent(lo:up)=0 - uvel(lo:up)=c0 - vvel(lo:up)=c0 - str1(lo:up)=c0 - str2(lo:up)=c0 - str3(lo:up)=c0 - str4(lo:up)=c0 - str5(lo:up)=c0 - str6(lo:up)=c0 - str7(lo:up)=c0 - str8(lo:up)=c0 - - end subroutine numainit - -!---------------------------------------------------------------------------- -!=============================================================================== + end subroutine convert_2d_1d -end module ice_dyn_evp_1d +!======================================================================= + + subroutine calc_halo_parent(nx, ny, na, navel, I_icetmask) + + implicit none + integer(kind=int_kind), intent(in) :: nx, ny, na, navel + integer(kind=int_kind), dimension(nx, ny), intent(in) :: & + I_icetmask + + ! local variables + + integer(kind=int_kind) :: iw, i, j + integer(kind=int_kind), dimension(1:navel) :: Ihalo + + character(len=*), parameter :: subname = '(calc_halo_parent)' + + !----------------------------------------------------------------- + ! Indices for halo update: + ! 0: no halo point + ! >0: index for halo point parent, related to indij vector + ! + ! TODO: Implement for nghost > 1 + ! TODO: Implement for tripole grids + !----------------------------------------------------------------- + + Ihalo(:) = 0 + halo_parent(:) = 0 + + do iw = 1, navel + j = int((indij(iw) - 1) / (nx)) + 1 + i = indij(iw) - (j - 1) * nx + ! if within ghost zone + if (i == nx .and. I_icetmask(2, j) == 1) Ihalo(iw) = 2 + (j - 1) * nx + if (i == 1 .and. I_icetmask(nx - 1, j) == 1) Ihalo(iw) = (nx - 1) + (j - 1) * nx + if (j == ny .and. I_icetmask(i, 2) == 1) Ihalo(iw) = i + nx + if (j == 1 .and. I_icetmask(i, ny - 1) == 1) Ihalo(iw) = i + (ny - 2) * nx + end do + + ! relate halo indices to indij vector + call findXinY_halo(Ihalo, indij, navel, navel, halo_parent) + + end subroutine calc_halo_parent + +!======================================================================= + + subroutine union(x, y, nx, ny, xy, nxy) + ! Find union (xy) of two sorted integer vectors (x and y), i.e. + ! combined values of the two vectors with no repetitions + + implicit none + + integer(int_kind), intent(in) :: nx, ny + integer(int_kind), intent(in) :: x(1:nx), y(1:ny) + integer(int_kind), intent(out) :: xy(1:nx + ny) + integer(int_kind), intent(out) :: nxy + + ! local variables + + integer(int_kind) :: i, j, k + + character(len=*), parameter :: subname = '(union)' + + i = 1 + j = 1 + k = 1 + do while (i <= nx .and. j <= ny) + if (x(i) < y(j)) then + xy(k) = x(i) + i = i + 1 + else if (x(i) > y(j)) then + xy(k) = y(j) + j = j + 1 + else + xy(k) = x(i) + i = i + 1 + j = j + 1 + end if + k = k + 1 + end do + + ! the rest + do while (i <= nx) + xy(k) = x(i) + i = i + 1 + k = k + 1 + end do + do while (j <= ny) + xy(k) = y(j) + j = j + 1 + k = k + 1 + end do + nxy = k - 1 + + end subroutine union + +!======================================================================= + + subroutine setdiff(x, y, nx, ny, xy, nxy) + ! Find element (xy) of two sorted integer vectors (x and y) that + ! are in x, but not in y, or in y, but not in x + + implicit none + + integer(kind=int_kind), intent(in) :: nx, ny + integer(kind=int_kind), intent(in) :: x(1:nx), y(1:ny) + integer(kind=int_kind), intent(out) :: xy(1:nx + ny) + integer(kind=int_kind), intent(out) :: nxy + + ! local variables + + integer(kind=int_kind) :: i, j, k + + character(len=*), parameter :: subname = '(setdiff)' + + i = 1 + j = 1 + k = 1 + do while (i <= nx .and. j <= ny) + if (x(i) < y(j)) then + xy(k) = x(i) + i = i + 1 + k = k + 1 + else if (x(i) > y(j)) then + xy(k) = y(j) + j = j + 1 + k = k + 1 + else + i = i + 1 + j = j + 1 + end if + end do + + ! the rest + do while (i <= nx) + xy(k) = x(i) + i = i + 1 + k = k + 1 + end do + do while (j <= ny) + xy(k) = y(j) + j = j + 1 + k = k + 1 + end do + nxy = k - 1 + + end subroutine setdiff + +!======================================================================== + + subroutine findXinY(x, y, nx, ny, indx) + ! Find indx vector so that x(1:na) = y(indx(1:na)) + ! + ! Conditions: + ! * EVERY item in x is found in y + ! * x(1:nx) is a sorted integer vector + ! * y(1:ny) consists of two sorted integer vectors: + ! [y(1:nx); y(nx + 1:ny)] + ! * ny >= nx + ! + ! Return: indx(1:na) + + implicit none + + integer (kind=int_kind), intent(in) :: nx, ny + integer (kind=int_kind), intent(in) :: x(1:nx), y(1:ny) + integer (kind=int_kind), intent(out) :: indx(1:nx) + + ! local variables + + integer (kind=int_kind) :: i, j1, j2 + + character(len=*), parameter :: subname = '(findXinY)' + + i = 1 + j1 = 1 + j2 = nx + 1 + do while (i <= nx) + if (x(i) == y(j1)) then + indx(i) = j1 + i = i + 1 + j1 = j1 + 1 + else if (x(i) == y(j2)) then + indx(i) = j2 + i = i + 1 + j2 = j2 + 1 + else if (x(i) > y(j1)) then + j1 = j1 + 1 + else if (x(i) > y(j2)) then + j2 = j2 + 1 + else + call abort_ice(subname & + // ': ERROR: conditions not met') + end if + end do + + end subroutine findXinY + +!======================================================================= + + subroutine findXinY_halo(x, y, nx, ny, indx) + ! Find indx vector so that x(1:na) = y(indx(1:na)) + ! + ! Conditions: + ! * EVERY item in x is found in y, + ! except for x == 0, where indx = 0 is returned + ! * x(1:nx) is a non-sorted integer vector + ! * y(1:ny) is a sorted integer vector + ! * ny >= nx + ! + ! Return: indx(1:na) + + implicit none + + integer (kind=int_kind), intent(in) :: nx, ny + integer (kind=int_kind), intent(in) :: x(1:nx), y(1:ny) + integer (kind=int_kind), intent(out) :: indx(1:nx) + + ! local variables + + integer (kind=int_kind) :: i, j1, nloop + + character(len=*), parameter :: subname = '(findXinY_halo)' + + nloop = 1 + i = 1 + j1 = int((ny + 1) / 2) ! initial guess in the middle + do while (i <= nx) + if (x(i) == 0) then + indx(i) = 0 + i = i + 1 + nloop = 1 + else if (x(i) == y(j1)) then + indx(i) = j1 + i = i + 1 + j1 = j1 + 1 + ! initial guess in the middle + if (j1 > ny) j1 = int((ny + 1) / 2) + nloop = 1 + else if (x(i) < y(j1)) then + j1 = 1 + else if (x(i) > y(j1)) then + j1 = j1 + 1 + if (j1 > ny) then + j1 = 1 + nloop = nloop + 1 + if (nloop > 2) then + ! stop for infinite loop. This check should not be + ! necessary for halo + call abort_ice(subname // ' ERROR: too many loops') + end if + end if + end if + end do + + end subroutine findXinY_halo + +!======================================================================= + + subroutine numainit(l, u, uu) + + use ice_constants, only : c0 + + implicit none + + integer(kind=int_kind), intent(in) :: l, u, uu + + ! local variables + + integer(kind=int_kind) :: lo, up + + character(len=*), parameter :: subname = '(numainit)' + + call domp_get_domain(l, u, lo, up) + ee(lo:up) = 0 + ne(lo:up) = 0 + se(lo:up) = 0 + sse(lo:up) = 0 + nw(lo:up) = 0 + sw(lo:up) = 0 + halo_parent(lo:up) = 0 + strength(lo:up) = c0 + uvel(lo:up) = c0 + vvel(lo:up) = c0 + uvel_init(lo:up) = c0 + vvel_init(lo:up) = c0 + uocn(lo:up) = c0 + vocn(lo:up) = c0 + dxt(lo:up) = c0 + dyt(lo:up) = c0 + HTE(lo:up) = c0 + HTN(lo:up) = c0 + HTEm1(lo:up) = c0 + HTNm1(lo:up) = c0 + stressp_1(lo:up) = c0 + stressp_2(lo:up) = c0 + stressp_3(lo:up) = c0 + stressp_4(lo:up) = c0 + stressm_1(lo:up) = c0 + stressm_2(lo:up) = c0 + stressm_3(lo:up) = c0 + stressm_4(lo:up) = c0 + stress12_1(lo:up) = c0 + stress12_2(lo:up) = c0 + stress12_3(lo:up) = c0 + stress12_4(lo:up) = c0 + tarear(lo:up) = c0 + Tbu(lo:up) = c0 + taubx(lo:up) = c0 + tauby(lo:up) = c0 + divu(lo:up) = c0 + rdg_conv(lo:up) = c0 + rdg_shear(lo:up) = c0 + shear(lo:up) = c0 + str1(lo:up) = c0 + str2(lo:up) = c0 + str3(lo:up) = c0 + str4(lo:up) = c0 + str5(lo:up) = c0 + str6(lo:up) = c0 + str7(lo:up) = c0 + str8(lo:up) = c0 + + call domp_get_domain(u + 1, uu, lo, up) + halo_parent(lo:up) = 0 + uvel(lo:up) = c0 + vvel(lo:up) = c0 + str1(lo:up) = c0 + str2(lo:up) = c0 + str3(lo:up) = c0 + str4(lo:up) = c0 + str5(lo:up) = c0 + str6(lo:up) = c0 + str7(lo:up) = c0 + str8(lo:up) = c0 + + end subroutine numainit + +!======================================================================= + +end module ice_dyn_evp_1d diff --git a/cicecore/cicedynB/dynamics/ice_dyn_shared.F90 b/cicecore/cicedynB/dynamics/ice_dyn_shared.F90 old mode 100644 new mode 100755 index d9a0919e6..bb65f122c --- a/cicecore/cicedynB/dynamics/ice_dyn_shared.F90 +++ b/cicecore/cicedynB/dynamics/ice_dyn_shared.F90 @@ -11,8 +11,8 @@ module ice_dyn_shared use ice_kinds_mod use ice_communicate, only: my_task, master_task - use ice_constants, only: c0, c1, c2, p01, p001 - use ice_constants, only: omega, spval_dbl, p5, c4 + use ice_constants, only: c0, c1, c2, c3, c4, c6 + use ice_constants, only: omega, spval_dbl, p01, p001, p5 use ice_blocks, only: nx_block, ny_block use ice_domain_size, only: max_blocks use ice_fileunits, only: nu_diag @@ -23,7 +23,8 @@ module ice_dyn_shared implicit none private public :: init_dyn, set_evp_parameters, stepu, principal_stress, & - dyn_prep1, dyn_prep2, dyn_finish, basal_stress_coeff, & + dyn_prep1, dyn_prep2, dyn_finish, & + seabed_stress_factor_LKD, seabed_stress_factor_prob, & alloc_dyn_shared, deformations, strain_rates, & stack_velocity_field, unstack_velocity_field @@ -32,7 +33,6 @@ module ice_dyn_shared integer (kind=int_kind), public :: & kdyn , & ! type of dynamics ( -1, 0 = off, 1 = evp, 2 = eap ) kridge , & ! set to "-1" to turn off ridging - ktransport , & ! set to "-1" to turn off transport ndte ! number of subcycles: ndte=dt/dte character (len=char_len), public :: & @@ -40,25 +40,25 @@ module ice_dyn_shared ssh_stress ! 'geostrophic' or 'coupled' logical (kind=log_kind), public :: & - revised_evp ! if true, use revised evp procedure + revised_evp ! if true, use revised evp procedure - integer (kind=int_kind), public :: & - kevp_kernel ! 0 = 2D org version - ! 1 = 1D representation raw (not implemented) - ! 2 = 1D + calculate distances inline (implemented) - ! 3 = 1D + calculate distances inline + real*4 internal (not implemented yet) + character (len=char_len), public :: & + evp_algorithm ! standard_2d = 2D org version (standard) + ! shared_mem_1d = 1d without mpi call and refactorization to 1d ! other EVP parameters character (len=char_len), public :: & - yield_curve ! 'ellipse' ('teardrop' needs further testing) - ! + yield_curve , & ! 'ellipse' ('teardrop' needs further testing) + seabed_stress_method ! method for seabed stress calculation + ! LKD: Lemieux et al. 2015, probabilistic: Dupont et al. in prep. + real (kind=dbl_kind), parameter, public :: & - eyc = 0.36_dbl_kind, & - ! coefficient for calculating the parameter E - cosw = c1 , & ! cos(ocean turning angle) ! turning angle = 0 - sinw = c0 , & ! sin(ocean turning angle) ! turning angle = 0 - a_min = p001, & ! minimum ice area - m_min = p01 ! minimum ice mass (kg/m^2) + eyc = 0.36_dbl_kind, & ! coefficient for calculating the parameter E + u0 = 5e-5_dbl_kind, & ! residual velocity for seabed stress (m/s) + cosw = c1 , & ! cos(ocean turning angle) ! turning angle = 0 + sinw = c0 , & ! sin(ocean turning angle) ! turning angle = 0 + a_min = p001 , & ! minimum ice area + m_min = p01 ! minimum ice mass (kg/m^2) real (kind=dbl_kind), public :: & revp , & ! 0 for classic EVP, 1 for revised EVP @@ -82,19 +82,18 @@ module ice_dyn_shared ! ice isotropic tensile strength parameter real (kind=dbl_kind), public :: & - Ktens ! T=Ktens*P (tensile strength: see Konig and Holland, 2010) + Ktens ! T=Ktens*P (tensile strength: see Konig and Holland, 2010) + ! seabed (basal) stress parameters and settings logical (kind=log_kind), public :: & - basalstress ! if true, basal stress for landfast on + seabed_stress ! if true, seabed stress for landfast on - ! basal stress parameters real (kind=dbl_kind), public :: & - k1, & ! 1st free parameter for landfast parameterization - k2, & ! second free parameter (N/m^3) for landfast parametrization - alphab, & ! alphab=Cb factor in Lemieux et al 2015 - threshold_hw, & ! max water depth for grounding + k1 , & ! 1st free parameter for seabed1 grounding parameterization + k2 , & ! second free parameter (N/m^3) for seabed1 grounding parametrization + alphab , & ! alphab=Cb factor in Lemieux et al 2015 + threshold_hw ! max water depth for grounding ! see keel data from Amundrud et al. 2004 (JGR) - u0 = 5e-5_dbl_kind ! residual velocity for basal stress (m/s) !======================================================================= @@ -447,7 +446,7 @@ subroutine dyn_prep2 (nx_block, ny_block, & dt ! time step real (kind=dbl_kind), dimension (nx_block,ny_block), intent(out) :: & - Tbu, & ! coefficient for basal stress (N/m^2) + Tbu, & ! seabed stress factor (N/m^2) uvel_init,& ! x-component of velocity (m/s), beginning of time step vvel_init,& ! y-component of velocity (m/s), beginning of time step umassdti, & ! mass of U-cell/dt (kg/m^2 s) @@ -469,8 +468,8 @@ subroutine dyn_prep2 (nx_block, ny_block, & strocny , & ! ice-ocean stress, y-direction strintx , & ! divergence of internal ice stress, x (N/m^2) strinty , & ! divergence of internal ice stress, y (N/m^2) - taubx , & ! basal stress, x-direction (N/m^2) - tauby ! basal stress, y-direction (N/m^2) + taubx , & ! seabed stress, x-direction (N/m^2) + tauby ! seabed stress, y-direction (N/m^2) ! local variables @@ -648,7 +647,7 @@ subroutine stepu (nx_block, ny_block, & indxuj ! compressed index in j-direction real (kind=dbl_kind), dimension (nx_block,ny_block), intent(in) :: & - Tbu, & ! coefficient for basal stress (N/m^2) + Tbu, & ! seabed stress factor (N/m^2) uvel_init,& ! x-component of velocity (m/s), beginning of timestep vvel_init,& ! y-component of velocity (m/s), beginning of timestep aiu , & ! ice fraction on u-grid @@ -672,8 +671,8 @@ subroutine stepu (nx_block, ny_block, & real (kind=dbl_kind), dimension (nx_block,ny_block), intent(inout) :: & strintx , & ! divergence of internal ice stress, x (N/m^2) strinty , & ! divergence of internal ice stress, y (N/m^2) - taubx , & ! basal stress, x-direction (N/m^2) - tauby ! basal stress, y-direction (N/m^2) + taubx , & ! seabed stress, x-direction (N/m^2) + tauby ! seabed stress, y-direction (N/m^2) real (kind=dbl_kind), dimension (nx_block,ny_block), intent(inout) :: & Cw ! ocean-ice neutral drag coefficient @@ -688,7 +687,7 @@ subroutine stepu (nx_block, ny_block, & vrel , & ! relative ice-ocean velocity cca,ccb,ab2,cc1,cc2,& ! intermediate variables taux, tauy , & ! part of ocean stress term - Cb , & ! complete basal stress coeff + Cb , & ! complete seabed (basal) stress coeff rhow ! character(len=*), parameter :: subname = '(stepu)' @@ -716,7 +715,7 @@ subroutine stepu (nx_block, ny_block, & taux = vrel*waterx(i,j) ! NOTE this is not the entire tauy = vrel*watery(i,j) ! ocn stress term - Cb = Tbu(i,j) / (sqrt(uold**2 + vold**2) + u0) ! for basal stress + Cb = Tbu(i,j) / (sqrt(uold**2 + vold**2) + u0) ! for seabed stress ! revp = 0 for classic evp, 1 for revised evp cca = (brlx + revp)*umassdti(i,j) + vrel * cosw + Cb ! kg/m^2 s @@ -739,9 +738,9 @@ subroutine stepu (nx_block, ny_block, & uvel(i,j) = (cca*cc1 + ccb*cc2) / ab2 ! m/s vvel(i,j) = (cca*cc2 - ccb*cc1) / ab2 - ! calculate basal stress component for outputs + ! calculate seabed stress component for outputs if (ksub == ndte) then ! on last subcycling iteration - if ( basalstress ) then + if ( seabed_stress ) then taubx(i,j) = -uvel(i,j)*Tbu(i,j) / (sqrt(uold**2 + vold**2) + u0) tauby(i,j) = -vvel(i,j)*Tbu(i,j) / (sqrt(uold**2 + vold**2) + u0) endif @@ -854,7 +853,10 @@ subroutine dyn_finish (nx_block, ny_block, & end subroutine dyn_finish !======================================================================= -! Computes basal stress Tbu coefficients (landfast ice) +! Computes seabed (basal) stress factor Tbu (landfast ice) based on mean +! thickness and bathymetry data. LKD refers to linear keel draft. This +! parameterization assumes that the largest keel draft varies linearly +! with the mean thickness. ! ! Lemieux, J. F., B. Tremblay, F. Dupont, M. Plante, G.C. Smith, D. Dumont (2015). ! A basal stress parameterization form modeling landfast ice, J. Geophys. Res. @@ -866,13 +868,14 @@ end subroutine dyn_finish ! ! author: JF Lemieux, Philippe Blain (ECCC) ! -! note: Tbu is a part of the Cb as defined in Lemieux et al. 2015 and 2016. -! - subroutine basal_stress_coeff (nx_block, ny_block, & - icellu, & - indxui, indxuj, & - vice, aice, & - hwater, Tbu) +! note1: Tbu is a part of the Cb as defined in Lemieux et al. 2015 and 2016. +! note2: Seabed stress (better name) was called basal stress in Lemieux et al. 2015 + + subroutine seabed_stress_factor_LKD (nx_block, ny_block, & + icellu, & + indxui, indxuj, & + vice, aice, & + hwater, Tbu) integer (kind=int_kind), intent(in) :: & nx_block, ny_block, & ! block dimensions @@ -884,23 +887,23 @@ subroutine basal_stress_coeff (nx_block, ny_block, & real (kind=dbl_kind), dimension (nx_block,ny_block), intent(in) :: & aice , & ! concentration of ice at tracer location - vice , & ! volume per unit area of ice at tracer location - hwater ! water depth at tracer location + vice , & ! volume per unit area of ice at tracer location (m) + hwater ! water depth at tracer location (m) real (kind=dbl_kind), dimension (nx_block,ny_block), intent(inout) :: & - Tbu ! coefficient for basal stress (N/m^2) + Tbu ! seabed stress factor (N/m^2) real (kind=dbl_kind) :: & au, & ! concentration of ice at u location - hu, & ! volume per unit area of ice at u location (mean thickness) - hwu, & ! water depth at u location - hcu ! critical thickness at u location + hu, & ! volume per unit area of ice at u location (mean thickness, m) + hwu, & ! water depth at u location (m) + hcu ! critical thickness at u location (m) integer (kind=int_kind) :: & i, j, ij - character(len=*), parameter :: subname = '(basal_stress_coeff)' - + character(len=*), parameter :: subname = '(seabed1_stress_coeff)' + do ij = 1, icellu i = indxui(ij) j = indxuj(ij) @@ -917,15 +920,189 @@ subroutine basal_stress_coeff (nx_block, ny_block, & ! 1- calculate critical thickness hcu = au * hwu / k1 - ! 2- calculate basal stress factor + ! 2- calculate seabed stress factor Tbu(i,j) = k2 * max(c0,(hu - hcu)) * exp(-alphab * (c1 - au)) - + endif enddo ! ij - end subroutine basal_stress_coeff + end subroutine seabed_stress_factor_LKD + +!======================================================================= +! Computes seabed (basal) stress factor Tbu (landfast ice) based on +! probability of contact between the ITD and the seabed. The water depth +! could take into account variations of the SSH. In the simplest +! formulation, hwater is simply the value of the bathymetry. To calculate +! the probability of contact, it is assumed that the bathymetry follows +! a normal distribution with sigma_b = 2.5d0. An improvement would +! be to provide the distribution based on high resolution data. +! +! Dupont, F. Dumont, D., Lemieux, J.F., Dumas-Lefebvre, E., Caya, A. +! in prep. +! +! authors: D. Dumont, J.F. Lemieux, E. Dumas-Lefebvre, F. Dupont +! + subroutine seabed_stress_factor_prob (nx_block, ny_block, & + icellt, indxti, indxtj, & + icellu, indxui, indxuj, & + aicen, vicen, & + hwater, Tbu) +! use modules + + use ice_arrays_column, only: hin_max + use ice_domain_size, only: ncat + + integer (kind=int_kind), intent(in) :: & + nx_block, ny_block, & ! block dimensions + icellt, icellu ! no. of cells where icetmask = 1 + + integer (kind=int_kind), dimension (nx_block*ny_block), & + intent(in) :: & + indxti , & ! compressed index in i-direction + indxtj , & ! compressed index in j-direction + indxui , & ! compressed index in i-direction + indxuj ! compressed index in j-direction + + real (kind=dbl_kind), dimension (nx_block,ny_block), intent(in) :: & + hwater ! water depth at tracer location (m) + + real (kind=dbl_kind), dimension (nx_block,ny_block,ncat), intent(in) :: & + aicen, & ! partial concentration for last thickness category in ITD + vicen ! partial volume for last thickness category in ITD (m) + + real (kind=dbl_kind), dimension (nx_block,ny_block), intent(inout) :: & + Tbu ! seabed stress factor (N/m^2) + +! local variables + + integer (kind=int_kind) :: & + i, j, ij, ii, n + + integer, parameter :: & + ncat_b = 100, & ! number of bathymetry categories + ncat_i = 100 ! number of ice thickness categories (log-normal) + + real (kind=dbl_kind), parameter :: & + max_depth = 50.0_dbl_kind, & ! initial range of log-normal distribution + mu_s = 0.1_dbl_kind, & ! friction coefficient + sigma_b = 2.5d0 ! Standard deviation of bathymetry + + real (kind=dbl_kind), dimension(ncat_i) :: & ! log-normal for ice thickness + x_k, & ! center of thickness categories (m) + g_k, & ! probability density function (thickness, 1/m) + P_x ! probability for each thickness category + + real (kind=dbl_kind), dimension(ncat_b) :: & ! normal dist for bathymetry + y_n, & ! center of bathymetry categories (m) + b_n, & ! probability density function (bathymetry, 1/m) + P_y ! probability for each bathymetry category + + real (kind=dbl_kind), dimension(ncat) :: & + vcat, acat + + integer, dimension(ncat_b) :: & + tmp ! Temporary vector tmp = merge(1,0,gt) + + logical, dimension (ncat_b) :: & + gt + + real (kind=dbl_kind) :: wid_i, wid_b, mu_i, sigma_i, mu_b, m_i, v_i ! parameters for PDFs + real (kind=dbl_kind), dimension(ncat_i):: tb_tmp + real (kind=dbl_kind), dimension (nx_block,ny_block):: Tbt ! seabed stress factor at t point (N/m^2) + real (kind=dbl_kind) :: atot, x_kmax + real (kind=dbl_kind) :: cut, rhoi, rhow, gravit, pi, puny + character(len=*), parameter :: subname = '(seabed2_stress_coeff)' + + call icepack_query_parameters(rhow_out=rhow, rhoi_out=rhoi) + call icepack_query_parameters(gravit_out=gravit) + call icepack_query_parameters(pi_out=pi) + call icepack_query_parameters(puny_out=puny) + + Tbt=c0 + + do ij = 1, icellt + i = indxti(ij) + j = indxtj(ij) + + atot = sum(aicen(i,j,1:ncat)) + + if (atot > 0.05_dbl_kind .and. hwater(i,j) < max_depth) then + + mu_b = hwater(i,j) ! mean of PDF (normal dist) bathymetry + wid_i = max_depth/ncat_i ! width of ice categories + wid_b = c6*sigma_b/ncat_b ! width of bathymetry categories (6 sigma_b = 2x3 sigma_b) + + x_k = (/( wid_i*( real(i,kind=dbl_kind) - p5 ), i=1, ncat_i )/) + y_n = (/( ( mu_b-c3*sigma_b )+( real(i,kind=dbl_kind) - p5 )*( c6*sigma_b/ncat_b ), i=1, ncat_b )/) + + vcat(1:ncat) = vicen(i,j,1:ncat) + acat(1:ncat) = aicen(i,j,1:ncat) + + m_i = sum(vcat) + + v_i=c0 + do n =1, ncat + v_i = v_i + vcat(n)**2 / (max(acat(n), puny)) + enddo + v_i = v_i - m_i**2 + + mu_i = log(m_i/sqrt(c1 + v_i/m_i**2)) ! parameters for the log-normal + sigma_i = sqrt(log(c1 + v_i/m_i**2)) + + ! max thickness associated with percentile of log-normal PDF + ! x_kmax=x997 was obtained from an optimization procedure (Dupont et al.) + + x_kmax = exp(mu_i + sqrt(c2*sigma_i)*1.9430d0) + + ! Set x_kmax to hlev of the last category where there is ice + ! when there is no ice in the last category + cut = x_k(ncat_i) + do n = ncat,-1,1 + if (acat(n) < puny) then + cut = hin_max(n-1) + else + exit + endif + enddo + x_kmax = min(cut, x_kmax) + + g_k = exp(-(log(x_k) - mu_i) ** 2 / (c2 * sigma_i ** 2)) / (x_k * sigma_i * sqrt(c2 * pi)) + + b_n = exp(-(y_n - mu_b) ** 2 / (c2 * sigma_b ** 2)) / (sigma_b * sqrt(c2 * pi)) + + P_x = g_k*wid_i + P_y = b_n*wid_b + + do n =1, ncat_i + if (x_k(n) > x_kmax) P_x(n)=c0 + enddo + + ! calculate Tb factor at t-location + do n=1, ncat_i + gt = (y_n <= rhoi*x_k(n)/rhow) + tmp = merge(1,0,gt) + ii = sum(tmp) + if (ii == 0) then + tb_tmp(n) = c0 + else + tb_tmp(n) = max(mu_s*gravit*P_x(n)*sum(P_y(1:ii)*(rhoi*x_k(n) - rhow*y_n(1:ii))),c0) + endif + enddo + Tbt(i,j) = sum(tb_tmp)*exp(-alphab * (c1 - atot)) + endif + enddo + + do ij = 1, icellu + i = indxui(ij) + j = indxuj(ij) + ! convert quantities to u-location + Tbu(i,j) = max(Tbt(i,j),Tbt(i+1,j),Tbt(i,j+1),Tbt(i+1,j+1)) + enddo ! ij + + end subroutine seabed_stress_factor_prob + !======================================================================= ! Computes principal stresses for comparison with the theoretical @@ -1024,10 +1201,10 @@ subroutine deformations (nx_block, ny_block, & vvel , & ! y-component of velocity (m/s) dxt , & ! width of T-cell through the middle (m) dyt , & ! height of T-cell through the middle (m) - cyp , & ! 1.5*HTE - 0.5*HTE - cxp , & ! 1.5*HTN - 0.5*HTN - cym , & ! 0.5*HTE - 1.5*HTE - cxm , & ! 0.5*HTN - 1.5*HTN + cyp , & ! 1.5*HTE - 0.5*HTW + cxp , & ! 1.5*HTN - 0.5*HTS + cym , & ! 0.5*HTE - 1.5*HTW + cxm , & ! 0.5*HTN - 1.5*HTS tarear ! 1/tarea real (kind=dbl_kind), dimension (nx_block,ny_block), & @@ -1125,10 +1302,10 @@ subroutine strain_rates (nx_block, ny_block, & vvel , & ! y-component of velocity (m/s) dxt , & ! width of T-cell through the middle (m) dyt , & ! height of T-cell through the middle (m) - cyp , & ! 1.5*HTE - 0.5*HTE - cxp , & ! 1.5*HTN - 0.5*HTN - cym , & ! 0.5*HTE - 1.5*HTE - cxm ! 0.5*HTN - 1.5*HTN + cyp , & ! 1.5*HTE - 0.5*HTW + cxp , & ! 1.5*HTN - 0.5*HTS + cym , & ! 0.5*HTE - 1.5*HTW + cxm ! 0.5*HTN - 1.5*HTS real (kind=dbl_kind), intent(out):: & ! at each corner : divune, divunw, divuse, divusw , & ! divergence diff --git a/cicecore/cicedynB/dynamics/ice_dyn_vp.F90 b/cicecore/cicedynB/dynamics/ice_dyn_vp.F90 index 570e202c2..cd81163da 100644 --- a/cicecore/cicedynB/dynamics/ice_dyn_vp.F90 +++ b/cicecore/cicedynB/dynamics/ice_dyn_vp.F90 @@ -1135,12 +1135,12 @@ subroutine calc_zeta_dPr (nx_block, ny_block, & vvel , & ! y-component of velocity (m/s) dxt , & ! width of T-cell through the middle (m) dyt , & ! height of T-cell through the middle (m) - dxhy , & ! 0.5*(HTE - HTE) - dyhx , & ! 0.5*(HTN - HTN) - cyp , & ! 1.5*HTE - 0.5*HTE - cxp , & ! 1.5*HTN - 0.5*HTN - cym , & ! 0.5*HTE - 1.5*HTE - cxm , & ! 0.5*HTN - 1.5*HTN + dxhy , & ! 0.5*(HTE - HTW) + dyhx , & ! 0.5*(HTN - HTS) + cyp , & ! 1.5*HTE - 0.5*HTW + cxp , & ! 1.5*HTN - 0.5*HTS + cym , & ! 0.5*HTE - 1.5*HTW + cxm , & ! 0.5*HTN - 1.5*HTS tinyarea ! min_strain_rate*tarea real (kind=dbl_kind), dimension(nx_block,ny_block,4), intent(out) :: & @@ -1321,10 +1321,10 @@ subroutine stress_vp (nx_block , ny_block , & vvel , & ! y-component of velocity (m/s) dxt , & ! width of T-cell through the middle (m) dyt , & ! height of T-cell through the middle (m) - cyp , & ! 1.5*HTE - 0.5*HTE - cxp , & ! 1.5*HTN - 0.5*HTN - cym , & ! 0.5*HTE - 1.5*HTE - cxm ! 0.5*HTN - 1.5*HTN + cyp , & ! 1.5*HTE - 0.5*HTW + cxp , & ! 1.5*HTN - 0.5*HTS + cym , & ! 0.5*HTE - 1.5*HTW + cxm ! 0.5*HTN - 1.5*HTS real (kind=dbl_kind), dimension(nx_block,ny_block,4), intent(in) :: & zetaD ! 2*zeta @@ -1541,12 +1541,12 @@ subroutine matvec (nx_block, ny_block, & real (kind=dbl_kind), dimension (nx_block,ny_block), intent(in) :: & dxt , & ! width of T-cell through the middle (m) dyt , & ! height of T-cell through the middle (m) - dxhy , & ! 0.5*(HTE - HTE) - dyhx , & ! 0.5*(HTN - HTN) - cyp , & ! 1.5*HTE - 0.5*HTE - cxp , & ! 1.5*HTN - 0.5*HTN - cym , & ! 0.5*HTE - 1.5*HTE - cxm ! 0.5*HTN - 1.5*HTN + dxhy , & ! 0.5*(HTE - HTW) + dyhx , & ! 0.5*(HTN - HTS) + cyp , & ! 1.5*HTE - 0.5*HTW + cxp , & ! 1.5*HTN - 0.5*HTS + cym , & ! 0.5*HTE - 1.5*HTW + cxm ! 0.5*HTN - 1.5*HTS real (kind=dbl_kind), dimension (nx_block,ny_block), intent(in) :: & uvel , & ! x-component of velocity (m/s) @@ -1990,12 +1990,12 @@ subroutine formDiag_step1 (nx_block, ny_block, & real (kind=dbl_kind), dimension (nx_block,ny_block), intent(in) :: & dxt , & ! width of T-cell through the middle (m) dyt , & ! height of T-cell through the middle (m) - dxhy , & ! 0.5*(HTE - HTE) - dyhx , & ! 0.5*(HTN - HTN) - cyp , & ! 1.5*HTE - 0.5*HTE - cxp , & ! 1.5*HTN - 0.5*HTN - cym , & ! 0.5*HTE - 1.5*HTE - cxm ! 0.5*HTN - 1.5*HTN + dxhy , & ! 0.5*(HTE - HTW) + dyhx , & ! 0.5*(HTN - HTS) + cyp , & ! 1.5*HTE - 0.5*HTW + cxp , & ! 1.5*HTN - 0.5*HTS + cym , & ! 0.5*HTE - 1.5*HTW + cxm ! 0.5*HTN - 1.5*HTS real (kind=dbl_kind), dimension(nx_block,ny_block,4), intent(in) :: & zetaD ! 2*zeta diff --git a/cicecore/cicedynB/general/ice_init.F90 b/cicecore/cicedynB/general/ice_init.F90 index d5a630078..3d102217a 100644 --- a/cicecore/cicedynB/general/ice_init.F90 +++ b/cicecore/cicedynB/general/ice_init.F90 @@ -40,7 +40,7 @@ module ice_init ice_ic ! method of ice cover initialization ! 'default' => latitude and sst dependent ! 'none' => no ice - ! note: restart = .true. overwrites + ! filename => read file public :: input_data, init_state, set_state_var @@ -59,21 +59,22 @@ subroutine input_data use ice_broadcast, only: broadcast_scalar, broadcast_array use ice_diagnostics, only: diag_file, print_global, print_points, latpnt, lonpnt, & - debug_model, debug_model_step + debug_model, debug_model_step, debug_model_task, & + debug_model_i, debug_model_j, debug_model_iblk use ice_domain, only: close_boundaries, orca_halogrid use ice_domain_size, only: ncat, nilyr, nslyr, nblyr, nfsd, nfreq, & n_iso, n_aero, n_zaero, n_algae, & n_doc, n_dic, n_don, n_fed, n_fep, & max_nstrm use ice_calendar, only: year_init, month_init, day_init, sec_init, & - istep0, histfreq, histfreq_n, & - dumpfreq, dumpfreq_n, diagfreq, & + istep0, histfreq, histfreq_n, histfreq_base, & + dumpfreq, dumpfreq_n, diagfreq, dumpfreq_base, & npt, dt, ndtd, days_per_year, use_leap_years, & write_ic, dump_last, npt_unit use ice_arrays_column, only: oceanmixed_ice use ice_restart_column, only: restart_age, restart_FY, restart_lvl, & restart_pond_cesm, restart_pond_lvl, restart_pond_topo, restart_aero, & - restart_fsd, restart_iso + restart_fsd, restart_iso, restart_snow use ice_restart_shared, only: & restart, restart_ext, restart_coszen, restart_dir, restart_file, pointer_file, & runid, runtype, use_restart_time, restart_format, lcdf64 @@ -84,21 +85,25 @@ subroutine input_data use ice_flux, only: default_season use ice_flux_bgc, only: cpl_bgc use ice_forcing, only: & - ycycle, fyear_init, forcing_diag, & + ycycle, fyear_init, debug_forcing, & atm_data_type, atm_data_dir, precip_units, rotate_wind, & atm_data_format, ocn_data_format, & bgc_data_type, & ocn_data_type, ocn_data_dir, wave_spec_file, & oceanmixed_file, restore_ocn, trestore, & - ice_data_type + ice_data_type, & + snw_filename, & + snw_tau_fname, snw_kappa_fname, snw_drdt0_fname, & + snw_rhos_fname, snw_Tgrd_fname, snw_T_fname use ice_arrays_column, only: bgc_data_dir, fe_data_type use ice_grid, only: grid_file, gridcpl_file, kmt_file, & bathymetry_file, use_bathymetry, & bathymetry_format, & grid_type, grid_format, & - dxrect, dyrect + dxrect, dyrect, & + pgl_global_ext use ice_dyn_shared, only: ndte, kdyn, revised_evp, yield_curve, & - kevp_kernel, & + evp_algorithm, & seabed_stress, seabed_stress_method, & k1, k2, alphab, threshold_hw, & Ktens, e_ratio, coriolis, ssh_stress, & @@ -127,19 +132,21 @@ subroutine input_data mu_rdg, hs0, dpscale, rfracmin, rfracmax, pndaspect, hs1, hp1, & a_rapid_mode, Rac_rapid_mode, aspect_rapid_mode, dSdt_slow_mode, & phi_c_slow_mode, phi_i_mushy, kalg, atmiter_conv, Pstar, Cstar, & - sw_frac, sw_dtemp, floediam, hfrazilmin, iceruf + sw_frac, sw_dtemp, floediam, hfrazilmin, iceruf, iceruf_ocn, & + rsnw_fall, rsnw_tmax, rhosnew, rhosmin, rhosmax, & + windmin, drhosdwind, snwlvlfac integer (kind=int_kind) :: ktherm, kstrength, krdg_partic, krdg_redist, natmiter, & kitd, kcatbound, ktransport character (len=char_len) :: shortwave, albedo_type, conduct, fbot_xfer_type, & - tfrz_option, frzpnd, atmbndy, wave_spec_type + tfrz_option, frzpnd, atmbndy, wave_spec_type, snwredist, snw_aging_table logical (kind=log_kind) :: calc_Tsfc, formdrag, highfreq, calc_strair, wave_spec, & - sw_redist + sw_redist, calc_dragio, use_smliq_pnd, snwgrain logical (kind=log_kind) :: tr_iage, tr_FY, tr_lvl, tr_pond - logical (kind=log_kind) :: tr_iso, tr_aero, tr_fsd + logical (kind=log_kind) :: tr_iso, tr_aero, tr_fsd, tr_snow logical (kind=log_kind) :: tr_pond_cesm, tr_pond_lvl, tr_pond_topo integer (kind=int_kind) :: numin, numax ! unit number limits @@ -164,9 +171,11 @@ subroutine input_data pointer_file, dumpfreq, dumpfreq_n, dump_last, & diagfreq, diag_type, diag_file, history_format,& print_global, print_points, latpnt, lonpnt, & - forcing_diag, histfreq, histfreq_n, hist_avg, & + debug_forcing, histfreq, histfreq_n, hist_avg, & history_dir, history_file, history_precision, cpl_bgc, & + histfreq_base, dumpfreq_base, & conserv_check, debug_model, debug_model_step, & + debug_model_i, debug_model_j, debug_model_iblk, debug_model_task, & year_init, month_init, day_init, sec_init, & write_ic, incond_dir, incond_file, version_name @@ -184,6 +193,7 @@ subroutine input_data tr_pond_cesm, restart_pond_cesm, & tr_pond_lvl, restart_pond_lvl, & tr_pond_topo, restart_pond_topo, & + tr_snow, restart_snow, & tr_iso, restart_iso, & tr_aero, restart_aero, & tr_fsd, restart_fsd, & @@ -198,7 +208,7 @@ subroutine input_data namelist /dynamics_nml/ & kdyn, ndte, revised_evp, yield_curve, & - kevp_kernel, & + evp_algorithm, & brlx, arlx, ssh_stress, & advection, coriolis, kridge, ktransport, & kstrength, krdg_partic, krdg_redist, mu_rdg, & @@ -224,10 +234,17 @@ subroutine input_data rfracmin, rfracmax, pndaspect, hs1, & hp1 + namelist /snow_nml/ & + snwredist, snwgrain, rsnw_fall, rsnw_tmax, & + rhosnew, rhosmin, rhosmax, snwlvlfac, & + windmin, drhosdwind, use_smliq_pnd, snw_aging_table,& + snw_filename, snw_rhos_fname, snw_Tgrd_fname,snw_T_fname, & + snw_tau_fname, snw_kappa_fname, snw_drdt0_fname + namelist /forcing_nml/ & formdrag, atmbndy, calc_strair, calc_Tsfc, & - highfreq, natmiter, atmiter_conv, & - ustar_min, emissivity, iceruf, & + highfreq, natmiter, atmiter_conv, calc_dragio, & + ustar_min, emissivity, iceruf, iceruf_ocn, & fbot_xfer_type, update_ocn_f, l_mpond_fresh, tfrz_option, & oceanmixed_ice, restore_ice, restore_ocn, trestore, & precip_units, default_season, wave_spec_type,nfreq, & @@ -267,7 +284,11 @@ subroutine input_data npt_unit = '1' ! units of npt 'y', 'm', 'd', 's', '1' diagfreq = 24 ! how often diag output is written debug_model = .false. ! debug output - debug_model_step = 999999999 ! debug model after this step number + debug_model_step = 0 ! debug model after this step number + debug_model_i = -1 ! debug model local i index + debug_model_j = -1 ! debug model local j index + debug_model_iblk = -1 ! debug model local iblk number + debug_model_task = -1 ! debug model local task number print_points = .false. ! if true, print point data print_global = .true. ! if true, print global diagnostic data bfbflag = 'off' ! off = optimized @@ -279,6 +300,7 @@ subroutine input_data histfreq(4) = 'm' ! output frequency option for different streams histfreq(5) = 'y' ! output frequency option for different streams histfreq_n(:) = 1 ! output frequency + histfreq_base = 'zero' ! output frequency reference date hist_avg = .true. ! if true, write time-averages (not snapshots) history_format = 'default' ! history file format history_dir = './' ! write to executable dir for default @@ -290,13 +312,12 @@ subroutine input_data incond_file = 'iceh_ic'! file prefix dumpfreq='y' ! restart frequency option dumpfreq_n = 1 ! restart frequency + dumpfreq_base = 'init' ! restart frequency reference date dump_last = .false. ! write restart on last time step - restart = .false. ! if true, read restart files for initialization restart_dir = './' ! write to executable dir for default restart_file = 'iced' ! restart file name prefix restart_ext = .false. ! if true, read/write ghost cells restart_coszen = .false. ! if true, read/write coszen - use_restart_time = .true. ! if true, use time info written in file pointer_file = 'ice.restart_file' restart_format = 'default' ! restart file format lcdf64 = .false. ! 64 bit offset for netCDF @@ -322,7 +343,8 @@ subroutine input_data kdyn = 1 ! type of dynamics (-1, 0 = off, 1 = evp, 2 = eap, 3 = vp) ndtd = 1 ! dynamic time steps per thermodynamic time step ndte = 120 ! subcycles per dynamics timestep: ndte=dt_dyn/dte - kevp_kernel = 0 ! EVP kernel (0 = 2D, >0: 1D. Only ver. 2 is implemented yet) + evp_algorithm = 'standard_2d' ! EVP kernel (=standard_2d: standard cice evp; =shared_mem_1d: 1d shared memory and no mpi. if more mpi processors then executed on master + pgl_global_ext = .false. ! if true, init primary grid lengths (global ext.) brlx = 300.0_dbl_kind ! revised_evp values. Otherwise overwritten in ice_dyn_shared arlx = 300.0_dbl_kind ! revised_evp values. Otherwise overwritten in ice_dyn_shared revised_evp = .false. ! if true, use revised procedure for evp dynamics @@ -380,6 +402,8 @@ subroutine input_data update_ocn_f = .false. ! include fresh water and salt fluxes for frazil ustar_min = 0.005 ! minimum friction velocity for ocean heat flux (m/s) iceruf = 0.0005_dbl_kind ! ice surface roughness at atmosphere interface (m) + iceruf_ocn = 0.03_dbl_kind ! under-ice roughness (m) + calc_dragio = .false. ! compute dragio from iceruf_ocn and thickness of first ocean level emissivity = 0.985 ! emissivity of snow and ice l_mpond_fresh = .false. ! logical switch for including meltpond freshwater ! flux feedback to ocean model @@ -400,6 +424,25 @@ subroutine input_data rfracmin = 0.15_dbl_kind ! minimum retained fraction of meltwater rfracmax = 0.85_dbl_kind ! maximum retained fraction of meltwater pndaspect = 0.8_dbl_kind ! ratio of pond depth to area fraction + snwredist = 'none' ! type of snow redistribution + snw_aging_table = 'test' ! snow aging lookup table + snw_filename = 'unknown' ! snowtable filename + snw_tau_fname = 'unknown' ! snowtable file tau fieldname + snw_kappa_fname = 'unknown' ! snowtable file kappa fieldname + snw_drdt0_fname = 'unknown' ! snowtable file drdt0 fieldname + snw_rhos_fname = 'unknown' ! snowtable file rhos fieldname + snw_Tgrd_fname = 'unknown' ! snowtable file Tgrd fieldname + snw_T_fname = 'unknown' ! snowtable file T fieldname + snwgrain = .false. ! snow metamorphosis + use_smliq_pnd = .false. ! use liquid in snow for ponds + rsnw_fall = 100.0_dbl_kind ! radius of new snow (10^-6 m) ! advanced snow physics: 54.526 x 10^-6 m + rsnw_tmax = 1500.0_dbl_kind ! maximum snow radius (10^-6 m) + rhosnew = 100.0_dbl_kind ! new snow density (kg/m^3) + rhosmin = 100.0_dbl_kind ! minimum snow density (kg/m^3) + rhosmax = 450.0_dbl_kind ! maximum snow density (kg/m^3) + windmin = 10.0_dbl_kind ! minimum wind speed to compact snow (m/s) + drhosdwind= 27.3_dbl_kind ! wind compaction factor for snow (kg s/m^4) + snwlvlfac = 0.3_dbl_kind ! fractional increase in snow depth for bulk redistribution albicev = 0.78_dbl_kind ! visible ice albedo for h > ahmax albicei = 0.36_dbl_kind ! near-ir ice albedo for h > ahmax albsnowv = 0.98_dbl_kind ! cold snow albedo, visible @@ -436,7 +479,7 @@ subroutine input_data restore_ocn = .false. ! restore sst if true trestore = 90 ! restoring timescale, days (0 instantaneous) restore_ice = .false. ! restore ice state on grid edges if true - forcing_diag = .false. ! true writes diagnostics for input forcing + debug_forcing = .false. ! true writes diagnostics for input forcing latpnt(1) = 90._dbl_kind ! latitude of diagnostic point 1 (deg) lonpnt(1) = 0._dbl_kind ! longitude of point 1 (deg) @@ -446,6 +489,8 @@ subroutine input_data #ifndef CESMCOUPLED runid = 'unknown' ! run ID used in CESM and for machine 'bering' runtype = 'initial' ! run type: 'initial', 'continue' + restart = .false. ! if true, read ice state from restart file + use_restart_time = .false. ! if true, use time info written in file #endif ! extra tracers @@ -461,6 +506,8 @@ subroutine input_data restart_pond_lvl = .false. ! melt ponds restart tr_pond_topo = .false. ! explicit melt ponds (topographic) restart_pond_topo = .false. ! melt ponds restart + tr_snow = .false. ! advanced snow physics + restart_snow = .false. ! advanced snow physics restart tr_iso = .false. ! isotopes restart_iso = .false. ! isotopes restart tr_aero = .false. ! aerosols @@ -534,6 +581,9 @@ subroutine input_data print*,'Reading ponds_nml' read(nu_nml, nml=ponds_nml,iostat=nml_error) if (nml_error /= 0) exit + print*,'Reading snow_nml' + read(nu_nml, nml=snow_nml,iostat=nml_error) + if (nml_error /= 0) exit print*,'Reading forcing_nml' read(nu_nml, nml=forcing_nml,iostat=nml_error) if (nml_error /= 0) exit @@ -604,6 +654,10 @@ subroutine input_data call broadcast_scalar(diagfreq, master_task) call broadcast_scalar(debug_model, master_task) call broadcast_scalar(debug_model_step, master_task) + call broadcast_scalar(debug_model_i, master_task) + call broadcast_scalar(debug_model_j, master_task) + call broadcast_scalar(debug_model_iblk, master_task) + call broadcast_scalar(debug_model_task, master_task) call broadcast_scalar(print_points, master_task) call broadcast_scalar(print_global, master_task) call broadcast_scalar(bfbflag, master_task) @@ -613,6 +667,7 @@ subroutine input_data call broadcast_scalar(histfreq(n), master_task) enddo call broadcast_array(histfreq_n, master_task) + call broadcast_scalar(histfreq_base, master_task) call broadcast_scalar(hist_avg, master_task) call broadcast_scalar(history_dir, master_task) call broadcast_scalar(history_file, master_task) @@ -624,6 +679,7 @@ subroutine input_data call broadcast_scalar(incond_file, master_task) call broadcast_scalar(dumpfreq, master_task) call broadcast_scalar(dumpfreq_n, master_task) + call broadcast_scalar(dumpfreq_base, master_task) call broadcast_scalar(dump_last, master_task) call broadcast_scalar(restart_file, master_task) call broadcast_scalar(restart, master_task) @@ -652,7 +708,8 @@ subroutine input_data call broadcast_scalar(kdyn, master_task) call broadcast_scalar(ndtd, master_task) call broadcast_scalar(ndte, master_task) - call broadcast_scalar(kevp_kernel, master_task) + call broadcast_scalar(evp_algorithm, master_task) + call broadcast_scalar(pgl_global_ext, master_task) call broadcast_scalar(brlx, master_task) call broadcast_scalar(arlx, master_task) call broadcast_scalar(revised_evp, master_task) @@ -717,6 +774,25 @@ subroutine input_data call broadcast_scalar(rfracmin, master_task) call broadcast_scalar(rfracmax, master_task) call broadcast_scalar(pndaspect, master_task) + call broadcast_scalar(snwredist, master_task) + call broadcast_scalar(snw_aging_table, master_task) + call broadcast_scalar(snw_filename, master_task) + call broadcast_scalar(snw_tau_fname, master_task) + call broadcast_scalar(snw_kappa_fname, master_task) + call broadcast_scalar(snw_drdt0_fname, master_task) + call broadcast_scalar(snw_rhos_fname, master_task) + call broadcast_scalar(snw_Tgrd_fname, master_task) + call broadcast_scalar(snw_T_fname, master_task) + call broadcast_scalar(snwgrain, master_task) + call broadcast_scalar(use_smliq_pnd, master_task) + call broadcast_scalar(rsnw_fall, master_task) + call broadcast_scalar(rsnw_tmax, master_task) + call broadcast_scalar(rhosnew, master_task) + call broadcast_scalar(rhosmin, master_task) + call broadcast_scalar(rhosmax, master_task) + call broadcast_scalar(windmin, master_task) + call broadcast_scalar(drhosdwind, master_task) + call broadcast_scalar(snwlvlfac, master_task) call broadcast_scalar(albicev, master_task) call broadcast_scalar(albicei, master_task) call broadcast_scalar(albsnowv, master_task) @@ -739,6 +815,8 @@ subroutine input_data call broadcast_scalar(l_mpond_fresh, master_task) call broadcast_scalar(ustar_min, master_task) call broadcast_scalar(iceruf, master_task) + call broadcast_scalar(iceruf_ocn, master_task) + call broadcast_scalar(calc_dragio, master_task) call broadcast_scalar(emissivity, master_task) call broadcast_scalar(fbot_xfer_type, master_task) call broadcast_scalar(precip_units, master_task) @@ -758,7 +836,7 @@ subroutine input_data call broadcast_scalar(restore_ocn, master_task) call broadcast_scalar(trestore, master_task) call broadcast_scalar(restore_ice, master_task) - call broadcast_scalar(forcing_diag, master_task) + call broadcast_scalar(debug_forcing, master_task) call broadcast_array (latpnt(1:2), master_task) call broadcast_array (lonpnt(1:2), master_task) call broadcast_scalar(runid, master_task) @@ -778,6 +856,8 @@ subroutine input_data call broadcast_scalar(restart_pond_lvl, master_task) call broadcast_scalar(tr_pond_topo, master_task) call broadcast_scalar(restart_pond_topo, master_task) + call broadcast_scalar(tr_snow, master_task) + call broadcast_scalar(restart_snow, master_task) call broadcast_scalar(tr_iso, master_task) call broadcast_scalar(restart_iso, master_task) call broadcast_scalar(tr_aero, master_task) @@ -830,42 +910,47 @@ subroutine input_data write(nu_diag,*) ' ' endif - if (trim(runtype) == 'continue' .and. .not.restart) then - if (my_task == master_task) & - write(nu_diag,*) subname//' WARNING: runtype=continue, setting restart=.true.' + if (trim(runtype) == 'continue') then + if (my_task == master_task) then + write(nu_diag,*) subname//'NOTE: runtype=continue, setting restart=.true.' + if (.not. use_restart_time) & + write(nu_diag,*) subname//'NOTE: runtype=continue, setting use_restart_time=.true.' + write(nu_diag,*) ' ' + endif restart = .true. - endif - - if (trim(runtype) /= 'continue' .and. restart .and. & - (ice_ic == 'none' .or. ice_ic == 'default')) then - if (my_task == master_task) & - write(nu_diag,*) subname//' WARNING: runtype ne continue and ice_ic=none|default, setting restart=.false.' - restart = .false. - endif - - if (trim(runtype) /= 'continue' .and. (ice_ic == 'none' .or. ice_ic == 'default')) then - if (my_task == master_task) & - write(nu_diag,*) subname//' WARNING: ice_ic = none or default, setting restart flags to .false.' - restart = .false. - restart_iso = .false. - restart_aero = .false. - restart_fsd = .false. - restart_age = .false. - restart_fy = .false. - restart_lvl = .false. - restart_pond_cesm = .false. - restart_pond_lvl = .false. - restart_pond_topo = .false. + use_restart_time = .true. + elseif (trim(runtype) == 'initial') then + if (ice_ic == 'none' .or. ice_ic == 'default') then + if (my_task == master_task) then + write(nu_diag,*) subname//'NOTE: ice_ic = none or default, setting restart flags to .false.' + if (.not. use_restart_time) & + write(nu_diag,*) subname//'NOTE: ice_ic = none or default, setting use_restart_time=.false.' + write(nu_diag,*) ' ' + endif + use_restart_time = .false. + restart = .false. + restart_iso = .false. + restart_aero = .false. + restart_fsd = .false. + restart_age = .false. + restart_fy = .false. + restart_lvl = .false. + restart_pond_cesm = .false. + restart_pond_lvl = .false. + restart_pond_topo = .false. + restart_snow = .false. ! tcraig, OK to leave as true, needed for boxrestore case -! restart_ext = .false. - endif - - if (trim(runtype) == 'initial' .and. .not.(restart) .and. & - ice_ic /= 'none' .and. ice_ic /= 'default') then +! restart_ext = .false. + else + if (my_task == master_task) then + write(nu_diag,*) subname//'NOTE: ice_ic /= none or default, setting restart=.true.' + write(nu_diag,*) ' ' + endif + restart = .true. + endif + else if (my_task == master_task) then - write(nu_diag,*) subname//' ERROR: runtype, restart, ice_ic are inconsistent:' - write(nu_diag,*) subname//' ERROR: runtype=',trim(runtype), ' restart=',restart, ' ice_ic=',trim(ice_ic) - write(nu_diag,*) subname//' ERROR: Please review user guide' + write(nu_diag,*) subname//' ERROR: runtype unknown = ',trim(runtype) endif abort_list = trim(abort_list)//":1" endif @@ -962,6 +1047,59 @@ subroutine input_data abort_list = trim(abort_list)//":8" endif + if (snwredist(1:4) /= 'none' .and. .not. tr_snow) then + if (my_task == master_task) then + write (nu_diag,*) 'ERROR: snwredist on but tr_snow=F' + write (nu_diag,*) 'ERROR: Use tr_snow=T for snow redistribution' + endif + abort_list = trim(abort_list)//":37" + endif + if (snwredist(1:4) == 'bulk' .and. .not. tr_lvl) then + if (my_task == master_task) then + write (nu_diag,*) 'ERROR: snwredist=bulk but tr_lvl=F' + write (nu_diag,*) 'ERROR: Use tr_lvl=T for snow redistribution' + endif + abort_list = trim(abort_list)//":38" + endif + if (snwredist(1:6) == 'ITDrdg' .and. .not. tr_lvl) then + if (my_task == master_task) then + write (nu_diag,*) 'ERROR: snwredist=ITDrdg but tr_lvl=F' + write (nu_diag,*) 'ERROR: Use tr_lvl=T for snow redistribution' + endif + abort_list = trim(abort_list)//":39" + endif + if (use_smliq_pnd .and. .not. snwgrain) then + if (my_task == master_task) then + write (nu_diag,*) 'ERROR: use_smliq_pnd = T but' + write (nu_diag,*) 'ERROR: snow metamorphosis not used' + write (nu_diag,*) 'ERROR: Use snwgrain=T with smliq for ponds' + endif + abort_list = trim(abort_list)//":40" + endif + if (use_smliq_pnd .and. .not. tr_snow) then + if (my_task == master_task) then + write (nu_diag,*) 'ERROR: use_smliq_pnd = T but' + write (nu_diag,*) 'ERROR: snow tracers are not active' + write (nu_diag,*) 'ERROR: Use tr_snow=T with smliq for ponds' + endif + abort_list = trim(abort_list)//":41" + endif + if (snwgrain .and. .not. tr_snow) then + if (my_task == master_task) then + write (nu_diag,*) 'ERROR: snwgrain=T but tr_snow=F' + write (nu_diag,*) 'ERROR: Use tr_snow=T for snow metamorphosis' + endif + abort_list = trim(abort_list)//":42" + endif + if (trim(snw_aging_table) /= 'test' .and. & + trim(snw_aging_table) /= 'snicar' .and. & + trim(snw_aging_table) /= 'file') then + if (my_task == master_task) then + write (nu_diag,*) 'ERROR: unknown snw_aging_table = '//trim(snw_aging_table) + endif + abort_list = trim(abort_list)//":43" + endif + if (tr_iso .and. n_iso==0) then if (my_task == master_task) then write(nu_diag,*) subname//' ERROR: isotopes activated but' @@ -991,7 +1129,7 @@ subroutine input_data if (my_task == master_task) then write(nu_diag,*) subname//' ERROR: nilyr < 1' endif - abort_list = trim(abort_list)//":33" + abort_list = trim(abort_list)//":2" endif if (nslyr < 1) then @@ -1025,6 +1163,13 @@ subroutine input_data abort_list = trim(abort_list)//":10" endif + if (trim(shortwave) /= 'dEdd' .and. snwgrain) then + if (my_task == master_task) then + write (nu_diag,*) 'WARNING: snow grain radius activated but' + write (nu_diag,*) 'WARNING: dEdd shortwave is not.' + endif + endif + if ((rfracmin < -puny .or. rfracmin > c1+puny) .or. & (rfracmax < -puny .or. rfracmax > c1+puny) .or. & (rfracmin > rfracmax)) then @@ -1106,6 +1251,16 @@ subroutine input_data abort_list = trim(abort_list)//":22" endif + if(histfreq_base /= 'init' .and. histfreq_base /= 'zero') then + write (nu_diag,*) subname//' ERROR: bad value for histfreq_base, allowed values: init, zero' + abort_list = trim(abort_list)//":24" + endif + + if(dumpfreq_base /= 'init' .and. dumpfreq_base /= 'zero') then + write (nu_diag,*) subname//' ERROR: bad value for dumpfreq_base, allowed values: init, zero' + abort_list = trim(abort_list)//":25" + endif + if (.not.(trim(dumpfreq) == 'y' .or. trim(dumpfreq) == 'Y' .or. & trim(dumpfreq) == 'm' .or. trim(dumpfreq) == 'M' .or. & trim(dumpfreq) == 'd' .or. trim(dumpfreq) == 'D' .or. & @@ -1260,16 +1415,16 @@ subroutine input_data tmpstr2 = ' : revised EVP formulation not used' endif write(nu_diag,1010) ' revised_evp = ', revised_evp,trim(tmpstr2) - - if (kevp_kernel == 0) then - tmpstr2 = ' : original EVP solver' - elseif (kevp_kernel == 2 .or. kevp_kernel == 102) then - tmpstr2 = ' : vectorized EVP solver' + + if (evp_algorithm == 'standard_2d') then + tmpstr2 = ' : standard 2d EVP solver' + elseif (evp_algorithm == 'shared_mem_1d') then + tmpstr2 = ' : vectorized 1d EVP solver' + pgl_global_ext = .true. else tmpstr2 = ' : unknown value' endif - write(nu_diag,1020) ' kevp_kernel = ', kevp_kernel,trim(tmpstr2) - + write(nu_diag,1031) ' evp_algorithm = ', trim(evp_algorithm),trim(tmpstr2) write(nu_diag,1020) ' ndtd = ', ndtd, ' : number of dynamics/advection/ridging/steps per thermo timestep' write(nu_diag,1020) ' ndte = ', ndte, ' : number of EVP or EAP subcycles' endif @@ -1543,6 +1698,15 @@ subroutine input_data endif write(nu_diag,1030) ' fbot_xfer_type = ', trim(fbot_xfer_type),trim(tmpstr2) write(nu_diag,1000) ' ustar_min = ', ustar_min,' : minimum value of ocean friction velocity' + if (calc_dragio) then + tmpstr2 = ' : dragio computed from iceruf_ocn' + else + tmpstr2 = ' : dragio hard-coded' + endif + write(nu_diag,1010) ' calc_dragio = ', calc_dragio,trim(tmpstr2) + if(calc_dragio) then + write(nu_diag,1002) ' iceruf_ocn = ', iceruf_ocn,' : under-ice roughness length' + endif if (tr_fsd) then write(nu_diag,1002) ' floediam = ', floediam, ' constant floe diameter' @@ -1610,6 +1774,78 @@ subroutine input_data write(nu_diag,1002) ' rfracmin = ', rfracmin,' : minimum fraction of melt water added to ponds' write(nu_diag,1002) ' rfracmax = ', rfracmax,' : maximum fraction of melt water added to ponds' + write(nu_diag,*) ' ' + write(nu_diag,*) ' Snow redistribution/metamorphism tracers' + write(nu_diag,*) '-----------------------------------------' + if (tr_snow) then + write(nu_diag,1010) ' tr_snow = ', tr_snow, & + ' : advanced snow physics' + if (snwredist(1:4) == 'none') then + write(nu_diag,1030) ' snwredist = ', trim(snwredist), & + ' : Snow redistribution scheme turned off' + else + if (snwredist(1:4) == 'bulk') then + write(nu_diag,1030) ' snwredist = ', trim(snwredist), & + ' : Using bulk snow redistribution scheme' + elseif (snwredist(1:6) == 'ITDrdg') then + write(nu_diag,1030) ' snwredist = ', trim(snwredist), & + ' : Using ridging based snow redistribution scheme' + write(nu_diag,1002) ' rhosnew = ', rhosnew, & + ' : new snow density (kg/m^3)' + write(nu_diag,1002) ' rhosmin = ', rhosmin, & + ' : minimum snow density (kg/m^3)' + write(nu_diag,1002) ' rhosmax = ', rhosmax, & + ' : maximum snow density (kg/m^3)' + write(nu_diag,1002) ' windmin = ', windmin, & + ' : minimum wind speed to compact snow (m/s)' + write(nu_diag,1002) ' drhosdwind = ', drhosdwind, & + ' : wind compaction factor (kg s/m^4)' + endif + write(nu_diag,1002) ' snwlvlfac = ', snwlvlfac, & + ' : fractional increase in snow depth for redistribution on ridges' + endif + if (.not. snwgrain) then + write(nu_diag,1010) ' snwgrain = ', snwgrain, & + ' : Snow metamorphosis turned off' + else + write(nu_diag,1010) ' snwgrain = ', snwgrain, & + ' : Using snow metamorphosis scheme' + write(nu_diag,1002) ' rsnw_tmax = ', rsnw_tmax, & + ' : maximum snow radius (10^-6 m)' + endif + write(nu_diag,1002) ' rsnw_fall = ', rsnw_fall, & + ' : radius of new snow (10^-6 m)' + if (snwgrain) then + if (use_smliq_pnd) then + tmpstr2 = ' : Using liquid water in snow for melt ponds' + else + tmpstr2 = ' : NOT using liquid water in snow for melt ponds' + endif + write(nu_diag,1010) ' use_smliq_pnd = ', use_smliq_pnd, trim(tmpstr2) + if (snw_aging_table == 'test') then + tmpstr2 = ' : Using 5x5x1 test matrix of internallly defined snow aging parameters' + write(nu_diag,1030) ' snw_aging_table = ', trim(snw_aging_table),trim(tmpstr2) + elseif (snw_aging_table == 'snicar') then + tmpstr2 = ' : Reading 3D snow aging parameters from SNICAR file' + write(nu_diag,1030) ' snw_aging_table = ', trim(snw_aging_table),trim(tmpstr2) + write(nu_diag,1031) ' snw_filename = ',trim(snw_filename) + write(nu_diag,1031) ' snw_tau_fname = ',trim(snw_tau_fname) + write(nu_diag,1031) ' snw_kappa_fname = ',trim(snw_kappa_fname) + write(nu_diag,1031) ' snw_drdt0_fname = ',trim(snw_drdt0_fname) + elseif (snw_aging_table == 'file') then + tmpstr2 = ' : Reading 1D and 3D snow aging dimensions and parameters from external file' + write(nu_diag,1030) ' snw_aging_table = ', trim(snw_aging_table),trim(tmpstr2) + write(nu_diag,1031) ' snw_filename = ',trim(snw_filename) + write(nu_diag,1031) ' snw_rhos_fname = ',trim(snw_rhos_fname) + write(nu_diag,1031) ' snw_Tgrd_fname = ',trim(snw_Tgrd_fname) + write(nu_diag,1031) ' snw_T_fname = ',trim(snw_T_fname) + write(nu_diag,1031) ' snw_tau_fname = ',trim(snw_tau_fname) + write(nu_diag,1031) ' snw_kappa_fname = ',trim(snw_kappa_fname) + write(nu_diag,1031) ' snw_drdt0_fname = ',trim(snw_drdt0_fname) + endif + endif + endif + write(nu_diag,*) ' ' write(nu_diag,*) ' Primary state variables, tracers' write(nu_diag,*) ' (excluding biogeochemistry)' @@ -1623,6 +1859,7 @@ subroutine input_data if (tr_pond_lvl) write(nu_diag,1010) ' tr_pond_lvl = ', tr_pond_lvl,' : level-ice pond formulation' if (tr_pond_topo) write(nu_diag,1010) ' tr_pond_topo = ', tr_pond_topo,' : topo pond formulation' if (tr_pond_cesm) write(nu_diag,1010) ' tr_pond_cesm = ', tr_pond_cesm,' : CESM pond formulation' + if (tr_snow) write(nu_diag,1010) ' tr_snow = ', tr_snow,' : advanced snow physics' if (tr_iage) write(nu_diag,1010) ' tr_iage = ', tr_iage,' : chronological ice age' if (tr_FY) write(nu_diag,1010) ' tr_FY = ', tr_FY,' : first-year ice area' if (tr_iso) write(nu_diag,1010) ' tr_iso = ', tr_iso,' : diagnostic isotope tracers' @@ -1649,11 +1886,16 @@ subroutine input_data write(nu_diag,1011) ' print_points = ', print_points write(nu_diag,1011) ' debug_model = ', debug_model write(nu_diag,1022) ' debug_model_step = ', debug_model_step + write(nu_diag,1021) ' debug_model_i = ', debug_model_i + write(nu_diag,1021) ' debug_model_i = ', debug_model_j + write(nu_diag,1021) ' debug_model_iblk = ', debug_model_iblk + write(nu_diag,1021) ' debug_model_task = ', debug_model_task write(nu_diag,1031) ' bfbflag = ', trim(bfbflag) write(nu_diag,1021) ' numin = ', numin write(nu_diag,1021) ' numax = ', numax write(nu_diag,1033) ' histfreq = ', histfreq(:) write(nu_diag,1023) ' histfreq_n = ', histfreq_n(:) + write(nu_diag,1031) ' histfreq_base = ', trim(histfreq_base) write(nu_diag,1011) ' hist_avg = ', hist_avg if (.not. hist_avg) write(nu_diag,1039) ' History data will be snapshots' write(nu_diag,1031) ' history_dir = ', trim(history_dir) @@ -1666,6 +1908,7 @@ subroutine input_data endif write(nu_diag,1031) ' dumpfreq = ', trim(dumpfreq) write(nu_diag,1021) ' dumpfreq_n = ', dumpfreq_n + write(nu_diag,1031) ' dumpfreq_base = ', trim(dumpfreq_base) write(nu_diag,1011) ' dump_last = ', dump_last write(nu_diag,1011) ' restart = ', restart write(nu_diag,1031) ' restart_dir = ', trim(restart_dir) @@ -1738,6 +1981,7 @@ subroutine input_data write(nu_diag,1011) ' restart_pond_cesm= ', restart_pond_cesm write(nu_diag,1011) ' restart_pond_lvl = ', restart_pond_lvl write(nu_diag,1011) ' restart_pond_topo= ', restart_pond_topo + write(nu_diag,1011) ' restart_snow = ', restart_snow write(nu_diag,1011) ' restart_iso = ', restart_iso write(nu_diag,1011) ' restart_aero = ', restart_aero write(nu_diag,1011) ' restart_fsd = ', restart_fsd @@ -1761,24 +2005,17 @@ subroutine input_data grid_type /= 'rectangular' .and. & grid_type /= 'cpom_grid' .and. & grid_type /= 'regional' .and. & - grid_type /= 'latlon' ) then + grid_type /= 'latlon' .and. & + grid_type /= 'setmask' ) then if (my_task == master_task) write(nu_diag,*) subname//' ERROR: unknown grid_type=',trim(grid_type) abort_list = trim(abort_list)//":20" endif - ! check for valid kevp_kernel - ! tcraig, kevp_kernel=2 is not validated, do not allow use - ! use "102" to test "2" for now - if (kevp_kernel /= 0) then - if (kevp_kernel == 102) then - kevp_kernel = 2 - else - if (my_task == master_task) write(nu_diag,*) subname//' ERROR: kevp_kernel = ',kevp_kernel - if (kevp_kernel == 2) then - if (my_task == master_task) write(nu_diag,*) subname//' kevp_kernel=2 not validated, use kevp_kernel=102 for testing until it is validated' - endif - abort_list = trim(abort_list)//":21" - endif + if (kdyn == 1 .and. & + evp_algorithm /= 'standard_2d' .and. & + evp_algorithm /= 'shared_mem_1d') then + if (my_task == master_task) write(nu_diag,*) subname//' ERROR: unknown evp_algorithm=',trim(evp_algorithm) + abort_list = trim(abort_list)//":21" endif if (abort_list /= "") then @@ -1808,11 +2045,15 @@ subroutine input_data wave_spec_type_in = wave_spec_type, & wave_spec_in=wave_spec, nfreq_in=nfreq, & tfrz_option_in=tfrz_option, kalg_in=kalg, fbot_xfer_type_in=fbot_xfer_type, & - Pstar_in=Pstar, Cstar_in=Cstar, iceruf_in=iceruf, & + Pstar_in=Pstar, Cstar_in=Cstar, iceruf_in=iceruf, iceruf_ocn_in=iceruf_ocn, calc_dragio_in=calc_dragio, & + windmin_in=windmin, drhosdwind_in=drhosdwind, & + rsnw_fall_in=rsnw_fall, rsnw_tmax_in=rsnw_tmax, rhosnew_in=rhosnew, & + snwlvlfac_in=snwlvlfac, rhosmin_in=rhosmin, rhosmax_in=rhosmax, & + snwredist_in=snwredist, snwgrain_in=snwgrain, snw_aging_table_in=trim(snw_aging_table), & sw_redist_in=sw_redist, sw_frac_in=sw_frac, sw_dtemp_in=sw_dtemp) call icepack_init_tracer_flags(tr_iage_in=tr_iage, tr_FY_in=tr_FY, & tr_lvl_in=tr_lvl, tr_iso_in=tr_iso, tr_aero_in=tr_aero, & - tr_fsd_in=tr_fsd, tr_pond_in=tr_pond, & + tr_fsd_in=tr_fsd, tr_snow_in=tr_snow, tr_pond_in=tr_pond, & tr_pond_cesm_in=tr_pond_cesm, tr_pond_lvl_in=tr_pond_lvl, tr_pond_topo_in=tr_pond_topo) call icepack_init_tracer_sizes(ncat_in=ncat, nilyr_in=nilyr, nslyr_in=nslyr, nblyr_in=nblyr, & nfsd_in=nfsd, n_algae_in=n_algae, n_iso_in=n_iso, n_aero_in=n_aero, & @@ -1870,10 +2111,12 @@ subroutine init_state heat_capacity ! from icepack integer (kind=int_kind) :: ntrcr - logical (kind=log_kind) :: tr_iage, tr_FY, tr_lvl, tr_iso, tr_aero, tr_fsd + logical (kind=log_kind) :: tr_iage, tr_FY, tr_lvl, tr_iso, tr_aero logical (kind=log_kind) :: tr_pond_cesm, tr_pond_lvl, tr_pond_topo + logical (kind=log_kind) :: tr_snow, tr_fsd 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 + integer (kind=int_kind) :: nt_smice, nt_smliq, nt_rhos, nt_rsnw integer (kind=int_kind) :: nt_isosno, nt_isoice, nt_aero, nt_fsd type (block) :: & @@ -1886,12 +2129,15 @@ subroutine init_state call icepack_query_parameters(heat_capacity_out=heat_capacity) call icepack_query_tracer_sizes(ntrcr_out=ntrcr) call icepack_query_tracer_flags(tr_iage_out=tr_iage, tr_FY_out=tr_FY, & - tr_lvl_out=tr_lvl, tr_iso_out=tr_iso, tr_aero_out=tr_aero, tr_fsd_out=tr_fsd, & - tr_pond_cesm_out=tr_pond_cesm, tr_pond_lvl_out=tr_pond_lvl, tr_pond_topo_out=tr_pond_topo) + tr_lvl_out=tr_lvl, tr_iso_out=tr_iso, tr_aero_out=tr_aero, & + tr_pond_cesm_out=tr_pond_cesm, tr_pond_lvl_out=tr_pond_lvl, tr_pond_topo_out=tr_pond_topo, & + tr_snow_out=tr_snow, tr_fsd_out=tr_fsd) call icepack_query_tracer_indices(nt_Tsfc_out=nt_Tsfc, nt_sice_out=nt_sice, & nt_qice_out=nt_qice, nt_qsno_out=nt_qsno, nt_iage_out=nt_iage, nt_fy_out=nt_fy, & 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_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) @@ -1968,6 +2214,14 @@ subroutine init_state trcr_depend(nt_hpnd) = 2+nt_apnd ! melt pond depth trcr_depend(nt_ipnd) = 2+nt_apnd ! refrozen pond lid endif + if (tr_snow) then ! snow-volume-weighted snow tracers + do k = 1, nslyr + trcr_depend(nt_smice + k - 1) = 2 ! ice mass in snow + trcr_depend(nt_smliq + k - 1) = 2 ! liquid mass in snow + trcr_depend(nt_rhos + k - 1) = 2 ! effective snow density + trcr_depend(nt_rsnw + k - 1) = 2 ! snow radius + enddo + endif if (tr_fsd) then do it = 1, nfsd trcr_depend(nt_fsd + it - 1) = 0 ! area-weighted floe size distribution @@ -2198,7 +2452,7 @@ subroutine set_state_var (nx_block, ny_block, & indxi, indxj ! compressed indices for cells with aicen > puny real (kind=dbl_kind) :: & - Tsfc, sum, hbar, puny, rhos, Lfresh, rad_to_deg + Tsfc, sum, hbar, puny, rhos, Lfresh, rad_to_deg, rsnw_fall real (kind=dbl_kind), dimension(ncat) :: & ainit, hinit ! initial area, thickness @@ -2214,22 +2468,26 @@ subroutine set_state_var (nx_block, ny_block, & edge_init_nh = 70._dbl_kind, & ! initial ice edge, N.Hem. (deg) edge_init_sh = -60._dbl_kind ! initial ice edge, S.Hem. (deg) - logical (kind=log_kind) :: tr_brine, tr_lvl + logical (kind=log_kind) :: tr_brine, tr_lvl, tr_snow integer (kind=int_kind) :: ntrcr integer (kind=int_kind) :: nt_Tsfc, nt_qice, nt_qsno, nt_sice integer (kind=int_kind) :: nt_fbri, nt_alvl, nt_vlvl + integer (kind=int_kind) :: nt_smice, nt_smliq, nt_rhos, nt_rsnw character(len=*), parameter :: subname='(set_state_var)' !----------------------------------------------------------------- call icepack_query_tracer_sizes(ntrcr_out=ntrcr) - call icepack_query_tracer_flags(tr_brine_out=tr_brine, tr_lvl_out=tr_lvl) + call icepack_query_tracer_flags(tr_brine_out=tr_brine, tr_lvl_out=tr_lvl, & + tr_snow_out=tr_snow) call icepack_query_tracer_indices( nt_Tsfc_out=nt_Tsfc, nt_qice_out=nt_qice, & nt_qsno_out=nt_qsno, nt_sice_out=nt_sice, & - nt_fbri_out=nt_fbri, nt_alvl_out=nt_alvl, nt_vlvl_out=nt_vlvl) + nt_fbri_out=nt_fbri, nt_alvl_out=nt_alvl, nt_vlvl_out=nt_vlvl, & + nt_smice_out=nt_smice, nt_smliq_out=nt_smliq, & + nt_rhos_out=nt_rhos, nt_rsnw_out=nt_rsnw) call icepack_query_parameters(rhos_out=rhos, Lfresh_out=Lfresh, puny_out=puny, & - rad_to_deg_out=rad_to_deg) + rad_to_deg_out=rad_to_deg, rsnw_fall_out=rsnw_fall) call icepack_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & file=__FILE__, line=__LINE__) @@ -2261,6 +2519,14 @@ subroutine set_state_var (nx_block, ny_block, & do k = 1, nslyr trcrn(i,j,nt_qsno+k-1,n) = -rhos * Lfresh enddo + if (tr_snow) then + do k = 1, nslyr + trcrn(i,j,nt_rsnw +k-1,n) = rsnw_fall + trcrn(i,j,nt_rhos +k-1,n) = rhos + trcrn(i,j,nt_smice+k-1,n) = rhos + trcrn(i,j,nt_smliq+k-1,n) = c0 + enddo ! nslyr + endif enddo enddo enddo diff --git a/cicecore/cicedynB/infrastructure/ice_grid.F90 b/cicecore/cicedynB/infrastructure/ice_grid.F90 index f22d084f6..9e72a2157 100644 --- a/cicecore/cicedynB/infrastructure/ice_grid.F90 +++ b/cicecore/cicedynB/infrastructure/ice_grid.F90 @@ -19,7 +19,8 @@ module ice_grid use ice_kinds_mod use ice_broadcast, only: broadcast_scalar, broadcast_array - use ice_boundary, only: ice_HaloUpdate, ice_HaloExtrapolate + use ice_boundary, only: ice_HaloUpdate, ice_HaloExtrapolate, & + primary_grid_lengths_global_ext use ice_communicate, only: my_task, master_task use ice_blocks, only: block, get_block, nx_block, ny_block, nghost use ice_domain_size, only: nx_global, ny_global, max_blocks @@ -77,13 +78,17 @@ module ice_grid ocn_gridcell_frac ! only relevant for lat-lon grids ! gridcell value of [1 - (land fraction)] (T-cell) + real (kind=dbl_kind), dimension (:,:), allocatable, public :: & + G_HTE , & ! length of eastern edge of T-cell (global ext.) + G_HTN ! length of northern edge of T-cell (global ext.) + real (kind=dbl_kind), dimension (:,:,:), allocatable, public :: & - cyp , & ! 1.5*HTE - 0.5*HTE - cxp , & ! 1.5*HTN - 0.5*HTN - cym , & ! 0.5*HTE - 1.5*HTE - cxm , & ! 0.5*HTN - 1.5*HTN - dxhy , & ! 0.5*(HTE - HTE) - dyhx ! 0.5*(HTN - HTN) + cyp , & ! 1.5*HTE(i,j)-0.5*HTW(i,j) = 1.5*HTE(i,j)-0.5*HTE(i-1,j) + cxp , & ! 1.5*HTN(i,j)-0.5*HTS(i,j) = 1.5*HTN(i,j)-0.5*HTN(i,j-1) + cym , & ! 0.5*HTE(i,j)-1.5*HTW(i,j) = 0.5*HTE(i,j)-1.5*HTE(i-1,j) + cxm , & ! 0.5*HTN(i,j)-1.5*HTS(i,j) = 0.5*HTN(i,j)-1.5*HTN(i,j-1) + dxhy , & ! 0.5*(HTE(i,j) - HTW(i,j)) = 0.5*(HTE(i,j) - HTE(i-1,j)) + dyhx ! 0.5*(HTN(i,j) - HTS(i,j)) = 0.5*(HTN(i,j) - HTN(i,j-1)) ! grid dimensions for rectangular grid real (kind=dbl_kind), public :: & @@ -125,7 +130,8 @@ module ice_grid kmt ! ocean topography mask for bathymetry (T-cell) logical (kind=log_kind), public :: & - use_bathymetry ! flag for reading in bathymetry_file + use_bathymetry, & ! flag for reading in bathymetry_file + pgl_global_ext ! flag for init primary grid lengths (global ext.) logical (kind=log_kind), & dimension (:,:,:), allocatable, public :: & @@ -153,6 +159,8 @@ subroutine alloc_grid integer (int_kind) :: ierr + character(len=*), parameter :: subname = '(alloc_grid)' + allocate( & dxt (nx_block,ny_block,max_blocks), & ! width of T-cell through the middle (m) dyt (nx_block,ny_block,max_blocks), & ! height of T-cell through the middle (m) @@ -175,12 +183,12 @@ subroutine alloc_grid ANGLET (nx_block,ny_block,max_blocks), & ! ANGLE converted to T-cells bathymetry(nx_block,ny_block,max_blocks),& ! ocean depth, for grounding keels and bergs (m) ocn_gridcell_frac(nx_block,ny_block,max_blocks),& ! only relevant for lat-lon grids - cyp (nx_block,ny_block,max_blocks), & ! 1.5*HTE - 0.5*HTE - cxp (nx_block,ny_block,max_blocks), & ! 1.5*HTN - 0.5*HTN - cym (nx_block,ny_block,max_blocks), & ! 0.5*HTE - 1.5*HTE - cxm (nx_block,ny_block,max_blocks), & ! 0.5*HTN - 1.5*HTN - dxhy (nx_block,ny_block,max_blocks), & ! 0.5*(HTE - HTE) - dyhx (nx_block,ny_block,max_blocks), & ! 0.5*(HTN - HTN) + cyp (nx_block,ny_block,max_blocks), & ! 1.5*HTE - 0.5*HTW + cxp (nx_block,ny_block,max_blocks), & ! 1.5*HTN - 0.5*HTS + cym (nx_block,ny_block,max_blocks), & ! 0.5*HTE - 1.5*HTW + cxm (nx_block,ny_block,max_blocks), & ! 0.5*HTN - 1.5*HTS + dxhy (nx_block,ny_block,max_blocks), & ! 0.5*(HTE - HTW) + dyhx (nx_block,ny_block,max_blocks), & ! 0.5*(HTN - HTS) xav (nx_block,ny_block,max_blocks), & ! mean T-cell value of x yav (nx_block,ny_block,max_blocks), & ! mean T-cell value of y xxav (nx_block,ny_block,max_blocks), & ! mean T-cell value of xx @@ -203,7 +211,15 @@ subroutine alloc_grid mse (2,2,nx_block,ny_block,max_blocks), & msw (2,2,nx_block,ny_block,max_blocks), & stat=ierr) - if (ierr/=0) call abort_ice('(alloc_grid): Out of memory') + if (ierr/=0) call abort_ice(subname//'ERROR: Out of memory') + + if (pgl_global_ext) then + allocate( & + G_HTE(nx_global+2*nghost, ny_global+2*nghost), & ! length of eastern edge of T-cell (global ext.) + G_HTN(nx_global+2*nghost, ny_global+2*nghost), & ! length of northern edge of T-cell (global ext.) + stat=ierr) + if (ierr/=0) call abort_ice(subname//'ERROR: Out of memory') + endif end subroutine alloc_grid @@ -1490,6 +1506,10 @@ subroutine primary_grid_lengths_HTN(work_g) enddo enddo endif + if (pgl_global_ext) then + call primary_grid_lengths_global_ext( & + G_HTN, work_g, ew_boundary_type, ns_boundary_type) + endif call scatter_global(HTN, work_g, master_task, distrb_info, & field_loc_Nface, field_type_scalar) call scatter_global(dxu, work_g2, master_task, distrb_info, & @@ -1564,6 +1584,10 @@ subroutine primary_grid_lengths_HTE(work_g) enddo endif endif + if (pgl_global_ext) then + call primary_grid_lengths_global_ext( & + G_HTE, work_g, ew_boundary_type, ns_boundary_type) + endif call scatter_global(HTE, work_g, master_task, distrb_info, & field_loc_Eface, field_type_scalar) call scatter_global(dyu, work_g2, master_task, distrb_info, & diff --git a/cicecore/cicedynB/infrastructure/ice_read_write.F90 b/cicecore/cicedynB/infrastructure/ice_read_write.F90 index b8b749482..bf0361cf1 100644 --- a/cicecore/cicedynB/infrastructure/ice_read_write.F90 +++ b/cicecore/cicedynB/infrastructure/ice_read_write.F90 @@ -68,6 +68,9 @@ module ice_read_write ice_read_nc_xyz, & !ice_read_nc_xyf, & ice_read_nc_point, & + ice_read_nc_1D, & + ice_read_nc_2D, & + ice_read_nc_3D, & ice_read_nc_z end interface @@ -1329,7 +1332,7 @@ subroutine ice_read_nc_xyz(fid, nrec, varname, work, diag, & amin, amax, asum ! min, max values and sum of input array ! character (char_len) :: & -! dimname ! dimension name +! dimname ! dimension name real (kind=dbl_kind), dimension(:,:,:), allocatable :: & work_g1 @@ -1546,7 +1549,7 @@ subroutine ice_read_nc_xyf(fid, nrec, varname, work, diag, & amin, amax, asum ! min, max values and sum of input array character (char_len) :: & - dimname ! dimension name + dimname ! dimension name real (kind=dbl_kind), dimension(:,:,:), allocatable :: & work_g1 @@ -1759,7 +1762,7 @@ subroutine ice_read_nc_point(fid, nrec, varname, work, diag, & integer (kind=int_kind) :: lnrec ! local value of nrec character (char_len) :: & - dimname ! dimension name + dimname ! dimension name lnrec = nrec @@ -1837,6 +1840,277 @@ end subroutine ice_read_nc_point !======================================================================= +! Written by T. Craig + + subroutine ice_read_nc_1D(fid, varname, work, diag, & + xdim) + + use ice_fileunits, only: nu_diag + + integer (kind=int_kind), intent(in) :: & + fid , & ! file id + xdim ! field dimensions + + logical (kind=log_kind), intent(in) :: & + diag ! if true, write diagnostic output + + character (char_len), intent(in) :: & + varname ! field name in netcdf file + + real (kind=dbl_kind), dimension(:), intent(out) :: & + work ! output array + + ! local variables + + character(len=*), parameter :: subname = '(ice_read_nc_1D)' + +#ifdef USE_NETCDF +! netCDF file diagnostics: + integer (kind=int_kind) :: & + varid, & ! netcdf id for field + status, & ! status output from netcdf routines + ndim, nvar, & ! sizes of netcdf file + dimlen ! size of dimension + + character (char_len) :: & + dimname ! dimension name + + real (kind=dbl_kind), dimension(xdim) :: & + workg ! output array (real, 8-byte) + + !-------------------------------------------------------------- + + if (my_task == master_task) then + + if (size(work,dim=1) < xdim) then + write(nu_diag,*) subname,' work, dim=1 ',size(work,dim=1),xdim + call abort_ice (subname//' ERROR: work array wrong size '//trim(varname), & + file=__FILE__, line=__LINE__ ) + endif + !------------------------------------------------------------- + ! Find out ID of required variable + !------------------------------------------------------------- + + status = nf90_inq_varid(fid, trim(varname), varid) + + if (status /= nf90_noerr) then + call abort_ice (subname//' ERROR: Cannot find variable '//trim(varname), & + file=__FILE__, line=__LINE__ ) + endif + + !-------------------------------------------------------------- + ! Read array + !-------------------------------------------------------------- + status = nf90_get_var( fid, varid, workg, & + start=(/1/), & + count=(/xdim/) ) + work(1:xdim) = workg(1:xdim) + + !------------------------------------------------------------------- + ! optional diagnostics + !------------------------------------------------------------------- + + if (diag) then + write(nu_diag,*) subname, & + ' fid= ',fid, ', xdim = ',xdim, & + ' varname = ',trim(varname) + status = nf90_inquire(fid, nDimensions=ndim, nVariables=nvar) + write(nu_diag,*) 'ndim= ',ndim,', nvar= ',nvar + endif + endif +#else + call abort_ice(subname//'ERROR: USE_NETCDF cpp not defined', & + file=__FILE__, line=__LINE__) + work = c0 ! to satisfy intent(out) attribute +#endif + + end subroutine ice_read_nc_1D + +!======================================================================= + +! Written by T. Craig + + subroutine ice_read_nc_2D(fid, varname, work, diag, & + xdim, ydim) + + use ice_fileunits, only: nu_diag + + integer (kind=int_kind), intent(in) :: & + fid , & ! file id + xdim, ydim ! field dimensions + + logical (kind=log_kind), intent(in) :: & + diag ! if true, write diagnostic output + + character (char_len), intent(in) :: & + varname ! field name in netcdf file + + real (kind=dbl_kind), dimension(:,:), intent(out) :: & + work ! output array + + ! local variables + + character(len=*), parameter :: subname = '(ice_read_nc_2D)' + +#ifdef USE_NETCDF +! netCDF file diagnostics: + integer (kind=int_kind) :: & + varid, & ! netcdf id for field + status, & ! status output from netcdf routines + ndim, nvar, & ! sizes of netcdf file + dimlen ! size of dimension + + character (char_len) :: & + dimname ! dimension name + + real (kind=dbl_kind), dimension(xdim,ydim) :: & + workg ! output array (real, 8-byte) + + !-------------------------------------------------------------- + + if (my_task == master_task) then + + if (size(work,dim=1) < xdim .or. & + size(work,dim=2) < ydim) then + write(nu_diag,*) subname,' work, dim=1 ',size(work,dim=1),xdim + write(nu_diag,*) subname,' work, dim=2 ',size(work,dim=2),ydim + call abort_ice (subname//' ERROR: work array wrong size '//trim(varname), & + file=__FILE__, line=__LINE__ ) + endif + !------------------------------------------------------------- + ! Find out ID of required variable + !------------------------------------------------------------- + + status = nf90_inq_varid(fid, trim(varname), varid) + + if (status /= nf90_noerr) then + call abort_ice (subname//' ERROR: Cannot find variable '//trim(varname), & + file=__FILE__, line=__LINE__ ) + endif + + !-------------------------------------------------------------- + ! Read array + !-------------------------------------------------------------- + status = nf90_get_var( fid, varid, workg, & + start=(/1,1/), & + count=(/xdim,ydim/) ) + work(1:xdim,1:ydim) = workg(1:xdim, 1:ydim) + + !------------------------------------------------------------------- + ! optional diagnostics + !------------------------------------------------------------------- + + if (diag) then + write(nu_diag,*) subname, & + ' fid= ',fid, ', xdim = ',xdim, & + ' ydim= ', ydim, ' varname = ',trim(varname) + status = nf90_inquire(fid, nDimensions=ndim, nVariables=nvar) + write(nu_diag,*) 'ndim= ',ndim,', nvar= ',nvar + endif + endif +#else + call abort_ice(subname//'ERROR: USE_NETCDF cpp not defined', & + file=__FILE__, line=__LINE__) + work = c0 ! to satisfy intent(out) attribute +#endif + + end subroutine ice_read_nc_2D + +!======================================================================= +!======================================================================= + +! Written by T. Craig + + subroutine ice_read_nc_3D(fid, varname, work, diag, & + xdim, ydim, zdim) + + use ice_fileunits, only: nu_diag + + integer (kind=int_kind), intent(in) :: & + fid , & ! file id + xdim, ydim,zdim ! field dimensions + + logical (kind=log_kind), intent(in) :: & + diag ! if true, write diagnostic output + + character (char_len), intent(in) :: & + varname ! field name in netcdf file + + real (kind=dbl_kind), dimension(:,:,:), intent(out) :: & + work ! output array + + ! local variables + + character(len=*), parameter :: subname = '(ice_read_nc_3D)' + +#ifdef USE_NETCDF +! netCDF file diagnostics: + integer (kind=int_kind) :: & + varid, & ! netcdf id for field + status, & ! status output from netcdf routines + ndim, nvar, & ! sizes of netcdf file + dimlen ! size of dimension + + character (char_len) :: & + dimname ! dimension name + + real (kind=dbl_kind), dimension(xdim,ydim,zdim) :: & + workg ! output array (real, 8-byte) + + !-------------------------------------------------------------- + + if (my_task == master_task) then + + if (size(work,dim=1) < xdim .or. & + size(work,dim=2) < ydim .or. & + size(work,dim=3) < zdim ) then + write(nu_diag,*) subname,' work, dim=1 ',size(work,dim=1),xdim + write(nu_diag,*) subname,' work, dim=2 ',size(work,dim=2),ydim + write(nu_diag,*) subname,' work, dim=3 ',size(work,dim=3),zdim + call abort_ice (subname//' ERROR: work array wrong size '//trim(varname), & + file=__FILE__, line=__LINE__ ) + endif + !------------------------------------------------------------- + ! Find out ID of required variable + !------------------------------------------------------------- + + status = nf90_inq_varid(fid, trim(varname), varid) + + if (status /= nf90_noerr) then + call abort_ice (subname//' ERROR: Cannot find variable '//trim(varname), & + file=__FILE__, line=__LINE__ ) + endif + + !-------------------------------------------------------------- + ! Read array + !-------------------------------------------------------------- + status = nf90_get_var( fid, varid, workg, & + start=(/1,1,1/), & + count=(/xdim,ydim,zdim/) ) + work(1:xdim,1:ydim,1:zdim) = workg(1:xdim, 1:ydim, 1:zdim) + + !------------------------------------------------------------------- + ! optional diagnostics + !------------------------------------------------------------------- + + if (diag) then + write(nu_diag,*) subname, & + ' fid= ',fid, ', xdim = ',xdim, & + ' ydim= ', ydim,' zdim = ',zdim, ' varname = ',trim(varname) + status = nf90_inquire(fid, nDimensions=ndim, nVariables=nvar) + write(nu_diag,*) 'ndim= ',ndim,', nvar= ',nvar + endif + endif +#else + call abort_ice(subname//'ERROR: USE_NETCDF cpp not defined', & + file=__FILE__, line=__LINE__) + work = c0 ! to satisfy intent(out) attribute +#endif + + end subroutine ice_read_nc_3D + +!======================================================================= + ! Adapted by Nicole Jeffery, LANL subroutine ice_read_nc_z(fid, nrec, varname, work, diag, & @@ -2012,7 +2286,7 @@ subroutine ice_write_nc_xy(fid, nrec, varid, work, diag, & character (char_len) :: & lvarname ! variable name -! dimname ! dimension name +! dimname ! dimension name real (kind=dbl_kind), dimension(:,:), allocatable :: & work_g1 @@ -2136,7 +2410,7 @@ subroutine ice_write_nc_xyz(fid, nrec, varid, work, diag, & character (char_len) :: & lvarname ! variable name -! dimname ! dimension name +! dimname ! dimension name real (kind=dbl_kind), dimension(:,:,:), allocatable :: & work_g1 @@ -2265,7 +2539,7 @@ subroutine ice_read_global_nc (fid, nrec, varname, work_g, diag) amin, amax, asum ! min, max values and sum of input array ! character (char_len) :: & -! dimname ! dimension name +! dimname ! dimension name ! real (kind=dbl_kind), dimension(:,:), allocatable :: & work_g3 @@ -2428,7 +2702,7 @@ subroutine ice_read_nc_uv(fid, nrec, nzlev, varname, work, diag, & amin, amax, asum ! min, max values and sum of input array ! character (char_len) :: & -! dimname ! dimension name +! dimname ! dimension name real (kind=dbl_kind), dimension(:,:), allocatable :: & work_g1 diff --git a/cicecore/cicedynB/infrastructure/io/io_netcdf/ice_history_write.F90 b/cicecore/cicedynB/infrastructure/io/io_netcdf/ice_history_write.F90 index 9fe3a5bfe..493a91c1e 100644 --- a/cicecore/cicedynB/infrastructure/io/io_netcdf/ice_history_write.F90 +++ b/cicecore/cicedynB/infrastructure/io/io_netcdf/ice_history_write.F90 @@ -67,11 +67,9 @@ subroutine ice_write_hist (ns) ! local variables - real (kind=dbl_kind), dimension(:,:), allocatable :: work_g1 - real (kind=real_kind), dimension(:,:), allocatable :: work_gr - real (kind=real_kind), dimension(:,:,:), allocatable :: work_gr3 - real (kind=dbl_kind), dimension(nx_block,ny_block,max_blocks) :: & - work1 + real (kind=dbl_kind), dimension(:,:), allocatable :: work_g1 + real (kind=dbl_kind), dimension(:,:,:), allocatable :: work1_3 + real (kind=dbl_kind), dimension(nx_block,ny_block,max_blocks) :: work1 integer (kind=int_kind) :: i,k,ic,n,nn, & ncid,status,imtid,jmtid,kmtidi,kmtids,kmtidb, cmtid,timid,varid, & @@ -362,20 +360,7 @@ subroutine ice_write_hist (ns) status = nf90_put_att(ncid, varid, 'units', coord_var(i)%units) if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: defining units for '//coord_var(i)%short_name) - if (lprecision == nf90_float) then - status = nf90_put_att(ncid,varid,'missing_value',spval) - else - status = nf90_put_att(ncid,varid,'missing_value',spval_dbl) - endif - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: defining missing_value for '//coord_var(i)%short_name) - if (lprecision == nf90_float) then - status = nf90_put_att(ncid,varid,'_FillValue',spval) - else - status = nf90_put_att(ncid,varid,'_FillValue',spval_dbl) - endif - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: defining _FillValue for '//coord_var(i)%short_name) + call ice_write_hist_fill(ncid,varid,coord_var(i)%short_name,history_precision) if (coord_var(i)%short_name == 'ULAT') then status = nf90_put_att(ncid,varid,'comment', & 'Latitude of NE corner of T grid cell') @@ -422,18 +407,7 @@ subroutine ice_write_hist (ns) if (status /= nf90_noerr) call abort_ice(subname//'ERROR: tmask units') status = nf90_put_att(ncid,varid,'comment', '0 = land, 1 = ocean') if (status /= nf90_noerr) call abort_ice(subname//'ERROR: tmask comment') - if (lprecision == nf90_float) then - status = nf90_put_att(ncid,varid,'missing_value',spval) - else - status = nf90_put_att(ncid,varid,'missing_value',spval_dbl) - endif - if (status /= nf90_noerr) call abort_ice(subname//'ERROR: defining missing_value for tmask') - if (lprecision == nf90_float) then - status = nf90_put_att(ncid,varid,'_FillValue',spval) - else - status = nf90_put_att(ncid,varid,'_FillValue',spval_dbl) - endif - if (status /= nf90_noerr) call abort_ice(subname//'ERROR: defining _FillValue for tmask') + call ice_write_hist_fill(ncid,varid,'tmask',history_precision) endif if (igrd(n_blkmask)) then @@ -445,18 +419,7 @@ subroutine ice_write_hist (ns) if (status /= nf90_noerr) call abort_ice(subname//'ERROR: blkmask units') status = nf90_put_att(ncid,varid,'comment', 'mytask + iblk/100') if (status /= nf90_noerr) call abort_ice(subname//'ERROR: blkmask comment') - if (lprecision == nf90_float) then - status = nf90_put_att(ncid,varid,'missing_value',spval) - else - status = nf90_put_att(ncid,varid,'missing_value',spval_dbl) - endif - if (status /= nf90_noerr) call abort_ice(subname//'ERROR: defining missing_value for blkmask') - if (lprecision == nf90_float) then - status = nf90_put_att(ncid,varid,'_FillValue',spval) - else - status = nf90_put_att(ncid,varid,'_FillValue',spval_dbl) - endif - if (status /= nf90_noerr) call abort_ice(subname//'ERROR: defining _FillValue for blkmask') + call ice_write_hist_fill(ncid,varid,'blkmask',history_precision) endif do i = 3, nvar ! note n_tmask=1, n_blkmask=2 @@ -474,20 +437,7 @@ subroutine ice_write_hist (ns) status = nf90_put_att(ncid, varid, 'coordinates', var(i)%coordinates) if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: defining coordinates for '//var(i)%req%short_name) - if (lprecision == nf90_float) then - status = nf90_put_att(ncid,varid,'missing_value',spval) - else - status = nf90_put_att(ncid,varid,'missing_value',spval_dbl) - endif - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: defining missing_value for '//var(i)%req%short_name) - if (lprecision == nf90_float) then - status = nf90_put_att(ncid,varid,'_FillValue',spval) - else - status = nf90_put_att(ncid,varid,'_FillValue',spval_dbl) - endif - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: defining _FillValue for '//var(i)%req%short_name) + call ice_write_hist_fill(ncid,varid,var(i)%req%short_name,history_precision) endif enddo @@ -507,20 +457,7 @@ subroutine ice_write_hist (ns) status = nf90_put_att(ncid, varid, 'units', var_nverts(i)%units) if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: defining units for '//var_nverts(i)%short_name) - if (lprecision == nf90_float) then - status = nf90_put_att(ncid,varid,'missing_value',spval) - else - status = nf90_put_att(ncid,varid,'missing_value',spval_dbl) - endif - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: defining missing_value for '//var_nverts(i)%short_name) - if (lprecision == nf90_float) then - status = nf90_put_att(ncid,varid,'_FillValue',spval) - else - status = nf90_put_att(ncid,varid,'_FillValue',spval_dbl) - endif - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: defining _FillValue for '//var_nverts(i)%short_name) + call ice_write_hist_fill(ncid,varid,var_nverts(i)%short_name,history_precision) endif enddo @@ -546,20 +483,7 @@ subroutine ice_write_hist (ns) avail_hist_fields(n)%vcellmeas) if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: defining cell measures for '//avail_hist_fields(n)%vname) - if (lprecision == nf90_float) then - status = nf90_put_att(ncid,varid,'missing_value',spval) - else - status = nf90_put_att(ncid,varid,'missing_value',spval_dbl) - endif - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: defining missing_value for '//avail_hist_fields(n)%vname) - if (lprecision == nf90_float) then - status = nf90_put_att(ncid,varid,'_FillValue',spval) - else - status = nf90_put_att(ncid,varid,'_FillValue',spval_dbl) - endif - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: defining _FillValue for '//avail_hist_fields(n)%vname) + call ice_write_hist_fill(ncid,varid,avail_hist_fields(n)%vname,history_precision) !----------------------------------------------------------------- ! Add cell_methods attribute to variables if averaged @@ -618,20 +542,7 @@ subroutine ice_write_hist (ns) avail_hist_fields(n)%vcellmeas) if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: defining cell measures for '//avail_hist_fields(n)%vname) - if (lprecision == nf90_float) then - status = nf90_put_att(ncid,varid,'missing_value',spval) - else - status = nf90_put_att(ncid,varid,'missing_value',spval_dbl) - endif - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: defining missing_value for '//avail_hist_fields(n)%vname) - if (lprecision == nf90_float) then - status = nf90_put_att(ncid,varid,'_FillValue',spval) - else - status = nf90_put_att(ncid,varid,'_FillValue',spval_dbl) - endif - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: defining _FillValue for '//avail_hist_fields(n)%vname) + call ice_write_hist_fill(ncid,varid,avail_hist_fields(n)%vname,history_precision) !----------------------------------------------------------------- ! Add cell_methods attribute to variables if averaged @@ -678,20 +589,7 @@ subroutine ice_write_hist (ns) avail_hist_fields(n)%vcellmeas) if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: defining cell measures for '//avail_hist_fields(n)%vname) - if (lprecision == nf90_float) then - status = nf90_put_att(ncid,varid,'missing_value',spval) - else - status = nf90_put_att(ncid,varid,'missing_value',spval_dbl) - endif - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: defining missing_value for '//avail_hist_fields(n)%vname) - if (lprecision == nf90_float) then - status = nf90_put_att(ncid,varid,'_FillValue',spval) - else - status = nf90_put_att(ncid,varid,'_FillValue',spval_dbl) - endif - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: defining _FillValue for '//avail_hist_fields(n)%vname) + call ice_write_hist_fill(ncid,varid,avail_hist_fields(n)%vname,history_precision) endif enddo ! num_avail_hist_fields_3Dz @@ -723,20 +621,7 @@ subroutine ice_write_hist (ns) avail_hist_fields(n)%vcellmeas) if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: defining cell measures for '//avail_hist_fields(n)%vname) - if (lprecision == nf90_float) then - status = nf90_put_att(ncid,varid,'missing_value',spval) - else - status = nf90_put_att(ncid,varid,'missing_value',spval_dbl) - endif - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: defining missing_value for '//avail_hist_fields(n)%vname) - if (lprecision == nf90_float) then - status = nf90_put_att(ncid,varid,'_FillValue',spval) - else - status = nf90_put_att(ncid,varid,'_FillValue',spval_dbl) - endif - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: defining _FillValue for '//avail_hist_fields(n)%vname) + call ice_write_hist_fill(ncid,varid,avail_hist_fields(n)%vname,history_precision) endif enddo ! num_avail_hist_fields_3Db @@ -768,20 +653,7 @@ subroutine ice_write_hist (ns) avail_hist_fields(n)%vcellmeas) if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: defining cell measures for '//avail_hist_fields(n)%vname) - if (lprecision == nf90_float) then - status = nf90_put_att(ncid,varid,'missing_value',spval) - else - status = nf90_put_att(ncid,varid,'missing_value',spval_dbl) - endif - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: defining missing_value for '//avail_hist_fields(n)%vname) - if (lprecision == nf90_float) then - status = nf90_put_att(ncid,varid,'_FillValue',spval) - else - status = nf90_put_att(ncid,varid,'_FillValue',spval_dbl) - endif - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: defining _FillValue for '//avail_hist_fields(n)%vname) + call ice_write_hist_fill(ncid,varid,avail_hist_fields(n)%vname,history_precision) endif enddo ! num_avail_hist_fields_3Da @@ -813,20 +685,7 @@ subroutine ice_write_hist (ns) avail_hist_fields(n)%vcellmeas) if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: defining cell measures for '//avail_hist_fields(n)%vname) - if (lprecision == nf90_float) then - status = nf90_put_att(ncid,varid,'missing_value',spval) - else - status = nf90_put_att(ncid,varid,'missing_value',spval_dbl) - endif - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: defining missing_value for '//avail_hist_fields(n)%vname) - if (lprecision == nf90_float) then - status = nf90_put_att(ncid,varid,'_FillValue',spval) - else - status = nf90_put_att(ncid,varid,'_FillValue',spval_dbl) - endif - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: defining _FillValue for '//avail_hist_fields(n)%vname) + call ice_write_hist_fill(ncid,varid,avail_hist_fields(n)%vname,history_precision) endif enddo ! num_avail_hist_fields_3Df @@ -860,20 +719,7 @@ subroutine ice_write_hist (ns) avail_hist_fields(n)%vcellmeas) if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: defining cell measures for '//avail_hist_fields(n)%vname) - if (lprecision == nf90_float) then - status = nf90_put_att(ncid,varid,'missing_value',spval) - else - status = nf90_put_att(ncid,varid,'missing_value',spval_dbl) - endif - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: defining missing_value for '//avail_hist_fields(n)%vname) - if (lprecision == nf90_float) then - status = nf90_put_att(ncid,varid,'_FillValue',spval) - else - status = nf90_put_att(ncid,varid,'_FillValue',spval_dbl) - endif - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: defining _FillValue for '//avail_hist_fields(n)%vname) + call ice_write_hist_fill(ncid,varid,avail_hist_fields(n)%vname,history_precision) !----------------------------------------------------------------- ! Add cell_methods attribute to variables if averaged @@ -922,20 +768,7 @@ subroutine ice_write_hist (ns) avail_hist_fields(n)%vcellmeas) if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: defining cell measures for '//avail_hist_fields(n)%vname) - if (lprecision == nf90_float) then - status = nf90_put_att(ncid,varid,'missing_value',spval) - else - status = nf90_put_att(ncid,varid,'missing_value',spval_dbl) - endif - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: defining missing_value for '//avail_hist_fields(n)%vname) - if (lprecision == nf90_float) then - status = nf90_put_att(ncid,varid,'_FillValue',spval) - else - status = nf90_put_att(ncid,varid,'_FillValue',spval_dbl) - endif - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: defining _FillValue for '//avail_hist_fields(n)%vname) + call ice_write_hist_fill(ncid,varid,avail_hist_fields(n)%vname,history_precision) !----------------------------------------------------------------- ! Add cell_methods attribute to variables if averaged @@ -984,20 +817,7 @@ subroutine ice_write_hist (ns) avail_hist_fields(n)%vcellmeas) if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: defining cell measures for '//avail_hist_fields(n)%vname) - if (lprecision == nf90_float) then - status = nf90_put_att(ncid,varid,'missing_value',spval) - else - status = nf90_put_att(ncid,varid,'missing_value',spval_dbl) - endif - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: defining missing_value for '//avail_hist_fields(n)%vname) - if (lprecision == nf90_float) then - status = nf90_put_att(ncid,varid,'_FillValue',spval) - else - status = nf90_put_att(ncid,varid,'_FillValue',spval_dbl) - endif - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: defining _FillValue for '//avail_hist_fields(n)%vname) + call ice_write_hist_fill(ncid,varid,avail_hist_fields(n)%vname,history_precision) !----------------------------------------------------------------- ! Add cell_methods attribute to variables if averaged @@ -1120,9 +940,7 @@ subroutine ice_write_hist (ns) if (my_task==master_task) then allocate(work_g1(nx_global,ny_global)) - allocate(work_gr(nx_global,ny_global)) else - allocate(work_gr(1,1)) ! to save memory allocate(work_g1(1,1)) endif @@ -1153,11 +971,10 @@ subroutine ice_write_hist (ns) END SELECT if (my_task == master_task) then - work_gr = work_g1 status = nf90_inq_varid(ncid, coord_var(i)%short_name, varid) if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: getting varid for '//coord_var(i)%short_name) - status = nf90_put_var(ncid,varid,work_gr) + status = nf90_put_var(ncid,varid,work_g1) if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: writing'//coord_var(i)%short_name) endif @@ -1199,11 +1016,10 @@ subroutine ice_write_hist (ns) if (igrd(n_tmask)) then call gather_global(work_g1, hm, master_task, distrb_info) if (my_task == master_task) then - work_gr=work_g1 status = nf90_inq_varid(ncid, 'tmask', varid) if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: getting varid for tmask') - status = nf90_put_var(ncid,varid,work_gr) + status = nf90_put_var(ncid,varid,work_g1) if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: writing variable tmask') endif @@ -1212,11 +1028,10 @@ subroutine ice_write_hist (ns) if (igrd(n_blkmask)) then call gather_global(work_g1, bm, master_task, distrb_info) if (my_task == master_task) then - work_gr=work_g1 status = nf90_inq_varid(ncid, 'blkmask', varid) if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: getting varid for blkmask') - status = nf90_put_var(ncid,varid,work_gr) + status = nf90_put_var(ncid,varid,work_g1) if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: writing variable blkmask') endif @@ -1249,31 +1064,28 @@ subroutine ice_write_hist (ns) END SELECT if (my_task == master_task) then - work_gr=work_g1 status = nf90_inq_varid(ncid, var(i)%req%short_name, varid) if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: getting varid for '//var(i)%req%short_name) - status = nf90_put_var(ncid,varid,work_gr) + status = nf90_put_var(ncid,varid,work_g1) if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: writing variable '//var(i)%req%short_name) endif endif enddo - deallocate(work_gr) - !---------------------------------------------------------------- ! Write coordinates of grid box vertices !---------------------------------------------------------------- if (f_bounds) then if (my_task==master_task) then - allocate(work_gr3(nverts,nx_global,ny_global)) + allocate(work1_3(nverts,nx_global,ny_global)) else - allocate(work_gr3(1,1,1)) ! to save memory + allocate(work1_3(1,1,1)) ! to save memory endif - work_gr3(:,:,:) = c0 + work1_3(:,:,:) = c0 work1 (:,:,:) = c0 do i = 1, nvar_verts @@ -1283,25 +1095,25 @@ subroutine ice_write_hist (ns) do ivertex = 1, nverts work1(:,:,:) = lont_bounds(ivertex,:,:,:) call gather_global(work_g1, work1, master_task, distrb_info) - if (my_task == master_task) work_gr3(ivertex,:,:) = work_g1(:,:) + if (my_task == master_task) work1_3(ivertex,:,:) = work_g1(:,:) enddo CASE ('latt_bounds') do ivertex = 1, nverts work1(:,:,:) = latt_bounds(ivertex,:,:,:) call gather_global(work_g1, work1, master_task, distrb_info) - if (my_task == master_task) work_gr3(ivertex,:,:) = work_g1(:,:) + if (my_task == master_task) work1_3(ivertex,:,:) = work_g1(:,:) enddo CASE ('lonu_bounds') do ivertex = 1, nverts work1(:,:,:) = lonu_bounds(ivertex,:,:,:) call gather_global(work_g1, work1, master_task, distrb_info) - if (my_task == master_task) work_gr3(ivertex,:,:) = work_g1(:,:) + if (my_task == master_task) work1_3(ivertex,:,:) = work_g1(:,:) enddo CASE ('latu_bounds') do ivertex = 1, nverts work1(:,:,:) = latu_bounds(ivertex,:,:,:) call gather_global(work_g1, work1, master_task, distrb_info) - if (my_task == master_task) work_gr3(ivertex,:,:) = work_g1(:,:) + if (my_task == master_task) work1_3(ivertex,:,:) = work_g1(:,:) enddo END SELECT @@ -1309,24 +1121,18 @@ subroutine ice_write_hist (ns) status = nf90_inq_varid(ncid, var_nverts(i)%short_name, varid) if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: getting varid for '//var_nverts(i)%short_name) - status = nf90_put_var(ncid,varid,work_gr3) + status = nf90_put_var(ncid,varid,work1_3) if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: writing variable '//var_nverts(i)%short_name) endif enddo - deallocate(work_gr3) + deallocate(work1_3) endif !----------------------------------------------------------------- ! write variable data !----------------------------------------------------------------- - if (my_task==master_task) then - allocate(work_gr(nx_global,ny_global)) - else - allocate(work_gr(1,1)) ! to save memory - endif - work_gr(:,:) = c0 work_g1(:,:) = c0 do n=1,num_avail_hist_fields_2D @@ -1334,19 +1140,18 @@ subroutine ice_write_hist (ns) call gather_global(work_g1, a2D(:,:,n,:), & master_task, distrb_info) if (my_task == master_task) then - work_gr(:,:) = work_g1(:,:) status = nf90_inq_varid(ncid,avail_hist_fields(n)%vname,varid) if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: getting varid for '//avail_hist_fields(n)%vname) - status = nf90_put_var(ncid,varid,work_gr(:,:), & + status = nf90_put_var(ncid,varid,work_g1, & count=(/nx_global,ny_global/)) if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: writing variable '//avail_hist_fields(n)%vname) endif + endif enddo ! num_avail_hist_fields_2D - work_gr(:,:) = c0 work_g1(:,:) = c0 do n = n2D + 1, n3Dccum @@ -1360,13 +1165,12 @@ subroutine ice_write_hist (ns) do k = 1, ncat_hist call gather_global(work_g1, a3Dc(:,:,k,nn,:), & master_task, distrb_info) - work_gr(:,:) = work_g1(:,:) if (my_task == master_task) then status = nf90_inq_varid(ncid,avail_hist_fields(n)%vname,varid) if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: getting varid for '//avail_hist_fields(n)%vname) - status = nf90_put_var(ncid,varid,work_gr(:,:), & + status = nf90_put_var(ncid,varid,work_g1, & start=(/ 1, 1,k/), & count=(/nx_global,ny_global,1/)) if (status /= nf90_noerr) call abort_ice(subname// & @@ -1376,7 +1180,6 @@ subroutine ice_write_hist (ns) endif enddo ! num_avail_hist_fields_3Dc - work_gr(:,:) = c0 work_g1(:,:) = c0 do n = n3Dccum+1, n3Dzcum @@ -1390,10 +1193,9 @@ subroutine ice_write_hist (ns) do k = 1, nzilyr call gather_global(work_g1, a3Dz(:,:,k,nn,:), & master_task, distrb_info) - work_gr(:,:) = work_g1(:,:) if (my_task == master_task) then - status = nf90_put_var(ncid,varid,work_gr(:,:), & + status = nf90_put_var(ncid,varid,work_g1, & start=(/ 1, 1,k/), & count=(/nx_global,ny_global,1/)) if (status /= nf90_noerr) call abort_ice(subname// & @@ -1403,7 +1205,6 @@ subroutine ice_write_hist (ns) endif enddo ! num_avail_hist_fields_3Dz - work_gr(:,:) = c0 work_g1(:,:) = c0 do n = n3Dzcum+1, n3Dbcum @@ -1417,10 +1218,9 @@ subroutine ice_write_hist (ns) do k = 1, nzblyr call gather_global(work_g1, a3Db(:,:,k,nn,:), & master_task, distrb_info) - work_gr(:,:) = work_g1(:,:) if (my_task == master_task) then - status = nf90_put_var(ncid,varid,work_gr(:,:), & + status = nf90_put_var(ncid,varid,work_g1, & start=(/ 1, 1,k/), & count=(/nx_global,ny_global,1/)) if (status /= nf90_noerr) call abort_ice(subname// & @@ -1430,7 +1230,6 @@ subroutine ice_write_hist (ns) endif enddo ! num_avail_hist_fields_3Db - work_gr(:,:) = c0 work_g1(:,:) = c0 do n = n3Dbcum+1, n3Dacum @@ -1444,10 +1243,9 @@ subroutine ice_write_hist (ns) do k = 1, nzalyr call gather_global(work_g1, a3Da(:,:,k,nn,:), & master_task, distrb_info) - work_gr(:,:) = work_g1(:,:) if (my_task == master_task) then - status = nf90_put_var(ncid,varid,work_gr(:,:), & + status = nf90_put_var(ncid,varid,work_g1, & start=(/ 1, 1,k/), & count=(/nx_global,ny_global,1/)) if (status /= nf90_noerr) call abort_ice(subname// & @@ -1457,7 +1255,6 @@ subroutine ice_write_hist (ns) endif enddo ! num_avail_hist_fields_3Da - work_gr(:,:) = c0 work_g1(:,:) = c0 do n = n3Dacum+1, n3Dfcum @@ -1471,9 +1268,8 @@ subroutine ice_write_hist (ns) do k = 1, nfsd_hist call gather_global(work_g1, a3Df(:,:,k,nn,:), & master_task, distrb_info) - work_gr(:,:) = work_g1(:,:) if (my_task == master_task) then - status = nf90_put_var(ncid,varid,work_gr(:,:), & + status = nf90_put_var(ncid,varid,work_g1, & start=(/ 1, 1,k/), & count=(/nx_global,ny_global,1/)) if (status /= nf90_noerr) call abort_ice(subname// & @@ -1483,7 +1279,6 @@ subroutine ice_write_hist (ns) endif enddo ! num_avail_hist_fields_3Df - work_gr(:,:) = c0 work_g1(:,:) = c0 do n = n3Dfcum+1, n4Dicum @@ -1498,9 +1293,8 @@ subroutine ice_write_hist (ns) do k = 1, nzilyr call gather_global(work_g1, a4Di(:,:,k,ic,nn,:), & master_task, distrb_info) - work_gr(:,:) = work_g1(:,:) if (my_task == master_task) then - status = nf90_put_var(ncid,varid,work_gr(:,:), & + status = nf90_put_var(ncid,varid,work_g1, & start=(/ 1, 1,k,ic/), & count=(/nx_global,ny_global,1, 1/)) if (status /= nf90_noerr) call abort_ice(subname// & @@ -1511,7 +1305,6 @@ subroutine ice_write_hist (ns) endif enddo ! num_avail_hist_fields_4Di - work_gr(:,:) = c0 work_g1(:,:) = c0 do n = n4Dicum+1, n4Dscum @@ -1526,9 +1319,8 @@ subroutine ice_write_hist (ns) do k = 1, nzslyr call gather_global(work_g1, a4Ds(:,:,k,ic,nn,:), & master_task, distrb_info) - work_gr(:,:) = work_g1(:,:) if (my_task == master_task) then - status = nf90_put_var(ncid,varid,work_gr(:,:), & + status = nf90_put_var(ncid,varid,work_g1, & start=(/ 1, 1,k,ic/), & count=(/nx_global,ny_global,1, 1/)) if (status /= nf90_noerr) call abort_ice(subname// & @@ -1551,9 +1343,8 @@ subroutine ice_write_hist (ns) do k = 1, nfsd_hist call gather_global(work_g1, a4Df(:,:,k,ic,nn,:), & master_task, distrb_info) - work_gr(:,:) = work_g1(:,:) if (my_task == master_task) then - status = nf90_put_var(ncid,varid,work_gr(:,:), & + status = nf90_put_var(ncid,varid,work_g1, & start=(/ 1, 1,k,ic/), & count=(/nx_global,ny_global,1, 1/)) if (status /= nf90_noerr) call abort_ice(subname// & @@ -1564,7 +1355,6 @@ subroutine ice_write_hist (ns) endif enddo ! num_avail_hist_fields_4Df - deallocate(work_gr) deallocate(work_g1) !----------------------------------------------------------------- @@ -1586,6 +1376,43 @@ subroutine ice_write_hist (ns) end subroutine ice_write_hist +!======================================================================= + + subroutine ice_write_hist_fill(ncid,varid,vname,precision) + + use ice_kinds_mod +#ifdef USE_NETCDF + use netcdf +#endif + + integer (kind=int_kind), intent(in) :: ncid ! netcdf file id + integer (kind=int_kind), intent(in) :: varid ! netcdf var id + character(len=*), intent(in) :: vname ! var name + integer (kind=int_kind), intent(in) :: precision ! precision + + ! local variables + + integer (kind=int_kind) :: status + character(len=*), parameter :: subname = '(ice_write_hist_fill)' + + if (precision == 8) then + status = nf90_put_att(ncid,varid,'missing_value',spval_dbl) + else + status = nf90_put_att(ncid,varid,'missing_value',spval) + endif + if (status /= nf90_noerr) call abort_ice(subname// & + 'ERROR: defining missing_value for '//trim(vname)) + + if (precision == 8) then + status = nf90_put_att(ncid,varid,'_FillValue',spval_dbl) + else + status = nf90_put_att(ncid,varid,'_FillValue',spval) + endif + if (status /= nf90_noerr) call abort_ice(subname// & + 'ERROR: defining _FillValue for '//trim(vname)) + + end subroutine ice_write_hist_fill + !======================================================================= end module ice_history_write diff --git a/cicecore/cicedynB/infrastructure/io/io_pio2/ice_history_write.F90 b/cicecore/cicedynB/infrastructure/io/io_pio2/ice_history_write.F90 index fd20f4c03..0e91d42d0 100644 --- a/cicecore/cicedynB/infrastructure/io/io_pio2/ice_history_write.F90 +++ b/cicecore/cicedynB/infrastructure/io/io_pio2/ice_history_write.F90 @@ -18,6 +18,7 @@ module ice_history_write use ice_kinds_mod + use ice_constants, only: c0, c360, 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 @@ -45,7 +46,6 @@ subroutine ice_write_hist (ns) histfreq, histfreq_n, days_per_year, use_leap_years, dayyr, & hh_init, mm_init, ss_init use ice_communicate, only: my_task, master_task - use ice_constants, only: c0, c360, spval, spval_dbl use ice_domain, only: distrb_info, nblocks use ice_domain_size, only: nx_global, ny_global, max_blocks, max_nstrm use ice_gather_scatter, only: gather_global @@ -116,10 +116,15 @@ subroutine ice_write_hist (ns) TYPE(coord_attributes), dimension(nvarz) :: var_nz CHARACTER (char_len), dimension(ncoord) :: coord_bounds - real (kind=dbl_kind), allocatable :: workr2(:,:,:) - real (kind=dbl_kind), allocatable :: workr3(:,:,:,:) - real (kind=dbl_kind), allocatable :: workr4(:,:,:,:,:) - real (kind=dbl_kind), allocatable :: workr3v(:,:,:,:) + real (kind=dbl_kind) , allocatable :: workd2(:,:,:) + real (kind=dbl_kind) , allocatable :: workd3(:,:,:,:) + real (kind=dbl_kind) , allocatable :: workd4(:,:,:,:,:) + real (kind=dbl_kind) , allocatable :: workd3v(:,:,:,:) + + real (kind=real_kind), allocatable :: workr2(:,:,:) + real (kind=real_kind), allocatable :: workr3(:,:,:,:) + real (kind=real_kind), allocatable :: workr4(:,:,:,:,:) + real (kind=real_kind), allocatable :: workr3v(:,:,:,:) character(len=char_len_long) :: & filename @@ -164,16 +169,16 @@ subroutine ice_write_hist (ns) call ice_pio_init(mode='write', filename=trim(filename), File=File, & clobber=.true., cdf64=lcdf64, iotype=iotype) - call ice_pio_initdecomp(iodesc=iodesc2d) - call ice_pio_initdecomp(ndim3=ncat_hist, iodesc=iodesc3dc) - call ice_pio_initdecomp(ndim3=nzilyr, iodesc=iodesc3di) - call ice_pio_initdecomp(ndim3=nzblyr, iodesc=iodesc3db) - call ice_pio_initdecomp(ndim3=nzalyr, iodesc=iodesc3da) - call ice_pio_initdecomp(ndim3=nfsd_hist, iodesc=iodesc3df) - call ice_pio_initdecomp(ndim3=nverts, iodesc=iodesc3dv, inner_dim=.true.) - call ice_pio_initdecomp(ndim3=nzilyr, ndim4=ncat_hist, iodesc=iodesc4di) - call ice_pio_initdecomp(ndim3=nzslyr, ndim4=ncat_hist, iodesc=iodesc4ds) - call ice_pio_initdecomp(ndim3=nfsd_hist, ndim4=ncat_hist, iodesc=iodesc4df) + call ice_pio_initdecomp(iodesc=iodesc2d, precision=history_precision) + call ice_pio_initdecomp(ndim3=ncat_hist, iodesc=iodesc3dc, precision=history_precision) + call ice_pio_initdecomp(ndim3=nzilyr, iodesc=iodesc3di, precision=history_precision) + call ice_pio_initdecomp(ndim3=nzblyr, iodesc=iodesc3db, precision=history_precision) + call ice_pio_initdecomp(ndim3=nzalyr, iodesc=iodesc3da, precision=history_precision) + call ice_pio_initdecomp(ndim3=nfsd_hist, iodesc=iodesc3df, precision=history_precision) + call ice_pio_initdecomp(ndim3=nverts, iodesc=iodesc3dv, inner_dim=.true., precision=history_precision) + call ice_pio_initdecomp(ndim3=nzilyr, ndim4=ncat_hist, iodesc=iodesc4di, precision=history_precision) + 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 @@ -339,13 +344,7 @@ subroutine ice_write_hist (ns) dimid2, varid) status = pio_put_att(File,varid,'long_name',trim(coord_var(i)%long_name)) status = pio_put_att(File, varid, 'units', trim(coord_var(i)%units)) - if (lprecision == pio_real) then - status = pio_put_att(File, varid, 'missing_value', spval) - status = pio_put_att(File, varid,'_FillValue',spval) - else - status = pio_put_att(File, varid, 'missing_value', spval_dbl) - status = pio_put_att(File, varid,'_FillValue',spval_dbl) - endif + call ice_write_hist_fill(File,varid,coord_var(i)%short_name,history_precision) if (coord_var(i)%short_name == 'ULAT') then status = pio_put_att(File,varid,'comment', & trim('Latitude of NE corner of T grid cell')) @@ -377,13 +376,7 @@ subroutine ice_write_hist (ns) status = pio_def_var(File, 'tmask', lprecision, dimid2, varid) status = pio_put_att(File,varid, 'long_name', 'ocean grid mask') status = pio_put_att(File, varid, 'coordinates', 'TLON TLAT') - if (lprecision == pio_real) then - status = pio_put_att(File, varid, 'missing_value', spval) - status = pio_put_att(File, varid,'_FillValue',spval) - else - status = pio_put_att(File, varid, 'missing_value', spval_dbl) - status = pio_put_att(File, varid,'_FillValue',spval_dbl) - endif + call ice_write_hist_fill(File,varid,'tmask',history_precision) status = pio_put_att(File,varid,'comment', '0 = land, 1 = ocean') endif if (igrd(n_blkmask)) then @@ -391,13 +384,7 @@ subroutine ice_write_hist (ns) status = pio_put_att(File,varid, 'long_name', 'ice grid block mask') status = pio_put_att(File, varid, 'coordinates', 'TLON TLAT') status = pio_put_att(File,varid,'comment', 'mytask + iblk/100') - if (lprecision == pio_real) then - status = pio_put_att(File, varid, 'missing_value', spval) - status = pio_put_att(File, varid,'_FillValue',spval) - else - status = pio_put_att(File, varid, 'missing_value', spval_dbl) - status = pio_put_att(File, varid,'_FillValue',spval_dbl) - endif + call ice_write_hist_fill(File,varid,'blkmask',history_precision) endif do i = 3, nvar ! note: n_tmask=1, n_blkmask=2 @@ -407,13 +394,7 @@ subroutine ice_write_hist (ns) status = pio_put_att(File,varid, 'long_name', trim(var(i)%req%long_name)) status = pio_put_att(File, varid, 'units', trim(var(i)%req%units)) status = pio_put_att(File, varid, 'coordinates', trim(var(i)%coordinates)) - if (lprecision == pio_real) then - status = pio_put_att(File, varid, 'missing_value', spval) - status = pio_put_att(File, varid,'_FillValue',spval) - else - status = pio_put_att(File, varid, 'missing_value', spval_dbl) - status = pio_put_att(File, varid,'_FillValue',spval_dbl) - endif + call ice_write_hist_fill(File,varid,var(i)%req%short_name,history_precision) endif enddo @@ -429,13 +410,7 @@ subroutine ice_write_hist (ns) pio_put_att(File,varid, 'long_name', trim(var_nverts(i)%long_name)) status = & pio_put_att(File, varid, 'units', trim(var_nverts(i)%units)) - if (lprecision == pio_real) then - status = pio_put_att(File, varid, 'missing_value', spval) - status = pio_put_att(File, varid,'_FillValue',spval) - else - status = pio_put_att(File, varid, 'missing_value', spval_dbl) - status = pio_put_att(File, varid,'_FillValue',spval_dbl) - endif + call ice_write_hist_fill(File,varid,var_nverts(i)%short_name,history_precision) endif enddo @@ -463,13 +438,7 @@ subroutine ice_write_hist (ns) trim(avail_hist_fields(n)%vcoord)) status = pio_put_att(File,varid,'cell_measures', & trim(avail_hist_fields(n)%vcellmeas)) - if (lprecision == pio_real) then - status = pio_put_att(File, varid, 'missing_value', spval) - status = pio_put_att(File, varid,'_FillValue',spval) - else - status = pio_put_att(File, varid, 'missing_value', spval_dbl) - status = pio_put_att(File, varid,'_FillValue',spval_dbl) - endif + call ice_write_hist_fill(File,varid,avail_hist_fields(n)%vname,history_precision) ! Add cell_methods attribute to variables if averaged if (hist_avg) then @@ -518,13 +487,7 @@ subroutine ice_write_hist (ns) trim(avail_hist_fields(n)%vcoord)) status = pio_put_att(File,varid,'cell_measures', & trim(avail_hist_fields(n)%vcellmeas)) - if (lprecision == pio_real) then - status = pio_put_att(File, varid, 'missing_value', spval) - status = pio_put_att(File, varid,'_FillValue',spval) - else - status = pio_put_att(File, varid, 'missing_value', spval_dbl) - status = pio_put_att(File, varid,'_FillValue',spval_dbl) - endif + call ice_write_hist_fill(File,varid,avail_hist_fields(n)%vname,history_precision) ! Add cell_methods attribute to variables if averaged if (hist_avg) then @@ -561,13 +524,7 @@ subroutine ice_write_hist (ns) trim(avail_hist_fields(n)%vcoord)) status = pio_put_att(File,varid,'cell_measures', & trim(avail_hist_fields(n)%vcellmeas)) - if (lprecision == pio_real) then - status = pio_put_att(File, varid, 'missing_value', spval) - status = pio_put_att(File, varid,'_FillValue',spval) - else - status = pio_put_att(File, varid, 'missing_value', spval_dbl) - status = pio_put_att(File, varid,'_FillValue',spval_dbl) - endif + call ice_write_hist_fill(File,varid,avail_hist_fields(n)%vname,history_precision) ! Add cell_methods attribute to variables if averaged if (hist_avg) then @@ -604,13 +561,7 @@ subroutine ice_write_hist (ns) trim(avail_hist_fields(n)%vcoord)) status = pio_put_att(File,varid,'cell_measures', & trim(avail_hist_fields(n)%vcellmeas)) - if (lprecision == pio_real) then - status = pio_put_att(File, varid, 'missing_value', spval) - status = pio_put_att(File, varid,'_FillValue',spval) - else - status = pio_put_att(File, varid, 'missing_value', spval_dbl) - status = pio_put_att(File, varid,'_FillValue',spval_dbl) - endif + call ice_write_hist_fill(File,varid,avail_hist_fields(n)%vname,history_precision) ! Add cell_methods attribute to variables if averaged if (hist_avg) then @@ -647,13 +598,7 @@ subroutine ice_write_hist (ns) trim(avail_hist_fields(n)%vcoord)) status = pio_put_att(File,varid,'cell_measures', & trim(avail_hist_fields(n)%vcellmeas)) - if (lprecision == pio_real) then - status = pio_put_att(File, varid, 'missing_value', spval) - status = pio_put_att(File, varid,'_FillValue',spval) - else - status = pio_put_att(File, varid, 'missing_value', spval_dbl) - status = pio_put_att(File, varid,'_FillValue',spval_dbl) - endif + call ice_write_hist_fill(File,varid,avail_hist_fields(n)%vname,history_precision) ! Add cell_methods attribute to variables if averaged if (hist_avg) then @@ -690,13 +635,7 @@ subroutine ice_write_hist (ns) trim(avail_hist_fields(n)%vcoord)) status = pio_put_att(File,varid,'cell_measures', & trim(avail_hist_fields(n)%vcellmeas)) - if (lprecision == pio_real) then - status = pio_put_att(File, varid, 'missing_value', spval) - status = pio_put_att(File, varid,'_FillValue',spval) - else - status = pio_put_att(File, varid, 'missing_value', spval_dbl) - status = pio_put_att(File, varid,'_FillValue',spval_dbl) - endif + call ice_write_hist_fill(File,varid,avail_hist_fields(n)%vname,history_precision) ! Add cell_methods attribute to variables if averaged if (hist_avg) then @@ -739,13 +678,7 @@ subroutine ice_write_hist (ns) trim(avail_hist_fields(n)%vcoord)) status = pio_put_att(File,varid,'cell_measures', & trim(avail_hist_fields(n)%vcellmeas)) - if (lprecision == pio_real) then - status = pio_put_att(File, varid, 'missing_value', spval) - status = pio_put_att(File, varid,'_FillValue',spval) - else - status = pio_put_att(File, varid, 'missing_value', spval_dbl) - status = pio_put_att(File, varid,'_FillValue',spval_dbl) - endif + call ice_write_hist_fill(File,varid,avail_hist_fields(n)%vname,history_precision) ! Add cell_methods attribute to variables if averaged if (hist_avg) then @@ -783,13 +716,7 @@ subroutine ice_write_hist (ns) trim(avail_hist_fields(n)%vcoord)) status = pio_put_att(File,varid,'cell_measures', & trim(avail_hist_fields(n)%vcellmeas)) - if (lprecision == pio_real) then - status = pio_put_att(File, varid, 'missing_value', spval) - status = pio_put_att(File, varid,'_FillValue',spval) - else - status = pio_put_att(File, varid, 'missing_value', spval_dbl) - status = pio_put_att(File, varid,'_FillValue',spval_dbl) - endif + call ice_write_hist_fill(File,varid,avail_hist_fields(n)%vname,history_precision) ! Add cell_methods attribute to variables if averaged if (hist_avg) then @@ -828,13 +755,7 @@ subroutine ice_write_hist (ns) trim(avail_hist_fields(n)%vcoord)) status = pio_put_att(File,varid,'cell_measures', & trim(avail_hist_fields(n)%vcellmeas)) - if (lprecision == pio_real) then - status = pio_put_att(File, varid, 'missing_value', spval) - status = pio_put_att(File, varid,'_FillValue',spval) - else - status = pio_put_att(File, varid, 'missing_value', spval_dbl) - status = pio_put_att(File, varid,'_FillValue',spval_dbl) - endif + call ice_write_hist_fill(File,varid,avail_hist_fields(n)%vname,history_precision) ! Add cell_methods attribute to variables if averaged if (hist_avg) then @@ -928,6 +849,7 @@ subroutine ice_write_hist (ns) ! write coordinate variables !----------------------------------------------------------------- + allocate(workd2(nx_block,ny_block,nblocks)) allocate(workr2(nx_block,ny_block,nblocks)) do i = 1,ncoord @@ -935,16 +857,22 @@ subroutine ice_write_hist (ns) SELECT CASE (coord_var(i)%short_name) CASE ('TLON') ! Convert T grid longitude from -180 -> 180 to 0 to 360 - workr2(:,:,:) = mod(tlon(:,:,1:nblocks)*rad_to_deg + c360, c360) + workd2(:,:,:) = mod(tlon(:,:,1:nblocks)*rad_to_deg + c360, c360) CASE ('TLAT') - workr2(:,:,:) = tlat(:,:,1:nblocks)*rad_to_deg + workd2(:,:,:) = tlat(:,:,1:nblocks)*rad_to_deg CASE ('ULON') - workr2(:,:,:) = ulon(:,:,1:nblocks)*rad_to_deg + workd2(:,:,:) = ulon(:,:,1:nblocks)*rad_to_deg CASE ('ULAT') - workr2(:,:,:) = ulat(:,:,1:nblocks)*rad_to_deg + workd2(:,:,:) = ulat(:,:,1:nblocks)*rad_to_deg END SELECT - call pio_write_darray(File, varid, iodesc2d, & - workr2, status, fillval=spval_dbl) + if (history_precision == 8) then + call pio_write_darray(File, varid, iodesc2d, & + workd2, status, fillval=spval_dbl) + else + workr2 = workd2 + call pio_write_darray(File, varid, iodesc2d, & + workr2, status, fillval=spval) + endif enddo ! Extra dimensions (NCAT, NFSD, VGRD*) @@ -988,33 +916,39 @@ subroutine ice_write_hist (ns) if (igrd(i)) then SELECT CASE (var(i)%req%short_name) CASE ('tmask') - workr2 = hm(:,:,1:nblocks) + workd2 = hm(:,:,1:nblocks) CASE ('blkmask') - workr2 = bm(:,:,1:nblocks) + workd2 = bm(:,:,1:nblocks) CASE ('tarea') - workr2 = tarea(:,:,1:nblocks) + workd2 = tarea(:,:,1:nblocks) CASE ('uarea') - workr2 = uarea(:,:,1:nblocks) + workd2 = uarea(:,:,1:nblocks) CASE ('dxu') - workr2 = dxu(:,:,1:nblocks) + workd2 = dxu(:,:,1:nblocks) CASE ('dyu') - workr2 = dyu(:,:,1:nblocks) + workd2 = dyu(:,:,1:nblocks) CASE ('dxt') - workr2 = dxt(:,:,1:nblocks) + workd2 = dxt(:,:,1:nblocks) CASE ('dyt') - workr2 = dyt(:,:,1:nblocks) + workd2 = dyt(:,:,1:nblocks) CASE ('HTN') - workr2 = HTN(:,:,1:nblocks) + workd2 = HTN(:,:,1:nblocks) CASE ('HTE') - workr2 = HTE(:,:,1:nblocks) + workd2 = HTE(:,:,1:nblocks) CASE ('ANGLE') - workr2 = ANGLE(:,:,1:nblocks) + workd2 = ANGLE(:,:,1:nblocks) CASE ('ANGLET') - workr2 = ANGLET(:,:,1:nblocks) + workd2 = ANGLET(:,:,1:nblocks) END SELECT status = pio_inq_varid(File, var(i)%req%short_name, varid) - call pio_write_darray(File, varid, iodesc2d, & - workr2, status, fillval=spval_dbl) + if (history_precision == 8) then + call pio_write_darray(File, varid, iodesc2d, & + workd2, status, fillval=spval_dbl) + else + workr2 = workd2 + call pio_write_darray(File, varid, iodesc2d, & + workr2, status, fillval=spval) + endif endif enddo @@ -1023,32 +957,40 @@ subroutine ice_write_hist (ns) !---------------------------------------------------------------- if (f_bounds) then + allocate(workd3v(nverts,nx_block,ny_block,nblocks)) allocate(workr3v(nverts,nx_block,ny_block,nblocks)) - workr3v (:,:,:,:) = c0 + workd3v (:,:,:,:) = c0 do i = 1, nvar_verts SELECT CASE (var_nverts(i)%short_name) CASE ('lont_bounds') do ivertex = 1, nverts - workr3v(ivertex,:,:,:) = lont_bounds(ivertex,:,:,1:nblocks) + workd3v(ivertex,:,:,:) = lont_bounds(ivertex,:,:,1:nblocks) enddo CASE ('latt_bounds') do ivertex = 1, nverts - workr3v(ivertex,:,:,:) = latt_bounds(ivertex,:,:,1:nblocks) + workd3v(ivertex,:,:,:) = latt_bounds(ivertex,:,:,1:nblocks) enddo CASE ('lonu_bounds') do ivertex = 1, nverts - workr3v(ivertex,:,:,:) = lonu_bounds(ivertex,:,:,1:nblocks) + workd3v(ivertex,:,:,:) = lonu_bounds(ivertex,:,:,1:nblocks) enddo CASE ('latu_bounds') do ivertex = 1, nverts - workr3v(ivertex,:,:,:) = latu_bounds(ivertex,:,:,1:nblocks) + workd3v(ivertex,:,:,:) = latu_bounds(ivertex,:,:,1:nblocks) enddo END SELECT status = pio_inq_varid(File, var_nverts(i)%short_name, varid) - call pio_write_darray(File, varid, iodesc3dv, & - workr3v, status, fillval=spval_dbl) + if (history_precision == 8) then + call pio_write_darray(File, varid, iodesc3dv, & + workd3v, status, fillval=spval_dbl) + else + workr3v = workd3v + call pio_write_darray(File, varid, iodesc3dv, & + workr3v, status, fillval=spval) + endif enddo + deallocate(workd3v) deallocate(workr3v) endif ! f_bounds @@ -1063,20 +1005,28 @@ subroutine ice_write_hist (ns) status = pio_inq_varid(File,avail_hist_fields(n)%vname,varid) if (status /= pio_noerr) call abort_ice(subname// & 'ERROR getting varid for '//avail_hist_fields(n)%vname) - workr2(:,:,:) = a2D(:,:,n,1:nblocks) + workd2(:,:,:) = a2D(:,:,n,1:nblocks) #ifdef CESM1_PIO call pio_setframe(varid, int(1,kind=PIO_OFFSET)) #else call pio_setframe(File, varid, int(1,kind=PIO_OFFSET_KIND)) #endif - call pio_write_darray(File, varid, iodesc2d,& - workr2, status, fillval=spval_dbl) + if (history_precision == 8) then + call pio_write_darray(File, varid, iodesc2d,& + workd2, status, fillval=spval_dbl) + else + workr2 = workd2 + call pio_write_darray(File, varid, iodesc2d,& + workr2, status, fillval=spval) + endif endif enddo ! num_avail_hist_fields_2D + deallocate(workd2) deallocate(workr2) ! 3D (category) + allocate(workd3(nx_block,ny_block,nblocks,ncat_hist)) allocate(workr3(nx_block,ny_block,nblocks,ncat_hist)) do n = n2D + 1, n3Dccum nn = n - n2D @@ -1086,7 +1036,7 @@ subroutine ice_write_hist (ns) 'ERROR: getting varid for '//avail_hist_fields(n)%vname) do j = 1, nblocks do i = 1, ncat_hist - workr3(:,:,j,i) = a3Dc(:,:,i,nn,j) + workd3(:,:,j,i) = a3Dc(:,:,i,nn,j) enddo enddo #ifdef CESM1_PIO @@ -1094,13 +1044,21 @@ subroutine ice_write_hist (ns) #else call pio_setframe(File, varid, int(1,kind=PIO_OFFSET_KIND)) #endif - call pio_write_darray(File, varid, iodesc3dc,& - workr3, status, fillval=spval_dbl) + if (history_precision == 8) then + call pio_write_darray(File, varid, iodesc3dc,& + workd3, status, fillval=spval_dbl) + else + workr3 = workd3 + call pio_write_darray(File, varid, iodesc3dc,& + workr3, status, fillval=spval) + endif endif enddo ! num_avail_hist_fields_3Dc + deallocate(workd3) deallocate(workr3) ! 3D (vertical ice) + allocate(workd3(nx_block,ny_block,nblocks,nzilyr)) allocate(workr3(nx_block,ny_block,nblocks,nzilyr)) do n = n3Dccum+1, n3Dzcum nn = n - n3Dccum @@ -1110,7 +1068,7 @@ subroutine ice_write_hist (ns) 'ERROR: getting varid for '//avail_hist_fields(n)%vname) do j = 1, nblocks do i = 1, nzilyr - workr3(:,:,j,i) = a3Dz(:,:,i,nn,j) + workd3(:,:,j,i) = a3Dz(:,:,i,nn,j) enddo enddo #ifdef CESM1_PIO @@ -1118,13 +1076,21 @@ subroutine ice_write_hist (ns) #else call pio_setframe(File, varid, int(1,kind=PIO_OFFSET_KIND)) #endif - call pio_write_darray(File, varid, iodesc3di,& - workr3, status, fillval=spval_dbl) + if (history_precision == 8) then + call pio_write_darray(File, varid, iodesc3di,& + workd3, status, fillval=spval_dbl) + else + workr3 = workd3 + call pio_write_darray(File, varid, iodesc3di,& + workr3, status, fillval=spval) + endif endif enddo ! num_avail_hist_fields_3Dz + deallocate(workd3) deallocate(workr3) ! 3D (vertical ice biology) + allocate(workd3(nx_block,ny_block,nblocks,nzblyr)) allocate(workr3(nx_block,ny_block,nblocks,nzblyr)) do n = n3Dzcum+1, n3Dbcum nn = n - n3Dzcum @@ -1134,7 +1100,7 @@ subroutine ice_write_hist (ns) 'ERROR: getting varid for '//avail_hist_fields(n)%vname) do j = 1, nblocks do i = 1, nzblyr - workr3(:,:,j,i) = a3Db(:,:,i,nn,j) + workd3(:,:,j,i) = a3Db(:,:,i,nn,j) enddo enddo #ifdef CESM1_PIO @@ -1142,13 +1108,21 @@ subroutine ice_write_hist (ns) #else call pio_setframe(File, varid, int(1,kind=PIO_OFFSET_KIND)) #endif - call pio_write_darray(File, varid, iodesc3db,& - workr3, status, fillval=spval_dbl) + if (history_precision == 8) then + call pio_write_darray(File, varid, iodesc3db,& + workd3, status, fillval=spval_dbl) + else + workr3 = workd3 + call pio_write_darray(File, varid, iodesc3db,& + workr3, status, fillval=spval) + endif endif enddo ! num_avail_hist_fields_3Db + deallocate(workd3) deallocate(workr3) ! 3D (vertical snow biology) + allocate(workd3(nx_block,ny_block,nblocks,nzalyr)) allocate(workr3(nx_block,ny_block,nblocks,nzalyr)) do n = n3Dbcum+1, n3Dacum nn = n - n3Dbcum @@ -1158,7 +1132,7 @@ subroutine ice_write_hist (ns) 'ERROR: getting varid for '//avail_hist_fields(n)%vname) do j = 1, nblocks do i = 1, nzalyr - workr3(:,:,j,i) = a3Da(:,:,i,nn,j) + workd3(:,:,j,i) = a3Da(:,:,i,nn,j) enddo enddo #ifdef CESM1_PIO @@ -1166,13 +1140,21 @@ subroutine ice_write_hist (ns) #else call pio_setframe(File, varid, int(1,kind=PIO_OFFSET_KIND)) #endif - call pio_write_darray(File, varid, iodesc3da,& - workr3, status, fillval=spval_dbl) + if (history_precision == 8) then + call pio_write_darray(File, varid, iodesc3da,& + workd3, status, fillval=spval_dbl) + else + workr3 = workd3 + call pio_write_darray(File, varid, iodesc3da,& + workr3, status, fillval=spval) + endif endif enddo ! num_avail_hist_fields_3Db + deallocate(workd3) deallocate(workr3) ! 3D (fsd) + allocate(workd3(nx_block,ny_block,nblocks,nfsd_hist)) allocate(workr3(nx_block,ny_block,nblocks,nfsd_hist)) do n = n3Dacum+1, n3Dfcum nn = n - n3Dacum @@ -1182,7 +1164,7 @@ subroutine ice_write_hist (ns) 'ERROR: getting varid for '//avail_hist_fields(n)%vname) do j = 1, nblocks do i = 1, nfsd_hist - workr3(:,:,j,i) = a3Df(:,:,i,nn,j) + workd3(:,:,j,i) = a3Df(:,:,i,nn,j) enddo enddo #ifdef CESM1_PIO @@ -1190,12 +1172,20 @@ subroutine ice_write_hist (ns) #else call pio_setframe(File, varid, int(1,kind=PIO_OFFSET_KIND)) #endif - call pio_write_darray(File, varid, iodesc3df,& - workr3, status, fillval=spval_dbl) + if (history_precision == 8) then + call pio_write_darray(File, varid, iodesc3df,& + workd3, status, fillval=spval_dbl) + else + workr3 = workd3 + call pio_write_darray(File, varid, iodesc3df,& + workr3, status, fillval=spval) + endif endif enddo ! num_avail_hist_fields_3Df + deallocate(workd3) deallocate(workr3) + allocate(workd4(nx_block,ny_block,nblocks,ncat_hist,nzilyr)) allocate(workr4(nx_block,ny_block,nblocks,ncat_hist,nzilyr)) ! 4D (categories, fsd) do n = n3Dfcum+1, n4Dicum @@ -1207,7 +1197,7 @@ subroutine ice_write_hist (ns) do j = 1, nblocks do i = 1, ncat_hist do k = 1, nzilyr - workr4(:,:,j,i,k) = a4Di(:,:,k,i,nn,j) + workd4(:,:,j,i,k) = a4Di(:,:,k,i,nn,j) enddo ! k enddo ! i enddo ! j @@ -1216,12 +1206,20 @@ subroutine ice_write_hist (ns) #else call pio_setframe(File, varid, int(1,kind=PIO_OFFSET_KIND)) #endif - call pio_write_darray(File, varid, iodesc4di,& - workr4, status, fillval=spval_dbl) + if (history_precision == 8) then + call pio_write_darray(File, varid, iodesc4di,& + workd4, status, fillval=spval_dbl) + else + workr4 = workd4 + call pio_write_darray(File, varid, iodesc4di,& + workr4, status, fillval=spval) + endif endif enddo ! num_avail_hist_fields_4Di + deallocate(workd4) deallocate(workr4) + allocate(workd4(nx_block,ny_block,nblocks,ncat_hist,nzslyr)) allocate(workr4(nx_block,ny_block,nblocks,ncat_hist,nzslyr)) ! 4D (categories, vertical ice) do n = n4Dicum+1, n4Dscum @@ -1233,7 +1231,7 @@ subroutine ice_write_hist (ns) do j = 1, nblocks do i = 1, ncat_hist do k = 1, nzslyr - workr4(:,:,j,i,k) = a4Ds(:,:,k,i,nn,j) + workd4(:,:,j,i,k) = a4Ds(:,:,k,i,nn,j) enddo ! k enddo ! i enddo ! j @@ -1242,12 +1240,20 @@ subroutine ice_write_hist (ns) #else call pio_setframe(File, varid, int(1,kind=PIO_OFFSET_KIND)) #endif - call pio_write_darray(File, varid, iodesc4ds,& - workr4, status, fillval=spval_dbl) + if (history_precision == 8) then + call pio_write_darray(File, varid, iodesc4ds,& + workd4, status, fillval=spval_dbl) + else + workr4 = workd4 + call pio_write_darray(File, varid, iodesc4ds,& + workr4, status, fillval=spval) + endif endif enddo ! num_avail_hist_fields_4Ds + deallocate(workd4) deallocate(workr4) + allocate(workd4(nx_block,ny_block,nblocks,ncat_hist,nfsd_hist)) allocate(workr4(nx_block,ny_block,nblocks,ncat_hist,nfsd_hist)) ! 4D (categories, vertical ice) do n = n4Dscum+1, n4Dfcum @@ -1259,7 +1265,7 @@ subroutine ice_write_hist (ns) do j = 1, nblocks do i = 1, ncat_hist do k = 1, nfsd_hist - workr4(:,:,j,i,k) = a4Df(:,:,k,i,nn,j) + workd4(:,:,j,i,k) = a4Df(:,:,k,i,nn,j) enddo ! k enddo ! i enddo ! j @@ -1268,13 +1274,20 @@ subroutine ice_write_hist (ns) #else call pio_setframe(File, varid, int(1,kind=PIO_OFFSET_KIND)) #endif - call pio_write_darray(File, varid, iodesc4df,& - workr4, status, fillval=spval_dbl) + if (history_precision == 8) then + call pio_write_darray(File, varid, iodesc4df,& + workd4, status, fillval=spval_dbl) + else + workr4 = workd4 + call pio_write_darray(File, varid, iodesc4df,& + workr4, status, fillval=spval) + endif endif enddo ! num_avail_hist_fields_4Df + deallocate(workd4) deallocate(workr4) -! similarly for num_avail_hist_fields_4Db (define workr4b, iodesc4db) +! similarly for num_avail_hist_fields_4Db (define workd4b, iodesc4db) !----------------------------------------------------------------- @@ -1304,6 +1317,34 @@ subroutine ice_write_hist (ns) end subroutine ice_write_hist +!======================================================================= + + subroutine ice_write_hist_fill(File,varid,vname,precision) + + use ice_kinds_mod + use ice_pio + use pio + + type(file_desc_t) , intent(inout) :: File + type(var_desc_t) , intent(in) :: varid + character(len=*), intent(in) :: vname ! var name + integer (kind=int_kind), intent(in) :: precision ! precision + + ! local variables + + integer (kind=int_kind) :: status + character(len=*), parameter :: subname = '(ice_write_hist_fill)' + + if (precision == 8) then + status = pio_put_att(File, varid, 'missing_value', spval_dbl) + status = pio_put_att(File, varid,'_FillValue',spval_dbl) + else + status = pio_put_att(File, varid, 'missing_value', spval) + status = pio_put_att(File, varid,'_FillValue',spval) + endif + + end subroutine ice_write_hist_fill + !======================================================================= end module ice_history_write diff --git a/cicecore/cicedynB/infrastructure/io/io_pio2/ice_restart.F90 b/cicecore/cicedynB/infrastructure/io/io_pio2/ice_restart.F90 index 6356109fb..0ec6b7628 100644 --- a/cicecore/cicedynB/infrastructure/io/io_pio2/ice_restart.F90 +++ b/cicecore/cicedynB/infrastructure/io/io_pio2/ice_restart.F90 @@ -56,6 +56,8 @@ subroutine init_restart_read(ice_ic) integer (kind=int_kind) :: status, status1 + integer (kind=int_kind) :: iotype + character(len=*), parameter :: subname = '(init_restart_read)' if (present(ice_ic)) then @@ -75,12 +77,14 @@ subroutine init_restart_read(ice_ic) write(nu_diag,*) 'Using restart dump=', trim(filename) end if - if (restart_format == 'pio') then +! if (restart_format(1:3) == 'pio') then + iotype = PIO_IOTYPE_NETCDF + if (restart_format == 'pio_pnetcdf') iotype = PIO_IOTYPE_PNETCDF File%fh=-1 - call ice_pio_init(mode='read', filename=trim(filename), File=File) + call ice_pio_init(mode='read', filename=trim(filename), File=File, iotype=iotype) - call ice_pio_initdecomp(iodesc=iodesc2d) - call ice_pio_initdecomp(ndim3=ncat , iodesc=iodesc3d_ncat,remap=.true.) + call ice_pio_initdecomp(iodesc=iodesc2d, precision=8) + call ice_pio_initdecomp(ndim3=ncat , iodesc=iodesc3d_ncat,remap=.true., precision=8) if (use_restart_time) then status1 = PIO_noerr @@ -103,7 +107,7 @@ subroutine init_restart_read(ice_ic) call abort_ice(subname//"ERROR: reading restart time ") call pio_seterrorhandling(File, PIO_INTERNAL_ERROR) endif ! use namelist values if use_restart_time = F - endif +! endif if (my_task == master_task) then write(nu_diag,*) 'Restart read at istep=',istep0,myear,mmonth,mday,msec @@ -138,7 +142,7 @@ subroutine init_restart_write(filename_spec) use ice_communicate, only: my_task, master_task use ice_domain_size, only: nx_global, ny_global, ncat, nilyr, nslyr, & n_iso, n_aero, nblyr, n_zaero, n_algae, n_doc, & - n_dic, n_don, n_fed, n_fep + n_dic, n_don, n_fed, n_fep, nfsd use ice_dyn_shared, only: kdyn use ice_arrays_column, only: oceanmixed_ice @@ -147,13 +151,13 @@ subroutine init_restart_write(filename_spec) logical (kind=log_kind) :: & tr_iage, tr_FY, tr_lvl, tr_iso, tr_aero, tr_pond_cesm, & - tr_pond_topo, tr_pond_lvl, tr_brine, & + tr_pond_topo, tr_pond_lvl, tr_brine, tr_snow, & tr_bgc_N, tr_bgc_C, tr_bgc_Nit, & tr_bgc_Sil, tr_bgc_DMS, & - tr_bgc_chl, tr_bgc_Am, & + tr_bgc_chl, tr_bgc_Am, & tr_bgc_PON, tr_bgc_DON, & - tr_zaero, tr_bgc_Fe, & - tr_bgc_hum + tr_zaero, tr_bgc_Fe, & + tr_bgc_hum, tr_fsd integer (kind=int_kind) :: & nbtrcr @@ -169,6 +173,8 @@ subroutine init_restart_write(filename_spec) integer (kind=int_kind), allocatable :: dims(:) + integer (kind=int_kind) :: iotype + integer (kind=int_kind) :: & k, n, & ! loop index status ! status variable from netCDF routine @@ -181,13 +187,14 @@ subroutine init_restart_write(filename_spec) call icepack_query_tracer_flags( & tr_iage_out=tr_iage, tr_FY_out=tr_FY, tr_lvl_out=tr_lvl, & tr_iso_out=tr_iso, tr_aero_out=tr_aero, tr_pond_cesm_out=tr_pond_cesm, & - tr_pond_topo_out=tr_pond_topo, tr_pond_lvl_out=tr_pond_lvl, tr_brine_out=tr_brine, & + tr_pond_topo_out=tr_pond_topo, tr_pond_lvl_out=tr_pond_lvl, & + tr_snow_out=tr_snow, tr_brine_out=tr_brine, & tr_bgc_N_out=tr_bgc_N, tr_bgc_C_out=tr_bgc_C, tr_bgc_Nit_out=tr_bgc_Nit, & tr_bgc_Sil_out=tr_bgc_Sil, tr_bgc_DMS_out=tr_bgc_DMS, & tr_bgc_chl_out=tr_bgc_chl, tr_bgc_Am_out=tr_bgc_Am, & tr_bgc_PON_out=tr_bgc_PON, tr_bgc_DON_out=tr_bgc_DON, & tr_zaero_out=tr_zaero, tr_bgc_Fe_out=tr_bgc_Fe, & - tr_bgc_hum_out=tr_bgc_hum) + tr_bgc_hum_out=tr_bgc_hum, tr_fsd_out=tr_fsd) call icepack_query_parameters(solve_zsal_out=solve_zsal, skl_bgc_out=skl_bgc, & z_tracers_out=z_tracers) call icepack_warnings_flush(nu_diag) @@ -204,7 +211,7 @@ subroutine init_restart_write(filename_spec) myear,'-',mmonth,'-',mday,'-',msec end if - if (restart_format /= 'bin') filename = trim(filename) // '.nc' + if (restart_format(1:3) /= 'bin') filename = trim(filename) // '.nc' ! write pointer (path/file) if (my_task == master_task) then @@ -213,11 +220,13 @@ subroutine init_restart_write(filename_spec) close(nu_rst_pointer) endif - if (restart_format == 'pio') then +! if (restart_format(1:3) == 'pio') then + iotype = PIO_IOTYPE_NETCDF + if (restart_format == 'pio_pnetcdf') iotype = PIO_IOTYPE_PNETCDF File%fh=-1 call ice_pio_init(mode='write',filename=trim(filename), File=File, & - clobber=.true., cdf64=lcdf64 ) + clobber=.true., cdf64=lcdf64, iotype=iotype) status = pio_put_att(File,pio_global,'istep1',istep1) ! status = pio_put_att(File,pio_global,'time',time) @@ -475,6 +484,23 @@ subroutine init_restart_write(filename_spec) call define_rest_field(File,'qsno'//trim(nchar),dims) enddo + if (tr_snow) then + do k=1,nslyr + write(nchar,'(i3.3)') k + call define_rest_field(File,'smice'//trim(nchar),dims) + call define_rest_field(File,'smliq'//trim(nchar),dims) + call define_rest_field(File, 'rhos'//trim(nchar),dims) + call define_rest_field(File, 'rsnw'//trim(nchar),dims) + enddo + endif + + if (tr_fsd) then + do k=1,nfsd + write(nchar,'(i3.3)') k + call define_rest_field(File,'fsd'//trim(nchar),dims) + enddo + endif + if (tr_iso) then do k=1,n_iso write(nchar,'(i3.3)') k @@ -623,10 +649,10 @@ subroutine init_restart_write(filename_spec) deallocate(dims) status = pio_enddef(File) - call ice_pio_initdecomp(iodesc=iodesc2d) - call ice_pio_initdecomp(ndim3=ncat , iodesc=iodesc3d_ncat, remap=.true.) + call ice_pio_initdecomp(iodesc=iodesc2d, precision=8) + call ice_pio_initdecomp(ndim3=ncat , iodesc=iodesc3d_ncat, remap=.true., precision=8) - endif +! endif ! restart_format if (my_task == master_task) then write(nu_diag,*) 'Writing ',filename(1:lenstr(filename)) @@ -683,7 +709,7 @@ subroutine read_restart_field(nu,nrec,work,atype,vname,ndim3,diag, & character(len=*), parameter :: subname = '(read_restart_field)' - if (restart_format == "pio") then +! if (restart_format(1:3) == "pio") then if (my_task == master_task) & write(nu_diag,*)'Parallel restart file read: ',vname @@ -742,9 +768,9 @@ subroutine read_restart_field(nu,nrec,work,atype,vname,ndim3,diag, & endif endif - else - call abort_ice(subname//"ERROR: Invalid restart_format: "//trim(restart_format)) - endif +! else +! call abort_ice(subname//"ERROR: Invalid restart_format: "//trim(restart_format)) +! endif ! restart_format end subroutine read_restart_field @@ -791,7 +817,7 @@ subroutine write_restart_field(nu,nrec,work,atype,vname,ndim3,diag) character(len=*), parameter :: subname = '(write_restart_field)' - if (restart_format == "pio") then +! if (restart_format(1:3) == "pio") then if (my_task == master_task) & write(nu_diag,*)'Parallel restart file write: ',vname @@ -830,9 +856,9 @@ subroutine write_restart_field(nu,nrec,work,atype,vname,ndim3,diag) endif endif endif - else - call abort_ice(subname//"ERROR: Invalid restart_format: "//trim(restart_format)) - endif +! else +! call abort_ice(subname//"ERROR: Invalid restart_format: "//trim(restart_format)) +! endif end subroutine write_restart_field @@ -848,11 +874,9 @@ subroutine final_restart() character(len=*), parameter :: subname = '(final_restart)' - if (restart_format == 'pio') then - call PIO_freeDecomp(File,iodesc2d) - call PIO_freeDecomp(File,iodesc3d_ncat) - call pio_closefile(File) - endif + call PIO_freeDecomp(File,iodesc2d) + call PIO_freeDecomp(File,iodesc3d_ncat) + call pio_closefile(File) if (my_task == master_task) & write(nu_diag,*) 'Restart read/written ',istep1,idate,msec diff --git a/cicecore/drivers/standalone/cice/CICE_InitMod.F90 b/cicecore/drivers/standalone/cice/CICE_InitMod.F90 index 60f71fa8a..363025b9b 100644 --- a/cicecore/drivers/standalone/cice/CICE_InitMod.F90 +++ b/cicecore/drivers/standalone/cice/CICE_InitMod.F90 @@ -18,6 +18,7 @@ module CICE_InitMod use icepack_intfc, only: icepack_aggregate use icepack_intfc, only: icepack_init_itd, icepack_init_itd_hist use icepack_intfc, only: icepack_init_fsd_bounds, icepack_init_wave + use icepack_intfc, only: icepack_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, & @@ -76,7 +77,7 @@ subroutine cice_init use ice_flux, only: init_coupler_flux, init_history_therm, & init_history_dyn, init_flux_atm, init_flux_ocn, alloc_flux use ice_forcing, only: init_forcing_ocn, init_forcing_atmo, & - get_forcing_atmo, get_forcing_ocn, get_wave_spec + get_forcing_atmo, get_forcing_ocn, get_wave_spec, init_snowtable use ice_forcing_bgc, only: get_forcing_bgc, get_atm_bgc, & faero_default, faero_optics, alloc_forcing_bgc, fiso_default use ice_grid, only: init_grid1, init_grid2, alloc_grid @@ -90,7 +91,8 @@ subroutine cice_init use ice_transport_driver, only: init_transport logical(kind=log_kind) :: tr_aero, tr_zaero, skl_bgc, z_tracers, & - tr_iso, tr_fsd, wave_spec + tr_iso, tr_fsd, wave_spec, tr_snow + character(len=char_len) :: snw_aging_table character(len=*), parameter :: subname = '(cice_init)' call init_communicate ! initial setup for message passing @@ -162,7 +164,7 @@ subroutine cice_init call ice_HaloRestore_init ! restored boundary conditions call icepack_query_parameters(skl_bgc_out=skl_bgc, z_tracers_out=z_tracers, & - wave_spec_out=wave_spec) + wave_spec_out=wave_spec, snw_aging_table_out=snw_aging_table) call icepack_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call abort_ice(trim(subname), & file=__FILE__,line= __LINE__) @@ -176,7 +178,7 @@ subroutine cice_init call calc_timesteps ! update timestep counter if not using npt_unit="1" call icepack_query_tracer_flags(tr_aero_out=tr_aero, tr_zaero_out=tr_zaero) - call icepack_query_tracer_flags(tr_iso_out=tr_iso) + call icepack_query_tracer_flags(tr_iso_out=tr_iso, tr_snow_out=tr_snow) call icepack_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call abort_ice(trim(subname), & file=__FILE__,line= __LINE__) @@ -207,8 +209,20 @@ subroutine cice_init call get_forcing_atmo ! atmospheric forcing from data call get_forcing_ocn(dt) ! ocean forcing from data + ! snow aging lookup table initialization + if (tr_snow) then ! advanced snow physics + call icepack_init_snow() + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + if (snw_aging_table(1:4) /= 'test') then + call init_snowtable() + endif + endif + ! isotopes if (tr_iso) call fiso_default ! default values + ! aerosols ! if (tr_aero) call faero_data ! data file ! if (tr_zaero) call fzaero_data ! data file (gx1) @@ -235,12 +249,12 @@ subroutine init_restart use ice_calendar, only: calendar use ice_constants, only: c0 use ice_domain, only: nblocks - use ice_domain_size, only: ncat, n_iso, n_aero, nfsd + use ice_domain_size, only: ncat, n_iso, n_aero, nfsd, nslyr use ice_dyn_eap, only: read_restart_eap use ice_dyn_shared, only: kdyn use ice_grid, only: tmask use ice_init, only: ice_ic - use ice_init_column, only: init_age, init_FY, init_lvl, & + use ice_init_column, only: init_age, init_FY, init_lvl, init_snowtracers, & init_meltponds_cesm, 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, & @@ -248,6 +262,7 @@ subroutine init_restart restart_pond_cesm, read_restart_pond_cesm, & 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, & @@ -262,12 +277,13 @@ subroutine init_restart iblk ! block index logical(kind=log_kind) :: & tr_iage, tr_FY, tr_lvl, tr_pond_cesm, tr_pond_lvl, & - tr_pond_topo, tr_fsd, tr_iso, tr_aero, tr_brine, & + 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)' @@ -282,10 +298,12 @@ subroutine init_restart call icepack_query_tracer_flags(tr_iage_out=tr_iage, tr_FY_out=tr_FY, & tr_lvl_out=tr_lvl, tr_pond_cesm_out=tr_pond_cesm, tr_pond_lvl_out=tr_pond_lvl, & tr_pond_topo_out=tr_pond_topo, tr_aero_out=tr_aero, tr_brine_out=tr_brine, & - tr_fsd_out=tr_fsd, tr_iso_out=tr_iso) + tr_snow_out=tr_snow, tr_fsd_out=tr_fsd, tr_iso_out=tr_iso) call icepack_query_tracer_indices(nt_alvl_out=nt_alvl, nt_vlvl_out=nt_vlvl, & nt_apnd_out=nt_apnd, nt_hpnd_out=nt_hpnd, nt_ipnd_out=nt_ipnd, & nt_iage_out=nt_iage, nt_FY_out=nt_FY, nt_aero_out=nt_aero, nt_fsd_out=nt_fsd, & + nt_smice_out=nt_smice, nt_smliq_out=nt_smliq, & + nt_rhos_out=nt_rhos, nt_rsnw_out=nt_rsnw, & nt_isosno_out=nt_isosno, nt_isoice_out=nt_isoice) call icepack_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & @@ -382,6 +400,22 @@ subroutine init_restart enddo ! iblk endif ! .not. restart_pond endif + + ! snow redistribution/metamorphism + if (tr_snow) then + if (trim(runtype) == 'continue') restart_snow = .true. + if (restart_snow) then + call read_restart_snow + else + do iblk = 1, nblocks + call init_snowtracers(trcrn(:,:,nt_smice:nt_smice+nslyr-1,:,iblk), & + trcrn(:,:,nt_smliq:nt_smliq+nslyr-1,:,iblk), & + trcrn(:,:,nt_rhos :nt_rhos +nslyr-1,:,iblk), & + trcrn(:,:,nt_rsnw :nt_rsnw +nslyr-1,:,iblk)) + enddo ! iblk + endif + endif + ! floe size distribution if (tr_fsd) then if (trim(runtype) == 'continue') restart_fsd = .true. @@ -398,7 +432,7 @@ subroutine init_restart if (restart_iso) then call read_restart_iso else - do iblk = 1, nblocks + 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 diff --git a/cicecore/drivers/standalone/cice/CICE_RunMod.F90 b/cicecore/drivers/standalone/cice/CICE_RunMod.F90 index 936a8a70b..52d403a59 100644 --- a/cicecore/drivers/standalone/cice/CICE_RunMod.F90 +++ b/cicecore/drivers/standalone/cice/CICE_RunMod.F90 @@ -151,12 +151,13 @@ subroutine ice_step use ice_restart_column, only: write_restart_age, write_restart_FY, & write_restart_lvl, write_restart_pond_cesm, 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_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, save_init, step_dyn_wave + biogeochemistry, save_init, 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 @@ -170,7 +171,7 @@ subroutine ice_step offset ! d(age)/dt time offset logical (kind=log_kind) :: & - tr_iage, tr_FY, tr_lvl, tr_fsd, & + tr_iage, tr_FY, tr_lvl, tr_fsd, tr_snow, & tr_pond_cesm, tr_pond_lvl, tr_pond_topo, tr_brine, tr_iso, tr_aero, & calc_Tsfc, skl_bgc, solve_zsal, z_tracers, wave_spec @@ -191,7 +192,7 @@ subroutine ice_step call icepack_query_tracer_flags(tr_iage_out=tr_iage, tr_FY_out=tr_FY, & tr_lvl_out=tr_lvl, tr_pond_cesm_out=tr_pond_cesm, 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_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__) @@ -317,17 +318,28 @@ subroutine ice_step enddo endif + call ice_timer_start(timer_column) ! column physics + call ice_timer_start(timer_thermo) ! thermodynamics + !----------------------------------------------------------------- - ! albedo, shortwave radiation + ! snow redistribution and metamorphosis !----------------------------------------------------------------- - call ice_timer_start(timer_column) ! column physics - call ice_timer_start(timer_thermo) ! thermodynamics + if (tr_snow) then ! advanced snow physics + do iblk = 1, nblocks + call step_snow (dt, iblk) + enddo + call update_state (dt) ! clean up + endif !MHRI: CHECK THIS OMP !$OMP PARALLEL DO PRIVATE(iblk) do iblk = 1, nblocks + !----------------------------------------------------------------- + ! albedo, shortwave radiation + !----------------------------------------------------------------- + if (ktherm >= 0) call step_radiation (dt, iblk) if (debug_model) then @@ -383,6 +395,7 @@ subroutine ice_step if (tr_pond_cesm) call write_restart_pond_cesm 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 diff --git a/cicecore/drivers/unittest/calchk/calchk.F90 b/cicecore/drivers/unittest/calchk/calchk.F90 index 081932c8f..d669dbad3 100644 --- a/cicecore/drivers/unittest/calchk/calchk.F90 +++ b/cicecore/drivers/unittest/calchk/calchk.F90 @@ -1,10 +1,13 @@ program calchk + ! This tests the CICE calendar by calling it directly from this driver + ! and verifies results from hardwired inputs with known outputs + use ice_kinds_mod, only: int_kind, dbl_kind use ice_calendar, only: myear, mmonth, mday, msec use ice_calendar, only: year_init, month_init, day_init, sec_init - use ice_calendar, only: dt, ndtd, istep0, diagfreq, npt, npt_unit + use ice_calendar, only: dt, istep0, diagfreq, npt, npt_unit use ice_calendar, only: months_per_year, daymo, timesecs, seconds_per_day use ice_calendar, only: use_leap_years, days_per_year use ice_calendar, only: compute_elapsed_days @@ -54,8 +57,6 @@ program calchk testname(8) = 'calc_timesteps' testname(9) = 'seconds_to_hms' - ndtd = 1 - ! test yearmax years from year 0 ! yearmax = 1000 yearmax = 100000 @@ -600,10 +601,11 @@ program calchk 1002 format(a,i10,1x,a) write(6,*) ' ' + write(6,*) 'CALCHK COMPLETED SUCCESSFULLY' if (errorflag0 == passflag) then - write(6,*) 'CALCHK COMPLETED SUCCESSFULLY' + write(6,*) 'CALCHK TEST COMPLETED SUCCESSFULLY' else - write(6,*) 'CALCHK FAILED' + write(6,*) 'CALCHK TEST FAILED' endif end program diff --git a/cicecore/shared/ice_arrays_column.F90 b/cicecore/shared/ice_arrays_column.F90 index 9480d79bc..dbad4292c 100644 --- a/cicecore/shared/ice_arrays_column.F90 +++ b/cicecore/shared/ice_arrays_column.F90 @@ -1,7 +1,7 @@ !======================================================================= ! Grid-dependent arrays needed for column package -! These were originally module variables in modules that became part of +! These were originally module variables in modules that became part of ! the column package ! author: Elizabeth C. Hunke, LANL @@ -13,7 +13,7 @@ module ice_arrays_column use ice_blocks, only: nx_block, ny_block use ice_domain_size, only: max_blocks, ncat, nilyr, nslyr, & nblyr, nfsd, nfreq - use icepack_intfc, only: icepack_nspint_3bd + use icepack_intfc, only: icepack_nspint use icepack_intfc, only: icepack_query_tracer_sizes, icepack_query_parameters, & icepack_query_tracer_flags, & icepack_warnings_flush, icepack_warnings_aborted, icepack_query_tracer_sizes @@ -24,7 +24,6 @@ module ice_arrays_column public :: alloc_arrays_column ! icepack_atmo.F90 - ! Cdn variables on the T-grid real (kind=dbl_kind), public, & dimension (:,:,:), allocatable :: & Cdn_atm , & ! atm drag coefficient @@ -69,43 +68,51 @@ module ice_arrays_column character (len=35), public, allocatable :: c_hi_range(:) ! icepack_snow.F90 - real (kind=dbl_kind), public, dimension (:,:,:), allocatable :: & + real (kind=dbl_kind), public, & + dimension (:,:,:), allocatable :: & meltsliq ! snow melt mass (kg/m^2/step-->kg/m^2/day) - real (kind=dbl_kind), public, dimension (:,:,:,:), allocatable :: & + real (kind=dbl_kind), public, & + dimension (:,:,:,:), allocatable :: & meltsliqn ! snow melt mass in category n (kg/m^2) ! icepack_meltpond_lvl.F90 - real (kind=dbl_kind), public, dimension (:,:,:,:), allocatable :: & + real (kind=dbl_kind), public, & + dimension (:,:,:,:), allocatable :: & dhsn, & ! depth difference for snow on sea ice and pond ice ffracn ! fraction of fsurfn used to melt ipond ! icepack_shortwave.F90 ! category albedos - real (kind=dbl_kind), dimension (:,:,:,:), allocatable, public :: & + real (kind=dbl_kind), & + dimension (:,:,:,:), allocatable, public :: & alvdrn , & ! visible direct albedo (fraction) alidrn , & ! near-ir direct albedo (fraction) alvdfn , & ! visible diffuse albedo (fraction) alidfn ! near-ir diffuse albedo (fraction) ! albedo components for history - real (kind=dbl_kind), dimension (:,:,:,:), allocatable, public :: & - albicen, & ! bare ice - albsnon, & ! snow - albpndn, & ! pond + real (kind=dbl_kind), & + dimension (:,:,:,:), allocatable, public :: & + albicen, & ! bare ice + albsnon, & ! snow + albpndn, & ! pond apeffn ! effective pond area used for radiation calculation real (kind=dbl_kind), dimension (:,:,:,:), allocatable, public :: & snowfracn ! Category snow fraction used in radiation ! shortwave components - real (kind=dbl_kind), dimension (:,:,:,:,:), allocatable, public :: & + real (kind=dbl_kind), & + dimension (:,:,:,:,:), allocatable, public :: & Iswabsn ! SW radiation absorbed in ice layers (W m-2) - real (kind=dbl_kind), dimension (:,:,:,:,:), allocatable, public :: & + real (kind=dbl_kind), & + dimension (:,:,:,:,:), allocatable, public :: & Sswabsn ! SW radiation absorbed in snow layers (W m-2) - real (kind=dbl_kind), dimension (:,:,:,:), allocatable, public :: & + real (kind=dbl_kind), dimension (:,:,:,:), allocatable, & + public :: & fswsfcn , & ! SW absorbed at ice/snow surface (W m-2) fswthrun , & ! SW through ice to ocean (W/m^2) fswthrun_vdr , & ! vis dir SW through ice to ocean (W/m^2) @@ -114,15 +121,32 @@ module ice_arrays_column fswthrun_idf , & ! nir dif SW through ice to ocean (W/m^2) fswintn ! SW absorbed in ice interior, below surface (W m-2) - real (kind=dbl_kind), dimension (:,:,:,:,:), allocatable, public :: & + real (kind=dbl_kind), dimension (:,:,:,:,:), allocatable, & + public :: & fswpenln ! visible SW entering ice layers (W m-2) + ! aerosol optical properties -> band | + ! v aerosol + ! for combined dust category, use category 4 properties + real (kind=dbl_kind), dimension(:,:), allocatable, public :: & + kaer_tab, & ! aerosol mass extinction cross section (m2/kg) + waer_tab, & ! aerosol single scatter albedo (fraction) + gaer_tab ! aerosol asymmetry parameter (cos(theta)) + + real (kind=dbl_kind), dimension(:,:), allocatable, public :: & + kaer_bc_tab, & ! BC mass extinction cross section (m2/kg) + waer_bc_tab, & ! BC single scatter albedo (fraction) + gaer_bc_tab ! BC aerosol asymmetry parameter (cos(theta)) + + real (kind=dbl_kind), dimension(:,:,:), allocatable, public :: & + bcenh ! BC absorption enhancement factor + ! biogeochemistry components real (kind=dbl_kind), dimension (:), allocatable, public :: & bgrid , & ! biology nondimensional vertical grid points igrid , & ! biology vertical interface points - cgrid , & ! CICE vertical coordinate + cgrid , & ! CICE vertical coordinate icgrid , & ! interface grid for CICE (shortwave variable) swgrid ! grid for ice tracers used in dEdd scheme @@ -163,64 +187,88 @@ module ice_arrays_column ! 2*icepack_max_algae + icepack_max_doc + 7 + icepack_max_dic + icepack_max_don + icepack_max_fe ! Fep(1:icepack_max_fe) = 2*icepack_max_algae + icepack_max_doc + 8 + icepack_max_dic + icepack_max_don + icepack_max_fe: ! 2*icepack_max_algae + icepack_max_doc + 7 + icepack_max_dic + icepack_max_don + 2*icepack_max_fe - ! zaero(1:icepack_max_aero) = 2*icepack_max_algae + icepack_max_doc + 8 + icepack_max_dic + icepack_max_don + 2*icepack_max_fe: + ! zaero(1:icepack_max_aero) = 2*icepack_max_algae + icepack_max_doc + 8 + icepack_max_dic + icepack_max_don + 2*icepack_max_fe: ! 2*icepack_max_algae + icepack_max_doc + 7 + icepack_max_dic + icepack_max_don + 2*icepack_max_fe ! + icepack_max_aero ! humic == 2*icepack_max_algae + icepack_max_doc + 8 + icepack_max_dic + icepack_max_don + 2*icepack_max_fe - ! + icepack_max_aero + ! + icepack_max_aero integer (kind=int_kind), dimension(:,:,:,:), allocatable, public :: & - algal_peak ! vertical location of algal maximum, 0 if no maximum + algal_peak ! vertical location of algal maximum, 0 if no maximum - real (kind=dbl_kind), dimension (:,:,:,:,:), allocatable, public :: & + real (kind=dbl_kind), & + dimension (:,:,:,:,:), allocatable, public :: & Zoo ! N losses accumulated in timestep (ie. zooplankton/bacteria) ! mmol/m^3 - real (kind=dbl_kind), dimension (:,:,:,:), allocatable, public :: & + real (kind=dbl_kind), & + dimension (:,:,:,:), allocatable, public :: & dhbr_top , & ! brine top change dhbr_bot ! brine bottom change - real (kind=dbl_kind), dimension (:,:,:), allocatable, public :: & + real (kind=dbl_kind), & + dimension (:,:,:), allocatable, public :: & grow_net , & ! Specific growth rate (/s) per grid cell PP_net , & ! Total production (mg C/m^2/s) per grid cell hbri ! brine height, area-averaged for comparison with hi (m) - real (kind=dbl_kind), dimension (:,:,:,:,:), allocatable, public :: & - bphi , & ! porosity of layers + real (kind=dbl_kind), & + dimension (:,:,:,:,:), allocatable, public :: & + bphi , & ! porosity of layers bTiz ! layer temperatures interpolated on bio grid (C) - real (kind=dbl_kind), dimension (:,:,:,:), allocatable, public :: & + real (kind=dbl_kind), & + dimension (:,:,:,:), allocatable, public :: & darcy_V ! darcy velocity positive up (m/s) real (kind=dbl_kind), dimension (:,:,:), allocatable, public :: & - chl_net , & ! Total chla (mg chla/m^2) per grid cell - NO_net ! Total nitrate per grid cell + zsal_tot , & ! Total ice salinity in per grid cell (g/m^2) + chl_net , & ! Total chla (mg chla/m^2) per grid cell + NO_net ! Total nitrate per grid cell - real (kind=dbl_kind), dimension (:,:,:,:), allocatable, public :: & + logical (kind=log_kind), dimension (:,:,:), allocatable, public :: & + Rayleigh_criteria ! .true. means Ra_c was reached + + real (kind=dbl_kind), dimension (:,:,:), allocatable, public :: & + Rayleigh_real ! .true. = c1, .false. = c0 + + real (kind=dbl_kind), & + dimension (:,:,:,:), allocatable, public :: & sice_rho ! avg sea ice density (kg/m^3) ! ech: diagnostic only? + real (kind=dbl_kind), & + dimension (:,:,:,:), allocatable, public :: & + fzsaln, & ! category fzsal(kg/m^2/s) + fzsaln_g ! salt flux from gravity drainage only + + real (kind=dbl_kind), dimension (:,:,:), allocatable, public :: & + fzsal , & ! Total flux of salt to ocean at time step for conservation + fzsal_g ! Total gravity drainage flux + real (kind=dbl_kind), dimension (:,:,:,:,:), allocatable, public :: & zfswin ! Shortwave flux into layers interpolated on bio grid (W/m^2) real (kind=dbl_kind), dimension (:,:,:,:,:), allocatable, public :: & - iDi , & ! igrid Diffusivity (m^2/s) - iki ! Ice permeability (m^2) + iDi , & ! igrid Diffusivity (m^2/s) + iki ! Ice permeability (m^2) real (kind=dbl_kind), dimension (:,:,:), allocatable, public :: & upNO , & ! nitrate uptake rate (mmol/m^2/d) times aice upNH ! ammonium uptake rate (mmol/m^2/d) times aice - - real (kind=dbl_kind), dimension(:,:,:,:,:), allocatable, public :: & - trcrn_sw ! bgc tracers active in the delta-Eddington shortwave + + real (kind=dbl_kind), & + dimension(:,:,:,:,:), allocatable, public :: & + trcrn_sw ! bgc tracers active in the delta-Eddington shortwave ! calculation on the shortwave grid (swgrid) - real (kind=dbl_kind), dimension (:,:,:,:), allocatable, public :: & - ice_bio_net , & ! depth integrated tracer (mmol/m^2) + real (kind=dbl_kind), & + dimension (:,:,:,:), allocatable, public :: & + ice_bio_net , & ! depth integrated tracer (mmol/m^2) snow_bio_net ! depth integrated snow tracer (mmol/m^2) logical (kind=log_kind), public :: & oceanmixed_ice, & ! if true, use internal ocean mixed layer - restore_bgc ! + restore_bgc ! character(char_len), public :: & fe_data_type ! 'default', 'clim' @@ -228,7 +276,11 @@ module ice_arrays_column character(char_len_long), public :: & bgc_data_dir ! directory for biogeochemistry data - real (kind=dbl_kind), dimension(:), allocatable, public :: & + character(char_len_long), public :: & + optics_file, & ! modal aero optics file + optics_file_fieldname ! modal aero optics file fieldname + + real (kind=dbl_kind), dimension(:), allocatable, public :: & R_C2N_DON ! carbon to nitrogen mole ratio of DON pool real (kind=dbl_kind), dimension(:), allocatable, public :: & @@ -301,8 +353,14 @@ subroutine alloc_arrays_column grow_net (nx_block,ny_block,max_blocks), & ! Specific growth rate (/s) per grid cell PP_net (nx_block,ny_block,max_blocks), & ! Total production (mg C/m^2/s) per grid cell hbri (nx_block,ny_block,max_blocks), & ! brine height, area-averaged for comparison with hi (m) - chl_net (nx_block,ny_block,max_blocks), & ! Total chla (mg chla/m^2) per grid cell - NO_net (nx_block,ny_block,max_blocks), & ! Total nitrate per grid cell + zsal_tot (nx_block,ny_block,max_blocks), & ! Total ice salinity in per grid cell (g/m^2) + chl_net (nx_block,ny_block,max_blocks), & ! Total chla (mg chla/m^2) per grid cell + NO_net (nx_block,ny_block,max_blocks), & ! Total nitrate per grid cell + Rayleigh_criteria & + (nx_block,ny_block,max_blocks), & ! .true. means Ra_c was reached + Rayleigh_real(nx_block,ny_block,max_blocks), & ! .true. = c1, .false. = c0 + fzsal (nx_block,ny_block,max_blocks), & ! Total flux of salt to ocean at time step for conservation + fzsal_g (nx_block,ny_block,max_blocks), & ! Total gravity drainage flux upNO (nx_block,ny_block,max_blocks), & ! nitrate uptake rate (mmol/m^2/d) times aice upNH (nx_block,ny_block,max_blocks), & ! ammonium uptake rate (mmol/m^2/d) times aice meltsliq (nx_block,ny_block,max_blocks), & ! snow melt mass (kg/m^2) @@ -313,9 +371,9 @@ subroutine alloc_arrays_column alidrn (nx_block,ny_block,ncat,max_blocks), & ! near-ir direct albedo (fraction) alvdfn (nx_block,ny_block,ncat,max_blocks), & ! visible diffuse albedo (fraction) alidfn (nx_block,ny_block,ncat,max_blocks), & ! near-ir diffuse albedo (fraction) - albicen (nx_block,ny_block,ncat,max_blocks), & ! bare ice - albsnon (nx_block,ny_block,ncat,max_blocks), & ! snow - albpndn (nx_block,ny_block,ncat,max_blocks), & ! pond + albicen (nx_block,ny_block,ncat,max_blocks), & ! bare ice + albsnon (nx_block,ny_block,ncat,max_blocks), & ! snow + albpndn (nx_block,ny_block,ncat,max_blocks), & ! pond apeffn (nx_block,ny_block,ncat,max_blocks), & ! effective pond area used for radiation calculation snowfracn (nx_block,ny_block,ncat,max_blocks), & ! Category snow fraction used in radiation fswsfcn (nx_block,ny_block,ncat,max_blocks), & ! SW absorbed at ice/snow surface (W m-2) @@ -327,19 +385,21 @@ subroutine alloc_arrays_column fswintn (nx_block,ny_block,ncat,max_blocks), & ! SW absorbed in ice interior, below surface (W m-2) first_ice_real & (nx_block,ny_block,ncat,max_blocks), & ! .true. = c1, .false. = c0 - first_ice (nx_block,ny_block,ncat,max_blocks), & ! distinguishes ice that disappears (melts) and reappears (transport) + first_ice (nx_block,ny_block,ncat,max_blocks), & ! distinguishes ice that disappears (e.g. melts) and reappears (e.g. transport) dhbr_top (nx_block,ny_block,ncat,max_blocks), & ! brine top change dhbr_bot (nx_block,ny_block,ncat,max_blocks), & ! brine bottom change darcy_V (nx_block,ny_block,ncat,max_blocks), & ! darcy velocity positive up (m/s) sice_rho (nx_block,ny_block,ncat,max_blocks), & ! avg sea ice density (kg/m^3) ! ech: diagnostic only? + fzsaln (nx_block,ny_block,ncat,max_blocks), & ! category fzsal(kg/m^2/s) + fzsaln_g (nx_block,ny_block,ncat,max_blocks), & ! salt flux from gravity drainage only Iswabsn (nx_block,ny_block,nilyr,ncat,max_blocks), & ! SW radiation absorbed in ice layers (W m-2) Sswabsn (nx_block,ny_block,nslyr,ncat,max_blocks), & ! SW radiation absorbed in snow layers (W m-2) fswpenln (nx_block,ny_block,nilyr+1,ncat,max_blocks), & ! visible SW entering ice layers (W m-2) Zoo (nx_block,ny_block,nblyr+1,ncat,max_blocks), & ! N losses accumulated in timestep (ie. zooplankton/bacteria) zfswin (nx_block,ny_block,nblyr+1,ncat,max_blocks), & ! Shortwave flux into layers interpolated on bio grid (W/m^2) - iDi (nx_block,ny_block,nblyr+1,ncat,max_blocks), & ! igrid Diffusivity (m^2/s) - iki (nx_block,ny_block,nblyr+1,ncat,max_blocks), & ! Ice permeability (m^2) - bphi (nx_block,ny_block,nblyr+2,ncat,max_blocks), & ! porosity of layers + iDi (nx_block,ny_block,nblyr+1,ncat,max_blocks), & ! igrid Diffusivity (m^2/s) + iki (nx_block,ny_block,nblyr+1,ncat,max_blocks), & ! Ice permeability (m^2) + bphi (nx_block,ny_block,nblyr+2,ncat,max_blocks), & ! porosity of layers bTiz (nx_block,ny_block,nblyr+2,ncat,max_blocks), & ! layer temperatures interpolated on bio grid (C) stat=ierr) if (ierr/=0) call abort_ice(subname//': Out of Memory1') @@ -349,9 +409,9 @@ subroutine alloc_arrays_column fbio_snoice (nx_block,ny_block,max_nbtrcr,max_blocks), & ! fluxes from snow to ice fbio_atmice (nx_block,ny_block,max_nbtrcr,max_blocks), & ! fluxes from atm to ice ocean_bio_all(nx_block,ny_block,max_nbtrcr,max_blocks), & ! fixed order, all values even for tracers false - ice_bio_net (nx_block,ny_block,max_nbtrcr,max_blocks), & ! depth integrated tracer (mmol/m^2) + ice_bio_net (nx_block,ny_block,max_nbtrcr,max_blocks), & ! depth integrated tracer (mmol/m^2) snow_bio_net (nx_block,ny_block,max_nbtrcr,max_blocks), & ! depth integrated snow tracer (mmol/m^2) - algal_peak (nx_block,ny_block,max_algae ,max_blocks), & ! vertical location of algal maximum, 0 if no maximum + algal_peak (nx_block,ny_block,max_algae ,max_blocks), & ! vertical location of algal maximum, 0 if no maximum stat=ierr) if (ierr/=0) call abort_ice(subname//': Out of Memory2') @@ -360,12 +420,23 @@ subroutine alloc_arrays_column c_hi_range(ncat) , & ! bgrid(nblyr+2) , & ! biology nondimensional vertical grid points igrid(nblyr+1) , & ! biology vertical interface points - cgrid(nilyr+1) , & ! CICE vertical coordinate + cgrid(nilyr+1) , & ! CICE vertical coordinate icgrid(nilyr+1) , & ! interface grid for CICE (shortwave variable) swgrid(nilyr+1) , & ! grid for ice tracers used in dEdd scheme stat=ierr) if (ierr/=0) call abort_ice(subname//' Out of Memory3') + allocate( & + kaer_tab(icepack_nspint,max_aero), & ! aerosol mass extinction cross section (m2/kg) + waer_tab(icepack_nspint,max_aero), & ! aerosol single scatter albedo (fraction) + gaer_tab(icepack_nspint,max_aero), & ! aerosol asymmetry parameter (cos(theta)) + kaer_bc_tab(icepack_nspint,nmodal1), & ! BC mass extinction cross section (m2/kg) + waer_bc_tab(icepack_nspint,nmodal1), & ! BC single scatter albedo (fraction) + gaer_bc_tab(icepack_nspint,nmodal1), & ! BC aerosol asymmetry parameter (cos(theta)) + bcenh(icepack_nspint,nmodal1,nmodal2), & ! BC absorption enhancement factor + stat=ierr) + if (ierr/=0) call abort_ice(subname//' Out of Memory4') + ! floe size distribution allocate( & floe_rad_l (nfsd) , & ! fsd size lower bound in m (radius) diff --git a/cicecore/shared/ice_init_column.F90 b/cicecore/shared/ice_init_column.F90 index 08e32c283..664d88e5a 100644 --- a/cicecore/shared/ice_init_column.F90 +++ b/cicecore/shared/ice_init_column.F90 @@ -45,7 +45,7 @@ module ice_init_column init_age, init_FY, init_lvl, init_fsd, & init_meltponds_cesm, init_meltponds_lvl, init_meltponds_topo, & init_aerosol, init_bgc, init_hbrine, init_zbgc, input_zbgc, & - count_tracers, init_isotope + count_tracers, init_isotope, init_snowtracers ! namelist parameters needed locally @@ -214,8 +214,9 @@ subroutine init_shortwave logical (kind=log_kind) :: & l_print_point, & ! flag to print designated grid point diagnostics debug, & ! if true, print diagnostics - dEdd_algae, & ! from icepack - modal_aero ! from icepack + dEdd_algae, & ! use prognostic chla in dEdd radiation + modal_aero, & ! use modal aerosol optical treatment + snwgrain ! use variable snow radius character (char_len) :: shortwave @@ -225,12 +226,13 @@ subroutine init_shortwave real (kind=dbl_kind), dimension(ncat) :: & fbri ! brine height to ice thickness - real(kind=dbl_kind), allocatable :: & - ztrcr_sw(:,:) ! + 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_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) :: & @@ -243,17 +245,19 @@ subroutine init_shortwave 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_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 @@ -330,8 +334,14 @@ subroutine init_shortwave fbri(:) = c0 ztrcr_sw(:,:) = c0 + rsnow (:,:) = c0 do n = 1, ncat - if (tr_brine) fbri(n) = trcrn(i,j,nt_fbri,n,iblk) + 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 @@ -379,6 +389,7 @@ subroutine init_shortwave albpndn=albpndn(i,j,:,iblk), apeffn=apeffn(i,j,:,iblk), & snowfracn=snowfracn(i,j,:,iblk), & dhsn=dhsn(i,j,:,iblk), ffracn=ffracn(i,j,:,iblk), & + rsnow=rsnow(:,:), & l_print_point=l_print_point, & initonly = .true.) endif @@ -475,6 +486,7 @@ subroutine init_shortwave enddo ! iblk deallocate(ztrcr_sw) + deallocate(rsnow) call icepack_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & @@ -587,6 +599,29 @@ 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) @@ -1770,10 +1805,12 @@ subroutine count_tracers 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_cesm, 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, & @@ -1856,7 +1893,7 @@ subroutine count_tracers tr_lvl_out=tr_lvl, tr_aero_out=tr_aero, tr_pond_out=tr_pond, & tr_pond_cesm_out=tr_pond_cesm, 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_iso_out=tr_iso, & + 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, & @@ -1919,6 +1956,21 @@ subroutine count_tracers 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 @@ -2206,7 +2258,7 @@ subroutine count_tracers !tcx, +1 here is the unused tracer, want to get rid of it ntrcr = ntrcr + 1 -!tcx, reset unusaed tracer index, eventually get rid of it. +!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 @@ -2214,6 +2266,10 @@ subroutine count_tracers 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 @@ -2240,6 +2296,7 @@ subroutine count_tracers 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, & diff --git a/cicecore/shared/ice_restart_column.F90 b/cicecore/shared/ice_restart_column.F90 index e819b1098..074b37dbe 100644 --- a/cicecore/shared/ice_restart_column.F90 +++ b/cicecore/shared/ice_restart_column.F90 @@ -12,7 +12,7 @@ module ice_restart_column use ice_communicate, only: my_task, master_task use ice_constants, only: c0, c1, p5 use ice_constants, only: field_loc_center, field_type_scalar - use ice_domain_size, only: ncat, nfsd, nblyr + use ice_domain_size, only: ncat, nslyr, nfsd, nblyr use ice_restart,only: read_restart_field, write_restart_field use ice_exit, only: abort_ice use ice_fileunits, only: nu_diag @@ -32,6 +32,7 @@ module ice_restart_column write_restart_pond_cesm, read_restart_pond_cesm, & write_restart_pond_lvl, read_restart_pond_lvl, & write_restart_pond_topo, read_restart_pond_topo, & + write_restart_snow, read_restart_snow, & write_restart_fsd, read_restart_fsd, & write_restart_iso, read_restart_iso, & write_restart_aero, read_restart_aero, & @@ -45,6 +46,7 @@ module ice_restart_column restart_pond_cesm, & ! if .true., read meltponds restart file restart_pond_lvl , & ! if .true., read meltponds restart file restart_pond_topo, & ! if .true., read meltponds restart file + restart_snow , & ! if .true., read snow tracer restart file restart_fsd , & ! if .true., read floe size restart file restart_iso , & ! if .true., read isotope tracer restart file restart_aero , & ! if .true., read aerosol tracer restart file @@ -483,6 +485,93 @@ end subroutine read_restart_pond_topo !======================================================================= +! Dumps all values needed for restarting snow redistribution/metamorphism +! author Elizabeth C. Hunke, LANL + + subroutine write_restart_snow() + + use ice_fileunits, only: nu_dump_snow + use ice_state, only: trcrn + + ! local variables + + logical (kind=log_kind) :: diag + integer (kind=int_kind) :: nt_smice, nt_smliq, nt_rhos, nt_rsnw, k + character*3 ck + character(len=*),parameter :: subname='(write_restart_snow)' + + call icepack_query_tracer_indices(nt_smice_out=nt_smice, & + nt_smliq_out=nt_smliq, nt_rhos_out=nt_rhos, 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__) + + diag = .true. + + !----------------------------------------------------------------- + + do k = 1,nslyr + write(ck,'(i3.3)') k + call write_restart_field(nu_dump_snow,0, trcrn(:,:,nt_smice+k-1,:,:), & + 'ruf8','smice'//trim(ck),ncat,diag) + call write_restart_field(nu_dump_snow,0, trcrn(:,:,nt_smliq+k-1,:,:), & + 'ruf8','smliq'//trim(ck),ncat,diag) + call write_restart_field(nu_dump_snow,0, trcrn(:,:,nt_rhos+k-1,:,:), & + 'ruf8','rhos'//trim(ck),ncat,diag) + call write_restart_field(nu_dump_snow,0, trcrn(:,:,nt_rsnw+k-1,:,:), & + 'ruf8','rsnw'//trim(ck),ncat,diag) + enddo + + end subroutine write_restart_snow + +!======================================================================= + +! Reads all values needed for a restart with snow redistribution/metamorphism +! author Elizabeth C. Hunke, LANL + + subroutine read_restart_snow() + + use ice_fileunits, only: nu_restart_snow + use ice_state, only: trcrn + + ! local variables + + logical (kind=log_kind) :: & + diag + integer (kind=int_kind) :: nt_smice, nt_smliq, nt_rhos, nt_rsnw, k + character*3 ck + character(len=*),parameter :: subname='(read_restart_snow)' + + call icepack_query_tracer_indices(nt_smice_out=nt_smice, & + nt_smliq_out=nt_smliq, nt_rhos_out=nt_rhos, 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__) + + diag = .true. + + if (my_task == master_task) write(nu_diag,*) subname,'min/max snow tracers' + + do k=1,nslyr + write(ck,'(i3.3)') k + call read_restart_field(nu_restart_snow,0,trcrn(:,:,nt_smice+k-1,:,:), & + 'ruf8','smice'//trim(ck),ncat,diag, & + field_type=field_type_scalar,field_loc=field_loc_center) + call read_restart_field(nu_restart_snow,0,trcrn(:,:,nt_smliq+k-1,:,:), & + 'ruf8','smliq'//trim(ck),ncat,diag, & + field_type=field_type_scalar,field_loc=field_loc_center) + call read_restart_field(nu_restart_snow,0,trcrn(:,:,nt_rhos+k-1,:,:), & + 'ruf8','rhos'//trim(ck),ncat,diag, & + field_type=field_type_scalar,field_loc=field_loc_center) + call read_restart_field(nu_restart_snow,0,trcrn(:,:,nt_rsnw+k-1,:,:), & + 'ruf8','rsnw'//trim(ck),ncat,diag, & + field_type=field_type_scalar,field_loc=field_loc_center) + enddo + + end subroutine read_restart_snow + +!======================================================================= + ! Dumps all values needed for restarting ! author Elizabeth C. Hunke, LANL diff --git a/cicecore/version.txt b/cicecore/version.txt index cfd991555..04a90ef1a 100644 --- a/cicecore/version.txt +++ b/cicecore/version.txt @@ -1 +1 @@ -CICE 6.2.0 +CICE 6.3.0 diff --git a/configuration/scripts/cice.batch.csh b/configuration/scripts/cice.batch.csh index 902abb56b..024270039 100755 --- a/configuration/scripts/cice.batch.csh +++ b/configuration/scripts/cice.batch.csh @@ -226,6 +226,23 @@ cat >> ${jobfile} << EOFB #PBS -l walltime=${batchtime} EOFB +else if (${ICE_MACHINE} =~ gaea*) then +cat >> ${jobfile} << EOFB +#SBATCH -J ${ICE_CASENAME} +#SBATCH --partition=batch +#SBATCH --qos=${queue} +#SBATCH --account=nggps_emc +#SBATCH --clusters=c3 +#SBATCH --time=${batchtime} +#SBATCH --nodes=${nnodes} +#SBATCH --ntasks-per-node=${taskpernodelimit} +#SBATCH --cpus-per-task=${nthrds} +#SBATCH -e slurm%j.err +#SBATCH -o slurm%j.out +##SBATCH --mail-type FAIL +##SBATCH --mail-user=xxx@noaa.gov +EOFB + else if (${ICE_MACHINE} =~ hera*) then cat >> ${jobfile} << EOFB #SBATCH -J ${ICE_CASENAME} diff --git a/configuration/scripts/cice.launch.csh b/configuration/scripts/cice.launch.csh index 7d45a387f..40b8996b4 100755 --- a/configuration/scripts/cice.launch.csh +++ b/configuration/scripts/cice.launch.csh @@ -165,6 +165,12 @@ aprun -n ${ntasks} -N ${taskpernodelimit} -d ${nthrds} ./cice >&! \$ICE_RUNLOG_F EOFR endif +#======= +else if (${ICE_MACHINE} =~ gaea*) then +cat >> ${jobfile} << EOFR +srun -n ${ntasks} -c ${nthrds} ./cice >&! \$ICE_RUNLOG_FILE +EOFR + #======= else if (${ICE_MACHINE} =~ hera*) then cat >> ${jobfile} << EOFR diff --git a/configuration/scripts/cice.run.setup.csh b/configuration/scripts/cice.run.setup.csh index ea8efeb03..aa578b5ca 100755 --- a/configuration/scripts/cice.run.setup.csh +++ b/configuration/scripts/cice.run.setup.csh @@ -100,7 +100,7 @@ else echo "Run completed successfully" echo "\`date\` \${0}: Run completed successfully" >> \${ICE_CASEDIR}/README.case else - echo "CICE run did NOT complete" + echo "Run did NOT complete" echo "\`date\` \${0}: CICE run did NOT complete" >> \${ICE_CASEDIR}/README.case exit -1 endif diff --git a/configuration/scripts/ice_in b/configuration/scripts/ice_in index e5fcb9177..2817fc8b0 100644 --- a/configuration/scripts/ice_in +++ b/configuration/scripts/ice_in @@ -95,6 +95,8 @@ restart_pond_topo = .false. tr_pond_lvl = .true. restart_pond_lvl = .false. + tr_snow = .false. + restart_snow = .false. tr_iso = .false. restart_iso = .false. tr_aero = .false. @@ -122,7 +124,7 @@ kdyn = 1 ndte = 240 revised_evp = .false. - kevp_kernel = 0 + evp_algorithm = 'standard_2d' brlx = 300.0 arlx = 300.0 advection = 'remap' @@ -192,6 +194,28 @@ pndaspect = 0.8 / +&snow_nml + snwredist = 'none' + snwgrain = .false. + use_smliq_pnd = .false. + rsnw_fall = 100.0 + rsnw_tmax = 1500.0 + rhosnew = 100.0 + rhosmin = 100.0 + rhosmax = 450.0 + windmin = 10.0 + drhosdwind = 27.3 + snwlvlfac = 0.3 + snw_aging_table = 'test' + snw_filename = 'unknown' + snw_rhos_fname = 'unknown' + snw_Tgrd_fname = 'unknown' + snw_T_fname = 'unknown' + snw_tau_fname = 'unknown' + snw_kappa_fname = 'unknown' + snw_drdt0_fname = 'unknown' +/ + &forcing_nml formdrag = .false. atmbndy = 'default' @@ -575,6 +599,21 @@ f_apeff_ai = 'm' / +&icefields_snow_nml + f_smassicen = 'x' + f_smassliqn = 'x' + f_rhos_cmpn = 'x' + f_rhos_cntn = 'x' + f_rsnwn = 'x' + f_smassice = 'm' + f_smassliq = 'm' + f_rhos_cmp = 'm' + f_rhos_cnt = 'm' + f_rsnw = 'm' + f_meltsliq = 'm' + f_fsloss = 'm' +/ + &icefields_bgc_nml f_fiso_atm = 'x' f_fiso_ocn = 'x' diff --git a/configuration/scripts/machines/Macros.onyx_gnu b/configuration/scripts/machines/Macros.onyx_gnu index d423cd9ab..fc07361fb 100644 --- a/configuration/scripts/machines/Macros.onyx_gnu +++ b/configuration/scripts/machines/Macros.onyx_gnu @@ -8,7 +8,7 @@ CFLAGS := -c FIXEDFLAGS := -ffixed-line-length-132 FREEFLAGS := -ffree-form -FFLAGS := -fconvert=big-endian -fbacktrace -ffree-line-length-none +FFLAGS := -fconvert=big-endian -fbacktrace -ffree-line-length-none -fallow-argument-mismatch FFLAGS_NOOPT:= -O0 ifeq ($(ICE_BLDDEBUG), true) diff --git a/configuration/scripts/machines/env.gaea_intel b/configuration/scripts/machines/env.gaea_intel old mode 100644 new mode 100755 index 3601bfcfb..d143270d7 --- a/configuration/scripts/machines/env.gaea_intel +++ b/configuration/scripts/machines/env.gaea_intel @@ -16,13 +16,10 @@ module load cray-netcdf module load PrgEnv-intel/6.0.5 module list -# May be needed for OpenMP memory -#setenv OMP_STACKSIZE 64M - endif setenv ICE_MACHINE_MACHNAME gaea -setenv ICE_MACHINE_MACHINFO "Cray XC40 Intel Haswell/Broadwell 2.3GHz, Gemini Interconnect" +setenv ICE_MACHINE_MACHINFO "Cray Intel SkyLake 6148" setenv ICE_MACHINE_ENVNAME intel setenv ICE_MACHINE_ENVINFO "ifort 18.0.5 20180823, cray-mpich, cray-netcdf" setenv ICE_MACHINE_MAKE gmake diff --git a/configuration/scripts/machines/env.onyx_cray b/configuration/scripts/machines/env.onyx_cray old mode 100644 new mode 100755 index e879cdf03..38785a27d --- 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.10 +module load PrgEnv-cray/6.0.9 module unload cce -module load cce/14.0.3 +module load cce/11.0.2 module unload cray-mpich module unload cray-mpich2 -module load cray-mpich/7.7.20 +module load cray-mpich/7.7.16 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.8.1.3 -module load cray-hdf5/1.12.1.3 +module load cray-netcdf/4.7.4.0 +module load cray-hdf5/1.12.0.0 module unload cray-libsci module unload craype-hugepages2M @@ -39,14 +39,13 @@ module load craype-broadwell setenv NETCDF_PATH ${NETCDF_DIR} limit coredumpsize unlimited limit stacksize unlimited -setenv OMP_STACKSIZE 64M 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/14.0.3, cray-mpich/7.7.20, netcdf/4.8.1.3" +setenv ICE_MACHINE_ENVINFO "Cray cce/11.0.2, cray-mpich/7.7.16, netcdf/4.7.4.0" 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 old mode 100644 new mode 100755 index 19a4eb701..699c01559 --- 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.10 +module load PrgEnv-gnu/6.0.9 module unload gcc -module load gcc/12.1.0 +module load gcc/10.2.0 module unload cray-mpich module unload cray-mpich2 -module load cray-mpich/7.7.20 +module load cray-mpich/7.7.16 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.8.1.3 -module load cray-hdf5/1.12.1.3 +module load cray-netcdf/4.7.4.0 +module load cray-hdf5/1.12.0.0 module unload cray-libsci module unload craype-hugepages2M @@ -39,14 +39,13 @@ module load craype-broadwell setenv NETCDF_PATH ${NETCDF_DIR} limit coredumpsize unlimited limit stacksize unlimited -setenv OMP_STACKSIZE 64M 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) 12.1.0, cray-mpich/7.7.20, netcdf/4.8.1.3" +setenv ICE_MACHINE_ENVINFO "GNU Fortran (GCC) 10.2.0, cray-mpich/7.7.16, netcdf/4.7.4.0" 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 old mode 100644 new mode 100755 index 999d5a2bd..39f25e8e5 --- 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.10 +module load PrgEnv-intel/6.0.9 module unload intel -module load intel/2021.4.0 +module load intel/19.1.3.304 module unload cray-mpich module unload cray-mpich2 -module load cray-mpich/7.7.20 +module load cray-mpich/7.7.16 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.8.1.3 -module load cray-hdf5/1.12.1.3 +module load cray-netcdf/4.7.4.0 +module load cray-hdf5/1.12.0.0 module unload cray-libsci module unload craype-hugepages2M @@ -39,14 +39,13 @@ module load craype-broadwell setenv NETCDF_PATH ${NETCDF_DIR} limit coredumpsize unlimited limit stacksize unlimited -setenv OMP_STACKSIZE 64M 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 2021.4.0, cray-mpich/7.7.20, netcdf/4.8.1.3" +setenv ICE_MACHINE_ENVINFO "ifort 19.1.3.304, cray-mpich/7.7.16, netcdf/4.7.4.0" setenv ICE_MACHINE_MAKE gmake setenv ICE_MACHINE_WKDIR $WORKDIR/CICE_RUNS setenv ICE_MACHINE_INPUTDATA /p/app/unsupported/RASM/cice_consortium diff --git a/configuration/scripts/options/set_nml.gx1prod b/configuration/scripts/options/set_nml.gx1prod index f725c4367..761d14b73 100644 --- a/configuration/scripts/options/set_nml.gx1prod +++ b/configuration/scripts/options/set_nml.gx1prod @@ -1,10 +1,10 @@ year_init = 2005 use_leap_years = .true. npt_unit = 'y' -npt = 1 +npt = 4 dumpfreq = 'm' fyear_init = 2005 -ycycle = 5 +ycycle = 4 ocn_data_dir = 'ICE_MACHINE_INPUTDATA/CICE_data/forcing/gx1/CESM/MONTHLY/' use_bathymetry = .true. seabed_stress = .true. diff --git a/configuration/scripts/options/set_nml.snwITDrdg b/configuration/scripts/options/set_nml.snwITDrdg new file mode 100644 index 000000000..cddeedec3 --- /dev/null +++ b/configuration/scripts/options/set_nml.snwITDrdg @@ -0,0 +1,10 @@ +tr_snow = .true. +snwredist = 'ITDrdg' +nslyr = 5 +rhosnew = 100.0 +rhosmin = 100.0 +rhosmax = 450.0 +windmin = 10.0 +drhosdwind = 27.3 +snwlvlfac = 0.3 + diff --git a/configuration/scripts/tests/base_suite.ts b/configuration/scripts/tests/base_suite.ts index 71b33272d..4da4dd110 100644 --- a/configuration/scripts/tests/base_suite.ts +++ b/configuration/scripts/tests/base_suite.ts @@ -58,6 +58,9 @@ restart gx3 4x2 fsd12,debug,short smoke gx3 8x2 fsd12ww3,diag24,run1day smoke gx3 4x1 isotope,debug restart gx3 8x2 isotope +smoke gx3 4x1 snwITDrdg,snwgrain,icdefault,debug +smoke gx3 4x1 snw30percent,icdefault,debug +restart gx3 8x2 snwITDrdg,icdefault,snwgrain restart gx3 4x4 gx3ncarbulk,iobinary restart gx3 4x4 histall,precision8,cdf64 smoke gx3 30x1 bgcz,histall diff --git a/configuration/scripts/tests/prod_suite.ts b/configuration/scripts/tests/prod_suite.ts index 66226b104..8793dfed2 100644 --- a/configuration/scripts/tests/prod_suite.ts +++ b/configuration/scripts/tests/prod_suite.ts @@ -1,3 +1,4 @@ # Test Grid PEs Sets BFB-compare smoke gx1 64x1 qc,medium -smoke gx1 64x2 gx1prod,long,run10year \ No newline at end of file +smoke gx1 64x2 gx1prod,long,run10year + diff --git a/configuration/scripts/tests/reprosum_suite.ts b/configuration/scripts/tests/reprosum_suite.ts index 417a7de2e..dd6a6d56b 100644 --- a/configuration/scripts/tests/reprosum_suite.ts +++ b/configuration/scripts/tests/reprosum_suite.ts @@ -1,11 +1,12 @@ # Test Grid PEs Sets BFB-compare -smoke gx3 4x2x25x29x4 dslenderX2,diag1,reprosum -#smoke gx3 4x2x25x29x4 dslenderX2,diag1 -smoke gx3 1x1x50x58x4 droundrobin,diag1,thread,maskhalo,reprosum,cmplog smoke_gx3_4x2x25x29x4_diag1_dslenderX2_reprosum -smoke gx3 4x1x25x116x1 dslenderX1,diag1,thread,maskhalo,reprosum,cmplog smoke_gx3_4x2x25x29x4_diag1_dslenderX2_reprosum -smoke gx3 1x20x5x29x80 dsectrobin,diag1,short,reprosum,cmplog smoke_gx3_4x2x25x29x4_diag1_dslenderX2_reprosum -smoke gx3 8x2x8x10x20 droundrobin,diag1,reprosum,cmplog smoke_gx3_4x2x25x29x4_diag1_dslenderX2_reprosum -smoke gx3 6x2x50x58x1 droundrobin,diag1,reprosum,cmplog smoke_gx3_4x2x25x29x4_diag1_dslenderX2_reprosum -smoke gx3 6x2x4x29x18 dspacecurve,diag1,maskhalo,reprosum,cmplog smoke_gx3_4x2x25x29x4_diag1_dslenderX2_reprosum -smoke gx3 17x2x1x1x800 droundrobin,diag1,maskhalo,reprosum,cmplog smoke_gx3_4x2x25x29x4_diag1_dslenderX2_reprosum -#smoke gx3 8x2x8x10x20 droundrobin,diag1,cmplog smoke_gx3_4x2x25x29x4_diag1_dslenderX2 +logbfb gx3 4x2x25x29x4 dslenderX2,diag1,reprosum +#logbfb gx3 4x2x25x29x4 dslenderX2,diag1 +sleep 60 +logbfb gx3 1x1x50x58x4 droundrobin,diag1,thread,maskhalo,reprosum logbfb_gx3_4x2x25x29x4_diag1_dslenderX2_reprosum +logbfb gx3 4x1x25x116x1 dslenderX1,diag1,thread,maskhalo,reprosum logbfb_gx3_4x2x25x29x4_diag1_dslenderX2_reprosum +logbfb gx3 1x20x5x29x80 dsectrobin,diag1,short,reprosum logbfb_gx3_4x2x25x29x4_diag1_dslenderX2_reprosum +logbfb gx3 8x2x8x10x20 droundrobin,diag1,reprosum logbfb_gx3_4x2x25x29x4_diag1_dslenderX2_reprosum +logbfb gx3 6x2x50x58x1 droundrobin,diag1,reprosum logbfb_gx3_4x2x25x29x4_diag1_dslenderX2_reprosum +logbfb gx3 6x2x4x29x18 dspacecurve,diag1,maskhalo,reprosum logbfb_gx3_4x2x25x29x4_diag1_dslenderX2_reprosum +logbfb gx3 17x2x1x1x800 droundrobin,diag1,maskhalo,reprosum logbfb_gx3_4x2x25x29x4_diag1_dslenderX2_reprosum +#logbfb gx3 8x2x8x10x20 droundrobin,diag1 logbfb_gx3_4x2x25x29x4_diag1_dslenderX2 diff --git a/configuration/scripts/tests/test_unittest.script b/configuration/scripts/tests/test_unittest.script index 0fcd148a6..1db8dfe60 100644 --- a/configuration/scripts/tests/test_unittest.script +++ b/configuration/scripts/tests/test_unittest.script @@ -4,21 +4,33 @@ # cice.run returns -1 if run did not complete successfully ./cice.run -set res="$status" +set rres="$status" set log_file = `ls -t1 ${ICE_RUNDIR}/cice.runlog* | head -1` +grep ' TEST COMPLETED SUCCESSFULLY' ${log_file} +set tres="$status" + mv -f ${ICE_CASEDIR}/test_output ${ICE_CASEDIR}/test_output.prev cat ${ICE_CASEDIR}/test_output.prev | grep -iv "${ICE_TESTNAME} run" >! ${ICE_CASEDIR}/test_output mv -f ${ICE_CASEDIR}/test_output ${ICE_CASEDIR}/test_output.prev cat ${ICE_CASEDIR}/test_output.prev | grep -iv "${ICE_TESTNAME} test" >! ${ICE_CASEDIR}/test_output rm -f ${ICE_CASEDIR}/test_output.prev -set grade = FAIL -if ( $res == 0 ) then - set grade = PASS +set rgrade = PASS +if ( $rres != 0 ) then + set rgrade = FAIL +endif +set tgrade = PASS +if ( $tres != 0 ) then + set tgrade = FAIL endif -echo "$grade ${ICE_TESTNAME} run " >> ${ICE_CASEDIR}/test_output -echo "$grade ${ICE_TESTNAME} test " >> ${ICE_CASEDIR}/test_output +echo "$rgrade ${ICE_TESTNAME} run " >> ${ICE_CASEDIR}/test_output +echo "$tgrade ${ICE_TESTNAME} test " >> ${ICE_CASEDIR}/test_output + +if ( "$rgrade" == "FAIL" || "$tgrade" == "FAIL") then + echo "ERROR: Test failed" + exit 99 +endif diff --git a/doc/source/cice_index.rst b/doc/source/cice_index.rst index 69222e10c..0a04b5e26 100644 --- a/doc/source/cice_index.rst +++ b/doc/source/cice_index.rst @@ -6,9 +6,8 @@ Index of primary variables and parameters ========================================== This index defines many of the symbols used frequently in the CICE model -code. Values appearing in this list are fixed or recommended; most -namelist parameters are indicated ( :math:`E_\circ`) with their default -values. For other namelist options, see Section :ref:`tabnamelist`. All +code. Namelist variables are partly included here but also documented +elsewhere, see Section :ref:`tabnamelist`. All quantities in the code are expressed in MKS units (temperatures may take either Celsius or Kelvin units). @@ -28,25 +27,25 @@ either Celsius or Kelvin units). "a4Ds", "history field accumulations, 4D categories, vertical snow", "" "a4Df", "history field accumulations, 4D categories, fsd", "" "a_min", "minimum area concentration for computing velocity", "0.001" - "a_rapid_mode", ":math:`{\bullet}` brine channel diameter", "" - "add_mpi_barriers", ":math:`\bullet` turns on MPI barriers for communication throttling", "" - "advection", ":math:`\bullet` type of advection algorithm used (‘remap’ or ‘upwind’)", "remap" + "a_rapid_mode", "brine channel diameter", "" + "add_mpi_barriers", "turns on MPI barriers for communication throttling", "" + "advection", "type of advection algorithm used (‘remap’ or ‘upwind’)", "remap" "afsd(n)", "floe size distribution (in category n)", "" - "ahmax", ":math:`\bullet` thickness above which ice albedo is constant", "0.3m" + "ahmax", "thickness above which ice albedo is constant", "0.3m" "aice_extmin", "minimum value for ice extent diagnostic", "0.15" "aice_init", "concentration of ice at beginning of timestep", "" "aice0", "fractional open water area", "" "aice(n)", "total concentration of ice in grid cell (in category n)", "" - "albedo_type", ":math:`\bullet` type of albedo parameterization (‘ccsm3’ or ‘constant’)", "" + "albedo_type", "type of albedo parameterization (‘ccsm3’ or ‘constant’)", "" "albcnt", "counter for averaging albedo", "" "albice", "bare ice albedo", "" - "albicei", ":math:`\bullet` near infrared ice albedo for thicker ice", "" - "albicev", ":math:`\bullet` visible ice albedo for thicker ice", "" + "albicei", "near infrared ice albedo for thicker ice", "" + "albicev", "visible ice albedo for thicker ice", "" "albocn", "ocean albedo", "0.06" "albpnd", "melt pond albedo", "" "albsno", "snow albedo", "" - "albsnowi", ":math:`\bullet` near infrared, cold snow albedo", "" - "albsnowv", ":math:`\bullet` visible, cold snow albedo", "" + "albsnowi", "near infrared, cold snow albedo", "" + "albsnowv", "visible, cold snow albedo", "" "algalN", "algal nitrogen concentration", mmol/m\ :math:`^3` "alv(n)dr(f)", "albedo: visible (near IR), direct (diffuse)", "" "alv(n)dr(f)_ai", "grid-box-mean value of alv(n)dr(f)", "" @@ -60,23 +59,23 @@ either Celsius or Kelvin units). "araftn", "area fraction of rafted ice", "" "aredistrn", "redistribution function: fraction of new ridge area", "" "ardgn", "fractional area of ridged ice", "" - "aspect_rapid_mode", ":math:`\bullet` brine convection aspect ratio", "1" + "aspect_rapid_mode", "brine convection aspect ratio", "1" "astar", "e-folding scale for participation function", "0.05" - "atmiter_conv", ":math:`\bullet` convergence criteria for ustar", "0.00" - "atm_data_dir", ":math:`\bullet` directory for atmospheric forcing data", "" - "atm_data_format", ":math:`\bullet` format of atmospheric forcing files", "" - "atm_data_type", ":math:`\bullet` type of atmospheric forcing", "" - "atmbndy", ":math:`\bullet` atmo boundary layer parameterization (‘default’ or ‘constant’)", "" + "atmiter_conv", "convergence criteria for ustar", "0.00" + "atm_data_dir", "directory for atmospheric forcing data", "" + "atm_data_format", "format of atmospheric forcing files", "" + "atm_data_type", "type of atmospheric forcing", "" + "atmbndy", "atmo boundary layer parameterization (‘default’ or ‘constant’)", "" "avail_hist_fields", "type for history field data", "" "awtidf", "weighting factor for near-ir, diffuse albedo", "0.36218" "awtidr", "weighting factor for near-ir, direct albedo", "0.00182" "awtvdf", "weighting factor for visible, diffuse albedo", "0.63282" "awtvdr", "weighting factor for visible, direct albedo", "0.00318" "**B**", "", "" - "bfb_flag", ":math:`\bullet` for bit-for-bit reproducible diagnostics", "" - "bgc_data_dir", ":math:`\bullet` data directory for bgc", "" - "bgc_data_type", ":math:`\bullet` source of silicate, nitrate data", "" - "bgc_flux_type", ":math:`\bullet` ice–ocean flux velocity", "" + "bfb_flag", "for bit-for-bit reproducible diagnostics", "" + "bgc_data_dir", "data directory for bgc", "" + "bgc_data_type", "source of silicate, nitrate data", "" + "bgc_flux_type", "ice–ocean flux velocity", "" "bgc_tracer_type", "tracer_type for bgc tracers", "" "bgrid", "nondimensional vertical grid points for bio grid", "" "bignum", "a large number", ":math:`10^{30}`" @@ -92,12 +91,13 @@ either Celsius or Kelvin units). "bTiz", "temperature of ice layers on bio grid", "" "**C**", "", "" "c", "real(\ :math:`n`)", "" - "rotate_wind", ":math:`\bullet` if true, rotate wind/stress components to computational grid", "T" - "calc_strair", ":math:`\bullet` if true, calculate wind stress", "T" - "calc_Tsfc", ":math:`\bullet` if true, calculate surface temperature", "T" + "rotate_wind", "if true, rotate wind/stress components to computational grid", "T" + "calc_dragio", "if true, calculate ``dragio`` from ``iceruf_ocn`` and ``thickness_ocn_layer1``", "F" + "calc_strair", "if true, calculate wind stress", "T" + "calc_Tsfc", "if true, calculate surface temperature", "T" "Cdn_atm", "atmospheric drag coefficient", "" "Cdn_ocn", "ocean drag coefficient", "" - "Cf", ":math:`\bullet` ratio of ridging work to PE change in ridging", "17." + "Cf", "ratio of ridging work to PE change in ridging", "17." "cgrid", "vertical grid points for ice grid (compare bgrid)", "" "char_len", "length of character variable strings", "80" "char_len_long", "length of longer character variable strings", "256" @@ -107,7 +107,7 @@ either Celsius or Kelvin units). "cm_to_m", "cm to meters conversion", "0.01" "coldice", "value for constant albedo parameterization", "0.70" "coldsnow", "value for constant albedo parameterization", "0.81" - "conduct", ":math:`\bullet` conductivity parameterization", "" + "conduct", "conductivity parameterization", "" "congel", "basal ice growth", "m" "conserv_check", "if true, check conservation", "" "cosw", "cosine of the turning angle in water", "1." @@ -138,11 +138,17 @@ either Celsius or Kelvin units). "dardg2(n)dt", "rate of fractional area gain by new ridges (category n)", "1/s" "daymo", "number of days in one month", "" "daycal", "day number at end of month", "" - "days_per_year", ":math:`\bullet` number of days in one year", "365" - "day_init", ":math:`\bullet` the initial day of the month", "" + "days_per_year", "number of days in one year", "365" + "day_init", "the initial day of the month", "" "dbl_kind", "definition of double precision", "selected_real_kind(13)" + "debug_blocks", "write extra diagnostics for blocks and decomposition", ".false." + "debug_forcing", "write extra diagnostics for forcing inputs", ".false." "debug_model", "Logical that controls extended model point debugging.", "" - "debug_model_step", "Initial timestep for output associated with debug_model.", "" + "debug_model_i", "Local i gridpoint that defines debug_model point output.", "" + "debug_model_iblk", "Local iblk value that defines debug_model point output.", "" + "debug_model_j", "Local j gridpoint that defines debug_model point output.", "" + "debug_model_task", "Local mpi task value that defines debug_model point output.", "" + "debug_model_step", "Initial timestep for output from the debug_model flag.", "" "Delta", "function of strain rates (see Section :ref:`dynam`)", "1/s" "default_season", "Season from which initial values of forcing are set.", "winter" "denom1", "combination of constants for stress equation", "" @@ -150,31 +156,33 @@ either Celsius or Kelvin units). "dhbr_bt", "change in brine height at the bottom of the column", "" "dhbr_top", "change in brine height at the top of the column", "" "dhsn", "depth difference for snow on sea ice and pond ice", "" - "diag_file", ":math:`\bullet` diagnostic output file (alternative to standard out)", "" - "diag_type", ":math:`\bullet` where diagnostic output is written", "stdout" - "diagfreq", ":math:`\bullet` how often diagnostic output is written (10 = once per 10 dt)", "" + "diag_file", "diagnostic output file (alternative to standard out)", "" + "diag_type", "where diagnostic output is written", "stdout" + "diagfreq", "how often diagnostic output is written (10 = once per 10 dt)", "" "distrb", "distribution data type", "" "distrb_info", "block distribution information", "" - "distribution_type", ":math:`\bullet` method used to distribute blocks on processors", "" - "distribution_weight", ":math:`\bullet` weighting method used to compute work per block", "" + "distribution_type", "method used to distribute blocks on processors", "" + "distribution_weight", "weighting method used to compute work per block", "" "divu", "strain rate I component, velocity divergence", "1/s" "divu_adv", "divergence associated with advection", "1/s" "dms", "dimethyl sulfide concentration", "mmol/m\ :math:`^3`" "dmsp", "dimethyl sulfoniopropionate concentration", "mmol/m\ :math:`^3`" - "dpscale", ":math:`\bullet` time scale for flushing in permeable ice", ":math:`1\times 10^{-3}`" + "dpscale", "time scale for flushing in permeable ice", ":math:`1\times 10^{-3}`" + "drhosdwind", "wind compaction factor for snow", "27.3 kg s/m\ :math:`^{4}`" "dragio", "drag coefficient for water on ice", "0.00536" - "dSdt_slow_mode", ":math:`\bullet` drainage strength parameter", "" + "dSdt_slow_mode", "drainage strength parameter", "" "dsnow", "change in snow thickness", "m" - "dt", ":math:`\bullet` thermodynamics time step", "3600. s" + "dt", "thermodynamics time step", "3600. s" "dt_dyn", "dynamics/ridging/transport time step", "" - "dT_mlt", ":math:`\bullet` :math:`\Delta` temperature per :math:`\Delta` snow grain radius", "1. deg" + "dT_mlt", ":math:`\Delta` temperature per :math:`\Delta` snow grain radius", "1. deg" "dte", "subcycling time step for EVP dynamics (:math:`\Delta t_e`)", "s" "dte2T", "dte / 2(damping time scale)", "" "dtei", "1/dte, where dte is the EVP subcycling time step", "1/s" - "dump_file", ":math:`\bullet` output file for restart dump", "" - "dumpfreq", ":math:`\bullet` dump frequency for restarts, y, m, d, h or 1", "" - "dumpfreq_n", ":math:`\bullet` restart output frequency", "" - "dump_last", ":math:`\bullet` if true, write restart on last time step of simulation", "" + "dump_file", "output file for restart dump", "" + "dumpfreq", "dump frequency for restarts, y, m, d, h or 1", "" + "dumpfreq_base", "reference date for restart output", "" + "dumpfreq_n", "restart output frequency", "" + "dump_last", "if true, write restart on last time step of simulation", "" "dwavefreq", "widths of wave frequency bins", "1/s" "dxhy", "combination of HTE values", "" "dxt", "width of T cell (:math:`\Delta x`) through the middle", "m" @@ -195,12 +203,12 @@ either Celsius or Kelvin units). "eps16", "a small number", "10\ :math:`^{-16}`" "esno(n)", "energy of melting of snow per unit area (in category n)", "J/m\ :math:`^2`" "evap", "evaporative water flux", "kg/m\ :math:`^2`/s" - "ew_boundary_type", ":math:`\bullet` type of east-west boundary condition", "" + "ew_boundary_type", "type of east-west boundary condition", "" "eyc", "coefficient for calculating the parameter E, 0\ :math:`<` eyc :math:`<`\ 1", "0.36" "**F**", "", "" "faero_atm", "aerosol deposition rate", "kg/m\ :math:`^2`/s" "faero_ocn", "aerosol flux to the ocean", "kg/m\ :math:`^2`/s" - "fbot_xfer_type", ":math:`\bullet` type of heat transfer coefficient under ice", "" + "fbot_xfer_type", "type of heat transfer coefficient under ice", "" "fcondtop(n)(_f)", "conductive heat flux", "W/m\ :math:`^2`" "fcor_blk", "Coriolis parameter", "1/s" "ferrmax", "max allowed energy flux error (thermodynamics)", "1x :math:`10^{-3}` W/m\ :math:`^2`" @@ -231,8 +239,7 @@ either Celsius or Kelvin units). "flw", "incoming longwave radiation", "W/m\ :math:`^2`" "flwout", "outgoing longwave radiation", "W/m\ :math:`^2`" "fm", "Coriolis parameter * mass in U cell", "kg/s" - "forcing_diag", ":math:`\bullet` write extra diagnostics for forcing inputs", ".false." - "formdrag", ":math:`\bullet` calculate form drag", "" + "formdrag", "calculate form drag", "" "fpond", "fresh water flux to ponds", "kg/m\ :math:`^2`/s" "fr_resp", "bgc respiration fraction", "0.05" "frain", "rainfall rate", "kg/m\ :math:`^2`/s" @@ -243,13 +250,14 @@ either Celsius or Kelvin units). "frzmlt", "freezing/melting potential", "W/m\ :math:`^2`" "frzmlt_init", "freezing/melting potential at beginning of time step", "W/m\ :math:`^2`" "frzmlt_max", "maximum magnitude of freezing/melting potential", "1000. W/m\ :math:`^2`" - "frzpnd", ":math:`\bullet` Stefan refreezing of melt ponds", "‘hlid’" + "frzpnd", "Stefan refreezing of melt ponds", "‘hlid’" "fsalt", "net salt flux to ocean", "kg/m\ :math:`^2`/s" "fsalt_ai", "grid-box-mean salt flux to ocean (fsalt)", "kg/m\ :math:`^2`/s" "fsens", "sensible heat flux", "W/m\ :math:`^2`" "fsnow", "snowfall rate", "kg/m\ :math:`^2`/s" "fsnowrdg", "snow fraction that survives in ridging", "0.5" "fsurf(n)(_f)", "net surface heat flux excluding fcondtop", "W/m\ :math:`^2`" + "fsloss", "rate of snow loss to leads", "kg/m\ :math:`^{2}` s" "fsw", "incoming shortwave radiation", "W/m\ :math:`^2`" "fswabs", "total absorbed shortwave radiation", "W/m\ :math:`^2`" "fswfac", "scaling factor to adjust ice quantities for updated data", "" @@ -263,42 +271,43 @@ either Celsius or Kelvin units). "fswthru_ai", "grid-box-mean shortwave penetrating to ocean (fswthru)", "W/m\ :math:`^2`" "fyear", "current forcing data year", "" "fyear_final", "last forcing data year", "" - "fyear_init", ":math:`\bullet` initial forcing data year", "" + "fyear_init", "initial forcing data year", "" "**G**", "", "" "gravit", "gravitational acceleration", "9.80616 m/s\ :math:`^2`" - "grid_file", ":math:`\bullet` input file for grid info", "" - "grid_format", ":math:`\bullet` format of grid files", "" - "grid_type", ":math:`\bullet` ‘rectangular’, ‘displaced_pole’, ‘column’ or ‘regional’", "" - "gridcpl_file", ":math:`\bullet` input file for coupling grid info", "" + "grid_file", "input file for grid info", "" + "grid_format", "format of grid files", "" + "grid_type", "‘rectangular’, ‘displaced_pole’, ‘column’ or ‘regional’", "" + "gridcpl_file", "input file for coupling grid info", "" "grow_net", "specific biogeochemistry growth rate per grid cell", "s :math:`^{-1}`" "Gstar", "piecewise-linear ridging participation function parameter", "0.15" "**H**", "", "" "halo_info", "information for updating ghost cells", "" - "heat_capacity", ":math:`\bullet` if true, use salinity-dependent thermodynamics", "T" + "heat_capacity", "if true, use salinity-dependent thermodynamics", "T" "hfrazilmin", "minimum thickness of new frazil ice", "0.05 m" "hi_min", "minimum ice thickness for thinnest ice category", "0.01 m" "hi_ssl", "ice surface scattering layer thickness", "0.05 m" "hicen", "ice thickness in category n", "m" - "highfreq", ":math:`\bullet` high-frequency atmo coupling", "F" + "highfreq", "high-frequency atmo coupling", "F" "hin_old", "ice thickness prior to growth/melt", "m" "hin_max", "category thickness limits", "m" - "hist_avg", ":math:`\bullet` if true, write averaged data instead of snapshots", "T" - "histfreq", ":math:`\bullet` units of history output frequency: y, m, w, d or 1", "" - "histfreq_n", ":math:`\bullet` integer output frequency in histfreq units", "" - "history_dir", ":math:`\bullet` path to history output files", "" - "history_file", ":math:`\bullet` history output file prefix", "" - "history_format", ":math:`\bullet` history file format", "" - "history_precision", ":math:`\bullet` history output precision: 4 or 8 byte", "4" + "hist_avg", "if true, write averaged data instead of snapshots", "T" + "histfreq", "units of history output frequency: y, m, w, d or 1", "" + "histfreq_base", "reference date for history output", "" + "histfreq_n", "integer output frequency in histfreq units", "" + "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" "hm", "land/boundary mask, thickness (T-cell)", "" "hmix", "ocean mixed layer depth", "20. m" "hour", "hour of the year", "" "hp0", "pond depth at which shortwave transition to bare ice occurs", "0.2 m" - "hp1", ":math:`\bullet` critical ice lid thickness for topo ponds (dEdd)", "0.01 m" + "hp1", "critical ice lid thickness for topo ponds (dEdd)", "0.01 m" "hpmin", "minimum melt pond depth (shortwave)", "0.005 m" "hpondn", "melt pond depth", "m" "hs_min", "minimum thickness for which :math:`T_s` is computed", "1.\ :math:`\times`\ 10\ :math:`^{-4}` m" - "hs0", ":math:`\bullet` snow depth at which transition to ice occurs (dEdd)", "0.03 m" - "hs1", ":math:`\bullet` snow depth of transition to pond ice", "0.03 m" + "hs0", "snow depth at which transition to ice occurs (dEdd)", "0.03 m" + "hs1", "snow depth of transition to pond ice", "0.03 m" "hs_ssl", "snow surface scattering layer thickness", "0.04 m" "Hstar", "determines mean thickness of ridged ice", "25. m" "HTE", "length of eastern edge (:math:`\Delta y`) of T-cell", "m" @@ -311,12 +320,13 @@ either Celsius or Kelvin units). "iblkp","block on which to write debugging data", "" "i(j)block", "Cartesian i,j position of block", "" "ice_hist_field", "type for history variables", "" - "ice_ic", ":math:`\bullet` choice of initial conditions (see :ref:`tab-ic`)", "" + "ice_ic", "choice of initial conditions (see :ref:`tab-ic`)", "" "ice_stdout", "unit number for standard output", "" "ice_stderr", "unit number for standard error output", "" "ice_ref_salinity", "reference salinity for ice–ocean exchanges", "4. ppt" "icells", "number of grid cells with specified property (for vectorization)", "" - "iceruf", ":math:`\bullet` ice surface roughness at atmosphere interface", "5.\ :math:`\times`\ 10\ :math:`^{-4}` m" + "iceruf", "ice surface roughness at atmosphere interface", "5.\ :math:`\times`\ 10\ :math:`^{-4}` m" + "iceruf_ocn", "under-ice roughness (at ocean interface)", "0.03 m" "icetmask", "ice extent mask (T-cell)", "" "iceumask", "ice extent mask (U-cell)", "" "idate", "the date at the end of the current time step (yyyymmdd)", "" @@ -325,45 +335,45 @@ either Celsius or Kelvin units). "igrid", "interface points for vertical bio grid", "" "i(j)hi", "last i(j) index of physical domain (local)", "" "i(j)lo", "first i(j) index of physical domain (local)", "" - "incond_dir", ":math:`\bullet` directory to write snapshot of initial condition", "" - "incond_file", ":math:`\bullet` prefix for initial condition file name", "" + "incond_dir", "directory to write snapshot of initial condition", "" + "incond_file", "prefix for initial condition file name", "" "int_kind", "definition of an integer", "selected_real_kind(6)" "integral_order", "polynomial order of quadrature integrals in remapping", "3" "ip, jp", "local processor coordinates on which to write debugging data", "" "istep", "local step counter for time loop", "" - "istep0", ":math:`\bullet` number of steps taken in previous run", "0" + "istep0", "number of steps taken in previous run", "0" "istep1", "total number of steps at current time step", "" "Iswabs", "shortwave radiation absorbed in ice layers", "W/m\ :math:`^2`" "**J**", "", "" "**K**", "", "" - "kalg", ":math:`\bullet` absorption coefficient for algae", "" + "kalg", "absorption coefficient for algae", "" "kappav", "visible extinction coefficient in ice, wavelength\ :math:`<`\ 700nm", "1.4 m\ :math:`^{-1}`" - "kcatbound", ":math:`\bullet` category boundary formula", "" - "kdyn", ":math:`\bullet` type of dynamics (1 = EVP, 2 = EAP, 3 = VP, 0,-1 = off)", "1" + "kcatbound", "category boundary formula", "" + "kdyn", "type of dynamics (1 = EVP, 2 = EAP, 3 = VP, 0,-1 = off)", "1" "kg_to_g", "kg to g conversion factor", "1000." "kice", "thermal conductivity of fresh ice (:cite:`Bitz99`)", "2.03 W/m/deg" - "kitd", ":math:`\bullet` type of itd conversions (0 = delta function, 1 = linear remap)", "1" - "kmt_file", ":math:`\bullet` input file for land mask info", "" - "krdg_partic", ":math:`\bullet` ridging participation function", "1" - "krdg_redist", ":math:`\bullet` ridging redistribution function", "1" + "kitd", "type of itd conversions (0 = delta function, 1 = linear remap)", "1" + "kmt_file", "input file for land mask info", "" + "krdg_partic", "ridging participation function", "1" + "krdg_redist", "ridging redistribution function", "1" "krgdn", "mean ridge thickness per thickness of ridging ice", "" "kseaice", "thermal conductivity of ice for zero-layer thermodynamics", "2.0 W/m/deg" "ksno", "thermal conductivity of snow", "0.30 W/m/deg" - "kstrength", ":math:`\bullet` ice stength formulation (1= :cite:`Rothrock75`, 0 = :cite:`Hibler79`)", "1" - "ktherm", ":math:`\bullet` thermodynamic formulation (0 = zero-layer, 1 = :cite:`Bitz99`, 2 = mushy)", "" + "kstrength", "ice stength formulation (1= :cite:`Rothrock75`, 0 = :cite:`Hibler79`)", "1" + "ktherm", "thermodynamic formulation (0 = zero-layer, 1 = :cite:`Bitz99`, 2 = mushy)", "" "**L**", "", "" "l_brine", "flag for brine pocket effects", "" "l_fixed_area", "flag for prescribing remapping fluxes", "" - "l_mpond_fresh", ":math:`\bullet` if true, retain (topo) pond water until ponds drain", "" - "latpnt", ":math:`\bullet` desired latitude of diagnostic points", "degrees N" + "l_mpond_fresh", "if true, retain (topo) pond water until ponds drain", "" + "latpnt", "desired latitude of diagnostic points", "degrees N" "latt(u)_bounds", "latitude of T(U) grid cell corners", "degrees N" - "lcdf64", ":math:`\bullet` if true, use 64-bit  format", "" + "lcdf64", "if true, use 64-bit  format", "" "Lfresh", "latent heat of melting of fresh ice = Lsub - Lvap", "J/kg" "lhcoef", "transfer coefficient for latent heat", "" "lmask_n(s)", "northern (southern) hemisphere mask", "" "local_id", "local address of block in current distribution", "" "log_kind", "definition of a logical variable", "kind(.true.)" - "lonpnt", ":math:`\bullet` desired longitude of diagnostic points", "degrees E" + "lonpnt", "desired longitude of diagnostic points", "degrees E" "lont(u)_bounds", "longitude of T(U) grid cell corners", "degrees E" "Lsub", "latent heat of sublimation for fresh water", "2.835\ :math:`\times` 10\ :math:`^6` J/kg" "ltripole_grid", "flag to signal use of tripole grid", "" @@ -374,9 +384,9 @@ either Celsius or Kelvin units). "m1", "constant for lateral melt rate", "1.6\ :math:`\times`\ 10\ :math:`^{-6}` m/s deg\ :math:`^{-m2}`" "m2", "constant for lateral melt rate", "1.36" "m2_to_km2", "m\ :math:`^2` to km\ :math:`^2` conversion", "1\ :math:`\times`\ 10\ :math:`^{-6}`" - "maskhalo_bound", ":math:`\bullet` turns on *bound_state* halo masking", "" - "maskhalo_dyn", ":math:`\bullet` turns on dynamics halo masking", "" - "maskhalo_remap", ":math:`\bullet` turns on transport halo masking", "" + "maskhalo_bound", "turns on *bound_state* halo masking", "" + "maskhalo_dyn", "turns on dynamics halo masking", "" + "maskhalo_remap", "turns on transport halo masking", "" "master_task", "task ID for the controlling processor", "" "max_blocks", "maximum number of blocks per processor", "" "max_ntrcr", "maximum number of tracers available", "5" @@ -385,29 +395,32 @@ either Celsius or Kelvin units). "meltb", "basal ice melt", "m" "meltl", "lateral ice melt", "m" "melts", "snow melt", "m" + "meltsliq", "snow melt mass", "kg/m\ :math:`^{2}`" + "meltsliqn", "snow melt mass in category n", "kg/m\ :math:`^{2}`" "meltt", "top ice melt", "m" "min_salin", "threshold for brine pockets", "0.1 ppt" "mlt_onset", "day of year that surface melt begins", "" "mmonth", "model month number", "" "monthp", "previous month number", "" - "month_init", ":math:`\bullet` the initial month", "" + "month_init", "the initial month", "" "mps_to_cmpdy", "m per s to cm per day conversion", "8.64\ :math:`\times`\ 10\ :math:`^6`" "msec", "model seconds elasped into day", "" "mtask", "local processor number that writes debugging data", "" - "mu_rdg", ":math:`\bullet` e-folding scale of ridged ice", "" + "mu_rdg", "e-folding scale of ridged ice", "" "myear", "model year", "" + "myear_max", "maximum allowed model year", "" "my_task", "task ID for the current processor", "" "**N**", "", "" "n_aero", "number of aerosol species", "" - "natmiter", ":math:`\bullet` number of atmo boundary layer iterations", "5" + "natmiter", "number of atmo boundary layer iterations", "5" "nblocks", "number of blocks on current processor", "" "nblocks_tot", "total number of blocks in decomposition", "" "nblocks_x(y)", "total number of blocks in x(y) direction", "" "nbtrcr", "number of biology tracers", "" "ncat", "number of ice categories", "5" "ncat_hist", "number of categories written to history", "" - "ndte", ":math:`\bullet` number of subcycles", "120" - "ndtd", ":math:`\bullet` number of dynamics/advection steps under thermo", "1" + "ndte", "number of subcycles", "120" + "ndtd", "number of dynamics/advection steps under thermo", "1" "new_day", "flag for beginning new day", "" "new_hour", "flag for beginning new hour", "" "new_month", "flag for beginning new month", "" @@ -421,10 +434,10 @@ either Celsius or Kelvin units). "nit", "nitrate concentration", "mmol/m\ :math:`^3`" "nlt_bgc_[chem]", "ocean sources and sinks for biogeochemistry", "" "nml_filename", "namelist file name", "" - "nprocs", ":math:`\bullet` total number of processors", "" - "npt", ":math:`\bullet` total run length values associate with npt_unit", "" + "nprocs", "total number of processors", "" + "npt", "total run length values associate with npt_unit", "" "npt_unit", "units of the run length, number set by npt", "" - "ns_boundary_type", ":math:`\bullet` type of north-south boundary condition", "" + "ns_boundary_type", "type of north-south boundary condition", "" "nslyr", "number of snow layers in each category", "" "nspint", "number of solar spectral intervals", "" "nstreams", "number of history output streams (frequencies)", "" @@ -452,13 +465,15 @@ either Celsius or Kelvin units). "nx(y)_global", "number of physical gridpoints in x(y) direction, global domain", "" "**O**", "", "" "ocean_bio", "concentrations of bgc constituents in the ocean", "" - "oceanmixed_file", ":math:`\bullet` data file containing ocean forcing data", "" - "oceanmixed_ice", ":math:`\bullet` if true, use internal ocean mixed layer", "" - "ocn_data_dir", ":math:`\bullet` directory for ocean forcing data", "" - "ocn_data_format", ":math:`\bullet` format of ocean forcing files", "" - "ocn_data_type", ":math:`\bullet` source of surface temperature, salinity data", "" + "oceanmixed_file", "data file containing ocean forcing data", "" + "oceanmixed_ice", "if true, use internal ocean mixed layer", "" + "ocn_data_dir", "directory for ocean forcing data", "" + "ocn_data_format", "format of ocean forcing files", "" + "ocn_data_type", "source of surface temperature, salinity data", "" "omega", "angular velocity of Earth", "7.292\ :math:`\times`\ 10\ :math:`^{-5}` rad/s" "opening", "rate of ice opening due to divergence and shear", "1/s" + "optics_file", "optics filename associated with modal aerosols", "" + "optics_file_fieldname", "optics file fieldname that is read", "" "**P**", "", "" "p001", "1/1000", "" "p01", "1/100", "" @@ -481,10 +496,10 @@ either Celsius or Kelvin units). "p6", "3/5", "" "p666", "2/3", "" "p75", "3/4", "" - "phi_c_slow_mode", ":math:`\bullet` critical liquid fraction", "" - "phi_i_mushy", ":math:`\bullet` solid fraction at lower boundary", "" + "phi_c_slow_mode", "critical liquid fraction", "" + "phi_i_mushy", "solid fraction at lower boundary", "" "phi_sk", "skeletal layer porosity", "" - "phi_snow", ":math:`\bullet` snow porosity for brine height tracer", "" + "phi_snow", "snow porosity for brine height tracer", "" "pi", ":math:`\pi`", "" "pi2", ":math:`2\pi`", "" "pih", ":math:`\pi /2`", "" @@ -492,14 +507,14 @@ either Celsius or Kelvin units). "pi(j,b,m)loc", "x (y, block, task) location of diagnostic points", "" "plat", "grid latitude of diagnostic points", "" "plon", "grid longitude of diagnostic points", "" - "pndaspect", ":math:`\bullet` aspect ratio of pond changes (depth:area)", "0.8" - "pointer_file", ":math:`\bullet` input file for restarting", "" + "pndaspect", "aspect ratio of pond changes (depth:area)", "0.8" + "pointer_file", "input file for restarting", "" "potT", "atmospheric potential temperature", "K" "PP_net", "total primary productivity per grid cell", "mg C/m\ :math:`^2`/s" - "precip_units", ":math:`\bullet` liquid precipitation data units", "" - "print_global", ":math:`\bullet` if true, print global data", "F" - "print_points", ":math:`\bullet` if true, print point data", "F" - "processor_shape", ":math:`\bullet` descriptor for processor aspect ratio", "" + "precip_units", "liquid precipitation data units", "" + "print_global", "if true, print global data", "F" + "print_points", "if true, print point data", "F" + "processor_shape", "descriptor for processor aspect ratio", "" "prs_sig", "replacement pressure", "N/m" "Pstar", "ice strength parameter", "2.75\ :math:`\times`\ 10\ :math:`^4`\ N/m\ :math:`^2`" "puny", "a small positive number", "1\ :math:`\times`\ 10\ :math:`^{-11}`" @@ -513,12 +528,12 @@ either Celsius or Kelvin units). "R_C2N", "algal carbon to nitrate factor", "7. mole/mole" "R_gC2molC", "mg/mmol carbon", "12.01 mg/mole" "R_chl2N", "algal chlorophyll to nitrate factor", "3. mg/mmol" - "R_ice", ":math:`\bullet` parameter for Delta-Eddington ice albedo", "" - "R_pnd", ":math:`\bullet` parameter for Delta-Eddington pond albedo", "" + "R_ice", "parameter for Delta-Eddington ice albedo", "" + "R_pnd", "parameter for Delta-Eddington pond albedo", "" "R_S2N", "algal silicate to nitrate factor", "0.03 mole/mole" - "R_snw", ":math:`\bullet` parameter for Delta-Eddington snow albedo", "" + "R_snw", "parameter for Delta-Eddington snow albedo", "" "r16_kind", "definition of quad precision", "selected_real_kind(26)", "" - "Rac_rapid_mode", ":math:`\bullet` critical Rayleigh number", "10" + "Rac_rapid_mode", "critical Rayleigh number", "10" "rad_to_deg", "degree-radian conversion", ":math:`180/\pi`" "radius", "earth radius", "6.37\ :math:`\times`\ 10\ :math:`^6` m" "rdg_conv", "convergence for ridging", "1/s" @@ -526,35 +541,42 @@ either Celsius or Kelvin units). "real_kind", "definition of single precision real", "selected_real_kind(6)" "refindx", "refractive index of sea ice", "1.310" "revp", "real(revised_evp)", "" - "restart", ":math:`\bullet` if true, initialize using restart file instead of defaults", "T" - "restart_age", ":math:`\bullet` if true, read age restart file", "" - "restart_bgc", ":math:`\bullet` if true, read bgc restart file", "" - "restart_dir", ":math:`\bullet` path to restart/dump files", "" - "restart_file", ":math:`\bullet` restart file prefix", "" - "restart_format", ":math:`\bullet` restart file format", "" - "restart_[tracer]", ":math:`\bullet` if true, read tracer restart file", "" - "restart_ext", ":math:`\bullet` if true, read/write halo cells in restart file", "" - "restart_coszen", ":math:`\bullet` if true, read/write coszen in restart file", "" - "restore_bgc", ":math:`\bullet` if true, restore nitrate/silicate to data", "" - "restore_ice", ":math:`\bullet` if true, restore ice state along lateral boundaries", "" - "restore_ocn", ":math:`\bullet` restore sst to data", "" - "revised_evp", ":math:`\bullet` if true, use revised EVP parameters and approach", "" - "rfracmin", ":math:`\bullet` minimum melt water fraction added to ponds", "0.15" - "rfracmax", ":math:`\bullet` maximum melt water fraction added to ponds", "1.0" + "restart", "if true, initialize ice state from file", "T" + "restart_age", "if true, read age restart file", "" + "restart_bgc", "if true, read bgc restart file", "" + "restart_dir", "path to restart/dump files", "" + "restart_file", "restart file prefix", "" + "restart_format", "restart file format", "" + "restart_[tracer]", "if true, read tracer restart file", "" + "restart_ext", "if true, read/write halo cells in restart file", "" + "restart_coszen", "if true, read/write coszen in restart file", "" + "restore_bgc", "if true, restore nitrate/silicate to data", "" + "restore_ice", "if true, restore ice state along lateral boundaries", "" + "restore_ocn", "restore sst to data", "" + "revised_evp", "if true, use revised EVP parameters and approach", "" + "rfracmin", "minimum melt water fraction added to ponds", "0.15" + "rfracmax", "maximum melt water fraction added to ponds", "1.0" "rhoa", "air density", "kg/m\ :math:`^3`" "rhofresh", "density of fresh water", "1000.0 kg/m\ :math:`^3`" "rhoi", "density of ice", "917. kg/m\ :math:`^3`" "rhos", "density of snow", "330. kg/m\ :math:`^3`" + "rhos_cmp", "density of snow due to wind compaction", "kg/m\ :math:`^3`" + "rhos_cnt", "density of ice and liquid content of snow", "kg/m\ :math:`^3`" "rhosi", "average sea ice density (for hbrine tracer)", "940. kg/m\ :math:`^3`" + "rhosmax", "maximum snow density", "450 kg/m\ :math:`^{3}`" + "rhosmin", "minimum snow density", "100 kg/m\ :math:`^{3}`" + "rhosnew", "new snow density", "100 kg/m\ :math:`^{3}`" "rhow", "density of seawater", "1026. kg/m\ :math:`^3`" "rnilyr", "real(nlyr)", "" "rside", "fraction of ice that melts laterally", "" - "rsnw_fresh", "freshly fallen snow grain radius", "100. :math:`\times` 10\ :math:`^{-6}` m" - "rsnw_melt", ":math:`\bullet` melting snow grain radius", "1000. :math:`\times` 10\ :math:`^{-6}` m" + "rsnw", "snow grain radius", "10\ :math:`^{-6}` m" + "rsnw_fall", "freshly fallen snow grain radius", "100. :math:`\times` 10\ :math:`^{-6}` m" + "rsnw_melt", "melting snow grain radius", "1000. :math:`\times` 10\ :math:`^{-6}` m" "rsnw_nonmelt", "nonmelting snow grain radius", "500. :math:`\times` 10\ :math:`^{-6}` m" "rsnw_sig", "standard deviation of snow grain radius", "250. :math:`\times` 10\ :math:`^{-6}` m" - "runid", ":math:`\bullet` identifier for run", "" - "runtype", ":math:`\bullet` type of initialization used", "" + "rsnw_tmax", "maximum snow radius", "1500. :math:`\times` 10\ :math:`^{-6}` m" + "runid", "identifier for run", "" + "runtype", "type of initialization used", "" "**S**", "", "" "s11, s12, s22", "stress tensor components", "" "saltmax", "max salinity, at ice base (:cite:`Bitz99`)", "3.2 ppt" @@ -562,11 +584,11 @@ either Celsius or Kelvin units). "seabed_stress", "if true, calculate seabed stress", "F" "seabed_stress_method", "method for calculating seabed stress (‘LKD’ or ‘probabilistic’)", "LKD" "secday", "number of seconds in a day", "86400." - "sec_init", ":math:`\bullet` the initial second", "" + "sec_init", "the initial second", "" "shcoef", "transfer coefficient for sensible heat", "" "shear", "strain rate II component", "1/s" "shlat", "southern latitude of artificial mask edge", "30\ :math:`^\circ`\ N" - "shortwave", ":math:`\bullet` flag for shortwave parameterization (‘ccsm3’ or ‘dEdd’)", "" + "shortwave", "flag for shortwave parameterization (‘ccsm3’ or ‘dEdd’)", "" "sig1(2)", "principal stress components (diagnostic)", "" "sil", "silicate concentration", "mmol/m\ :math:`^3`" "sinw", "sine of the turning angle in water", "0." @@ -574,7 +596,26 @@ either Celsius or Kelvin units). "sk_l", "skeletal layer thickness", "0.03 m" "snoice", "snow–ice formation", "m" "snowpatch", "length scale for parameterizing nonuniform snow coverage", "0.02 m" - "skl_bgc", ":math:`\bullet` biogeochemistry on/off", "" + "skl_bgc", "biogeochemistry on/off", "" + "smassice", "mass of ice in snow from smice tracer", "kg/m\ :math:`^2`" + "smassliq", "mass of liquid in snow from smliq tracer", "kg/m\ :math:`^2`" + "snowage_drdt0", "initial rate of change of effective snow radius", " " + "snowage_rhos", "snow aging parameter (density)", " " + "snowage_kappa", "snow aging best-fit parameter", " " + "snowage_tau", "snow aging best-fit parameter", " " + "snowage_T", "snow aging parameter (temperature)", " " + "snowage_Tgrd", "snow aging parameter (temperature gradient)", " " + "snw_aging_table", "snow aging lookup table", " " + "snw_filename", "snowtable filename", " " + "snw_tau_fname", "snowtable file tau fieldname", " " + "snw_kappa_fname", "snowtable file kappa fieldname", " " + "snw_drdt0_fname", "snowtable file drdt0 fieldname", " " + "snw_rhos_fname", "snowtable file rhos fieldname", " " + "snw_Tgrd_fname", "snowtable file Tgrd fieldname", " " + "snw_T_fname", "snowtable file T fieldname", " " + "snwgrain", "activate snow metamorphosis", " " + "snwlvlfac", "fractional increase in snow depth for redistribution on ridges", "0.3" + "snwredist", "type of snow redistribution", " " "spval", "special value (single precision)", ":math:`10^{30}`", "" "spval_dbl", "special value (double precision)", ":math:`10^{30}`", "" "ss_tltx(y)", "sea surface in the x(y) direction", "m/m" @@ -604,7 +645,7 @@ either Celsius or Kelvin units). "tcstr", "string identifying T grid for history variables", "" "Tf", "freezing temperature", "C" "Tffresh", "freezing temp of fresh ice", "273.15 K" - "tfrz_option", ":math:`\bullet` form of ocean freezing temperature", "" + "tfrz_option", "form of ocean freezing temperature", "" "thinS", "minimum ice thickness for brine tracer", "" "timesecs", "total elapsed time in seconds", "s" "time_beg", "beginning time for history averages", "" @@ -621,19 +662,19 @@ either Celsius or Kelvin units). "Tmin", "minimum allowed internal temperature", "-100. C" "Tmltz", "melting temperature profile of ice", "" "Tocnfrz", "temperature of constant freezing point parameterization", "-1.8 C" - "tr_aero", ":math:`\bullet` if true, use aerosol tracers", "" - "tr_bgc_[tracer]", ":math:`\bullet` if true, use biogeochemistry tracers", "" - "tr_brine", ":math:`\bullet` if true, use brine height tracer", "" - "tr_FY", ":math:`\bullet` if true, use first-year area tracer", "" - "tr_iage", ":math:`\bullet` if true, use ice age tracer", "" - "tr_lvl", ":math:`\bullet` if true, use level ice area and volume tracers", "" - "tr_pond_cesm", ":math:`\bullet` if true, use CESM melt pond scheme", "" - "tr_pond_lvl", ":math:`\bullet` if true, use level-ice melt pond scheme", "" - "tr_pond_topo", ":math:`\bullet` if true, use topo melt pond scheme", "" + "tr_aero", "if true, use aerosol tracers", "" + "tr_bgc_[tracer]", "if true, use biogeochemistry tracers", "" + "tr_brine", "if true, use brine height tracer", "" + "tr_FY", "if true, use first-year area tracer", "" + "tr_iage", "if true, use ice age tracer", "" + "tr_lvl", "if true, use level ice area and volume tracers", "" + "tr_pond_cesm", "if true, use CESM melt pond scheme", "" + "tr_pond_lvl", "if true, use level-ice melt pond scheme", "" + "tr_pond_topo", "if true, use topo melt pond scheme", "" "trcr", "ice tracers", "" "trcr_depend", "tracer dependency on basic state variables", "" "Tref", "2m atmospheric reference temperature", "K" - "trestore", ":math:`\bullet` restoring time scale", "days" + "trestore", "restoring time scale", "days" "tripole", "if true, block lies along tripole boundary", "" "tripoleT", "if true, tripole boundary is T-fold; if false, U-fold", "" "Tsf_errmax", "max allowed :math:`T_{\mathit sf}` error (thermodynamics)", "5.\ :math:`\times`\ 10\ :math:`^{-4}`\ deg" @@ -652,10 +693,11 @@ either Celsius or Kelvin units). "umax_stab", "ice speed threshold (diagnostics)", "1. m/s" "umin", "min wind speed for turbulent fluxes", "1. m/s" "uocn", "ocean current in the x-direction", "m/s" - "update_ocn_f", ":math:`\bullet` if true, include frazil ice fluxes in ocean flux fields", "" - "use_leap_years", ":math:`\bullet` if true, include leap days", "" - "use_restart_time", ":math:`\bullet` if true, use date from restart file", "" - "ustar_min", ":math:`\bullet` minimum friction velocity under ice", "" + "update_ocn_f", "if true, include frazil ice fluxes in ocean flux fields", "" + "use_leap_years", "if true, include leap days", "" + "use_restart_time", "if true, use date from restart file", "" + "use_smliq_pnd", "use liquid in snow for ponds", " " + "ustar_min", "minimum friction velocity under ice", "" "ucstr", "string identifying U grid for history variables", "" "uvel", "x-component of ice velocity", "m/s" "uvel_init", "x-component of ice velocity at beginning of time step", "m/s" @@ -680,16 +722,17 @@ either Celsius or Kelvin units). "wave_spectrum", "wave spectrum", "m\ :math:`^2`/s" "wavefreq", "wave frequencies", "1/s" "wind", "wind speed", "m/s" + "windmin", "minimum wind speed to compact snow", "10 m/s" "write_history", "if true, write history now", "" - "write_ic", ":math:`\bullet` if true, write initial conditions", "" + "write_ic", "if true, write initial conditions", "" "write_restart", "if 1, write restart now", "" "**X**", "", "" "**Y**", "", "" - "ycycle", ":math:`\bullet` number of years in forcing data cycle", "" + "ycycle", "number of years in forcing data cycle", "" "yday", "day of the year, computed in the model calendar", "" "yield_curve", "type of yield curve", "ellipse" "yieldstress11(12, 22)", "yield stress tensor components", "" - "year_init", ":math:`\bullet` the initial year", "" + "year_init", "the initial year", "" "**Z**", "", "" "zlvl", "atmospheric level height (momentum)", "m" "zlvs", "atmospheric level height (scalars)", "m" diff --git a/doc/source/conf.py b/doc/source/conf.py index 4cf2f580d..099f65403 100644 --- a/doc/source/conf.py +++ b/doc/source/conf.py @@ -62,9 +62,9 @@ # built documents. # # The short X.Y version. -version = u'6.2.0' +version = u'6.3.0' # The full version, including alpha/beta/rc tags. -version = u'6.2.0' +version = u'6.3.0' # The language for content autogenerated by Sphinx. Refer to documentation # for a list of supported languages. diff --git a/doc/source/developer_guide/dg_dynamics.rst b/doc/source/developer_guide/dg_dynamics.rst index 7df716298..48dead1cb 100644 --- a/doc/source/developer_guide/dg_dynamics.rst +++ b/doc/source/developer_guide/dg_dynamics.rst @@ -6,7 +6,7 @@ Dynamics ============================ -The CICE **cicecore/** directory consists of the non icepack source code. Within that +The CICE **cicecore/** directory consists of the non icepack source code. Within that directory there are the following subdirectories **cicecore/cicedynB/analysis** contains higher level history and diagnostic routines. @@ -30,29 +30,20 @@ Dynamical Solvers -------------------- The dynamics solvers are found in **cicecore/cicedynB/dynamics/**. A couple of different solvers are -available including EVP, revised EVP, EAP and VP. The dynamics solver is specified in namelist with the -``kdyn`` variable. ``kdyn=1`` is evp, ``kdyn=2`` is eap, ``kdyn=3`` is VP and revised EVP requires -the ``revised_evp`` namelist flag be set to true. - -Multiple EVP solvers are supported thru the namelist flag ``kevp_kernel``. The standard implementation -and current default is ``kevp_kernel=0``. In this case, the stress is solved on the regular decomposition -via subcycling and calls to subroutine ``stress`` and subroutine ``stepu`` with MPI global sums required in each -subcycling call. With ``kevp_kernel=2``, the data required to compute the stress is gathered to the root -MPI process and the stress calculation is performed on the root task without any MPI global sums. OpenMP -parallelism is supported in ``kevp_kernel=2``. The solutions with ``kevp_kernel`` set to 0 or 2 will -not be bit-for-bit -identical but should be the same to roundoff and produce the same climate. ``kevp_kernel=2`` may perform -better for some configurations, some machines, and some pe counts. ``kevp_kernel=2`` is not supported -with the tripole grid and is still being validated. Until ``kevp_kernel=2`` is fully validated, it will -abort if set. To override the abort, use value 102 for testing. +available including EVP, EAP and VP. The dynamics solver is specified in namelist with the +``kdyn`` variable. ``kdyn=1`` is evp, ``kdyn=2`` is eap, ``kdyn=3`` is VP. + +Two alternative implementations of EVP are included. The first alternative is the Revised EVP, triggered when the ``revised_evp`` is set to true. The second alternative is the 1d EVP solver triggered when the ``evp_algorithm`` is set to ``shared_mem_1d`` as oppose to the default setting of ``evp_standard_2d``. The solutions with ``evp_algorithm`` set to ``standard_2d`` or ``shared_mem_1d`` will +not be bit-for-bit identical when compared to each other. The reason for this is floating point round off errors that occur unless strict compiler flags are used. ``evp_algorithm=shared_mem_1d`` is primarily built for OpenMP. If MPI domain splitting is used then the solver will only run on the master processor. ``evp_algorithm=shared_mem_1d`` is not supported +with the tripole grid. Transport ----------------- -The transport (advection) methods are found in **cicecore/cicedynB/dynamics/**. Only the incremental -remapping method is supported at this time, and is set in namelist via the ``advection`` variable. -Transport can be turned off by setting ``advection = none`` or ``ktransport = -1``. +The transport (advection) methods are found in **cicecore/cicedynB/dynamics/**. Two methods are supported, +upwind and remap. These are set in namelist via the ``advection`` variable. +Transport can be disabled with the ``ktransport`` namelist variable. Infrastructure @@ -90,7 +81,7 @@ Time Manager Time manager data is module data in **cicecore/shared/ice_calendar.F90**. Much of the time manager data is public and operated on during the model timestepping. The model timestepping actually takes -place in the **CICE_RunMod.F90** file which is part of the driver code. +place in the **CICE_RunMod.F90** file which is part of the driver code. The time manager was updated in early 2021. Additional information about the time manager can be found here, :ref:`timemanagerplus` @@ -100,12 +91,12 @@ Communication ------------------ Two low-level communications packages, mpi and serial, are provided as part of CICE. This software -provides a middle layer between the model and the underlying libraries. Only the CICE mpi or +provides a middle layer between the model and the underlying libraries. Only the CICE mpi or serial directories are compiled with CICE, not both. -**cicedynB/infrastructure/comm/mpi/** +**cicedynB/infrastructure/comm/mpi/** is based on MPI and provides various methods to do halo updates, global sums, gather/scatter, broadcasts -and similar using some fairly generic interfaces to isolate the MPI calls in the code. +and similar using some fairly generic interfaces to isolate the MPI calls in the code. **cicedynB/infrastructure/comm/serial/** support the same interfaces, but operates in shared memory mode with no MPI. The serial library will be used, by default in the CICE scripts, @@ -124,7 +115,7 @@ case. This has to be set before CICE is built. **cicedynB/infrastructure/io/io_netcdf/** is the default for the standalone CICE model, and it supports writing history and restart files in netcdf format using standard netcdf calls. It does this by writing from and reading to the root task and -gathering and scattering fields from the root task to support model parallelism. +gathering and scattering fields from the root task to support model parallelism. **cicedynB/infrastructure/io/io_binary/** supports files in binary format using a gather/scatter approach and reading to and writing from the root task. @@ -134,4 +125,3 @@ is a parallel io library (https://github.com/NCAR/ParallelIO) that supports read binary and netcdf file through various interfaces including netcdf and pnetcdf. pio is generally more parallel in memory even when using serial netcdf than the standard gather/scatter methods, and it provides parallel read/write capabilities by optionally linking and using pnetcdf. - diff --git a/doc/source/science_guide/sg_dynamics.rst b/doc/source/science_guide/sg_dynamics.rst index e7f214ff7..d4e209d8a 100644 --- a/doc/source/science_guide/sg_dynamics.rst +++ b/doc/source/science_guide/sg_dynamics.rst @@ -6,10 +6,9 @@ Dynamics ======== There are different approaches in the CICE code for representing sea ice -rheology and for solving the sea ice momentum equation. The -elastic-viscous-plastic (EVP) model represents a modification of the -standard viscous-plastic (VP) model for sea ice dynamics -:cite:`Hibler79`. The elastic-anisotropic-plastic (EAP) model, +rheology and for solving the sea ice momentum equation. The viscous-plastic (VP) originally developed by :cite:`Hibler79`, +the elastic-viscous-plastic (EVP) :cite:`Hunke97` model represents a modification of the +standard viscous-plastic (VP) model for sea ice dynamics. The elastic-anisotropic-plastic (EAP) model, on the other hand, explicitly accounts for the observed sub-continuum anisotropy of the sea ice cover :cite:`Wilchinsky06,Weiss09`. If ``kdyn`` = 1 in the namelist then the EVP model is used (module @@ -68,7 +67,7 @@ vertical direction: where :math:`m` is the combined mass of ice and snow per unit area and :math:`\vec{\tau}_a` and :math:`\vec{\tau}_w` are wind and ocean -stresses, respectively. The term :math:`\vec{\tau}_b` is a +stresses, respectively. The term :math:`\vec{\tau}_b` is a seabed stress (also referred to as basal stress) that represents the grounding of pressure ridges in shallow water :cite:`Lemieux16`. The mechanical properties of the ice are represented by the internal stress tensor :math:`\sigma_{ij}`. The other two terms on @@ -84,11 +83,11 @@ For clarity, the two components of Equation :eq:`vpmom` are .. math:: \begin{aligned} - m{\partial u\over\partial t} &= {\partial\sigma_{1j}\over\partial x_j} + \tau_{ax} + + m{\partial u\over\partial t} &= {\partial\sigma_{1j}\over\partial x_j} + \tau_{ax} + a_i c_w \rho_w \left|{\bf U}_w - {\bf u}\right| \left[\left(U_w-u\right)\cos\theta - \left(V_w-v\right)\sin\theta\right] -C_bu +mfv - mg{\partial H_\circ\over\partial x}, \\ - m{\partial v\over\partial t} &= {\partial\sigma_{2j}\over\partial x_j} + \tau_{ay} + + m{\partial v\over\partial t} &= {\partial\sigma_{2j}\over\partial x_j} + \tau_{ay} + a_i c_w \rho_w \left|{\bf U}_w - {\bf u}\right| \left[\left(U_w-u\right)\sin\theta + \left(V_w-v\right)\cos\theta\right] -C_bv-mfu - mg{\partial H_\circ\over\partial y}. \end{aligned} @@ -111,14 +110,14 @@ Elastic-Viscous-Plastic The momentum equation is discretized in time as follows, for the classic EVP approach. In the code, -:math:`{\tt vrel}=a_i c_w \rho_w\left|{\bf U}_w - {\bf u}^k\right|` and -:math:`C_b=T_b \left( \sqrt{(u^k)^2+(v^k)^2}+u_0 \right)^{-1}`, +:math:`{\tt vrel}=a_i c_w \rho_w\left|{\bf U}_w - {\bf u}^k\right|` and +:math:`C_b=T_b \left( \sqrt{(u^k)^2+(v^k)^2}+u_0 \right)^{-1}`, where :math:`k` denotes the subcycling step. The following equations illustrate the time discretization and define some of the other variables used in the code. .. math:: - \underbrace{\left({m\over\Delta t_e}+{\tt vrel} \cos\theta\ + C_b \right)}_{\tt cca} u^{k+1} + \underbrace{\left({m\over\Delta t_e}+{\tt vrel} \cos\theta\ + C_b \right)}_{\tt cca} u^{k+1} - \underbrace{\left(mf+{\tt vrel}\sin\theta\right)}_{\tt ccb}v^{k+1} = &\underbrace{{\partial\sigma_{1j}^{k+1}\over\partial x_j}}_{\tt strintx} + \underbrace{\tau_{ax} - mg{\partial H_\circ\over\partial x} }_{\tt forcex} \\ @@ -126,7 +125,7 @@ variables used in the code. :label: umom .. math:: - \underbrace{\left(mf+{\tt vrel}\sin\theta\right)}_{\tt ccb} u^{k+1} + \underbrace{\left(mf+{\tt vrel}\sin\theta\right)}_{\tt ccb} u^{k+1} + \underbrace{\left({m\over\Delta t_e}+{\tt vrel} \cos\theta + C_b \right)}_{\tt cca}v^{k+1} = &\underbrace{{\partial\sigma_{2j}^{k+1}\over\partial x_j}}_{\tt strinty} + \underbrace{\tau_{ay} - mg{\partial H_\circ\over\partial y} }_{\tt forcey} \\ @@ -139,7 +138,7 @@ We solve this system of equations analytically for :math:`u^{k+1}` and :math:`v^{k+1}`. Define .. math:: - \hat{u} = F_u + \tau_{ax} - mg{\partial H_\circ\over\partial x} + {\tt vrel} \left(U_w\cos\theta - V_w\sin\theta\right) + {m\over\Delta t_e}u^k + \hat{u} = F_u + \tau_{ax} - mg{\partial H_\circ\over\partial x} + {\tt vrel} \left(U_w\cos\theta - V_w\sin\theta\right) + {m\over\Delta t_e}u^k :label: cevpuhat .. math:: @@ -169,7 +168,7 @@ where .. math:: b = mf + {\tt vrel}\sin\theta. :label: cevpb - + .. _vp-momentum: Viscous-Plastic @@ -236,48 +235,119 @@ pending further testing. Seabed stress *************** -The parameterization for the seabed stress is described in :cite:`Lemieux16`. The components of the basal seabed stress are -:math:`\tau_{bx}=C_bu` and :math:`\tau_{by}=C_bv`, where :math:`C_b` is a coefficient expressed as +CICE includes two options for calculating the seabed stress, +i.e. the term in the momentum equation that represents the interaction +between grounded ice keels and the seabed. The seabed stress can be +activated by setting ``seabed_stress`` to true in the namelist. The seabed stress (or basal +stress) parameterization of :cite:`Lemieux16` is chosen if ``seabed_stress_method`` = ``LKD`` while the approach based on the probability of contact between the ice and the seabed is used if ``seabed_stress_method`` = ``probabilistic``. + +For both parameterizations, the components of the seabed +stress are expressed as :math:`\tau_{bx}=C_bu` and +:math:`\tau_{by}=C_bv`, where :math:`C_b` is a seabed stress +coefficient. + +The two parameterizations differ in their calculation of +the :math:`C_b` coefficients. + +Note that the user must provide a bathymetry field for using these +grounding schemes. It is suggested to have a bathymetry field with water depths +larger than 5 m that represents well shallow water (less than 30 m) regions such as the Laptev Sea +and the East Siberian Sea. + +Seabed stress based on linear keel draft (LKD) +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +This parameterization for the seabed stress is described in +:cite:`Lemieux16`. It assumes that the largest keel draft varies linearly with the mean thickness in a grid cell (i.e. sea ice volume). The :math:`C_b` coefficients are expressed as .. math:: C_b= k_2 \max [0,(h_u - h_{cu})] e^{-\alpha_b * (1 - a_u)} (\sqrt{u^2+v^2}+u_0)^{-1}, \\ - :label: Cb + :label: Cb -where :math:`k_2` determines the maximum seabed stress that can be sustained by the grounded parameterized ridge(s), :math:`u_0` -is a small residual velocity and :math:`\alpha_b` is a parameter to ensure that the seabed stress quickly drops when -the ice concentration is smaller than 1. In the code, :math:`k_2 \max [0,(h_u - h_{cu})] e^{-\alpha_b * (1 - a_u)}` is defined as -:math:`T_b`. The quantities :math:`h_u`, :math:`a_{u}` and :math:`h_{cu}` are calculated at -the 'u' point based on local ice conditions (surrounding tracer points). They are respectively given by +where :math:`k_2` determines the maximum seabed stress that can be sustained by the grounded parameterized ridge(s), :math:`u_0` +is a small residual velocity and :math:`\alpha_b` is a parameter to ensure that the seabed stress quickly drops when +the ice concentration is smaller than 1. In the code, :math:`k_2 \max [0,(h_u - h_{cu})] e^{-\alpha_b * (1 - a_u)}` is defined as +:math:`T_b`. The quantities :math:`h_u`, :math:`a_{u}` and :math:`h_{cu}` are calculated at +the 'u' point based on local ice conditions (surrounding tracer points). They are respectively given by .. math:: h_u=\max[v_i(i,j),v_i(i+1,j),v_i(i,j+1),v_i(i+1,j+1)], \\ - :label: hu - + :label: hu + .. math:: a_u=\max[a_i(i,j),a_i(i+1,j),a_i(i,j+1),a_i(i+1,j+1)]. \\ - :label: au - + :label: au + .. math:: h_{cu}=a_u h_{wu} / k_1, \\ :label: hcu -where the :math:`a_i` and :math:`v_i` are the total ice concentrations and ice volumes around the :math:`u` point :math:`i,j` and -:math:`k_1` is a parameter that defines the critical ice thickness :math:`h_{cu}` at which the parameterized -ridge(s) reaches the seafloor for a water depth :math:`h_{wu}=\min[h_w(i,j),h_w(i+1,j),h_w(i,j+1),h_w(i+1,j+1)]`. Given the formulation of :math:`C_b` in equation :eq:`Cb`, the seabed stress components are non-zero only -when :math:`h_u > h_{cu}`. +where the :math:`a_i` and :math:`v_i` are the total ice concentrations and ice volumes around the :math:`u` point :math:`i,j` and +:math:`k_1` is a parameter that defines the critical ice thickness :math:`h_{cu}` at which the parameterized +ridge(s) reaches the seafloor for a water depth :math:`h_{wu}=\min[h_w(i,j),h_w(i+1,j),h_w(i,j+1),h_w(i+1,j+1)]`. Given the formulation of :math:`C_b` in equation :eq:`Cb`, the seabed stress components are non-zero only +when :math:`h_u > h_{cu}`. -The maximum seabed stress depends on the weight of the ridge -above hydrostatic balance and the value of :math:`k_2`. It is, however, the parameter :math:`k_1` that has the most notable impact on the simulated extent of landfast ice. -The value of :math:`k_1` can be changed at runtime using the namelist variable ``k1``. The grounding scheme can be turned on or off using the namelist logical basalstress. +The maximum seabed stress depends on the weight of the ridge +above hydrostatic balance and the value of :math:`k_2`. It is, however, the parameter :math:`k_1` that has the most notable impact on the simulated extent of landfast ice. +The value of :math:`k_1` can be changed at runtime using the namelist variable ``k1``. -Note that the user must provide a bathymetry field for using this grounding -scheme. It is suggested to have a bathymetry field with water depths larger than -5 m that represents well shallow water regions such as the Laptev Sea and the -East Siberian Sea. To prevent unrealistic grounding, :math:`T_b` is set to zero when :math:`h_{wu}` -is larger than 30 m. This maximum value is chosen based on observations of large +To prevent unrealistic grounding, :math:`T_b` is set to zero when :math:`h_{wu}` +is larger than 30 m. This maximum value is chosen based on observations of large keels in the Arctic Ocean :cite:`Amundrud04`. - +Seabed stress based on probabilistic approach +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +This more sophisticated grounding parameterization computes the seabed stress based +on the probability of contact between the ice thickness distribution +(ITD) and the seabed. Multi-thickness category models such as CICE typically use a +few thickness categories (5-10). This crude representation of the ITD +does not resolve the tail of the ITD, which is crucial for grounding +events. + +To represent the tail of the distribution, the simulated ITD is +converted to a positively skewed probability function :math:`f(x)` +with :math:`x` the sea ice thickness. The mean and variance are set +equal to the ones of the original ITD. A +log-normal distribution is used for :math:`f(x)`. + +It is assumed that the bathymetry :math:`y` (at the 't' point) follows a normal +distribution :math:`b(y)`. The mean of :math:`b(y)` comes from the user's bathymetry field and the +standard deviation :math:`\sigma_b` is currently fixed to 2.5 m. Two +possible improvements would be to specify a distribution based on high +resolution bathymetry data and to take into account variations of the +water depth due to changes in the sea surface height. + +Assuming hydrostatic balance and neglecting the impact of snow, the draft of floating ice of thickness +:math:`x` is :math:`D(x)=\rho_i x / \rho_w` where :math:`\rho_i` is the sea ice density. Hence, the probability of contact (:math:`P_c`) between the +ITD and the seabed is given by + +.. math:: + P_c=\int_{0}^{\inf} \int_{0}^{D(x)} g(x)b(y) dy dx \label{prob_contact}. + +:math:`T_b` is first calculated at the 't' point (referred to as :math:`T_{bt}`). :math:`T_{bt}` depends on the weight of the ridge in excess of hydrostatic balance. The parameterization first calculates + +.. math:: + T_{bt}^*=\mu_s g \int_{0}^{\inf} \int_{0}^{D(x)} (\rho_i x - \rho_w + y)g(x)b(y) dy dx, \\ + :label: Tbt + +and then obtains :math:`T_{bt}` by multiplying :math:`T_{bt}^*` by :math:`e^{-\alpha_b * (1 - a_i)}` (similar to what is done for ``seabed_stress_method`` = ``LKD``). + +To calculate :math:`T_{bt}^*` in equation :eq:`Tbt`, :math:`f(x)` and :math:`b(y)` are discretized using many small categories (100). :math:`f(x)` is discretized between 0 and 50 m while :math:`b(y)` is truncated at plus and minus three :math:`\sigma_b`. :math:`f(x)` is also modified by setting it to zero after a certain percentile of the log-normal distribution. This percentile, which is currently set to 99.7%, notably affects the simulation of landfast ice and is used as a tuning parameter. Its impact is similar to the one of the parameter :math:`k_1` for the LKD method. + +:math:`T_b` at the 'u' point is calculated from the 't' point values around it according to + +.. math:: + T_b=\max[T_{bt}(i,j),T_{bt}(i+1,j),T_{bt}(i,j+1),T_{bt}(i+1,j+1)]. \\ + :label: Tb + +Following again the LKD method, the seabed stress coefficients are finally expressed as + +.. math:: + C_b= T_b (\sqrt{u^2+v^2}+u_0)^{-1}, \\ + :label: Cb2 + .. _internal-stress: *************** @@ -291,13 +361,13 @@ divergence, :math:`D_D`, and the horizontal tension and shearing strain rates, :math:`D_T` and :math:`D_S` respectively: .. math:: - D_D = \dot{\epsilon}_{11} + \dot{\epsilon}_{22}, + D_D = \dot{\epsilon}_{11} + \dot{\epsilon}_{22}, .. math:: - D_T = \dot{\epsilon}_{11} - \dot{\epsilon}_{22}, + D_T = \dot{\epsilon}_{11} - \dot{\epsilon}_{22}, .. math:: - D_S = 2\dot{\epsilon}_{12}, + D_S = 2\dot{\epsilon}_{12}, where @@ -305,13 +375,17 @@ where \dot{\epsilon}_{ij} = {1\over 2}\left({{\partial u_i}\over{\partial x_j}} + {{\partial u_j}\over{\partial x_i}}\right) CICE can output the internal ice pressure which is an important field to support navigation in ice-infested water. -The internal ice pressure (``sigP``) is the average of the normal stresses multiplied by :math:`-1` and +The internal ice pressure (``sigP``) is the average of the normal stresses multiplied by :math:`-1` and is therefore simply equal to :math:`-\sigma_1/2`. -Following the approach of :cite:`Konig10` (see also :cite:`Lemieux16`), the -elliptical yield curve can be modified such that the ice has isotropic tensile strength. -The tensile strength :math:`T_p` is expressed as a fraction of the ice strength :math:`P`, that is :math:`T_p=k_t P` -where :math:`k_t` should be set to a value between 0 and 1 (this can be changed at runtime with the namelist parameter ``Ktens``). +Following the approach of :cite:`Konig10` (see also :cite:`Lemieux16`), the +elliptical yield curve can be modified such that the ice has isotropic tensile strength. +The tensile strength :math:`T_p` is expressed as a fraction of the ice strength :math:`P`, that is :math:`T_p=k_t P` +where :math:`k_t` should be set to a value between 0 and 1 (this can +be changed at runtime with the namelist parameter ``Ktens``). The ice +strength :math:`P` is a function of the ice thickness distribution as +described in the `Icepack +Documentation`_. .. _stress-vp: @@ -328,10 +402,10 @@ where :math:`\eta` and :math:`\zeta` are the bulk and shear viscosities. An elliptical yield curve is used, with the viscosities given by .. math:: - \zeta = {P(1+k_t)\over 2\Delta}, + \zeta = {P(1+k_t)\over 2\Delta}, .. math:: - \eta = {P(1+k_t)\over {2\Delta e^2}}, + \eta = {P(1+k_t)\over {2\Delta e^2}}, where @@ -342,9 +416,7 @@ and :math:`P_R` is a “replacement pressure” (see :cite:`Geiger98`, for example), which serves to prevent residual ice motion due to spatial variations of :math:`P` when the rates of strain are exactly zero. -The ice strength :math:`P` -is a function of the ice thickness and concentration -as described in the `Icepack Documentation `_. The parameter :math:`e` is the ratio of the major and minor axes of the elliptical yield curve, also called the ellipse aspect ratio. It can be changed using the namelist parameter ``e_ratio``. +The parameter :math:`e` is the ratio of the major and minor axes of the elliptical yield curve, also called the ellipse aspect ratio. It can be changed using the namelist parameter ``e_ratio``. .. _stress-evp: @@ -374,7 +446,7 @@ dynamics component is subcycled within the time step, and the elastic parameter :math:`E` is defined in terms of a damping timescale :math:`T` for elastic waves, :math:`\Delta t_e < T < \Delta t`, as -.. math:: +.. math:: E = {\zeta\over T}, where :math:`T=E_\circ\Delta t` and :math:`E_\circ` (eyc) is a tunable @@ -382,7 +454,7 @@ parameter less than one. Including the modification proposed by :cite:`Bouillon1 .. math:: \begin{aligned} - {\partial\sigma_1\over\partial t} + {\sigma_1\over 2T} + {\partial\sigma_1\over\partial t} + {\sigma_1\over 2T} + {P_R(1-k_t)\over 2T} &=& {P(1+k_t)\over 2T\Delta} D_D, \\ {\partial\sigma_2\over\partial t} + {\sigma_2\over 2T} &=& {P(1+k_t)\over 2Te^2\Delta} D_T,\\ @@ -393,14 +465,14 @@ Once discretized in time, these last three equations are written as .. math:: \begin{aligned} - {(\sigma_1^{k+1}-\sigma_1^{k})\over\Delta t_e} + {\sigma_1^{k+1}\over 2T} + {(\sigma_1^{k+1}-\sigma_1^{k})\over\Delta t_e} + {\sigma_1^{k+1}\over 2T} + {P_R^k(1-k_t)\over 2T} &=& {P(1+k_t)\over 2T\Delta^k} D_D^k, \\ {(\sigma_2^{k+1}-\sigma_2^{k})\over\Delta t_e} + {\sigma_2^{k+1}\over 2T} &=& {P(1+k_t)\over 2Te^2\Delta^k} D_T^k,\\ {(\sigma_{12}^{k+1}-\sigma_{12}^{k})\over\Delta t_e} + {\sigma_{12}^{k+1}\over 2T} &=& {P(1+k_t)\over 4Te^2\Delta^k}D_S^k,\end{aligned} - :label: sigdisc - + :label: sigdisc + where :math:`k` denotes again the subcycling step. All coefficients on the left-hand side are constant except for :math:`P_R`. This modification compensates for the decreased efficiency of including @@ -425,7 +497,7 @@ anisotropy of the sea ice cover is accounted for by an additional prognostic variable, the structure tensor :math:`\mathbf{A}` defined by -.. math:: +.. math:: {\mathbf A}=\int_{\mathbb{S}}\vartheta(\mathbf r)\mathbf r\mathbf r d\mathbf r\label{structuretensor}. where :math:`\mathbb{S}` is a unit-radius circle; **A** is a unit @@ -444,7 +516,7 @@ components of :math:`\mathbf{A}`, :math:`A_{1}/A_{2}`, are derived from the phenomenological evolution equation for the structure tensor :math:`\mathbf A`, -.. math:: +.. math:: \frac{D\mathbf{A}}{D t}=\mathbf{F}_{iso}(\mathbf{A})+\mathbf{F}_{frac}(\mathbf{A},\boldsymbol\sigma), :label: evolutionA @@ -508,7 +580,7 @@ of two equations: .. math:: \begin{aligned} - \frac{\partial A_{11}}{\partial t}&=&-k_{t}\left(A_{11}-\frac{1}{2}\right)+M_{11} \mbox{,} \\ + \frac{\partial A_{11}}{\partial t}&=&-k_{t}\left(A_{11}-\frac{1}{2}\right)+M_{11} \mbox{,} \\ \frac{\partial A_{12}}{\partial t}&=&-k_{t} A_{12}+M_{12} \mbox{,}\end{aligned} where the first terms on the right hand side correspond to the @@ -545,7 +617,7 @@ but in a continuum-scale sea ice region the floes can possess different orientations in different places and we take the mean sea ice stress over a collection of floes to be given by the average -.. math:: +.. math:: \boldsymbol\sigma^{EAP}(h)=P_{r}(h)\int_{\mathbb{S}}\vartheta(\mathbf r)\left[\boldsymbol\sigma_{r}^{b}(\mathbf r)+ k \boldsymbol\sigma_{s}^{b}(\mathbf r)\right]d\mathbf r :label: stressaverage @@ -560,11 +632,11 @@ efficient, explicit numerical algorithm used to solve the full sea ice momentum balance. We use the analogous EAP stress equations, .. math:: - \frac{\partial \sigma_{1}}{\partial t}+\frac{\sigma_1}{2T} = \frac{\sigma^{EAP}_{1}}{2T} \mbox{,} + \frac{\partial \sigma_{1}}{\partial t}+\frac{\sigma_1}{2T} = \frac{\sigma^{EAP}_{1}}{2T} \mbox{,} :label: EAPsigma1 .. math:: - \frac{\partial \sigma_{2}}{\partial t}+\frac{\sigma_2}{2T} = \frac{\sigma^{EAP}_{2}}{2T} \mbox{,} + \frac{\partial \sigma_{2}}{\partial t}+\frac{\sigma_2}{2T} = \frac{\sigma^{EAP}_{2}}{2T} \mbox{,} :label: EAPsigma2 .. math:: @@ -603,44 +675,44 @@ of the dynamics. Revised approach **************** -The revised EVP approach is based on a pseudo-time iterative scheme :cite:`Lemieux12`, :cite:`Bouillon13`, :cite:`Kimmritz15`. By construction, the revised EVP approach should lead to the VP solution -(given the right numerical parameters and a sufficiently large number of iterations). To do so, the inertial term is formulated such that it matches the backward Euler approach of -implicit solvers and there is an additional term for the pseudo-time iteration. Hence, with the revised approach, the discretized momentum equations :eq:`umom` and :eq:`vmom` become +The revised EVP approach is based on a pseudo-time iterative scheme :cite:`Lemieux12`, :cite:`Bouillon13`, :cite:`Kimmritz15`. By construction, the revised EVP approach should lead to the VP solution +(given the right numerical parameters and a sufficiently large number of iterations). To do so, the inertial term is formulated such that it matches the backward Euler approach of +implicit solvers and there is an additional term for the pseudo-time iteration. Hence, with the revised approach, the discretized momentum equations :eq:`umom` and :eq:`vmom` become .. math:: - {\beta^*(u^{k+1}-u^k)\over\Delta t_e} + {m(u^{k+1}-u^n)\over\Delta t} + {\left({\tt vrel} \cos\theta + C_b \right)} u^{k+1} + {\beta^*(u^{k+1}-u^k)\over\Delta t_e} + {m(u^{k+1}-u^n)\over\Delta t} + {\left({\tt vrel} \cos\theta + C_b \right)} u^{k+1} - {\left(mf+{\tt vrel}\sin\theta\right)} v^{k+1} - = {{\partial\sigma_{1j}^{k+1}\over\partial x_j}} + = {{\partial\sigma_{1j}^{k+1}\over\partial x_j}} + {\tau_{ax} - mg{\partial H_\circ\over\partial x} } + {\tt vrel} {\left(U_w\cos\theta-V_w\sin\theta\right)}, :label: umomr .. math:: - {\beta^*(v^{k+1}-v^k)\over\Delta t_e} + {m(v^{k+1}-v^n)\over\Delta t} + {\left({\tt vrel} \cos\theta + C_b \right)}v^{k+1} - + {\left(mf+{\tt vrel}\sin\theta\right)} u^{k+1} - = {{\partial\sigma_{2j}^{k+1}\over\partial x_j}} + {\beta^*(v^{k+1}-v^k)\over\Delta t_e} + {m(v^{k+1}-v^n)\over\Delta t} + {\left({\tt vrel} \cos\theta + C_b \right)}v^{k+1} + + {\left(mf+{\tt vrel}\sin\theta\right)} u^{k+1} + = {{\partial\sigma_{2j}^{k+1}\over\partial x_j}} + {\tau_{ay} - mg{\partial H_\circ\over\partial y} } + {\tt vrel}{\left(U_w\sin\theta+V_w\cos\theta\right)}, :label: vmomr -where :math:`\beta^*` is a numerical parameter and :math:`u^n, v^n` are the components of the previous time level solution. +where :math:`\beta^*` is a numerical parameter and :math:`u^n, v^n` are the components of the previous time level solution. With :math:`\beta=\beta^* \Delta t \left( m \Delta t_e \right)^{-1}` :cite:`Bouillon13`, these equations can be written as - + .. math:: - \underbrace{\left((\beta+1){m\over\Delta t}+{\tt vrel} \cos\theta\ + C_b \right)}_{\tt cca} u^{k+1} + \underbrace{\left((\beta+1){m\over\Delta t}+{\tt vrel} \cos\theta\ + C_b \right)}_{\tt cca} u^{k+1} - \underbrace{\left(mf+{\tt vrel}\sin\theta\right)}_{\tt ccb}v^{k+1} - = \underbrace{{\partial\sigma_{1j}^{k+1}\over\partial x_j}}_{\tt strintx} + = \underbrace{{\partial\sigma_{1j}^{k+1}\over\partial x_j}}_{\tt strintx} + \underbrace{\tau_{ax} - mg{\partial H_\circ\over\partial x} }_{\tt forcex} + {\tt vrel}\underbrace{\left(U_w\cos\theta-V_w\sin\theta\right)}_{\tt waterx} + {m\over\Delta t}(\beta u^k + u^n), :label: umomr2 .. math:: - \underbrace{\left(mf+{\tt vrel}\sin\theta\right)}_{\tt ccb} u^{k+1} + \underbrace{\left(mf+{\tt vrel}\sin\theta\right)}_{\tt ccb} u^{k+1} + \underbrace{\left((\beta+1){m\over\Delta t}+{\tt vrel} \cos\theta + C_b \right)}_{\tt cca}v^{k+1} - = \underbrace{{\partial\sigma_{2j}^{k+1}\over\partial x_j}}_{\tt strinty} + = \underbrace{{\partial\sigma_{2j}^{k+1}\over\partial x_j}}_{\tt strinty} + \underbrace{\tau_{ay} - mg{\partial H_\circ\over\partial y} }_{\tt forcey} + {\tt vrel}\underbrace{\left(U_w\sin\theta+V_w\cos\theta\right)}_{\tt watery} + {m\over\Delta t}(\beta v^k + v^n), - :label: vmomr2 + :label: vmomr2 At this point, the solutions :math:`u^{k+1}` and :math:`v^{k+1}` are obtained in the same manner as for the standard EVP approach (see equations :eq:`cevpuhat` to :eq:`cevpb`). @@ -648,16 +720,26 @@ Introducing another numerical parameter :math:`\alpha=2T \Delta t_e ^{-1}` :cite .. math:: \begin{aligned} - {\alpha (\sigma_1^{k+1}-\sigma_1^{k})} + {\sigma_1^{k}} + {\alpha (\sigma_1^{k+1}-\sigma_1^{k})} + {\sigma_1^{k}} + {P_R^k(1-k_t)} &=& {P(1+k_t)\over \Delta^k} D_D^k, \\ {\alpha (\sigma_2^{k+1}-\sigma_2^{k})} + {\sigma_2^{k}} &=& {P(1+k_t)\over e^2\Delta^k} D_T^k,\\ {\alpha (\sigma_{12}^{k+1}-\sigma_{12}^{k})} + {\sigma_{12}^{k}} &=& {P(1+k_t)\over 2e^2\Delta^k}D_S^k,\end{aligned} - -where as opposed to the classic EVP, the second term in each equation is at iteration :math:`k` :cite:`Bouillon13`. Also, as opposed to the classic EVP, -:math:`\Delta t_e` times the number of subcycles (or iterations) does not need to be equal to the advective time step :math:`\Delta t`. -Finally, as with the classic EVP approach, the stresses are initialized using the previous time level values. -The revised EVP is activated by setting the namelist parameter ``revised_evp = true``. -In the code :math:`\alpha` is ``arlx`` and :math:`\beta` is ``brlx``. The values of ``arlx`` and ``brlx`` can be set in the namelist. + +where as opposed to the classic EVP, the second term in each equation is at iteration :math:`k` :cite:`Bouillon13`. Also, as opposed to the classic EVP, +:math:`\Delta t_e` times the number of subcycles (or iterations) does not need to be equal to the advective time step :math:`\Delta t`. +Finally, as with the classic EVP approach, the stresses are initialized using the previous time level values. +The revised EVP is activated by setting the namelist parameter ``revised_evp = true``. +In the code :math:`\alpha` is ``arlx`` and :math:`\beta` is ``brlx``. The values of ``arlx`` and ``brlx`` can be set in the namelist. It is recommended to use large values of these parameters and to set :math:`\alpha=\beta` :cite:`Kimmritz15`. + +.. _evp1d: + +**************** +1d EVP solver +**************** + +The standard EVP solver iterates hundreds of times, where each iteration includes a communication through MPI and a limited number of calculations. This limits how much the solver can be optimized as the speed is primarily determined by the communication. The 1d EVP solver avoids the communication by utilizing shared memory, which removes the requirement for calls to the MPI communicator. As a consequence of this the potential scalability of the code is improved. The performance is best on shared memory but the solver is also functional on MPI and hybrid MPI/OpenMP setups as it will run on the master processor alone. + +The scalability of geophysical models is in general terms limited by the memory usage. In order to optimize this the 1d EVP solver solves the same equations that are outlined in the section :ref:`stress-evp` but it transforms all matrices to vectors (1d matrices) as this compiles better with the computer hardware. The vectorization and the contiguous placement of arrays in the memory makes it easier for the compiler to optimize the code and pass pointers instead of copying the vectors. The 1d solver is not supported for tripole grids and the code will abort if this combination is attempted. diff --git a/doc/source/science_guide/sg_tracers.rst b/doc/source/science_guide/sg_tracers.rst index bbd18eb1f..215c13d08 100644 --- a/doc/source/science_guide/sg_tracers.rst +++ b/doc/source/science_guide/sg_tracers.rst @@ -90,6 +90,10 @@ is not in use. "tr_iso", "n_iso", "vice, vsno", "nt_iso"," " "tr_brine", " ", "vice", "nt_fbri", " " "tr_fsd","nfsd","aice","nt_fsd"," " + "tr_snow","nslyr","vsno","nt_rsnw"," " + " ","nslyr","vsno","nt_rhos"," " + " ","nslyr","vsno","nt_smice"," " + " ","nslyr","vsno","nt_smliq"," " "solve_zsal", "n_trzs", "fbri or (a,v)ice", "nt_bgc_S", " " "tr_bgc_N", "n_algae", "fbri or (a,v)ice", "nt_bgc_N", "nlt_bgc_N" "tr_bgc_Nit", " ", "fbri or (a,v)ice", "nt_bgc_Nit", "nlt_bgc_Nit" @@ -115,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, 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 44ee6f5b0..415ddfeaa 100644 --- a/doc/source/user_guide/ug_case_settings.rst +++ b/doc/source/user_guide/ug_case_settings.rst @@ -319,6 +319,7 @@ tracer_nml "``tr_pond_cesm``", "logical", "CESM melt ponds", "``.false.``" "``tr_pond_lvl``", "logical", "level-ice melt ponds", "``.false.``" "``tr_pond_topo``", "logical", "topo melt ponds", "``.false.``" + "``tr_snow``", "logical", "advanced snow physics", "``.false.``" "``restart_aero``", "logical", "restart tracer values from file", "``.false.``" "``restart_age``", "logical", "restart tracer values from file", "``.false.``" "``restart_fsd``", "logical", "restart floe size distribution values from file", "``.false.``" @@ -387,8 +388,8 @@ dynamics_nml "", "``1``", "EVP dynamics", "" "", "``2``", "EAP dynamics", "" "", "``3``", "VP dynamics", "" - "``kevp_kernel``", "``0``", "standard 2D EVP memory parallel solver", "0" - "", "``2``", "1D shared memory solver (not fully validated)", "" + "``evp_algorithm``", "``standard_2d``", "standard 2d EVP memory parallel solver", "standard_2d" + "", "``shared_mem_1d``", "1d shared memory solver", "" "``kstrength``", "``0``", "ice strength formulation :cite:`Hibler79`", "1" "", "``1``", "ice strength formulation :cite:`Rothrock75`", "" "``krdg_partic``", "``0``", "old ridging participation function", "1" @@ -477,6 +478,40 @@ ponds_nml "``rfracmin``", ":math:`0 \le r_{min} \le 1`", "minimum melt water added to ponds", "0.15" "", "", "", "" +snow_nml +~~~~~~~~~~~~~~~~~~~~~~~~~ + +.. csv-table:: **snow_nml namelist options** + :header: "variable", "options/format", "description", "default value" + :widths: 15, 15, 30, 15 + + "", "", "", "" + "``drhosdwind``", "real", "wind compactions factor for now in kg-s/m^4", "27.3" + "``rhosmax``", "real", "maximum snow density in kg/m^3", "450." + "``rhosmin``", "real", "minimum snow density in kg/m^3", "100." + "``rhosnew``", "real", "new snow density in kg/m^3", "100." + "``rsnw_fall``", "real", "radius of new snow in 1.0e-6 m", "100." + "``rsnw_tmax``", "real", "maximum snow radius in 1.0e-6 m", "1500." + "``snwgrain``", "logical", "snow metamorophsis flag", "``.false.``" + "``snwlvlfac``", "real", "fractional increase in snow", "0.3" + "``snwredist``", "``bulk``", "bulk snow redistribution scheme", "``none``" + "", "``ITD``", "ITD snow redistribution scheme", "" + "", "``ITDrdg``", "ITDrdg snow redistribution scheme", "" + "", "``none``", "snow redistribution scheme off", "" + "``snw_aging_table``", "file", "read 1D and 3D fields for dry metamorophsis lookup table", "test" + "", "snicar", "read 3D fields for dry metamorophsis lookup table", "" + "", "test", "internally generated dry metamorophsis lookup table for testing", "" + "``snw_drdt0_fname``", "string", "snow aging file drdt0 fieldname", "unknown" + "``snw_filename``", "string", "snow aging table data filename", "unknown" + "``snw_kappa_fname``", "string", "snow aging file kappa fieldname", "unknown" + "``snw_rhos_fname``", "string", "snow aging file rhos fieldname", "unknown" + "``snw_T_fname``", "string", "snow aging file T fieldname", "unknown" + "``snw_tau_fname``", "string", "snow aging file tau fieldname", "unknown" + "``snw_Tgrd_fname``", "string", "snow aging file Tgrd fieldname", "unknown" + "``use_smliq_pnd``", "logical", "use liquid in snow for ponds", "``.false.``" + "``windmin``", "real", "minimum wind speed to compact snow in m/s", "10." + "", "", "", "" + forcing_nml ~~~~~~~~~~~~~~~~~~~~~~~~~ diff --git a/doc/source/user_guide/ug_implementation.rst b/doc/source/user_guide/ug_implementation.rst index 566d10fbc..61461d426 100644 --- a/doc/source/user_guide/ug_implementation.rst +++ b/doc/source/user_guide/ug_implementation.rst @@ -81,20 +81,35 @@ Grid, boundary conditions and masks The spatial discretization is specialized for a generalized orthogonal B-grid as in :cite:`Murray96` or -:cite:`Smith95`. The ice and snow area, volume and energy are -given at the center of the cell, velocity is defined at the corners, and -the internal ice stress tensor takes four different values within a grid +:cite:`Smith95`. Figure :ref:`fig-Bgrid` is a schematic of CICE +B-grid. This cell with the tracer point :math:`t(i,j)` in the middle +is referred to as T-cell. The ice and snow area, volume and energy are +given at the t-point. The velocity :math:`{\bf u}(i,j)` +associated with :math:`t(i,j)` is defined in the northeast (NE) +corner. The other corners of the T-cell are northwest (NW), southwest +(SW) and southeast (SE). The lengths of the four edges of the T-cell +are respectively HTN, HTW, HTS and HTE for the northern, western, +southern and eastern edges. The lengths of the T-cell through the +middle are respectively dxt and dyt along the x and y axis. + +We also occasionally refer to “U-cells,” which are centered on the +northeast corner of the corresponding T-cells and have velocity in the +center of each. The velocity components are aligned along grid lines. + +The internal ice stress tensor takes four different values within a grid cell; bilinear approximations are used for the stress tensor and the ice velocity across the cell, as described in :cite:`Hunke02`. This tends to avoid the grid decoupling problems associated with the B-grid. EVP is available on the C-grid through the MITgcm code distribution, http://mitgcm.org/viewvc/MITgcm/MITgcm/pkg/seaice/. -Since ice thickness and thermodynamic variables such as temperature are given -in the center of each cell, the grid cells are referred to as “T cells.” -We also occasionally refer to “U cells,” which are centered on the -northeast corner of the corresponding T cells and have velocity in the -center of each. The velocity components are aligned along grid lines. +.. _fig-Bgrid: + +.. figure:: ./figures/CICE_Bgrid.png + :align: center + :scale: 55% + + Schematic of CICE B-grid. The user has several choices of grid routines: *popgrid* reads grid lengths and other parameters for a nonuniform grid (including tripole @@ -203,11 +218,11 @@ middle of the row. The grid is constructed by “folding” the top row, so that the left-hand half and the right-hand half of it coincide. Two choices for constructing the tripole grid are available. The one first introduced to CICE is called “U-fold”, which means that the poles and -the grid cells between them are U cells on the grid. Alternatively the -poles and the cells between them can be grid T cells, making a “T-fold.” +the grid cells between them are U-cells on the grid. Alternatively the +poles and the cells between them can be grid T-cells, making a “T-fold.” Both of these options are also supported by the OPA/NEMO ocean model, which calls the U-fold an “f-fold” (because it uses the Arakawa C-grid -in which U cells are on T-rows). The choice of tripole grid is given by +in which U-cells are on T-rows). The choice of tripole grid is given by the namelist variable ``ns_boundary_type``, ‘tripole’ for the U-fold and ‘tripoleT’ for the T-fold grid. @@ -329,7 +344,7 @@ dynamics component to prevent unnecessary calculations on grid points where there is no ice. They are not used in the thermodynamics component, so that ice may form in previously ice-free cells. Like the land masks ``hm`` and ``uvm``, the ice extent masks ``ice_tmask`` and ``ice_umask`` -are for T cells and U cells, respectively. +are for T-cells and U-cells, respectively. Improved parallel performance may result from utilizing halo masks for boundary updates of the full ice state, incremental remapping transport,