diff --git a/.zenodo.json b/.zenodo.json index f5b00f1f8..d96cfb9bb 100644 --- a/.zenodo.json +++ b/.zenodo.json @@ -1,22 +1,22 @@ { "license": "BSD-3-Clause", - "copyright": "Copyright (c) 1998, 2017 Triad National Security, LLC", + "copyright": "Copyright 1998-2025 Triad National Security, LLC", "description": "View detailed release notes at https://github.com/CICE-Consortium/CICE/releases", "language": "eng", - "title": "CICE-Consortium/CICE: CICE Version 6.6.1", + "title": "CICE-Consortium/CICE: CICE Version 6.6.2", "keywords": [ "sea ice model", "CICE", "Icepack" ], - "version": "6.6.1", + "version": "6.6.2", "upload_type": "software", "communities": [ { "identifier": "cice-consortium" } ], - "publication_date": "2025-07-21", + "publication_date": "2025-08-15", "creators": [ { "affiliation": "Los Alamos National Laboratory", diff --git a/COPYRIGHT.pdf b/COPYRIGHT.pdf index 55132ca5e..2f37e495f 100644 Binary files a/COPYRIGHT.pdf and b/COPYRIGHT.pdf differ diff --git a/cicecore/cicedyn/analysis/ice_history.F90 b/cicecore/cicedyn/analysis/ice_history.F90 index a6eabe2db..99b04afb9 100644 --- a/cicecore/cicedyn/analysis/ice_history.F90 +++ b/cicecore/cicedyn/analysis/ice_history.F90 @@ -1535,17 +1535,17 @@ subroutine init_hist (dt) call define_hist_field(n_sitemptop,"sitemptop","K",tstr2D, tcstr, & "sea ice surface temperature", & - "none", c1, c0, & + "none", c1, Tffresh, & ns1, f_sitemptop, avg_ice_present=.true., mask_ice_free_points=.true.) call define_hist_field(n_sitempsnic,"sitempsnic","K",tstr2D, tcstr, & "snow ice interface temperature", & - "surface temperature when no snow present", c1, c0, & + "surface temperature when no snow present", c1, Tffresh, & ns1, f_sitempsnic, avg_ice_present=.true., mask_ice_free_points=.true.) call define_hist_field(n_sitempbot,"sitempbot","K",tstr2D, tcstr, & "sea ice bottom temperature", & - "none", c1, c0, & + "none", c1, Tffresh, & ns1, f_sitempbot, avg_ice_present=.true., mask_ice_free_points=.true.) call define_hist_field(n_siu,"siu","m/s",ustr2D, ucstr, & @@ -2753,22 +2753,18 @@ subroutine accum_hist (dt) worka(:,:) = c0 do j = jlo, jhi do i = ilo, ihi - if (aice(i,j,iblk) > puny) & - worka(i,j) = aice(i,j,iblk)*(trcr(i,j,nt_Tsfc,iblk)+Tffresh) + worka(i,j) = aice(i,j,iblk)*trcr(i,j,nt_Tsfc,iblk) enddo enddo call accum_hist_field(n_sitemptop, iblk, worka(:,:), a2D) endif + ! Tsnice is already multiplied by aicen in icepack. if (f_sitempsnic(1:1) /= 'x') then worka(:,:) = c0 do j = jlo, jhi do i = ilo, ihi - if (vsno(i,j,iblk) > puny .and. aice_init(i,j,iblk) > puny) then - worka(i,j) = aice(i,j,iblk)*(Tsnice(i,j,iblk)/aice_init(i,j,iblk)+Tffresh) - else - worka(i,j) = aice(i,j,iblk)*(trcr(i,j,nt_Tsfc,iblk)+Tffresh) - endif + worka(i,j) = Tsnice(i,j,iblk) enddo enddo call accum_hist_field(n_sitempsnic, iblk, worka(:,:), a2D) @@ -2778,8 +2774,7 @@ subroutine accum_hist (dt) worka(:,:) = c0 do j = jlo, jhi do i = ilo, ihi - if (aice_init(i,j,iblk) > puny) & - worka(i,j) = aice(i,j,iblk)*(Tbot(i,j,iblk)/aice_init(i,j,iblk)+Tffresh) + worka(i,j) = aice(i,j,iblk)*Tbot(i,j,iblk) enddo enddo call accum_hist_field(n_sitempbot, iblk, worka(:,:), a2D) @@ -3705,33 +3700,40 @@ subroutine accum_hist (dt) do n = 1, num_avail_hist_fields_2D if (avail_hist_fields(n)%vhistfreq == histfreq(ns)) then - 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_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 - endif - enddo ! i - enddo ! j - - ! Only average for timesteps when ice present + ! Only average when/where ice present if (avail_hist_fields(n)%avg_ice_present) then do j = jlo, jhi do i = ilo, ihi - if (tmask(i,j,iblk)) then - a2D(i,j,n,iblk) = & - a2D(i,j,n,iblk)*avgct(ns)*ravgip(i,j) + if (.not. tmask(i,j,iblk)) then + 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) & + * ravgip(i,j) + avail_hist_fields(n)%conb endif - ! Mask ice-free points - if (avail_hist_fields(n)%mask_ice_free_points) then - if (ravgip(i,j) == c0) a2D(i,j,n,iblk) = spval_dbl + enddo ! i + enddo ! j + else + 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_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 endif enddo ! i enddo ! j endif + ! Mask ice-free points + if (avail_hist_fields(n)%mask_ice_free_points) then + do j = jlo, jhi + do i = ilo, ihi + if (ravgip(i,j) == c0) a2D(i,j,n,iblk) = spval_dbl + enddo ! i + enddo ! j + endif + ! CMIP albedo: also mask points below horizon if (index(avail_hist_fields(n)%vname,'sialb') /= 0) then do j = jlo, jhi @@ -3838,30 +3840,33 @@ subroutine accum_hist (dt) nn = n2D + n if (avail_hist_fields(nn)%vhistfreq == histfreq(ns)) then - do k = 1, ncat_hist - 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_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 + if (avail_hist_fields(nn)%avg_ice_present) then + do k = 1, ncat_hist + 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_dbl + else ! convert units + a3Dc(i,j,k,n,iblk) = avail_hist_fields(nn)%cona*a3Dc(i,j,k,n,iblk) & + * ravgipn(i,j,k) + avail_hist_fields(nn)%conb + endif + enddo ! i + enddo ! j + enddo ! k + else + do k = 1, ncat_hist + 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_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 + endif + enddo ! i + enddo ! j + enddo ! k endif - enddo ! i - enddo ! j - enddo ! k - if (avail_hist_fields(nn)%avg_ice_present) then - do k = 1, ncat_hist - do j = jlo, jhi - do i = ilo, ihi - if (tmask(i,j,iblk)) then - a3Dc(i,j,k,n,iblk) = & - a3Dc(i,j,k,n,iblk)*avgct(ns)*ravgipn(i,j,k) - endif - enddo ! i - enddo ! j - enddo ! k - endif endif @@ -3885,6 +3890,7 @@ subroutine accum_hist (dt) enddo ! k endif enddo ! n + do n = 1, num_avail_hist_fields_3Db nn = n3Dzcum + n if (avail_hist_fields(nn)%vhistfreq == histfreq(ns)) then diff --git a/cicecore/cicedyn/dynamics/ice_dyn_evp1d.F90 b/cicecore/cicedyn/dynamics/ice_dyn_evp1d.F90 index 223ef2849..18316640e 100644 --- a/cicecore/cicedyn/dynamics/ice_dyn_evp1d.F90 +++ b/cicecore/cicedyn/dynamics/ice_dyn_evp1d.F90 @@ -94,7 +94,7 @@ subroutine dyn_evp1d_init endif ! gather from blks to global - call gather_static(G_uarear, G_dxT, G_dyT, G_tmask) + call gather_static(G_uarear, G_dxT, G_dyT, G_tmask) ! calculate number of water points (T and U). Only needed for the static version ! tmask in ocean/ice @@ -349,7 +349,6 @@ subroutine evp1d_alloc_static_na(na0) call abort_ice(subname//' ERROR: allocating', file=__FILE__, line=__LINE__) endif - allocate(indxTi(1:na0), & indxTj(1:na0), & stat=ierr) @@ -628,6 +627,11 @@ subroutine gather_static(G_uarear, G_dxT, G_dyT, G_Tmask) character(len=*), parameter :: subname = '(gather_static)' + G_uarear = c0 + G_dyT = c0 + G_dxT = c0 + G_tmask = .false. + ! copy from distributed I_* to G_* call gather_global_ext(G_uarear, uarear, master_task, distrb_info) call gather_global_ext(G_dxT , dxT , master_task, distrb_info) @@ -977,6 +981,37 @@ subroutine convert_1d_2d_dyn(na0 , navel0 , integer(kind=int_kind) :: lo, up, iw, i, j character(len=*), parameter :: subname = '(convert_1d_2d_dyn)' + 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_strength = c0 + G_cdn_ocn = c0 + G_aiu = c0 + G_uocn = c0 + G_vocn = c0 + G_waterxU = c0 + G_wateryU = c0 + G_forcexU = c0 + G_forceyU = c0 + G_umassdti = c0 + G_fmU = c0 + G_strintxU = c0 + G_strintyU = c0 + G_Tbu = c0 + G_uvel = c0 + G_vvel = c0 + G_taubxU = c0 + G_taubyU = c0 + lo=1 up=na0 do iw = lo, up diff --git a/cicecore/cicedyn/dynamics/ice_dyn_shared.F90 b/cicecore/cicedyn/dynamics/ice_dyn_shared.F90 index 40f49877d..81d603124 100644 --- a/cicecore/cicedyn/dynamics/ice_dyn_shared.F90 +++ b/cicecore/cicedyn/dynamics/ice_dyn_shared.F90 @@ -193,6 +193,13 @@ subroutine alloc_dyn_shared stat=ierr) if (ierr/=0) call abort_ice(subname//': Out of memory') + uvel_init = c0 + vvel_init = c0 + iceTmask = .false. + iceUmask = .false. + fcor_blk = c0 + DminTarea = c0 + allocate( & fld2(nx_block,ny_block,2,max_blocks), & fld3(nx_block,ny_block,3,max_blocks), & @@ -200,6 +207,10 @@ subroutine alloc_dyn_shared stat=ierr) if (ierr/=0) call abort_ice(subname//': Out of memory') + fld2 = c0 + fld3 = c0 + fld4 = c0 + allocate( & cyp(nx_block,ny_block,max_blocks), & ! 1.5*HTE - 0.5*HTW cxp(nx_block,ny_block,max_blocks), & ! 1.5*HTN - 0.5*HTS @@ -208,12 +219,19 @@ subroutine alloc_dyn_shared stat=ierr) if (ierr/=0) call abort_ice(subname//': Out of memory') + cyp = c0 + cxp = c0 + cym = c0 + cxm = c0 + if (grid_ice == 'B' .and. evp_algorithm == "standard_2d") then allocate( & dxhy(nx_block,ny_block,max_blocks), & ! 0.5*(HTE - HTW) dyhx(nx_block,ny_block,max_blocks), & ! 0.5*(HTN - HTS) stat=ierr) if (ierr/=0) call abort_ice(subname//': Out of memory') + dxhy = c0 + dyhx = c0 endif if (grid_ice == 'CD' .or. grid_ice == 'C') then @@ -228,6 +246,14 @@ subroutine alloc_dyn_shared fcorN_blk (nx_block,ny_block,max_blocks), & ! Coriolis stat=ierr) if (ierr/=0) call abort_ice(subname//': Out of memory') + uvelE_init = c0 + vvelE_init = c0 + uvelN_init = c0 + vvelN_init = c0 + iceEmask = .false. + iceNmask = .false. + fcorE_blk = c0 + fcorN_blk = c0 endif end subroutine alloc_dyn_shared diff --git a/cicecore/cicedyn/general/ice_flux.F90 b/cicecore/cicedyn/general/ice_flux.F90 index ff71a4a4d..16d3a6edc 100644 --- a/cicecore/cicedyn/general/ice_flux.F90 +++ b/cicecore/cicedyn/general/ice_flux.F90 @@ -625,40 +625,270 @@ subroutine alloc_flux stat=ierr) if (ierr/=0) call abort_ice('(alloc_flux): Out of memory') - if (grid_ice == "CD" .or. grid_ice == "C") & + strax = c0 + stray = c0 + uocn = c0 + vocn = c0 + ss_tltx = c0 + ss_tlty = c0 + hwater = c0 + strairxT = c0 + strairyT = c0 + strocnxT_iavg= c0 + strocnyT_iavg= c0 + sig1 = c0 + sig2 = c0 + sigP = c0 + taubxU = c0 + taubyU = c0 + strairxU = c0 + strairyU = c0 + strocnxU = c0 + strocnyU = c0 + strtltxU = c0 + strtltyU = c0 + strintxU = c0 + strintyU = c0 + daidtd = c0 + dvidtd = c0 + dvsdtd = c0 + dagedtd = c0 + dardg1dt = c0 + dardg2dt = c0 + dvirdgdt = c0 + opening = c0 + stressp_1 = c0 + stressp_2 = c0 + stressp_3 = c0 + stressp_4 = c0 + stressm_1 = c0 + stressm_2 = c0 + stressm_3 = c0 + stressm_4 = c0 + stress12_1 = c0 + stress12_2 = c0 + stress12_3 = c0 + stress12_4 = c0 + fmU = c0 + TbU = c0 + zlvl = c0 + zlvs = c0 + uatm = c0 + vatm = c0 + wind = c0 + potT = c0 + Tair = c0 + Qa = c0 + rhoa = c0 + swvdr = c0 + swvdf = c0 + swidr = c0 + swidf = c0 + swuvrdr = c0 + swuvrdf = c0 + swpardr = c0 + swpardf = c0 + flw = c0 + frain = c0 + fsnow = c0 + sss = c0 + sst = c0 + frzmlt = c0 + frzmlt_init= c0 + Tf = c0 + qdp = c0 + hmix = c0 + daice_da = c0 + fsens = c0 + flat = c0 + fswabs = c0 + fswint_ai = c0 + flwout = c0 + Tref = c0 + Qref = c0 + Uref = c0 + evap = c0 + evaps = c0 + evapi = c0 + alvdr = c0 + alidr = c0 + alvdf = c0 + alidf = c0 + alvdr_ai = c0 + alidr_ai = c0 + alvdf_ai = c0 + alidf_ai = c0 + albice = c0 + albsno = c0 + albpnd = c0 + apeff_ai = c0 + snowfrac = c0 + alvdr_init = c0 + alidr_init = c0 + alvdf_init = c0 + alidf_init = c0 + fpond = c0 + fresh = c0 + fsalt = c0 + fhocn = c0 + fsloss = c0 + fswthru = c0 + fswthru_vdr= c0 + fswthru_vdf= c0 + fswthru_idr= c0 + fswthru_idf= c0 + fswthru_uvrdr = c0 + fswthru_uvrdf = c0 + fswthru_pardr = c0 + fswthru_pardf = c0 + scale_factor = c0 + strairx_ocn= c0 + strairy_ocn= c0 + fsens_ocn = c0 + flat_ocn = c0 + flwout_ocn = c0 + evap_ocn = c0 + alvdr_ocn = c0 + alidr_ocn = c0 + alvdf_ocn = c0 + alidf_ocn = c0 + Tref_ocn = c0 + Qref_ocn = c0 + fsurf = c0 + fcondtop = c0 + fcondbot = c0 + fbot = c0 + Tbot = c0 + Tsnice = c0 + congel = c0 + frazil = c0 + snoice = c0 + meltt = c0 + melts = c0 + meltb = c0 + meltl = c0 + dsnow = c0 + daidtt = c0 + dvidtt = c0 + dvsdtt = c0 + dagedtt = c0 + mlt_onset = c0 + frz_onset = c0 + frazil_diag= c0 + fresh_ai = c0 + fsalt_ai = c0 + fhocn_ai = c0 + fswthru_ai = c0 + fresh_da = c0 + fsalt_da = c0 + uatmT = c0 + vatmT = c0 + wlat = c0 + fsw = c0 + coszen = c0 + rdg_conv = c0 + rdg_shear = c0 + rsiden = c0 + dardg1ndt = c0 + dardg2ndt = c0 + dvirdgndt = c0 + aparticn = c0 + krdgn = c0 + ardgn = c0 + vrdgn = c0 + araftn = c0 + vraftn = c0 + aredistn = c0 + vredistn = c0 + fsurfn_f = c0 + fcondtopn_f= c0 + fsensn_f = c0 + flatn_f = c0 + evapn_f = c0 + dflatndTsfc_f = c0 + dfsurfndTsfc_f= c0 + meltsn = c0 + melttn = c0 + meltbn = c0 + congeln = c0 + snoicen = c0 + keffn_top = c0 + fsurfn = c0 + fcondtopn = c0 + fcondbotn = c0 + fsensn = c0 + flatn = c0 + albcnt = c0 + snwcnt = c0 + salinz = c0 + Tmltz = c0 + + if (grid_ice == "CD" .or. grid_ice == "C") then allocate( & - taubxN (nx_block,ny_block,max_blocks), & ! seabed stress (x) at N points (N/m^2) - taubyN (nx_block,ny_block,max_blocks), & ! seabed stress (y) at N points (N/m^2) - strairxN (nx_block,ny_block,max_blocks), & ! stress on ice by air, x-direction at N points - strairyN (nx_block,ny_block,max_blocks), & ! stress on ice by air, y-direction at N points - strocnxN (nx_block,ny_block,max_blocks), & ! ice-ocean stress, x-direction at N points - strocnyN (nx_block,ny_block,max_blocks), & ! ice-ocean stress, y-direction at N points - strtltxN (nx_block,ny_block,max_blocks), & ! stress due to sea surface slope, x-direction at N points - strtltyN (nx_block,ny_block,max_blocks), & ! stress due to sea surface slope, y-direction at N points - strintxN (nx_block,ny_block,max_blocks), & ! divergence of internal ice stress, x at N points (N/m^2) - strintyN (nx_block,ny_block,max_blocks), & ! divergence of internal ice stress, y at N points (N/m^2) - fmN (nx_block,ny_block,max_blocks), & ! Coriolis param. * mass in N-cell (kg/s) - TbN (nx_block,ny_block,max_blocks), & ! factor for seabed stress (landfast ice) - taubxE (nx_block,ny_block,max_blocks), & ! seabed stress (x) at E points (N/m^2) - taubyE (nx_block,ny_block,max_blocks), & ! seabed stress (y) at E points (N/m^2) - strairxE (nx_block,ny_block,max_blocks), & ! stress on ice by air, x-direction at E points - strairyE (nx_block,ny_block,max_blocks), & ! stress on ice by air, y-direction at E points - strocnxE (nx_block,ny_block,max_blocks), & ! ice-ocean stress, x-direction at E points - strocnyE (nx_block,ny_block,max_blocks), & ! ice-ocean stress, y-direction at E points - strtltxE (nx_block,ny_block,max_blocks), & ! stress due to sea surface slope, x-direction at E points - strtltyE (nx_block,ny_block,max_blocks), & ! stress due to sea surface slope, y-direction at E points - strintxE (nx_block,ny_block,max_blocks), & ! divergence of internal ice stress, x at E points (N/m^2) - strintyE (nx_block,ny_block,max_blocks), & ! divergence of internal ice stress, y at E points (N/m^2) - fmE (nx_block,ny_block,max_blocks), & ! Coriolis param. * mass in E-cell (kg/s) - TbE (nx_block,ny_block,max_blocks), & ! factor for seabed stress (landfast ice) - stresspT (nx_block,ny_block,max_blocks), & ! sigma11+sigma22 - stressmT (nx_block,ny_block,max_blocks), & ! sigma11-sigma22 - stress12T (nx_block,ny_block,max_blocks), & ! sigma12 - stresspU (nx_block,ny_block,max_blocks), & ! sigma11+sigma22 - stressmU (nx_block,ny_block,max_blocks), & ! sigma11-sigma22 - stress12U (nx_block,ny_block,max_blocks), & ! sigma12 - stat=ierr) - if (ierr/=0) call abort_ice('(alloc_flux): Out of memory (C or CD grid)') + taubxN (nx_block,ny_block,max_blocks), & ! seabed stress (x) at N points (N/m^2) + taubyN (nx_block,ny_block,max_blocks), & ! seabed stress (y) at N points (N/m^2) + strairxN (nx_block,ny_block,max_blocks), & ! stress on ice by air, x-direction at N points + strairyN (nx_block,ny_block,max_blocks), & ! stress on ice by air, y-direction at N points + strocnxN (nx_block,ny_block,max_blocks), & ! ice-ocean stress, x-direction at N points + strocnyN (nx_block,ny_block,max_blocks), & ! ice-ocean stress, y-direction at N points + strtltxN (nx_block,ny_block,max_blocks), & ! stress due to sea surface slope, x-direction at N points + strtltyN (nx_block,ny_block,max_blocks), & ! stress due to sea surface slope, y-direction at N points + strintxN (nx_block,ny_block,max_blocks), & ! divergence of internal ice stress, x at N points (N/m^2) + strintyN (nx_block,ny_block,max_blocks), & ! divergence of internal ice stress, y at N points (N/m^2) + fmN (nx_block,ny_block,max_blocks), & ! Coriolis param. * mass in N-cell (kg/s) + TbN (nx_block,ny_block,max_blocks), & ! factor for seabed stress (landfast ice) + taubxE (nx_block,ny_block,max_blocks), & ! seabed stress (x) at E points (N/m^2) + taubyE (nx_block,ny_block,max_blocks), & ! seabed stress (y) at E points (N/m^2) + strairxE (nx_block,ny_block,max_blocks), & ! stress on ice by air, x-direction at E points + strairyE (nx_block,ny_block,max_blocks), & ! stress on ice by air, y-direction at E points + strocnxE (nx_block,ny_block,max_blocks), & ! ice-ocean stress, x-direction at E points + strocnyE (nx_block,ny_block,max_blocks), & ! ice-ocean stress, y-direction at E points + strtltxE (nx_block,ny_block,max_blocks), & ! stress due to sea surface slope, x-direction at E points + strtltyE (nx_block,ny_block,max_blocks), & ! stress due to sea surface slope, y-direction at E points + strintxE (nx_block,ny_block,max_blocks), & ! divergence of internal ice stress, x at E points (N/m^2) + strintyE (nx_block,ny_block,max_blocks), & ! divergence of internal ice stress, y at E points (N/m^2) + fmE (nx_block,ny_block,max_blocks), & ! Coriolis param. * mass in E-cell (kg/s) + TbE (nx_block,ny_block,max_blocks), & ! factor for seabed stress (landfast ice) + stresspT (nx_block,ny_block,max_blocks), & ! sigma11+sigma22 + stressmT (nx_block,ny_block,max_blocks), & ! sigma11-sigma22 + stress12T (nx_block,ny_block,max_blocks), & ! sigma12 + stresspU (nx_block,ny_block,max_blocks), & ! sigma11+sigma22 + stressmU (nx_block,ny_block,max_blocks), & ! sigma11-sigma22 + stress12U (nx_block,ny_block,max_blocks), & ! sigma12 + stat=ierr) + if (ierr/=0) call abort_ice('(alloc_flux): Out of memory (C or CD grid)') + + taubxN = c0 + taubyN = c0 + strairxN = c0 + strairyN = c0 + strocnxN = c0 + strocnyN = c0 + strtltxN = c0 + strtltyN = c0 + strintxN = c0 + strintyN = c0 + fmN = c0 + TbN = c0 + taubxE = c0 + taubyE = c0 + strairxE = c0 + strairyE = c0 + strocnxE = c0 + strocnyE = c0 + strtltxE = c0 + strtltyE = c0 + strintxE = c0 + strintyE = c0 + fmE = c0 + TbE = c0 + stresspT = c0 + stressmT = c0 + stress12T = c0 + stresspU = c0 + stressmU = c0 + stress12U = c0 + endif ! Pond diagnostics allocate( & @@ -677,6 +907,19 @@ subroutine alloc_flux stat=ierr) if (ierr/=0) call abort_ice('(alloc_flux): Out of memory (ponds)') + dpnd_flush = c0 + dpnd_expon = c0 + dpnd_freebd = c0 + dpnd_initial = c0 + dpnd_dlid = c0 + dpnd_melt = c0 + dpnd_ridge = c0 + dpnd_flushn = c0 + dpnd_exponn = c0 + dpnd_freebdn = c0 + dpnd_initialn= c0 + dpnd_dlidn = c0 + end subroutine alloc_flux !======================================================================= diff --git a/cicecore/cicedyn/general/ice_flux_bgc.F90 b/cicecore/cicedyn/general/ice_flux_bgc.F90 index 9c07971ff..7aaaf2baa 100644 --- a/cicecore/cicedyn/general/ice_flux_bgc.F90 +++ b/cicecore/cicedyn/general/ice_flux_bgc.F90 @@ -7,6 +7,7 @@ module ice_flux_bgc use ice_kinds_mod + use ice_constants, only: c0 use ice_blocks, only: nx_block, ny_block use ice_domain_size, only: max_blocks, ncat use ice_fileunits, only: nu_diag @@ -161,6 +162,48 @@ subroutine alloc_flux_bgc stat=ierr) if (ierr/=0) call abort_ice('(alloc_flux_bgc): Out of memory') + nit = c0 + amm = c0 + sil = c0 + dmsp = c0 + dms = c0 + hum = c0 + fnit = c0 + famm = c0 + fsil = c0 + fdmsp = c0 + fdms = c0 + fhum = c0 + fdust = c0 + hin_old = c0 + dsnown = c0 + HDO_ocn = c0 + H2_16O_ocn = c0 + H2_18O_ocn = c0 + Qa_iso = c0 + Qref_iso = c0 + fiso_atm = c0 + fiso_evap = c0 + fiso_ocn = c0 + faero_atm = c0 + faero_ocn = c0 + zaeros = c0 + flux_bio_atm= c0 + flux_bio = c0 + flux_bio_ai = c0 + algalN = c0 + falgalN = c0 + doc = c0 + fdoc = c0 + don = c0 + fdon = c0 + dic = c0 + fdic = c0 + fed = c0 + fep = c0 + ffed = c0 + ffep = c0 + end subroutine alloc_flux_bgc !======================================================================= diff --git a/cicecore/cicedyn/general/ice_forcing.F90 b/cicecore/cicedyn/general/ice_forcing.F90 index e0f1b736a..d165b612a 100755 --- a/cicecore/cicedyn/general/ice_forcing.F90 +++ b/cicecore/cicedyn/general/ice_forcing.F90 @@ -209,37 +209,59 @@ subroutine alloc_forcing if (local_debug .and. my_task == master_task) write(nu_diag,*) subname,'fdbg start' allocate ( & - cldf(nx_block,ny_block, max_blocks), & ! cloud fraction - fsw_data(nx_block,ny_block,2,max_blocks), & ! field values at 2 temporal data points - cldf_data(nx_block,ny_block,2,max_blocks), & - fsnow_data(nx_block,ny_block,2,max_blocks), & - Tair_data(nx_block,ny_block,2,max_blocks), & - uatm_data(nx_block,ny_block,2,max_blocks), & - vatm_data(nx_block,ny_block,2,max_blocks), & - wind_data(nx_block,ny_block,2,max_blocks), & - strax_data(nx_block,ny_block,2,max_blocks), & - stray_data(nx_block,ny_block,2,max_blocks), & - Qa_data(nx_block,ny_block,2,max_blocks), & - rhoa_data(nx_block,ny_block,2,max_blocks), & - flw_data(nx_block,ny_block,2,max_blocks), & - sst_data(nx_block,ny_block,2,max_blocks), & - sss_data(nx_block,ny_block,2,max_blocks), & - uocn_data(nx_block,ny_block,2,max_blocks), & - vocn_data(nx_block,ny_block,2,max_blocks), & - sublim_data(nx_block,ny_block,2,max_blocks), & - frain_data(nx_block,ny_block,2,max_blocks), & - topmelt_data(nx_block,ny_block,2,max_blocks,ncat), & - botmelt_data(nx_block,ny_block,2,max_blocks,ncat), & - ocn_frc_m(nx_block,ny_block, max_blocks,nfld,12), & ! ocn data for 12 months - topmelt_file(ncat), & - botmelt_file(ncat), & - wave_spectrum_data(nx_block,ny_block,nfreq,2,max_blocks), & + cldf (nx_block,ny_block, max_blocks), & ! cloud fraction + fsw_data (nx_block,ny_block,2,max_blocks), & ! field values at 2 temporal data points + cldf_data (nx_block,ny_block,2,max_blocks), & + fsnow_data (nx_block,ny_block,2,max_blocks), & + Tair_data (nx_block,ny_block,2,max_blocks), & + uatm_data (nx_block,ny_block,2,max_blocks), & + vatm_data (nx_block,ny_block,2,max_blocks), & + wind_data (nx_block,ny_block,2,max_blocks), & + strax_data (nx_block,ny_block,2,max_blocks), & + stray_data (nx_block,ny_block,2,max_blocks), & + Qa_data (nx_block,ny_block,2,max_blocks), & + rhoa_data (nx_block,ny_block,2,max_blocks), & + flw_data (nx_block,ny_block,2,max_blocks), & + sst_data (nx_block,ny_block,2,max_blocks), & + sss_data (nx_block,ny_block,2,max_blocks), & + uocn_data (nx_block,ny_block,2,max_blocks), & + vocn_data (nx_block,ny_block,2,max_blocks), & + sublim_data (nx_block,ny_block,2,max_blocks), & + frain_data (nx_block,ny_block,2,max_blocks), & + topmelt_data(nx_block,ny_block,2,max_blocks,ncat), & + botmelt_data(nx_block,ny_block,2,max_blocks,ncat), & + ocn_frc_m (nx_block,ny_block, max_blocks,nfld,12), & ! ocn data for 12 months + topmelt_file(ncat), & + botmelt_file(ncat), & + wave_spectrum_data(nx_block,ny_block,nfreq,2,max_blocks), & stat=ierr) if (ierr/=0) call abort_ice('(alloc_forcing): Out of Memory') -! initialize this, not set in box2001 (and some other forcings?) - - cldf = c0 + cldf = c0 + fsw_data = c0 + cldf_data = c0 + fsnow_data = c0 + Tair_data = c0 + uatm_data = c0 + vatm_data = c0 + wind_data = c0 + strax_data = c0 + stray_data = c0 + Qa_data = c0 + rhoa_data = c0 + flw_data = c0 + sst_data = c0 + sss_data = c0 + uocn_data = c0 + vocn_data = c0 + sublim_data = c0 + frain_data = c0 + topmelt_data = c0 + botmelt_data = c0 + ocn_frc_m = c0 + topmelt_file = '' + botmelt_file = '' + wave_spectrum_data = c0 end subroutine alloc_forcing @@ -711,13 +733,13 @@ subroutine get_forcing_atmo call ice_timer_start(timer_bound) call ice_HaloUpdate (swvdr, halo_info, & - field_loc_center, field_type_scalar) + field_loc_center, field_type_scalar, fillvalue=c0) call ice_HaloUpdate (swvdf, halo_info, & - field_loc_center, field_type_scalar) + field_loc_center, field_type_scalar, fillvalue=c0) call ice_HaloUpdate (swidr, halo_info, & - field_loc_center, field_type_scalar) + field_loc_center, field_type_scalar, fillvalue=c0) call ice_HaloUpdate (swidf, halo_info, & - field_loc_center, field_type_scalar) + field_loc_center, field_type_scalar, fillvalue=c0) call ice_timer_stop(timer_bound) call ice_timer_stop(timer_forcing) diff --git a/cicecore/cicedyn/general/ice_forcing_bgc.F90 b/cicecore/cicedyn/general/ice_forcing_bgc.F90 index 69c3ea311..d12df6417 100644 --- a/cicecore/cicedyn/general/ice_forcing_bgc.F90 +++ b/cicecore/cicedyn/general/ice_forcing_bgc.F90 @@ -65,6 +65,11 @@ subroutine alloc_forcing_bgc stat=ierr) if (ierr/=0) call abort_ice('(alloc_forcing_bgc): Out of memory') + nitdat = c0 + sildat = c0 + nit_data= c0 + sil_data= c0 + end subroutine alloc_forcing_bgc !======================================================================= diff --git a/cicecore/cicedyn/general/ice_init.F90 b/cicecore/cicedyn/general/ice_init.F90 index 92580a512..aa78c398d 100644 --- a/cicecore/cicedyn/general/ice_init.F90 +++ b/cicecore/cicedyn/general/ice_init.F90 @@ -84,7 +84,7 @@ subroutine input_data restart, restart_ext, restart_coszen, use_restart_time, & runtype, restart_file, restart_dir, runid, pointer_file, & restart_format, restart_rearranger, restart_iotasks, restart_root, & - restart_stride, restart_deflate, restart_chunksize + restart_stride, restart_deflate, restart_chunksize, restart_mod use ice_history_shared, only: & history_precision, hist_avg, history_format, history_file, incond_file, & history_dir, incond_dir, version_name, history_rearranger, & @@ -196,7 +196,7 @@ subroutine input_data ice_ic, restart, restart_dir, restart_file, & restart_ext, use_restart_time, restart_format, lcdf64, & restart_root, restart_stride, restart_iotasks, restart_rearranger, & - restart_deflate, restart_chunksize, & + restart_deflate, restart_chunksize, restart_mod, & pointer_file, dumpfreq, dumpfreq_n, dump_last, & diagfreq, diag_type, diag_file, history_format,& history_root, history_stride, history_iotasks, history_rearranger, & @@ -573,6 +573,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 + restart_mod = 'none' ! restart modification option debug_forcing = .false. ! true writes diagnostics for input forcing latpnt(1) = 90._dbl_kind ! latitude of diagnostic point 1 (deg) @@ -991,6 +992,7 @@ subroutine input_data call broadcast_scalar(restart_rearranger, master_task) call broadcast_scalar(restart_deflate, master_task) call broadcast_array(restart_chunksize, master_task) + call broadcast_scalar(restart_mod, master_task) call broadcast_scalar(lcdf64, master_task) call broadcast_scalar(pointer_file, master_task) call broadcast_scalar(ice_ic, master_task) @@ -1443,6 +1445,14 @@ subroutine input_data endif endif + if (close_boundaries) then + if (my_task == master_task) then + write(nu_diag,*) subname//' ERROR: close_boundaries deprecated, '// & + 'use ew_boundary_type=closed and/or ns_boundary_type=closed' + endif + abort_list = trim(abort_list)//":49" + endif + if (grid_ice == 'CD') then if (my_task == master_task) then write(nu_diag,*) subname//' ERROR: grid_ice = CD not supported yet' @@ -2620,6 +2630,7 @@ subroutine input_data write(nu_diag,1011) ' restart = ', restart write(nu_diag,1031) ' restart_dir = ', trim(restart_dir) write(nu_diag,1011) ' restart_ext = ', restart_ext + write(nu_diag,1031) ' restart_mod = ', trim(restart_mod) write(nu_diag,1011) ' restart_coszen = ', restart_coszen write(nu_diag,1031) ' restart_format = ', trim(restart_format) write(nu_diag,1021) ' restart_deflate = ', restart_deflate @@ -3068,14 +3079,14 @@ subroutine init_state ! Halo update on North, East faces call ice_HaloUpdate(uvelN, halo_info, & - field_loc_Nface, field_type_scalar) + field_loc_Nface, field_type_scalar, fillvalue=c0) call ice_HaloUpdate(vvelN, halo_info, & - field_loc_Nface, field_type_scalar) + field_loc_Nface, field_type_scalar, fillvalue=c0) call ice_HaloUpdate(uvelE, halo_info, & - field_loc_Eface, field_type_scalar) + field_loc_Eface, field_type_scalar, fillvalue=c0) call ice_HaloUpdate(vvelE, halo_info, & - field_loc_Eface, field_type_scalar) + field_loc_Eface, field_type_scalar, fillvalue=c0) endif diff --git a/cicecore/cicedyn/general/ice_state.F90 b/cicecore/cicedyn/general/ice_state.F90 index 82b03f2cb..92066d038 100644 --- a/cicecore/cicedyn/general/ice_state.F90 +++ b/cicecore/cicedyn/general/ice_state.F90 @@ -172,6 +172,32 @@ subroutine alloc_state stat=ierr) if (ierr/=0) call abort_ice('(alloc_state): Out of memory1') + aice = c0 + aiU = c0 + vice = c0 + vsno = c0 + aice0 = c0 + uvel = c0 + vvel = c0 + uvelE = c0 + vvelE = c0 + uvelN = c0 + vvelN = c0 + divu = c0 + shear = c0 + vort = c0 + strength = c0 + aice_init = c0 + aicen = c0 + vicen = c0 + vsnon = c0 + aicen_init = c0 + vicen_init = c0 + vsnon_init = c0 + Tsfcn_init = c0 + trcr = c0 + trcrn = c0 + allocate ( & trcr_depend(ntrcr) , & ! n_trcr_strata(ntrcr) , & ! number of underlying tracer layers @@ -184,12 +210,6 @@ subroutine alloc_state n_trcr_strata = 0 nt_strata = 0 trcr_base = c0 - aicen = c0 - aicen_init = c0 - vicen = c0 - vicen_init = c0 - vsnon = c0 - vsnon_init = c0 end subroutine alloc_state diff --git a/cicecore/cicedyn/infrastructure/comm/mpi/ice_boundary.F90 b/cicecore/cicedyn/infrastructure/comm/mpi/ice_boundary.F90 index 11cd0d2e1..5a690d490 100644 --- a/cicecore/cicedyn/infrastructure/comm/mpi/ice_boundary.F90 +++ b/cicecore/cicedyn/infrastructure/comm/mpi/ice_boundary.F90 @@ -64,7 +64,7 @@ module ice_boundary use icepack_intfc, only: icepack_warnings_flush, icepack_warnings_aborted use ice_blocks, only: nx_block, ny_block, nghost, & - nblocks_tot, ice_blocksNorth, & + nblocks_tot, nblocks_x, nblocks_y, ice_blocksNorth, & ice_blocksSouth, ice_blocksEast, ice_blocksWest, & ice_blocksEast2, ice_blocksWest2, & ice_blocksNorthEast, ice_blocksNorthWest, & @@ -106,6 +106,10 @@ module ice_boundary sendAddr, &! src addresses for each sent message recvAddr ! dst addresses for each recvd message + character (char_len) :: & + nsBoundaryType, &! type of boundary to use in logical ns dir + ewBoundaryType ! type of boundary to use in logical ew dir + end type public :: ice_HaloCreate, & @@ -252,6 +256,8 @@ function ice_HaloCreate(dist, nsBoundaryType, ewBoundaryType, & if (my_task >= numProcs) return halo%communicator = communicator + halo%ewBoundaryType = ewBoundaryType + halo%nsBoundaryType = nsBoundaryType blockSizeX = nx_block - 2*nghost blockSizeY = ny_block - 2*nghost @@ -1239,6 +1245,7 @@ subroutine ice_HaloUpdate2DR8(array, halo, & integer (int_kind) :: & i,j,n,nmsg, &! dummy loop indices iblk,ilo,ihi,jlo,jhi, &! block sizes for fill + iblock,jblock, &! global block indices ierr, &! error or status flag for MPI,alloc nxGlobal, &! global domain size in x (tripole) iSrc,jSrc, &! source addresses for message @@ -1261,6 +1268,8 @@ subroutine ice_HaloUpdate2DR8(array, halo, & x1,x2,xavg ! scalars for enforcing symmetry at U pts logical (log_kind) :: & + ewfillouter, &! fill outer boundary ew + nsfillouter, &! fill outer boundary ns ltripoleOnly ! local tripoleOnly value integer (int_kind) :: len ! length of messages @@ -1290,8 +1299,20 @@ subroutine ice_HaloUpdate2DR8(array, halo, & ! !----------------------------------------------------------------------- + ewfillouter = .false. + nsfillouter = .false. + + ! fill outer boundary if cyclic + if (halo%ewBoundaryType == 'cyclic') ewfillouter=.true. + if (halo%nsBoundaryType == 'tripole' .or. & + halo%nsBoundaryType == 'tripoleT' .or. & + halo%nsBoundaryType == 'cyclic') nsfillouter=.true. + if (present(fillValue)) then fill = fillValue + ! always fill outer boundary if fillValue is passed + ewfillouter = .true. + nsfillouter = .true. else fill = 0.0_dbl_kind endif @@ -1367,29 +1388,77 @@ subroutine ice_HaloUpdate2DR8(array, halo, & !----------------------------------------------------------------------- ! -! while messages are being communicated, fill out halo region +! While messages are being communicated, fill out halo region ! needed for masked halos to ensure halo values are filled for -! halo grid cells that are not updated +! halo grid cells that are not updated except in cases where +! you don't want to overwrite those halos ! !----------------------------------------------------------------------- - if (ltripoleOnly) then - ! skip fill, not needed since tripole seam always exists if running - ! on tripole grid and set tripoleOnly flag - else + if (.not. ltripoleOnly) then + ! tripoleOnly skip fill, do not overwrite any values in interior as they may + ! already be set and filling tripole is not necessary + + ! fill outer boundary as needed + ! only fill corners if both edges are being filled do iblk = 1, halo%numLocalBlocks - call get_block_parameter(halo%blockGlobalID(iblk), & - ilo=ilo, ihi=ihi, & - jlo=jlo, jhi=jhi) - do j = 1,nghost - array(1:nx_block, jlo-j,iblk) = fill - array(1:nx_block, jhi+j,iblk) = fill - enddo - do i = 1,nghost - array(ilo-i, 1:ny_block,iblk) = fill - array(ihi+i, 1:ny_block,iblk) = fill - enddo - enddo + call get_block_parameter(halo%blockGlobalID(iblk), & + ilo=ilo, ihi=ihi, & + jlo=jlo, jhi=jhi, & + iblock=iblock, jblock=jblock) + if (ewfillouter .or. iblock > 1) then ! west edge + do i = 1,nghost + array(ilo-i, jlo:jhi, iblk) = fill + enddo + endif + if (ewfillouter .or. iblock < nblocks_x) then ! east edge + do i = 1,nghost + array(ihi+i, jlo:jhi, iblk) = fill + enddo + endif + if (nsfillouter .or. jblock > 1) then ! south edge + do j = 1,nghost + array(ilo:ihi, jlo-j, iblk) = fill + enddo + endif + if (nsfillouter .or. jblock < nblocks_y) then ! north edge + do j = 1,nghost + array(ilo:ihi, jhi+j, iblk) = fill + enddo + endif + if ((ewfillouter .or. iblock > 1) .and. & ! southwest corner + (nsfillouter .or. jblock > 1)) then + do j = 1,nghost + do i = 1,nghost + array(ilo-i, jlo-j, iblk) = fill + enddo + enddo + endif + if ((ewfillouter .or. iblock > 1) .and. & ! northwest corner + (nsfillouter .or. jblock < nblocks_y)) then + do j = 1,nghost + do i = 1,nghost + array(ilo-i, jhi+j, iblk) = fill + enddo + enddo + endif + if ((ewfillouter .or. iblock < nblocks_x) .and. & ! southeast corner + (nsfillouter .or. jblock > 1)) then + do j = 1,nghost + do i = 1,nghost + array(ihi+i, jlo-j, iblk) = fill + enddo + enddo + endif + if ((ewfillouter .or. iblock < nblocks_x) .and. & ! northeast corner + (nsfillouter .or. jblock < nblocks_y)) then + do j = 1,nghost + do i = 1,nghost + array(ihi+i, jhi+j, iblk) = fill + enddo + enddo + endif + enddo ! iblk endif !----------------------------------------------------------------------- @@ -1683,6 +1752,7 @@ subroutine ice_HaloUpdate2DR4(array, halo, & integer (int_kind) :: & i,j,n,nmsg, &! dummy loop indices iblk,ilo,ihi,jlo,jhi, &! block sizes for fill + iblock,jblock, &! global block indices ierr, &! error or status flag for MPI,alloc nxGlobal, &! global domain size in x (tripole) iSrc,jSrc, &! source addresses for message @@ -1704,6 +1774,10 @@ subroutine ice_HaloUpdate2DR4(array, halo, & fill, &! value to use for unknown points x1,x2,xavg ! scalars for enforcing symmetry at U pts + logical (log_kind) :: & + ewfillouter, &! fill outer boundary ew + nsfillouter ! fill outer boundary ns + integer (int_kind) :: len ! length of messages character(len=*), parameter :: subname = '(ice_HaloUpdate2DR4)' @@ -1731,8 +1805,20 @@ subroutine ice_HaloUpdate2DR4(array, halo, & ! !----------------------------------------------------------------------- + ewfillouter = .false. + nsfillouter = .false. + + ! fill outer boundary if cyclic + if (halo%ewBoundaryType == 'cyclic') ewfillouter=.true. + if (halo%nsBoundaryType == 'tripole' .or. & + halo%nsBoundaryType == 'tripoleT' .or. & + halo%nsBoundaryType == 'cyclic') nsfillouter=.true. + if (present(fillValue)) then fill = fillValue + ! always fill outer boundary if fillValue is passed + ewfillouter = .true. + nsfillouter = .true. else fill = 0.0_real_kind endif @@ -1804,23 +1890,71 @@ subroutine ice_HaloUpdate2DR4(array, halo, & ! ! while messages are being communicated, fill out halo region ! needed for masked halos to ensure halo values are filled for -! halo grid cells that are not updated +! halo grid cells that are not updated except in cases where +! you don't want to overwrite those halos ! !----------------------------------------------------------------------- + ! fill outer boundary as needed + ! only fill corners if both edges are being filled do iblk = 1, halo%numLocalBlocks - call get_block_parameter(halo%blockGlobalID(iblk), & - ilo=ilo, ihi=ihi, & - jlo=jlo, jhi=jhi) - do j = 1,nghost - array(1:nx_block, jlo-j,iblk) = fill - array(1:nx_block, jhi+j,iblk) = fill - enddo - do i = 1,nghost - array(ilo-i, 1:ny_block,iblk) = fill - array(ihi+i, 1:ny_block,iblk) = fill - enddo - enddo + call get_block_parameter(halo%blockGlobalID(iblk), & + ilo=ilo, ihi=ihi, & + jlo=jlo, jhi=jhi, & + iblock=iblock, jblock=jblock) + if (ewfillouter .or. iblock > 1) then ! west edge + do i = 1,nghost + array(ilo-i, jlo:jhi, iblk) = fill + enddo + endif + if (ewfillouter .or. iblock < nblocks_x) then ! east edge + do i = 1,nghost + array(ihi+i, jlo:jhi, iblk) = fill + enddo + endif + if (nsfillouter .or. jblock > 1) then ! south edge + do j = 1,nghost + array(ilo:ihi, jlo-j, iblk) = fill + enddo + endif + if (nsfillouter .or. jblock < nblocks_y) then ! north edge + do j = 1,nghost + array(ilo:ihi, jhi+j, iblk) = fill + enddo + endif + if ((ewfillouter .or. iblock > 1) .and. & ! southwest corner + (nsfillouter .or. jblock > 1)) then + do j = 1,nghost + do i = 1,nghost + array(ilo-i, jlo-j, iblk) = fill + enddo + enddo + endif + if ((ewfillouter .or. iblock > 1) .and. & ! northwest corner + (nsfillouter .or. jblock < nblocks_y)) then + do j = 1,nghost + do i = 1,nghost + array(ilo-i, jhi+j, iblk) = fill + enddo + enddo + endif + if ((ewfillouter .or. iblock < nblocks_x) .and. & ! southeast corner + (nsfillouter .or. jblock > 1)) then + do j = 1,nghost + do i = 1,nghost + array(ihi+i, jlo-j, iblk) = fill + enddo + enddo + endif + if ((ewfillouter .or. iblock < nblocks_x) .and. & ! northeast corner + (nsfillouter .or. jblock < nblocks_y)) then + do j = 1,nghost + do i = 1,nghost + array(ihi+i, jhi+j, iblk) = fill + enddo + enddo + endif + enddo ! iblk !----------------------------------------------------------------------- ! @@ -2098,6 +2232,7 @@ subroutine ice_HaloUpdate2DI4(array, halo, & integer (int_kind) :: & i,j,n,nmsg, &! dummy loop indices iblk,ilo,ihi,jlo,jhi, &! block sizes for fill + iblock,jblock, &! global block indices ierr, &! error or status flag for MPI,alloc nxGlobal, &! global domain size in x (tripole) iSrc,jSrc, &! source addresses for message @@ -2119,6 +2254,10 @@ subroutine ice_HaloUpdate2DI4(array, halo, & fill, &! value to use for unknown points x1,x2,xavg ! scalars for enforcing symmetry at U pts + logical (log_kind) :: & + ewfillouter, &! fill outer boundary ew + nsfillouter ! fill outer boundary ns + integer (int_kind) :: len ! length of messages character(len=*), parameter :: subname = '(ice_HaloUpdate2DI4)' @@ -2146,8 +2285,20 @@ subroutine ice_HaloUpdate2DI4(array, halo, & ! !----------------------------------------------------------------------- + ewfillouter = .false. + nsfillouter = .false. + + ! fill outer boundary if cyclic + if (halo%ewBoundaryType == 'cyclic') ewfillouter=.true. + if (halo%nsBoundaryType == 'tripole' .or. & + halo%nsBoundaryType == 'tripoleT' .or. & + halo%nsBoundaryType == 'cyclic') nsfillouter=.true. + if (present(fillValue)) then fill = fillValue + ! always fill outer boundary if fillValue is passed + ewfillouter = .true. + nsfillouter = .true. else fill = 0_int_kind endif @@ -2219,23 +2370,71 @@ subroutine ice_HaloUpdate2DI4(array, halo, & ! ! while messages are being communicated, fill out halo region ! needed for masked halos to ensure halo values are filled for -! halo grid cells that are not updated +! halo grid cells that are not updated except in cases where +! you don't want to overwrite those halos ! !----------------------------------------------------------------------- + ! fill outer boundary as needed + ! only fill corners if both edges are being filled do iblk = 1, halo%numLocalBlocks - call get_block_parameter(halo%blockGlobalID(iblk), & - ilo=ilo, ihi=ihi, & - jlo=jlo, jhi=jhi) - do j = 1,nghost - array(1:nx_block, jlo-j,iblk) = fill - array(1:nx_block, jhi+j,iblk) = fill - enddo - do i = 1,nghost - array(ilo-i, 1:ny_block,iblk) = fill - array(ihi+i, 1:ny_block,iblk) = fill - enddo - enddo + call get_block_parameter(halo%blockGlobalID(iblk), & + ilo=ilo, ihi=ihi, & + jlo=jlo, jhi=jhi, & + iblock=iblock, jblock=jblock) + if (ewfillouter .or. iblock > 1) then ! west edge + do i = 1,nghost + array(ilo-i, jlo:jhi, iblk) = fill + enddo + endif + if (ewfillouter .or. iblock < nblocks_x) then ! east edge + do i = 1,nghost + array(ihi+i, jlo:jhi, iblk) = fill + enddo + endif + if (nsfillouter .or. jblock > 1) then ! south edge + do j = 1,nghost + array(ilo:ihi, jlo-j, iblk) = fill + enddo + endif + if (nsfillouter .or. jblock < nblocks_y) then ! north edge + do j = 1,nghost + array(ilo:ihi, jhi+j, iblk) = fill + enddo + endif + if ((ewfillouter .or. iblock > 1) .and. & ! southwest corner + (nsfillouter .or. jblock > 1)) then + do j = 1,nghost + do i = 1,nghost + array(ilo-i, jlo-j, iblk) = fill + enddo + enddo + endif + if ((ewfillouter .or. iblock > 1) .and. & ! northwest corner + (nsfillouter .or. jblock < nblocks_y)) then + do j = 1,nghost + do i = 1,nghost + array(ilo-i, jhi+j, iblk) = fill + enddo + enddo + endif + if ((ewfillouter .or. iblock < nblocks_x) .and. & ! southeast corner + (nsfillouter .or. jblock > 1)) then + do j = 1,nghost + do i = 1,nghost + array(ihi+i, jlo-j, iblk) = fill + enddo + enddo + endif + if ((ewfillouter .or. iblock < nblocks_x) .and. & ! northeast corner + (nsfillouter .or. jblock < nblocks_y)) then + do j = 1,nghost + do i = 1,nghost + array(ihi+i, jhi+j, iblk) = fill + enddo + enddo + endif + enddo ! iblk !----------------------------------------------------------------------- ! @@ -2593,6 +2792,7 @@ subroutine ice_HaloUpdate3DR8(array, halo, & integer (int_kind) :: & i,j,k,n,nmsg, &! dummy loop indices iblk,ilo,ihi,jlo,jhi, &! block sizes for fill + iblock,jblock, &! global block indices ierr, &! error or status flag for MPI,alloc nxGlobal, &! global domain size in x (tripole) nz, &! size of array in 3rd dimension @@ -2615,6 +2815,10 @@ subroutine ice_HaloUpdate3DR8(array, halo, & fill, &! value to use for unknown points x1,x2,xavg ! scalars for enforcing symmetry at U pts + logical (log_kind) :: & + ewfillouter, &! fill outer boundary ew + nsfillouter ! fill outer boundary ns + real (dbl_kind), dimension(:,:), allocatable :: & bufSend, bufRecv ! 3d send,recv buffers @@ -2648,8 +2852,20 @@ subroutine ice_HaloUpdate3DR8(array, halo, & ! !----------------------------------------------------------------------- + ewfillouter = .false. + nsfillouter = .false. + + ! fill outer boundary if cyclic + if (halo%ewBoundaryType == 'cyclic') ewfillouter=.true. + if (halo%nsBoundaryType == 'tripole' .or. & + halo%nsBoundaryType == 'tripoleT' .or. & + halo%nsBoundaryType == 'cyclic') nsfillouter=.true. + if (present(fillValue)) then fill = fillValue + ! always fill outer boundary if fillValue is passed + ewfillouter = .true. + nsfillouter = .true. else fill = 0.0_dbl_kind endif @@ -2742,23 +2958,71 @@ subroutine ice_HaloUpdate3DR8(array, halo, & ! ! while messages are being communicated, fill out halo region ! needed for masked halos to ensure halo values are filled for -! halo grid cells that are not updated +! halo grid cells that are not updated except in cases where +! you don't want to overwrite those halos ! !----------------------------------------------------------------------- + ! fill outer boundary as needed + ! only fill corners if both edges are being filled do iblk = 1, halo%numLocalBlocks - call get_block_parameter(halo%blockGlobalID(iblk), & - ilo=ilo, ihi=ihi, & - jlo=jlo, jhi=jhi) - do j = 1,nghost - array(1:nx_block, jlo-j,:,iblk) = fill - array(1:nx_block, jhi+j,:,iblk) = fill - enddo - do i = 1,nghost - array(ilo-i, 1:ny_block,:,iblk) = fill - array(ihi+i, 1:ny_block,:,iblk) = fill - enddo - enddo + call get_block_parameter(halo%blockGlobalID(iblk), & + ilo=ilo, ihi=ihi, & + jlo=jlo, jhi=jhi, & + iblock=iblock, jblock=jblock) + if (ewfillouter .or. iblock > 1) then ! west edge + do i = 1,nghost + array(ilo-i, jlo:jhi, :, iblk) = fill + enddo + endif + if (ewfillouter .or. iblock < nblocks_x) then ! east edge + do i = 1,nghost + array(ihi+i, jlo:jhi, :, iblk) = fill + enddo + endif + if (nsfillouter .or. jblock > 1) then ! south edge + do j = 1,nghost + array(ilo:ihi, jlo-j, :, iblk) = fill + enddo + endif + if (nsfillouter .or. jblock < nblocks_y) then ! north edge + do j = 1,nghost + array(ilo:ihi, jhi+j, :, iblk) = fill + enddo + endif + if ((ewfillouter .or. iblock > 1) .and. & ! southwest corner + (nsfillouter .or. jblock > 1)) then + do j = 1,nghost + do i = 1,nghost + array(ilo-i, jlo-j, :, iblk) = fill + enddo + enddo + endif + if ((ewfillouter .or. iblock > 1) .and. & ! northwest corner + (nsfillouter .or. jblock < nblocks_y)) then + do j = 1,nghost + do i = 1,nghost + array(ilo-i, jhi+j, :, iblk) = fill + enddo + enddo + endif + if ((ewfillouter .or. iblock < nblocks_x) .and. & ! southeast corner + (nsfillouter .or. jblock > 1)) then + do j = 1,nghost + do i = 1,nghost + array(ihi+i, jlo-j, :, iblk) = fill + enddo + enddo + endif + if ((ewfillouter .or. iblock < nblocks_x) .and. & ! northeast corner + (nsfillouter .or. jblock < nblocks_y)) then + do j = 1,nghost + do i = 1,nghost + array(ihi+i, jhi+j, :, iblk) = fill + enddo + enddo + endif + enddo ! iblk !----------------------------------------------------------------------- ! @@ -3067,6 +3331,7 @@ subroutine ice_HaloUpdate3DR4(array, halo, & integer (int_kind) :: & i,j,k,n,nmsg, &! dummy loop indices iblk,ilo,ihi,jlo,jhi, &! block sizes for fill + iblock,jblock, &! global block indices ierr, &! error or status flag for MPI,alloc nxGlobal, &! global domain size in x (tripole) nz, &! size of array in 3rd dimension @@ -3089,6 +3354,10 @@ subroutine ice_HaloUpdate3DR4(array, halo, & fill, &! value to use for unknown points x1,x2,xavg ! scalars for enforcing symmetry at U pts + logical (log_kind) :: & + ewfillouter, &! fill outer boundary ew + nsfillouter ! fill outer boundary ns + real (real_kind), dimension(:,:), allocatable :: & bufSend, bufRecv ! 3d send,recv buffers @@ -3122,8 +3391,20 @@ subroutine ice_HaloUpdate3DR4(array, halo, & ! !----------------------------------------------------------------------- + ewfillouter = .false. + nsfillouter = .false. + + ! fill outer boundary if cyclic + if (halo%ewBoundaryType == 'cyclic') ewfillouter=.true. + if (halo%nsBoundaryType == 'tripole' .or. & + halo%nsBoundaryType == 'tripoleT' .or. & + halo%nsBoundaryType == 'cyclic') nsfillouter=.true. + if (present(fillValue)) then fill = fillValue + ! always fill outer boundary if fillValue is passed + ewfillouter = .true. + nsfillouter = .true. else fill = 0.0_real_kind endif @@ -3216,23 +3497,71 @@ subroutine ice_HaloUpdate3DR4(array, halo, & ! ! while messages are being communicated, fill out halo region ! needed for masked halos to ensure halo values are filled for -! halo grid cells that are not updated +! halo grid cells that are not updated except in cases where +! you don't want to overwrite those halos ! !----------------------------------------------------------------------- + ! fill outer boundary as needed + ! only fill corners if both edges are being filled do iblk = 1, halo%numLocalBlocks - call get_block_parameter(halo%blockGlobalID(iblk), & - ilo=ilo, ihi=ihi, & - jlo=jlo, jhi=jhi) - do j = 1,nghost - array(1:nx_block, jlo-j,:,iblk) = fill - array(1:nx_block, jhi+j,:,iblk) = fill - enddo - do i = 1,nghost - array(ilo-i, 1:ny_block,:,iblk) = fill - array(ihi+i, 1:ny_block,:,iblk) = fill - enddo - enddo + call get_block_parameter(halo%blockGlobalID(iblk), & + ilo=ilo, ihi=ihi, & + jlo=jlo, jhi=jhi, & + iblock=iblock, jblock=jblock) + if (ewfillouter .or. iblock > 1) then ! west edge + do i = 1,nghost + array(ilo-i, jlo:jhi, :, iblk) = fill + enddo + endif + if (ewfillouter .or. iblock < nblocks_x) then ! east edge + do i = 1,nghost + array(ihi+i, jlo:jhi, :, iblk) = fill + enddo + endif + if (nsfillouter .or. jblock > 1) then ! south edge + do j = 1,nghost + array(ilo:ihi, jlo-j, :, iblk) = fill + enddo + endif + if (nsfillouter .or. jblock < nblocks_y) then ! north edge + do j = 1,nghost + array(ilo:ihi, jhi+j, :, iblk) = fill + enddo + endif + if ((ewfillouter .or. iblock > 1) .and. & ! southwest corner + (nsfillouter .or. jblock > 1)) then + do j = 1,nghost + do i = 1,nghost + array(ilo-i, jlo-j, :, iblk) = fill + enddo + enddo + endif + if ((ewfillouter .or. iblock > 1) .and. & ! northwest corner + (nsfillouter .or. jblock < nblocks_y)) then + do j = 1,nghost + do i = 1,nghost + array(ilo-i, jhi+j, :, iblk) = fill + enddo + enddo + endif + if ((ewfillouter .or. iblock < nblocks_x) .and. & ! southeast corner + (nsfillouter .or. jblock > 1)) then + do j = 1,nghost + do i = 1,nghost + array(ihi+i, jlo-j, :, iblk) = fill + enddo + enddo + endif + if ((ewfillouter .or. iblock < nblocks_x) .and. & ! northeast corner + (nsfillouter .or. jblock < nblocks_y)) then + do j = 1,nghost + do i = 1,nghost + array(ihi+i, jhi+j, :, iblk) = fill + enddo + enddo + endif + enddo ! iblk !----------------------------------------------------------------------- ! @@ -3541,6 +3870,7 @@ subroutine ice_HaloUpdate3DI4(array, halo, & integer (int_kind) :: & i,j,k,n,nmsg, &! dummy loop indices iblk,ilo,ihi,jlo,jhi, &! block sizes for fill + iblock,jblock, &! global block indices ierr, &! error or status flag for MPI,alloc nxGlobal, &! global domain size in x (tripole) nz, &! size of array in 3rd dimension @@ -3563,6 +3893,10 @@ subroutine ice_HaloUpdate3DI4(array, halo, & fill, &! value to use for unknown points x1,x2,xavg ! scalars for enforcing symmetry at U pts + logical (log_kind) :: & + ewfillouter, &! fill outer boundary ew + nsfillouter ! fill outer boundary ns + integer (int_kind), dimension(:,:), allocatable :: & bufSend, bufRecv ! 3d send,recv buffers @@ -3596,8 +3930,20 @@ subroutine ice_HaloUpdate3DI4(array, halo, & ! !----------------------------------------------------------------------- + ewfillouter = .false. + nsfillouter = .false. + + ! fill outer boundary if cyclic + if (halo%ewBoundaryType == 'cyclic') ewfillouter=.true. + if (halo%nsBoundaryType == 'tripole' .or. & + halo%nsBoundaryType == 'tripoleT' .or. & + halo%nsBoundaryType == 'cyclic') nsfillouter=.true. + if (present(fillValue)) then fill = fillValue + ! always fill outer boundary if fillValue is passed + ewfillouter = .true. + nsfillouter = .true. else fill = 0_int_kind endif @@ -3690,23 +4036,71 @@ subroutine ice_HaloUpdate3DI4(array, halo, & ! ! while messages are being communicated, fill out halo region ! needed for masked halos to ensure halo values are filled for -! halo grid cells that are not updated +! halo grid cells that are not updated except in cases where +! you don't want to overwrite those halos ! !----------------------------------------------------------------------- + ! fill outer boundary as needed + ! only fill corners if both edges are being filled do iblk = 1, halo%numLocalBlocks - call get_block_parameter(halo%blockGlobalID(iblk), & - ilo=ilo, ihi=ihi, & - jlo=jlo, jhi=jhi) - do j = 1,nghost - array(1:nx_block, jlo-j,:,iblk) = fill - array(1:nx_block, jhi+j,:,iblk) = fill - enddo - do i = 1,nghost - array(ilo-i, 1:ny_block,:,iblk) = fill - array(ihi+i, 1:ny_block,:,iblk) = fill - enddo - enddo + call get_block_parameter(halo%blockGlobalID(iblk), & + ilo=ilo, ihi=ihi, & + jlo=jlo, jhi=jhi, & + iblock=iblock, jblock=jblock) + if (ewfillouter .or. iblock > 1) then ! west edge + do i = 1,nghost + array(ilo-i, jlo:jhi, :, iblk) = fill + enddo + endif + if (ewfillouter .or. iblock < nblocks_x) then ! east edge + do i = 1,nghost + array(ihi+i, jlo:jhi, :, iblk) = fill + enddo + endif + if (nsfillouter .or. jblock > 1) then ! south edge + do j = 1,nghost + array(ilo:ihi, jlo-j, :, iblk) = fill + enddo + endif + if (nsfillouter .or. jblock < nblocks_y) then ! north edge + do j = 1,nghost + array(ilo:ihi, jhi+j, :, iblk) = fill + enddo + endif + if ((ewfillouter .or. iblock > 1) .and. & ! southwest corner + (nsfillouter .or. jblock > 1)) then + do j = 1,nghost + do i = 1,nghost + array(ilo-i, jlo-j, :, iblk) = fill + enddo + enddo + endif + if ((ewfillouter .or. iblock > 1) .and. & ! northwest corner + (nsfillouter .or. jblock < nblocks_y)) then + do j = 1,nghost + do i = 1,nghost + array(ilo-i, jhi+j, :, iblk) = fill + enddo + enddo + endif + if ((ewfillouter .or. iblock < nblocks_x) .and. & ! southeast corner + (nsfillouter .or. jblock > 1)) then + do j = 1,nghost + do i = 1,nghost + array(ihi+i, jlo-j, :, iblk) = fill + enddo + enddo + endif + if ((ewfillouter .or. iblock < nblocks_x) .and. & ! northeast corner + (nsfillouter .or. jblock < nblocks_y)) then + do j = 1,nghost + do i = 1,nghost + array(ihi+i, jhi+j, :, iblk) = fill + enddo + enddo + endif + enddo ! iblk !----------------------------------------------------------------------- ! @@ -4015,6 +4409,7 @@ subroutine ice_HaloUpdate4DR8(array, halo, & integer (int_kind) :: & i,j,k,l,n,nmsg, &! dummy loop indices iblk,ilo,ihi,jlo,jhi, &! block sizes for fill + iblock,jblock, &! global block indices ierr, &! error or status flag for MPI,alloc nxGlobal, &! global domain size in x (tripole) nz, nt, &! size of array in 3rd,4th dimensions @@ -4037,6 +4432,10 @@ subroutine ice_HaloUpdate4DR8(array, halo, & fill, &! value to use for unknown points x1,x2,xavg ! scalars for enforcing symmetry at U pts + logical (log_kind) :: & + ewfillouter, &! fill outer boundary ew + nsfillouter ! fill outer boundary ns + real (dbl_kind), dimension(:,:), allocatable :: & bufSend, bufRecv ! 4d send,recv buffers @@ -4070,8 +4469,20 @@ subroutine ice_HaloUpdate4DR8(array, halo, & ! !----------------------------------------------------------------------- + ewfillouter = .false. + nsfillouter = .false. + + ! fill outer boundary if cyclic + if (halo%ewBoundaryType == 'cyclic') ewfillouter=.true. + if (halo%nsBoundaryType == 'tripole' .or. & + halo%nsBoundaryType == 'tripoleT' .or. & + halo%nsBoundaryType == 'cyclic') nsfillouter=.true. + if (present(fillValue)) then fill = fillValue + ! always fill outer boundary if fillValue is passed + ewfillouter = .true. + nsfillouter = .true. else fill = 0.0_dbl_kind endif @@ -4168,23 +4579,71 @@ subroutine ice_HaloUpdate4DR8(array, halo, & ! ! while messages are being communicated, fill out halo region ! needed for masked halos to ensure halo values are filled for -! halo grid cells that are not updated +! halo grid cells that are not updated except in cases where +! you don't want to overwrite those halos ! !----------------------------------------------------------------------- + ! fill outer boundary as needed + ! only fill corners if both edges are being filled do iblk = 1, halo%numLocalBlocks - call get_block_parameter(halo%blockGlobalID(iblk), & - ilo=ilo, ihi=ihi, & - jlo=jlo, jhi=jhi) - do j = 1,nghost - array(1:nx_block, jlo-j,:,:,iblk) = fill - array(1:nx_block, jhi+j,:,:,iblk) = fill - enddo - do i = 1,nghost - array(ilo-i, 1:ny_block,:,:,iblk) = fill - array(ihi+i, 1:ny_block,:,:,iblk) = fill - enddo - enddo + call get_block_parameter(halo%blockGlobalID(iblk), & + ilo=ilo, ihi=ihi, & + jlo=jlo, jhi=jhi, & + iblock=iblock, jblock=jblock) + if (ewfillouter .or. iblock > 1) then ! west edge + do i = 1,nghost + array(ilo-i, jlo:jhi, :, :, iblk) = fill + enddo + endif + if (ewfillouter .or. iblock < nblocks_x) then ! east edge + do i = 1,nghost + array(ihi+i, jlo:jhi, :, :, iblk) = fill + enddo + endif + if (nsfillouter .or. jblock > 1) then ! south edge + do j = 1,nghost + array(ilo:ihi, jlo-j, :, :, iblk) = fill + enddo + endif + if (nsfillouter .or. jblock < nblocks_y) then ! north edge + do j = 1,nghost + array(ilo:ihi, jhi+j, :, :, iblk) = fill + enddo + endif + if ((ewfillouter .or. iblock > 1) .and. & ! southwest corner + (nsfillouter .or. jblock > 1)) then + do j = 1,nghost + do i = 1,nghost + array(ilo-i, jlo-j, :, :, iblk) = fill + enddo + enddo + endif + if ((ewfillouter .or. iblock > 1) .and. & ! northwest corner + (nsfillouter .or. jblock < nblocks_y)) then + do j = 1,nghost + do i = 1,nghost + array(ilo-i, jhi+j, :, :, iblk) = fill + enddo + enddo + endif + if ((ewfillouter .or. iblock < nblocks_x) .and. & ! southeast corner + (nsfillouter .or. jblock > 1)) then + do j = 1,nghost + do i = 1,nghost + array(ihi+i, jlo-j, :, :, iblk) = fill + enddo + enddo + endif + if ((ewfillouter .or. iblock < nblocks_x) .and. & ! northeast corner + (nsfillouter .or. jblock < nblocks_y)) then + do j = 1,nghost + do i = 1,nghost + array(ihi+i, jhi+j, :, :, iblk) = fill + enddo + enddo + endif + enddo ! iblk !----------------------------------------------------------------------- ! @@ -4513,6 +4972,7 @@ subroutine ice_HaloUpdate4DR4(array, halo, & integer (int_kind) :: & i,j,k,l,n,nmsg, &! dummy loop indices iblk,ilo,ihi,jlo,jhi, &! block sizes for fill + iblock,jblock, &! global block indices ierr, &! error or status flag for MPI,alloc nxGlobal, &! global domain size in x (tripole) nz, nt, &! size of array in 3rd,4th dimensions @@ -4535,6 +4995,10 @@ subroutine ice_HaloUpdate4DR4(array, halo, & fill, &! value to use for unknown points x1,x2,xavg ! scalars for enforcing symmetry at U pts + logical (log_kind) :: & + ewfillouter, &! fill outer boundary ew + nsfillouter ! fill outer boundary ns + real (real_kind), dimension(:,:), allocatable :: & bufSend, bufRecv ! 4d send,recv buffers @@ -4568,8 +5032,20 @@ subroutine ice_HaloUpdate4DR4(array, halo, & ! !----------------------------------------------------------------------- + ewfillouter = .false. + nsfillouter = .false. + + ! fill outer boundary if cyclic + if (halo%ewBoundaryType == 'cyclic') ewfillouter=.true. + if (halo%nsBoundaryType == 'tripole' .or. & + halo%nsBoundaryType == 'tripoleT' .or. & + halo%nsBoundaryType == 'cyclic') nsfillouter=.true. + if (present(fillValue)) then fill = fillValue + ! always fill outer boundary if fillValue is passed + ewfillouter = .true. + nsfillouter = .true. else fill = 0.0_real_kind endif @@ -4666,23 +5142,71 @@ subroutine ice_HaloUpdate4DR4(array, halo, & ! ! while messages are being communicated, fill out halo region ! needed for masked halos to ensure halo values are filled for -! halo grid cells that are not updated +! halo grid cells that are not updated except in cases where +! you don't want to overwrite those halos ! !----------------------------------------------------------------------- + ! fill outer boundary as needed + ! only fill corners if both edges are being filled do iblk = 1, halo%numLocalBlocks - call get_block_parameter(halo%blockGlobalID(iblk), & - ilo=ilo, ihi=ihi, & - jlo=jlo, jhi=jhi) - do j = 1,nghost - array(1:nx_block, jlo-j,:,:,iblk) = fill - array(1:nx_block, jhi+j,:,:,iblk) = fill - enddo - do i = 1,nghost - array(ilo-i, 1:ny_block,:,:,iblk) = fill - array(ihi+i, 1:ny_block,:,:,iblk) = fill - enddo - enddo + call get_block_parameter(halo%blockGlobalID(iblk), & + ilo=ilo, ihi=ihi, & + jlo=jlo, jhi=jhi, & + iblock=iblock, jblock=jblock) + if (ewfillouter .or. iblock > 1) then ! west edge + do i = 1,nghost + array(ilo-i, jlo:jhi, :, :, iblk) = fill + enddo + endif + if (ewfillouter .or. iblock < nblocks_x) then ! east edge + do i = 1,nghost + array(ihi+i, jlo:jhi, :, :, iblk) = fill + enddo + endif + if (nsfillouter .or. jblock > 1) then ! south edge + do j = 1,nghost + array(ilo:ihi, jlo-j, :, :, iblk) = fill + enddo + endif + if (nsfillouter .or. jblock < nblocks_y) then ! north edge + do j = 1,nghost + array(ilo:ihi, jhi+j, :, :, iblk) = fill + enddo + endif + if ((ewfillouter .or. iblock > 1) .and. & ! southwest corner + (nsfillouter .or. jblock > 1)) then + do j = 1,nghost + do i = 1,nghost + array(ilo-i, jlo-j, :, :, iblk) = fill + enddo + enddo + endif + if ((ewfillouter .or. iblock > 1) .and. & ! northwest corner + (nsfillouter .or. jblock < nblocks_y)) then + do j = 1,nghost + do i = 1,nghost + array(ilo-i, jhi+j, :, :, iblk) = fill + enddo + enddo + endif + if ((ewfillouter .or. iblock < nblocks_x) .and. & ! southeast corner + (nsfillouter .or. jblock > 1)) then + do j = 1,nghost + do i = 1,nghost + array(ihi+i, jlo-j, :, :, iblk) = fill + enddo + enddo + endif + if ((ewfillouter .or. iblock < nblocks_x) .and. & ! northeast corner + (nsfillouter .or. jblock < nblocks_y)) then + do j = 1,nghost + do i = 1,nghost + array(ihi+i, jhi+j, :, :, iblk) = fill + enddo + enddo + endif + enddo ! iblk !----------------------------------------------------------------------- ! @@ -5011,6 +5535,7 @@ subroutine ice_HaloUpdate4DI4(array, halo, & integer (int_kind) :: & i,j,k,l,n,nmsg, &! dummy loop indices iblk,ilo,ihi,jlo,jhi, &! block sizes for fill + iblock,jblock, &! global block indices ierr, &! error or status flag for MPI,alloc nxGlobal, &! global domain size in x (tripole) nz, nt, &! size of array in 3rd,4th dimensions @@ -5033,6 +5558,10 @@ subroutine ice_HaloUpdate4DI4(array, halo, & fill, &! value to use for unknown points x1,x2,xavg ! scalars for enforcing symmetry at U pts + logical (log_kind) :: & + ewfillouter, &! fill outer boundary ew + nsfillouter ! fill outer boundary ns + integer (int_kind), dimension(:,:), allocatable :: & bufSend, bufRecv ! 4d send,recv buffers @@ -5066,8 +5595,20 @@ subroutine ice_HaloUpdate4DI4(array, halo, & ! !----------------------------------------------------------------------- + ewfillouter = .false. + nsfillouter = .false. + + ! fill outer boundary if cyclic + if (halo%ewBoundaryType == 'cyclic') ewfillouter=.true. + if (halo%nsBoundaryType == 'tripole' .or. & + halo%nsBoundaryType == 'tripoleT' .or. & + halo%nsBoundaryType == 'cyclic') nsfillouter=.true. + if (present(fillValue)) then fill = fillValue + ! always fill outer boundary if fillValue is passed + ewfillouter = .true. + nsfillouter = .true. else fill = 0_int_kind endif @@ -5164,23 +5705,71 @@ subroutine ice_HaloUpdate4DI4(array, halo, & ! ! while messages are being communicated, fill out halo region ! needed for masked halos to ensure halo values are filled for -! halo grid cells that are not updated +! halo grid cells that are not updated except in cases where +! you don't want to overwrite those halos ! !----------------------------------------------------------------------- + ! fill outer boundary as needed + ! only fill corners if both edges are being filled do iblk = 1, halo%numLocalBlocks - call get_block_parameter(halo%blockGlobalID(iblk), & - ilo=ilo, ihi=ihi, & - jlo=jlo, jhi=jhi) - do j = 1,nghost - array(1:nx_block, jlo-j,:,:,iblk) = fill - array(1:nx_block, jhi+j,:,:,iblk) = fill - enddo - do i = 1,nghost - array(ilo-i, 1:ny_block,:,:,iblk) = fill - array(ihi+i, 1:ny_block,:,:,iblk) = fill - enddo - enddo + call get_block_parameter(halo%blockGlobalID(iblk), & + ilo=ilo, ihi=ihi, & + jlo=jlo, jhi=jhi, & + iblock=iblock, jblock=jblock) + if (ewfillouter .or. iblock > 1) then ! west edge + do i = 1,nghost + array(ilo-i, jlo:jhi, :, :, iblk) = fill + enddo + endif + if (ewfillouter .or. iblock < nblocks_x) then ! east edge + do i = 1,nghost + array(ihi+i, jlo:jhi, :, :, iblk) = fill + enddo + endif + if (nsfillouter .or. jblock > 1) then ! south edge + do j = 1,nghost + array(ilo:ihi, jlo-j, :, :, iblk) = fill + enddo + endif + if (nsfillouter .or. jblock < nblocks_y) then ! north edge + do j = 1,nghost + array(ilo:ihi, jhi+j, :, :, iblk) = fill + enddo + endif + if ((ewfillouter .or. iblock > 1) .and. & ! southwest corner + (nsfillouter .or. jblock > 1)) then + do j = 1,nghost + do i = 1,nghost + array(ilo-i, jlo-j, :, :, iblk) = fill + enddo + enddo + endif + if ((ewfillouter .or. iblock > 1) .and. & ! northwest corner + (nsfillouter .or. jblock < nblocks_y)) then + do j = 1,nghost + do i = 1,nghost + array(ilo-i, jhi+j, :, :, iblk) = fill + enddo + enddo + endif + if ((ewfillouter .or. iblock < nblocks_x) .and. & ! southeast corner + (nsfillouter .or. jblock > 1)) then + do j = 1,nghost + do i = 1,nghost + array(ihi+i, jlo-j, :, :, iblk) = fill + enddo + enddo + endif + if ((ewfillouter .or. iblock < nblocks_x) .and. & ! northeast corner + (nsfillouter .or. jblock < nblocks_y)) then + do j = 1,nghost + do i = 1,nghost + array(ihi+i, jhi+j, :, :, iblk) = fill + enddo + enddo + endif + enddo ! iblk !----------------------------------------------------------------------- ! @@ -7027,15 +7616,15 @@ end subroutine ice_HaloMsgCreate subroutine ice_HaloExtrapolate2DR8(ARRAY,dist,ew_bndy_type,ns_bndy_type) -! This subroutine extrapolates ARRAY values into the first row or column -! of ghost cells, and is intended for grid variables whose ghost cells +! This subroutine extrapolates ARRAY values into the ghost cells, +! and is intended for grid variables whose ghost cells ! would otherwise be set using the default boundary conditions (Dirichlet ! or Neumann). -! Note: This routine will need to be modified for nghost > 1. -! We assume padding occurs only on east and north edges. ! ! This is the specific interface for double precision arrays ! corresponding to the generic interface ice_HaloExtrapolate +! +! T.Craig, Oct 2025 - extend to nghost > 1 use ice_blocks, only: block, nblocks_x, nblocks_y, get_block use ice_constants, only: c2 @@ -7058,8 +7647,9 @@ subroutine ice_HaloExtrapolate2DR8(ARRAY,dist,ew_bndy_type,ns_bndy_type) !----------------------------------------------------------------------- integer (int_kind) :: & - i,j,iblk, &! dummy loop indices - numBlocks, &! number of local blocks + i,j,n,iblk,ii,jj, &! dummy loop indices + ilo,ihi,jlo,jhi, &! active block indices + numBlocks, &! number of local blocks blockID, &! block location ibc ! ghost cell column or row @@ -7067,6 +7657,7 @@ subroutine ice_HaloExtrapolate2DR8(ARRAY,dist,ew_bndy_type,ns_bndy_type) this_block ! block info for current block character(len=*), parameter :: subname = '(ice_HaloExtrapolate2DR8)' + !----------------------------------------------------------------------- ! ! Linear extrapolation @@ -7079,32 +7670,40 @@ subroutine ice_HaloExtrapolate2DR8(ARRAY,dist,ew_bndy_type,ns_bndy_type) do iblk = 1, numBlocks call ice_distributionGetBlockID(dist, iblk, blockID) this_block = get_block(blockID, blockID) + ilo = this_block%ilo + ihi = this_block%ihi + jlo = this_block%jlo + jhi = this_block%jhi if (this_block%iblock == 1) then ! west edge if (trim(ew_bndy_type) /= 'cyclic') then + do n = 1, nghost + ii = ilo - n ! gridcell to extrapolate to do j = 1, ny_block - ARRAY(1,j,iblk) = c2*ARRAY(2,j,iblk) - ARRAY(3,j,iblk) + ARRAY(ii,j,iblk) = c2*ARRAY(ii+1,j,iblk) - ARRAY(ii+2,j,iblk) + enddo enddo endif endif if (this_block%iblock == nblocks_x) then ! east edge if (trim(ew_bndy_type) /= 'cyclic') then - ! locate ghost cell column (avoid padding) - ibc = nx_block - do i = nx_block, nghost + 1, -1 - if (this_block%i_glob(i) == 0) ibc = ibc - 1 - enddo + do n = 1, nghost + ii = ihi + n ! gridcell to extrapolate to do j = 1, ny_block - ARRAY(ibc,j,iblk) = c2*ARRAY(ibc-1,j,iblk) - ARRAY(ibc-2,j,iblk) + ARRAY(ii,j,iblk) = c2*ARRAY(ii-1,j,iblk) - ARRAY(ii-2,j,iblk) + enddo enddo endif endif if (this_block%jblock == 1) then ! south edge if (trim(ns_bndy_type) /= 'cyclic') then + do n = 1, nghost + jj = jlo - n ! gridcell to extrapolate to do i = 1, nx_block - ARRAY(i,1,iblk) = c2*ARRAY(i,2,iblk) - ARRAY(i,3,iblk) + ARRAY(i,jj,iblk) = c2*ARRAY(i,jj+1,iblk) - ARRAY(i,jj+2,iblk) + enddo enddo endif endif @@ -7113,13 +7712,11 @@ subroutine ice_HaloExtrapolate2DR8(ARRAY,dist,ew_bndy_type,ns_bndy_type) if (trim(ns_bndy_type) /= 'cyclic' .and. & trim(ns_bndy_type) /= 'tripole' .and. & trim(ns_bndy_type) /= 'tripoleT' ) then - ! locate ghost cell column (avoid padding) - ibc = ny_block - do j = ny_block, nghost + 1, -1 - if (this_block%j_glob(j) == 0) ibc = ibc - 1 - enddo + do n = 1, nghost + jj = jhi + n ! gridcell to extrapolate to do i = 1, nx_block - ARRAY(i,ibc,iblk) = c2*ARRAY(i,ibc-1,iblk) - ARRAY(i,ibc-2,iblk) + ARRAY(i,jj,iblk) = c2*ARRAY(i,jj-1,iblk) - ARRAY(i,jj-2,iblk) + enddo enddo endif endif diff --git a/cicecore/cicedyn/infrastructure/comm/mpi/ice_gather_scatter.F90 b/cicecore/cicedyn/infrastructure/comm/mpi/ice_gather_scatter.F90 index cfb98befe..1c0191aee 100644 --- a/cicecore/cicedyn/infrastructure/comm/mpi/ice_gather_scatter.F90 +++ b/cicecore/cicedyn/infrastructure/comm/mpi/ice_gather_scatter.F90 @@ -1643,74 +1643,35 @@ subroutine scatter_global_dbl(ARRAY, ARRAY_G, src_task, dst_dist, & msg_buffer = c0 this_block = get_block(n,n) - !*** if this is an interior block, then there is no - !*** padding or update checking required - - if (this_block%iblock > 1 .and. & - this_block%iblock < nblocks_x .and. & - this_block%jblock > 1 .and. & - this_block%jblock < nblocks_y) then - - do j=1,ny_block - do i=1,nx_block - msg_buffer(i,j) = ARRAY_G(this_block%i_glob(i),& - this_block%j_glob(j)) - end do - end do - - !*** if this is an edge block but not a northern edge - !*** we only need to check for closed boundaries and - !*** padding (global index = 0) - - else if (this_block%jblock /= nblocks_y) then - - do j=1,ny_block - if (this_block%j_glob(j) /= 0) then - do i=1,nx_block - if (this_block%i_glob(i) /= 0) then - msg_buffer(i,j) = ARRAY_G(this_block%i_glob(i),& - this_block%j_glob(j)) - endif - end do - endif - end do - - !*** if this is a northern edge block, we need to check - !*** for and properly deal with tripole boundaries - - else - - do j=1,ny_block - if (this_block%j_glob(j) > 0) then ! normal boundary - - do i=1,nx_block - if (this_block%i_glob(i) /= 0) then - msg_buffer(i,j) = ARRAY_G(this_block%i_glob(i),& - this_block%j_glob(j)) - endif - end do - - else if (this_block%j_glob(j) < 0) then ! tripole - - ! for yoffset=0 or 1, yoffset2=0,0 - ! for yoffset=-1, yoffset2=0,1, for u-rows on T-fold grid - do yoffset2=0,max(yoffset,0)-yoffset - jsrc = ny_global + yoffset + yoffset2 + & - (this_block%j_glob(j) + ny_global) - do i=1,nx_block - if (this_block%i_glob(i) /= 0) then - isrc = nx_global + xoffset - this_block%i_glob(i) - if (isrc < 1) isrc = isrc + nx_global - if (isrc > nx_global) isrc = isrc - nx_global - msg_buffer(i,j-yoffset2) = isign * ARRAY_G(isrc,jsrc) - endif - end do - end do - - endif - end do - - endif + do j=1,ny_block + if (this_block%jblock == nblocks_y .and. this_block%j_glob(j) < 0) then + ! tripole is top block with j_glob < 0 + ! for yoffset=0 or 1, yoffset2=0,0 + ! for yoffset=-1, yoffset2=0,1, for u-rows on T-fold grid + do yoffset2=0,max(yoffset,0)-yoffset + jsrc = ny_global + yoffset + yoffset2 + & + (this_block%j_glob(j) + ny_global) + do i=1,nx_block + if (this_block%i_glob(i) /= 0) then + isrc = nx_global + xoffset - this_block%i_glob(i) + if (isrc < 1) isrc = isrc + nx_global + if (isrc > nx_global) isrc = isrc - nx_global + msg_buffer(i,j-yoffset2) & + = isign * ARRAY_G(isrc,jsrc) + endif + end do + end do + else + ! normal block + do i=1,nx_block + isrc = this_block%i_glob(i) + jsrc = this_block%j_glob(j) + if (isrc >=1 .and. isrc <= nx_global .and. & + jsrc >=1 .and. jsrc <= ny_global) & + msg_buffer(i,j) = ARRAY_G(isrc,jsrc) + end do + endif + end do call MPI_SEND(msg_buffer, nx_block*ny_block, & mpiR8, dst_dist%blockLocation(n)-1, 3*mpitag_gs+n, & @@ -1728,75 +1689,35 @@ subroutine scatter_global_dbl(ARRAY, ARRAY_G, src_task, dst_dist, & dst_block = dst_dist%blockLocalID(n) this_block = get_block(n,n) - !*** if this is an interior block, then there is no - !*** padding or update checking required - - if (this_block%iblock > 1 .and. & - this_block%iblock < nblocks_x .and. & - this_block%jblock > 1 .and. & - this_block%jblock < nblocks_y) then - - do j=1,ny_block - do i=1,nx_block - ARRAY(i,j,dst_block) = ARRAY_G(this_block%i_glob(i),& - this_block%j_glob(j)) - end do - end do - - !*** if this is an edge block but not a northern edge - !*** we only need to check for closed boundaries and - !*** padding (global index = 0) - - else if (this_block%jblock /= nblocks_y) then - - do j=1,ny_block - if (this_block%j_glob(j) /= 0) then - do i=1,nx_block - if (this_block%i_glob(i) /= 0) then - ARRAY(i,j,dst_block) = ARRAY_G(this_block%i_glob(i),& - this_block%j_glob(j)) - endif - end do - endif - end do - - !*** if this is a northern edge block, we need to check - !*** for and properly deal with tripole boundaries - - else - - do j=1,ny_block - if (this_block%j_glob(j) > 0) then ! normal boundary - - do i=1,nx_block - if (this_block%i_glob(i) /= 0) then - ARRAY(i,j,dst_block) = ARRAY_G(this_block%i_glob(i),& - this_block%j_glob(j)) - endif - end do - - else if (this_block%j_glob(j) < 0) then ! tripole - - ! for yoffset=0 or 1, yoffset2=0,0 - ! for yoffset=-1, yoffset2=0,1, for u-rows on T-fold grid - do yoffset2=0,max(yoffset,0)-yoffset - jsrc = ny_global + yoffset + yoffset2 + & - (this_block%j_glob(j) + ny_global) - do i=1,nx_block - if (this_block%i_glob(i) /= 0) then - isrc = nx_global + xoffset - this_block%i_glob(i) - if (isrc < 1) isrc = isrc + nx_global - if (isrc > nx_global) isrc = isrc - nx_global - ARRAY(i,j-yoffset2,dst_block) & - = isign * ARRAY_G(isrc,jsrc) - endif - end do - end do - - endif - end do - - endif + do j=1,ny_block + if (this_block%jblock == nblocks_y .and. this_block%j_glob(j) < 0) then + ! tripole is top block with j_glob < 0 + ! for yoffset=0 or 1, yoffset2=0,0 + ! for yoffset=-1, yoffset2=0,1, for u-rows on T-fold grid + do yoffset2=0,max(yoffset,0)-yoffset + jsrc = ny_global + yoffset + yoffset2 + & + (this_block%j_glob(j) + ny_global) + do i=1,nx_block + if (this_block%i_glob(i) /= 0) then + isrc = nx_global + xoffset - this_block%i_glob(i) + if (isrc < 1) isrc = isrc + nx_global + if (isrc > nx_global) isrc = isrc - nx_global + ARRAY(i,j-yoffset2,dst_block) & + = isign * ARRAY_G(isrc,jsrc) + endif + end do + end do + else + ! normal block + do i=1,nx_block + isrc = this_block%i_glob(i) + jsrc = this_block%j_glob(j) + if (isrc >=1 .and. isrc <= nx_global .and. & + jsrc >=1 .and. jsrc <= ny_global) & + ARRAY(i,j,dst_block) = ARRAY_G(isrc,jsrc) + end do + endif + end do endif end do @@ -1832,7 +1753,7 @@ subroutine scatter_global_dbl(ARRAY, ARRAY_G, src_task, dst_dist, & endif !----------------------------------------------------------------- - ! Ensure unused ghost cell values are 0 + ! Set ghost cell values to 0 for noupdate !----------------------------------------------------------------- if (field_loc == field_loc_noupdate) then @@ -2029,74 +1950,35 @@ subroutine scatter_global_real(ARRAY, ARRAY_G, src_task, dst_dist, & msg_buffer = 0._real_kind this_block = get_block(n,n) - !*** if this is an interior block, then there is no - !*** padding or update checking required - - if (this_block%iblock > 1 .and. & - this_block%iblock < nblocks_x .and. & - this_block%jblock > 1 .and. & - this_block%jblock < nblocks_y) then - - do j=1,ny_block - do i=1,nx_block - msg_buffer(i,j) = ARRAY_G(this_block%i_glob(i),& - this_block%j_glob(j)) - end do - end do - - !*** if this is an edge block but not a northern edge - !*** we only need to check for closed boundaries and - !*** padding (global index = 0) - - else if (this_block%jblock /= nblocks_y) then - - do j=1,ny_block - if (this_block%j_glob(j) /= 0) then - do i=1,nx_block - if (this_block%i_glob(i) /= 0) then - msg_buffer(i,j) = ARRAY_G(this_block%i_glob(i),& - this_block%j_glob(j)) - endif - end do - endif - end do - - !*** if this is a northern edge block, we need to check - !*** for and properly deal with tripole boundaries - - else - - do j=1,ny_block - if (this_block%j_glob(j) > 0) then ! normal boundary - - do i=1,nx_block - if (this_block%i_glob(i) /= 0) then - msg_buffer(i,j) = ARRAY_G(this_block%i_glob(i),& - this_block%j_glob(j)) - endif - end do - - else if (this_block%j_glob(j) < 0) then ! tripole - - ! for yoffset=0 or 1, yoffset2=0,0 - ! for yoffset=-1, yoffset2=0,1, for u-rows on T-fold grid - do yoffset2=0,max(yoffset,0)-yoffset - jsrc = ny_global + yoffset + yoffset2 + & - (this_block%j_glob(j) + ny_global) - do i=1,nx_block - if (this_block%i_glob(i) /= 0) then - isrc = nx_global + xoffset - this_block%i_glob(i) - if (isrc < 1) isrc = isrc + nx_global - if (isrc > nx_global) isrc = isrc - nx_global - msg_buffer(i,j-yoffset2) = isign * ARRAY_G(isrc,jsrc) - endif - end do - end do - - endif - end do - - endif + do j=1,ny_block + if (this_block%jblock == nblocks_y .and. this_block%j_glob(j) < 0) then + ! tripole is top block with j_glob < 0 + ! for yoffset=0 or 1, yoffset2=0,0 + ! for yoffset=-1, yoffset2=0,1, for u-rows on T-fold grid + do yoffset2=0,max(yoffset,0)-yoffset + jsrc = ny_global + yoffset + yoffset2 + & + (this_block%j_glob(j) + ny_global) + do i=1,nx_block + if (this_block%i_glob(i) /= 0) then + isrc = nx_global + xoffset - this_block%i_glob(i) + if (isrc < 1) isrc = isrc + nx_global + if (isrc > nx_global) isrc = isrc - nx_global + msg_buffer(i,j-yoffset2) & + = isign * ARRAY_G(isrc,jsrc) + endif + end do + end do + else + ! normal block + do i=1,nx_block + isrc = this_block%i_glob(i) + jsrc = this_block%j_glob(j) + if (isrc >=1 .and. isrc <= nx_global .and. & + jsrc >=1 .and. jsrc <= ny_global) & + msg_buffer(i,j) = ARRAY_G(isrc,jsrc) + end do + endif + end do call MPI_SEND(msg_buffer, nx_block*ny_block, & mpiR4, dst_dist%blockLocation(n)-1, 3*mpitag_gs+n, & @@ -2114,75 +1996,35 @@ subroutine scatter_global_real(ARRAY, ARRAY_G, src_task, dst_dist, & dst_block = dst_dist%blockLocalID(n) this_block = get_block(n,n) - !*** if this is an interior block, then there is no - !*** padding or update checking required - - if (this_block%iblock > 1 .and. & - this_block%iblock < nblocks_x .and. & - this_block%jblock > 1 .and. & - this_block%jblock < nblocks_y) then - - do j=1,ny_block - do i=1,nx_block - ARRAY(i,j,dst_block) = ARRAY_G(this_block%i_glob(i),& - this_block%j_glob(j)) - end do - end do - - !*** if this is an edge block but not a northern edge - !*** we only need to check for closed boundaries and - !*** padding (global index = 0) - - else if (this_block%jblock /= nblocks_y) then - - do j=1,ny_block - if (this_block%j_glob(j) /= 0) then - do i=1,nx_block - if (this_block%i_glob(i) /= 0) then - ARRAY(i,j,dst_block) = ARRAY_G(this_block%i_glob(i),& - this_block%j_glob(j)) - endif - end do - endif - end do - - !*** if this is a northern edge block, we need to check - !*** for and properly deal with tripole boundaries - - else - - do j=1,ny_block - if (this_block%j_glob(j) > 0) then ! normal boundary - - do i=1,nx_block - if (this_block%i_glob(i) /= 0) then - ARRAY(i,j,dst_block) = ARRAY_G(this_block%i_glob(i),& - this_block%j_glob(j)) - endif - end do - - else if (this_block%j_glob(j) < 0) then ! tripole - - ! for yoffset=0 or 1, yoffset2=0,0 - ! for yoffset=-1, yoffset2=0,1, for u-rows on T-fold grid - do yoffset2=0,max(yoffset,0)-yoffset - jsrc = ny_global + yoffset + yoffset2 + & - (this_block%j_glob(j) + ny_global) - do i=1,nx_block - if (this_block%i_glob(i) /= 0) then - isrc = nx_global + xoffset - this_block%i_glob(i) - if (isrc < 1) isrc = isrc + nx_global - if (isrc > nx_global) isrc = isrc - nx_global - ARRAY(i,j-yoffset2,dst_block) & - = isign * ARRAY_G(isrc,jsrc) - endif - end do - end do - - endif - end do - - endif + do j=1,ny_block + if (this_block%jblock == nblocks_y .and. this_block%j_glob(j) < 0) then + ! tripole is top block with j_glob < 0 + ! for yoffset=0 or 1, yoffset2=0,0 + ! for yoffset=-1, yoffset2=0,1, for u-rows on T-fold grid + do yoffset2=0,max(yoffset,0)-yoffset + jsrc = ny_global + yoffset + yoffset2 + & + (this_block%j_glob(j) + ny_global) + do i=1,nx_block + if (this_block%i_glob(i) /= 0) then + isrc = nx_global + xoffset - this_block%i_glob(i) + if (isrc < 1) isrc = isrc + nx_global + if (isrc > nx_global) isrc = isrc - nx_global + ARRAY(i,j-yoffset2,dst_block) & + = isign * ARRAY_G(isrc,jsrc) + endif + end do + end do + else + ! normal block + do i=1,nx_block + isrc = this_block%i_glob(i) + jsrc = this_block%j_glob(j) + if (isrc >=1 .and. isrc <= nx_global .and. & + jsrc >=1 .and. jsrc <= ny_global) & + ARRAY(i,j,dst_block) = ARRAY_G(isrc,jsrc) + end do + endif + end do endif end do @@ -2218,7 +2060,7 @@ subroutine scatter_global_real(ARRAY, ARRAY_G, src_task, dst_dist, & endif !----------------------------------------------------------------- - ! Ensure unused ghost cell values are 0 + ! Set ghost cell values to 0 for noupdate !----------------------------------------------------------------- if (field_loc == field_loc_noupdate) then @@ -2415,74 +2257,35 @@ subroutine scatter_global_int(ARRAY, ARRAY_G, src_task, dst_dist, & msg_buffer = 0 this_block = get_block(n,n) - !*** if this is an interior block, then there is no - !*** padding or update checking required - - if (this_block%iblock > 1 .and. & - this_block%iblock < nblocks_x .and. & - this_block%jblock > 1 .and. & - this_block%jblock < nblocks_y) then - - do j=1,ny_block - do i=1,nx_block - msg_buffer(i,j) = ARRAY_G(this_block%i_glob(i),& - this_block%j_glob(j)) - end do - end do - - !*** if this is an edge block but not a northern edge - !*** we only need to check for closed boundaries and - !*** padding (global index = 0) - - else if (this_block%jblock /= nblocks_y) then - - do j=1,ny_block - if (this_block%j_glob(j) /= 0) then - do i=1,nx_block - if (this_block%i_glob(i) /= 0) then - msg_buffer(i,j) = ARRAY_G(this_block%i_glob(i),& - this_block%j_glob(j)) - endif - end do - endif - end do - - !*** if this is a northern edge block, we need to check - !*** for and properly deal with tripole boundaries - - else - - do j=1,ny_block - if (this_block%j_glob(j) > 0) then ! normal boundary - - do i=1,nx_block - if (this_block%i_glob(i) /= 0) then - msg_buffer(i,j) = ARRAY_G(this_block%i_glob(i),& - this_block%j_glob(j)) - endif - end do - - else if (this_block%j_glob(j) < 0) then ! tripole - - ! for yoffset=0 or 1, yoffset2=0,0 - ! for yoffset=-1, yoffset2=0,1, for u-rows on T-fold grid - do yoffset2=0,max(yoffset,0)-yoffset - jsrc = ny_global + yoffset + yoffset2 + & - (this_block%j_glob(j) + ny_global) - do i=1,nx_block - if (this_block%i_glob(i) /= 0) then - isrc = nx_global + xoffset - this_block%i_glob(i) - if (isrc < 1) isrc = isrc + nx_global - if (isrc > nx_global) isrc = isrc - nx_global - msg_buffer(i,j-yoffset2) = isign * ARRAY_G(isrc,jsrc) - endif - end do - end do - - endif - end do - - endif + do j=1,ny_block + if (this_block%jblock == nblocks_y .and. this_block%j_glob(j) < 0) then + ! tripole is top block with j_glob < 0 + ! for yoffset=0 or 1, yoffset2=0,0 + ! for yoffset=-1, yoffset2=0,1, for u-rows on T-fold grid + do yoffset2=0,max(yoffset,0)-yoffset + jsrc = ny_global + yoffset + yoffset2 + & + (this_block%j_glob(j) + ny_global) + do i=1,nx_block + if (this_block%i_glob(i) /= 0) then + isrc = nx_global + xoffset - this_block%i_glob(i) + if (isrc < 1) isrc = isrc + nx_global + if (isrc > nx_global) isrc = isrc - nx_global + msg_buffer(i,j-yoffset2) & + = isign * ARRAY_G(isrc,jsrc) + endif + end do + end do + else + ! normal block + do i=1,nx_block + isrc = this_block%i_glob(i) + jsrc = this_block%j_glob(j) + if (isrc >=1 .and. isrc <= nx_global .and. & + jsrc >=1 .and. jsrc <= ny_global) & + msg_buffer(i,j) = ARRAY_G(isrc,jsrc) + end do + endif + end do call MPI_SEND(msg_buffer, nx_block*ny_block, & mpi_integer, dst_dist%blockLocation(n)-1, 3*mpitag_gs+n, & @@ -2500,75 +2303,35 @@ subroutine scatter_global_int(ARRAY, ARRAY_G, src_task, dst_dist, & dst_block = dst_dist%blockLocalID(n) this_block = get_block(n,n) - !*** if this is an interior block, then there is no - !*** padding or update checking required - - if (this_block%iblock > 1 .and. & - this_block%iblock < nblocks_x .and. & - this_block%jblock > 1 .and. & - this_block%jblock < nblocks_y) then - - do j=1,ny_block - do i=1,nx_block - ARRAY(i,j,dst_block) = ARRAY_G(this_block%i_glob(i),& - this_block%j_glob(j)) - end do - end do - - !*** if this is an edge block but not a northern edge - !*** we only need to check for closed boundaries and - !*** padding (global index = 0) - - else if (this_block%jblock /= nblocks_y) then - - do j=1,ny_block - if (this_block%j_glob(j) /= 0) then - do i=1,nx_block - if (this_block%i_glob(i) /= 0) then - ARRAY(i,j,dst_block) = ARRAY_G(this_block%i_glob(i),& - this_block%j_glob(j)) - endif - end do - endif - end do - - !*** if this is a northern edge block, we need to check - !*** for and properly deal with tripole boundaries - - else - - do j=1,ny_block - if (this_block%j_glob(j) > 0) then ! normal boundary - - do i=1,nx_block - if (this_block%i_glob(i) /= 0) then - ARRAY(i,j,dst_block) = ARRAY_G(this_block%i_glob(i),& - this_block%j_glob(j)) - endif - end do - - else if (this_block%j_glob(j) < 0) then ! tripole - - ! for yoffset=0 or 1, yoffset2=0,0 - ! for yoffset=-1, yoffset2=0,1, for u-rows on T-fold grid - do yoffset2=0,max(yoffset,0)-yoffset - jsrc = ny_global + yoffset + yoffset2 + & - (this_block%j_glob(j) + ny_global) - do i=1,nx_block - if (this_block%i_glob(i) /= 0) then - isrc = nx_global + xoffset - this_block%i_glob(i) - if (isrc < 1) isrc = isrc + nx_global - if (isrc > nx_global) isrc = isrc - nx_global - ARRAY(i,j-yoffset2,dst_block) & - = isign * ARRAY_G(isrc,jsrc) - endif - end do - end do - - endif - end do - - endif + do j=1,ny_block + if (this_block%jblock == nblocks_y .and. this_block%j_glob(j) < 0) then + ! tripole is top block with j_glob < 0 + ! for yoffset=0 or 1, yoffset2=0,0 + ! for yoffset=-1, yoffset2=0,1, for u-rows on T-fold grid + do yoffset2=0,max(yoffset,0)-yoffset + jsrc = ny_global + yoffset + yoffset2 + & + (this_block%j_glob(j) + ny_global) + do i=1,nx_block + if (this_block%i_glob(i) /= 0) then + isrc = nx_global + xoffset - this_block%i_glob(i) + if (isrc < 1) isrc = isrc + nx_global + if (isrc > nx_global) isrc = isrc - nx_global + ARRAY(i,j-yoffset2,dst_block) & + = isign * ARRAY_G(isrc,jsrc) + endif + end do + end do + else + ! normal block + do i=1,nx_block + isrc = this_block%i_glob(i) + jsrc = this_block%j_glob(j) + if (isrc >=1 .and. isrc <= nx_global .and. & + jsrc >=1 .and. jsrc <= ny_global) & + ARRAY(i,j,dst_block) = ARRAY_G(isrc,jsrc) + end do + endif + end do endif end do @@ -2604,7 +2367,7 @@ subroutine scatter_global_int(ARRAY, ARRAY_G, src_task, dst_dist, & endif !----------------------------------------------------------------- - ! Ensure unused ghost cell values are 0 + ! Set ghost cell values to 0 for noupdate !----------------------------------------------------------------- if (field_loc == field_loc_noupdate) then @@ -2681,7 +2444,7 @@ subroutine scatter_global_ext(ARRAY, ARRAY_G, src_task, dst_dist) integer (int_kind) :: & i,j,n, &! dummy loop indices iblk, jblk, &! block indices - iglb, jglb, &! global indices + isrc, jsrc, &! global indices nrecvs, &! actual number of messages received dst_block, &! location of block in dst array ierr ! MPI error flag @@ -2748,13 +2511,13 @@ subroutine scatter_global_ext(ARRAY, ARRAY_G, src_task, dst_dist) ! southwest corner iblk = i jblk = j - iglb = this_block%i_glob(this_block%ilo)+i-1 - jglb = j - msg_buffer(iblk,jblk) = ARRAY_G(iglb,jglb) + isrc = this_block%i_glob(this_block%ilo)+i-1 + jsrc = j + msg_buffer(iblk,jblk) = ARRAY_G(isrc,jsrc) ! southeast corner iblk = this_block%ihi+i - iglb = this_block%i_glob(this_block%ihi)+nghost+i - msg_buffer(iblk,jblk) = ARRAY_G(iglb,jglb) + isrc = this_block%i_glob(this_block%ihi)+nghost+i + msg_buffer(iblk,jblk) = ARRAY_G(isrc,jsrc) enddo enddo endif @@ -2769,13 +2532,13 @@ subroutine scatter_global_ext(ARRAY, ARRAY_G, src_task, dst_dist) ! northwest corner iblk = i jblk = this_block%jhi+j - iglb = this_block%i_glob(this_block%ilo)+i-1 - jglb = ny_global+nghost+j - msg_buffer(iblk,jblk) = ARRAY_G(iglb,jglb) + isrc = this_block%i_glob(this_block%ilo)+i-1 + jsrc = ny_global+nghost+j + msg_buffer(iblk,jblk) = ARRAY_G(isrc,jsrc) ! northeast corner iblk = this_block%ihi+i - iglb = this_block%i_glob(this_block%ihi)+nghost+i - msg_buffer(iblk,jblk) = ARRAY_G(iglb,jglb) + isrc = this_block%i_glob(this_block%ihi)+nghost+i + msg_buffer(iblk,jblk) = ARRAY_G(isrc,jsrc) enddo enddo endif @@ -2791,13 +2554,13 @@ subroutine scatter_global_ext(ARRAY, ARRAY_G, src_task, dst_dist) ! northwest corner iblk = i jblk = this_block%jhi+j - iglb = i - jglb = this_block%j_glob(this_block%jhi)+nghost+j - msg_buffer(iblk,jblk) = ARRAY_G(iglb,jglb) + isrc = i + jsrc = this_block%j_glob(this_block%jhi)+nghost+j + msg_buffer(iblk,jblk) = ARRAY_G(isrc,jsrc) ! southwest corner jblk = j - jglb = this_block%j_glob(this_block%jlo)+j-1 - msg_buffer(iblk,jblk) = ARRAY_G(iglb,jglb) + jsrc = this_block%j_glob(this_block%jlo)+j-1 + msg_buffer(iblk,jblk) = ARRAY_G(isrc,jsrc) enddo enddo endif @@ -2814,13 +2577,13 @@ subroutine scatter_global_ext(ARRAY, ARRAY_G, src_task, dst_dist) ! northeast corner iblk = this_block%ihi+i jblk = this_block%jhi+j - iglb = nx_global+nghost+i - jglb = this_block%j_glob(this_block%jhi)+nghost+j - msg_buffer(iblk,jblk) = ARRAY_G(iglb,jglb) + isrc = nx_global+nghost+i + jsrc = this_block%j_glob(this_block%jhi)+nghost+j + msg_buffer(iblk,jblk) = ARRAY_G(isrc,jsrc) ! southeast corner jblk = j - jglb = this_block%j_glob(this_block%jlo)+j-1 - msg_buffer(iblk,jblk) = ARRAY_G(iglb,jglb) + jsrc = this_block%j_glob(this_block%jlo)+j-1 + msg_buffer(iblk,jblk) = ARRAY_G(isrc,jsrc) enddo enddo endif @@ -2861,13 +2624,13 @@ subroutine scatter_global_ext(ARRAY, ARRAY_G, src_task, dst_dist) ! southwest corner iblk = i jblk = j - iglb = this_block%i_glob(this_block%ilo)+i-1 - jglb = j - ARRAY(iblk,jblk,dst_block) = ARRAY_G(iglb,jglb) + isrc = this_block%i_glob(this_block%ilo)+i-1 + jsrc = j + ARRAY(iblk,jblk,dst_block) = ARRAY_G(isrc,jsrc) ! southeast corner iblk = this_block%ihi+i - iglb = this_block%i_glob(this_block%ihi)+nghost+i - ARRAY(iblk,jblk,dst_block) = ARRAY_G(iglb,jglb) + isrc = this_block%i_glob(this_block%ihi)+nghost+i + ARRAY(iblk,jblk,dst_block) = ARRAY_G(isrc,jsrc) enddo enddo endif @@ -2882,13 +2645,13 @@ subroutine scatter_global_ext(ARRAY, ARRAY_G, src_task, dst_dist) ! northwest corner iblk = i jblk = this_block%jhi+j - iglb = this_block%i_glob(this_block%ilo)+i-1 - jglb = ny_global+nghost+j - ARRAY(iblk,jblk,dst_block) = ARRAY_G(iglb,jglb) + isrc = this_block%i_glob(this_block%ilo)+i-1 + jsrc = ny_global+nghost+j + ARRAY(iblk,jblk,dst_block) = ARRAY_G(isrc,jsrc) ! northeast corner iblk = this_block%ihi+i - iglb = this_block%i_glob(this_block%ihi)+nghost+i - ARRAY(iblk,jblk,dst_block) = ARRAY_G(iglb,jglb) + isrc = this_block%i_glob(this_block%ihi)+nghost+i + ARRAY(iblk,jblk,dst_block) = ARRAY_G(isrc,jsrc) enddo enddo endif @@ -2904,13 +2667,13 @@ subroutine scatter_global_ext(ARRAY, ARRAY_G, src_task, dst_dist) ! northwest corner iblk = i jblk = this_block%jhi+j - iglb = i - jglb = this_block%j_glob(this_block%jhi)+nghost+j - ARRAY(iblk,jblk,dst_block) = ARRAY_G(iglb,jglb) + isrc = i + jsrc = this_block%j_glob(this_block%jhi)+nghost+j + ARRAY(iblk,jblk,dst_block) = ARRAY_G(isrc,jsrc) ! southwest corner jblk = j - jglb = this_block%j_glob(this_block%jlo)+j-1 - ARRAY(iblk,jblk,dst_block) = ARRAY_G(iglb,jglb) + jsrc = this_block%j_glob(this_block%jlo)+j-1 + ARRAY(iblk,jblk,dst_block) = ARRAY_G(isrc,jsrc) enddo enddo endif @@ -2927,17 +2690,16 @@ subroutine scatter_global_ext(ARRAY, ARRAY_G, src_task, dst_dist) ! northeast corner iblk = this_block%ihi+i jblk = this_block%jhi+j - iglb = nx_global+nghost+i - jglb = this_block%j_glob(this_block%jhi)+nghost+j - ARRAY(iblk,jblk,dst_block) = ARRAY_G(iglb,jglb) + isrc = nx_global+nghost+i + jsrc = this_block%j_glob(this_block%jhi)+nghost+j + ARRAY(iblk,jblk,dst_block) = ARRAY_G(isrc,jsrc) ! southeast corner jblk = j - jglb = this_block%j_glob(this_block%jlo)+j-1 - ARRAY(iblk,jblk,dst_block) = ARRAY_G(iglb,jglb) + jsrc = this_block%j_glob(this_block%jlo)+j-1 + ARRAY(iblk,jblk,dst_block) = ARRAY_G(isrc,jsrc) enddo enddo endif - endif end do @@ -3071,70 +2833,30 @@ subroutine scatter_global_stress(ARRAY, ARRAY_G1, ARRAY_G2, & msg_buffer = c0 this_block = get_block(n,n) - !*** if this is an interior block, then there is no - !*** padding or update checking required - - if (this_block%iblock > 1 .and. & - this_block%iblock < nblocks_x .and. & - this_block%jblock > 1 .and. & - this_block%jblock < nblocks_y) then - - do j=1,ny_block - do i=1,nx_block - msg_buffer(i,j) = ARRAY_G1(this_block%i_glob(i),& - this_block%j_glob(j)) - end do - end do - - !*** if this is an edge block but not a northern edge - !*** we only need to check for closed boundaries and - !*** padding (global index = 0) - - else if (this_block%jblock /= nblocks_y) then - - do j=1,ny_block - if (this_block%j_glob(j) /= 0) then - do i=1,nx_block - if (this_block%i_glob(i) /= 0) then - msg_buffer(i,j) = ARRAY_G1(this_block%i_glob(i),& - this_block%j_glob(j)) - endif - end do - endif - end do - - !*** if this is a northern edge block, we need to check - !*** for and properly deal with tripole boundaries - - else - - do j=1,ny_block - if (this_block%j_glob(j) > 0) then ! normal boundary - - do i=1,nx_block - if (this_block%i_glob(i) /= 0) then - msg_buffer(i,j) = ARRAY_G1(this_block%i_glob(i),& - this_block%j_glob(j)) - endif - end do - - else if (this_block%j_glob(j) < 0) then ! tripole - - jsrc = ny_global + yoffset + & - (this_block%j_glob(j) + ny_global) - do i=1,nx_block - if (this_block%i_glob(i) /= 0) then - isrc = nx_global + xoffset - this_block%i_glob(i) - if (isrc < 1) isrc = isrc + nx_global - if (isrc > nx_global) isrc = isrc - nx_global - msg_buffer(i,j) = isign * ARRAY_G2(isrc,jsrc) - endif - end do - - endif - end do - - endif + do j=1,ny_block + if (this_block%jblock == nblocks_y .and. this_block%j_glob(j) < 0) then + ! tripole is top block with j_glob < 0 + jsrc = ny_global + yoffset + & + (this_block%j_glob(j) + ny_global) + do i=1,nx_block + if (this_block%i_glob(i) /= 0) then + isrc = nx_global + xoffset - this_block%i_glob(i) + if (isrc < 1) isrc = isrc + nx_global + if (isrc > nx_global) isrc = isrc - nx_global + msg_buffer(i,j) = isign * ARRAY_G2(isrc,jsrc) + endif + end do + else + ! normal block + do i=1,nx_block + isrc = this_block%i_glob(i) + jsrc = this_block%j_glob(j) + if (isrc >=1 .and. isrc <= nx_global .and. & + jsrc >=1 .and. jsrc <= ny_global) & + msg_buffer(i,j) = ARRAY_G1(isrc,jsrc) + end do + endif + end do call MPI_SEND(msg_buffer, nx_block*ny_block, & mpiR8, dst_dist%blockLocation(n)-1, 3*mpitag_gs+n, & @@ -3152,75 +2874,35 @@ subroutine scatter_global_stress(ARRAY, ARRAY_G1, ARRAY_G2, & dst_block = dst_dist%blockLocalID(n) this_block = get_block(n,n) - !*** if this is an interior block, then there is no - !*** padding or update checking required - - if (this_block%iblock > 1 .and. & - this_block%iblock < nblocks_x .and. & - this_block%jblock > 1 .and. & - this_block%jblock < nblocks_y) then - - do j=1,ny_block - do i=1,nx_block - ARRAY(i,j,dst_block) = ARRAY_G1(this_block%i_glob(i),& - this_block%j_glob(j)) - end do - end do - - !*** if this is an edge block but not a northern edge - !*** we only need to check for closed boundaries and - !*** padding (global index = 0) - - else if (this_block%jblock /= nblocks_y) then - - do j=1,ny_block - if (this_block%j_glob(j) /= 0) then - do i=1,nx_block - if (this_block%i_glob(i) /= 0) then - ARRAY(i,j,dst_block) = ARRAY_G1(this_block%i_glob(i),& - this_block%j_glob(j)) - endif - end do - endif - end do - - !*** if this is a northern edge block, we need to check - !*** for and properly deal with tripole boundaries - - else - - do j=1,ny_block - if (this_block%j_glob(j) > 0) then ! normal boundary - - do i=1,nx_block - if (this_block%i_glob(i) /= 0) then - ARRAY(i,j,dst_block) = ARRAY_G1(this_block%i_glob(i),& - this_block%j_glob(j)) - endif - end do - - else if (this_block%j_glob(j) < 0) then ! tripole - - ! for yoffset=0 or 1, yoffset2=0,0 - ! for yoffset=-1, yoffset2=0,1, for u-rows on T-fold grid - do yoffset2=0,max(yoffset,0)-yoffset - jsrc = ny_global + yoffset + yoffset2 + & - (this_block%j_glob(j) + ny_global) - do i=1,nx_block - if (this_block%i_glob(i) /= 0) then - isrc = nx_global + xoffset - this_block%i_glob(i) - if (isrc < 1) isrc = isrc + nx_global - if (isrc > nx_global) isrc = isrc - nx_global - ARRAY(i,j-yoffset2,dst_block) & - = isign * ARRAY_G2(isrc,jsrc) - endif - end do - end do - - endif - end do - - endif + do j=1,ny_block + if (this_block%jblock == nblocks_y .and. this_block%j_glob(j) < 0) then + ! tripole is top block with j_glob < 0 + ! for yoffset=0 or 1, yoffset2=0,0 + ! for yoffset=-1, yoffset2=0,1, for u-rows on T-fold grid + do yoffset2=0,max(yoffset,0)-yoffset + jsrc = ny_global + yoffset + yoffset2 + & + (this_block%j_glob(j) + ny_global) + do i=1,nx_block + if (this_block%i_glob(i) /= 0) then + isrc = nx_global + xoffset - this_block%i_glob(i) + if (isrc < 1) isrc = isrc + nx_global + if (isrc > nx_global) isrc = isrc - nx_global + ARRAY(i,j-yoffset2,dst_block) & + = isign * ARRAY_G2(isrc,jsrc) + endif + end do + end do + else + ! normal block + do i=1,nx_block + isrc = this_block%i_glob(i) + jsrc = this_block%j_glob(j) + if (isrc >=1 .and. isrc <= nx_global .and. & + jsrc >=1 .and. jsrc <= ny_global) & + ARRAY(i,j,dst_block) = ARRAY_G1(isrc,jsrc) + end do + endif + end do endif end do diff --git a/cicecore/cicedyn/infrastructure/comm/serial/ice_boundary.F90 b/cicecore/cicedyn/infrastructure/comm/serial/ice_boundary.F90 index b9ac8fe33..f185da3c5 100644 --- a/cicecore/cicedyn/infrastructure/comm/serial/ice_boundary.F90 +++ b/cicecore/cicedyn/infrastructure/comm/serial/ice_boundary.F90 @@ -31,7 +31,7 @@ module ice_boundary use icepack_intfc, only: icepack_warnings_flush, icepack_warnings_aborted use ice_blocks, only: nx_block, ny_block, nghost, & - nblocks_tot, ice_blocksNorth, & + nblocks_tot, ice_blocksNorth, nblocks_x, nblocks_y, & ice_blocksSouth, ice_blocksEast, ice_blocksWest, & ice_blocksEast2, ice_blocksWest2, & ice_blocksNorthEast, ice_blocksNorthWest, & @@ -61,6 +61,10 @@ module ice_boundary srcLocalAddr, &! src addresses for each local copy dstLocalAddr ! dst addresses for each local copy + character (char_len) :: & + nsBoundaryType, &! type of boundary to use in logical ns dir + ewBoundaryType ! type of boundary to use in logical ew dir + end type public :: ice_HaloCreate, & @@ -177,6 +181,8 @@ function ice_HaloCreate(dist, nsBoundaryType, ewBoundaryType, & if (my_task >= numProcs) return halo%communicator = communicator + halo%ewBoundaryType = ewBoundaryType + halo%nsBoundaryType = nsBoundaryType blockSizeX = nx_block - 2*nghost blockSizeY = ny_block - 2*nghost @@ -659,7 +665,7 @@ subroutine ice_HaloUpdate2DR8(array, halo, & ! This routine updates ghost cells for an input array and is a ! member of a group of routines under the generic interface -! POP\_HaloUpdate. This routine is the specific interface +! ice\_HaloUpdate. This routine is the specific interface ! for 2d horizontal arrays of double precision. type (ice_halo), intent(in) :: & @@ -690,9 +696,10 @@ subroutine ice_HaloUpdate2DR8(array, halo, & ! !----------------------------------------------------------------------- - integer (int_kind) :: & + integer (int_kind) :: & i,j,nmsg, &! dummy loop indices iblk,ilo,ihi,jlo,jhi, &! block sizes for fill + iblock,jblock, &! global block indices nxGlobal, &! global domain size in x (tripole) iSrc,jSrc, &! source addresses for message iDst,jDst, &! dest addresses for message @@ -706,6 +713,8 @@ subroutine ice_HaloUpdate2DR8(array, halo, & x1,x2,xavg ! scalars for enforcing symmetry at U pts logical (log_kind) :: & + ewfillouter, &! fill outer boundary ew + nsfillouter, &! fill outer boundary ns ltripoleOnly ! local tripoleOnly value character(len=*), parameter :: subname = '(ice_HaloUpdate2DR8)' @@ -733,8 +742,20 @@ subroutine ice_HaloUpdate2DR8(array, halo, & ! !----------------------------------------------------------------------- + ewfillouter = .false. + nsfillouter = .false. + + ! fill outer boundary if cyclic or tripole + if (halo%ewBoundaryType == 'cyclic') ewfillouter=.true. + if (halo%nsBoundaryType == 'tripole' .or. & + halo%nsBoundaryType == 'tripoleT' .or. & + halo%nsBoundaryType == 'cyclic') nsfillouter=.true. + if (present(fillValue)) then fill = fillValue + ! always fill outer boundary if fillValue is passed + ewfillouter = .true. + nsfillouter = .true. else fill = 0.0_dbl_kind endif @@ -753,29 +774,78 @@ subroutine ice_HaloUpdate2DR8(array, halo, & !----------------------------------------------------------------------- ! -! fill out halo region -! needed for masked halos to ensure halo values are filled for +! Fill out halo region +! Needed for masked halos to ensure halo values are filled for ! halo grid cells that are not updated +! In general, do NOT fill outer boundary for open boundary conditions +! because do not want to overwrite existing data ! !----------------------------------------------------------------------- - if (ltripoleOnly) then - ! skip fill, not needed since tripole seam always exists if running - ! on tripole grid and set tripoleOnly flag - else + if (.not. ltripoleOnly) then + ! tripoleOnly skip fill, do not overwrite any values in interior as they may + ! already be set and filling tripole is not necessary + + ! fill outer boundary as needed + ! only fill corners if both edges are being filled do iblk = 1, halo%numLocalBlocks - call get_block_parameter(halo%blockGlobalID(iblk), & - ilo=ilo, ihi=ihi, & - jlo=jlo, jhi=jhi) - do j = 1,nghost - array(1:nx_block, jlo-j,iblk) = fill - array(1:nx_block, jhi+j,iblk) = fill - enddo - do i = 1,nghost - array(ilo-i, 1:ny_block,iblk) = fill - array(ihi+i, 1:ny_block,iblk) = fill - enddo - enddo + call get_block_parameter(halo%blockGlobalID(iblk), & + ilo=ilo, ihi=ihi, & + jlo=jlo, jhi=jhi, & + iblock=iblock, jblock=jblock) + if (ewfillouter .or. iblock > 1) then ! west edge + do i = 1,nghost + array(ilo-i, jlo:jhi, iblk) = fill + enddo + endif + if (ewfillouter .or. iblock < nblocks_x) then ! east edge + do i = 1,nghost + array(ihi+i, jlo:jhi, iblk) = fill + enddo + endif + if (nsfillouter .or. jblock > 1) then ! south edge + do j = 1,nghost + array(ilo:ihi, jlo-j, iblk) = fill + enddo + endif + if (nsfillouter .or. jblock < nblocks_y) then ! north edge + do j = 1,nghost + array(ilo:ihi, jhi+j, iblk) = fill + enddo + endif + if ((ewfillouter .or. iblock > 1) .and. & ! southwest corner + (nsfillouter .or. jblock > 1)) then + do j = 1,nghost + do i = 1,nghost + array(ilo-i, jlo-j, iblk) = fill + enddo + enddo + endif + if ((ewfillouter .or. iblock > 1) .and. & ! northwest corner + (nsfillouter .or. jblock < nblocks_y)) then + do j = 1,nghost + do i = 1,nghost + array(ilo-i, jhi+j, iblk) = fill + enddo + enddo + endif + if ((ewfillouter .or. iblock < nblocks_x) .and. & ! southeast corner + (nsfillouter .or. jblock > 1)) then + do j = 1,nghost + do i = 1,nghost + array(ihi+i, jlo-j, iblk) = fill + enddo + enddo + endif + if ((ewfillouter .or. iblock < nblocks_x) .and. & ! northeast corner + (nsfillouter .or. jblock < nblocks_y)) then + do j = 1,nghost + do i = 1,nghost + array(ihi+i, jhi+j, iblk) = fill + enddo + enddo + endif + enddo ! iblk endif !----------------------------------------------------------------------- @@ -994,7 +1064,7 @@ subroutine ice_HaloUpdate2DR4(array, halo, & ! This routine updates ghost cells for an input array and is a ! member of a group of routines under the generic interface -! POP\_HaloUpdate. This routine is the specific interface +! ice\_HaloUpdate. This routine is the specific interface ! for 2d horizontal arrays of single precision. type (ice_halo), intent(in) :: & @@ -1022,9 +1092,10 @@ subroutine ice_HaloUpdate2DR4(array, halo, & ! !----------------------------------------------------------------------- - integer (int_kind) :: & + integer (int_kind) :: & i,j,nmsg, &! dummy loop indices iblk,ilo,ihi,jlo,jhi, &! block sizes for fill + iblock,jblock, &! global block indices nxGlobal, &! global domain size in x (tripole) iSrc,jSrc, &! source addresses for message iDst,jDst, &! dest addresses for message @@ -1037,6 +1108,10 @@ subroutine ice_HaloUpdate2DR4(array, halo, & fill, &! value to use for unknown points x1,x2,xavg ! scalars for enforcing symmetry at U pts + logical (log_kind) :: & + ewfillouter, &! fill outer boundary ew + nsfillouter ! fill outer boundary ns + character(len=*), parameter :: subname = '(ice_HaloUpdate2DR4)' !----------------------------------------------------------------------- @@ -1062,8 +1137,20 @@ subroutine ice_HaloUpdate2DR4(array, halo, & ! !----------------------------------------------------------------------- + ewfillouter = .false. + nsfillouter = .false. + + ! fill outer boundary if cyclic + if (halo%ewBoundaryType == 'cyclic') ewfillouter=.true. + if (halo%nsBoundaryType == 'tripole' .or. & + halo%nsBoundaryType == 'tripoleT' .or. & + halo%nsBoundaryType == 'cyclic') nsfillouter=.true. + if (present(fillValue)) then fill = fillValue + ! always fill outer boundary if fillValue is passed + ewfillouter = .true. + nsfillouter = .true. else fill = 0.0_real_kind endif @@ -1076,25 +1163,74 @@ subroutine ice_HaloUpdate2DR4(array, halo, & !----------------------------------------------------------------------- ! -! fill out halo region -! needed for masked halos to ensure halo values are filled for +! Fill out halo region +! Needed for masked halos to ensure halo values are filled for ! halo grid cells that are not updated +! In general, do NOT fill outer boundary for open boundary conditions +! because do not want to overwrite existing data ! !----------------------------------------------------------------------- + ! fill outer boundary as needed + ! only fill corners if both edges are being filled do iblk = 1, halo%numLocalBlocks - call get_block_parameter(halo%blockGlobalID(iblk), & - ilo=ilo, ihi=ihi, & - jlo=jlo, jhi=jhi) - do j = 1,nghost - array(1:nx_block, jlo-j,iblk) = fill - array(1:nx_block, jhi+j,iblk) = fill - enddo - do i = 1,nghost - array(ilo-i, 1:ny_block,iblk) = fill - array(ihi+i, 1:ny_block,iblk) = fill - enddo - enddo + call get_block_parameter(halo%blockGlobalID(iblk), & + ilo=ilo, ihi=ihi, & + jlo=jlo, jhi=jhi, & + iblock=iblock, jblock=jblock) + if (ewfillouter .or. iblock > 1) then ! west edge + do i = 1,nghost + array(ilo-i, jlo:jhi, iblk) = fill + enddo + endif + if (ewfillouter .or. iblock < nblocks_x) then ! east edge + do i = 1,nghost + array(ihi+i, jlo:jhi, iblk) = fill + enddo + endif + if (nsfillouter .or. jblock > 1) then ! south edge + do j = 1,nghost + array(ilo:ihi, jlo-j, iblk) = fill + enddo + endif + if (nsfillouter .or. jblock < nblocks_y) then ! north edge + do j = 1,nghost + array(ilo:ihi, jhi+j, iblk) = fill + enddo + endif + if ((ewfillouter .or. iblock > 1) .and. & ! southwest corner + (nsfillouter .or. jblock > 1)) then + do j = 1,nghost + do i = 1,nghost + array(ilo-i, jlo-j, iblk) = fill + enddo + enddo + endif + if ((ewfillouter .or. iblock > 1) .and. & ! northwest corner + (nsfillouter .or. jblock < nblocks_y)) then + do j = 1,nghost + do i = 1,nghost + array(ilo-i, jhi+j, iblk) = fill + enddo + enddo + endif + if ((ewfillouter .or. iblock < nblocks_x) .and. & ! southeast corner + (nsfillouter .or. jblock > 1)) then + do j = 1,nghost + do i = 1,nghost + array(ihi+i, jlo-j, iblk) = fill + enddo + enddo + endif + if ((ewfillouter .or. iblock < nblocks_x) .and. & ! northeast corner + (nsfillouter .or. jblock < nblocks_y)) then + do j = 1,nghost + do i = 1,nghost + array(ihi+i, jhi+j, iblk) = fill + enddo + enddo + endif + enddo ! iblk !----------------------------------------------------------------------- ! @@ -1303,7 +1439,7 @@ subroutine ice_HaloUpdate2DI4(array, halo, & ! This routine updates ghost cells for an input array and is a ! member of a group of routines under the generic interface -! POP\_HaloUpdate. This routine is the specific interface +! ice\_HaloUpdate. This routine is the specific interface ! for 2d horizontal integer arrays. type (ice_halo), intent(in) :: & @@ -1331,9 +1467,10 @@ subroutine ice_HaloUpdate2DI4(array, halo, & ! !----------------------------------------------------------------------- - integer (int_kind) :: & + integer (int_kind) :: & i,j,nmsg, &! dummy loop indices iblk,ilo,ihi,jlo,jhi, &! block sizes for fill + iblock,jblock, &! global block indices nxGlobal, &! global domain size in x (tripole) iSrc,jSrc, &! source addresses for message iDst,jDst, &! dest addresses for message @@ -1346,6 +1483,10 @@ subroutine ice_HaloUpdate2DI4(array, halo, & fill, &! value to use for unknown points x1,x2,xavg ! scalars for enforcing symmetry at U pts + logical (log_kind) :: & + ewfillouter, &! fill outer boundary ew + nsfillouter ! fill outer boundary ns + character(len=*), parameter :: subname = '(ice_HaloUpdate2DI4)' !----------------------------------------------------------------------- @@ -1371,8 +1512,20 @@ subroutine ice_HaloUpdate2DI4(array, halo, & ! !----------------------------------------------------------------------- + ewfillouter = .false. + nsfillouter = .false. + + ! fill outer boundary if cyclic + if (halo%ewBoundaryType == 'cyclic') ewfillouter=.true. + if (halo%nsBoundaryType == 'tripole' .or. & + halo%nsBoundaryType == 'tripoleT' .or. & + halo%nsBoundaryType == 'cyclic') nsfillouter=.true. + if (present(fillValue)) then fill = fillValue + ! always fill outer boundary if fillValue is passed + ewfillouter = .true. + nsfillouter = .true. else fill = 0_int_kind endif @@ -1385,25 +1538,74 @@ subroutine ice_HaloUpdate2DI4(array, halo, & !----------------------------------------------------------------------- ! -! fill out halo region -! needed for masked halos to ensure halo values are filled for +! Fill out halo region +! Needed for masked halos to ensure halo values are filled for ! halo grid cells that are not updated +! In general, do NOT fill outer boundary for open boundary conditions +! because do not want to overwrite existing data ! !----------------------------------------------------------------------- + ! fill outer boundary as needed + ! only fill corners if both edges are being filled do iblk = 1, halo%numLocalBlocks - call get_block_parameter(halo%blockGlobalID(iblk), & - ilo=ilo, ihi=ihi, & - jlo=jlo, jhi=jhi) - do j = 1,nghost - array(1:nx_block, jlo-j,iblk) = fill - array(1:nx_block, jhi+j,iblk) = fill - enddo - do i = 1,nghost - array(ilo-i, 1:ny_block,iblk) = fill - array(ihi+i, 1:ny_block,iblk) = fill - enddo - enddo + call get_block_parameter(halo%blockGlobalID(iblk), & + ilo=ilo, ihi=ihi, & + jlo=jlo, jhi=jhi, & + iblock=iblock, jblock=jblock) + if (ewfillouter .or. iblock > 1) then ! west edge + do i = 1,nghost + array(ilo-i, jlo:jhi, iblk) = fill + enddo + endif + if (ewfillouter .or. iblock < nblocks_x) then ! east edge + do i = 1,nghost + array(ihi+i, jlo:jhi, iblk) = fill + enddo + endif + if (nsfillouter .or. jblock > 1) then ! south edge + do j = 1,nghost + array(ilo:ihi, jlo-j, iblk) = fill + enddo + endif + if (nsfillouter .or. jblock < nblocks_y) then ! north edge + do j = 1,nghost + array(ilo:ihi, jhi+j, iblk) = fill + enddo + endif + if ((ewfillouter .or. iblock > 1) .and. & ! southwest corner + (nsfillouter .or. jblock > 1)) then + do j = 1,nghost + do i = 1,nghost + array(ilo-i, jlo-j, iblk) = fill + enddo + enddo + endif + if ((ewfillouter .or. iblock > 1) .and. & ! northwest corner + (nsfillouter .or. jblock < nblocks_y)) then + do j = 1,nghost + do i = 1,nghost + array(ilo-i, jhi+j, iblk) = fill + enddo + enddo + endif + if ((ewfillouter .or. iblock < nblocks_x) .and. & ! southeast corner + (nsfillouter .or. jblock > 1)) then + do j = 1,nghost + do i = 1,nghost + array(ihi+i, jlo-j, iblk) = fill + enddo + enddo + endif + if ((ewfillouter .or. iblock < nblocks_x) .and. & ! northeast corner + (nsfillouter .or. jblock < nblocks_y)) then + do j = 1,nghost + do i = 1,nghost + array(ihi+i, jhi+j, iblk) = fill + enddo + enddo + endif + enddo ! iblk !----------------------------------------------------------------------- ! @@ -1692,7 +1894,7 @@ subroutine ice_HaloUpdate3DR8(array, halo, & ! This routine updates ghost cells for an input array and is a ! member of a group of routines under the generic interface -! POP\_HaloUpdate. This routine is the specific interface +! ice\_HaloUpdate. This routine is the specific interface ! for 3d horizontal arrays of double precision. type (ice_halo), intent(in) :: & @@ -1720,9 +1922,10 @@ subroutine ice_HaloUpdate3DR8(array, halo, & ! !----------------------------------------------------------------------- - integer (int_kind) :: & + integer (int_kind) :: & i,j,k,nmsg, &! dummy loop indices iblk,ilo,ihi,jlo,jhi, &! block sizes for fill + iblock,jblock, &! global block indices nxGlobal, &! global domain size in x (tripole) nz, &! size of array in 3rd dimension iSrc,jSrc, &! source addresses for message @@ -1736,6 +1939,10 @@ subroutine ice_HaloUpdate3DR8(array, halo, & fill, &! value to use for unknown points x1,x2,xavg ! scalars for enforcing symmetry at U pts + logical (log_kind) :: & + ewfillouter, &! fill outer boundary ew + nsfillouter ! fill outer boundary ns + real (dbl_kind), dimension(:,:,:), allocatable :: & bufTripole ! 3d tripole buffer @@ -1764,8 +1971,20 @@ subroutine ice_HaloUpdate3DR8(array, halo, & ! !----------------------------------------------------------------------- + ewfillouter = .false. + nsfillouter = .false. + + ! fill outer boundary if cyclic + if (halo%ewBoundaryType == 'cyclic') ewfillouter=.true. + if (halo%nsBoundaryType == 'tripole' .or. & + halo%nsBoundaryType == 'tripoleT' .or. & + halo%nsBoundaryType == 'cyclic') nsfillouter=.true. + if (present(fillValue)) then fill = fillValue + ! always fill outer boundary if fillValue is passed + ewfillouter = .true. + nsfillouter = .true. else fill = 0.0_dbl_kind endif @@ -1781,25 +2000,74 @@ subroutine ice_HaloUpdate3DR8(array, halo, & !----------------------------------------------------------------------- ! -! fill out halo region -! needed for masked halos to ensure halo values are filled for +! Fill out halo region +! Needed for masked halos to ensure halo values are filled for ! halo grid cells that are not updated +! In general, do NOT fill outer boundary for open boundary conditions +! because do not want to overwrite existing data ! !----------------------------------------------------------------------- + ! fill outer boundary as needed + ! only fill corners if both edges are being filled do iblk = 1, halo%numLocalBlocks - call get_block_parameter(halo%blockGlobalID(iblk), & - ilo=ilo, ihi=ihi, & - jlo=jlo, jhi=jhi) - do j = 1,nghost - array(1:nx_block, jlo-j,:,iblk) = fill - array(1:nx_block, jhi+j,:,iblk) = fill - enddo - do i = 1,nghost - array(ilo-i, 1:ny_block,:,iblk) = fill - array(ihi+i, 1:ny_block,:,iblk) = fill - enddo - enddo + call get_block_parameter(halo%blockGlobalID(iblk), & + ilo=ilo, ihi=ihi, & + jlo=jlo, jhi=jhi, & + iblock=iblock, jblock=jblock) + if (ewfillouter .or. iblock > 1) then ! west edge + do i = 1,nghost + array(ilo-i, jlo:jhi, :, iblk) = fill + enddo + endif + if (ewfillouter .or. iblock < nblocks_x) then ! east edge + do i = 1,nghost + array(ihi+i, jlo:jhi, :, iblk) = fill + enddo + endif + if (nsfillouter .or. jblock > 1) then ! south edge + do j = 1,nghost + array(ilo:ihi, jlo-j, :, iblk) = fill + enddo + endif + if (nsfillouter .or. jblock < nblocks_y) then ! north edge + do j = 1,nghost + array(ilo:ihi, jhi+j, :, iblk) = fill + enddo + endif + if ((ewfillouter .or. iblock > 1) .and. & ! southwest corner + (nsfillouter .or. jblock > 1)) then + do j = 1,nghost + do i = 1,nghost + array(ilo-i, jlo-j, :, iblk) = fill + enddo + enddo + endif + if ((ewfillouter .or. iblock > 1) .and. & ! northwest corner + (nsfillouter .or. jblock < nblocks_y)) then + do j = 1,nghost + do i = 1,nghost + array(ilo-i, jhi+j, :, iblk) = fill + enddo + enddo + endif + if ((ewfillouter .or. iblock < nblocks_x) .and. & ! southeast corner + (nsfillouter .or. jblock > 1)) then + do j = 1,nghost + do i = 1,nghost + array(ihi+i, jlo-j, :, iblk) = fill + enddo + enddo + endif + if ((ewfillouter .or. iblock < nblocks_x) .and. & ! northeast corner + (nsfillouter .or. jblock < nblocks_y)) then + do j = 1,nghost + do i = 1,nghost + array(ihi+i, jhi+j, :, iblk) = fill + enddo + enddo + endif + enddo ! iblk !----------------------------------------------------------------------- ! @@ -2027,7 +2295,7 @@ subroutine ice_HaloUpdate3DR4(array, halo, & ! This routine updates ghost cells for an input array and is a ! member of a group of routines under the generic interface -! POP\_HaloUpdate. This routine is the specific interface +! ice\_HaloUpdate. This routine is the specific interface ! for 3d horizontal arrays of single precision. type (ice_halo), intent(in) :: & @@ -2055,9 +2323,10 @@ subroutine ice_HaloUpdate3DR4(array, halo, & ! !----------------------------------------------------------------------- - integer (int_kind) :: & + integer (int_kind) :: & i,j,k,nmsg, &! dummy loop indices iblk,ilo,ihi,jlo,jhi, &! block sizes for fill + iblock,jblock, &! global block indices nxGlobal, &! global domain size in x (tripole) nz, &! size of array in 3rd dimension iSrc,jSrc, &! source addresses for message @@ -2071,6 +2340,10 @@ subroutine ice_HaloUpdate3DR4(array, halo, & fill, &! value to use for unknown points x1,x2,xavg ! scalars for enforcing symmetry at U pts + logical (log_kind) :: & + ewfillouter, &! fill outer boundary ew + nsfillouter ! fill outer boundary ns + real (real_kind), dimension(:,:,:), allocatable :: & bufTripole ! 3d tripole buffer @@ -2099,8 +2372,20 @@ subroutine ice_HaloUpdate3DR4(array, halo, & ! !----------------------------------------------------------------------- + ewfillouter = .false. + nsfillouter = .false. + + ! fill outer boundary if cyclic + if (halo%ewBoundaryType == 'cyclic') ewfillouter=.true. + if (halo%nsBoundaryType == 'tripole' .or. & + halo%nsBoundaryType == 'tripoleT' .or. & + halo%nsBoundaryType == 'cyclic') nsfillouter=.true. + if (present(fillValue)) then fill = fillValue + ! always fill outer boundary if fillValue is passed + ewfillouter = .true. + nsfillouter = .true. else fill = 0.0_real_kind endif @@ -2116,25 +2401,74 @@ subroutine ice_HaloUpdate3DR4(array, halo, & !----------------------------------------------------------------------- ! -! fill out halo region -! needed for masked halos to ensure halo values are filled for +! Fill out halo region +! Needed for masked halos to ensure halo values are filled for ! halo grid cells that are not updated +! In general, do NOT fill outer boundary for open boundary conditions +! because do not want to overwrite existing data ! !----------------------------------------------------------------------- + ! fill outer boundary as needed + ! only fill corners if both edges are being filled do iblk = 1, halo%numLocalBlocks - call get_block_parameter(halo%blockGlobalID(iblk), & - ilo=ilo, ihi=ihi, & - jlo=jlo, jhi=jhi) - do j = 1,nghost - array(1:nx_block, jlo-j,:,iblk) = fill - array(1:nx_block, jhi+j,:,iblk) = fill - enddo - do i = 1,nghost - array(ilo-i, 1:ny_block,:,iblk) = fill - array(ihi+i, 1:ny_block,:,iblk) = fill - enddo - enddo + call get_block_parameter(halo%blockGlobalID(iblk), & + ilo=ilo, ihi=ihi, & + jlo=jlo, jhi=jhi, & + iblock=iblock, jblock=jblock) + if (ewfillouter .or. iblock > 1) then ! west edge + do i = 1,nghost + array(ilo-i, jlo:jhi, :, iblk) = fill + enddo + endif + if (ewfillouter .or. iblock < nblocks_x) then ! east edge + do i = 1,nghost + array(ihi+i, jlo:jhi, :, iblk) = fill + enddo + endif + if (nsfillouter .or. jblock > 1) then ! south edge + do j = 1,nghost + array(ilo:ihi, jlo-j, :, iblk) = fill + enddo + endif + if (nsfillouter .or. jblock < nblocks_y) then ! north edge + do j = 1,nghost + array(ilo:ihi, jhi+j, :, iblk) = fill + enddo + endif + if ((ewfillouter .or. iblock > 1) .and. & ! southwest corner + (nsfillouter .or. jblock > 1)) then + do j = 1,nghost + do i = 1,nghost + array(ilo-i, jlo-j, :, iblk) = fill + enddo + enddo + endif + if ((ewfillouter .or. iblock > 1) .and. & ! northwest corner + (nsfillouter .or. jblock < nblocks_y)) then + do j = 1,nghost + do i = 1,nghost + array(ilo-i, jhi+j, :, iblk) = fill + enddo + enddo + endif + if ((ewfillouter .or. iblock < nblocks_x) .and. & ! southeast corner + (nsfillouter .or. jblock > 1)) then + do j = 1,nghost + do i = 1,nghost + array(ihi+i, jlo-j, :, iblk) = fill + enddo + enddo + endif + if ((ewfillouter .or. iblock < nblocks_x) .and. & ! northeast corner + (nsfillouter .or. jblock < nblocks_y)) then + do j = 1,nghost + do i = 1,nghost + array(ihi+i, jhi+j, :, iblk) = fill + enddo + enddo + endif + enddo ! iblk !----------------------------------------------------------------------- ! @@ -2362,7 +2696,7 @@ subroutine ice_HaloUpdate3DI4(array, halo, & ! This routine updates ghost cells for an input array and is a ! member of a group of routines under the generic interface -! POP\_HaloUpdate. This routine is the specific interface +! ice\_HaloUpdate. This routine is the specific interface ! for 3d horizontal arrays of double precision. type (ice_halo), intent(in) :: & @@ -2390,9 +2724,10 @@ subroutine ice_HaloUpdate3DI4(array, halo, & ! !----------------------------------------------------------------------- - integer (int_kind) :: & + integer (int_kind) :: & i,j,k,nmsg, &! dummy loop indices iblk,ilo,ihi,jlo,jhi, &! block sizes for fill + iblock,jblock, &! global block indices nxGlobal, &! global domain size in x (tripole) nz, &! size of array in 3rd dimension iSrc,jSrc, &! source addresses for message @@ -2406,6 +2741,10 @@ subroutine ice_HaloUpdate3DI4(array, halo, & fill, &! value to use for unknown points x1,x2,xavg ! scalars for enforcing symmetry at U pts + logical (log_kind) :: & + ewfillouter, &! fill outer boundary ew + nsfillouter ! fill outer boundary ns + integer (int_kind), dimension(:,:,:), allocatable :: & bufTripole ! 3d tripole buffer @@ -2434,8 +2773,20 @@ subroutine ice_HaloUpdate3DI4(array, halo, & ! !----------------------------------------------------------------------- + ewfillouter = .false. + nsfillouter = .false. + + ! fill outer boundary if cyclic + if (halo%ewBoundaryType == 'cyclic') ewfillouter=.true. + if (halo%nsBoundaryType == 'tripole' .or. & + halo%nsBoundaryType == 'tripoleT' .or. & + halo%nsBoundaryType == 'cyclic') nsfillouter=.true. + if (present(fillValue)) then fill = fillValue + ! always fill outer boundary if fillValue is passed + ewfillouter = .true. + nsfillouter = .true. else fill = 0_int_kind endif @@ -2451,25 +2802,74 @@ subroutine ice_HaloUpdate3DI4(array, halo, & !----------------------------------------------------------------------- ! -! fill out halo region -! needed for masked halos to ensure halo values are filled for +! Fill out halo region +! Needed for masked halos to ensure halo values are filled for ! halo grid cells that are not updated +! In general, do NOT fill outer boundary for open boundary conditions +! because do not want to overwrite existing data ! !----------------------------------------------------------------------- + ! fill outer boundary as needed + ! only fill corners if both edges are being filled do iblk = 1, halo%numLocalBlocks - call get_block_parameter(halo%blockGlobalID(iblk), & - ilo=ilo, ihi=ihi, & - jlo=jlo, jhi=jhi) - do j = 1,nghost - array(1:nx_block, jlo-j,:,iblk) = fill - array(1:nx_block, jhi+j,:,iblk) = fill - enddo - do i = 1,nghost - array(ilo-i, 1:ny_block,:,iblk) = fill - array(ihi+i, 1:ny_block,:,iblk) = fill - enddo - enddo + call get_block_parameter(halo%blockGlobalID(iblk), & + ilo=ilo, ihi=ihi, & + jlo=jlo, jhi=jhi, & + iblock=iblock, jblock=jblock) + if (ewfillouter .or. iblock > 1) then ! west edge + do i = 1,nghost + array(ilo-i, jlo:jhi, :, iblk) = fill + enddo + endif + if (ewfillouter .or. iblock < nblocks_x) then ! east edge + do i = 1,nghost + array(ihi+i, jlo:jhi, :, iblk) = fill + enddo + endif + if (nsfillouter .or. jblock > 1) then ! south edge + do j = 1,nghost + array(ilo:ihi, jlo-j, :, iblk) = fill + enddo + endif + if (nsfillouter .or. jblock < nblocks_y) then ! north edge + do j = 1,nghost + array(ilo:ihi, jhi+j, :, iblk) = fill + enddo + endif + if ((ewfillouter .or. iblock > 1) .and. & ! southwest corner + (nsfillouter .or. jblock > 1)) then + do j = 1,nghost + do i = 1,nghost + array(ilo-i, jlo-j, :, iblk) = fill + enddo + enddo + endif + if ((ewfillouter .or. iblock > 1) .and. & ! northwest corner + (nsfillouter .or. jblock < nblocks_y)) then + do j = 1,nghost + do i = 1,nghost + array(ilo-i, jhi+j, :, iblk) = fill + enddo + enddo + endif + if ((ewfillouter .or. iblock < nblocks_x) .and. & ! southeast corner + (nsfillouter .or. jblock > 1)) then + do j = 1,nghost + do i = 1,nghost + array(ihi+i, jlo-j, :, iblk) = fill + enddo + enddo + endif + if ((ewfillouter .or. iblock < nblocks_x) .and. & ! northeast corner + (nsfillouter .or. jblock < nblocks_y)) then + do j = 1,nghost + do i = 1,nghost + array(ihi+i, jhi+j, :, iblk) = fill + enddo + enddo + endif + enddo ! iblk !----------------------------------------------------------------------- ! @@ -2697,7 +3097,7 @@ subroutine ice_HaloUpdate4DR8(array, halo, & ! This routine updates ghost cells for an input array and is a ! member of a group of routines under the generic interface -! POP\_HaloUpdate. This routine is the specific interface +! ice\_HaloUpdate. This routine is the specific interface ! for 4d horizontal arrays of double precision. type (ice_halo), intent(in) :: & @@ -2725,9 +3125,10 @@ subroutine ice_HaloUpdate4DR8(array, halo, & ! !----------------------------------------------------------------------- - integer (int_kind) :: & + integer (int_kind) :: & i,j,k,l,nmsg, &! dummy loop indices iblk,ilo,ihi,jlo,jhi, &! block sizes for fill + iblock,jblock, &! global block indices nxGlobal, &! global domain size in x (tripole) nz, nt, &! size of array in 3rd,4th dimensions iSrc,jSrc, &! source addresses for message @@ -2741,6 +3142,10 @@ subroutine ice_HaloUpdate4DR8(array, halo, & fill, &! value to use for unknown points x1,x2,xavg ! scalars for enforcing symmetry at U pts + logical (log_kind) :: & + ewfillouter, &! fill outer boundary ew + nsfillouter ! fill outer boundary ns + real (dbl_kind), dimension(:,:,:,:), allocatable :: & bufTripole ! 4d tripole buffer @@ -2769,8 +3174,20 @@ subroutine ice_HaloUpdate4DR8(array, halo, & ! !----------------------------------------------------------------------- + ewfillouter = .false. + nsfillouter = .false. + + ! fill outer boundary if cyclic + if (halo%ewBoundaryType == 'cyclic') ewfillouter=.true. + if (halo%nsBoundaryType == 'tripole' .or. & + halo%nsBoundaryType == 'tripoleT' .or. & + halo%nsBoundaryType == 'cyclic') nsfillouter=.true. + if (present(fillValue)) then fill = fillValue + ! always fill outer boundary if fillValue is passed + ewfillouter = .true. + nsfillouter = .true. else fill = 0.0_dbl_kind endif @@ -2787,25 +3204,74 @@ subroutine ice_HaloUpdate4DR8(array, halo, & !----------------------------------------------------------------------- ! -! fill out halo region -! needed for masked halos to ensure halo values are filled for +! Fill out halo region +! Needed for masked halos to ensure halo values are filled for ! halo grid cells that are not updated +! In general, do NOT fill outer boundary for open boundary conditions +! because do not want to overwrite existing data ! !----------------------------------------------------------------------- + ! fill outer boundary as needed + ! only fill corners if both edges are being filled do iblk = 1, halo%numLocalBlocks - call get_block_parameter(halo%blockGlobalID(iblk), & - ilo=ilo, ihi=ihi, & - jlo=jlo, jhi=jhi) - do j = 1,nghost - array(1:nx_block, jlo-j,:,:,iblk) = fill - array(1:nx_block, jhi+j,:,:,iblk) = fill - enddo - do i = 1,nghost - array(ilo-i, 1:ny_block,:,:,iblk) = fill - array(ihi+i, 1:ny_block,:,:,iblk) = fill - enddo - enddo + call get_block_parameter(halo%blockGlobalID(iblk), & + ilo=ilo, ihi=ihi, & + jlo=jlo, jhi=jhi, & + iblock=iblock, jblock=jblock) + if (ewfillouter .or. iblock > 1) then ! west edge + do i = 1,nghost + array(ilo-i, jlo:jhi, :, :, iblk) = fill + enddo + endif + if (ewfillouter .or. iblock < nblocks_x) then ! east edge + do i = 1,nghost + array(ihi+i, jlo:jhi, :, :, iblk) = fill + enddo + endif + if (nsfillouter .or. jblock > 1) then ! south edge + do j = 1,nghost + array(ilo:ihi, jlo-j, :, :, iblk) = fill + enddo + endif + if (nsfillouter .or. jblock < nblocks_y) then ! north edge + do j = 1,nghost + array(ilo:ihi, jhi+j, :, :, iblk) = fill + enddo + endif + if ((ewfillouter .or. iblock > 1) .and. & ! southwest corner + (nsfillouter .or. jblock > 1)) then + do j = 1,nghost + do i = 1,nghost + array(ilo-i, jlo-j, :, :, iblk) = fill + enddo + enddo + endif + if ((ewfillouter .or. iblock > 1) .and. & ! northwest corner + (nsfillouter .or. jblock < nblocks_y)) then + do j = 1,nghost + do i = 1,nghost + array(ilo-i, jhi+j, :, :, iblk) = fill + enddo + enddo + endif + if ((ewfillouter .or. iblock < nblocks_x) .and. & ! southeast corner + (nsfillouter .or. jblock > 1)) then + do j = 1,nghost + do i = 1,nghost + array(ihi+i, jlo-j, :, :, iblk) = fill + enddo + enddo + endif + if ((ewfillouter .or. iblock < nblocks_x) .and. & ! northeast corner + (nsfillouter .or. jblock < nblocks_y)) then + do j = 1,nghost + do i = 1,nghost + array(ihi+i, jhi+j, :, :, iblk) = fill + enddo + enddo + endif + enddo ! iblk !----------------------------------------------------------------------- ! @@ -3049,7 +3515,7 @@ subroutine ice_HaloUpdate4DR4(array, halo, & ! This routine updates ghost cells for an input array and is a ! member of a group of routines under the generic interface -! POP\_HaloUpdate. This routine is the specific interface +! ice\_HaloUpdate. This routine is the specific interface ! for 4d horizontal arrays of single precision. type (ice_halo), intent(in) :: & @@ -3077,9 +3543,10 @@ subroutine ice_HaloUpdate4DR4(array, halo, & ! !----------------------------------------------------------------------- - integer (int_kind) :: & + integer (int_kind) :: & i,j,k,l,nmsg, &! dummy loop indices iblk,ilo,ihi,jlo,jhi, &! block sizes for fill + iblock,jblock, &! global block indices nxGlobal, &! global domain size in x (tripole) nz, nt, &! size of array in 3rd,4th dimensions iSrc,jSrc, &! source addresses for message @@ -3093,6 +3560,10 @@ subroutine ice_HaloUpdate4DR4(array, halo, & fill, &! value to use for unknown points x1,x2,xavg ! scalars for enforcing symmetry at U pts + logical (log_kind) :: & + ewfillouter, &! fill outer boundary ew + nsfillouter ! fill outer boundary ns + real (real_kind), dimension(:,:,:,:), allocatable :: & bufTripole ! 4d tripole buffer @@ -3121,8 +3592,20 @@ subroutine ice_HaloUpdate4DR4(array, halo, & ! !----------------------------------------------------------------------- + ewfillouter = .false. + nsfillouter = .false. + + ! fill outer boundary if cyclic + if (halo%ewBoundaryType == 'cyclic') ewfillouter=.true. + if (halo%nsBoundaryType == 'tripole' .or. & + halo%nsBoundaryType == 'tripoleT' .or. & + halo%nsBoundaryType == 'cyclic') nsfillouter=.true. + if (present(fillValue)) then fill = fillValue + ! always fill outer boundary if fillValue is passed + ewfillouter = .true. + nsfillouter = .true. else fill = 0.0_real_kind endif @@ -3139,25 +3622,74 @@ subroutine ice_HaloUpdate4DR4(array, halo, & !----------------------------------------------------------------------- ! -! fill out halo region -! needed for masked halos to ensure halo values are filled for +! Fill out halo region +! Needed for masked halos to ensure halo values are filled for ! halo grid cells that are not updated +! In general, do NOT fill outer boundary for open boundary conditions +! because do not want to overwrite existing data ! !----------------------------------------------------------------------- + ! fill outer boundary as needed + ! only fill corners if both edges are being filled do iblk = 1, halo%numLocalBlocks - call get_block_parameter(halo%blockGlobalID(iblk), & - ilo=ilo, ihi=ihi, & - jlo=jlo, jhi=jhi) - do j = 1,nghost - array(1:nx_block, jlo-j,:,:,iblk) = fill - array(1:nx_block, jhi+j,:,:,iblk) = fill - enddo - do i = 1,nghost - array(ilo-i, 1:ny_block,:,:,iblk) = fill - array(ihi+i, 1:ny_block,:,:,iblk) = fill - enddo - enddo + call get_block_parameter(halo%blockGlobalID(iblk), & + ilo=ilo, ihi=ihi, & + jlo=jlo, jhi=jhi, & + iblock=iblock, jblock=jblock) + if (ewfillouter .or. iblock > 1) then ! west edge + do i = 1,nghost + array(ilo-i, jlo:jhi, :, :, iblk) = fill + enddo + endif + if (ewfillouter .or. iblock < nblocks_x) then ! east edge + do i = 1,nghost + array(ihi+i, jlo:jhi, :, :, iblk) = fill + enddo + endif + if (nsfillouter .or. jblock > 1) then ! south edge + do j = 1,nghost + array(ilo:ihi, jlo-j, :, :, iblk) = fill + enddo + endif + if (nsfillouter .or. jblock < nblocks_y) then ! north edge + do j = 1,nghost + array(ilo:ihi, jhi+j, :, :, iblk) = fill + enddo + endif + if ((ewfillouter .or. iblock > 1) .and. & ! southwest corner + (nsfillouter .or. jblock > 1)) then + do j = 1,nghost + do i = 1,nghost + array(ilo-i, jlo-j, :, :, iblk) = fill + enddo + enddo + endif + if ((ewfillouter .or. iblock > 1) .and. & ! northwest corner + (nsfillouter .or. jblock < nblocks_y)) then + do j = 1,nghost + do i = 1,nghost + array(ilo-i, jhi+j, :, :, iblk) = fill + enddo + enddo + endif + if ((ewfillouter .or. iblock < nblocks_x) .and. & ! southeast corner + (nsfillouter .or. jblock > 1)) then + do j = 1,nghost + do i = 1,nghost + array(ihi+i, jlo-j, :, :, iblk) = fill + enddo + enddo + endif + if ((ewfillouter .or. iblock < nblocks_x) .and. & ! northeast corner + (nsfillouter .or. jblock < nblocks_y)) then + do j = 1,nghost + do i = 1,nghost + array(ihi+i, jhi+j, :, :, iblk) = fill + enddo + enddo + endif + enddo ! iblk !----------------------------------------------------------------------- ! @@ -3401,7 +3933,7 @@ subroutine ice_HaloUpdate4DI4(array, halo, & ! This routine updates ghost cells for an input array and is a ! member of a group of routines under the generic interface -! POP\_HaloUpdate. This routine is the specific interface +! ice\_HaloUpdate. This routine is the specific interface ! for 4d horizontal integer arrays. type (ice_halo), intent(in) :: & @@ -3429,9 +3961,10 @@ subroutine ice_HaloUpdate4DI4(array, halo, & ! !----------------------------------------------------------------------- - integer (int_kind) :: & + integer (int_kind) :: & i,j,k,l,nmsg, &! dummy loop indices iblk,ilo,ihi,jlo,jhi, &! block sizes for fill + iblock,jblock, &! global block indices nxGlobal, &! global domain size in x (tripole) nz, nt, &! size of array in 3rd,4th dimensions iSrc,jSrc, &! source addresses for message @@ -3445,6 +3978,10 @@ subroutine ice_HaloUpdate4DI4(array, halo, & fill, &! value to use for unknown points x1,x2,xavg ! scalars for enforcing symmetry at U pts + logical (log_kind) :: & + ewfillouter, &! fill outer boundary ew + nsfillouter ! fill outer boundary ns + integer (int_kind), dimension(:,:,:,:), allocatable :: & bufTripole ! 4d tripole buffer @@ -3473,8 +4010,20 @@ subroutine ice_HaloUpdate4DI4(array, halo, & ! !----------------------------------------------------------------------- + ewfillouter = .false. + nsfillouter = .false. + + ! fill outer boundary if cyclic + if (halo%ewBoundaryType == 'cyclic') ewfillouter=.true. + if (halo%nsBoundaryType == 'tripole' .or. & + halo%nsBoundaryType == 'tripoleT' .or. & + halo%nsBoundaryType == 'cyclic') nsfillouter=.true. + if (present(fillValue)) then fill = fillValue + ! always fill outer boundary if fillValue is passed + ewfillouter = .true. + nsfillouter = .true. else fill = 0_int_kind endif @@ -3491,25 +4040,74 @@ subroutine ice_HaloUpdate4DI4(array, halo, & !----------------------------------------------------------------------- ! -! fill out halo region -! needed for masked halos to ensure halo values are filled for +! Fill out halo region +! Needed for masked halos to ensure halo values are filled for ! halo grid cells that are not updated +! In general, do NOT fill outer boundary for open boundary conditions +! because do not want to overwrite existing data ! !----------------------------------------------------------------------- + ! fill outer boundary as needed + ! only fill corners if both edges are being filled do iblk = 1, halo%numLocalBlocks - call get_block_parameter(halo%blockGlobalID(iblk), & - ilo=ilo, ihi=ihi, & - jlo=jlo, jhi=jhi) - do j = 1,nghost - array(1:nx_block, jlo-j,:,:,iblk) = fill - array(1:nx_block, jhi+j,:,:,iblk) = fill - enddo - do i = 1,nghost - array(ilo-i, 1:ny_block,:,:,iblk) = fill - array(ihi+i, 1:ny_block,:,:,iblk) = fill - enddo - enddo + call get_block_parameter(halo%blockGlobalID(iblk), & + ilo=ilo, ihi=ihi, & + jlo=jlo, jhi=jhi, & + iblock=iblock, jblock=jblock) + if (ewfillouter .or. iblock > 1) then ! west edge + do i = 1,nghost + array(ilo-i, jlo:jhi, :, :, iblk) = fill + enddo + endif + if (ewfillouter .or. iblock < nblocks_x) then ! east edge + do i = 1,nghost + array(ihi+i, jlo:jhi, :, :, iblk) = fill + enddo + endif + if (nsfillouter .or. jblock > 1) then ! south edge + do j = 1,nghost + array(ilo:ihi, jlo-j, :, :, iblk) = fill + enddo + endif + if (nsfillouter .or. jblock < nblocks_y) then ! north edge + do j = 1,nghost + array(ilo:ihi, jhi+j, :, :, iblk) = fill + enddo + endif + if ((ewfillouter .or. iblock > 1) .and. & ! southwest corner + (nsfillouter .or. jblock > 1)) then + do j = 1,nghost + do i = 1,nghost + array(ilo-i, jlo-j, :, :, iblk) = fill + enddo + enddo + endif + if ((ewfillouter .or. iblock > 1) .and. & ! northwest corner + (nsfillouter .or. jblock < nblocks_y)) then + do j = 1,nghost + do i = 1,nghost + array(ilo-i, jhi+j, :, :, iblk) = fill + enddo + enddo + endif + if ((ewfillouter .or. iblock < nblocks_x) .and. & ! southeast corner + (nsfillouter .or. jblock > 1)) then + do j = 1,nghost + do i = 1,nghost + array(ihi+i, jlo-j, :, :, iblk) = fill + enddo + enddo + endif + if ((ewfillouter .or. iblock < nblocks_x) .and. & ! northeast corner + (nsfillouter .or. jblock < nblocks_y)) then + do j = 1,nghost + do i = 1,nghost + array(ihi+i, jhi+j, :, :, iblk) = fill + enddo + enddo + endif + enddo ! iblk !----------------------------------------------------------------------- ! @@ -4778,15 +5376,15 @@ end subroutine ice_HaloMsgCreate subroutine ice_HaloExtrapolate2DR8(ARRAY,dist,ew_bndy_type,ns_bndy_type) -! This subroutine extrapolates ARRAY values into the first row or column -! of ghost cells, and is intended for grid variables whose ghost cells +! This subroutine extrapolates ARRAY values into the ghost cells, +! and is intended for grid variables whose ghost cells ! would otherwise be set using the default boundary conditions (Dirichlet ! or Neumann). -! Note: This routine will need to be modified for nghost > 1. -! We assume padding occurs only on east and north edges. ! ! This is the specific interface for double precision arrays ! corresponding to the generic interface ice_HaloExtrapolate +! +! T.Craig, Oct 2025 - extend to nghost > 1 use ice_blocks, only: block, nblocks_x, nblocks_y, get_block use ice_constants, only: c2 @@ -4809,8 +5407,9 @@ subroutine ice_HaloExtrapolate2DR8(ARRAY,dist,ew_bndy_type,ns_bndy_type) !----------------------------------------------------------------------- integer (int_kind) :: & - i,j,iblk, &! dummy loop indices - numBlocks, &! number of local blocks + i,j,n,iblk,ii,jj, &! dummy loop indices + ilo,ihi,jlo,jhi, &! active block indices + numBlocks, &! number of local blocks blockID, &! block location ibc ! ghost cell column or row @@ -4831,32 +5430,40 @@ subroutine ice_HaloExtrapolate2DR8(ARRAY,dist,ew_bndy_type,ns_bndy_type) do iblk = 1, numBlocks call ice_distributionGetBlockID(dist, iblk, blockID) this_block = get_block(blockID, blockID) + ilo = this_block%ilo + ihi = this_block%ihi + jlo = this_block%jlo + jhi = this_block%jhi if (this_block%iblock == 1) then ! west edge if (trim(ew_bndy_type) /= 'cyclic') then + do n = 1, nghost + ii = ilo - n ! gridcell to extrapolate to do j = 1, ny_block - ARRAY(1,j,iblk) = c2*ARRAY(2,j,iblk) - ARRAY(3,j,iblk) + ARRAY(ii,j,iblk) = c2*ARRAY(ii+1,j,iblk) - ARRAY(ii+2,j,iblk) + enddo enddo endif endif if (this_block%iblock == nblocks_x) then ! east edge if (trim(ew_bndy_type) /= 'cyclic') then - ! locate ghost cell column (avoid padding) - ibc = nx_block - do i = nx_block, nghost + 1, -1 - if (this_block%i_glob(i) == 0) ibc = ibc - 1 - enddo + do n = 1, nghost + ii = ihi + n ! gridcell to extrapolate to do j = 1, ny_block - ARRAY(ibc,j,iblk) = c2*ARRAY(ibc-1,j,iblk) - ARRAY(ibc-2,j,iblk) + ARRAY(ii,j,iblk) = c2*ARRAY(ii-1,j,iblk) - ARRAY(ii-2,j,iblk) + enddo enddo endif endif if (this_block%jblock == 1) then ! south edge if (trim(ns_bndy_type) /= 'cyclic') then + do n = 1, nghost + jj = jlo - n ! gridcell to extrapolate to do i = 1, nx_block - ARRAY(i,1,iblk) = c2*ARRAY(i,2,iblk) - ARRAY(i,3,iblk) + ARRAY(i,jj,iblk) = c2*ARRAY(i,jj+1,iblk) - ARRAY(i,jj+2,iblk) + enddo enddo endif endif @@ -4865,13 +5472,11 @@ subroutine ice_HaloExtrapolate2DR8(ARRAY,dist,ew_bndy_type,ns_bndy_type) if (trim(ns_bndy_type) /= 'cyclic' .and. & trim(ns_bndy_type) /= 'tripole' .and. & trim(ns_bndy_type) /= 'tripoleT' ) then - ! locate ghost cell column (avoid padding) - ibc = ny_block - do j = ny_block, nghost + 1, -1 - if (this_block%j_glob(j) == 0) ibc = ibc - 1 - enddo + do n = 1, nghost + jj = jhi + n ! gridcell to extrapolate to do i = 1, nx_block - ARRAY(i,ibc,iblk) = c2*ARRAY(i,ibc-1,iblk) - ARRAY(i,ibc-2,iblk) + ARRAY(i,jj,iblk) = c2*ARRAY(i,jj-1,iblk) - ARRAY(i,jj-2,iblk) + enddo enddo endif endif diff --git a/cicecore/cicedyn/infrastructure/comm/serial/ice_gather_scatter.F90 b/cicecore/cicedyn/infrastructure/comm/serial/ice_gather_scatter.F90 index 5f4938281..be1845e56 100644 --- a/cicecore/cicedyn/infrastructure/comm/serial/ice_gather_scatter.F90 +++ b/cicecore/cicedyn/infrastructure/comm/serial/ice_gather_scatter.F90 @@ -925,80 +925,40 @@ subroutine scatter_global_dbl(ARRAY, ARRAY_G, src_task, dst_dist, & this_block = get_block(n,n) dst_block = dst_dist%blockLocalID(n) - !*** if this is an interior block, then there is no - !*** padding or update checking required - - if (this_block%iblock > 1 .and. & - this_block%iblock < nblocks_x .and. & - this_block%jblock > 1 .and. & - this_block%jblock < nblocks_y) then - - do j=1,ny_block - do i=1,nx_block - ARRAY(i,j,dst_block) = ARRAY_G(this_block%i_glob(i),& - this_block%j_glob(j)) - end do - end do - - !*** if this is an edge block but not a northern edge - !*** we only need to check for closed boundaries and - !*** padding (global index = 0) - - else if (this_block%jblock /= nblocks_y) then - - do j=1,ny_block - if (this_block%j_glob(j) /= 0) then - do i=1,nx_block - if (this_block%i_glob(i) /= 0) then - ARRAY(i,j,dst_block) = ARRAY_G(this_block%i_glob(i),& - this_block%j_glob(j)) - endif - end do - endif - end do - - !*** if this is a northern edge block, we need to check - !*** for and properly deal with tripole boundaries - - else - - do j=1,ny_block - if (this_block%j_glob(j) > 0) then ! normal boundary - - do i=1,nx_block - if (this_block%i_glob(i) /= 0) then - ARRAY(i,j,dst_block) = ARRAY_G(this_block%i_glob(i),& - this_block%j_glob(j)) - endif - end do - - else if (this_block%j_glob(j) < 0) then ! tripole - - ! for yoffset=0 or 1, yoffset2=0,0 - ! for yoffset=-1, yoffset2=0,1, for u-rows on T-fold grid - do yoffset2=0,max(yoffset,0)-yoffset - jsrc = ny_global + yoffset + yoffset2 + & - (this_block%j_glob(j) + ny_global) - do i=1,nx_block - if (this_block%i_glob(i) /= 0) then - isrc = nx_global + xoffset - this_block%i_glob(i) - if (isrc < 1) isrc = isrc + nx_global - if (isrc > nx_global) isrc = isrc - nx_global - ARRAY(i,j-yoffset2,dst_block) & - = isign * ARRAY_G(isrc,jsrc) - endif - end do - end do - - endif - end do - - endif + do j=1,ny_block + if (this_block%jblock == nblocks_y .and. this_block%j_glob(j) < 0) then + ! tripole is top block with j_glob < 0 + ! for yoffset=0 or 1, yoffset2=0,0 + ! for yoffset=-1, yoffset2=0,1, for u-rows on T-fold grid + do yoffset2=0,max(yoffset,0)-yoffset + jsrc = ny_global + yoffset + yoffset2 + & + (this_block%j_glob(j) + ny_global) + do i=1,nx_block + if (this_block%i_glob(i) /= 0) then + isrc = nx_global + xoffset - this_block%i_glob(i) + if (isrc < 1) isrc = isrc + nx_global + if (isrc > nx_global) isrc = isrc - nx_global + ARRAY(i,j-yoffset2,dst_block) & + = isign * ARRAY_G(isrc,jsrc) + endif + end do + end do + else + ! normal block + do i=1,nx_block + isrc = this_block%i_glob(i) + jsrc = this_block%j_glob(j) + if (isrc >=1 .and. isrc <= nx_global .and. & + jsrc >=1 .and. jsrc <= ny_global) & + ARRAY(i,j,dst_block) = ARRAY_G(isrc,jsrc) + end do + endif + end do endif ! dst block not land end do ! block loop !----------------------------------------------------------------- - ! Ensure unused ghost cell values are 0 + ! Set ghost cell values to 0 for noupdate !----------------------------------------------------------------- if (field_loc == field_loc_noupdate) then @@ -1173,80 +1133,40 @@ subroutine scatter_global_real(ARRAY, ARRAY_G, src_task, dst_dist, & this_block = get_block(n,n) dst_block = dst_dist%blockLocalID(n) - !*** if this is an interior block, then there is no - !*** padding or update checking required - - if (this_block%iblock > 1 .and. & - this_block%iblock < nblocks_x .and. & - this_block%jblock > 1 .and. & - this_block%jblock < nblocks_y) then - - do j=1,ny_block - do i=1,nx_block - ARRAY(i,j,dst_block) = ARRAY_G(this_block%i_glob(i),& - this_block%j_glob(j)) - end do - end do - - !*** if this is an edge block but not a northern edge - !*** we only need to check for closed boundaries and - !*** padding (global index = 0) - - else if (this_block%jblock /= nblocks_y) then - - do j=1,ny_block - if (this_block%j_glob(j) /= 0) then - do i=1,nx_block - if (this_block%i_glob(i) /= 0) then - ARRAY(i,j,dst_block) = ARRAY_G(this_block%i_glob(i),& - this_block%j_glob(j)) - endif - end do - endif - end do - - !*** if this is a northern edge block, we need to check - !*** for and properly deal with tripole boundaries - - else - - do j=1,ny_block - if (this_block%j_glob(j) > 0) then ! normal boundary - - do i=1,nx_block - if (this_block%i_glob(i) /= 0) then - ARRAY(i,j,dst_block) = ARRAY_G(this_block%i_glob(i),& - this_block%j_glob(j)) - endif - end do - - else if (this_block%j_glob(j) < 0) then ! tripole - - ! for yoffset=0 or 1, yoffset2=0,0 - ! for yoffset=-1, yoffset2=0,1, for u-rows on T-fold grid - do yoffset2=0,max(yoffset,0)-yoffset - jsrc = ny_global + yoffset + yoffset2 + & - (this_block%j_glob(j) + ny_global) - do i=1,nx_block - if (this_block%i_glob(i) /= 0) then - isrc = nx_global + xoffset - this_block%i_glob(i) - if (isrc < 1) isrc = isrc + nx_global - if (isrc > nx_global) isrc = isrc - nx_global - ARRAY(i,j-yoffset2,dst_block) & - = isign * ARRAY_G(isrc,jsrc) - endif - end do - end do - - endif - end do - - endif + do j=1,ny_block + if (this_block%jblock == nblocks_y .and. this_block%j_glob(j) < 0) then + ! tripole is top block with j_glob < 0 + ! for yoffset=0 or 1, yoffset2=0,0 + ! for yoffset=-1, yoffset2=0,1, for u-rows on T-fold grid + do yoffset2=0,max(yoffset,0)-yoffset + jsrc = ny_global + yoffset + yoffset2 + & + (this_block%j_glob(j) + ny_global) + do i=1,nx_block + if (this_block%i_glob(i) /= 0) then + isrc = nx_global + xoffset - this_block%i_glob(i) + if (isrc < 1) isrc = isrc + nx_global + if (isrc > nx_global) isrc = isrc - nx_global + ARRAY(i,j-yoffset2,dst_block) & + = isign * ARRAY_G(isrc,jsrc) + endif + end do + end do + else + ! normal block + do i=1,nx_block + isrc = this_block%i_glob(i) + jsrc = this_block%j_glob(j) + if (isrc >=1 .and. isrc <= nx_global .and. & + jsrc >=1 .and. jsrc <= ny_global) & + ARRAY(i,j,dst_block) = ARRAY_G(isrc,jsrc) + end do + endif + end do endif ! dst block not land end do ! block loop !----------------------------------------------------------------- - ! Ensure unused ghost cell values are 0 + ! Set ghost cell values to 0 for noupdate !----------------------------------------------------------------- if (field_loc == field_loc_noupdate) then @@ -1421,80 +1341,40 @@ subroutine scatter_global_int(ARRAY, ARRAY_G, src_task, dst_dist, & this_block = get_block(n,n) dst_block = dst_dist%blockLocalID(n) - !*** if this is an interior block, then there is no - !*** padding or update checking required - - if (this_block%iblock > 1 .and. & - this_block%iblock < nblocks_x .and. & - this_block%jblock > 1 .and. & - this_block%jblock < nblocks_y) then - - do j=1,ny_block - do i=1,nx_block - ARRAY(i,j,dst_block) = ARRAY_G(this_block%i_glob(i),& - this_block%j_glob(j)) - end do - end do - - !*** if this is an edge block but not a northern edge - !*** we only need to check for closed boundaries and - !*** padding (global index = 0) - - else if (this_block%jblock /= nblocks_y) then - - do j=1,ny_block - if (this_block%j_glob(j) /= 0) then - do i=1,nx_block - if (this_block%i_glob(i) /= 0) then - ARRAY(i,j,dst_block) = ARRAY_G(this_block%i_glob(i),& - this_block%j_glob(j)) - endif - end do - endif - end do - - !*** if this is a northern edge block, we need to check - !*** for and properly deal with tripole boundaries - - else - - do j=1,ny_block - if (this_block%j_glob(j) > 0) then ! normal boundary - - do i=1,nx_block - if (this_block%i_glob(i) /= 0) then - ARRAY(i,j,dst_block) = ARRAY_G(this_block%i_glob(i),& - this_block%j_glob(j)) - endif - end do - - else if (this_block%j_glob(j) < 0) then ! tripole - - ! for yoffset=0 or 1, yoffset2=0,0 - ! for yoffset=-1, yoffset2=0,1, for u-rows on T-fold grid - do yoffset2=0,max(yoffset,0)-yoffset - jsrc = ny_global + yoffset + yoffset2 + & - (this_block%j_glob(j) + ny_global) - do i=1,nx_block - if (this_block%i_glob(i) /= 0) then - isrc = nx_global + xoffset - this_block%i_glob(i) - if (isrc < 1) isrc = isrc + nx_global - if (isrc > nx_global) isrc = isrc - nx_global - ARRAY(i,j-yoffset2,dst_block) & - = isign * ARRAY_G(isrc,jsrc) - endif - end do - end do - - endif - end do - - endif + do j=1,ny_block + if (this_block%jblock == nblocks_y .and. this_block%j_glob(j) < 0) then + ! tripole is top block with j_glob < 0 + ! for yoffset=0 or 1, yoffset2=0,0 + ! for yoffset=-1, yoffset2=0,1, for u-rows on T-fold grid + do yoffset2=0,max(yoffset,0)-yoffset + jsrc = ny_global + yoffset + yoffset2 + & + (this_block%j_glob(j) + ny_global) + do i=1,nx_block + if (this_block%i_glob(i) /= 0) then + isrc = nx_global + xoffset - this_block%i_glob(i) + if (isrc < 1) isrc = isrc + nx_global + if (isrc > nx_global) isrc = isrc - nx_global + ARRAY(i,j-yoffset2,dst_block) & + = isign * ARRAY_G(isrc,jsrc) + endif + end do + end do + else + ! normal block + do i=1,nx_block + isrc = this_block%i_glob(i) + jsrc = this_block%j_glob(j) + if (isrc >=1 .and. isrc <= nx_global .and. & + jsrc >=1 .and. jsrc <= ny_global) & + ARRAY(i,j,dst_block) = ARRAY_G(isrc,jsrc) + end do + endif + end do endif ! dst block not land end do ! block loop !----------------------------------------------------------------- - ! Ensure unused ghost cell values are 0 + ! Set ghost cell values to 0 for noupdate !----------------------------------------------------------------- if (field_loc == field_loc_noupdate) then @@ -1570,8 +1450,8 @@ subroutine scatter_global_ext(ARRAY, ARRAY_G, src_task, dst_dist) integer (int_kind) :: & i,j,n, &! dummy loop indices + isrc, jsrc, &! source addresses iblk, jblk, &! source addresses - iglb, jglb, &! global indices dst_block ! local block index in dest distribution type (block) :: & @@ -1618,13 +1498,13 @@ subroutine scatter_global_ext(ARRAY, ARRAY_G, src_task, dst_dist) ! southwest corner iblk = i jblk = j - iglb = this_block%i_glob(this_block%ilo)+i-1 - jglb = j - ARRAY(iblk,jblk,dst_block) = ARRAY_G(iglb,jglb) + isrc = this_block%i_glob(this_block%ilo)+i-1 + jsrc = j + ARRAY(iblk,jblk,dst_block) = ARRAY_G(isrc,jsrc) ! southeast corner iblk = this_block%ihi+i - iglb = this_block%i_glob(this_block%ihi)+nghost+i - ARRAY(iblk,jblk,dst_block) = ARRAY_G(iglb,jglb) + isrc = this_block%i_glob(this_block%ihi)+nghost+i + ARRAY(iblk,jblk,dst_block) = ARRAY_G(isrc,jsrc) enddo enddo endif @@ -1639,13 +1519,13 @@ subroutine scatter_global_ext(ARRAY, ARRAY_G, src_task, dst_dist) ! northwest corner iblk = i jblk = this_block%jhi+j - iglb = this_block%i_glob(this_block%ilo)+i-1 - jglb = ny_global+nghost+j - ARRAY(iblk,jblk,dst_block) = ARRAY_G(iglb,jglb) + isrc = this_block%i_glob(this_block%ilo)+i-1 + jsrc = ny_global+nghost+j + ARRAY(iblk,jblk,dst_block) = ARRAY_G(isrc,jsrc) ! northeast corner iblk = this_block%ihi+i - iglb = this_block%i_glob(this_block%ihi)+nghost+i - ARRAY(iblk,jblk,dst_block) = ARRAY_G(iglb,jglb) + isrc = this_block%i_glob(this_block%ihi)+nghost+i + ARRAY(iblk,jblk,dst_block) = ARRAY_G(isrc,jsrc) enddo enddo endif @@ -1661,13 +1541,13 @@ subroutine scatter_global_ext(ARRAY, ARRAY_G, src_task, dst_dist) ! northwest corner iblk = i jblk = this_block%jhi+j - iglb = i - jglb = this_block%j_glob(this_block%jhi)+nghost+j - ARRAY(iblk,jblk,dst_block) = ARRAY_G(iglb,jglb) + isrc = i + jsrc = this_block%j_glob(this_block%jhi)+nghost+j + ARRAY(iblk,jblk,dst_block) = ARRAY_G(isrc,jsrc) ! southwest corner jblk = j - jglb = this_block%j_glob(this_block%jlo)+j-1 - ARRAY(iblk,jblk,dst_block) = ARRAY_G(iglb,jglb) + jsrc = this_block%j_glob(this_block%jlo)+j-1 + ARRAY(iblk,jblk,dst_block) = ARRAY_G(isrc,jsrc) enddo enddo endif @@ -1684,17 +1564,16 @@ subroutine scatter_global_ext(ARRAY, ARRAY_G, src_task, dst_dist) ! northeast corner iblk = this_block%ihi+i jblk = this_block%jhi+j - iglb = nx_global+nghost+i - jglb = this_block%j_glob(this_block%jhi)+nghost+j - ARRAY(iblk,jblk,dst_block) = ARRAY_G(iglb,jglb) + isrc = nx_global+nghost+i + jsrc = this_block%j_glob(this_block%jhi)+nghost+j + ARRAY(iblk,jblk,dst_block) = ARRAY_G(isrc,jsrc) ! southeast corner jblk = j - jglb = this_block%j_glob(this_block%jlo)+j-1 - ARRAY(iblk,jblk,dst_block) = ARRAY_G(iglb,jglb) + jsrc = this_block%j_glob(this_block%jlo)+j-1 + ARRAY(iblk,jblk,dst_block) = ARRAY_G(isrc,jsrc) enddo enddo endif - endif ! dst block not land end do ! block loop @@ -1775,75 +1654,35 @@ subroutine scatter_global_stress(ARRAY, ARRAY_G1, ARRAY_G2, & this_block = get_block(n,n) dst_block = dst_dist%blockLocalID(n) - !*** if this is an interior block, then there is no - !*** padding or update checking required - - if (this_block%iblock > 1 .and. & - this_block%iblock < nblocks_x .and. & - this_block%jblock > 1 .and. & - this_block%jblock < nblocks_y) then - - do j=1,ny_block - do i=1,nx_block - ARRAY(i,j,dst_block) = ARRAY_G1(this_block%i_glob(i),& - this_block%j_glob(j)) - end do - end do - - !*** if this is an edge block but not a northern edge - !*** we only need to check for closed boundaries and - !*** padding (global index = 0) - - else if (this_block%jblock /= nblocks_y) then - - do j=1,ny_block - if (this_block%j_glob(j) /= 0) then - do i=1,nx_block - if (this_block%i_glob(i) /= 0) then - ARRAY(i,j,dst_block) = ARRAY_G1(this_block%i_glob(i),& - this_block%j_glob(j)) - endif - end do - endif - end do - - !*** if this is a northern edge block, we need to check - !*** for and properly deal with tripole boundaries - - else - - do j=1,ny_block - if (this_block%j_glob(j) > 0) then ! normal boundary - - do i=1,nx_block - if (this_block%i_glob(i) /= 0) then - ARRAY(i,j,dst_block) = ARRAY_G1(this_block%i_glob(i),& - this_block%j_glob(j)) - endif - end do - - else if (this_block%j_glob(j) < 0) then ! tripole - - ! for yoffset=0 or 1, yoffset2=0,0 - ! for yoffset=-1, yoffset2=0,1, for u-rows on T-fold grid - do yoffset2=0,max(yoffset,0)-yoffset - jsrc = ny_global + yoffset + yoffset2 + & - (this_block%j_glob(j) + ny_global) - do i=1,nx_block - if (this_block%i_glob(i) /= 0) then - isrc = nx_global + xoffset - this_block%i_glob(i) - if (isrc < 1) isrc = isrc + nx_global - if (isrc > nx_global) isrc = isrc - nx_global - ARRAY(i,j-yoffset2,dst_block) & - = isign * ARRAY_G2(isrc,jsrc) - endif - end do - end do - - endif - end do - - endif + do j=1,ny_block + if (this_block%jblock == nblocks_y .and. this_block%j_glob(j) < 0) then + ! tripole is top block with j_glob < 0 + ! for yoffset=0 or 1, yoffset2=0,0 + ! for yoffset=-1, yoffset2=0,1, for u-rows on T-fold grid + do yoffset2=0,max(yoffset,0)-yoffset + jsrc = ny_global + yoffset + yoffset2 + & + (this_block%j_glob(j) + ny_global) + do i=1,nx_block + if (this_block%i_glob(i) /= 0) then + isrc = nx_global + xoffset - this_block%i_glob(i) + if (isrc < 1) isrc = isrc + nx_global + if (isrc > nx_global) isrc = isrc - nx_global + ARRAY(i,j-yoffset2,dst_block) & + = isign * ARRAY_G2(isrc,jsrc) + endif + end do + end do + else + ! normal block + do i=1,nx_block + isrc = this_block%i_glob(i) + jsrc = this_block%j_glob(j) + if (isrc >=1 .and. isrc <= nx_global .and. & + jsrc >=1 .and. jsrc <= ny_global) & + ARRAY(i,j,dst_block) = ARRAY_G1(isrc,jsrc) + end do + endif + end do endif ! dst block not land end do ! block loop diff --git a/cicecore/cicedyn/infrastructure/ice_blocks.F90 b/cicecore/cicedyn/infrastructure/ice_blocks.F90 index ccaf23999..513f3c06f 100644 --- a/cicecore/cicedyn/infrastructure/ice_blocks.F90 +++ b/cicecore/cicedyn/infrastructure/ice_blocks.F90 @@ -31,7 +31,13 @@ module ice_blocks tripoleTFlag ! tripole boundary is a T-fold integer (int_kind), dimension(:), pointer :: & - i_glob, j_glob ! global domain location for each point + i_glob, j_glob ! global domain location for each point. + ! valid values between 1:nx_global, 1:ny_global. + ! outside that range may occur in the halo with + ! open or closed bcs or on the tripole. + ! by definition, tripole is only on the north + ! boundary and in that case, the j_glob values + ! will be valid j_glob values with minus sign. end type public :: create_blocks ,& @@ -140,9 +146,23 @@ subroutine create_blocks(nx_global, ny_global, ew_boundary_type, & !---------------------------------------------------------------------- ! -! compute number of blocks and cartesian decomposition -! if the requested block size does not divide the global domain -! size evenly, add additional block space to accomodate padding +! Compute number of blocks and cartesian decomposition. +! If the requested block size does not divide the global domain +! size evenly, add additional block space to accomodate padding. +! +! Compute the global indices for each block including on the halo. +! The global indices go from 1:nx_global and 1:ny_global for +! most of the domain including the halo that's in the internal part +! of the domain. On the outer boundaries, the global indices will +! be wrapped around for the 'cyclic' option and will be given a +! negative value on the north tripole. Padded gridcells will be +! given a global index of zero (0). All other cases will extrapolate +! the global index outside of 1:nx_global, 1:ny_global. That means +! the global index will go from -nghost+1:0 on the lower boundary +! and n*_global+1:n*_global+nghost on the upper boundary and the +! haloUpdate and scatter, for instance, will not fill those values +! in those cases. Other boundary condition methods will fill the +! outer halo values in cases where ice exists on those boundaries. ! !---------------------------------------------------------------------- @@ -206,7 +226,7 @@ subroutine create_blocks(nx_global, ny_global, ew_boundary_type, & all_blocks_ij(iblock,jblock) = n do j=1,ny_block - j_global(j,n) = js - nghost + j - 1 + j_global(j,n) = js - nghost + j - 1 ! simple lower to upper counting !*** southern ghost cells @@ -215,13 +235,13 @@ subroutine create_blocks(nx_global, ny_global, ew_boundary_type, & case ('cyclic') j_global(j,n) = j_global(j,n) + ny_global case ('open') - j_global(j,n) = nghost - j + 1 + ! lower to upper case ('closed') - j_global(j,n) = 0 + ! lower to upper case ('tripole') - j_global(j,n) = nghost - j + 1 ! open + ! lower to upper case ('tripoleT') - j_global(j,n) = -j_global(j,n) + 1 ! open + ! lower to upper case default call abort_ice(subname//' ERROR: unknown n-s bndy type') end select @@ -239,13 +259,13 @@ subroutine create_blocks(nx_global, ny_global, ew_boundary_type, & case ('cyclic') j_global(j,n) = j_global(j,n) - ny_global case ('open') - j_global(j,n) = 2*ny_global - j_global(j,n) + 1 + ! lower to upper case ('closed') - j_global(j,n) = 0 + ! lower to upper case ('tripole') - j_global(j,n) = -j_global(j,n) + j_global(j,n) = -j_global(j,n) ! negative case ('tripoleT') - j_global(j,n) = -j_global(j,n) + j_global(j,n) = -j_global(j,n) ! negative case default call abort_ice(subname//' ERROR: unknown n-s bndy type') end select @@ -262,7 +282,7 @@ subroutine create_blocks(nx_global, ny_global, ew_boundary_type, & all_blocks(n)%j_glob => j_global(:,n) do i=1,nx_block - i_global(i,n) = is - nghost + i - 1 + i_global(i,n) = is - nghost + i - 1 ! left to right counting !*** western ghost cells @@ -271,9 +291,9 @@ subroutine create_blocks(nx_global, ny_global, ew_boundary_type, & case ('cyclic') i_global(i,n) = i_global(i,n) + nx_global case ('open') - i_global(i,n) = nghost - i + 1 + ! left to right case ('closed') - i_global(i,n) = 0 + ! left to right case default call abort_ice(subname//' ERROR: unknown e-w bndy type') end select @@ -291,9 +311,9 @@ subroutine create_blocks(nx_global, ny_global, ew_boundary_type, & case ('cyclic') i_global(i,n) = i_global(i,n) - nx_global case ('open') - i_global(i,n) = 2*nx_global - i_global(i,n) + 1 + ! left to right case ('closed') - i_global(i,n) = 0 + ! left to right case default call abort_ice(subname//' ERROR: unknown e-w bndy type') end select diff --git a/cicecore/cicedyn/infrastructure/ice_domain.F90 b/cicecore/cicedyn/infrastructure/ice_domain.F90 index 86d6a1939..9a0941e19 100644 --- a/cicecore/cicedyn/infrastructure/ice_domain.F90 +++ b/cicecore/cicedyn/infrastructure/ice_domain.F90 @@ -44,7 +44,7 @@ module ice_domain nblocks ! actual number of blocks on this processor logical (kind=log_kind), public :: & - close_boundaries + close_boundaries ! deprecated Nov, 2025 integer (int_kind), dimension(:), pointer, public :: & blocks_ice => null() ! block ids for local blocks @@ -371,100 +371,11 @@ subroutine init_domain_distribution(KMTG,ULATG,grid_ice) character(len=*), parameter :: subname = '(init_domain_distribution)' -!---------------------------------------------------------------------- -! -! check that there are at least nghost+1 rows or columns of land cells -! for closed boundary conditions (otherwise grid lengths are zero in -! cells neighboring ocean points). -! -!---------------------------------------------------------------------- - call icepack_query_parameters(puny_out=puny, rad_to_deg_out=rad_to_deg) call icepack_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & file=__FILE__, line=__LINE__) - if (trim(ns_boundary_type) == 'closed') then - call abort_ice(subname//' ERROR: ns_boundary_type = closed not supported', file=__FILE__, line=__LINE__) - allocate(nocn(nblocks_tot)) - nocn = 0 - do n=1,nblocks_tot - this_block = get_block(n,n) - if (this_block%jblock == nblocks_y) then ! north edge - do j = this_block%jhi-1, this_block%jhi - if (this_block%j_glob(j) > 0) then - do i = 1, nx_block - if (this_block%i_glob(i) > 0) then - ig = this_block%i_glob(i) - jg = this_block%j_glob(j) - if (KMTG(ig,jg) > puny) nocn(n) = nocn(n) + 1 - endif - enddo - endif - enddo - endif - if (this_block%jblock == 1) then ! south edge - do j = this_block%jlo, this_block%jlo+1 - if (this_block%j_glob(j) > 0) then - do i = 1, nx_block - if (this_block%i_glob(i) > 0) then - ig = this_block%i_glob(i) - jg = this_block%j_glob(j) - if (KMTG(ig,jg) > puny) nocn(n) = nocn(n) + 1 - endif - enddo - endif - enddo - endif - if (nocn(n) > 0) then - write(nu_diag,*) subname,'ns closed, Not enough land cells along ns edge' - call abort_ice(subname//' ERROR: Not enough land cells along ns edge for ns closed', & - file=__FILE__, line=__LINE__) - endif - enddo - deallocate(nocn) - endif - if (trim(ew_boundary_type) == 'closed') then - call abort_ice(subname//' ERROR: ew_boundary_type = closed not supported', file=__FILE__, line=__LINE__) - allocate(nocn(nblocks_tot)) - nocn = 0 - do n=1,nblocks_tot - this_block = get_block(n,n) - if (this_block%iblock == nblocks_x) then ! east edge - do j = 1, ny_block - if (this_block%j_glob(j) > 0) then - do i = this_block%ihi-1, this_block%ihi - if (this_block%i_glob(i) > 0) then - ig = this_block%i_glob(i) - jg = this_block%j_glob(j) - if (KMTG(ig,jg) > puny) nocn(n) = nocn(n) + 1 - endif - enddo - endif - enddo - endif - if (this_block%iblock == 1) then ! west edge - do j = 1, ny_block - if (this_block%j_glob(j) > 0) then - do i = this_block%ilo, this_block%ilo+1 - if (this_block%i_glob(i) > 0) then - ig = this_block%i_glob(i) - jg = this_block%j_glob(j) - if (KMTG(ig,jg) > puny) nocn(n) = nocn(n) + 1 - endif - enddo - endif - enddo - endif - if (nocn(n) > 0) then - write(nu_diag,*) subname,'ew closed, Not enough land cells along ew edge' - call abort_ice(subname//' ERROR: Not enough land cells along ew edge for ew closed', & - file=__FILE__, line=__LINE__) - endif - enddo - deallocate(nocn) - endif - !---------------------------------------------------------------------- ! ! estimate the amount of work per processor using the topography @@ -519,11 +430,11 @@ subroutine init_domain_distribution(KMTG,ULATG,grid_ice) do n=1,nblocks_tot this_block = get_block(n,n) do j=this_block%jlo,this_block%jhi - if (this_block%j_glob(j) > 0) then + jg = this_block%j_glob(j) + if (jg > 0) then do i=this_block%ilo,this_block%ihi - if (this_block%i_glob(i) > 0) then - ig = this_block%i_glob(i) - jg = this_block%j_glob(j) + ig = this_block%i_glob(i) + if (ig > 0) then ! if (KMTG(ig,jg) > puny) & ! nocn(n) = max(nocn(n),nint(wght(ig,jg)+1.0_dbl_kind)) if (KMTG(ig,jg) > puny) then @@ -544,11 +455,11 @@ subroutine init_domain_distribution(KMTG,ULATG,grid_ice) do n=1,nblocks_tot this_block = get_block(n,n) do j=this_block%jlo,this_block%jhi - if (this_block%j_glob(j) > 0) then + jg = this_block%j_glob(j) + if (jg > 0) then do i=this_block%ilo,this_block%ihi - if (this_block%i_glob(i) > 0) then - ig = this_block%i_glob(i) - jg = this_block%j_glob(j) + ig = this_block%i_glob(i) + if (ig > 0) then if (grid_ice == 'C' .or. grid_ice == 'CD') then ! Have to be careful about block elimination with C/CD ! Use a bigger stencil diff --git a/cicecore/cicedyn/infrastructure/ice_grid.F90 b/cicecore/cicedyn/infrastructure/ice_grid.F90 index d6f306c90..406cff6d2 100644 --- a/cicecore/cicedyn/infrastructure/ice_grid.F90 +++ b/cicecore/cicedyn/infrastructure/ice_grid.F90 @@ -33,11 +33,10 @@ module ice_grid use ice_blocks, only: block, get_block, nx_block, ny_block, nghost use ice_domain_size, only: nx_global, ny_global, max_blocks use ice_domain, only: blocks_ice, nblocks, halo_info, distrb_info, & - ew_boundary_type, ns_boundary_type, init_domain_distribution, & - close_boundaries + ew_boundary_type, ns_boundary_type, init_domain_distribution use ice_fileunits, only: nu_diag, nu_grid, nu_kmt, & get_fileunit, release_fileunit, flush_fileunit - use ice_gather_scatter, only: gather_global, scatter_global + use ice_gather_scatter, only: gather_global, scatter_global, gather_global_ext use ice_read_write, only: ice_read, ice_read_nc, ice_read_global, & ice_read_global_nc, ice_open, ice_open_nc, ice_close_nc, ice_check_nc use ice_timers, only: timer_bound, ice_timer_start, ice_timer_stop @@ -253,7 +252,62 @@ subroutine alloc_grid stat=ierr) if (ierr/=0) call abort_ice(subname//' ERROR: Out of memory1', file=__FILE__, line=__LINE__) + dxT = c0 + dyT = c0 + dxU = c0 + dyU = c0 + dxN = c0 + dyN = c0 + dxE = c0 + dyE = c0 + HTE = c0 + HTN = c0 + tarea = c0 + uarea = c0 + narea = c0 + earea = c0 + tarear = c0 + uarear = c0 + narear = c0 + earear = c0 + tarean = c0 + tareas = c0 + ULON = c0 + ULAT = c0 + TLON = c0 + TLAT = c0 + NLON = c0 + NLAT = c0 + ELON = c0 + ELAT = c0 + ANGLE = c0 + ANGLET = c0 + bathymetry = c0 ocn_gridcell_frac(:,:,:) = -c1 ! special value to start, will be ignored unless set elsewhere + hm = c0 + bm = c0 + uvm = c0 + npm = c0 + epm = c0 + kmt = c0 + tmask = .false. + umask = .false. + umaskCD = .false. + nmask = .false. + emask = .false. + opmask = .false. + lmask_n = .false. + lmask_s = .false. + rndex_global = c0 + lont_bounds = c0 + latt_bounds = c0 + lonu_bounds = c0 + latu_bounds = c0 + lonn_bounds = c0 + latn_bounds = c0 + lone_bounds = c0 + late_bounds = c0 + if (save_ghte_ghtn) then if (my_task == master_task) then @@ -268,6 +322,8 @@ subroutine alloc_grid stat=ierr) endif if (ierr/=0) call abort_ice(subname//' ERROR: Out of memory3', file=__FILE__, line=__LINE__) + G_HTE = c0 + G_HTN = c0 endif end subroutine alloc_grid @@ -369,27 +425,26 @@ subroutine init_grid1 if (my_task == master_task) then allocate(work_mom(nx_global*2+1, ny_global*2+1), stat=ierr) - else - allocate(work_mom(1, 1), stat=ierr) - endif - if (ierr/=0) call abort_ice(subname//' ERROR: Out of memory', file=__FILE__, line=__LINE__) - - fieldname='y' ! use mom y field to fill cice ULAT - call ice_open_nc(grid_file,fid_grid) - call ice_read_global_nc(fid_grid,1,fieldname,work_mom,.true.) - call ice_close_nc(fid_grid) - im = 3 - do i = 1, nx_global - jm = 3 - do j = 1, ny_global - work_g1(i,j) = work_mom(im, jm) - jm = jm + 2 + if (ierr/=0) call abort_ice(subname//' ERROR: Out of memory', file=__FILE__, line=__LINE__) + + fieldname='y' ! use mom y field to fill cice ULAT + call ice_open_nc(grid_file,fid_grid) + call ice_read_global_nc(fid_grid,1,fieldname,work_mom,.true.) + call ice_close_nc(fid_grid) + im = 3 + do i = 1, nx_global + jm = 3 + do j = 1, ny_global + work_g1(i,j) = work_mom(im, jm) + jm = jm + 2 + enddo + im = im + 2 enddo - im = im + 2 - enddo - deallocate(work_mom, stat=ierr) - if (ierr/=0) call abort_ice(subname//' ERROR: Dealloc error', file=__FILE__, line=__LINE__) + deallocate(work_mom, stat=ierr) + if (ierr/=0) call abort_ice(subname//' ERROR: Dealloc error', file=__FILE__, line=__LINE__) + + endif case('pop_nc', 'geosnc') @@ -596,14 +651,8 @@ subroutine init_grid2 !----------------------------------------------------------------- if (trim(grid_format) /= 'mom_nc') then - !$OMP PARALLEL DO PRIVATE(iblk,i,j,ilo,ihi,jlo,jhi,this_block) + !$OMP PARALLEL DO PRIVATE(iblk,i,j) do iblk = 1, nblocks - this_block = get_block(blocks_ice(iblk),iblk) - ilo = this_block%ilo - ihi = this_block%ihi - jlo = this_block%jlo - jhi = this_block%jhi - do j = 1,ny_block do i = 1,nx_block tarea(i,j,iblk) = dxT(i,j,iblk)*dyT(i,j,iblk) @@ -616,13 +665,8 @@ subroutine init_grid2 !$OMP END PARALLEL DO endif - !$OMP PARALLEL DO PRIVATE(iblk,i,j,ilo,ihi,jlo,jhi,this_block) + !$OMP PARALLEL DO PRIVATE(iblk,i,j) do iblk = 1, nblocks - this_block = get_block(blocks_ice(iblk),iblk) - ilo = this_block%ilo - ihi = this_block%ihi - jlo = this_block%jlo - jhi = this_block%jhi do j = 1,ny_block do i = 1,nx_block @@ -960,6 +1004,8 @@ subroutine popgrid call ice_read_global(nu_grid,7,work_g1,'rda8',.true.) ! ANGLE call scatter_global(ANGLE, work_g1, master_task, distrb_info, & field_loc_NEcorner, field_type_angle) + call ice_HaloExtrapolate(ANGLE, distrb_info, & + ew_boundary_type, ns_boundary_type) !----------------------------------------------------------------- ! cell dimensions @@ -1062,6 +1108,8 @@ subroutine popgrid_nc call ice_read_global_nc(fid_grid,1,fieldname,work_g1,diag) ! ANGLE call scatter_global(ANGLE, work_g1, master_task, distrb_info, & field_loc_NEcorner, field_type_angle) + call ice_HaloExtrapolate(ANGLE, distrb_info, & + ew_boundary_type, ns_boundary_type) ! fix ANGLE: roundoff error due to single precision where (ANGLE > pi) ANGLE = pi where (ANGLE < -pi) ANGLE = -pi @@ -1082,16 +1130,22 @@ subroutine popgrid_nc call ice_read_global_nc(fid_grid,1,fieldname,work_g1,diag) call scatter_global(ANGLET, work_g1, master_task, distrb_info, & field_loc_center, field_type_angle) + call ice_HaloExtrapolate(ANGLET, distrb_info, & + ew_boundary_type, ns_boundary_type) where (ANGLET > pi) ANGLET = pi where (ANGLET < -pi) ANGLET = -pi fieldname="tlon" call ice_read_global_nc(fid_grid,1,fieldname,work_g1,diag) call scatter_global(TLON, work_g1, master_task, distrb_info, & field_loc_center, field_type_scalar) + call ice_HaloExtrapolate(TLON, distrb_info, & + ew_boundary_type, ns_boundary_type) fieldname="tlat" call ice_read_global_nc(fid_grid,1,fieldname,work_g1,diag) call scatter_global(TLAT, work_g1, master_task, distrb_info, & field_loc_center, field_type_scalar) + call ice_HaloExtrapolate(TLAT, distrb_info, & + ew_boundary_type, ns_boundary_type) endif !----------------------------------------------------------------- ! cell dimensions @@ -1488,9 +1542,13 @@ subroutine mom_grid call mom_grid_rotation_angle(G_ULON, G_ULAT, G_TLON(1:nx_global,1:ny_global), work_g1) ! anglet call scatter_global(ANGLET, work_g1, master_task, distrb_info, & field_loc_center, field_type_angle) + call ice_HaloExtrapolate(ANGLET, distrb_info, & + ew_boundary_type, ns_boundary_type) call mom_grid_rotation_angle(G_TLON, G_TLAT, G_ULON(2:nx_global+1,2:ny_global+1), work_g1) ! angle call scatter_global(ANGLE, work_g1, master_task, distrb_info, & field_loc_NEcorner, field_type_angle) + call ice_HaloExtrapolate(ANGLE, distrb_info, & + ew_boundary_type, ns_boundary_type) deallocate(work_g1, G_ULAT, G_TLAT, G_TLON, G_ULON, stat=ierr) if (ierr/=0) call abort_ice(subname//' ERROR: Dealloc error', file=__FILE__, line=__LINE__) @@ -1793,26 +1851,28 @@ subroutine mom_dx(work_mom) jm1 = jm1 + 2 ; jm2 = jm2 + 2 enddo endif - - if (save_ghte_ghtn) then - do j = 1, ny_global - do i = 1, nx_global - G_HTN(i+nghost,j+nghost) = G_dxN(i,j) - enddo - enddo - call global_ext_halo(G_HTN) - endif endif call scatter_global(dxT, G_dxT, master_task, distrb_info, & field_loc_center, field_type_scalar) + call ice_HaloExtrapolate(dxT, distrb_info, & + ew_boundary_type, ns_boundary_type) call scatter_global(HTN, G_dxN, master_task, distrb_info, & field_loc_Nface, field_type_scalar) + call ice_HaloExtrapolate(HTN, distrb_info, & + ew_boundary_type, ns_boundary_type) + if (save_ghte_ghtn) then + call gather_global_ext(G_HTN, HTN, master_task, distrb_info) + endif dxN(:,:,:) = HTN(:,:,:) call scatter_global(dxE, G_dxE, master_task, distrb_info, & field_loc_center, field_type_scalar) + call ice_HaloExtrapolate(dxE, distrb_info, & + ew_boundary_type, ns_boundary_type) call scatter_global(dxU, G_dxU, master_task, distrb_info, & field_loc_NEcorner, field_type_scalar) + call ice_HaloExtrapolate(dxU, distrb_info, & + ew_boundary_type, ns_boundary_type) deallocate(G_dxT, G_dxE, G_dxU, G_dxN, stat=ierr) if (ierr/=0) call abort_ice(subname//' ERROR: Dealloc error', file=__FILE__, line=__LINE__) @@ -1891,26 +1951,28 @@ subroutine mom_dy(work_mom) im1 = im1 + 2 ; im2 = im2 + 2 enddo endif - - if (save_ghte_ghtn) then - do j = 1, ny_global - do i = 1, nx_global - G_HTE(i+nghost,j+nghost) = G_dyE(i,j) - enddo - enddo - call global_ext_halo(G_HTE) - endif endif call scatter_global(dyT, G_dyT, master_task, distrb_info, & - field_loc_center, field_type_scalar) + field_loc_center, field_type_scalar) + call ice_HaloExtrapolate(dyT, distrb_info, & + ew_boundary_type, ns_boundary_type) call scatter_global(dyN, G_dyN, master_task, distrb_info, & field_loc_Nface, field_type_scalar) + call ice_HaloExtrapolate(dyN, distrb_info, & + ew_boundary_type, ns_boundary_type) call scatter_global(HTE, G_dyE, master_task, distrb_info, & field_loc_center, field_type_scalar) + call ice_HaloExtrapolate(HTE, distrb_info, & + ew_boundary_type, ns_boundary_type) + if (save_ghte_ghtn) then + call gather_global_ext(G_HTE, HTE, master_task, distrb_info) + endif dyE(:,:,:) = HTE(:,:,:) call scatter_global(dyU, G_dyU, master_task, distrb_info, & field_loc_NEcorner, field_type_scalar) + call ice_HaloExtrapolate(dyU, distrb_info, & + ew_boundary_type, ns_boundary_type) deallocate(G_dyT, G_dyN, G_dyE, G_dyU) if (ierr/=0) call abort_ice(subname//' ERROR: Dealloc error', file=__FILE__, line=__LINE__) @@ -2190,6 +2252,8 @@ subroutine geosgrid_nc call ice_read_global_nc(fid_grid,1,fieldname,work_g1,diag) ! ANGLE call scatter_global(ANGLE, work_g1, master_task, distrb_info, & field_loc_NEcorner, field_type_angle) + call ice_HaloExtrapolate(ANGLE, distrb_info, & + ew_boundary_type, ns_boundary_type) ! fix ANGLE: roundoff error due to single precision where (ANGLE > pi) ANGLE = pi where (ANGLE < -pi) ANGLE = -pi @@ -2210,16 +2274,22 @@ subroutine geosgrid_nc call ice_read_global_nc(fid_grid,1,fieldname,work_g1,diag) call scatter_global(ANGLET, work_g1, master_task, distrb_info, & field_loc_center, field_type_angle) + call ice_HaloExtrapolate(ANGLET, distrb_info, & + ew_boundary_type, ns_boundary_type) where (ANGLET > pi) ANGLET = pi where (ANGLET < -pi) ANGLET = -pi fieldname="tlon" call ice_read_global_nc(fid_grid,1,fieldname,work_g1,diag) call scatter_global(TLON, work_g1, master_task, distrb_info, & field_loc_center, field_type_scalar) + call ice_HaloExtrapolate(TLON, distrb_info, & + ew_boundary_type, ns_boundary_type) fieldname="tlat" call ice_read_global_nc(fid_grid,1,fieldname,work_g1,diag) call scatter_global(TLAT, work_g1, master_task, distrb_info, & field_loc_center, field_type_scalar) + call ice_HaloExtrapolate(TLAT, distrb_info, & + ew_boundary_type, ns_boundary_type) endif !----------------------------------------------------------------- ! cell dimensions @@ -2359,6 +2429,10 @@ subroutine rectgrid call grid_boxislands_kmt(work_g1) + elseif (trim(kmt_type) == 'none') then + + work_g1(:,:) = c1 ! initialize hm as ocean + elseif (trim(kmt_type) == 'channel') then do j = 3,ny_global-2 ! closed top and bottom @@ -2427,12 +2501,14 @@ subroutine rectgrid endif ! kmt_type - if (close_boundaries) then - work_g1(:, 1:2) = c0 - work_g1(:, ny_global-1:ny_global) = c0 + if (ew_boundary_type == 'closed') then work_g1(1:2, :) = c0 work_g1(nx_global-1:nx_global, :) = c0 endif + if (ns_boundary_type == 'closed') then + work_g1(:, 1:2) = c0 + work_g1(:, ny_global-1:ny_global) = c0 + endif endif @@ -2598,7 +2674,6 @@ subroutine rectgrid_scale_dxdy call ice_HaloExtrapolate(ULAT, distrb_info, & ew_boundary_type, ns_boundary_type) - deallocate(work_g1) end subroutine rectgrid_scale_dxdy @@ -2776,19 +2851,18 @@ subroutine primary_grid_lengths_HTN(work_g) work_g2(i,j) = p5*(work_g(i,j) + work_g(ip1,j)) ! dxU enddo enddo - if (save_ghte_ghtn) then - do j = 1, ny_global - do i = 1,nx_global - G_HTN(i+nghost,j+nghost) = work_g(i,j) - enddo - enddo - call global_ext_halo(G_HTN) - endif endif call scatter_global(HTN, work_g, master_task, distrb_info, & field_loc_Nface, field_type_scalar) + call ice_HaloExtrapolate(HTN, distrb_info, & + ew_boundary_type, ns_boundary_type) + if (save_ghte_ghtn) then + call gather_global_ext(G_HTN, HTN, master_task, distrb_info) + endif call scatter_global(dxU, work_g2, master_task, distrb_info, & field_loc_NEcorner, field_type_scalar) + call ice_HaloExtrapolate(dxU, distrb_info, & + ew_boundary_type, ns_boundary_type) ! dxT = average of 2 neighbor HTNs in j @@ -2805,6 +2879,8 @@ subroutine primary_grid_lengths_HTN(work_g) endif call scatter_global(dxT, work_g2, master_task, distrb_info, & field_loc_center, field_type_scalar) + call ice_HaloExtrapolate(dxT, distrb_info, & + ew_boundary_type, ns_boundary_type) ! dxN = HTN @@ -2832,6 +2908,8 @@ subroutine primary_grid_lengths_HTN(work_g) endif call scatter_global(dxE, work_g2, master_task, distrb_info, & field_loc_center, field_type_scalar) + call ice_HaloExtrapolate(dxE, distrb_info, & + ew_boundary_type, ns_boundary_type) deallocate(work_g2, stat=ierr) if (ierr/=0) call abort_ice(subname//' ERROR: Dealloc error', file=__FILE__, line=__LINE__) @@ -2887,19 +2965,18 @@ subroutine primary_grid_lengths_HTE(work_g) work_g2(i,ny_global) = c2*work_g(i,ny_global-1) - work_g(i,ny_global-2) ! dyU enddo endif - if (save_ghte_ghtn) then - do j = 1, ny_global - do i = 1, nx_global - G_HTE(i+nghost,j+nghost) = work_g(i,j) - enddo - enddo - call global_ext_halo(G_HTE) - endif endif call scatter_global(HTE, work_g, master_task, distrb_info, & field_loc_Eface, field_type_scalar) + call ice_HaloExtrapolate(HTE, distrb_info, & + ew_boundary_type, ns_boundary_type) + if (save_ghte_ghtn) then + call gather_global_ext(G_HTE, HTE, master_task, distrb_info) + endif call scatter_global(dyU, work_g2, master_task, distrb_info, & field_loc_NEcorner, field_type_scalar) + call ice_HaloExtrapolate(dyU, distrb_info, & + ew_boundary_type, ns_boundary_type) ! dyT = average of 2 neighbor HTE in i @@ -2915,6 +2992,8 @@ subroutine primary_grid_lengths_HTE(work_g) endif call scatter_global(dyT, work_g2, master_task, distrb_info, & field_loc_center, field_type_scalar) + call ice_HaloExtrapolate(dyT, distrb_info, & + ew_boundary_type, ns_boundary_type) ! dyN = average of 4 neighbor HTEs @@ -2940,6 +3019,8 @@ subroutine primary_grid_lengths_HTE(work_g) endif call scatter_global(dyN, work_g2, master_task, distrb_info, & field_loc_center, field_type_scalar) + call ice_HaloExtrapolate(dyN, distrb_info, & + ew_boundary_type, ns_boundary_type) ! dyE = HTE diff --git a/cicecore/cicedyn/infrastructure/ice_read_write.F90 b/cicecore/cicedyn/infrastructure/ice_read_write.F90 index 784f54f07..62545c3f3 100644 --- a/cicecore/cicedyn/infrastructure/ice_read_write.F90 +++ b/cicecore/cicedyn/infrastructure/ice_read_write.F90 @@ -13,6 +13,7 @@ module ice_read_write + use,intrinsic :: ieee_arithmetic use ice_kinds_mod use ice_constants, only: c0, spval_dbl, & field_loc_noupdate, field_type_noupdate @@ -1139,22 +1140,29 @@ subroutine ice_read_nc_xy(fid, nrec, varname, work, diag, & real (kind=dbl_kind), dimension(:,:), allocatable :: & work_g1 + logical, dimension(:,:), allocatable :: mask + integer (kind=int_kind) :: nx, ny integer (kind=int_kind) :: lnrec ! local value of nrec - lnrec = nrec + logical (kind=log_kind) :: lrestart_ext ! local value of restart_ext - nx = nx_global - ny = ny_global + lnrec = nrec work = c0 ! to satisfy intent(out) attribute + lrestart_ext = .false. if (present(restart_ext)) then - if (restart_ext) then - nx = nx_global + 2*nghost - ny = ny_global + 2*nghost - endif + lrestart_ext = restart_ext + endif + + if (lrestart_ext) then + nx = nx_global + 2*nghost + ny = ny_global + 2*nghost + else + nx = nx_global + ny = ny_global endif if (my_task == master_task) then @@ -1222,10 +1230,17 @@ subroutine ice_read_nc_xy(fid, nrec, varname, work, diag, & ! call ice_check_nc(status, subname//' ERROR: Missing _FillValue', & ! file=__FILE__, line=__LINE__) ! write(nu_diag,*) subname,' missingvalue= ',missingvalue - amin = minval(work_g1) - amax = maxval(work_g1, mask = work_g1 /= missingvalue) - asum = sum (work_g1, mask = work_g1 /= missingvalue) + allocate(mask(nx,ny)) + if ( ieee_is_nan(missingvalue) ) then + mask = ieee_is_nan(work_g1) + else + mask = work_g1 /= missingvalue + endif + amin = minval(work_g1, mask = mask ) + amax = maxval(work_g1, mask = mask ) + asum = sum (work_g1, mask = mask ) write(nu_diag,*) subname,' min, max, sum =', amin, amax, asum, trim(varname) + deallocate(mask) endif !------------------------------------------------------------------- @@ -1233,10 +1248,8 @@ subroutine ice_read_nc_xy(fid, nrec, varname, work, diag, & ! NOTE: Ghost cells are not updated unless field_loc is present. !------------------------------------------------------------------- - if (present(restart_ext)) then - if (restart_ext) then - call scatter_global_ext(work, work_g1, master_task, distrb_info) - endif + if (lrestart_ext) then + call scatter_global_ext(work, work_g1, master_task, distrb_info) else if (present(field_loc)) then call scatter_global(work, work_g1, master_task, distrb_info, & @@ -1320,20 +1333,27 @@ subroutine ice_read_nc_xyz(fid, nrec, varname, work, diag, & real (kind=dbl_kind), dimension(:,:,:), allocatable :: & work_g1 + logical, dimension(:,:), allocatable :: mask + integer (kind=int_kind) :: nx, ny integer (kind=int_kind) :: lnrec ! local value of nrec - lnrec = nrec + logical (kind=log_kind) :: lrestart_ext ! local value of restart_ext - nx = nx_global - ny = ny_global + lnrec = nrec + lrestart_ext = .false. if (present(restart_ext)) then - if (restart_ext) then - nx = nx_global + 2*nghost - ny = ny_global + 2*nghost - endif + lrestart_ext = restart_ext + endif + + if (lrestart_ext) then + nx = nx_global + 2*nghost + ny = ny_global + 2*nghost + else + nx = nx_global + ny = ny_global endif if (my_task == master_task) then @@ -1400,13 +1420,19 @@ subroutine ice_read_nc_xyz(fid, nrec, varname, work, diag, & status = nf90_get_att(fid, varid, "_FillValue", missingvalue) ! call ice_check_nc(status, subname//' ERROR: Missing _FillValue', & ! file=__FILE__, line=__LINE__) -! write(nu_diag,*) subname,' missingvalue= ',missingvalue + allocate(mask(nx,ny)) do n=1,ncat - amin = minval(work_g1(:,:,n)) - amax = maxval(work_g1(:,:,n), mask = work_g1(:,:,n) /= missingvalue) - asum = sum (work_g1(:,:,n), mask = work_g1(:,:,n) /= missingvalue) + if ( ieee_is_nan(missingvalue) ) then + mask = ieee_is_nan(work_g1(:,:,n)) + else + mask = work_g1(:,:,n) /= missingvalue + endif + amin = minval(work_g1(:,:,n), mask = mask ) + amax = maxval(work_g1(:,:,n), mask = mask ) + asum = sum (work_g1(:,:,n), mask = mask ) write(nu_diag,*) subname,' min, max, sum =', amin, amax, asum, trim(varname) enddo + deallocate(mask) endif !------------------------------------------------------------------- @@ -1414,13 +1440,11 @@ subroutine ice_read_nc_xyz(fid, nrec, varname, work, diag, & ! NOTE: Ghost cells are not updated unless field_loc is present. !------------------------------------------------------------------- - if (present(restart_ext)) then - if (restart_ext) then - do n=1,ncat - call scatter_global_ext(work(:,:,n,:), work_g1(:,:,n), & - master_task, distrb_info) - enddo - endif + if (lrestart_ext) then + do n=1,ncat + call scatter_global_ext(work(:,:,n,:), work_g1(:,:,n), & + master_task, distrb_info) + enddo else if (present(field_loc)) then do n=1,ncat @@ -1508,24 +1532,31 @@ subroutine ice_read_nc_xyf(fid, nrec, varname, work, diag, & real (kind=dbl_kind), dimension(:,:,:), allocatable :: & work_g1 + logical, dimension(:,:), allocatable :: mask + integer (kind=int_kind) :: nx, ny integer (kind=int_kind) :: lnrec ! local value of nrec + logical (kind=log_kind) :: lrestart_ext ! local value of restart_ext + character(len=*), parameter :: subname = '(ice_read_nc_xyf)' #ifdef USE_NETCDF lnrec = nrec - nx = nx_global - ny = ny_global - + lrestart_ext = .false. if (present(restart_ext)) then - if (restart_ext) then - nx = nx_global + 2*nghost - ny = ny_global + 2*nghost - endif + lrestart_ext = restart_ext + endif + + if (lrestart_ext) then + nx = nx_global + 2*nghost + ny = ny_global + 2*nghost + else + nx = nx_global + ny = ny_global endif if (my_task == master_task) then @@ -1592,13 +1623,19 @@ subroutine ice_read_nc_xyf(fid, nrec, varname, work, diag, & status = nf90_get_att(fid, varid, "_FillValue", missingvalue) ! call ice_check_nc(status, subname//' ERROR: Missing _FillValue', & ! file=__FILE__, line=__LINE__) -! write(nu_diag,*) subname,' missingvalue= ',missingvalue - do n = 1, nfreq - amin = minval(work_g1(:,:,n)) - amax = maxval(work_g1(:,:,n), mask = work_g1(:,:,n) /= missingvalue) - asum = sum (work_g1(:,:,n), mask = work_g1(:,:,n) /= missingvalue) + allocate(mask(nx,ny)) + do n=1,ncat + if ( ieee_is_nan(missingvalue) ) then + mask = ieee_is_nan(work_g1(:,:,n)) + else + mask = work_g1(:,:,n) /= missingvalue + endif + amin = minval(work_g1(:,:,n), mask = mask ) + amax = maxval(work_g1(:,:,n), mask = mask ) + asum = sum (work_g1(:,:,n), mask = mask ) write(nu_diag,*) subname,' min, max, sum =', amin, amax, asum, trim(varname) enddo + deallocate(mask) endif !------------------------------------------------------------------- @@ -1606,13 +1643,11 @@ subroutine ice_read_nc_xyf(fid, nrec, varname, work, diag, & ! NOTE: Ghost cells are not updated unless field_loc is present. !------------------------------------------------------------------- - if (present(restart_ext)) then - if (restart_ext) then - do n = 1, nfreq - call scatter_global_ext(work(:,:,n,1,:), work_g1(:,:,n), & - master_task, distrb_info) - enddo - endif + if (lrestart_ext) then + do n = 1, nfreq + call scatter_global_ext(work(:,:,n,1,:), work_g1(:,:,n), & + master_task, distrb_info) + enddo else if (present(field_loc)) then do n = 1, nfreq @@ -2188,14 +2223,19 @@ subroutine ice_write_nc_xy(fid, nrec, varid, work, diag, & integer (kind=int_kind) :: nx, ny - nx = nx_global - ny = ny_global + logical (kind=log_kind) :: lrestart_ext ! local value of restart_ext + lrestart_ext = .false. if (present(restart_ext)) then - if (restart_ext) then - nx = nx_global + 2*nghost - ny = ny_global + 2*nghost - endif + lrestart_ext = restart_ext + endif + + if (lrestart_ext) then + nx = nx_global + 2*nghost + ny = ny_global + 2*nghost + else + nx = nx_global + ny = ny_global endif if (present(varname)) then @@ -2210,10 +2250,8 @@ subroutine ice_write_nc_xy(fid, nrec, varid, work, diag, & allocate(work_g1(1,1)) ! to save memory endif - if (present(restart_ext)) then - if (restart_ext) then - call gather_global_ext(work_g1, work, master_task, distrb_info, spc_val=c0) - endif + if (lrestart_ext) then + call gather_global_ext(work_g1, work, master_task, distrb_info, spc_val=c0) else call gather_global(work_g1, work, master_task, distrb_info, spc_val=c0) endif @@ -2312,14 +2350,19 @@ subroutine ice_write_nc_xyz(fid, nrec, varid, work, diag, & integer (kind=int_kind) :: nx, ny - nx = nx_global - ny = ny_global + logical (kind=log_kind) :: lrestart_ext ! local value of restart_ext + lrestart_ext = .false. if (present(restart_ext)) then - if (restart_ext) then - nx = nx_global + 2*nghost - ny = ny_global + 2*nghost - endif + lrestart_ext = restart_ext + endif + + if (lrestart_ext) then + nx = nx_global + 2*nghost + ny = ny_global + 2*nghost + else + nx = nx_global + ny = ny_global endif if (my_task == master_task) then @@ -2328,13 +2371,11 @@ subroutine ice_write_nc_xyz(fid, nrec, varid, work, diag, & allocate(work_g1(1,1,ncat)) ! to save memory endif - if (present(restart_ext)) then - if (restart_ext) then - do n=1,ncat - call gather_global_ext(work_g1(:,:,n), work(:,:,n,:), & - master_task, distrb_info, spc_val=c0) - enddo - endif + if (lrestart_ext) then + do n=1,ncat + call gather_global_ext(work_g1(:,:,n), work(:,:,n,:), & + master_task, distrb_info, spc_val=c0) + enddo else do n=1,ncat call gather_global(work_g1(:,:,n), work(:,:,n,:), & @@ -2638,14 +2679,19 @@ subroutine ice_read_nc_uv(fid, nrec, nzlev, varname, work, diag, & integer (kind=int_kind) :: nx, ny - nx = nx_global - ny = ny_global + logical (kind=log_kind) :: lrestart_ext ! local value of restart_ext + lrestart_ext = .false. if (present(restart_ext)) then - if (restart_ext) then - nx = nx_global + 2*nghost - ny = ny_global + 2*nghost - endif + lrestart_ext = restart_ext + endif + + if (lrestart_ext) then + nx = nx_global + 2*nghost + ny = ny_global + 2*nghost + else + nx = nx_global + ny = ny_global endif if (my_task == master_task) then @@ -2691,10 +2737,8 @@ subroutine ice_read_nc_uv(fid, nrec, nzlev, varname, work, diag, & ! NOTE: Ghost cells are not updated unless field_loc is present. !------------------------------------------------------------------- - if (present(restart_ext)) then - if (restart_ext) then - call scatter_global_ext(work, work_g1, master_task, distrb_info) - endif + if (lrestart_ext) then + call scatter_global_ext(work, work_g1, master_task, distrb_info) else if (present(field_loc)) then call scatter_global(work, work_g1, master_task, distrb_info, & diff --git a/cicecore/cicedyn/infrastructure/ice_restart_driver.F90 b/cicecore/cicedyn/infrastructure/ice_restart_driver.F90 index 8f11f7f5e..1f6f00591 100644 --- a/cicecore/cicedyn/infrastructure/ice_restart_driver.F90 +++ b/cicecore/cicedyn/infrastructure/ice_restart_driver.F90 @@ -25,7 +25,7 @@ module ice_restart_driver field_loc_Eface, field_loc_Nface, & field_type_scalar, field_type_vector use ice_restart_shared, only: restart_dir, pointer_file, & - runid, use_restart_time, lenstr, restart_coszen + runid, use_restart_time, lenstr, restart_coszen, restart_mod use ice_restart use ice_exit, only: abort_ice use ice_fileunits, only: nu_diag, nu_rst_pointer, nu_restart, nu_dump @@ -33,6 +33,8 @@ module ice_restart_driver use icepack_intfc, only: icepack_warnings_flush, icepack_warnings_aborted use icepack_intfc, only: icepack_aggregate use icepack_intfc, only: icepack_query_tracer_indices, icepack_query_tracer_sizes + use icepack_intfc, only: icepack_query_parameters + use icepack_intfc, only: icepack_query_tracer_flags implicit none private @@ -297,6 +299,11 @@ subroutine restartfile (ice_ic) aice0, aicen, vicen, vsnon, trcrn, aice_init, uvel, vvel, & uvelE, vvelE, uvelN, vvelN, & trcr_base, nt_strata, n_trcr_strata + use icepack_itd, only: cleanup_itd !for restart_mod + use ice_arrays_column, only: first_ice, hin_max + use ice_flux, only: fpond, fresh, fsalt, fhocn + use ice_flux_bgc, only: faero_ocn, fiso_ocn, flux_bio + use ice_calendar, only: dt character (*), optional :: ice_ic @@ -308,7 +315,8 @@ subroutine restartfile (ice_ic) nt_Tsfc, nt_sice, nt_qice, nt_qsno logical (kind=log_kind) :: & - diag + diag, & + tr_aero, tr_pond_topo real (kind=dbl_kind), dimension (nx_block,ny_block,max_blocks) :: & work1 @@ -324,6 +332,7 @@ subroutine restartfile (ice_ic) 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) + call icepack_query_tracer_flags(tr_aero_out=tr_aero, tr_pond_topo_out=tr_pond_topo) call icepack_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & file=__FILE__, line=__LINE__) @@ -717,6 +726,76 @@ subroutine restartfile (ice_ic) npt = npt - istep0 endif + !----------------------------------------------------------------- + ! update concentration from a file + !----------------------------------------------------------------- + if (restart_mod /= "none") then + + select case (trim(restart_mod)) + + case('adjust_aice') + call direct_adjust_aice + + case('adjust_aice_test') + call direct_adjust_aice(test=.true.) + + case default + call abort_ice(subname//'ERROR: unsupported restart_mod='//trim(restart_mod), & + file=__FILE__, line=__LINE__) + + end select + + !----------------------------------------------------------------- + ! Ensure ice is binned in correct categories + !----------------------------------------------------------------- + do iblk = 1, nblocks + do j = 1, ny_block + do i = 1, nx_block + if (tmask(i,j,iblk)) then + + call cleanup_itd(dt, hin_max, & + aicen(i,j,:,iblk), trcrn(i,j,:,:,iblk), & + vicen(i,j,:,iblk), vsnon(i,j,:, iblk), & + aice0(i,j, iblk), aice(i,j, iblk), & + tr_aero, tr_pond_topo, & + first_ice(i,j,:,iblk), & + trcr_depend, trcr_base, & + n_trcr_strata, nt_strata, & + fpond = fpond(i,j, iblk), & + fresh = fresh(i,j, iblk), & + fsalt = fsalt(i,j, iblk), & + fhocn = fhocn(i,j, iblk), & + faero_ocn = faero_ocn(i,j,:,iblk), & + fiso_ocn = fiso_ocn(i,j,:,iblk), & + flux_bio = flux_bio(i,j,:,iblk), & + Tf = Tf(i,j, iblk), & + limit_aice = .true. ) + + call icepack_aggregate( & + aicen = aicen(i,j,:,iblk), & + trcrn = trcrn(i,j,:,:,iblk), & + vicen = vicen(i,j,:,iblk), & + vsnon = vsnon(i,j,:,iblk), & + aice = aice (i,j, iblk), & + trcr = trcr (i,j,:,iblk), & + vice = vice (i,j, iblk), & + vsno = vsno (i,j, iblk), & + aice0 = aice0(i,j, iblk), & + trcr_depend = trcr_depend, & + trcr_base = trcr_base, & + n_trcr_strata = n_trcr_strata, & + nt_strata = nt_strata, & + Tf = Tf(i,j,iblk)) + + aice_init(i,j,iblk) = aice(i,j,iblk) + + endif ! tmask + enddo ! i + enddo ! j + enddo ! iblk + + endif !restart_mod + end subroutine restartfile !======================================================================= @@ -1091,6 +1170,310 @@ subroutine restartfile_v4 (ice_ic) end subroutine restartfile_v4 +!======================================================================= + +!======================================================================= +! Direct insertion of ice concentration read from file. +! +! Posey, et. al. 2015: Improving Arctic sea ice edge forecasts by +! assimilating high horizontal resolution sea ice concentration +! data into the US Navy's ice forecast systems. +! The Cryosphere. doi:10.5194/tc-9-1735-2015 +! +! Alan J. Wallcraft, COAPS/FSU, Nov 2024 + + subroutine direct_adjust_aice(test) + + use ice_blocks, only: nghost, nx_block, ny_block + use ice_domain, only: nblocks + use ice_domain_size, only: nilyr, nslyr, ncat, max_blocks + use ice_grid, only: tmask + use ice_communicate, only: my_task, master_task + use ice_constants, only: c0, c1, c4, c20, c100, & + p5, p2, p1, p01, p001, & + field_loc_center, field_loc_NEcorner, & + field_type_scalar, field_type_vector + use ice_fileunits, only: nu_diag + use ice_flux, only: & + Tair, Tf, salinz, Tmltz, sst, & + stressp_1, stressp_2, stressp_3, stressp_4, & + stressm_1, stressm_2, stressm_3, stressm_4, & + stress12_1, stress12_2, stress12_3, stress12_4 + use ice_state, only: & + aice, aicen, vicen, vsnon, trcrn + use ice_read_write, only: ice_check_nc, ice_read_nc, & + ice_open_nc, ice_close_nc + use ice_arrays_column, only: hin_max + ! use icepack_mushy_physics, only: enthalpy_mush + use icepack_intfc, only: icepack_init_trcr + + logical(kind=log_kind), optional, intent(in) :: & + test ! use internally generated aice + + ! --- local variables + real(kind=dbl_kind) :: & + q , & ! scale factor + aice_m, & ! model aice + aice_o, & ! observation aice + aice_t, & ! target aice + aice_i, & ! insert ice + slope, & ! used to compute surf Temp + Ti, & ! target surface temperature + edge_om, & ! nominal ice edge zone + diff_om, & ! allowed model vs obs difference + hin_om, & ! new ice thickness + aicen_old, & ! old value of aice to check when adding ice + vsnon_old, & ! old value of snow volume to check when adding ice + Tsfc ! surface temp. + integer (kind=int_kind) :: & + fid ! file id for netCDF file + integer (kind=int_kind) :: & + i, j, k, n, iblk ! counting indices + logical (kind=log_kind) :: & + diag, & ! diagnostic output + ltest ! local value of test argument + real (kind=dbl_kind), dimension (nx_block,ny_block,max_blocks) :: & + work1 + real (kind=dbl_kind), dimension(nilyr) :: & + qin ! ice enthalpy (J/m3) + real (kind=dbl_kind), dimension(nslyr) :: & + qsn ! snow enthalpy (J/m3) + character(len=char_len_long) :: & + aice_filename, &! filename to read in + aice_fldname ! fieldname to read in + + ! parameters from icepack + real (kind=dbl_kind) :: & + puny, Tffresh, Tsmelt, Lfresh, cp_ice, cp_ocn, & + rhos, rhoi + integer (kind=int_kind) :: & + nt_Tsfc, nt_sice, nt_qice, nt_qsno, & + ktherm + character(len=*), parameter :: subname = '(direct_adjust_aice)' + + diag = .true. + ltest = .false. + if (present(test)) then + ltest = test + endif + aice_filename = trim(restart_dir)//'/sic.nc' + aice_fldname = 'sic' + + ! get parameters from icepack + call icepack_query_parameters( & + puny_out=puny, & + Tffresh_out=Tffresh, & + Tsmelt_out=Tsmelt, & + Lfresh_out=Lfresh, & + cp_ice_out=cp_ice, & + cp_ocn_out=cp_ocn, & + rhos_out=rhos, & + rhoi_out=rhoi, & + ktherm_out=ktherm ) + + 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 ) + + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + + if (ltest) then + if (my_task == master_task) then + write(nu_diag,*) subname//" direct_adjust_aice rounding to nearest 1/20th" + endif + work1 = nint(aice*c20)/c20 ! round to nearest 5/100th + else + if (my_task == master_task) then + write(nu_diag,*) subname//" direct_adjust_aice from "//trim(aice_filename) + endif + + call ice_open_nc(trim(aice_filename), fid) + call ice_read_nc(fid,1,trim(aice_fldname),work1,diag, & + field_loc=field_loc_center, & + field_type=field_type_scalar) + call ice_close_nc(fid) + endif + + edge_om = p2 ! nominal ice edge zone + diff_om = p1 ! allowed model vs obs difference + hin_om = hin_max(1)*0.9_dbl_kind !new ice thickness + + do iblk = 1, nblocks + do j = 1, ny_block + do i = 1, nx_block + + aice_o = work1(i,j,iblk) ! obs. ice concentration + aice_m = aice(i,j,iblk) ! model ice concentration + + if (.not.tmask(i,j,iblk)) then + ! land - do nothing + elseif (aice_o.gt.p01 .and. & + abs(aice_o-aice_m).le.p01) then + ! model and obs are very close - do nothing + elseif (min(aice_o,aice_m).ge.edge_om .and. & + abs(aice_o-aice_m).le.diff_om) then + ! model and obs are close enough - do nothing + elseif (aice_o.eq.aice_m) then + elseif (aice_o.lt.aice_m) then + if (aice_o.lt.p01)then + ! --- remove all ice --- + ! warm sst so the ice won't grow immediately + sst(i,j,iblk) = sst(i,j,iblk) + p2 + do n=1,ncat + aicen(i,j,n,iblk) = c0 + vicen(i,j,n,iblk) = c0 + vsnon(i,j,n,iblk) = c0 + call icepack_init_trcr( & + Tair = Tair(i,j, iblk), & + Tf = Tf(i,j, iblk), & + Sprofile = salinz(i,j,:,iblk), & + Tprofile = Tmltz(i,j,:,iblk), & + Tsfc = Tsfc, & + qin = qin(:), & + qsn = qsn(:) ) + ! surface temperature + trcrn(i,j,nt_Tsfc,n,iblk) = Tsfc ! deg C + ! ice enthalpy, salinity + do k = 1, nilyr + trcrn(i,j,nt_qice+k-1,n,iblk) = qin(k) + trcrn(i,j,nt_sice+k-1,n,iblk) = salinz(i,j,k,iblk) + enddo ! nilyr + ! snow enthalpy + do k = 1, nslyr + trcrn(i,j,nt_qsno+k-1,n,iblk) = qsn(k) + enddo ! nslyr + enddo !n + else !aice_o.ge.p01 + if (aice_o.lt.edge_om) then + ! --- target ice conc. is obs. + aice_t = aice_o + else !aice_m-aice_o.gt.diff_om + ! --- target ice conc. is obs.+diff_om + aice_t = aice_o + diff_om + endif + ! --- reduce ice to the target concentration, + ! completely exhasting ice categories in order --- + aice_i = aice_m - aice_t !>=0.0 + do n=1,ncat + if (aice_i.le.p001) then + exit + elseif (aice_i.ge.aicen(i,j,n,iblk)) then + ! --- remove all of this category + aice_i = aice_i - aicen(i,j,n,iblk) + aicen(i,j,n,iblk) = c0 + vicen(i,j,n,iblk) = c0 + vsnon(i,j,n,iblk) = c0 + call icepack_init_trcr( & + Tair = Tair(i,j, iblk), & + Tf = Tf(i,j, iblk), & + Sprofile = salinz(i,j,:,iblk), & + Tprofile = Tmltz(i,j,:,iblk), & + Tsfc = Tsfc, & + qin = qin(:), & + qsn = qsn(:) ) + ! surface temperature + trcrn(i,j,nt_Tsfc,n,iblk) = Tsfc ! deg C + ! ice enthalpy, salinity + do k = 1, nilyr + trcrn(i,j,nt_qice+k-1,n,iblk) = qin(k) + trcrn(i,j,nt_sice+k-1,n,iblk) = salinz(i,j,k,iblk) + enddo ! nilyr + ! snow enthalpy + do k = 1, nslyr + trcrn(i,j,nt_qsno+k-1,n,iblk) = qsn(k) + enddo ! nslyr + else !aice_i.lt.aicen(i,j,n,iblk) + ! --- remove part of this category + q = (aicen(i,j,n,iblk) - aice_i) & + /aicen(i,j,n,iblk) !<1 + aice_i = c0 + + ! reduce aicen, vicen, vsnon by q + ! do not alter Tsfc since there is already + ! ice here. + aicen(i,j,n,iblk) = q*aicen(i,j,n,iblk) + vicen(i,j,n,iblk) = q*vicen(i,j,n,iblk) + vsnon(i,j,n,iblk) = q*vsnon(i,j,n,iblk) + endif ! aice_i.gt.p001 and aice_i.lt.aicen + enddo ! n + endif ! aice_o.lt.p01 + elseif (aice_o.gt.p01) then ! .and. aice_o.gt.aicen + if (aice_m.lt.edge_om) then + ! --- target ice conc. is obs. + aice_t = aice_o + else !aice_o-aice_m.gt.diff_om + ! --- target ice conc. is obs.-diff_om + aice_t = aice_o - diff_om + endif + q = (aice_t-aice_m) + ! --- add ice to the target concentration, + ! --- with all new ice in category 1 + ! --- cool sst so the ice won't melt immediately + sst( i,j, iblk) = sst( i,j, iblk) - q ! 0 <= q <= 1 + aicen_old = aicen(i,j,1,iblk) ! store to check for zero ice later + vsnon_old = vsnon(i,j,1,iblk) ! store to check for zero snow later + aicen(i,j,1,iblk) = aicen(i,j,1,iblk) + q + vicen(i,j,1,iblk) = vicen(i,j,1,iblk) + q*hin_om + vsnon(i,j,1,iblk) = vsnon(i,j,1,iblk) + q*hin_om*p2 + + ! ------------------------------------------------------ + ! check for zero snow in 1st category. + ! It is possible that there was ice + ! but no snow. This would skip the loop below and an + ! error in snow thermo would occur. If snow was zero + ! specify enthalpy here + ! ------------------------------------------------------ + if (vsnon_old < puny) then + do n=1,1 ! only do 1st category + ! --- snow layers + trcrn(i,j,nt_Tsfc,n,iblk) = & ! Tsfc + min(Tsmelt,Tair(i,j,iblk) - Tffresh) + Ti = min(c0,trcrn(i,j,nt_Tsfc,n,iblk)) + do k=1,nslyr + trcrn(i,j,nt_qsno+k-1,n,iblk) = -rhos*(Lfresh - cp_ice*Ti) + enddo ! k + enddo ! n = 1,1 + endif + + ! ------------------------------------------------------ + ! check for zero aice in 1st category. + ! if adding to an initially zero ice, we must define + ! qice, qsno, sice so thermo does not blow up. + ! ------------------------------------------------------ + if (aicen_old < puny) then + do n =1,1 ! only do 1st category + call icepack_init_trcr( & + Tair = Tair(i,j, iblk), & + Tf = Tf(i,j, iblk), & + Sprofile = salinz(i,j,:,iblk), & + Tprofile = Tmltz(i,j,:,iblk), & + Tsfc = Tsfc, & + qin = qin(:), & + qsn = qsn(:) ) + ! surface temperature + trcrn(i,j,nt_Tsfc,n,iblk) = Tsfc ! deg C + ! ice enthalpy, salinity + do k = 1, nilyr + trcrn(i,j,nt_qice+k-1,n,iblk) = qin(k) + trcrn(i,j,nt_sice+k-1,n,iblk) = salinz(i,j,k,iblk) + enddo + ! snow enthalpy + do k = 1, nslyr + trcrn(i,j,nt_qsno+k-1,n,iblk) = qsn(k) + enddo ! nslyr + enddo ! n + endif ! qice == c0 + endif ! aice_o vs aice_m or tmask + enddo ! j + enddo ! i + enddo ! iblk + + end subroutine direct_adjust_aice + !======================================================================= end module ice_restart_driver diff --git a/cicecore/cicedyn/infrastructure/ice_restoring.F90 b/cicecore/cicedyn/infrastructure/ice_restoring.F90 index b7f1b3971..71c236a8a 100644 --- a/cicecore/cicedyn/infrastructure/ice_restoring.F90 +++ b/cicecore/cicedyn/infrastructure/ice_restoring.F90 @@ -215,7 +215,7 @@ subroutine ice_HaloRestore_init vicen_rest(i,j,n,iblk) = vicen(i,jlo,n,iblk) vsnon_rest(i,j,n,iblk) = vsnon(i,jlo,n,iblk) do nt = 1, ntrcr - trcrn_rest(i,j,nt,n,iblk) = trcrn(ilo,j,nt,n,iblk) + trcrn_rest(i,j,nt,n,iblk) = trcrn(i,jlo,nt,n,iblk) enddo enddo enddo @@ -246,7 +246,7 @@ subroutine ice_HaloRestore_init vicen_rest(i,j,n,iblk) = vicen(i,jhi,n,iblk) vsnon_rest(i,j,n,iblk) = vsnon(i,jhi,n,iblk) do nt = 1, ntrcr - trcrn_rest(i,j,nt,n,iblk) = trcrn(ihi,j,nt,n,iblk) + trcrn_rest(i,j,nt,n,iblk) = trcrn(i,jhi,nt,n,iblk) enddo enddo enddo diff --git a/cicecore/cicedyn/infrastructure/io/io_binary/ice_restart.F90 b/cicecore/cicedyn/infrastructure/io/io_binary/ice_restart.F90 index d8931866a..9ae19f1d9 100644 --- a/cicecore/cicedyn/infrastructure/io/io_binary/ice_restart.F90 +++ b/cicecore/cicedyn/infrastructure/io/io_binary/ice_restart.F90 @@ -9,9 +9,7 @@ module ice_restart use ice_broadcast use ice_kinds_mod - use ice_restart_shared, only: & - restart, restart_ext, restart_dir, restart_file, pointer_file, & - runid, runtype, use_restart_time, lenstr + use ice_restart_shared use ice_communicate, only: my_task, master_task use ice_fileunits, only: nu_diag, nu_rst_pointer use ice_fileunits, only: nu_dump, nu_dump_eap, nu_dump_FY, nu_dump_age @@ -396,6 +394,7 @@ subroutine init_restart_write(filename_spec) nbtrcr ! number of bgc tracers character(len=char_len_long) :: filename + character(len=char_len_long) :: lpointer_file character(len=*), parameter :: subname = '(init_restart_write)' @@ -422,7 +421,13 @@ subroutine init_restart_write(filename_spec) ! write pointer (path/file) if (my_task == master_task) then - open(nu_rst_pointer,file=pointer_file) + lpointer_file = pointer_file + if (pointer_date) then + ! append date to pointer filename + write(lpointer_file,'(a,i4.4,a,i2.2,a,i2.2,a,i5.5)') & + trim(lpointer_file)//'.',myear,'-',mmonth,'-',mday,'-',msec + end if + open(nu_rst_pointer,file=lpointer_file) write(nu_rst_pointer,'(a)') filename close(nu_rst_pointer) if (restart_ext) then diff --git a/cicecore/cicedyn/infrastructure/io/io_netcdf/ice_history_write.F90 b/cicecore/cicedyn/infrastructure/io/io_netcdf/ice_history_write.F90 index d7720cd1e..2d6c5915a 100644 --- a/cicecore/cicedyn/infrastructure/io/io_netcdf/ice_history_write.F90 +++ b/cicecore/cicedyn/infrastructure/io/io_netcdf/ice_history_write.F90 @@ -1287,9 +1287,15 @@ subroutine ice_hist_field_def(ncid, hfield, lprecision, dimids, ns) .and.TRIM(hfield%vname(1:9))/='sistreave' & .and.TRIM(hfield%vname(1:9))/='sistremax' & .and.TRIM(hfield%vname(1:4))/='sigP') then - status = nf90_put_att(ncid,varid,'cell_methods','time: mean') - call ice_check_nc(status, subname// ' ERROR: defining cell methods for '//hfield%vname, & - file=__FILE__, line=__LINE__) + if (hfield%avg_ice_present) then + status = nf90_put_att(ncid,varid,'cell_methods','area: time: mean where sea ice (mask=siconc)') + call ice_check_nc(status, subname// ' ERROR: defining cell methods for '//hfield%vname, & + file=__FILE__, line=__LINE__) + else + status = nf90_put_att(ncid,varid,'cell_methods','time: mean') + call ice_check_nc(status, subname// ' ERROR: defining cell methods for '//hfield%vname, & + file=__FILE__, line=__LINE__) + endif endif endif diff --git a/cicecore/cicedyn/infrastructure/io/io_netcdf/ice_restart.F90 b/cicecore/cicedyn/infrastructure/io/io_netcdf/ice_restart.F90 index 33fd0cd1f..1c25e3f30 100644 --- a/cicecore/cicedyn/infrastructure/io/io_netcdf/ice_restart.F90 +++ b/cicecore/cicedyn/infrastructure/io/io_netcdf/ice_restart.F90 @@ -10,16 +10,14 @@ module ice_restart use ice_broadcast + use ice_constants, only: c0 use ice_communicate, only: my_task, master_task use ice_kinds_mod #ifdef USE_NETCDF use netcdf #endif use ice_read_write, only: ice_check_nc - use ice_restart_shared, only: & - restart_ext, restart_dir, restart_file, pointer_file, & - runid, use_restart_time, lenstr, restart_coszen, restart_format, & - restart_chunksize, restart_deflate + use ice_restart_shared use ice_fileunits, only: nu_diag, nu_rst_pointer use ice_exit, only: abort_ice use icepack_intfc, only: icepack_query_parameters @@ -168,6 +166,7 @@ subroutine init_restart_write(filename_spec) nbtrcr ! number of bgc tracers character(len=char_len_long) :: filename + character(len=char_len_long) :: lpointer_file integer (kind=int_kind), allocatable :: dims(:) @@ -215,7 +214,13 @@ subroutine init_restart_write(filename_spec) ! write pointer (path/file) if (my_task == master_task) then filename = trim(filename) // '.nc' - open(nu_rst_pointer,file=pointer_file) + lpointer_file = pointer_file + if (pointer_date) then + ! append date to pointer filename + write(lpointer_file,'(a,i4.4,a,i2.2,a,i2.2,a,i5.5)') & + trim(lpointer_file)//'.',myear,'-',mmonth,'-',mday,'-',msec + end if + open(nu_rst_pointer,file=lpointer_file) write(nu_rst_pointer,'(a)') filename close(nu_rst_pointer) @@ -744,39 +749,25 @@ subroutine read_restart_field(nu,nrec,work,atype,vname,ndim3, & character(len=*), parameter :: subname = '(read_restart_field)' + work (:,:,:,:) = c0 + work2(:,:,:) = c0 #ifdef USE_NETCDF if (present(field_loc)) then if (ndim3 == ncat) then - if (restart_ext) then - call ice_read_nc(ncid,1,vname,work,diag, & - field_loc=field_loc,field_type=field_type,restart_ext=restart_ext) - else - call ice_read_nc(ncid,1,vname,work,diag,field_loc,field_type) - endif + call ice_read_nc(ncid,1,vname,work,diag, & + field_loc=field_loc,field_type=field_type,restart_ext=restart_ext) elseif (ndim3 == 1) then - if (restart_ext) then - call ice_read_nc(ncid,1,vname,work2,diag, & - field_loc=field_loc,field_type=field_type,restart_ext=restart_ext) - else - call ice_read_nc(ncid,1,vname,work2,diag,field_loc,field_type) - endif + call ice_read_nc(ncid,1,vname,work2,diag, & + field_loc=field_loc,field_type=field_type,restart_ext=restart_ext) work(:,:,1,:) = work2(:,:,:) else write(nu_diag,*) 'ndim3 not supported ',ndim3 endif else if (ndim3 == ncat) then - if (restart_ext) then - call ice_read_nc(ncid, 1, vname, work, diag, restart_ext=restart_ext) - else - call ice_read_nc(ncid, 1, vname, work, diag) - endif + call ice_read_nc(ncid, 1, vname, work, diag, restart_ext=restart_ext) elseif (ndim3 == 1) then - if (restart_ext) then - call ice_read_nc(ncid, 1, vname, work2, diag, restart_ext=restart_ext) - else - call ice_read_nc(ncid, 1, vname, work2, diag) - endif + call ice_read_nc(ncid, 1, vname, work2, diag, restart_ext=restart_ext) work(:,:,1,:) = work2(:,:,:) else write(nu_diag,*) 'ndim3 not supported ',ndim3 @@ -837,18 +828,10 @@ subroutine write_restart_field(nu,nrec,work,atype,vname,ndim3,diag) call ice_check_nc(status, subname//' ERROR: inq varid '//trim(vname), file=__FILE__, line=__LINE__) endif if (ndim3 == ncat) then - if (restart_ext) then - call ice_write_nc(ncid, 1, varid, work, diag, restart_ext, varname=trim(vname)) - else - call ice_write_nc(ncid, 1, varid, work, diag, varname=trim(vname)) - endif + call ice_write_nc(ncid, 1, varid, work, diag, restart_ext, varname=trim(vname)) elseif (ndim3 == 1) then work2(:,:,:) = work(:,:,1,:) - if (restart_ext) then - call ice_write_nc(ncid, 1, varid, work2, diag, restart_ext, varname=trim(vname)) - else - call ice_write_nc(ncid, 1, varid, work2, diag, varname=trim(vname)) - endif + call ice_write_nc(ncid, 1, varid, work2, diag, restart_ext, varname=trim(vname)) else write(nu_diag,*) 'ndim3 not supported',ndim3 endif diff --git a/cicecore/cicedyn/infrastructure/io/io_pio2/ice_history_write.F90 b/cicecore/cicedyn/infrastructure/io/io_pio2/ice_history_write.F90 index d935f2577..f4c6e51db 100644 --- a/cicecore/cicedyn/infrastructure/io/io_pio2/ice_history_write.F90 +++ b/cicecore/cicedyn/infrastructure/io/io_pio2/ice_history_write.F90 @@ -1428,8 +1428,14 @@ subroutine ice_hist_field_def(File, hfield,lprecision, dimids, ns) .and.TRIM(hfield%vname(1:9))/='sistreave' & .and.TRIM(hfield%vname(1:9))/='sistremax' & .and.TRIM(hfield%vname(1:4))/='sigP') then - call ice_pio_check(pio_put_att(File,varid,'cell_methods','time: mean'), & - subname//' ERROR: defining att cell_methods',file=__FILE__,line=__LINE__) + if (hfield%avg_ice_present) then + call ice_pio_check(pio_put_att(File,varid,'cell_methods', & + 'area: time: mean where sea ice (mask=siconc)'), & + subname//' ERROR: defining att cell_methods',file=__FILE__,line=__LINE__) + else + call ice_pio_check(pio_put_att(File,varid,'cell_methods','time: mean'), & + subname//' ERROR: defining att cell_methods',file=__FILE__,line=__LINE__) + endif endif endif diff --git a/cicecore/cicedyn/infrastructure/io/io_pio2/ice_restart.F90 b/cicecore/cicedyn/infrastructure/io/io_pio2/ice_restart.F90 index b06501483..37cf4d985 100644 --- a/cicecore/cicedyn/infrastructure/io/io_pio2/ice_restart.F90 +++ b/cicecore/cicedyn/infrastructure/io/io_pio2/ice_restart.F90 @@ -220,16 +220,20 @@ subroutine init_restart_write(filename_spec) myear,'-',mmonth,'-',mday,'-',msec end if - if (restart_format(1:3) /= 'bin') filename = trim(filename) // '.nc' + filename = trim(filename) // '.nc' ! write pointer (path/file) if (my_task == master_task) then -#ifdef CESMCOUPLED - write(lpointer_file,'(a,i4.4,a,i2.2,a,i2.2,a,i5.5)') & - 'rpointer.ice'//trim(inst_suffix)//'.',myear,'-',mmonth,'-',mday,'-',msec +#ifdef CESMCOUPLED + lpointer_file = 'rpointer.ice'//trim(inst_suffix) #else lpointer_file = pointer_file #endif + if (pointer_date) then + ! append date to pointer filename + write(lpointer_file,'(a,i4.4,a,i2.2,a,i2.2,a,i5.5)') & + trim(lpointer_file)//'.',myear,'-',mmonth,'-',mday,'-',msec + end if open(nu_rst_pointer,file=lpointer_file) write(nu_rst_pointer,'(a)') filename close(nu_rst_pointer) @@ -752,6 +756,7 @@ subroutine read_restart_field(nu,nrec,work,atype,vname,ndim3,diag, & subname// " ERROR: missing varndims "//trim(vname),file=__FILE__,line=__LINE__) call pio_seterrorhandling(File, PIO_INTERNAL_ERROR) + work (:,:,:,:) = c0 if (ndim3 == ncat .and. ndims == 3) then call pio_read_darray(File, vardesc, iodesc3d_ncat, work, status) #ifdef CESMCOUPLED diff --git a/cicecore/drivers/direct/hadgem3/CICE.F90 b/cicecore/drivers/direct/hadgem3/CICE.F90 index a7233fe39..ad02ca51b 100644 --- a/cicecore/drivers/direct/hadgem3/CICE.F90 +++ b/cicecore/drivers/direct/hadgem3/CICE.F90 @@ -1,5 +1,5 @@ !======================================================================= -! Copyright (c) 1998, 2017, Triad National Security, LLC +! Copyright 1998-2025, Triad National Security, LLC ! All rights reserved. ! ! This program was produced under U.S. Government contract 89233218CNA000001 diff --git a/cicecore/drivers/mapl/geos/CICE_copyright.txt b/cicecore/drivers/mapl/geos/CICE_copyright.txt index 9ee3d2c60..ab684c63e 100644 --- a/cicecore/drivers/mapl/geos/CICE_copyright.txt +++ b/cicecore/drivers/mapl/geos/CICE_copyright.txt @@ -1,4 +1,4 @@ -! Copyright (c) 1998, 2017, Triad National Security, LLC +! Copyright 1998-2025, Triad National Security, LLC ! All rights reserved. ! ! This program was produced under U.S. Government contract 89233218CNA000001 diff --git a/cicecore/drivers/mct/cesm1/CICE_copyright.txt b/cicecore/drivers/mct/cesm1/CICE_copyright.txt index 9ee3d2c60..ab684c63e 100644 --- a/cicecore/drivers/mct/cesm1/CICE_copyright.txt +++ b/cicecore/drivers/mct/cesm1/CICE_copyright.txt @@ -1,4 +1,4 @@ -! Copyright (c) 1998, 2017, Triad National Security, LLC +! Copyright 1998-2025, Triad National Security, LLC ! All rights reserved. ! ! This program was produced under U.S. Government contract 89233218CNA000001 diff --git a/cicecore/drivers/nuopc/cmeps/CICE_copyright.txt b/cicecore/drivers/nuopc/cmeps/CICE_copyright.txt index 9ee3d2c60..ab684c63e 100644 --- a/cicecore/drivers/nuopc/cmeps/CICE_copyright.txt +++ b/cicecore/drivers/nuopc/cmeps/CICE_copyright.txt @@ -1,4 +1,4 @@ -! Copyright (c) 1998, 2017, Triad National Security, LLC +! Copyright 1998-2025, Triad National Security, LLC ! All rights reserved. ! ! This program was produced under U.S. Government contract 89233218CNA000001 diff --git a/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 b/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 index e8f019343..f2b2e2833 100644 --- a/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 +++ b/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 @@ -30,7 +30,8 @@ module ice_comp_nuopc use ice_kinds_mod , only : dbl_kind, int_kind, char_len, char_len_long use ice_fileunits , only : nu_diag, nu_diag_set, inst_index, inst_name use ice_fileunits , only : inst_suffix, release_all_fileunits, flush_fileunit - use ice_restart_shared , only : runid, runtype, restart, use_restart_time, restart_dir, restart_file, restart_format, restart_chunksize + use ice_restart_shared , only : runid, runtype, restart, use_restart_time, restart_dir, restart_file, & + restart_format, restart_chunksize, pointer_date use ice_history , only : accum_hist use ice_history_shared , only : history_format, history_chunksize use ice_exit , only : abort_ice @@ -329,6 +330,15 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) if (trim(cvalue) .eq. '.true.') restart_eor = .true. endif +#ifdef CESMCOUPLED + pointer_date = .true. +#endif + + ! set CICE internal pointer_date variable based on nuopc settings + ! this appends a datestamp to the "rpointer" file + call NUOPC_CompAttributeGet(gcomp, name="restart_pointer_append_date", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) pointer_date = (trim(cvalue) .eq. ".true.") !---------------------------------------------------------------------------- ! generate local mpi comm !---------------------------------------------------------------------------- diff --git a/cicecore/drivers/nuopc/dmi/CICE.F90 b/cicecore/drivers/nuopc/dmi/CICE.F90 index c92f0ea24..14c7af346 100644 --- a/cicecore/drivers/nuopc/dmi/CICE.F90 +++ b/cicecore/drivers/nuopc/dmi/CICE.F90 @@ -1,5 +1,5 @@ !======================================================================= -! Copyright (c) 1998, 2017, Triad National Security, LLC +! Copyright 1998-2025, Triad National Security, LLC ! All rights reserved. ! ! This program was produced under U.S. Government contract 89233218CNA000001 diff --git a/cicecore/drivers/standalone/cice/CICE.F90 b/cicecore/drivers/standalone/cice/CICE.F90 index c92f0ea24..14c7af346 100644 --- a/cicecore/drivers/standalone/cice/CICE.F90 +++ b/cicecore/drivers/standalone/cice/CICE.F90 @@ -1,5 +1,5 @@ !======================================================================= -! Copyright (c) 1998, 2017, Triad National Security, LLC +! Copyright 1998-2025, Triad National Security, LLC ! All rights reserved. ! ! This program was produced under U.S. Government contract 89233218CNA000001 diff --git a/cicecore/drivers/unittest/gridavgchk/gridavgchk.F90 b/cicecore/drivers/unittest/gridavgchk/gridavgchk.F90 index bd7ed3165..02e51fbba 100644 --- a/cicecore/drivers/unittest/gridavgchk/gridavgchk.F90 +++ b/cicecore/drivers/unittest/gridavgchk/gridavgchk.F90 @@ -16,7 +16,6 @@ program gridavgchk use CICE_InitMod use ice_kinds_mod, only: int_kind, dbl_kind use ice_blocks, only: block, get_block, nx_block, ny_block, nblocks_tot - use ice_boundary, only: ice_HaloUpdate use ice_constants, only: c0, c1, c2, p25, & field_loc_center, field_loc_NEcorner, & field_loc_Nface, field_loc_Eface, field_type_scalar diff --git a/cicecore/drivers/unittest/halochk/halochk.F90 b/cicecore/drivers/unittest/halochk/halochk.F90 index 29eaa8150..2fecaf31e 100644 --- a/cicecore/drivers/unittest/halochk/halochk.F90 +++ b/cicecore/drivers/unittest/halochk/halochk.F90 @@ -40,11 +40,12 @@ program halochk implicit none - integer(int_kind) :: nn, nl, nt, i, j, k1, k2, n, ib, ie, jb, je + integer(int_kind) :: nn, nl, nt, nf, i, j, k1, k2, n, ib, ie, jb, je integer(int_kind) :: iblock, itrip, ioffset, joffset integer(int_kind) :: blockID, numBlocks, jtrip type (block) :: this_block + ! fields sent to the haloupdate real(dbl_kind) , allocatable :: darrayi1(:,:,:) , darrayj1(:,:,:) real(dbl_kind) , allocatable :: darrayi2(:,:,:,:) , darrayj2(:,:,:,:) real(dbl_kind) , allocatable :: darrayi3(:,:,:,:,:), darrayj3(:,:,:,:,:) @@ -58,25 +59,27 @@ program halochk real(dbl_kind) , allocatable :: darrayi1str(:,:,:) , darrayj1str(:,:,:) real(dbl_kind) , allocatable :: darrayi10(:,:,:) , darrayj10(:,:,:) - real(dbl_kind), allocatable :: cidata_bas(:,:,:,:,:),cjdata_bas(:,:,:,:,:) - real(dbl_kind), allocatable :: cidata_nup(:,:,:,:,:),cjdata_nup(:,:,:,:,:) - real(dbl_kind), allocatable :: cidata_std(:,:,:,:,:),cjdata_std(:,:,:,:,:) + ! expected results + real(dbl_kind), allocatable :: cidata_bas(:,:,:,:,:),cjdata_bas(:,:,:,:,:) ! baseline integer(int_kind), parameter :: maxtests = 11 integer(int_kind), parameter :: maxtypes = 4 integer(int_kind), parameter :: maxlocs = 5 + integer(int_kind), parameter :: maxfills = 2 integer(int_kind), parameter :: nz1 = 3 integer(int_kind), parameter :: nz2 = 4 real(dbl_kind) :: aichk,ajchk,cichk,cjchk,rival,rjval,rsign - character(len=16) :: locs_name(maxlocs), types_name(maxtypes) + real(dbl_kind) :: fillexpected + character(len=16) :: locs_name(maxlocs), types_name(maxtypes), fill_name(maxfills) integer(int_kind) :: field_loc(maxlocs), field_type(maxtypes) + logical :: halofill integer(int_kind) :: npes, ierr, ntask, testcnt, tottest, tpcnt, tfcnt integer(int_kind) :: errorflag0, gflag, k1m, k2m, ptcntsum, failcntsum integer(int_kind), allocatable :: errorflag(:) integer(int_kind), allocatable :: ptcnt(:), failcnt(:) character(len=128), allocatable :: teststring(:) character(len=32) :: halofld - logical :: tripole_average, tripole_pole, spvalL1 + logical :: tripole_average, tripole_pole logical :: first_call = .true. real(dbl_kind) , parameter :: fillval = -88888.0_dbl_kind @@ -94,6 +97,7 @@ program halochk locs_name (:) = 'unknown' types_name(:) = 'unknown' + fill_name (:) = 'unknown' field_type(:) = field_type_unknown field_loc (:) = field_loc_unknown @@ -110,7 +114,7 @@ program halochk locs_name (1) = 'center' field_loc (1) = field_loc_center - locs_name (2) = 'NEcorner' + locs_name (2) = 'NEcorn' field_loc (2) = field_loc_NEcorner locs_name (3) = 'Nface' field_loc (3) = field_loc_Nface @@ -121,7 +125,10 @@ program halochk ! locs_name (6) = 'unknown' ! field_loc (6) = field_loc_unknown ! aborts in CICE, as expected - tottest = maxtests * maxlocs * maxtypes + fill_name (1) = 'fill' + fill_name (2) = 'nofill' + + tottest = maxtests * maxlocs * maxtypes * maxfills allocate(errorflag(tottest)) allocate(teststring(tottest)) allocate(ptcnt(tottest)) @@ -187,10 +194,6 @@ program halochk allocate(cidata_bas(nx_block,ny_block,nz1,nz2,max_blocks)) allocate(cjdata_bas(nx_block,ny_block,nz1,nz2,max_blocks)) - allocate(cidata_std(nx_block,ny_block,nz1,nz2,max_blocks)) - allocate(cjdata_std(nx_block,ny_block,nz1,nz2,max_blocks)) - allocate(cidata_nup(nx_block,ny_block,nz1,nz2,max_blocks)) - allocate(cjdata_nup(nx_block,ny_block,nz1,nz2,max_blocks)) darrayi1 = fillval darrayj1 = fillval @@ -218,14 +221,14 @@ program halochk darrayj10 = fillval cidata_bas = fillval cjdata_bas = fillval - cidata_std = fillval - cjdata_std = fillval - cidata_nup = fillval - cjdata_nup = fillval call ice_distributionGet(distrb_info, numLocalBlocks = numBlocks) !--- baseline data --- + ! set to the global index + ! i/j valid everywhere for "cyclic" + ! i/j valid for "open" with extrapolation on outer boundary + ! i/j zero on outer boundary for "closed" do iblock = 1,numBlocks call ice_distributionGetBlockID(distrb_info, iblock, blockID) @@ -244,102 +247,32 @@ program halochk enddo enddo - !--- setup nup (noupdate) solution, set halo/pad will fillval --- - - cidata_nup(:,:,:,:,:) = cidata_bas(:,:,:,:,:) - cjdata_nup(:,:,:,:,:) = cjdata_bas(:,:,:,:,:) - - do iblock = 1,numBlocks - call ice_distributionGetBlockID(distrb_info, iblock, blockID) - this_block = get_block(blockID, blockID) - ib = this_block%ilo - ie = this_block%ihi - jb = this_block%jlo - je = this_block%jhi - cidata_nup(1:ib-1 ,: ,:,:,iblock) = fillval - cjdata_nup(1:ib-1 ,: ,:,:,iblock) = fillval - cidata_nup(ie+1:nx_block,: ,:,:,iblock) = fillval - cjdata_nup(ie+1:nx_block,: ,:,:,iblock) = fillval - cidata_nup(: ,1:jb-1 ,:,:,iblock) = fillval - cjdata_nup(: ,1:jb-1 ,:,:,iblock) = fillval - cidata_nup(: ,je+1:ny_block,:,:,iblock) = fillval - cjdata_nup(: ,je+1:ny_block,:,:,iblock) = fillval - enddo - - !--- setup std solution for cyclic, closed, open, tripole solution --- - - cidata_std(:,:,:,:,:) = cidata_bas(:,:,:,:,:) - cjdata_std(:,:,:,:,:) = cjdata_bas(:,:,:,:,:) - - !--- halo off on east and west boundary --- - if (ew_boundary_type == 'closed' .or. & - ew_boundary_type == 'open' ) then - do iblock = 1,numBlocks - call ice_distributionGetBlockID(distrb_info, iblock, blockID) - this_block = get_block(blockID, blockID) - ib = this_block%ilo - ie = this_block%ihi - jb = this_block%jlo - je = this_block%jhi - if (this_block%i_glob(ib) == 1) then - cidata_std(1:ib-1 ,:,:,:,iblock) = dhalofillval - cjdata_std(1:ib-1 ,:,:,:,iblock) = dhalofillval - endif - if (this_block%i_glob(ie) == nx_global) then - cidata_std(ie+1:nx_block,:,:,:,iblock) = dhalofillval - cjdata_std(ie+1:nx_block,:,:,:,iblock) = dhalofillval - endif - enddo - endif - - !--- halo off on south boundary --- - if (ns_boundary_type == 'closed' .or. & - ns_boundary_type == 'open' .or. & - ns_boundary_type == 'tripole' .or. & - ns_boundary_type == 'tripoleT' ) then - do iblock = 1,numBlocks - call ice_distributionGetBlockID(distrb_info, iblock, blockID) - this_block = get_block(blockID, blockID) - ib = this_block%ilo - ie = this_block%ihi - jb = this_block%jlo - je = this_block%jhi - if (this_block%j_glob(jb) == 1) then - cidata_std(:,1:jb-1,:,:,iblock) = dhalofillval - cjdata_std(:,1:jb-1,:,:,iblock) = dhalofillval - endif - enddo - endif - - !--- halo off on north boundary, tripole handled later --- - if (ns_boundary_type == 'closed' .or. & - ns_boundary_type == 'open' .or. & - ns_boundary_type == 'tripole' .or. & - ns_boundary_type == 'tripoleT' ) then - do iblock = 1,numBlocks - call ice_distributionGetBlockID(distrb_info, iblock, blockID) - this_block = get_block(blockID, blockID) - ib = this_block%ilo - ie = this_block%ihi - jb = this_block%jlo - je = this_block%jhi - if (this_block%j_glob(je) == ny_global) then - cidata_std(:,je+1:ny_block,:,:,iblock) = dhalofillval - cjdata_std(:,je+1:ny_block,:,:,iblock) = dhalofillval - endif - enddo - endif - !--------------------------------------------------------------- testcnt = 0 do nn = 1, maxtests do nl = 1, maxlocs do nt = 1, maxtypes + do nf = 1, maxfills !--- setup test --- first_call = .true. testcnt = testcnt + 1 + if (nf == 1) then + halofill = .true. + fillexpected = dhalofillval + elseif (nf == 2) then + halofill = .false. + fillexpected = fillval + else + write(6,*) subname,' nf = ',nf + if (my_task == master_task) then + write(6,*) ' ' + write(6,*) 'HALOCHK FAILED' + write(6,*) ' ' + endif + call abort_ice(subname//' invalid value of nf',file=__FILE__,line=__LINE__) + endif if (testcnt > tottest) then if (my_task == master_task) then write(6,*) ' ' @@ -388,35 +321,54 @@ program halochk darrayi10 = darrayi1 darrayj10 = darrayj1 - !--- halo update --- if (nn == 1) then k1m = 1 k2m = 1 halofld = '2DR8' - call ice_haloUpdate(darrayi1, halo_info, field_loc(nl), field_type(nt), fillvalue=dhalofillval) - call ice_haloUpdate(darrayj1, halo_info, field_loc(nl), field_type(nt), fillvalue=dhalofillval) + if (halofill) then + call ice_haloUpdate(darrayi1, halo_info, field_loc(nl), field_type(nt), fillvalue=dhalofillval) + call ice_haloUpdate(darrayj1, halo_info, field_loc(nl), field_type(nt), fillvalue=dhalofillval) + else + call ice_haloUpdate(darrayi1, halo_info, field_loc(nl), field_type(nt)) + call ice_haloUpdate(darrayj1, halo_info, field_loc(nl), field_type(nt)) + endif elseif (nn == 2) then k1m = nz1 k2m = 1 halofld = '3DR8' - call ice_haloUpdate(darrayi2, halo_info, field_loc(nl), field_type(nt), fillvalue=dhalofillval) - call ice_haloUpdate(darrayj2, halo_info, field_loc(nl), field_type(nt), fillvalue=dhalofillval) + if (halofill) then + call ice_haloUpdate(darrayi2, halo_info, field_loc(nl), field_type(nt), fillvalue=dhalofillval) + call ice_haloUpdate(darrayj2, halo_info, field_loc(nl), field_type(nt), fillvalue=dhalofillval) + else + call ice_haloUpdate(darrayi2, halo_info, field_loc(nl), field_type(nt)) + call ice_haloUpdate(darrayj2, halo_info, field_loc(nl), field_type(nt)) + endif elseif (nn == 3) then k1m = nz1 k2m = nz2 halofld = '4DR8' - call ice_haloUpdate(darrayi3, halo_info, field_loc(nl), field_type(nt), fillvalue=dhalofillval) - call ice_haloUpdate(darrayj3, halo_info, field_loc(nl), field_type(nt), fillvalue=dhalofillval) + if (halofill) then + call ice_haloUpdate(darrayi3, halo_info, field_loc(nl), field_type(nt), fillvalue=dhalofillval) + call ice_haloUpdate(darrayj3, halo_info, field_loc(nl), field_type(nt), fillvalue=dhalofillval) + else + call ice_haloUpdate(darrayi3, halo_info, field_loc(nl), field_type(nt)) + call ice_haloUpdate(darrayj3, halo_info, field_loc(nl), field_type(nt)) + endif elseif (nn == 4) then k1m = 1 k2m = 1 halofld = '2DR4' rarrayi1 = real(darrayi1,kind=real_kind) rarrayj1 = real(darrayj1,kind=real_kind) - call ice_haloUpdate(rarrayi1, halo_info, field_loc(nl), field_type(nt), fillvalue=rhalofillval) - call ice_haloUpdate(rarrayj1, halo_info, field_loc(nl), field_type(nt), fillvalue=rhalofillval) + if (halofill) then + call ice_haloUpdate(rarrayi1, halo_info, field_loc(nl), field_type(nt), fillvalue=rhalofillval) + call ice_haloUpdate(rarrayj1, halo_info, field_loc(nl), field_type(nt), fillvalue=rhalofillval) + else + call ice_haloUpdate(rarrayi1, halo_info, field_loc(nl), field_type(nt)) + call ice_haloUpdate(rarrayj1, halo_info, field_loc(nl), field_type(nt)) + endif darrayi1 = real(rarrayi1,kind=dbl_kind) darrayj1 = real(rarrayj1,kind=dbl_kind) elseif (nn == 5) then @@ -425,8 +377,13 @@ program halochk halofld = '3DR4' rarrayi2 = real(darrayi2,kind=real_kind) rarrayj2 = real(darrayj2,kind=real_kind) - call ice_haloUpdate(rarrayi2, halo_info, field_loc(nl), field_type(nt), fillvalue=rhalofillval) - call ice_haloUpdate(rarrayj2, halo_info, field_loc(nl), field_type(nt), fillvalue=rhalofillval) + if (halofill) then + call ice_haloUpdate(rarrayi2, halo_info, field_loc(nl), field_type(nt), fillvalue=rhalofillval) + call ice_haloUpdate(rarrayj2, halo_info, field_loc(nl), field_type(nt), fillvalue=rhalofillval) + else + call ice_haloUpdate(rarrayi2, halo_info, field_loc(nl), field_type(nt)) + call ice_haloUpdate(rarrayj2, halo_info, field_loc(nl), field_type(nt)) + endif darrayi2 = real(rarrayi2,kind=dbl_kind) darrayj2 = real(rarrayj2,kind=dbl_kind) elseif (nn == 6) then @@ -435,8 +392,13 @@ program halochk halofld = '4DR4' rarrayi3 = real(darrayi3,kind=real_kind) rarrayj3 = real(darrayj3,kind=real_kind) - call ice_haloUpdate(rarrayi3, halo_info, field_loc(nl), field_type(nt), fillvalue=rhalofillval) - call ice_haloUpdate(rarrayj3, halo_info, field_loc(nl), field_type(nt), fillvalue=rhalofillval) + if (halofill) then + call ice_haloUpdate(rarrayi3, halo_info, field_loc(nl), field_type(nt), fillvalue=rhalofillval) + call ice_haloUpdate(rarrayj3, halo_info, field_loc(nl), field_type(nt), fillvalue=rhalofillval) + else + call ice_haloUpdate(rarrayi3, halo_info, field_loc(nl), field_type(nt)) + call ice_haloUpdate(rarrayj3, halo_info, field_loc(nl), field_type(nt)) + endif darrayi3 = real(rarrayi3,kind=dbl_kind) darrayj3 = real(rarrayj3,kind=dbl_kind) elseif (nn == 7) then @@ -445,8 +407,13 @@ program halochk halofld = '2DI4' iarrayi1 = nint(darrayi1) iarrayj1 = nint(darrayj1) - call ice_haloUpdate(iarrayi1, halo_info, field_loc(nl), field_type(nt), fillvalue=ihalofillval) - call ice_haloUpdate(iarrayj1, halo_info, field_loc(nl), field_type(nt), fillvalue=ihalofillval) + if (halofill) then + call ice_haloUpdate(iarrayi1, halo_info, field_loc(nl), field_type(nt), fillvalue=ihalofillval) + call ice_haloUpdate(iarrayj1, halo_info, field_loc(nl), field_type(nt), fillvalue=ihalofillval) + else + call ice_haloUpdate(iarrayi1, halo_info, field_loc(nl), field_type(nt)) + call ice_haloUpdate(iarrayj1, halo_info, field_loc(nl), field_type(nt)) + endif darrayi1 = real(iarrayi1,kind=dbl_kind) darrayj1 = real(iarrayj1,kind=dbl_kind) elseif (nn == 8) then @@ -455,8 +422,13 @@ program halochk halofld = '3DI4' iarrayi2 = nint(darrayi2) iarrayj2 = nint(darrayj2) - call ice_haloUpdate(iarrayi2, halo_info, field_loc(nl), field_type(nt), fillvalue=ihalofillval) - call ice_haloUpdate(iarrayj2, halo_info, field_loc(nl), field_type(nt), fillvalue=ihalofillval) + if (halofill) then + call ice_haloUpdate(iarrayi2, halo_info, field_loc(nl), field_type(nt), fillvalue=ihalofillval) + call ice_haloUpdate(iarrayj2, halo_info, field_loc(nl), field_type(nt), fillvalue=ihalofillval) + else + call ice_haloUpdate(iarrayi2, halo_info, field_loc(nl), field_type(nt)) + call ice_haloUpdate(iarrayj2, halo_info, field_loc(nl), field_type(nt)) + endif darrayi2 = real(iarrayi2,kind=dbl_kind) darrayj2 = real(iarrayj2,kind=dbl_kind) elseif (nn == 9) then @@ -465,20 +437,36 @@ program halochk halofld = '4DI4' iarrayi3 = nint(darrayi3) iarrayj3 = nint(darrayj3) - call ice_haloUpdate(iarrayi3, halo_info, field_loc(nl), field_type(nt), fillvalue=ihalofillval) - call ice_haloUpdate(iarrayj3, halo_info, field_loc(nl), field_type(nt), fillvalue=ihalofillval) + if (halofill) then + call ice_haloUpdate(iarrayi3, halo_info, field_loc(nl), field_type(nt), fillvalue=ihalofillval) + call ice_haloUpdate(iarrayj3, halo_info, field_loc(nl), field_type(nt), fillvalue=ihalofillval) + else + call ice_haloUpdate(iarrayi3, halo_info, field_loc(nl), field_type(nt)) + call ice_haloUpdate(iarrayj3, halo_info, field_loc(nl), field_type(nt)) + endif darrayi3 = real(iarrayi3,kind=dbl_kind) darrayj3 = real(iarrayj3,kind=dbl_kind) elseif (nn == 10) then k1m = 1 k2m = 1 halofld = '2DL1' - larrayi1 = .true. - where (darrayi1 == fillval) larrayi1 = .false. - larrayj1 = .false. - where (darrayj1 == fillval) larrayj1 = .true. - call ice_haloUpdate(larrayi1, halo_info, field_loc(nl), field_type(nt), fillvalue=0) - call ice_haloUpdate(larrayj1, halo_info, field_loc(nl), field_type(nt), fillvalue=1) + where (darrayi1 == fillval) + larrayi1 = .false. + elsewhere + larrayi1 = (mod(nint(darrayi1),2) == 1) + endwhere + where (darrayj1 == fillval) + larrayj1 = .true. + elsewhere + larrayj1 = (mod(nint(darrayj1),2) == 1) + endwhere + if (halofill) then + call ice_haloUpdate(larrayi1, halo_info, field_loc(nl), field_type(nt), fillvalue=0) + call ice_haloUpdate(larrayj1, halo_info, field_loc(nl), field_type(nt), fillvalue=1) + else + call ice_haloUpdate(larrayi1, halo_info, field_loc(nl), field_type(nt)) + call ice_haloUpdate(larrayj1, halo_info, field_loc(nl), field_type(nt)) + endif darrayi1 = c0 where (larrayi1) darrayi1 = c1 darrayj1 = c0 @@ -489,11 +477,16 @@ program halochk halofld = 'STRESS' darrayi1str = -darrayi1 ! flip sign for testing darrayj1str = -darrayj1 - call ice_haloUpdate_stress(darrayi1, darrayi1str, halo_info, field_loc(nl), field_type(nt), fillvalue=dhalofillval) - call ice_haloUpdate_stress(darrayj1, darrayj1str, halo_info, field_loc(nl), field_type(nt), fillvalue=dhalofillval) + if (halofill) then + call ice_haloUpdate_stress(darrayi1, darrayi1str, halo_info, field_loc(nl), field_type(nt), fillvalue=dhalofillval) + call ice_haloUpdate_stress(darrayj1, darrayj1str, halo_info, field_loc(nl), field_type(nt), fillvalue=dhalofillval) + else + call ice_haloUpdate_stress(darrayi1, darrayi1str, halo_info, field_loc(nl), field_type(nt)) + call ice_haloUpdate_stress(darrayj1, darrayj1str, halo_info, field_loc(nl), field_type(nt)) + endif endif - write(teststring(testcnt),'(5a10)') trim(halofld),trim(locs_name(nl)),trim(types_name(nt)), & + write(teststring(testcnt),'(6a8)') trim(halofld),trim(locs_name(nl)),trim(types_name(nt)),trim(fill_name(nf)), & trim(ew_boundary_type),trim(ns_boundary_type) do iblock = 1,numBlocks @@ -504,15 +497,12 @@ program halochk jb = this_block%jlo je = this_block%jhi ! just check non-padded gridcells -! do j = 1,ny_block -! do i = 1,nx_block do j = jb-nghost, je+nghost do i = ib-nghost, ie+nghost do k1 = 1,k1m do k2 = 1,k2m tripole_average = .false. tripole_pole = .false. - spvalL1 = .false. if (index(halofld,'2D') > 0) then aichk = darrayi1(i,j,iblock) ajchk = darrayj1(i,j,iblock) @@ -534,14 +524,46 @@ program halochk call abort_ice(subname//' halofld not matched '//trim(halofld),file=__FILE__,line=__LINE__) endif + cichk = cidata_bas(i,j,k1,k2,iblock) + cjchk = cjdata_bas(i,j,k1,k2,iblock) + + ! halo special cases if (field_loc (nl) == field_loc_noupdate .or. & field_type(nt) == field_type_noupdate) then - cichk = cidata_nup(i,j,k1,k2,iblock) - cjchk = cjdata_nup(i,j,k1,k2,iblock) + if (i < ib .or. j < jb .or. i > ie .or. j > je) then + ! no halo update anywhere, doesn't even see fillvalue passed in + cichk = fillval + cjchk = fillval + endif + else - cichk = cidata_std(i,j,k1,k2,iblock) - cjchk = cjdata_std(i,j,k1,k2,iblock) + ! if ew_boundary_type is not cyclic we expect just fill values on outer boundary + if (ew_boundary_type /= 'cyclic' .and. & + ((this_block%i_glob(ib) == 1 .and. i < ib) .or. & ! west outer face + (this_block%i_glob(ie) == nx_global .and. i > ie))) then ! east outer face + cichk = fillexpected + cjchk = fillexpected + endif + + ! if ns_boundary_type is not cyclic we expect just fill values on outer boundary except + ! - tripole north edge will be haloed and is updated below, default to fill value for now + ! - tripole south edge will be set to the fillvalue or to haloupdate internal default (c0) + ! tripole basically assumes south edge is land or always ice free in CICE + if (ns_boundary_type /= 'cyclic' .and. & + ((this_block%j_glob(jb) == 1 .and. j < jb) .or. & ! south outer face + (this_block%j_glob(je) == ny_global .and. j > je))) then ! north outer face + ! ns_boundary_type is not cyclic and on outer boundary + if ((ns_boundary_type == 'tripole' .or. & + ns_boundary_type == 'tripoleT') .and. & + .not. halofill) then + cichk = c0 + cjchk = c0 + else + cichk = fillexpected + cjchk = fillexpected + endif + endif if (index(halofld,'STRESS') > 0) then ! only updates on tripole zipper for tripole grids @@ -560,11 +582,11 @@ program halochk (ns_boundary_type == 'tripoleT' .and. & (j >= je)))) then - ! flip sign for vector/angle - if (field_type(nt) == field_type_vector .or. field_type(nt) == field_type_angle ) then + ! flip sign for vector/angle except for logical halo updates + rsign = c1 + if ((field_type(nt) == field_type_vector .or. field_type(nt) == field_type_angle) .and. & + .not. (index(halofld,'L1') > 0)) then rsign = -c1 - else - rsign = c1 endif ! for tripole @@ -650,44 +672,40 @@ program halochk if (index(halofld,'STRESS') > 0) then ! only updates on tripole zipper for tripole grids, not tripoleT + ! note: L1 and STRESS never overlap so don't worry about L1 here if (tripole_pole) then ! flip sign due to sign of darrayi1str ! ends of tripole seam not averaged in CICE - cichk = -rsign * cidata_std(i,j,k1,k2,iblock) - cjchk = -rsign * cjdata_std(i,j,k1,k2,iblock) + cichk = -rsign * cidata_bas(i,j,k1,k2,iblock) + cjchk = -rsign * cjdata_bas(i,j,k1,k2,iblock) else cichk = -rsign * rival cjchk = -rsign * rjval endif - elseif (index(halofld,'L1') > 0 .and. j == je) then - ! force cichk and cjchk to match on tripole average index, calc not well defined - spvalL1 = .true. - cichk = aichk - cjchk = ajchk + elseif (tripole_pole) then ! ends of tripole seam not averaged in CICE - cichk = rsign * cidata_std(i,j,k1,k2,iblock) - cjchk = rsign * cjdata_std(i,j,k1,k2,iblock) + cichk = rsign * cidata_bas(i,j,k1,k2,iblock) + cjchk = rsign * cjdata_bas(i,j,k1,k2,iblock) + elseif (tripole_average) then - ! tripole average - cichk = p5 * (cidata_std(i,j,k1,k2,iblock) + rsign * rival) - cjchk = p5 * (cjdata_std(i,j,k1,k2,iblock) + rsign * rjval) + if (index(halofld,'L1') > 0) then + ! logical math doesn't work this way, force to correct answer + cichk = aichk ! p5 * (mod(nint(cidata_bas(i,j,k1,k2,iblock)),2) + rsign * mod(nint(rival),2)) + cjchk = ajchk ! p5 * (mod(nint(cidata_bas(i,j,k1,k2,iblock)),2) + rsign * mod(nint(rjval),2)) + else + cichk = p5 * (cidata_bas(i,j,k1,k2,iblock) + rsign * rival) + cjchk = p5 * (cjdata_bas(i,j,k1,k2,iblock) + rsign * rjval) + endif + else ! standard tripole fold cichk = rsign * rival cjchk = rsign * rjval endif -! if (testcnt == 6 .and. j == 61 .and. i < 3) then -! if (testcnt == 186 .and. j == 61 .and. i<4) then -! if (testcnt == 13 .and. j > 61 .and. (i < 3 .or. i > 89)) then -! if (testcnt == 5 .and. j >= 61 .and. (i < 3 .or. i > 90)) then -! write(100+my_task,'(a,5i6,2l3,f6.2,i6)') 'tcx1 ',i,j,iblock,itrip,jtrip, & -! tripole_average,tripole_pole,rsign,this_block%i_glob(i) -! write(100+my_task,'(a,4f12.2)') 'tcx2 ',cidata_std(i,j,k1,k2,iblock),rival,cichk,aichk -! write(100+my_task,'(a,4f12.2)') 'tcx3 ',cjdata_std(i,j,k1,k2,iblock),rjval,cjchk,ajchk -! endif endif ! tripole or tripoleT + endif if (index(halofld,'I4') > 0) then @@ -695,16 +713,16 @@ program halochk cjchk = real(nint(cjchk),kind=dbl_kind) endif - if (index(halofld,'L1') > 0 .and. .not.spvalL1) then + if (index(halofld,'L1') > 0) then if (cichk == dhalofillval .or. cichk == fillval) then cichk = c0 else - cichk = c1 + cichk = mod(nint(cichk),2) endif if (cjchk == dhalofillval .or. cjchk == fillval) then cjchk = c1 else - cjchk = c0 + cjchk = mod(nint(cjchk),2) endif endif @@ -719,6 +737,7 @@ program halochk enddo ! j enddo ! iblock + enddo ! maxfills enddo ! maxtypes enddo ! maxlocs enddo ! maxtests @@ -746,10 +765,10 @@ program halochk do n = 1,tottest if (errorflag(n) == passflag) then tpcnt = tpcnt + 1 - write(6,*) 'PASS ',trim(teststring(n)),ptcnt(n),failcnt(n) + write(6,'(2a,2i8)') 'PASS ',trim(teststring(n)),ptcnt(n),failcnt(n) else tfcnt = tfcnt + 1 - write(6,*) 'FAIL ',trim(teststring(n)),ptcnt(n),failcnt(n) + write(6,'(2a,2i8)') 'FAIL ',trim(teststring(n)),ptcnt(n),failcnt(n) endif enddo write(6,*) ' ' @@ -793,8 +812,10 @@ subroutine chkresults(a1,r1,errorflag,testcnt,failcnt,i,j,k1,k2,iblock,first_cal character(len=*) , parameter :: subname='(chkresults)' if (a1 /= r1 .or. print_always) then - errorflag = failflag - failcnt = failcnt + 1 + if (a1 /= r1) then + errorflag = failflag + failcnt = failcnt + 1 + endif if (first_call) then write(100+my_task,*) ' ' write(100+my_task,'(a,i4,2a)') '------- TEST = ',testcnt,' ',trim(teststring) diff --git a/cicecore/drivers/unittest/opticep/CICE.F90 b/cicecore/drivers/unittest/opticep/CICE.F90 index c92f0ea24..14c7af346 100644 --- a/cicecore/drivers/unittest/opticep/CICE.F90 +++ b/cicecore/drivers/unittest/opticep/CICE.F90 @@ -1,5 +1,5 @@ !======================================================================= -! Copyright (c) 1998, 2017, Triad National Security, LLC +! Copyright 1998-2025, Triad National Security, LLC ! All rights reserved. ! ! This program was produced under U.S. Government contract 89233218CNA000001 diff --git a/cicecore/shared/ice_arrays_column.F90 b/cicecore/shared/ice_arrays_column.F90 index 38f3ee0f7..8dee4aef3 100644 --- a/cicecore/shared/ice_arrays_column.F90 +++ b/cicecore/shared/ice_arrays_column.F90 @@ -9,6 +9,7 @@ module ice_arrays_column use ice_kinds_mod + use ice_constants, only : c0 use ice_fileunits, only: nu_diag use ice_blocks, only: nx_block, ny_block use ice_domain_size, only: max_blocks, ncat, nilyr, nslyr, & @@ -25,8 +26,7 @@ module ice_arrays_column ! icepack_atmo.F90 ! Cdn variables on the T-grid - real (kind=dbl_kind), public, & - dimension (:,:,:), allocatable :: & + real (kind=dbl_kind), public, dimension (:,:,:), allocatable :: & Cdn_atm , & ! atm drag coefficient Cdn_ocn , & ! ocn drag coefficient ! form drag @@ -64,16 +64,17 @@ module ice_arrays_column ! icepack_itd.F90 real (kind=dbl_kind), public, allocatable :: & - hin_max(:) ! category limits (m) + hin_max(:) ! category limits (m) - character (len=35), public, allocatable :: c_hi_range(:) + character (len=35), public, allocatable :: & + c_hi_range(:)! string for history output ! icepack_snow.F90 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 :: & - meltsliqn ! snow melt mass in category n (kg/m^2) + meltsliqn ! snow melt mass in category n (kg/m^2) ! icepack_meltpond_lvl.F90 real (kind=dbl_kind), public, dimension (:,:,:,:), allocatable :: & @@ -83,10 +84,10 @@ module ice_arrays_column ! icepack_shortwave.F90 ! category albedos 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) + 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 :: & @@ -100,14 +101,14 @@ module ice_arrays_column ! shortwave components real (kind=dbl_kind), dimension (:,:,:,:,:), allocatable, public :: & - Iswabsn ! SW radiation absorbed in ice layers (W m-2) + Iswabsn ! SW radiation absorbed in ice layers (W m-2) real (kind=dbl_kind), dimension (:,:,:,:,:), allocatable, public :: & - Sswabsn ! SW radiation absorbed in snow layers (W m-2) + Sswabsn ! SW radiation absorbed in snow layers (W m-2) 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) + 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) fswthrun_vdf , & ! vis dif SW through ice to ocean (W/m^2) fswthrun_idr , & ! nir dir SW through ice to ocean (W/m^2) @@ -119,7 +120,7 @@ module ice_arrays_column fswintn ! SW absorbed in ice interior, below surface (W m-2) real (kind=dbl_kind), dimension (:,:,:,:,:), allocatable, public :: & - fswpenln ! visible SW entering ice layers (W m-2) + fswpenln ! visible SW entering ice layers (W m-2) ! biogeochemistry components @@ -348,6 +349,71 @@ subroutine alloc_arrays_column stat=ierr) if (ierr/=0) call abort_ice(subname//': Out of Memory1') + Cdn_atm = c0 + Cdn_ocn = c0 + hfreebd = c0 + hdraft = c0 + hridge = c0 + distrdg = c0 + hkeel = c0 + dkeel = c0 + lfloe = c0 + dfloe = c0 + Cdn_atm_skin = c0 + Cdn_atm_floe = c0 + Cdn_atm_pond = c0 + Cdn_atm_rdg = c0 + Cdn_ocn_skin = c0 + Cdn_ocn_floe = c0 + Cdn_ocn_keel = c0 + Cdn_atm_ratio = c0 + grow_net = c0 + PP_net = c0 + hbri = c0 + chl_net = c0 + NO_net = c0 + upNO = c0 + upNH = c0 + meltsliq = c0 + meltsliqn = c0 + dhsn = c0 + ffracn = c0 + alvdrn = c0 + alidrn = c0 + alvdfn = c0 + alidfn = c0 + albicen = c0 + albsnon = c0 + albpndn = c0 + apeffn = c0 + snowfracn = c0 + fswsfcn = c0 + fswthrun = c0 + fswthrun_vdr = c0 + fswthrun_vdf = c0 + fswthrun_idr = c0 + fswthrun_idf = c0 + fswthrun_uvrdr= c0 + fswthrun_uvrdf= c0 + fswthrun_pardr= c0 + fswthrun_pardf= c0 + fswintn = c0 + first_ice_real= c0 + first_ice = .false. + dhbr_top = c0 + dhbr_bot = c0 + darcy_V = c0 + sice_rho = c0 + Iswabsn = c0 + Sswabsn = c0 + fswpenln = c0 + Zoo = c0 + zfswin = c0 + iDi = c0 + iki = c0 + bphi = c0 + bTiz = c0 + allocate( & ocean_bio (nx_block,ny_block,max_nbtrcr,max_blocks), & ! contains all the ocean bgc tracer concentrations fbio_snoice (nx_block,ny_block,max_nbtrcr,max_blocks), & ! fluxes from snow to ice @@ -359,6 +425,14 @@ subroutine alloc_arrays_column stat=ierr) if (ierr/=0) call abort_ice(subname//': Out of Memory2') + ocean_bio = c0 + fbio_snoice = c0 + fbio_atmice = c0 + ocean_bio_all= c0 + ice_bio_net = c0 + snow_bio_net = c0 + algal_peak = 0 + allocate( & hin_max(0:ncat) , & ! category limits (m) c_hi_range(ncat) , & ! @@ -370,6 +444,14 @@ subroutine alloc_arrays_column stat=ierr) if (ierr/=0) call abort_ice(subname//' Out of Memory3') + hin_max = c0 + c_hi_range = '' + bgrid = c0 + igrid = c0 + cgrid = c0 + icgrid = c0 + swgrid = c0 + ! floe size distribution allocate( & floe_rad_l (nfsd) , & ! fsd size lower bound in m (radius) @@ -388,6 +470,20 @@ subroutine alloc_arrays_column stat=ierr) if (ierr/=0) call abort_ice(subname//' Out of Memory5') + floe_rad_l = c0 + floe_rad_c = c0 + floe_binwidth = c0 + c_fsd_range = '' + wavefreq = c0 + dwavefreq = c0 + wave_sig_ht = c0 + wave_spectrum = c0 + d_afsd_newi = c0 + d_afsd_latg = c0 + d_afsd_latm = c0 + d_afsd_wave = c0 + d_afsd_weld = c0 + end subroutine alloc_arrays_column !======================================================================= diff --git a/cicecore/shared/ice_restart_shared.F90 b/cicecore/shared/ice_restart_shared.F90 index c022d77ba..409d0cb16 100644 --- a/cicecore/shared/ice_restart_shared.F90 +++ b/cicecore/shared/ice_restart_shared.F90 @@ -25,8 +25,12 @@ module ice_restart_shared character (len=char_len_long), public :: & pointer_file ! input pointer file for restarts + logical (kind=log_kind), public :: & + pointer_date = .false. ! if true, append datestamp to pointer file + character (len=char_len), public :: & restart_format , & ! format of restart files 'nc' + restart_mod , & ! restart modification option, "none", "adjust_aice" restart_rearranger ! restart file rearranger, box or subset for pio integer (kind=int_kind), public :: & diff --git a/cicecore/version.txt b/cicecore/version.txt index 0a244794e..4efe718e0 100644 --- a/cicecore/version.txt +++ b/cicecore/version.txt @@ -1 +1 @@ -CICE 6.6.1 +CICE 6.6.2 diff --git a/configuration/scripts/cice.batch.csh b/configuration/scripts/cice.batch.csh index 220313bfa..abb64e25c 100755 --- a/configuration/scripts/cice.batch.csh +++ b/configuration/scripts/cice.batch.csh @@ -366,12 +366,21 @@ cat >> ${jobfile} << EOFB #PBS -l walltime=${batchtime} EOFB +else if (${ICE_MACHINE} =~ boreas* ) then +cat >> ${jobfile} << EOFB +#PBS -N ${ICE_CASENAME} +#PBS -j oe +#PBS -q ${queue} +#PBS -l select=${nnodes}:ncpus=${corespernode}:mpiprocs=${taskpernodelimit}:ompthreads=${nthrds} +#PBS -l walltime=${batchtime} +EOFB + else if (${ICE_MACHINE} =~ gaeac5*) then cat >> ${jobfile} << EOFB #SBATCH -J ${ICE_CASENAME} #SBATCH --partition=batch #SBATCH --qos=${queue} -#SBATCH --account=nggps_emc +#SBATCH --account=${acct} #SBATCH --clusters=c5 #SBATCH --time=${batchtime} #SBATCH --nodes=${nnodes} @@ -388,7 +397,7 @@ cat >> ${jobfile} << EOFB #SBATCH -J ${ICE_CASENAME} #SBATCH --partition=batch #SBATCH --qos=${queue} -#SBATCH --account=sfs_emc +#SBATCH --account=${acct} #SBATCH --clusters=c6 #SBATCH --time=${batchtime} #SBATCH --nodes=${nnodes} diff --git a/configuration/scripts/cice.launch.csh b/configuration/scripts/cice.launch.csh index bc68a7ce1..73af50d1b 100755 --- a/configuration/scripts/cice.launch.csh +++ b/configuration/scripts/cice.launch.csh @@ -272,6 +272,19 @@ aprun -n ${ntasks} -N ${taskpernodelimit} -d ${nthrds} ./cice >&! \$ICE_RUNLOG_F EOFR endif +#======= +else if (${ICE_MACHCOMP} =~ boreas*) then +if (${ICE_COMMDIR} =~ serial*) then +cat >> ${jobfile} << EOFR +aprun -n 1 -N 1 -d 1 ./cice >&! \$ICE_RUNLOG_FILE +EOFR +else +cat >> ${jobfile} << EOFR +aprun -n ${ntasks} -N ${taskpernodelimit} -d ${nthrds} ./cice >&! \$ICE_RUNLOG_FILE +EOFR +endif + + #======= else if (${ICE_MACHCOMP} =~ gaea*) then cat >> ${jobfile} << EOFR diff --git a/configuration/scripts/ice_in b/configuration/scripts/ice_in index 776f9f966..0c9c7ffe5 100644 --- a/configuration/scripts/ice_in +++ b/configuration/scripts/ice_in @@ -21,6 +21,7 @@ restart_stride = -99 restart_deflate = 0 restart_chunksize = 0, 0 + restart_mod = 'none' lcdf64 = .false. numin = 21 numax = 89 @@ -95,7 +96,6 @@ scale_dxdy = .false. dxscale = 1.d0 dyscale = 1.d0 - close_boundaries = .false. ncat = 5 nfsd = 1 nilyr = 7 diff --git a/configuration/scripts/machines/Macros.boreas_intel b/configuration/scripts/machines/Macros.boreas_intel new file mode 100644 index 000000000..0fe33a1bf --- /dev/null +++ b/configuration/scripts/machines/Macros.boreas_intel @@ -0,0 +1,70 @@ +#============================================================================== +# Makefile macros for DMI Freya based on ECCC banting +#============================================================================== +# For use with intel compiler +#============================================================================== + +#INCLDIR := -I. -I/usr/include +#SLIBS := + +#--- Compiler/preprocessor --- +FC := ftn +CC := cc +CXX := CC +CPP := /usr/bin/cpp +CPPFLAGS := -P -traditional # ALLOW fortran double backslash "\\" +SCC := gcc +SFC := ftn + +CPPDEFS := -DFORTRANUNDERSCORE ${ICE_CPPDEFS} +CFLAGS := -c -O2 -fp-model precise +# Additional flags +FIXEDFLAGS := -132 +FREEFLAGS := -FR +FFLAGS := -convert big_endian -assume byterecl +#-xHost + +ifeq ($(ICE_BLDDEBUG), true) + FFLAGS += -O0 -g -check -fpe0 -ftrapuv -fp-model except -check noarg_temp_created -fp-model source -ftz -traceback -no-wrap-margin +# -heap-arrays 1024 +else +# FFLAGS += -O3 -xCORE-AVX512 -qopt-zmm-usage=high -finline-functions -finline -parallel + FFLAGS += -O2 -qopt-zmm-usage=high -finline-functions -finline -parallel +endif +LD := $(FC) +LDFLAGS := $(FFLAGS) -v +#ifeq ($(ICE_BLDDEBUG), true) +#FFLAGS := -O0 -g -check uninit -check bounds -check pointers -fpe0 -check noarg_temp_created +#FFLAGS := -g -O0 -traceback -fp-model precise -fp-stack-check -fpe0 +#else +#FFLAGS := -r8 -i4 -O2 -align all -w -ftz -assume byterecl +# FFLAGS := -O2 -fp-model precise -assume byterecl -ftz -traceback -xHost +#endif +# Preprocessor flags +#CPPDEFS := -DLINUX $(ICE_CPPDEFS) + +# Linker flags + +# Additional flags + +ifeq ($(ICE_THREADED), true) + LDFLAGS += -qopenmp + CFLAGS += -qopenmp + FFLAGS += -qopenmp +endif + +#--- NetCDF --- +#ifeq ($(IO_TYPE), netcdf) +# +#endif +# +#ifeq ($(IO_TYPE), netcdf_bin) +# CPPDEFS := $(CPPDEFS) -Dncdf +#endif + +### if using parallel I/O, load all 3 libraries. PIO must be first! +#ifeq ($(ICE_IOTYPE), pio) +# PIO_PATH:=/usr/projects/climate/SHARED_CLIMATE/software/conejo/pio/1.7.2/intel-13.0.1/openmpi-1.6.3/netcdf-3.6.3-parallel-netcdf-1.3.1/include +# INCLDIR += -I$(PIO_PATH) +# SLIBS := $(SLIBS) -L$(PIO_PATH) -lpio +#endif diff --git a/configuration/scripts/machines/Macros.gaea_cray b/configuration/scripts/machines/Macros.gaea_cray deleted file mode 100644 index 851134514..000000000 --- a/configuration/scripts/machines/Macros.gaea_cray +++ /dev/null @@ -1,57 +0,0 @@ -#============================================================================== -# Makefile macros for NOAA hera, intel compiler -#============================================================================== - -CPP := fpp -CPPDEFS := -DFORTRANUNDERSCORE ${ICE_CPPDEFS} -CFLAGS := -c -O2 - -FIXEDFLAGS := -132 -FREEFLAGS := -FFLAGS := -hbyteswapio -FFLAGS_NOOPT:= -O0 -LDLAGS := -hbyteswapio - -ifeq ($(ICE_BLDDEBUG), true) - FFLAGS += -O0 -hfp0 -g -Rbcdps -Ktrap=fp -else - FFLAGS += -O2 -hfp0 -endif - -SCC := cc -SFC := ftn -MPICC := cc -MPIFC := ftn - -ifeq ($(ICE_COMMDIR), mpi) - FC := $(MPIFC) - CC := $(MPICC) -else - FC := $(SFC) - CC := $(SCC) -endif -LD:= $(FC) - -NETCDF_PATH := $(NETCDF) - -#PIO_CONFIG_OPTS:= --enable-filesystem-hints=gpfs - -#PNETCDF_PATH := $(PNETCDF) -#PNETCDF_PATH := /glade/u/apps/ch/opt/pio/2.2/mpt/2.15f/intel/17.0.1/lib - -INC_NETCDF := $(NETCDF_PATH)/include -LIB_NETCDF := $(NETCDF_PATH)/lib - -#LIB_PNETCDF := $(PNETCDF_PATH)/lib -#LIB_MPI := $(IMPILIBDIR) - -INCLDIR := $(INCLDIR) -I$(INC_NETCDF) -#SLIBS := -L$(LIB_NETCDF) -lnetcdf -lnetcdff -L$(LIB_PNETCDF) -lpnetcdf -lgptl -SLIBS := -L$(LIB_NETCDF) -lnetcdf -lnetcdff - -ifeq ($(ICE_THREADED), true) - LDFLAGS += -fopenmp - CFLAGS += -fopenmp - FFLAGS += -fopenmp -endif - diff --git a/configuration/scripts/machines/Macros.gaeac5_intel b/configuration/scripts/machines/Macros.gaeac5_intel index 794070214..5a4c384fc 100644 --- a/configuration/scripts/machines/Macros.gaeac5_intel +++ b/configuration/scripts/machines/Macros.gaeac5_intel @@ -4,15 +4,17 @@ CPP := fpp CPPDEFS := -DFORTRANUNDERSCORE ${ICE_CPPDEFS} -CFLAGS := -c -O2 -fp-model precise -xHost +CFLAGS := -c -O2 -fp-model precise -march=core-avx2 FIXEDFLAGS := -132 FREEFLAGS := -FR -FFLAGS := -fp-model precise -convert big_endian -assume byterecl -ftz -traceback -align array64byte -xHost +FFLAGS := -fp-model precise -convert big_endian -assume byterecl -ftz -traceback -align array64byte -march=core-avx2 FFLAGS_NOOPT:= -O0 ifeq ($(ICE_BLDDEBUG), true) - FFLAGS += -O0 -g -check uninit -check bounds -check pointers -fpe0 -check noarg_temp_created -link_mpi=dbg + # 7/2025: cannot use -check uninit + # 7/2025: must use fpe1 rather than fpe0 + FFLAGS += -O0 -g -check bounds -check pointers -fpe1 -check noarg_temp_created -link_mpi=dbg else FFLAGS += -O2 endif diff --git a/configuration/scripts/machines/Macros.gaea_intel b/configuration/scripts/machines/Macros.gaeac6_intel similarity index 76% rename from configuration/scripts/machines/Macros.gaea_intel rename to configuration/scripts/machines/Macros.gaeac6_intel index f4c4d2cbe..9ba174738 100644 --- a/configuration/scripts/machines/Macros.gaea_intel +++ b/configuration/scripts/machines/Macros.gaeac6_intel @@ -1,18 +1,20 @@ #============================================================================== -# Makefile macros for NOAA hera, intel compiler +# Makefile macros for NOAA gaeac6, intel compiler #============================================================================== CPP := fpp CPPDEFS := -DFORTRANUNDERSCORE ${ICE_CPPDEFS} -CFLAGS := -c -O2 -fp-model precise -xHost +CFLAGS := -c -O2 -fp-model precise -march=core-avx2 FIXEDFLAGS := -132 FREEFLAGS := -FR -FFLAGS := -fp-model precise -convert big_endian -assume byterecl -ftz -traceback -align array64byte -xHost +FFLAGS := -fp-model precise -convert big_endian -assume byterecl -ftz -traceback -align array64byte -march=core-avx2 FFLAGS_NOOPT:= -O0 ifeq ($(ICE_BLDDEBUG), true) - FFLAGS += -O0 -g -check uninit -check bounds -check pointers -fpe0 -check noarg_temp_created -link_mpi=dbg +# no -check uninit 25 Jul 2025 +# fpe1 rather than fpe0 due to bug in hdf library 25 Jul 2025 + FFLAGS += -O0 -g -check bounds -check pointers -fpe1 -check noarg_temp_created -link_mpi=dbg else FFLAGS += -O2 endif diff --git a/configuration/scripts/machines/env.boreas_intel b/configuration/scripts/machines/env.boreas_intel new file mode 100644 index 000000000..5525e08eb --- /dev/null +++ b/configuration/scripts/machines/env.boreas_intel @@ -0,0 +1,52 @@ +#!/bin/csh -f + +set inp = "undefined" +if ($#argv == 1) then + set inp = $1 +endif + +if ("$inp" != "-nomodules") then +alias module 'eval `/opt/cray/pe/modules/3.2.11.7/bin/modulecmd tcsh \!*`' +module purge +module load craype-x86-milan +module load PrgEnv-intel +module load cray-hdf5-parallel +module load cray-netcdf-hdf5parallel +module swap intel/2022.2.1 intel-classic/2022.2.1 +module load gcc/12.2.0 +module load jasper-3.0.3-cce-14.0.3-dqhpvpm +module load cray-pals/1.2.12 +#asetenv NETCDF_PATH ${NETCDF_DIR} +setenv LD_LIBRARY_PATH /opt/cray/pe/netcdf-hdf5parallel/4.9.0.5/intel/2022.2/lib:${LD_LIBRARY_PATH} +###source /opt/modules/default/init/csh # Initialize modules for csh +##source /opt/cray/pe/modules/3.2.11.7/init/csh +### Clear environment +##module rm PrgEnv-intel +##module rm PrgEnv-cray +##module rm PrgEnv-gnu +##module add PrgEnv-intel +###module load PrgEnv-intel # Intel compiler +###module load cray-mpich # MPI (Cray MPICH) +#module add cray-hdf5 # HDF5 +#module add cray-netcdf # NetCDF +#module load cray-pals +#setenv HDF5_USE_FILE_LOCKING FALSE # necessary since data is on an NFS filesystem + +endif + +setenv ICE_MACHINE_MACHNAME Boreas +setenv ICE_MACHINE_MACHINFO "Cray XC50, Intel Xeon Gold 6148 (Skylake) NOT SURE-TILL" +setenv ICE_MACHINE_ENVNAME intel +setenv ICE_MACHINE_ENVINFO "Intel 18.0.0.128, cray-mpich/7.7.0, cray-netcdf/4.4.1.1.6" +setenv ICE_MACHINE_MAKE make +setenv ICE_MACHINE_WKDIR /data/${USER}/cice_original/run/ +setenv ICE_MACHINE_INPUTDATA /data/${USER}/cice_original/ +setenv ICE_MACHINE_BASELINE /data/${USER}/cice_original/dbaselines/ +setenv ICE_MACHINE_SUBMIT "qsub" +setenv ICE_MACHINE_TPNODE 128 # tasks per node +#setenv ICE_MACHINE_MAXRUNLENGTH 9 +setenv ICE_MACHINE_ACCT P0000000 +setenv ICE_MACHINE_QUEUE "hpc" +setenv ICE_MACHINE_BLDTHRDS 18 +setenv ICE_MACHINE_QSTAT "qstat " +setenv OMP_STACKSIZE 64M diff --git a/configuration/scripts/machines/env.gaea_cray b/configuration/scripts/machines/env.gaea_cray deleted file mode 100644 index db62615ee..000000000 --- a/configuration/scripts/machines/env.gaea_cray +++ /dev/null @@ -1,44 +0,0 @@ -#!/bin/csh -f - -set inp = "undefined" -if ($#argv == 1) then - set inp = $1 -endif - -if ("$inp" != "-nomodules") then - -#source /lustre/f2/pdata/esrl/gsd/contrib/lua-5.1.4.9/init/init_lmod.csh -source $MODULESHOME/init/csh -module purge -module load PrgEnv-cray -module load cce/18.0.0 -module load cray-libsci/24.07.0 -module load cray-hdf5/1.14.3.1 -module load cray-netcdf/4.9.0.13 -setenv NETCDF $NETCDF_DIR -module list - -# May be needed for OpenMP memory -#setenv OMP_STACKSIZE 64M - -endif - -# 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_ENVNAME intel -setenv ICE_MACHINE_ENVINFO "ifort 18.0.5 20180823, cray-mpich, cray-netcdf" -setenv ICE_MACHINE_MAKE gmake -setenv ICE_MACHINE_WKDIR $HOME/scratch/CICE_RUNS -setenv ICE_MACHINE_INPUTDATA /ncrc/home1/Robert.Grumbine/rgdev/CICE_INPUTDATA -setenv ICE_MACHINE_BASELINE $HOME/scratch/CICE_BASELINE -setenv ICE_MACHINE_SUBMIT "sbatch" -setenv ICE_MACHINE_TPNODE 40 -setenv ICE_MACHINE_ACCT P0000000 -setenv ICE_MACHINE_QUEUE "normal" -setenv ICE_MACHINE_BLDTHRDS 1 -setenv ICE_MACHINE_QSTAT "squeue --jobs=" diff --git a/configuration/scripts/machines/env.gaeac5_intel b/configuration/scripts/machines/env.gaeac5_intel index 69bddb428..2fbbffef8 100644 --- a/configuration/scripts/machines/env.gaeac5_intel +++ b/configuration/scripts/machines/env.gaeac5_intel @@ -7,37 +7,33 @@ endif if ("$inp" != "-nomodules") then -#source /lustre/f2/pdata/esrl/gsd/contrib/lua-5.1.4.9/init/init_lmod.csh source $MODULESHOME/init/csh -#module list -module load PrgEnv-intel -module load intel -#module load intel/2023.2.0 -#module load cce/18.0.0 +module load PrgEnv-intel/8.6.0 +module load intel/2025.0 +module load cray-mpich/8.1.32 module load cray-hdf5/1.14.3.1 module load cray-netcdf/4.9.0.13 setenv NETCDF $NETCDF_DIR -echo zzz final module list -module list -#module avail intel +#echo zzz final module list +#module list # May be needed for OpenMP memory setenv OMP_STACKSIZE 64M endif -env | grep NETCDF +#env | grep NETCDF setenv ICE_MACHINE_MACHNAME gaea -setenv ICE_MACHINE_MACHINFO "Cray XC40 Intel Haswell/Broadwell 2.3GHz, Gemini Interconnect" +setenv ICE_MACHINE_MACHINFO "HPE-EX Cray X3000, AMD EPYC 7H12 2.6 GHz, HPE Slingshot interconnect" setenv ICE_MACHINE_ENVNAME intel -setenv ICE_MACHINE_ENVINFO "ifort 18.0.5 20180823, cray-mpich, cray-netcdf" +setenv ICE_MACHINE_ENVINFO "ifort 2025.0, cray-mpich 8.1.32, cray-netcdf 4.9.0.13" setenv ICE_MACHINE_MAKE gmake setenv ICE_MACHINE_WKDIR $HOME/scratch/CICE_RUNS -setenv ICE_MACHINE_INPUTDATA /ncrc/home1/Robert.Grumbine/rgdev/CICE_INPUTDATA +setenv ICE_MACHINE_INPUTDATA /ncrc/home1/Anthony.Craig/scratch setenv ICE_MACHINE_BASELINE $HOME/scratch/CICE_BASELINE setenv ICE_MACHINE_SUBMIT "sbatch" -setenv ICE_MACHINE_TPNODE 40 +setenv ICE_MACHINE_TPNODE 128 setenv ICE_MACHINE_ACCT P0000000 setenv ICE_MACHINE_QUEUE "normal" setenv ICE_MACHINE_BLDTHRDS 1 diff --git a/configuration/scripts/machines/env.gaea_intel b/configuration/scripts/machines/env.gaeac6_intel similarity index 53% rename from configuration/scripts/machines/env.gaea_intel rename to configuration/scripts/machines/env.gaeac6_intel index 69bddb428..0963ecc69 100644 --- a/configuration/scripts/machines/env.gaea_intel +++ b/configuration/scripts/machines/env.gaeac6_intel @@ -10,15 +10,14 @@ if ("$inp" != "-nomodules") then #source /lustre/f2/pdata/esrl/gsd/contrib/lua-5.1.4.9/init/init_lmod.csh source $MODULESHOME/init/csh #module list -module load PrgEnv-intel -module load intel -#module load intel/2023.2.0 -#module load cce/18.0.0 +module load PrgEnv-intel/8.6.0 +module load intel/2025.0 +module load cray-mpich/8.1.32 module load cray-hdf5/1.14.3.1 module load cray-netcdf/4.9.0.13 setenv NETCDF $NETCDF_DIR -echo zzz final module list -module list +#echo zzz final module list +#module list #module avail intel # May be needed for OpenMP memory @@ -26,19 +25,19 @@ setenv OMP_STACKSIZE 64M endif -env | grep NETCDF +#env | grep NETCDF setenv ICE_MACHINE_MACHNAME gaea -setenv ICE_MACHINE_MACHINFO "Cray XC40 Intel Haswell/Broadwell 2.3GHz, Gemini Interconnect" +setenv ICE_MACHINE_MACHINFO "HPE-EX Cray3000, AMD EPYC 9654 2.4GHz, HPE Slingshot interconnect" setenv ICE_MACHINE_ENVNAME intel -setenv ICE_MACHINE_ENVINFO "ifort 18.0.5 20180823, cray-mpich, cray-netcdf" +setenv ICE_MACHINE_ENVINFO "intel 2025.0, cray-mpich 8.1.32, cray-netcdf 4.9.0.13" setenv ICE_MACHINE_MAKE gmake -setenv ICE_MACHINE_WKDIR $HOME/scratch/CICE_RUNS -setenv ICE_MACHINE_INPUTDATA /ncrc/home1/Robert.Grumbine/rgdev/CICE_INPUTDATA -setenv ICE_MACHINE_BASELINE $HOME/scratch/CICE_BASELINE +setenv ICE_MACHINE_WKDIR $HOME/scratch6/CICE_RUNS +setenv ICE_MACHINE_INPUTDATA /ncrc/home1/Anthony.Craig/scratch6 +setenv ICE_MACHINE_BASELINE $HOME/scratch6/CICE_BASELINE setenv ICE_MACHINE_SUBMIT "sbatch" -setenv ICE_MACHINE_TPNODE 40 -setenv ICE_MACHINE_ACCT P0000000 +setenv ICE_MACHINE_TPNODE 192 +setenv ICE_MACHINE_ACCT A00000 setenv ICE_MACHINE_QUEUE "normal" setenv ICE_MACHINE_BLDTHRDS 1 setenv ICE_MACHINE_QSTAT "squeue --jobs=" diff --git a/configuration/scripts/options/set_nml.box2001 b/configuration/scripts/options/set_nml.box2001 index ad42a4236..1c2fc3683 100644 --- a/configuration/scripts/options/set_nml.box2001 +++ b/configuration/scripts/options/set_nml.box2001 @@ -11,9 +11,8 @@ grid_type = 'rectangular' kmt_type = 'default' dxrect = 16.e5 dyrect = 16.e5 -close_boundaries = .true. -ew_boundary_type = 'open' -ns_boundary_type = 'open' +ew_boundary_type = 'closed' +ns_boundary_type = 'closed' tr_iage = .false. tr_FY = .false. tr_lvl = .false. diff --git a/configuration/scripts/options/set_nml.boxchan b/configuration/scripts/options/set_nml.boxchan index a3f0fd191..67fdaff9c 100644 --- a/configuration/scripts/options/set_nml.boxchan +++ b/configuration/scripts/options/set_nml.boxchan @@ -9,7 +9,6 @@ grid_type = 'rectangular' kmt_type = 'channel' dxrect = 16.e5 dyrect = 16.e5 -close_boundaries = .false. ew_boundary_type = 'cyclic' ns_boundary_type = 'open' tr_iage = .false. diff --git a/configuration/scripts/options/set_nml.boxchan1e b/configuration/scripts/options/set_nml.boxchan1e index cf8b0d314..0a4e92bef 100644 --- a/configuration/scripts/options/set_nml.boxchan1e +++ b/configuration/scripts/options/set_nml.boxchan1e @@ -9,7 +9,6 @@ grid_type = 'rectangular' kmt_type = 'channel_oneeast' dxrect = 16.e5 dyrect = 16.e5 -close_boundaries = .false. ew_boundary_type = 'cyclic' ns_boundary_type = 'open' tr_iage = .false. diff --git a/configuration/scripts/options/set_nml.boxchan1n b/configuration/scripts/options/set_nml.boxchan1n index f90d4da0c..a342f811c 100644 --- a/configuration/scripts/options/set_nml.boxchan1n +++ b/configuration/scripts/options/set_nml.boxchan1n @@ -9,7 +9,6 @@ grid_type = 'rectangular' kmt_type = 'channel_onenorth' dxrect = 16.e5 dyrect = 16.e5 -close_boundaries = .false. ew_boundary_type = 'open' ns_boundary_type = 'cyclic' tr_iage = .false. diff --git a/configuration/scripts/options/set_nml.boxclosed b/configuration/scripts/options/set_nml.boxclosed index d55faa302..ba9d9b4d7 100644 --- a/configuration/scripts/options/set_nml.boxclosed +++ b/configuration/scripts/options/set_nml.boxclosed @@ -9,9 +9,8 @@ grid_type = 'rectangular' kmt_type = 'default' dxrect = 16.e5 dyrect = 16.e5 -close_boundaries = .true. -ew_boundary_type = 'open' -ns_boundary_type = 'open' +ew_boundary_type = 'closed' +ns_boundary_type = 'closed' tr_iage = .false. tr_FY = .false. tr_lvl = .false. diff --git a/configuration/scripts/options/set_nml.boxopen b/configuration/scripts/options/set_nml.boxopen index 84badd373..081865d7a 100644 --- a/configuration/scripts/options/set_nml.boxopen +++ b/configuration/scripts/options/set_nml.boxopen @@ -6,7 +6,6 @@ histfreq = 'd','x','x','x','x' grid_type = 'rectangular' dxrect = 16.e5 dyrect = 16.e5 -close_boundaries = .false. ew_boundary_type = 'cyclic' ns_boundary_type = 'open' ktherm = -1 diff --git a/configuration/scripts/options/set_nml.boxslotcyl b/configuration/scripts/options/set_nml.boxslotcyl index 10f0518c8..de35e21e9 100644 --- a/configuration/scripts/options/set_nml.boxslotcyl +++ b/configuration/scripts/options/set_nml.boxslotcyl @@ -11,9 +11,8 @@ kmt_type = 'default' dxrect = 10.e5 dyrect = 10.e5 kcatbound = 2 -ew_boundary_type = 'open' -ns_boundary_type = 'open' -close_boundaries = .true. +ew_boundary_type = 'closed' +ns_boundary_type = 'closed' tr_lvl = .false. tr_pond_lvl = .false. ktherm = -1 diff --git a/configuration/scripts/options/set_nml.boxwallblock b/configuration/scripts/options/set_nml.boxwallblock index 2e9a34728..352f4c4ad 100644 --- a/configuration/scripts/options/set_nml.boxwallblock +++ b/configuration/scripts/options/set_nml.boxwallblock @@ -9,7 +9,6 @@ grid_type = 'rectangular' kmt_type = 'wall' dxrect = 16.e5 dyrect = 16.e5 -close_boundaries = .false. ew_boundary_type = 'cyclic' ns_boundary_type = 'cyclic' tr_iage = .false. diff --git a/configuration/scripts/options/set_nml.restaicetest b/configuration/scripts/options/set_nml.restaicetest new file mode 100644 index 000000000..3d779d732 --- /dev/null +++ b/configuration/scripts/options/set_nml.restaicetest @@ -0,0 +1,2 @@ +restart_mod = "adjust_aice_test" + diff --git a/configuration/scripts/tests/base_suite.ts b/configuration/scripts/tests/base_suite.ts index 46f2c1900..4af813211 100644 --- a/configuration/scripts/tests/base_suite.ts +++ b/configuration/scripts/tests/base_suite.ts @@ -86,3 +86,4 @@ restart gx3 4x4 diag1,gx3ncarbulk,short smoke gx3 4x1 calcdragio restart gx3 4x2 atmbndyconstant restart gx3 4x2 atmbndymixed +smoke gx3 12x2 diag1,run5day,restaicetest,debug diff --git a/configuration/scripts/tests/baseline.script b/configuration/scripts/tests/baseline.script index 9fd2fe001..168824010 100644 --- a/configuration/scripts/tests/baseline.script +++ b/configuration/scripts/tests/baseline.script @@ -136,17 +136,17 @@ if (${ICE_BFBCOMP} != ${ICE_SPVAL}) then set cnt = 0 if (${job} =~ [0-9]*) then while ($qstatjob) - ${ICE_MACHINE_QSTAT} $job >&/dev/null - set qstatus = $status + set qstatus = `${ICE_MACHINE_QSTAT} $job | grep $job | wc -l` +# ${ICE_MACHINE_QSTAT} $job # echo $job $qstatus - if ($qstatus != 0) then + if ($qstatus == 0) then echo "Job $job completed" set qstatjob = 0 else @ cnt = $cnt + 1 echo "Waiting for $job to complete $cnt" sleep 60 # Sleep for 1 minute, so as not to overwhelm the queue manager - if ($cnt > 30) then + if ($cnt > 5) then echo "No longer waiting for $job to complete" set qstatjob = 0 # Abandon check after cnt sleep 60 checks endif diff --git a/doc/source/cice_index.rst b/doc/source/cice_index.rst index 949ab80b6..f46fbaa8d 100644 --- a/doc/source/cice_index.rst +++ b/doc/source/cice_index.rst @@ -595,6 +595,7 @@ section :ref:`tabnamelist`. "restart_file", "restart file prefix", "" "restart_format", "restart file format", "" "restart_iotasks", "restart output total number of tasks used", "" + "restart_mod", "restart modification mode", "" "restart_rearranger", "restart output io rearranger method", "" "restart_root", "restart output io root task id", "" "restart_stride", "restart output io task stride", "" diff --git a/doc/source/conf.py b/doc/source/conf.py index a71bef070..458d72887 100644 --- a/doc/source/conf.py +++ b/doc/source/conf.py @@ -57,7 +57,7 @@ # General information about the project. project = u'CICE' -copyright = u'1998, 2017, Triad National Security, LLC (code) and National Center for Atmospheric Research (documentation)' +copyright = u'1998-2025, Triad National Security, LLC (code) and National Center for Atmospheric Research (documentation)' author = u'CICE-Consortium' # The version info for the project you're documenting, acts as replacement for @@ -65,9 +65,9 @@ # built documents. # # The short X.Y version. -version = u'6.6.1' +version = u'6.6.2' # The full version, including alpha/beta/rc tags. -version = u'6.6.1' +version = u'6.6.2' # The language for content autogenerated by Sphinx. Refer to documentation # for a list of supported languages. diff --git a/doc/source/developer_guide/dg_assim.rst b/doc/source/developer_guide/dg_assim.rst new file mode 100644 index 000000000..cdcfb9eaa --- /dev/null +++ b/doc/source/developer_guide/dg_assim.rst @@ -0,0 +1,37 @@ +:tocdepth: 3 + +.. _dataassimilation: + +Data Assimilation +====================== + +Data assimilation (DA) is the scientific process of combining external +data with numerical model forecasts. There are several ways this can +be done including by adjusting the model initial conditions (internally +or externally) or adjusting the model solution as it evolves in time. +Various data assimilation options are being introduced in CICE and are +described below. + +.. _restartmod: + +Data Assimilation on restart +------------------------------------ + +The namelist variable, ``restart_mod``, specifies the restart DA mode. +By default, this namelist value is set to ``none`` which disables the feature. +The current active options are ``adjust_aice`` and ``adjust_aice_test``. + +With ``adjust_aice`` and ``adjust_aice_test``, the category averaged aice +value is modified at restart to specified values using the method implemented in +**cicecore/cicedyn/infrastructure/ice_restart_driver.F90** subroutine +**direct_adjust_aice**. This method adjusts aice, vice, vsno, qice, and +sice in all categories to be consistent with the category average aice +specified. It also adjusts several thermodynamic variables such as +temperature and salinity (see :cite:`Posey15`). +``adjust_aice`` reads in a sea ice concentration +field from an external file. The field is currently hardwired to 'sic' and the +file is currently hardwired to 'sic.nc'. The field must be on the model grid. +``adjust_aice_test`` modifies the +aice field read on restart internally. The current implementation rounds +the aice values read at restart to the nearest 1/100th. This mode exists +primarily to test the feature. diff --git a/doc/source/developer_guide/index.rst b/doc/source/developer_guide/index.rst index 680746beb..e8ed32408 100644 --- a/doc/source/developer_guide/index.rst +++ b/doc/source/developer_guide/index.rst @@ -16,6 +16,7 @@ Developer Guide dg_infra.rst dg_driver.rst dg_forcing.rst + dg_assim.rst dg_icepack.rst dg_scripts.rst dg_tools.rst diff --git a/doc/source/intro/copyright.rst b/doc/source/intro/copyright.rst index c72da7fbd..7d4830aa7 100644 --- a/doc/source/intro/copyright.rst +++ b/doc/source/intro/copyright.rst @@ -5,7 +5,7 @@ Copyright ============================= -© Copyright 1998, 2017, Triad National Security, LLC +Copyright 1998-2025, Triad National Security, LLC All rights reserved. This program was produced under U.S. Government contract 89233218CNA000001 for Los Alamos National Laboratory (LANL), which is operated by Triad National Security, LLC for the U.S. Department of Energy/National Nuclear Security Administration. All rights in the program are reserved by Triad National Security, LLC, and the U.S. Department of Energy/National Nuclear Security Administration. The Government is granted for itself and others acting on its behalf a nonexclusive, paid-up, irrevocable worldwide license in this material to reproduce, prepare. derivative works, distribute copies to the public, perform publicly and display publicly, and to permit others to do so. diff --git a/doc/source/master_list.bib b/doc/source/master_list.bib index 6e3bb9b40..a91511ccd 100644 --- a/doc/source/master_list.bib +++ b/doc/source/master_list.bib @@ -1041,7 +1041,7 @@ @incollection{Arakawa77 @article{Horvat15, author = "C. Horvat and E. Tziperman", - journal = {The Cryosphere}, + journal = TC, number = {6}, pages = {2119-2134}, title = "{A prognostic model of the sea-ice floe size and thickness distribution}", @@ -1113,6 +1113,16 @@ @Article{Tsujino18 pages = {79-139}, url = {http://dx.doi.org/10.1016/j.ocemod.2018.07.002} } + +@Article{Posey15, + author = "P.G. Posey and E.J. Metzger and A.J. Wallcraft and D.A. Hebert and R.A. Allard and O.M. Smedstad and M.W. Phelps and F. Fetterer and J.S. Stewart and W.N. Meier and S.R. Helfrich", + title = "{Improving Arctic sea ice edge forecasts by assimilating high horizontal resolution sea ice concentration data into the US Navy's ice forecast system}", + journal = TC, + year = {2015}, + volume = {9}, + pages = {1735-1745}, + url = {https://doi.org/10.5194/tc-9-1735-2015} +} % ********************************************** % For new entries, see example entry in BIB_TEMPLATE.txt % ********************************************** diff --git a/doc/source/user_guide/ug_case_settings.rst b/doc/source/user_guide/ug_case_settings.rst index 2f705e64c..98bc7268f 100644 --- a/doc/source/user_guide/ug_case_settings.rst +++ b/doc/source/user_guide/ug_case_settings.rst @@ -266,6 +266,9 @@ setup_nml "", "``pnetcdf2``", "write restart files with pnetcdf cdf2 (netcdf3-64bit-offset) format", "" "", "``pnetcdf5``", "write restart files with pnetcdf cdf5 (netcdf3-64bit-data) format", "" "``restart_iotasks``", "integer", "pe io tasks for restart output with restart_root and restart_stride (PIO only), -99=internal default", "-99" + "``restart_mod``", "``adjust_aice``", "adjust aice on restart read from file", "none" + "", "``adjust_aice_test``", "adjust aice on restart read rounding", "" + "", "``none``", "no modification of restart at read", "" "``restart_rearranger``", "``box``", "box io rearranger option for restart output (PIO only)", "default" "", "``default``", "internal default io rearranger option for restart output", "" "", "``subset``", "subset io rearranger option for restart output", "" @@ -294,7 +297,7 @@ grid_nml "``bathymetry_file``", "string", "name of bathymetry file to be read", "'unknown_bathymetry_file'" "``bathymetry_format``", "``default``", "NetCDF depth field", "'default'" "", "``pop``", "POP thickness file in cm in ascii format", "" - "``close_boundaries``", "logical", "force two gridcell wide land mask on boundaries for rectangular grids", "``.false.``" + "``close_boundaries``", "logical", "deprecated Nov, 2025, use ew_boundary_type and ns_boundary_type", "``.false.``" "``dxrect``", "real", "x-direction grid spacing for rectangular grid in cm", "0.0" "``dxscale``", "real", "user defined rectgrid x-grid scale factor", "1.0" "``dyrect``", "real", "y-direction grid spacing for rectangular grid in cm", "0.0" @@ -373,7 +376,8 @@ domain_nml "", "``blockfull``", "block method with NO land block elimination and full weight given to land blocks", "" "", "``latitude``", "latitude/ocean sets ``work_per_block``", "" "``distribution_wght_file``", "string", "distribution weight file when distribution_type is ``wghtfile``", "'unknown'" - "``ew_boundary_type``", "``cyclic``", "periodic boundary conditions in x-direction", "``cyclic``" + "``ew_boundary_type``", "``closed``", "force two gridcell wide land mask on x-direction boundaries for rectangular grids", "``cyclic``" + "", "``cyclic``", "periodic boundary conditions in x-direction", "" "", "``open``", "Dirichlet boundary conditions in x", "" "``maskhalo_dyn``", "logical", "mask unused halo cells for dynamics", "``.false.``" "``maskhalo_remap``", "logical", "mask unused halo cells for transport", "``.false.``" @@ -382,7 +386,8 @@ domain_nml "", "``-1``", "find number of blocks per MPI task automatically", "" "``nprocs``", "integer", "number of MPI tasks to use", "-1" "", "``-1``", "find number of MPI tasks automatically", "" - "``ns_boundary_type``", "``cyclic``", "periodic boundary conditions in y-direction", "``open``" + "``ns_boundary_type``", "``closed``", "force two gridcell wide land mask on y-direction boundaries for rectangular grids", "``cyclic``" + "", "``cyclic``", "periodic boundary conditions in y-direction", "" "", "``open``", "Dirichlet boundary conditions in y", "" "", "``tripole``", "U-fold tripole boundary conditions in y", "" "", "``tripoleT``", "T-fold tripole boundary conditions in y", "" diff --git a/doc/source/user_guide/ug_implementation.rst b/doc/source/user_guide/ug_implementation.rst index 69c288ee8..17b1f618e 100644 --- a/doc/source/user_guide/ug_implementation.rst +++ b/doc/source/user_guide/ug_implementation.rst @@ -421,7 +421,7 @@ Tinz and Tsnz, and the ice salinity profile, Sinz. These variables also include category as a fourth dimension. ******************* -Boundary conditions +Boundary Conditions ******************* Much of the infrastructure used in CICE, including the boundary @@ -430,33 +430,39 @@ communications among processors when MPI is in use and among blocks whenever there is more than one block per processor. Boundary conditions are defined by the ``ns_boundary_type`` and ``ew_boundary_type`` -namelist inputs. Valid values are ``open`` and ``cyclic``. In addition, +namelist inputs. Valid values are ``open``, ``closed``, and ``cyclic``. In addition, ``tripole`` and ``tripoleT`` are options for the ``ns_boundary_type``. -Closed boundary conditions are not supported currently. -The domain can be physically closed with the ``close_boundaries`` -namelist which forces a land mask on the boundary with a two gridcell depth. -Where the boundary is land, the boundary_type settings play no role. -For example, in the displaced-pole grids, at least one row of grid cells along the north -and south boundaries is land. Along the east/west domain boundaries not -masked by land, periodic conditions wrap the domain around the globe. In +``closed`` imposes a land mask on the boundary with a two gridcell depth +and is only supported for rectangular grids. In general, +where the boundary is land or where there is no ice on the boundary, +the boundary_type settings and boundary conditions play no role. + +In the displaced-pole global grids, the mask (kmt) file has at least one row of +grid cells along the north and south boundaries that is land. Along the east/west +domain boundaries, periodic conditions wrap the domain around the globe. In this example, -the appropriate namelist settings are ``nsboundary_type`` = ``open``, -``ew_boundary_type`` = ``cyclic``, and ``close_boundaries`` = ``.false.``. - -CICE can be run on regional grids with open boundary conditions; except -for variables describing grid lengths, non-land halo cells along the -grid edge must be filled by restoring them to specified values. The -namelist variable ``restore_ice`` turns this functionality on and off; the +the appropriate namelist settings are ``ns_boundary_type`` = ``open``, +``ew_boundary_type`` = ``cyclic``. + +CICE can be run on regional grids with ``open``, ``closed``, or ``cyclic`` +boundary conditions. +Except for variables describing grid lengths, non-land halo cells along the +grid edge must be filled with some boundary conditions +if ice is present at that location. The outside halo is handled automatically +with ``closed`` or ``cyclic`` conditions. With open boundary conditions, one can imagine +several different ways to set the outside boundary including reading values from +an external file or deriving values on that halo based on the interior +solution while specifying zero gradient, constant gradient, specified state, +zero flux, or other boundary conditions. Mathematically specified boundary +conditions are currently not supported in the CICE model. + +The namelist variable ``restore_ice`` turns on a restoring capability on the +boundary by setting the boundary halo to values read from a file. The restoring timescale ``trestore`` may be used (it is also used for restoring ocean sea surface temperature in stand-alone ice runs). This implementation is only intended to provide the “hooks" for a more -sophisticated treatment; the rectangular grid option can be used to test -this configuration. The ‘displaced_pole’ grid option should not be used -unless the regional grid contains land all along the north and south -boundaries. The current form of the boundary condition routines does not -allow Neumann boundary conditions, which must be set explicitly. This -has been done in an unreleased branch of the code; contact Elizabeth for -more information. +sophisticated treatment. The rectangular grid option can be used to test +this configuration. For exact restarts using restoring, set ``restart_ext`` = true in namelist to use the extended-grid subroutines. diff --git a/icepack b/icepack index 6a5c51e9e..4954a6f90 160000 --- a/icepack +++ b/icepack @@ -1 +1 @@ -Subproject commit 6a5c51e9e6c643da0760a315e452755661d7d745 +Subproject commit 4954a6f9033f78e5c32bf33780384cbf2d0843e6