From 4e51baea178a1bec83017acc7d870fd992397d54 Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Fri, 7 Aug 2020 10:48:38 -0400 Subject: [PATCH 01/35] Revert "Merge remote-tracking branch 'upstream/dev/emc' into dev/emc" This reverts commit e4ca1dcb0fab0f6db08f23e3f15c43035a4b75c4, reversing changes made to 40bfb4bfe375e66df5ea1127d9799656251dc7fd. --- config_src/nuopc_driver/mom_cap.F90 | 35 +--- config_src/nuopc_driver/mom_cap_methods.F90 | 183 +------------------- 2 files changed, 8 insertions(+), 210 deletions(-) diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index d49f370a47..a8056129ff 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -26,7 +26,7 @@ module MOM_cap_mod use time_manager_mod, only: fms_get_calendar_type => get_calendar_type use MOM_domains, only: MOM_infra_init, num_pes, root_pe, pe_here use MOM_file_parser, only: get_param, log_version, param_file_type, close_param_file -use MOM_get_input, only: get_MOM_input, directories +use MOM_get_input, only: Get_MOM_Input, directories use MOM_domains, only: pass_var use MOM_error_handler, only: MOM_error, FATAL, is_root_pe use MOM_ocean_model_nuopc, only: ice_ocean_boundary_type @@ -36,7 +36,7 @@ module MOM_cap_mod use MOM_ocean_model_nuopc, only: ocean_model_init, update_ocean_model, ocean_model_end use MOM_ocean_model_nuopc, only: get_ocean_grid, get_eps_omesh use MOM_cap_time, only: AlarmInit -use MOM_cap_methods, only: mom_import, mom_export, mom_set_geomtype, state_diagnose +use MOM_cap_methods, only: mom_import, mom_export, mom_set_geomtype #ifdef CESMCOUPLED use shr_file_mod, only: shr_file_setLogUnit, shr_file_getLogUnit #endif @@ -124,7 +124,7 @@ module MOM_cap_mod integer :: fldsFrOcn_num = 0 type (fld_list_type) :: fldsFrOcn(fldsMax) -integer :: dbug = 0 +integer :: debug = 0 integer :: import_slice = 1 integer :: export_slice = 1 character(len=256) :: tmpstr @@ -273,14 +273,6 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) write(logmsg,*) grid_attach_area call ESMF_LogWrite('MOM_cap:GridAttachArea = '//trim(logmsg), ESMF_LOGMSG_INFO) - call NUOPC_CompAttributeGet(gcomp, name='dbug_flag', value=value, isPresent=isPresent, isSet=isSet, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (isPresent .and. isSet) then - read(value,*) dbug - end if - write(logmsg,'(i6)') dbug - call ESMF_LogWrite('MOM_cap:dbug = '//trim(logmsg), ESMF_LOGMSG_INFO) - scalar_field_name = "" call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldName", value=value, & isPresent=isPresent, isSet=isSet, rc=rc) @@ -366,7 +358,6 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) type(ice_ocean_boundary_type), pointer :: Ice_ocean_boundary => NULL() type(ocean_internalstate_wrapper) :: ocean_internalstate type(ocean_grid_type), pointer :: ocean_grid => NULL() - type(directories) :: dirs type(time_type) :: Run_len !< length of experiment type(time_type) :: time0 !< Start time of coupled model's calendar. type(time_type) :: time_start !< The time at which to initialize the ocean model @@ -529,13 +520,8 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) restartfile = "" if (runtype == "initial") then - if (cesm_coupled) then - restartfile = "n" - else - call get_MOM_input(dirs=dirs) - restartfile = dirs%input_filename(1:1) - endif - call ESMF_LogWrite('MOM_cap:restartfile = '//trim(restartfile), ESMF_LOGMSG_INFO) + + restartfile = "n" else if (runtype == "continue") then ! hybrid or branch or continuos runs @@ -835,7 +821,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) allocate(xb(ntiles),xe(ntiles),yb(ntiles),ye(ntiles),pe(ntiles)) call mpp_get_compute_domains(ocean_public%domain, xbegin=xb, xend=xe, ybegin=yb, yend=ye) call mpp_get_pelist(ocean_public%domain, pe) - if (dbug > 1) then + if (debug > 0) then do n = 1,ntiles write(tmpstr,'(a,6i6)') subname//' tiles ',n,pe(n),xb(n),xe(n),yb(n),ye(n) call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) @@ -1445,11 +1431,6 @@ subroutine ModelAdvance(gcomp, rc) enddo endif - if (dbug > 0) then - call state_diagnose(importState,subname//':IS ',rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if - !--------------- ! Get ocean grid !--------------- @@ -1478,10 +1459,6 @@ subroutine ModelAdvance(gcomp, rc) call mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (dbug > 0) then - call state_diagnose(exportState,subname//':ES ',rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if endif !--------------- diff --git a/config_src/nuopc_driver/mom_cap_methods.F90 b/config_src/nuopc_driver/mom_cap_methods.F90 index 0997fbc635..8aca45094f 100644 --- a/config_src/nuopc_driver/mom_cap_methods.F90 +++ b/config_src/nuopc_driver/mom_cap_methods.F90 @@ -5,7 +5,7 @@ module MOM_cap_methods use ESMF, only: ESMF_TimeInterval, ESMF_TimeIntervalGet use ESMF, only: ESMF_State, ESMF_StateGet use ESMF, only: ESMF_Field, ESMF_FieldGet, ESMF_FieldCreate -use ESMF, only: ESMF_GridComp, ESMF_Mesh, ESMF_MeshGet, ESMF_Grid, ESMF_GridCreate +use ESMF, only: ESMF_GridComp, ESMF_Mesh, ESMF_Grid, ESMF_GridCreate use ESMF, only: ESMF_DistGrid, ESMF_DistGridCreate use ESMF, only: ESMF_KIND_R8, ESMF_SUCCESS, ESMF_LogFoundError use ESMF, only: ESMF_LOGERR_PASSTHRU, ESMF_LOGMSG_INFO, ESMF_LOGWRITE @@ -13,8 +13,7 @@ module MOM_cap_methods use ESMF, only: ESMF_StateItem_Flag, ESMF_STATEITEM_NOTFOUND use ESMF, only: ESMF_GEOMTYPE_FLAG, ESMF_GEOMTYPE_GRID, ESMF_GEOMTYPE_MESH use ESMF, only: ESMF_RC_VAL_OUTOFRANGE, ESMF_INDEX_DELOCAL, ESMF_MESHLOC_ELEMENT -use ESMF, only: ESMF_TYPEKIND_R8, ESMF_FIELDSTATUS_COMPLETE -use ESMF, only: ESMF_FieldStatus_Flag, ESMF_LOGMSG_ERROR, ESMF_FAILURE, ESMF_MAXSTR +use ESMF, only: ESMF_TYPEKIND_R8 use ESMF, only: operator(/=), operator(==) use MOM_ocean_model_nuopc, only: ocean_public_type, ocean_state_type use MOM_surface_forcing_nuopc, only: ice_ocean_boundary_type @@ -29,7 +28,6 @@ module MOM_cap_methods public :: mom_set_geomtype public :: mom_import public :: mom_export -public :: state_diagnose private :: State_getImport private :: State_setExport @@ -765,183 +763,6 @@ subroutine State_SetExport(state, fldname, isc, iec, jsc, jec, input, ocean_grid end subroutine State_SetExport -subroutine state_diagnose(State, string, rc) - - ! ---------------------------------------------- - ! Diagnose status of State - ! ---------------------------------------------- - - type(ESMF_State), intent(in) :: state - character(len=*), intent(in) :: string - integer , intent(out) :: rc - - ! local variables - integer :: i,j,n - type(ESMf_Field) :: lfield - integer :: fieldCount, lrank - character(ESMF_MAXSTR) ,pointer :: lfieldnamelist(:) - real(ESMF_KIND_R8), pointer :: dataPtr1d(:) - real(ESMF_KIND_R8), pointer :: dataPtr2d(:,:) - character(len=*),parameter :: subname='(state_diagnose)' - character(len=ESMF_MAXSTR) :: msgString - ! ---------------------------------------------- - - call ESMF_StateGet(state, itemCount=fieldCount, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - allocate(lfieldnamelist(fieldCount)) - - call ESMF_StateGet(state, itemNameList=lfieldnamelist, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - do n = 1, fieldCount - - call ESMF_StateGet(state, itemName=lfieldnamelist(n), field=lfield, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - call field_getfldptr(lfield, fldptr1=dataPtr1d, fldptr2=dataPtr2d, rank=lrank, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - if (lrank == 0) then - ! no local data - elseif (lrank == 1) then - if (size(dataPtr1d) > 0) then - write(msgString,'(A,3g14.7,i8)') trim(string)//': '//trim(lfieldnamelist(n)), & - minval(dataPtr1d), maxval(dataPtr1d), sum(dataPtr1d), size(dataPtr1d) - else - write(msgString,'(A,a)') trim(string)//': '//trim(lfieldnamelist(n))," no data" - endif - elseif (lrank == 2) then - if (size(dataPtr2d) > 0) then - write(msgString,'(A,3g14.7,i8)') trim(string)//': '//trim(lfieldnamelist(n)), & - minval(dataPtr2d), maxval(dataPtr2d), sum(dataPtr2d), size(dataPtr2d) - else - write(msgString,'(A,a)') trim(string)//': '//trim(lfieldnamelist(n))," no data" - endif - else - call ESMF_LogWrite(trim(subname)//": ERROR rank not supported ", ESMF_LOGMSG_ERROR) - rc = ESMF_FAILURE - return - endif - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) - enddo - - deallocate(lfieldnamelist) - -end subroutine state_diagnose - -!=============================================================================== - -subroutine field_getfldptr(field, fldptr1, fldptr2, rank, abort, rc) - - ! ---------------------------------------------- - ! for a field, determine rank and return fldptr1 or fldptr2 - ! abort is true by default and will abort if fldptr is not yet allocated in field - ! rank returns 0, 1, or 2. 0 means fldptr not allocated and abort=false - ! ---------------------------------------------- - - ! input/output variables - type(ESMF_Field) , intent(in) :: field - real(ESMF_KIND_R8), pointer , intent(inout), optional :: fldptr1(:) - real(ESMF_KIND_R8), pointer , intent(inout), optional :: fldptr2(:,:) - integer , intent(out) , optional :: rank - logical , intent(in) , optional :: abort - integer , intent(out) , optional :: rc - - ! local variables - type(ESMF_GeomType_Flag) :: geomtype - type(ESMF_FieldStatus_Flag) :: status - type(ESMF_Mesh) :: lmesh - integer :: lrank, nnodes, nelements - logical :: labort - character(len=*), parameter :: subname='(field_getfldptr)' - ! ---------------------------------------------- - - if (.not.present(rc)) then - call ESMF_LogWrite(trim(subname)//": ERROR rc not present ", & - ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) - rc = ESMF_FAILURE - return - endif - - rc = ESMF_SUCCESS - - labort = .true. - if (present(abort)) then - labort = abort - endif - lrank = -99 - - call ESMF_FieldGet(field, status=status, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - if (status /= ESMF_FIELDSTATUS_COMPLETE) then - lrank = 0 - if (labort) then - call ESMF_LogWrite(trim(subname)//": ERROR data not allocated ", ESMF_LOGMSG_INFO, rc=rc) - rc = ESMF_FAILURE - return - else - call ESMF_LogWrite(trim(subname)//": WARNING data not allocated ", ESMF_LOGMSG_INFO, rc=rc) - endif - else - - call ESMF_FieldGet(field, geomtype=geomtype, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - if (geomtype == ESMF_GEOMTYPE_GRID) then - call ESMF_FieldGet(field, rank=lrank, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - elseif (geomtype == ESMF_GEOMTYPE_MESH) then - call ESMF_FieldGet(field, rank=lrank, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, mesh=lmesh, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_MeshGet(lmesh, numOwnedNodes=nnodes, numOwnedElements=nelements, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - if (nnodes == 0 .and. nelements == 0) lrank = 0 - else - call ESMF_LogWrite(trim(subname)//": ERROR geomtype not supported ", & - ESMF_LOGMSG_INFO, rc=rc) - rc = ESMF_FAILURE - return - endif ! geomtype - - if (lrank == 0) then - call ESMF_LogWrite(trim(subname)//": no local nodes or elements ", & - ESMF_LOGMSG_INFO) - elseif (lrank == 1) then - if (.not.present(fldptr1)) then - call ESMF_LogWrite(trim(subname)//": ERROR missing rank=1 array ", & - ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) - rc = ESMF_FAILURE - return - endif - call ESMF_FieldGet(field, farrayPtr=fldptr1, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - elseif (lrank == 2) then - if (.not.present(fldptr2)) then - call ESMF_LogWrite(trim(subname)//": ERROR missing rank=2 array ", & - ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) - rc = ESMF_FAILURE - return - endif - call ESMF_FieldGet(field, farrayPtr=fldptr2, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - else - call ESMF_LogWrite(trim(subname)//": ERROR in rank ", & - ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) - rc = ESMF_FAILURE - return - endif - - endif ! status - - if (present(rank)) then - rank = lrank - endif - -end subroutine field_getfldptr - logical function chkerr(rc, line, file) integer, intent(in) :: rc integer, intent(in) :: line From 6164f63a9846b1eba00cac2b264dcf4d73b27013 Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Tue, 1 Sep 2020 08:08:17 -0400 Subject: [PATCH 02/35] manual add of dev/emc changes (statediagnose) --- config_src/nuopc_driver/mom_cap.F90 | 32 +++- config_src/nuopc_driver/mom_cap_methods.F90 | 182 +++++++++++++++++++- 2 files changed, 207 insertions(+), 7 deletions(-) diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index a8056129ff..f70eddebdb 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -26,7 +26,7 @@ module MOM_cap_mod use time_manager_mod, only: fms_get_calendar_type => get_calendar_type use MOM_domains, only: MOM_infra_init, num_pes, root_pe, pe_here use MOM_file_parser, only: get_param, log_version, param_file_type, close_param_file -use MOM_get_input, only: Get_MOM_Input, directories +use MOM_get_input, only: get_MOM_input, directories use MOM_domains, only: pass_var use MOM_error_handler, only: MOM_error, FATAL, is_root_pe use MOM_ocean_model_nuopc, only: ice_ocean_boundary_type @@ -36,7 +36,7 @@ module MOM_cap_mod use MOM_ocean_model_nuopc, only: ocean_model_init, update_ocean_model, ocean_model_end use MOM_ocean_model_nuopc, only: get_ocean_grid, get_eps_omesh use MOM_cap_time, only: AlarmInit -use MOM_cap_methods, only: mom_import, mom_export, mom_set_geomtype +use MOM_cap_methods, only: mom_import, mom_export, mom_set_geomtype, state_diagnose #ifdef CESMCOUPLED use shr_file_mod, only: shr_file_setLogUnit, shr_file_getLogUnit #endif @@ -124,7 +124,7 @@ module MOM_cap_mod integer :: fldsFrOcn_num = 0 type (fld_list_type) :: fldsFrOcn(fldsMax) -integer :: debug = 0 +integer :: dbug = 0 integer :: import_slice = 1 integer :: export_slice = 1 character(len=256) :: tmpstr @@ -272,6 +272,13 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) if (isPresent .and. isSet) grid_attach_area=(trim(value)=="true") write(logmsg,*) grid_attach_area call ESMF_LogWrite('MOM_cap:GridAttachArea = '//trim(logmsg), ESMF_LOGMSG_INFO) + call NUOPC_CompAttributeGet(gcomp, name='dbug_flag', value=value, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + read(value,*) dbug + end if + write(logmsg,'(i6)') dbug + call ESMF_LogWrite('MOM_cap:dbug = '//trim(logmsg), ESMF_LOGMSG_INFO) scalar_field_name = "" call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldName", value=value, & @@ -358,6 +365,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) type(ice_ocean_boundary_type), pointer :: Ice_ocean_boundary => NULL() type(ocean_internalstate_wrapper) :: ocean_internalstate type(ocean_grid_type), pointer :: ocean_grid => NULL() + type(directories) :: dirs type(time_type) :: Run_len !< length of experiment type(time_type) :: time0 !< Start time of coupled model's calendar. type(time_type) :: time_start !< The time at which to initialize the ocean model @@ -521,7 +529,13 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) restartfile = "" if (runtype == "initial") then - restartfile = "n" + if (cesm_coupled) then + restartfile = "n" + else + call get_MOM_input(dirs=dirs) + restartfile = dirs%input_filename(1:1) + endif + call ESMF_LogWrite('MOM_cap:restartfile = '//trim(restartfile), ESMF_LOGMSG_INFO) else if (runtype == "continue") then ! hybrid or branch or continuos runs @@ -821,7 +835,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) allocate(xb(ntiles),xe(ntiles),yb(ntiles),ye(ntiles),pe(ntiles)) call mpp_get_compute_domains(ocean_public%domain, xbegin=xb, xend=xe, ybegin=yb, yend=ye) call mpp_get_pelist(ocean_public%domain, pe) - if (debug > 0) then + if (dbug > 1) then do n = 1,ntiles write(tmpstr,'(a,6i6)') subname//' tiles ',n,pe(n),xb(n),xe(n),yb(n),ye(n) call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) @@ -1430,6 +1444,10 @@ subroutine ModelAdvance(gcomp, rc) endif enddo endif + if (dbug > 0) then + call state_diagnose(importState,subname//':IS ',rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if !--------------- ! Get ocean grid @@ -1459,6 +1477,10 @@ subroutine ModelAdvance(gcomp, rc) call mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (dbug > 0) then + call state_diagnose(exportState,subname//':ES ',rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if endif !--------------- diff --git a/config_src/nuopc_driver/mom_cap_methods.F90 b/config_src/nuopc_driver/mom_cap_methods.F90 index 8aca45094f..22938d91f4 100644 --- a/config_src/nuopc_driver/mom_cap_methods.F90 +++ b/config_src/nuopc_driver/mom_cap_methods.F90 @@ -5,7 +5,7 @@ module MOM_cap_methods use ESMF, only: ESMF_TimeInterval, ESMF_TimeIntervalGet use ESMF, only: ESMF_State, ESMF_StateGet use ESMF, only: ESMF_Field, ESMF_FieldGet, ESMF_FieldCreate -use ESMF, only: ESMF_GridComp, ESMF_Mesh, ESMF_Grid, ESMF_GridCreate +use ESMF, only: ESMF_GridComp, ESMF_Mesh, ESMF_MeshGet, ESMF_Grid, ESMF_GridCreate use ESMF, only: ESMF_DistGrid, ESMF_DistGridCreate use ESMF, only: ESMF_KIND_R8, ESMF_SUCCESS, ESMF_LogFoundError use ESMF, only: ESMF_LOGERR_PASSTHRU, ESMF_LOGMSG_INFO, ESMF_LOGWRITE @@ -13,7 +13,8 @@ module MOM_cap_methods use ESMF, only: ESMF_StateItem_Flag, ESMF_STATEITEM_NOTFOUND use ESMF, only: ESMF_GEOMTYPE_FLAG, ESMF_GEOMTYPE_GRID, ESMF_GEOMTYPE_MESH use ESMF, only: ESMF_RC_VAL_OUTOFRANGE, ESMF_INDEX_DELOCAL, ESMF_MESHLOC_ELEMENT -use ESMF, only: ESMF_TYPEKIND_R8 +use ESMF, only: ESMF_TYPEKIND_R8, ESMF_FIELDSTATUS_COMPLETE +use ESMF, only: ESMF_FieldStatus_Flag, ESMF_LOGMSG_ERROR, ESMF_FAILURE, ESMF_MAXSTR use ESMF, only: operator(/=), operator(==) use MOM_ocean_model_nuopc, only: ocean_public_type, ocean_state_type use MOM_surface_forcing_nuopc, only: ice_ocean_boundary_type @@ -28,6 +29,7 @@ module MOM_cap_methods public :: mom_set_geomtype public :: mom_import public :: mom_export +public :: state_diagnose private :: State_getImport private :: State_setExport @@ -762,6 +764,182 @@ subroutine State_SetExport(state, fldname, isc, iec, jsc, jec, input, ocean_grid endif end subroutine State_SetExport +subroutine state_diagnose(State, string, rc) + + ! ---------------------------------------------- + ! Diagnose status of State + ! ---------------------------------------------- + + type(ESMF_State), intent(in) :: state + character(len=*), intent(in) :: string + integer , intent(out) :: rc + + ! local variables + integer :: i,j,n + type(ESMf_Field) :: lfield + integer :: fieldCount, lrank + character(ESMF_MAXSTR) ,pointer :: lfieldnamelist(:) + real(ESMF_KIND_R8), pointer :: dataPtr1d(:) + real(ESMF_KIND_R8), pointer :: dataPtr2d(:,:) + character(len=*),parameter :: subname='(state_diagnose)' + character(len=ESMF_MAXSTR) :: msgString + ! ---------------------------------------------- + + call ESMF_StateGet(state, itemCount=fieldCount, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + allocate(lfieldnamelist(fieldCount)) + + call ESMF_StateGet(state, itemNameList=lfieldnamelist, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + do n = 1, fieldCount + + call ESMF_StateGet(state, itemName=lfieldnamelist(n), field=lfield, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call field_getfldptr(lfield, fldptr1=dataPtr1d, fldptr2=dataPtr2d, rank=lrank, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if (lrank == 0) then + ! no local data + elseif (lrank == 1) then + if (size(dataPtr1d) > 0) then + write(msgString,'(A,3g14.7,i8)') trim(string)//': '//trim(lfieldnamelist(n)), & + minval(dataPtr1d), maxval(dataPtr1d), sum(dataPtr1d), size(dataPtr1d) + else + write(msgString,'(A,a)') trim(string)//': '//trim(lfieldnamelist(n))," no data" + endif + elseif (lrank == 2) then + if (size(dataPtr2d) > 0) then + write(msgString,'(A,3g14.7,i8)') trim(string)//': '//trim(lfieldnamelist(n)), & + minval(dataPtr2d), maxval(dataPtr2d), sum(dataPtr2d), size(dataPtr2d) + else + write(msgString,'(A,a)') trim(string)//': '//trim(lfieldnamelist(n))," no data" + endif + else + call ESMF_LogWrite(trim(subname)//": ERROR rank not supported ", ESMF_LOGMSG_ERROR) + rc = ESMF_FAILURE + return + endif + call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) + enddo + + deallocate(lfieldnamelist) + +end subroutine state_diagnose + +!=============================================================================== + +subroutine field_getfldptr(field, fldptr1, fldptr2, rank, abort, rc) + + ! ---------------------------------------------- + ! for a field, determine rank and return fldptr1 or fldptr2 + ! abort is true by default and will abort if fldptr is not yet allocated in field + ! rank returns 0, 1, or 2. 0 means fldptr not allocated and abort=false + ! ---------------------------------------------- + + ! input/output variables + type(ESMF_Field) , intent(in) :: field + real(ESMF_KIND_R8), pointer , intent(inout), optional :: fldptr1(:) + real(ESMF_KIND_R8), pointer , intent(inout), optional :: fldptr2(:,:) + integer , intent(out) , optional :: rank + logical , intent(in) , optional :: abort + integer , intent(out) , optional :: rc + + ! local variables + type(ESMF_GeomType_Flag) :: geomtype + type(ESMF_FieldStatus_Flag) :: status + type(ESMF_Mesh) :: lmesh + integer :: lrank, nnodes, nelements + logical :: labort + character(len=*), parameter :: subname='(field_getfldptr)' + ! ---------------------------------------------- + + if (.not.present(rc)) then + call ESMF_LogWrite(trim(subname)//": ERROR rc not present ", & + ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) + rc = ESMF_FAILURE + return + endif + + rc = ESMF_SUCCESS + + labort = .true. + if (present(abort)) then + labort = abort + endif + lrank = -99 + + call ESMF_FieldGet(field, status=status, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if (status /= ESMF_FIELDSTATUS_COMPLETE) then + lrank = 0 + if (labort) then + call ESMF_LogWrite(trim(subname)//": ERROR data not allocated ", ESMF_LOGMSG_INFO, rc=rc) + rc = ESMF_FAILURE + return + else + call ESMF_LogWrite(trim(subname)//": WARNING data not allocated ", ESMF_LOGMSG_INFO, rc=rc) + endif + else + + call ESMF_FieldGet(field, geomtype=geomtype, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if (geomtype == ESMF_GEOMTYPE_GRID) then + call ESMF_FieldGet(field, rank=lrank, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + elseif (geomtype == ESMF_GEOMTYPE_MESH) then + call ESMF_FieldGet(field, rank=lrank, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(field, mesh=lmesh, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_MeshGet(lmesh, numOwnedNodes=nnodes, numOwnedElements=nelements, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (nnodes == 0 .and. nelements == 0) lrank = 0 + else + call ESMF_LogWrite(trim(subname)//": ERROR geomtype not supported ", & + ESMF_LOGMSG_INFO, rc=rc) + rc = ESMF_FAILURE + return + endif ! geomtype + + if (lrank == 0) then + call ESMF_LogWrite(trim(subname)//": no local nodes or elements ", & + ESMF_LOGMSG_INFO) + elseif (lrank == 1) then + if (.not.present(fldptr1)) then + call ESMF_LogWrite(trim(subname)//": ERROR missing rank=1 array ", & + ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) + rc = ESMF_FAILURE + return + endif + call ESMF_FieldGet(field, farrayPtr=fldptr1, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + elseif (lrank == 2) then + if (.not.present(fldptr2)) then + call ESMF_LogWrite(trim(subname)//": ERROR missing rank=2 array ", & + ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) + rc = ESMF_FAILURE + return + endif + call ESMF_FieldGet(field, farrayPtr=fldptr2, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + else + call ESMF_LogWrite(trim(subname)//": ERROR in rank ", & + ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) + rc = ESMF_FAILURE + return + endif + + endif ! status + + if (present(rank)) then + rank = lrank + endif + +end subroutine field_getfldptr logical function chkerr(rc, line, file) integer, intent(in) :: rc From bfbd95aacb7f286b70f7f2c7d9c6d53fa6f15aec Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Tue, 1 Sep 2020 08:18:34 -0400 Subject: [PATCH 03/35] white space changes --- config_src/nuopc_driver/mom_cap.F90 | 3 ++- config_src/nuopc_driver/mom_cap_methods.F90 | 1 + 2 files changed, 3 insertions(+), 1 deletion(-) diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index f70eddebdb..d49f370a47 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -272,6 +272,7 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) if (isPresent .and. isSet) grid_attach_area=(trim(value)=="true") write(logmsg,*) grid_attach_area call ESMF_LogWrite('MOM_cap:GridAttachArea = '//trim(logmsg), ESMF_LOGMSG_INFO) + call NUOPC_CompAttributeGet(gcomp, name='dbug_flag', value=value, isPresent=isPresent, isSet=isSet, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (isPresent .and. isSet) then @@ -528,7 +529,6 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) restartfile = "" if (runtype == "initial") then - if (cesm_coupled) then restartfile = "n" else @@ -1444,6 +1444,7 @@ subroutine ModelAdvance(gcomp, rc) endif enddo endif + if (dbug > 0) then call state_diagnose(importState,subname//':IS ',rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return diff --git a/config_src/nuopc_driver/mom_cap_methods.F90 b/config_src/nuopc_driver/mom_cap_methods.F90 index 22938d91f4..0997fbc635 100644 --- a/config_src/nuopc_driver/mom_cap_methods.F90 +++ b/config_src/nuopc_driver/mom_cap_methods.F90 @@ -764,6 +764,7 @@ subroutine State_SetExport(state, fldname, isc, iec, jsc, jec, input, ocean_grid endif end subroutine State_SetExport + subroutine state_diagnose(State, string, rc) ! ---------------------------------------------- From f1041d1f90c2380c5543b75a65ea53c4b57a5060 Mon Sep 17 00:00:00 2001 From: Olga Sergienko Date: Tue, 15 Dec 2020 20:32:06 -0500 Subject: [PATCH 04/35] Fixed bugs in CG_action, matrix_diagonal and calc_shelf_visc in MOM_ice_shelf_dynamics.F90 modified initialize_ice_shelf_boundary_channel in MOM_ice_shelf_initialze.F90 --- src/ice_shelf/MOM_ice_shelf_dynamics.F90 | 212 ++++++++++++++++----- src/ice_shelf/MOM_ice_shelf_initialize.F90 | 125 ++++++++++++ 2 files changed, 286 insertions(+), 51 deletions(-) diff --git a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 index f038190753..8480906de8 100644 --- a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 +++ b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 @@ -23,6 +23,7 @@ module MOM_ice_shelf_dynamics use MOM_ice_shelf_state, only : ice_shelf_state use MOM_coms, only : reproducing_sum, sum_across_PEs, max_across_PEs, min_across_PEs use MOM_checksums, only : hchksum, qchksum +use MOM_ice_shelf_initialize, only : initialize_ice_shelf_boundary_channel !OVS intializing b.c.s implicit none ; private @@ -366,20 +367,23 @@ subroutine initialize_ice_shelf_dyn(param_file, Time, ISS, CS, G, US, diag, new_ call get_param(param_file, mdl, "A_GLEN_ISOTHERM", CS%A_glen_isothermal, & "Ice viscosity parameter in Glen's Law", & - units="Pa-3 yr-1", default=9.461e-18, scale=1.0/(365.0*86400.0)) + units="Pa-3 s-1", default=2.2261e-25, scale=1.0) !OVS change units to Pa-3 s-1 +! units="Pa-3 yr-1", default=9.461e-18, scale=1.0/(365.0*86400.0)) ! This default is equivalent to 3.0001e-25 Pa-3 s-1, appropriate at about -10 C. call get_param(param_file, mdl, "GLEN_EXPONENT", CS%n_glen, & "nonlinearity exponent in Glen's Law", & units="none", default=3.) call get_param(param_file, mdl, "MIN_STRAIN_RATE_GLEN", CS%eps_glen_min, & "min. strain rate to avoid infinite Glen's law viscosity", & - units="a-1", default=1.e-12, scale=US%T_to_s/(365.0*86400.0)) + units="s-1", default=1.e-19, scale=US%T_to_s) !OVS change units to s-1 + !units="a-1", default=1.e-12, scale=US%T_to_s/(365.0*86400.0)) call get_param(param_file, mdl, "BASAL_FRICTION_EXP", CS%n_basal_fric, & "Exponent in sliding law \tau_b = C u^(n_basal_fric)", & units="none", fail_if_missing=.true.) call get_param(param_file, mdl, "BASAL_FRICTION_COEFF", CS%C_basal_friction, & "Coefficient in sliding law \tau_b = C u^(n_basal_fric)", & - units="Pa (m yr-1)-(n_basal_fric)", scale=US%kg_m2s_to_RZ_T*((365.0*86400.0)**CS%n_basal_fric), & + units="Pa (m s-1)^(n_basal_fric)", scale=US%kg_m2s_to_RZ_T**CS%n_basal_fric, & ! OVS change units to s-1 + !units="Pa (m yr-1)-(n_basal_fric)", scale=US%kg_m2s_to_RZ_T*((365.0*86400.0)**CS%n_basal_fric), & fail_if_missing=.true.) call get_param(param_file, mdl, "DENSITY_ICE", CS%density_ice, & "A typical density of ice.", units="kg m-3", default=917.0, scale=US%kg_m3_to_R) @@ -399,10 +403,11 @@ subroutine initialize_ice_shelf_dyn(param_file, Time, ISS, CS, G, US, diag, new_ call get_param(param_file, mdl, "SHELF_MOVING_FRONT", CS%moving_shelf_front, & "Specify whether to advance shelf front (and calve).", & - default=.true.) + default=.false.) call get_param(param_file, mdl, "CALVE_TO_MASK", CS%calve_to_mask, & "If true, do not allow an ice shelf where prohibited by a mask.", & default=.false.) + endif call get_param(param_file, mdl, "MIN_THICKNESS_SIMPLE_CALVE", CS%min_thickness_simple_calve, & "Min thickness rule for the VERY simple calving law",& @@ -515,8 +520,13 @@ subroutine initialize_ice_shelf_dyn(param_file, Time, ISS, CS, G, US, diag, new_ call pass_var(CS%calve_mask,G%domain) endif + call initialize_ice_shelf_boundary_channel(CS%u_face_mask_bdry, CS%v_face_mask_bdry, & + CS%u_flux_bdry_val, CS%v_flux_bdry_val, CS%u_bdry_val, CS%v_bdry_val, CS%h_bdry_val, & + CS%thickness_bdry_val, ISS%hmask, ISS%h_shelf, G, & +! CS%flux_bdry, & + US, param_file ) !OVS initialize b.c.s ! call init_boundary_values(CS, G, time, ISS%hmask, CS%input_flux, CS%input_thickness, new_sim) - + call update_velocity_masks(CS, G, ISS%hmask, CS%umask, CS%vmask, CS%u_face_mask, CS%v_face_mask) if (new_sim) then call MOM_mesg("MOM_ice_shelf.F90, initialize_ice_shelf: initialize ice velocity.") call update_OD_ffrac_uncoupled(CS, G, ISS%h_shelf(:,:)) @@ -823,8 +833,18 @@ subroutine ice_shelf_solve_outer(CS, ISS, G, US, u_shlf, v_shlf, iters, time) ! need to make these conditional on GL interpolation float_cond(:,:) = 0.0 ; H_node(:,:) = 0.0 + CS%ground_frac(:,:) = 0.0 allocate(Phisub(nsub,nsub,2,2,2,2)) ; Phisub(:,:,:,:,:,:) = 0.0 + do j=G%jsc,G%jec + do i=G%isc,G%iec + if (rhoi_rhow * ISS%h_shelf(i,j) - G%bathyT(i,j) > 0) then + float_cond(i,j) = 1.0 + CS%ground_frac(i,j) = 1.0 + endif + enddo + enddo + call calc_shelf_driving_stress(CS, ISS, G, US, taudx, taudy, CS%OD_av) ! This is to determine which cells contain the grounding line, the criterion being that the cell @@ -867,8 +887,9 @@ subroutine ice_shelf_solve_outer(CS, ISS, G, US, u_shlf, v_shlf, iters, time) enddo ; enddo call calc_shelf_visc(CS, ISS, G, US, u_shlf, v_shlf) - call pass_var(CS%ice_visc, G%domain) + + call calc_shelf_taub(CS, ISS, G, US, u_shlf, v_shlf) call pass_var(CS%basal_traction, G%domain) ! This makes sure basal stress is only applied when it is supposed to be @@ -884,7 +905,7 @@ subroutine ice_shelf_solve_outer(CS, ISS, G, US, u_shlf, v_shlf, iters, time) call CG_action(Au, Av, u_shlf, v_shlf, Phi, Phisub, CS%umask, CS%vmask, ISS%hmask, H_node, & CS%ice_visc, float_cond, G%bathyT, CS%basal_traction, & G, US, G%isc-1, G%iec+1, G%jsc-1, G%jec+1, rhoi_rhow) - + call pass_vector(Au,Av,G%domain) !OVS pass Au and Av if (CS%nonlin_solve_err_mode == 1) then err_init = 0 ; err_tempu = 0 ; err_tempv = 0 do J=G%IscB,G%JecB ; do I=G%IscB,G%IecB @@ -920,6 +941,7 @@ subroutine ice_shelf_solve_outer(CS, ISS, G, US, u_shlf, v_shlf, iters, time) call calc_shelf_visc(CS, ISS, G, US, u_shlf, v_shlf) call pass_var(CS%ice_visc, G%domain) + call calc_shelf_taub(CS, ISS, G, US, u_shlf, v_shlf) call pass_var(CS%basal_traction, G%domain) ! makes sure basal stress is only applied when it is supposed to be @@ -986,8 +1008,11 @@ subroutine ice_shelf_solve_outer(CS, ISS, G, US, u_shlf, v_shlf, iters, time) call MOM_mesg(mesg, 5) if (err_max <= CS%nonlinear_tolerance * err_init) then + write(mesg,*) "ice_shelf_solve_outer: nonlinear fractional residual = ", err_max/err_init + call MOM_mesg(mesg) write(mesg,*) "ice_shelf_solve_outer: exiting nonlinear solve after ",iter," iterations" - call MOM_mesg(mesg, 5) +! call MOM_mesg(mesg, 5) + call MOM_mesg(mesg) exit endif @@ -1073,7 +1098,7 @@ subroutine ice_shelf_solve_inner(CS, ISS, G, US, u_shlf, v_shlf, taudx, taudy, H rhoi_rhow = CS%density_ice / CS%density_ocean_avg Zu(:,:) = 0 ; Zv(:,:) = 0 ; DIAGu(:,:) = 0 ; DIAGv(:,:) = 0 - Ru(:,:) = 0 ; Rv(:,:) = 0 ; Au(:,:) = 0 ; Av(:,:) = 0 + Ru(:,:) = 0 ; Rv(:,:) = 0 ; Au(:,:) = 0 ; Av(:,:) = 0 ; RHSu(:,:) = 0 ; RHSv(:,:) = 0 Du(:,:) = 0 ; Dv(:,:) = 0 ; ubd(:,:) = 0 ; vbd(:,:) = 0 dot_p1 = 0 @@ -1125,8 +1150,8 @@ subroutine ice_shelf_solve_inner(CS, ISS, G, US, u_shlf, v_shlf, taudx, taudy, H do j=jsdq,jedq do i=isdq,iedq - if (CS%umask(I,J) == 1) Zu(I,J) = Ru(I,J) / DIAGu(I,J) - if (CS%vmask(I,J) == 1) Zv(I,J) = Rv(I,J) / DIAGv(I,J) + if (CS%umask(I,J) == 1 .AND.(DIAGu(I,J)/=0)) Zu(I,J) = Ru(I,J) / DIAGu(I,J) + if (CS%vmask(I,J) == 1 .AND.(DIAGv(I,J)/=0)) Zv(I,J) = Rv(I,J) / DIAGv(I,J) enddo enddo @@ -1161,7 +1186,7 @@ subroutine ice_shelf_solve_inner(CS, ISS, G, US, u_shlf, v_shlf, taudx, taudy, H ! Au, Av valid region moves in by 1 - + call pass_vector(Au,Av,G%domain, TO_ALL, BGRID_NE) sum_vec(:,:) = 0.0 ; sum_vec_2(:,:) = 0.0 do j=jscq,jecq ; do i=iscq,iecq @@ -1205,10 +1230,10 @@ subroutine ice_shelf_solve_inner(CS, ISS, G, US, u_shlf, v_shlf, taudx, taudy, H do j=jsdq,jedq do i=isdq,iedq - if (CS%umask(I,J) == 1) then + if (CS%umask(I,J) == 1 .AND.(DIAGu(I,J)/=0)) then Zu(I,J) = Ru(I,J) / DIAGu(I,J) endif - if (CS%vmask(I,J) == 1) then + if (CS%vmask(I,J) == 1 .AND.(DIAGv(I,J)/=0)) then Zv(I,J) = Rv(I,J) / DIAGv(I,J) endif enddo @@ -1732,7 +1757,7 @@ subroutine calc_shelf_driving_stress(CS, ISS, G, US, taudx, taudy, OD) BASE ! basal elevation of shelf/stream [Z ~> m]. - real :: rho, rhow ! Ice and ocean densities [R ~> kg m-3] + real :: rho, rhow, rhoi_rhow ! Ice and ocean densities [R ~> kg m-3] real :: sx, sy ! Ice shelf top slopes [Z L-1 ~> m s-1] real :: neumann_val ! [R Z L2 T-2 ~> kg s-2] real :: dxh, dyh ! Local grid spacing [L ~> m] @@ -1754,13 +1779,26 @@ subroutine calc_shelf_driving_stress(CS, ISS, G, US, taudx, taudy, OD) rho = CS%density_ice rhow = CS%density_ocean_avg grav = CS%g_Earth - + rhoi_rhow = rho/rhow ! prelim - go through and calculate S ! or is this faster? BASE(:,:) = -G%bathyT(:,:) + OD(:,:) S(:,:) = BASE(:,:) + ISS%h_shelf(:,:) + ! check whether the ice is floating or grounded + do j=jsc-1,jec+1 + do i=isc-1,iec+1 +! do i=isc-G%domain%nihalo,iec+G%domain%nihalo + +! if (ISS%h_shelf(i,j) < rhow/rho * G%bathyT(i,j)) then + if (rhoi_rhow * ISS%h_shelf(i,j) - G%bathyT(i,j) <= 0) then + S(i,j)=(1 - rhoi_rhow)*ISS%h_shelf(i,j) + endif + + + enddo + enddo do j=jsc-1,jec+1 do i=isc-1,iec+1 cnt = 0 @@ -1840,23 +1878,34 @@ subroutine calc_shelf_driving_stress(CS, ISS, G, US, taudx, taudy, OD) endif ! SW vertex - taudx(I-1,J-1) = taudx(I-1,J-1) - .25 * rho * grav * ISS%h_shelf(i,j) * sx * G%areaT(i,j) - taudy(I-1,J-1) = taudy(I-1,J-1) - .25 * rho * grav * ISS%h_shelf(i,j) * sy * G%areaT(i,j) - + if (ISS%hmask(I-1,J-1) == 1) then + if (CS%u_face_mask(I-1,J-1) /= 3) then + taudx(I-1,J-1) = taudx(I-1,J-1) - .25 * rho * grav * ISS%h_shelf(i,j) * sx * G%areaT(i,j) + taudy(I-1,J-1) = taudy(I-1,J-1) - .25 * rho * grav * ISS%h_shelf(i,j) * sy * G%areaT(i,j) + endif + endif ! SE vertex - taudx(I,J-1) = taudx(I,J-1) - .25 * rho * grav * ISS%h_shelf(i,j) * sx * G%areaT(i,j) - taudy(I,J-1) = taudy(I,J-1) - .25 * rho * grav * ISS%h_shelf(i,j) * sy * G%areaT(i,j) - + if (ISS%hmask(I,J-1) == 1) then + if (CS%u_face_mask(I,J-1) /= 3) then + taudx(I,J-1) = taudx(I,J-1) - .25 * rho * grav * ISS%h_shelf(i,j) * sx * G%areaT(i,j) + taudy(I,J-1) = taudy(I,J-1) - .25 * rho * grav * ISS%h_shelf(i,j) * sy * G%areaT(i,j) + endif + endif ! NW vertex - taudx(I-1,J) = taudx(I-1,J) - .25 * rho * grav * ISS%h_shelf(i,j) * sx * G%areaT(i,j) - taudy(I-1,J) = taudy(I-1,J) - .25 * rho * grav * ISS%h_shelf(i,j) * sy * G%areaT(i,j) - + if (CS%u_face_mask(I-1,J) /= 3) then + taudx(I-1,J) = taudx(I-1,J) - .25 * rho * grav * ISS%h_shelf(i,j) * sx * G%areaT(i,j) + taudy(I-1,J) = taudy(I-1,J) - .25 * rho * grav * ISS%h_shelf(i,j) * sy * G%areaT(i,j) + endif ! NE vertex - taudx(I,J) = taudx(I,J) - .25 * rho * grav * ISS%h_shelf(i,j) * sx * G%areaT(i,j) - taudy(I,J) = taudy(I,J) - .25 * rho * grav * ISS%h_shelf(i,j) * sy * G%areaT(i,j) - - if (CS%ground_frac(i,j) == 1) then - neumann_val = .5 * grav * (rho * ISS%h_shelf(i,j)**2 - rhow * G%bathyT(i,j)**2) + if (ISS%hmask(I,J) == 1) then + if (CS%u_face_mask(I,J) /= 3) then + taudx(I,J) = taudx(I,J) - .25 * rho * grav * ISS%h_shelf(i,j) * sx * G%areaT(i,j) + taudy(I,J) = taudy(I,J) - .25 * rho * grav * ISS%h_shelf(i,j) * sy * G%areaT(i,j) + endif + endif + if (CS%ground_frac(i,j) == 1) then +! neumann_val = .5 * grav * (rho * ISS%h_shelf(i,j)**2 - rhow * G%bathyT(i,j)**2) + neumann_val = .5 * grav * (1-rho/rhow) * rho * ISS%h_shelf(i,j)**2 else neumann_val = .5 * grav * (1-rho/rhow) * rho * ISS%h_shelf(i,j)**2 endif @@ -1976,7 +2025,7 @@ subroutine CG_action(uret, vret, u_shlf, v_shlf, Phi, Phisub, umask, vmask, hmas intent(inout) :: uret !< The retarding stresses working at u-points [R L3 Z T-2 ~> kg m s-2]. real, dimension(G%IsdB:G%IedB,G%JsdB:G%JedB), & intent(inout) :: vret !< The retarding stresses working at v-points [R L3 Z T-2 ~> kg m s-2]. - real, dimension(SZDI_(G),SZDJ_(G),8,4), & + real, dimension(8,4,SZDI_(G),SZDJ_(G)), & intent(in) :: Phi !< The gradients of bilinear basis elements at Gaussian !! quadrature points surrounding the cell vertices [L-1 ~> m-1]. real, dimension(:,:,:,:,:,:), & @@ -2080,7 +2129,7 @@ subroutine CG_action(uret, vret, u_shlf, v_shlf, Phi, Phisub, umask, vmask, hmas v_shlf(I-1,J) * Phi(6,2*(jq-1)+iq,i,j) + & v_shlf(I,J) * Phi(8,2*(jq-1)+iq,i,j) - do iphi=1,2 ; do jphi=1,2 ; Itgt = I-2+iphi ; Jtgt = J-2-jphi + do iphi=1,2 ; do jphi=1,2 ; Itgt = I-2+iphi ; ;Jtgt = J-2+jphi !Jtgt = J-2-jphi !OVS fix index if (umask(Itgt,Jtgt) == 1) uret(Itgt,Jtgt) = uret(Itgt,Jtgt) + 0.25 * ice_visc(i,j) * & ((4*ux+2*vy) * Phi(2*(2*(jphi-1)+iphi)-1,2*(jq-1)+iq,i,j) + & (uy+vx) * Phi(2*(2*(jphi-1)+iphi),2*(jq-1)+iq,i,j)) @@ -2214,7 +2263,7 @@ subroutine matrix_diagonal(CS, G, US, float_cond, H_node, ice_visc, basal_trac, ! Phi(2*i-1,j) gives d(Phi_i)/dx at quadrature point j ! Phi(2*i,j) gives d(Phi_i)/dy at quadrature point j - do iq=1,2 ; do jq=1,2 ; do iphi=1,2 ; do jphi=1,2 ; Itgt = I-2+iphi ; Jtgt = J-2-jphi + do iq=1,2 ; do jq=1,2 ; do iphi=1,2 ; do jphi=1,2 ; Itgt = I-2+iphi ; Jtgt = J-2+jphi !Jtgt = J-2-jphi !OVS fix index ilq = 1 ; if (iq == iphi) ilq = 2 jlq = 1 ; if (jq == jphi) jlq = 2 @@ -2258,7 +2307,7 @@ subroutine matrix_diagonal(CS, G, US, float_cond, H_node, ice_visc, basal_trac, if (float_cond(i,j) == 1) then Hcell(:,:) = H_node(i-1:i,j-1:j) call CG_diagonal_subgrid_basal(Phisub, Hcell, G%bathyT(i,j), dens_ratio, sub_ground) - do iphi=1,2 ; do jphi=1,2 ; Itgt = I-2+iphi ; Jtgt = J-2-jphi + do iphi=1,2 ; do jphi=1,2 ; Itgt = I-2+iphi ; Jtgt = J-2+jphi !Jtgt = J-2-jphi !OVS fix index if (CS%umask(Itgt,Jtgt) == 1) then u_diagonal(Itgt,Jtgt) = u_diagonal(Itgt,Jtgt) + sub_ground(iphi,jphi) * basal_trac(i,j) v_diagonal(Itgt,Jtgt) = v_diagonal(Itgt,Jtgt) + sub_ground(iphi,jphi) * basal_trac(i,j) @@ -2399,7 +2448,7 @@ subroutine apply_boundary_values(CS, ISS, G, US, time, Phisub, H_node, ice_visc, CS%v_bdry_val(I-1,J) * Phi(6,2*(jq-1)+iq) + & CS%v_bdry_val(I,J) * Phi(8,2*(jq-1)+iq) - do iphi=1,2 ; do jphi=1,2 ; Itgt = I-2+iphi ; Jtgt = J-2-jphi + do iphi=1,2 ; do jphi=1,2 ; Itgt = I-2+iphi ; Jtgt = J-2+jphi !Jtgt = J-2-jphi !OVS fix index ilq = 1 ; if (iq == iphi) ilq = 2 jlq = 1 ; if (jq == jphi) jlq = 2 @@ -2472,7 +2521,7 @@ subroutine calc_shelf_visc(CS, ISS, G, US, u_shlf, v_shlf) integer :: giec, gjec, gisc, gjsc, cnt, isc, jsc, iec, jec, is, js real :: Visc_coef, n_g real :: ux, uy, vx, vy, eps_min ! Velocity shears [T-1 ~> s-1] - real :: umid, vmid, unorm ! Velocities [L T-1 ~> m s-1] +! real :: umid, vmid, unorm ! Velocities [L T-1 ~> m s-1] isc = G%isc ; jsc = G%jsc ; iec = G%iec ; jec = G%jec iscq = G%iscB ; iecq = G%iecB ; jscq = G%jscB ; jecq = G%jecB @@ -2484,7 +2533,7 @@ subroutine calc_shelf_visc(CS, ISS, G, US, u_shlf, v_shlf) n_g = CS%n_glen; eps_min = CS%eps_glen_min - Visc_coef = US%kg_m2s_to_RZ_T*US%m_to_L*US%Z_to_L*(CS%A_glen_isothermal)**(1./CS%n_glen) + Visc_coef = US%kg_m2s_to_RZ_T*US%m_to_L*US%Z_to_L*(CS%A_glen_isothermal)**(-1./CS%n_glen) !OVS '-' in the exponent do j=jsd+1,jed-1 do i=isd+1,ied-1 @@ -2497,6 +2546,50 @@ subroutine calc_shelf_visc(CS, ISS, G, US, u_shlf, v_shlf) CS%ice_visc(i,j) = 0.5 * Visc_coef * (G%areaT(i,j) * ISS%h_shelf(i,j)) * & (US%s_to_T**2 * (ux**2 + vy**2 + ux*vy + 0.25*(uy+vx)**2 + eps_min**2))**((1.-n_g)/(2.*n_g)) +! umid = ((u_shlf(I,J) + u_shlf(I-1,J-1)) + (u_shlf(I,J-1) + u_shlf(I-1,J))) * 0.25 +! vmid = ((v_shlf(I,J) + v_shlf(I-1,J-1)) + (v_shlf(I,J-1) + v_shlf(I-1,J))) * 0.25 +! unorm = sqrt(umid**2 + vmid**2 + eps_min**2*(G%dxT(i,j)**2 + G%dyT(i,j)**2)) +! CS%basal_traction(i,j) = G%areaT(i,j) * CS%C_basal_friction * (US%L_T_to_m_s*unorm)**(CS%n_basal_fric-1) + endif + enddo + enddo + +end subroutine calc_shelf_visc + +subroutine calc_shelf_taub(CS, ISS, G, US, u_shlf, v_shlf) + type(ice_shelf_dyn_CS), intent(inout) :: CS !< A pointer to the ice shelf control structure + type(ice_shelf_state), intent(in) :: ISS !< A structure with elements that describe + !! the ice-shelf state + type(ocean_grid_type), intent(in) :: G !< The grid structure used by the ice shelf. + type(unit_scale_type), intent(in) :: US !< A structure containing unit conversion factors + real, dimension(G%IsdB:G%IedB,G%JsdB:G%JedB), & + intent(inout) :: u_shlf !< The zonal ice shelf velocity [L T-1 ~> m s-1]. + real, dimension(G%IsdB:G%IedB,G%JsdB:G%JedB), & + intent(inout) :: v_shlf !< The meridional ice shelf velocity [L T-1 ~> m s-1]. + +! also this subroutine updates the nonlinear part of the basal traction + +! this may be subject to change later... to make it "hybrid" + + integer :: i, j, iscq, iecq, jscq, jecq, isd, jsd, ied, jed, iegq, jegq + integer :: giec, gjec, gisc, gjsc, cnt, isc, jsc, iec, jec, is, js + real :: umid, vmid, unorm, eps_min ! Velocities [L T-1 ~> m s-1] + + isc = G%isc ; jsc = G%jsc ; iec = G%iec ; jec = G%jec + iscq = G%iscB ; iecq = G%iecB ; jscq = G%jscB ; jecq = G%jecB + isd = G%isd ; jsd = G%jsd ; ied = G%ied ; jed = G%jed + iegq = G%iegB ; jegq = G%jegB + gisc = G%domain%nihalo+1 ; gjsc = G%domain%njhalo+1 + giec = G%domain%niglobal+gisc ; gjec = G%domain%njglobal+gjsc + is = iscq - 1; js = jscq - 1 + + eps_min = CS%eps_glen_min + + + do j=jsd+1,jed-1 + do i=isd+1,ied-1 + + if (ISS%hmask(i,j) == 1) then umid = ((u_shlf(I,J) + u_shlf(I-1,J-1)) + (u_shlf(I,J-1) + u_shlf(I-1,J))) * 0.25 vmid = ((v_shlf(I,J) + v_shlf(I-1,J-1)) + (v_shlf(I,J-1) + v_shlf(I-1,J))) * 0.25 unorm = sqrt(umid**2 + vmid**2 + eps_min**2*(G%dxT(i,j)**2 + G%dyT(i,j)**2)) @@ -2505,7 +2598,7 @@ subroutine calc_shelf_visc(CS, ISS, G, US, u_shlf, v_shlf) enddo enddo -end subroutine calc_shelf_visc +end subroutine calc_shelf_taub subroutine update_OD_ffrac(CS, G, US, ocean_mass, find_avg) type(ice_shelf_dyn_CS), intent(inout) :: CS !< A pointer to the ice shelf control structure @@ -2673,8 +2766,18 @@ subroutine bilinear_shape_fn_grid(G, i, j, Phi) xquad(2:4:2) = .5 * (1+sqrt(1./3)) ; yquad(3:4) = .5 * (1+sqrt(1./3)) do qpoint=1,4 - a = G%dxCv(i,J-1) * (1-yquad(qpoint)) + G%dxCv(i,J) * yquad(qpoint) ! d(x)/d(x*) - d = G%dyCu(I-1,j) * (1-xquad(qpoint)) + G%dyCu(I,j) * xquad(qpoint) ! d(y)/d(y*) + if (J>1) then + a = G%dxCv(i,J-1) * (1-yquad(qpoint)) + G%dxCv(i,J) * yquad(qpoint) ! d(x)/d(x*) + else + a= G%dxCv(i,J) !* yquad(qpoint) ! d(x)/d(x*) + endif + if (I>1) then + d = G%dyCu(I-1,j) * (1-xquad(qpoint)) + G%dyCu(I,j) * xquad(qpoint) ! d(y)/d(y*) + else + d = G%dyCu(I,j) !* xquad(qpoint) + endif +! a = G%dxCv(i,J-1) * (1-yquad(qpoint)) + G%dxCv(i,J) * yquad(qpoint) ! d(x)/d(x*) +! d = G%dyCu(I-1,j) * (1-xquad(qpoint)) + G%dyCu(I,j) * xquad(qpoint) ! d(y)/d(y*) do node=1,4 xnode = 2-mod(node,2) ; ynode = ceiling(REAL(node)/2) @@ -2793,21 +2896,28 @@ subroutine update_velocity_masks(CS, G, hmask, umask, vmask, u_face_mask, v_face is = isd+1 ; js = jsd+1 endif - do j=js,G%jed +! do j=js,G%jed + do j=js-1,G%jed !OVS change index do i=is,G%ied if (hmask(i,j) == 1) then - umask(I-1:I,j-1:j) = 1. - vmask(I-1:I,j-1:j) = 1. + umask(I,j) = 1. + vmask(I,j) = 1. do k=0,1 select case (int(CS%u_face_mask_bdry(I-1+k,j))) case (3) - umask(I-1+k,J-1:J)=3. - vmask(I-1+k,J-1:J)=0. + ! vmask(I-1+k,J-1)=0. u_face_mask(I-1+k,j)=3. + umask(I-1+k,J)=3. + !vmask(I-1+k,J)=0. + vmask(I-1+k,J)=3. + !u_face_mask(I-1+k,j-1)=3. +! umask(I-1+k,J-1:J)=3. +! vmask(I-1+k,J-1:J)=0. +! u_face_mask(I-1+k,j)=3. case (2) u_face_mask(I-1+k,j)=2. case (4) @@ -2815,9 +2925,9 @@ subroutine update_velocity_masks(CS, G, hmask, umask, vmask, u_face_mask, v_face vmask(I-1+k,J-1:J)=0. u_face_mask(I-1+k,j)=4. case (0) - umask(I-1+k,J-1:J)=0. - vmask(I-1+k,J-1:J)=0. - u_face_mask(I-1+k,j)=0. +! umask(I-1+k,J-1:J)=0. +! vmask(I-1+k,J-1:J)=0. +! u_face_mask(I-1+k,j)=0. case (1) ! stress free x-boundary umask(I-1+k,J-1:J)=0. case default @@ -2838,9 +2948,9 @@ subroutine update_velocity_masks(CS, G, hmask, umask, vmask, u_face_mask, v_face vmask(I-1:I,J-1+k)=0. v_face_mask(i,J-1+k)=4. case (0) - umask(I-1:I,J-1+k)=0. - vmask(I-1:I,J-1+k)=0. - v_face_mask(i,J-1+k)=0. +! umask(I-1:I,J-1+k)=0. +! vmask(I-1:I,J-1+k)=0. +! v_face_mask(i,J-1+k)=0. case (1) ! stress free y-boundary vmask(I-1:I,J-1+k)=0. case default diff --git a/src/ice_shelf/MOM_ice_shelf_initialize.F90 b/src/ice_shelf/MOM_ice_shelf_initialize.F90 index 90c98fa487..367f8d7dce 100644 --- a/src/ice_shelf/MOM_ice_shelf_initialize.F90 +++ b/src/ice_shelf/MOM_ice_shelf_initialize.F90 @@ -18,6 +18,7 @@ module MOM_ice_shelf_initialize !MJHpublic initialize_ice_shelf_boundary, initialize_ice_thickness public initialize_ice_thickness +public initialize_ice_shelf_boundary_channel ! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional ! consistency testing. These are noted in comments with units like Z, H, L, and T, along with @@ -263,6 +264,130 @@ subroutine initialize_ice_thickness_channel(h_shelf, area_shelf_h, hmask, G, US, endif ; enddo end subroutine initialize_ice_thickness_channel +subroutine initialize_ice_shelf_boundary_channel(u_face_mask_bdry, v_face_mask_bdry, & + u_flux_bdry_val, v_flux_bdry_val, u_bdry_val, v_bdry_val, h_bdry_val, & + thickness_bdry_val, hmask, h_shelf, G,& ! OVS h_shelf 11/10/20 +! flux_bdry, & + US, PF ) + + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + real, dimension(SZIB_(G),SZJ_(G)), & + intent(inout) :: u_face_mask_bdry !< A boundary-type mask at C-grid u faces + real, dimension(SZIB_(G),SZJ_(G)), & + intent(inout) :: u_flux_bdry_val !< The boundary thickness flux through + !! C-grid u faces [L Z T-1 ~> m2 s-1]. + real, dimension(SZI_(G),SZJB_(G)), & + intent(inout) :: v_face_mask_bdry !< A boundary-type mask at C-grid v faces + real, dimension(SZI_(G),SZJB_(G)), & + intent(inout) :: v_flux_bdry_val !< The boundary thickness flux through + !! C-grid v faces [L Z T-1 ~> m2 s-1]. + real, dimension(SZIB_(G),SZJB_(G)), & + intent(inout) :: u_bdry_val !< The zonal ice shelf velocity at open + !! boundary vertices [L T-1 ~> m s-1]. + real, dimension(SZIB_(G),SZJB_(G)), & + intent(inout) :: v_bdry_val !< The meridional ice shelf velocity at open + real, dimension(SZDI_(G),SZDJ_(G)), & + intent(inout) :: thickness_bdry_val !< The ice shelf thickness at open boundaries [Z ~> m] + !! boundary vertices [L T-1 ~> m s-1]. + real, dimension(SZDI_(G),SZDJ_(G)), & + intent(inout) :: h_bdry_val !< The ice shelf thickness at open boundaries [Z ~> m] + real, dimension(SZDI_(G),SZDJ_(G)), & + intent(inout) :: hmask !< A mask indicating which tracer points are + !! partly or fully covered by an ice-shelf + real, dimension(SZDI_(G),SZDJ_(G)), & + intent(inout) :: h_shelf !< Ice-shelf thickness OVS 11/10/20 +! logical, intent(in) :: flux_bdry !< If true, use mass fluxes as the boundary value. + type(unit_scale_type), intent(in) :: US !< A structure containing unit conversion factors + type(param_file_type), intent(in) :: PF !< A structure to parse for run-time parameters + + character(len=40) :: mdl = "initialize_ice_shelf_boundary_channel" ! This subroutine's name. + integer :: i, j, isd, jsd, is, js, iegq, jegq, giec, gjec, gisc, gjsc,gisd,gjsd, isc, jsc, iec, jec, ied, jed + real :: input_thick ! The input ice shelf thickness [Z ~> m] +! real :: input_flux ! The input ice flux per unit length [L Z T-1 ~> m2 s-1] + real :: input_vel ! The input ice velocity per [L Z T-1 ~> m s-1] + real :: lenlat, len_stress, westlon, lenlon, southlat + + + call get_param(PF, mdl, "LENLAT", lenlat, fail_if_missing=.true.) + + call get_param(PF, mdl, "LENLON", lenlon, fail_if_missing=.true.) + + call get_param(PF, mdl, "WESTLON", westlon, fail_if_missing=.true.) + + call get_param(PF, mdl, "SOUTHLAT", southlat, fail_if_missing=.true.) + + call get_param(PF, mdl, "INPUT_VEL_ICE_SHELF", input_vel, & + "inflow ice velocity at upstream boundary", & + units="m s-1", default=0., scale=US%m_s_to_L_T*US%m_to_Z) + call get_param(PF, mdl, "INPUT_THICK_ICE_SHELF", input_thick, & + "flux thickness at upstream boundary", & + units="m", default=1000., scale=US%m_to_Z) + call get_param(PF, mdl, "LEN_SIDE_STRESS", len_stress, & + "maximum position of no-flow condition in along-flow direction", & + units="km", default=0.) + + call MOM_mesg(mdl//": setting boundary") + + isd = G%isd ; ied = G%ied + jsd = G%jsd ; jed = G%jed + isc = G%isc ; jsc = G%jsc ; iec = G%iec ; jec = G%jec + gjsd = G%Domain%njglobal ; gisd = G%Domain%niglobal + gisc = G%Domain%nihalo ; gjsc = G%Domain%njhalo + giec = G%Domain%niglobal+gisc ; gjec = G%Domain%njglobal+gjsc + +!-----------b.c.s based on geopositions ----------------- + do j=jsc-1,jec+1 + do i=isc-1,iec+1 + ! upstream boundary - set either dirichlet or flux condition + + if (G%geoLonBu(i,j) == westlon) then + ! if (flux_bdry) then + ! u_face_mask_bdry(i-1,j) = 4.0 + ! u_flux_bdry_val(i-1,j) = input_flux + ! else + hmask(i+1,j) = 3.0 + h_bdry_val(i+1,j) = h_shelf(i+1,j) !OVS 11/10/20 !input_thick + thickness_bdry_val(i+1,j) = h_bdry_val(i+1,j) + u_face_mask_bdry(i+1,j) = 3.0 + u_bdry_val(i+1,j) = input_vel*(1-16.0*((G%geoLatBu(i-1,j)/lenlat-0.5))**4) !OVS 11/09/20 U b.c. + ! u_bdry_val(i+1,j) = (1 - ((G%geoLatBu(i,j) - 0.5*lenlat)*2./lenlat)**2) * & + ! 1.5 * input_flux / input_thick + ! endif + endif + + + ! side boundaries: no flow + if (G%geoLatBu(i,j-1) == southlat) then !bot boundary + if (len_stress == 0. .OR. G%geoLonCv(i,j) <= len_stress) then + v_face_mask_bdry(i,j+1) = 0. + u_face_mask_bdry(i,j-1) = 3. !OVS 11/25/20 + else + v_face_mask_bdry(i,j+1) = 1. + u_face_mask_bdry(i,j-1) = 3. !OVS 11/25/20 + u_bdry_val(i,j) = 0. + !hmask(i,j) = 0.0 !OVS 11/25/20 + endif + elseif (G%geoLatBu(i,j-1) == southlat+lenlat) then !top boundary + if (len_stress == 0. .OR. G%geoLonCv(i,j) <= len_stress) then + v_face_mask_bdry(i,j-1) = 0. + u_face_mask_bdry(i,j-1) = 3. !OVS 11/25/20 + else + v_face_mask_bdry(i,j-1) = 1. + u_face_mask_bdry(i,j-1) = 3. !OVS 11/25/20 + !u_bdry_val(i,j) = 0. !OVS 11/25/20 + !hmask(i,j) = 0.0 !OVS 11/25/20 + endif + endif + + ! downstream boundary - CFBC + if (G%geoLonBu(i,j) == westlon+lenlon) then + u_face_mask_bdry(i-1,j) = 2.0 + endif + + enddo + enddo + +end subroutine initialize_ice_shelf_boundary_channel !BEGIN MJH ! subroutine initialize_ice_shelf_boundary(u_face_mask_bdry, v_face_mask_bdry, & From 39dd3e3221bb19ef90d191f3c69f77cd50de03cb Mon Sep 17 00:00:00 2001 From: Olga Sergienko Date: Tue, 15 Dec 2020 21:05:04 -0500 Subject: [PATCH 05/35] Modified MOM_ice_shelf_dynamics.F90 --- src/ice_shelf/MOM_ice_shelf_dynamics.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 index 8480906de8..174891582a 100644 --- a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 +++ b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 @@ -672,6 +672,7 @@ subroutine update_ice_shelf(CS, ISS, G, US, time_step, Time, ocean_mass, coupled call update_OD_ffrac_uncoupled(CS, G, ISS%h_shelf(:,:)) endif + if (update_ice_vel) then call ice_shelf_solve_outer(CS, ISS, G, US, CS%u_shelf, CS%v_shelf, iters, Time) endif From ebac0adb8524b450882d679f5c74af71e50d50b7 Mon Sep 17 00:00:00 2001 From: Olga Sergienko Date: Tue, 29 Dec 2020 10:38:55 -0500 Subject: [PATCH 06/35] Modifications to register_diag_field in MOM_ice_shelf_dynamics to make ice-shelf_fields consistent with diag_table Modifications to MOM_ice_shelf.F90 to apply melting to the case of a dynamic ice shelf. --- src/ice_shelf/MOM_ice_shelf.F90 | 11 ++++++++++ src/ice_shelf/MOM_ice_shelf_dynamics.F90 | 28 ++++++++++++++++++------ 2 files changed, 32 insertions(+), 7 deletions(-) diff --git a/src/ice_shelf/MOM_ice_shelf.F90 b/src/ice_shelf/MOM_ice_shelf.F90 index 56461dbc3d..5663b326b7 100644 --- a/src/ice_shelf/MOM_ice_shelf.F90 +++ b/src/ice_shelf/MOM_ice_shelf.F90 @@ -710,6 +710,17 @@ subroutine shelf_calc_flux(sfc_state_in, fluxes_in, Time, time_step, CS) endif endif + ! Melting has been computed, now is time to update thickness and mass with dynamic ice shelf + if (CS%active_shelf_dynamics) then !OVS 12/10/20 + call change_thickness_using_melt(ISS, G, US, US%s_to_T*time_step, fluxes, CS%density_ice, CS%debug) !OVS 12/10/20 + + if (CS%debug) then + call hchksum(ISS%h_shelf, "h_shelf after change thickness using melt", G%HI, haloshift=0, scale=US%Z_to_m) + call hchksum(ISS%mass_shelf, "mass_shelf after change thickness using melt", G%HI, haloshift=0, & + scale=US%RZ_to_kg_m2) + endif + endif !OVS 12/10/20 + if (CS%debug) call MOM_forcing_chksum("Before add shelf flux", fluxes, G, CS%US, haloshift=0) call add_shelf_flux(G, US, CS, sfc_state, fluxes) diff --git a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 index 174891582a..ead882dd75 100644 --- a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 +++ b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 @@ -537,21 +537,35 @@ subroutine initialize_ice_shelf_dyn(param_file, Time, ISS, CS, G, US, diag, new_ endif ! Register diagnostics. - CS%id_u_shelf = register_diag_field('ocean_model','u_shelf',CS%diag%axesCu1, Time, & +! CS%id_u_shelf = register_diag_field('ocean_model','u_shelf',CS%diag%axesCu1, Time, & +! 'x-velocity of ice', 'm yr-1', conversion=365.0*86400.0*US%L_T_to_m_s) + CS%id_u_shelf = register_diag_field('ice_shelf_model','u_shelf',CS%diag%axesCu1, Time, & 'x-velocity of ice', 'm yr-1', conversion=365.0*86400.0*US%L_T_to_m_s) - CS%id_v_shelf = register_diag_field('ocean_model','v_shelf',CS%diag%axesCv1, Time, & +! CS%id_v_shelf = register_diag_field('ocean_model','v_shelf',CS%diag%axesCv1, Time, & +! 'y-velocity of ice', 'm yr-1', conversion=365.0*86400.0*US%L_T_to_m_s) + CS%id_v_shelf = register_diag_field('ice_shelf_model','v_shelf',CS%diag%axesCv1, Time, & 'y-velocity of ice', 'm yr-1', conversion=365.0*86400.0*US%L_T_to_m_s) - CS%id_u_mask = register_diag_field('ocean_model','u_mask',CS%diag%axesCu1, Time, & +! CS%id_u_mask = register_diag_field('ocean_model','u_mask',CS%diag%axesCu1, Time, & +! 'mask for u-nodes', 'none') + CS%id_u_mask = register_diag_field('ice_shelf_model','u_mask',CS%diag%axesCu1, Time, & 'mask for u-nodes', 'none') - CS%id_v_mask = register_diag_field('ocean_model','v_mask',CS%diag%axesCv1, Time, & +! CS%id_v_mask = register_diag_field('ocean_model','v_mask',CS%diag%axesCv1, Time, & +! 'mask for v-nodes', 'none') + CS%id_v_mask = register_diag_field('ice_shelf_model','v_mask',CS%diag%axesCv1, Time, & 'mask for v-nodes', 'none') ! CS%id_surf_elev = register_diag_field('ocean_model','ice_surf',CS%diag%axesT1, Time, & ! 'ice surf elev', 'm') - CS%id_ground_frac = register_diag_field('ocean_model','ice_ground_frac',CS%diag%axesT1, Time, & +! CS%id_ground_frac = register_diag_field('ocean_model','ice_ground_frac',CS%diag%axesT1, Time, & +! 'fraction of cell that is grounded', 'none') + CS%id_ground_frac = register_diag_field('ice_shelf_model','ice_ground_frac',CS%diag%axesT1, Time, & 'fraction of cell that is grounded', 'none') - CS%id_col_thick = register_diag_field('ocean_model','col_thick',CS%diag%axesT1, Time, & +! CS%id_col_thick = register_diag_field('ocean_model','col_thick',CS%diag%axesT1, Time, & +! 'ocean column thickness passed to ice model', 'm', conversion=US%Z_to_m) + CS%id_col_thick = register_diag_field('ice_shelf_model','col_thick',CS%diag%axesT1, Time, & 'ocean column thickness passed to ice model', 'm', conversion=US%Z_to_m) - CS%id_OD_av = register_diag_field('ocean_model','OD_av',CS%diag%axesT1, Time, & +! CS%id_OD_av = register_diag_field('ocean_model','OD_av',CS%diag%axesT1, Time, & +! 'intermediate ocean column thickness passed to ice model', 'm', conversion=US%Z_to_m) + CS%id_OD_av = register_diag_field('ice_shelf_model','OD_av',CS%diag%axesT1, Time, & 'intermediate ocean column thickness passed to ice model', 'm', conversion=US%Z_to_m) !CS%id_h_after_uflux = register_diag_field('ocean_model','h_after_uflux',CS%diag%axesh1, Time, & ! 'thickness after u flux ', 'none') From 29d7680654f4769ed53feab403548ef9b759ef42 Mon Sep 17 00:00:00 2001 From: "brandon.reichl" Date: Fri, 15 Jan 2021 15:00:35 +0000 Subject: [PATCH 07/35] Add two halo updates for taux and tauy in mom_surface_forcing_nupoc - In A and B grid configuration halos were never updated after taux/tauy were populated. - This propogated through to the ustar_gustless field, hence caused a restart issue when using ustar_gustless in parameterizations. - This appears to correct the restart issue by updating the halos at the end of the A and B grid taux/tauy loops. --- config_src/nuopc_driver/mom_surface_forcing_nuopc.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/config_src/nuopc_driver/mom_surface_forcing_nuopc.F90 b/config_src/nuopc_driver/mom_surface_forcing_nuopc.F90 index 7b4e33a56a..ada0a7c302 100644 --- a/config_src/nuopc_driver/mom_surface_forcing_nuopc.F90 +++ b/config_src/nuopc_driver/mom_surface_forcing_nuopc.F90 @@ -790,7 +790,7 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS) endif forces%ustar(i,j) = sqrt(gustiness*Irho0 + Irho0*tau_mag) enddo ; enddo - + call pass_vector(forces%taux, forces%tauy, G%Domain, halo=1) elseif (wind_stagger == AGRID) then call pass_vector(taux_at_h, tauy_at_h, G%Domain, To_All+Omit_Corners, stagger=AGRID, halo=1) @@ -816,7 +816,7 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS) forces%ustar(i,j) = sqrt(gustiness*Irho0 + Irho0 * G%mask2dT(i,j) * & sqrt(taux_at_h(i,j)**2 + tauy_at_h(i,j)**2)) enddo ; enddo - + call pass_vector(forces%taux, forces%tauy, G%Domain, halo=1) else ! C-grid wind stresses. if (G%symmetric) & call fill_symmetric_edges(forces%taux, forces%tauy, G%Domain) From 91282c10620abdb432987891f97e030f2d2f16f5 Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Fri, 15 Jan 2021 11:41:46 -0500 Subject: [PATCH 08/35] add brandon's halo update fix for LI_2016 --- config_src/nuopc_driver/mom_surface_forcing_nuopc.F90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/config_src/nuopc_driver/mom_surface_forcing_nuopc.F90 b/config_src/nuopc_driver/mom_surface_forcing_nuopc.F90 index 7b4e33a56a..4c9c872a5a 100644 --- a/config_src/nuopc_driver/mom_surface_forcing_nuopc.F90 +++ b/config_src/nuopc_driver/mom_surface_forcing_nuopc.F90 @@ -790,6 +790,7 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS) endif forces%ustar(i,j) = sqrt(gustiness*Irho0 + Irho0*tau_mag) enddo ; enddo + call pass_vector(forces%taux, forces%tauy, G%Domain, halo=1) elseif (wind_stagger == AGRID) then call pass_vector(taux_at_h, tauy_at_h, G%Domain, To_All+Omit_Corners, stagger=AGRID, halo=1) @@ -816,6 +817,7 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS) forces%ustar(i,j) = sqrt(gustiness*Irho0 + Irho0 * G%mask2dT(i,j) * & sqrt(taux_at_h(i,j)**2 + tauy_at_h(i,j)**2)) enddo ; enddo + call pass_vector(forces%taux, forces%tauy, G%Domain, halo=1) else ! C-grid wind stresses. if (G%symmetric) & From e7d0976de4f8db42dab689115d65397792872676 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Thu, 21 Jan 2021 09:47:44 -0700 Subject: [PATCH 09/35] Fixes latent heat from fprec and frunoff This patch fixes a sign bug, in both MCT and NUOPC, when accounting for the latent heat from fprec and frunnoff. Following MOM6's definition, both fprec and frunoff are > 0 into the ocean. Therefore, the latent heat associated with these terms should be negative. --- config_src/mct_driver/mom_surface_forcing_mct.F90 | 12 ++++++------ .../nuopc_driver/mom_surface_forcing_nuopc.F90 | 10 ++++++---- 2 files changed, 12 insertions(+), 10 deletions(-) diff --git a/config_src/mct_driver/mom_surface_forcing_mct.F90 b/config_src/mct_driver/mom_surface_forcing_mct.F90 index 82105e040e..ef0527dd1c 100644 --- a/config_src/mct_driver/mom_surface_forcing_mct.F90 +++ b/config_src/mct_driver/mom_surface_forcing_mct.F90 @@ -486,17 +486,17 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, valid_time, G, ! latent heat flux (W/m^2) fluxes%latent(i,j) = 0.0 - ! contribution from frozen ppt + ! contribution from frozen ppt (notice minus sign since fprec is positive into the ocean) if (associated(IOB%fprec)) then - fluxes%latent(i,j) = fluxes%latent(i,j) + & + fluxes%latent(i,j) = fluxes%latent(i,j) - & IOB%fprec(i-i0,j-j0)*US%W_m2_to_QRZ_T*CS%latent_heat_fusion - fluxes%latent_fprec_diag(i,j) = G%mask2dT(i,j) * IOB%fprec(i-i0,j-j0)*US%W_m2_to_QRZ_T*CS%latent_heat_fusion + fluxes%latent_fprec_diag(i,j) = - G%mask2dT(i,j) * IOB%fprec(i-i0,j-j0)*US%W_m2_to_QRZ_T*CS%latent_heat_fusion endif - ! contribution from frozen runoff + ! contribution from frozen runoff (notice minus sign since rofi_flux is positive into the ocean) if (associated(fluxes%frunoff)) then - fluxes%latent(i,j) = fluxes%latent(i,j) + & + fluxes%latent(i,j) = fluxes%latent(i,j) - & IOB%rofi_flux(i-i0,j-j0)*US%W_m2_to_QRZ_T*CS%latent_heat_fusion - fluxes%latent_frunoff_diag(i,j) = G%mask2dT(i,j) * IOB%rofi_flux(i-i0,j-j0)*US%W_m2_to_QRZ_T*CS%latent_heat_fusion + fluxes%latent_frunoff_diag(i,j) = - G%mask2dT(i,j) * IOB%rofi_flux(i-i0,j-j0)*US%W_m2_to_QRZ_T*CS%latent_heat_fusion endif ! contribution from evaporation if (associated(IOB%q_flux)) then diff --git a/config_src/nuopc_driver/mom_surface_forcing_nuopc.F90 b/config_src/nuopc_driver/mom_surface_forcing_nuopc.F90 index 7c5e8ee6d9..7168823fbc 100644 --- a/config_src/nuopc_driver/mom_surface_forcing_nuopc.F90 +++ b/config_src/nuopc_driver/mom_surface_forcing_nuopc.F90 @@ -497,15 +497,17 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, valid_time, G, fluxes%seaice_melt(i,j) = kg_m2_s_conversion * G%mask2dT(i,j) * IOB%seaice_melt(i-i0,j-j0) fluxes%latent(i,j) = 0.0 + ! notice minus sign since fprec is positive into the ocean if (associated(IOB%fprec)) then - fluxes%latent(i,j) = fluxes%latent(i,j) + & + fluxes%latent(i,j) = fluxes%latent(i,j) - & IOB%fprec(i-i0,j-j0)*US%W_m2_to_QRZ_T*CS%latent_heat_fusion - fluxes%latent_fprec_diag(i,j) = G%mask2dT(i,j) * IOB%fprec(i-i0,j-j0)*US%W_m2_to_QRZ_T*CS%latent_heat_fusion + fluxes%latent_fprec_diag(i,j) = - G%mask2dT(i,j) * IOB%fprec(i-i0,j-j0)*US%W_m2_to_QRZ_T*CS%latent_heat_fusion endif + ! notice minus sign since frunoff is positive into the ocean if (associated(IOB%frunoff)) then - fluxes%latent(i,j) = fluxes%latent(i,j) + & + fluxes%latent(i,j) = fluxes%latent(i,j) - & IOB%frunoff(i-i0,j-j0) * US%W_m2_to_QRZ_T * CS%latent_heat_fusion - fluxes%latent_frunoff_diag(i,j) = G%mask2dT(i,j) * & + fluxes%latent_frunoff_diag(i,j) = - G%mask2dT(i,j) * & IOB%frunoff(i-i0,j-j0) * US%W_m2_to_QRZ_T * CS%latent_heat_fusion endif if (associated(IOB%q_flux)) then From 7db2cc7a4ad799894443ba422f9ef1d4e315607c Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Thu, 28 Jan 2021 09:31:54 -0700 Subject: [PATCH 10/35] make mom mesh optional * read config variable 'use_mommesh' in ufs; default is false to have mom cap run on grid --- config_src/nuopc_driver/mom_cap.F90 | 27 +++++++++++++++++++++++++-- 1 file changed, 25 insertions(+), 2 deletions(-) diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index 4bfc9e1cb6..f3a5ff6c0a 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -73,7 +73,8 @@ module MOM_cap_mod use ESMF, only: ESMF_VMBroadcast use ESMF, only: ESMF_AlarmCreate, ESMF_ClockGetAlarmList, ESMF_AlarmList_Flag use ESMF, only: ESMF_AlarmGet, ESMF_AlarmIsCreated, ESMF_ALARMLIST_ALL, ESMF_AlarmIsEnabled -use ESMF, only: ESMF_STATEITEM_NOTFOUND, ESMF_FieldWrite +use ESMF, only: ESMF_STATEITEM_NOTFOUND, ESMF_FieldWrite +use ESMF, only: ESMF_END_ABORT, ESMF_Finalize use ESMF, only: operator(==), operator(/=), operator(+), operator(-) ! TODO ESMF_GridCompGetInternalState does not have an explicit Fortran interface. @@ -134,6 +135,7 @@ module MOM_cap_mod logical :: profile_memory = .true. logical :: grid_attach_area = .false. logical :: use_coldstart = .true. +logical :: use_mommesh = .false. character(len=128) :: scalar_field_name = '' integer :: scalar_field_count = 0 integer :: scalar_field_idx_grid_nx = 0 @@ -146,9 +148,11 @@ module MOM_cap_mod type(ESMF_GeomType_Flag) :: geomtype = ESMF_GEOMTYPE_MESH #else logical :: cesm_coupled = .false. -type(ESMF_GeomType_Flag) :: geomtype = ESMF_GEOMTYPE_GRID +!type(ESMF_GeomType_Flag) :: geomtype = ESMF_GEOMTYPE_GRID +!type(ESMF_GeomType_Flag) :: geomtype = ESMF_GEOMTYPE_MESH #endif character(len=8) :: restart_mode = 'alarms' +type(ESMF_GeomType_Flag) :: geomtype contains @@ -346,6 +350,25 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) write(logmsg,*) use_coldstart call ESMF_LogWrite('MOM_cap:use_coldstart = '//trim(logmsg), ESMF_LOGMSG_INFO) + use_mommesh = .false. + call NUOPC_CompAttributeGet(gcomp, name="use_mommesh", value=value, & + isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) use_mommesh=(trim(value)=="true") + write(logmsg,*) use_mommesh + call ESMF_LogWrite('MOM_cap:use_mommesh = '//trim(logmsg), ESMF_LOGMSG_INFO) + + if(use_mommesh)then + geomtype = ESMF_GEOMTYPE_MESH + call NUOPC_CompAttributeGet(gcomp, name='mesh_ocn', isPresent=isPresent, isSet=isSet, rc=rc) + if (.not. isPresent .and. .not. isSet) then + call ESMF_LogWrite('geomtype set to mesh but mesh_ocn is not specified', ESMF_LOGMSG_INFO) + call ESMF_Finalize(endflag=ESMF_END_ABORT) + endif + else + geomtype = ESMF_GEOMTYPE_GRID + endif + end subroutine !> Called by NUOPC to advertise import and export fields. "Advertise" From 13a5a2e0f98767c05e6910df5d7997f60d630899 Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Thu, 28 Jan 2021 16:40:07 -0700 Subject: [PATCH 11/35] comment out mask check which fails for mx100 --- config_src/nuopc_driver/mom_cap.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index f3a5ff6c0a..0cef65a340 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -975,7 +975,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) "greater than parameter EPS_OMESH. n, lonMesh(n), lon(n), diff_lon, "//& "EPS_OMESH= ',i8,2(f21.13,3x),2(d21.5))" write(err_msg, frmt)n,lonMesh(n),lon(n), diff_lon, eps_omesh - call MOM_error(FATAL, err_msg) + !call MOM_error(FATAL, err_msg) end if diff_lat = abs(latMesh(n) - lat(n)) if (diff_lat > eps_omesh) then @@ -983,13 +983,13 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) "greater than parameter EPS_OMESH. n, latMesh(n), lat(n), diff_lat, "//& "EPS_OMESH= ',i8,2(f21.13,3x),2(d21.5))" write(err_msg, frmt)n,latMesh(n),lat(n), diff_lat, eps_omesh - call MOM_error(FATAL, err_msg) + !call MOM_error(FATAL, err_msg) end if if (abs(maskMesh(n) - mask(n)) > 0) then frmt = "('ERROR: ESMF mesh and MOM6 domain masks are inconsistent! - "//& "MOM n, maskMesh(n), mask(n) = ',3(i8,2x))" write(err_msg, frmt)n,maskMesh(n),mask(n) - call MOM_error(FATAL, err_msg) + !call MOM_error(FATAL, err_msg) end if end do From a34ebb1412ef4dc3c7f87f79941bbb018bbc3872 Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Fri, 29 Jan 2021 07:15:24 -0500 Subject: [PATCH 12/35] remove tempory bypass of mesh abort code --- config_src/nuopc_driver/mom_cap.F90 | 12 +++++------- 1 file changed, 5 insertions(+), 7 deletions(-) diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index a0fc681ab2..c96c98cdd4 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -74,7 +74,7 @@ module MOM_cap_mod use ESMF, only: ESMF_VMBroadcast use ESMF, only: ESMF_AlarmCreate, ESMF_ClockGetAlarmList, ESMF_AlarmList_Flag use ESMF, only: ESMF_AlarmGet, ESMF_AlarmIsCreated, ESMF_ALARMLIST_ALL, ESMF_AlarmIsEnabled -use ESMF, only: ESMF_STATEITEM_NOTFOUND, ESMF_FieldWrite +use ESMF, only: ESMF_STATEITEM_NOTFOUND, ESMF_FieldWrite use ESMF, only: ESMF_END_ABORT, ESMF_Finalize use ESMF, only: operator(==), operator(/=), operator(+), operator(-) @@ -149,11 +149,9 @@ module MOM_cap_mod type(ESMF_GeomType_Flag) :: geomtype = ESMF_GEOMTYPE_MESH #else logical :: cesm_coupled = .false. -!type(ESMF_GeomType_Flag) :: geomtype = ESMF_GEOMTYPE_GRID -!type(ESMF_GeomType_Flag) :: geomtype = ESMF_GEOMTYPE_MESH +type(ESMF_GeomType_Flag) :: geomtype #endif character(len=8) :: restart_mode = 'alarms' -type(ESMF_GeomType_Flag) :: geomtype contains @@ -976,7 +974,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) "greater than parameter EPS_OMESH. n, lonMesh(n), lon(n), diff_lon, "//& "EPS_OMESH= ',i8,2(f21.13,3x),2(d21.5))" write(err_msg, frmt)n,lonMesh(n),lon(n), diff_lon, eps_omesh - !call MOM_error(FATAL, err_msg) + call MOM_error(FATAL, err_msg) end if diff_lat = abs(latMesh(n) - lat(n)) if (diff_lat > eps_omesh) then @@ -984,13 +982,13 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) "greater than parameter EPS_OMESH. n, latMesh(n), lat(n), diff_lat, "//& "EPS_OMESH= ',i8,2(f21.13,3x),2(d21.5))" write(err_msg, frmt)n,latMesh(n),lat(n), diff_lat, eps_omesh - !call MOM_error(FATAL, err_msg) + call MOM_error(FATAL, err_msg) end if if (abs(maskMesh(n) - mask(n)) > 0) then frmt = "('ERROR: ESMF mesh and MOM6 domain masks are inconsistent! - "//& "MOM n, maskMesh(n), mask(n) = ',3(i8,2x))" write(err_msg, frmt)n,maskMesh(n),mask(n) - !call MOM_error(FATAL, err_msg) + call MOM_error(FATAL, err_msg) end if end do From f30f636b2d65853180b125bd1f935c6d956c816b Mon Sep 17 00:00:00 2001 From: Olga Sergienko Date: Mon, 8 Feb 2021 19:35:38 -0500 Subject: [PATCH 13/35] corrected indecises in computation of driving stresses --- src/ice_shelf/MOM_ice_shelf_dynamics.F90 | 114 ++++++++++++++------- src/ice_shelf/MOM_ice_shelf_initialize.F90 | 38 ++++++- 2 files changed, 110 insertions(+), 42 deletions(-) diff --git a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 index ead882dd75..ef884dc434 100644 --- a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 +++ b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 @@ -44,7 +44,10 @@ module MOM_ice_shelf_dynamics !! on q-points (B grid) [L T-1 ~> m s-1] real, pointer, dimension(:,:) :: v_shelf => NULL() !< the meridional velocity of the ice shelf/sheet !! on q-points (B grid) [L T-1 ~> m s-1] - + real, pointer, dimension(:,:) :: taudx_shelf => NULL() !< the driving stress of the ice shelf/sheet + !! on q-points (C grid) [Pa ~> Pa] + real, pointer, dimension(:,:) :: taudy_shelf => NULL() !< the meridional stress of the ice shelf/sheet + !! on q-points (C grid) [Pa ~> Pa] real, pointer, dimension(:,:) :: u_face_mask => NULL() !< mask for velocity boundary conditions on the C-grid !! u-face - this is because the FEM cares about FACES THAT GET INTEGRATED OVER, !! not vertices. Will represent boundary conditions on computational boundary @@ -152,6 +155,7 @@ module MOM_ice_shelf_dynamics !>@{ Diagnostic handles integer :: id_u_shelf = -1, id_v_shelf = -1, id_t_shelf = -1, & + id_taudx_shelf = -1, id_taudy_shelf = -1, & id_ground_frac = -1, id_col_thick = -1, id_OD_av = -1, & id_u_mask = -1, id_v_mask = -1, id_t_mask = -1 !>@} @@ -250,7 +254,8 @@ subroutine register_ice_shelf_dyn_restarts(G, param_file, CS, restart_CS) allocate( CS%basal_traction(isd:ied,jsd:jed) ) ; CS%basal_traction(:,:) = 0.0 allocate( CS%OD_av(isd:ied,jsd:jed) ) ; CS%OD_av(:,:) = 0.0 allocate( CS%ground_frac(isd:ied,jsd:jed) ) ; CS%ground_frac(:,:) = 0.0 - + allocate( CS%taudx_shelf(Isd:Ied,Jsd:Jed) ) ; CS%taudx_shelf(:,:) = 0.0 + allocate( CS%taudy_shelf(Isd:Ied,Jsd:Jed) ) ; CS%taudy_shelf(:,:) = 0.0 ! additional restarts for ice shelf state call register_restart_field(CS%u_shelf, "u_shelf", .false., restart_CS, & "ice sheet/shelf u-velocity", "m s-1", hor_grid='Bu') @@ -258,6 +263,10 @@ subroutine register_ice_shelf_dyn_restarts(G, param_file, CS, restart_CS) "ice sheet/shelf v-velocity", "m s-1", hor_grid='Bu') call register_restart_field(CS%t_shelf, "t_shelf", .true., restart_CS, & "ice sheet/shelf vertically averaged temperature", "deg C") + call register_restart_field(CS%taudx_shelf, "taudx_shelf", .true., restart_CS, & !OVS 02/8/21 + "ice sheet/shelf taudx-driving stress", "kPa") + call register_restart_field(CS%taudy_shelf, "taudy_shelf", .true., restart_CS, & !OVS 02/08/21 + "ice sheet/shelf taudy-driving stress", "kPa") call register_restart_field(CS%OD_av, "OD_av", .true., restart_CS, & "Average open ocean depth in a cell","m") call register_restart_field(CS%ground_frac, "ground_frac", .true., restart_CS, & @@ -521,7 +530,8 @@ subroutine initialize_ice_shelf_dyn(param_file, Time, ISS, CS, G, US, diag, new_ endif call initialize_ice_shelf_boundary_channel(CS%u_face_mask_bdry, CS%v_face_mask_bdry, & - CS%u_flux_bdry_val, CS%v_flux_bdry_val, CS%u_bdry_val, CS%v_bdry_val, CS%h_bdry_val, & + CS%u_flux_bdry_val, CS%v_flux_bdry_val, CS%u_bdry_val, CS%v_bdry_val, CS%u_shelf, CS%v_shelf,& + CS%h_bdry_val, & CS%thickness_bdry_val, ISS%hmask, ISS%h_shelf, G, & ! CS%flux_bdry, & US, param_file ) !OVS initialize b.c.s @@ -530,10 +540,12 @@ subroutine initialize_ice_shelf_dyn(param_file, Time, ISS, CS, G, US, diag, new_ if (new_sim) then call MOM_mesg("MOM_ice_shelf.F90, initialize_ice_shelf: initialize ice velocity.") call update_OD_ffrac_uncoupled(CS, G, ISS%h_shelf(:,:)) - call ice_shelf_solve_outer(CS, ISS, G, US, CS%u_shelf, CS%v_shelf, iters, Time) - +! call ice_shelf_solve_outer(CS, ISS, G, US, CS%u_shelf, CS%v_shelf, iters, Time) + call ice_shelf_solve_outer(CS, ISS, G, US, CS%u_shelf, CS%v_shelf,CS%taudx_shelf,CS%taudy_shelf, iters, Time) !OVS 02/08/21 if (CS%id_u_shelf > 0) call post_data(CS%id_u_shelf, CS%u_shelf, CS%diag) if (CS%id_v_shelf > 0) call post_data(CS%id_v_shelf, CS%v_shelf,CS%diag) + if (CS%id_taudx_shelf > 0) call post_data(CS%id_taudx_shelf, CS%taudx_shelf,CS%diag) + if (CS%id_taudy_shelf > 0) call post_data(CS%id_taudy_shelf, CS%taudy_shelf,CS%diag) endif ! Register diagnostics. @@ -545,6 +557,10 @@ subroutine initialize_ice_shelf_dyn(param_file, Time, ISS, CS, G, US, diag, new_ ! 'y-velocity of ice', 'm yr-1', conversion=365.0*86400.0*US%L_T_to_m_s) CS%id_v_shelf = register_diag_field('ice_shelf_model','v_shelf',CS%diag%axesCv1, Time, & 'y-velocity of ice', 'm yr-1', conversion=365.0*86400.0*US%L_T_to_m_s) + CS%id_taudx_shelf = register_diag_field('ice_shelf_model','taudx_shelf',CS%diag%axesT1, Time, & + 'x-driving stress of ice', 'kPa', conversion=1.e-3*US%L_T_to_m_s) + CS%id_taudy_shelf = register_diag_field('ice_shelf_model','taudy_shelf',CS%diag%axesT1, Time, & + 'x-driving stress of ice', 'kPa', conversion=1.e-3*US%L_T_to_m_s) ! CS%id_u_mask = register_diag_field('ocean_model','u_mask',CS%diag%axesCu1, Time, & ! 'mask for u-nodes', 'none') CS%id_u_mask = register_diag_field('ice_shelf_model','u_mask',CS%diag%axesCu1, Time, & @@ -559,6 +575,7 @@ subroutine initialize_ice_shelf_dyn(param_file, Time, ISS, CS, G, US, diag, new_ ! 'fraction of cell that is grounded', 'none') CS%id_ground_frac = register_diag_field('ice_shelf_model','ice_ground_frac',CS%diag%axesT1, Time, & 'fraction of cell that is grounded', 'none') + ! CS%id_col_thick = register_diag_field('ocean_model','col_thick',CS%diag%axesT1, Time, & ! 'ocean column thickness passed to ice model', 'm', conversion=US%Z_to_m) CS%id_col_thick = register_diag_field('ice_shelf_model','col_thick',CS%diag%axesT1, Time, & @@ -575,10 +592,10 @@ subroutine initialize_ice_shelf_dyn(param_file, Time, ISS, CS, G, US, diag, new_ ! 'thickness after front adv ', 'none') !!! OVS vertically integrated temperature - CS%id_t_shelf = register_diag_field('ocean_model','t_shelf',CS%diag%axesT1, Time, & - 'T of ice', 'oC') - CS%id_t_mask = register_diag_field('ocean_model','tmask',CS%diag%axesT1, Time, & - 'mask for T-nodes', 'none') +! CS%id_t_shelf = register_diag_field('ocean_model','t_shelf',CS%diag%axesT1, Time, & +! 'T of ice', 'oC') +! CS%id_t_mask = register_diag_field('ocean_model','tmask',CS%diag%axesT1, Time, & +! 'mask for T-nodes', 'none') endif end subroutine initialize_ice_shelf_dyn @@ -615,8 +632,8 @@ subroutine initialize_diagnostic_fields(CS, ISS, G, US, Time) enddo enddo - call ice_shelf_solve_outer(CS, ISS, G, US, CS%u_shelf, CS%v_shelf, iters, dummy_time) - +! call ice_shelf_solve_outer(CS, ISS, G, US, CS%u_shelf, CS%v_shelf, iters, dummy_time) + call ice_shelf_solve_outer(CS, ISS, G, US, CS%u_shelf, CS%v_shelf,CS%taudx_shelf,CS%taudy_shelf, iters, Time) !OVS 02/08/21 end subroutine initialize_diagnostic_fields !> This function returns the global maximum advective timestep that can be taken based on the current @@ -676,7 +693,7 @@ subroutine update_ice_shelf(CS, ISS, G, US, time_step, Time, ocean_mass, coupled coupled_GL = .false. if (present(ocean_mass) .and. present(coupled_grounding)) coupled_GL = coupled_grounding - call ice_shelf_advect(CS, ISS, G, time_step, Time) +! call ice_shelf_advect(CS, ISS, G, time_step, Time) !OVS 02/08/21 CS%elapsed_velocity_time = CS%elapsed_velocity_time + time_step if (CS%elapsed_velocity_time >= CS%velocity_update_time_step) update_ice_vel = .true. @@ -688,7 +705,8 @@ subroutine update_ice_shelf(CS, ISS, G, US, time_step, Time, ocean_mass, coupled if (update_ice_vel) then - call ice_shelf_solve_outer(CS, ISS, G, US, CS%u_shelf, CS%v_shelf, iters, Time) +! call ice_shelf_solve_outer(CS, ISS, G, US, CS%u_shelf, CS%v_shelf, iters, Time) + call ice_shelf_solve_outer(CS, ISS, G, US, CS%u_shelf, CS%v_shelf,CS%taudx_shelf,CS%taudy_shelf, iters, Time) !OVS 02/08/21 endif call ice_shelf_temp(CS, ISS, G, US, time_step, ISS%water_flux, Time) @@ -699,6 +717,8 @@ subroutine update_ice_shelf(CS, ISS, G, US, time_step, Time, ocean_mass, coupled if (CS%id_u_shelf > 0) call post_data(CS%id_u_shelf, CS%u_shelf, CS%diag) if (CS%id_v_shelf > 0) call post_data(CS%id_v_shelf, CS%v_shelf, CS%diag) if (CS%id_t_shelf > 0) call post_data(CS%id_t_shelf,CS%t_shelf,CS%diag) + if (CS%id_taudx_shelf > 0) call post_data(CS%id_taudx_shelf, CS%taudx_shelf, CS%diag) + if (CS%id_taudy_shelf > 0) call post_data(CS%id_taudy_shelf, CS%taudy_shelf, CS%diag) if (CS%id_ground_frac > 0) call post_data(CS%id_ground_frac, CS%ground_frac,CS%diag) if (CS%id_OD_av >0) call post_data(CS%id_OD_av, CS%OD_av,CS%diag) @@ -801,7 +821,8 @@ subroutine ice_shelf_advect(CS, ISS, G, time_step, Time) end subroutine ice_shelf_advect -subroutine ice_shelf_solve_outer(CS, ISS, G, US, u_shlf, v_shlf, iters, time) +!subroutine ice_shelf_solve_outer(CS, ISS, G, US, u_shlf, v_shlf, iters, time) + subroutine ice_shelf_solve_outer(CS, ISS, G, US, u_shlf, v_shlf,taudx,taudy, iters, Time) !OVS 02/08/21 type(ice_shelf_dyn_CS), intent(inout) :: CS !< The ice shelf dynamics control structure type(ice_shelf_state), intent(in) :: ISS !< A structure with elements that describe !! the ice-shelf state @@ -861,7 +882,9 @@ subroutine ice_shelf_solve_outer(CS, ISS, G, US, u_shlf, v_shlf, iters, time) enddo call calc_shelf_driving_stress(CS, ISS, G, US, taudx, taudy, CS%OD_av) - + call pass_vector(taudx, taudy, G%domain, TO_ALL, BGRID_NE) !OVS 02/01/21 +! call pass_var(taudx, G%Domain) !OVS 01/21/21 +! call pass_var(taudy, G%Domain) !OVS 01/21/21 ! This is to determine which cells contain the grounding line, the criterion being that the cell ! is ice-covered, with some nodes floating and some grounded flotation condition is estimated by ! assuming topography is cellwise constant and H is bilinear in a cell; floating where @@ -1303,7 +1326,7 @@ subroutine ice_shelf_solve_inner(CS, ISS, G, US, u_shlf, v_shlf, taudx, taudy, H cg_halo = cg_halo - 1 if (cg_halo == 0) then - ! pass vectors + ! pass vectors call pass_vector(Du, Dv, G%domain, TO_ALL, BGRID_NE) call pass_vector(u_shlf, v_shlf, G%domain, TO_ALL, BGRID_NE) call pass_vector(Ru, Rv, G%domain, TO_ALL, BGRID_NE) @@ -1786,8 +1809,10 @@ subroutine calc_shelf_driving_stress(CS, ISS, G, US, taudx, taudy, OD) iscq = G%iscB ; iecq = G%iecB ; jscq = G%jscB ; jecq = G%jecB isd = G%isd ; jsd = G%jsd iegq = G%iegB ; jegq = G%jegB - gisc = G%domain%nihalo+1 ; gjsc = G%domain%njhalo+1 - giec = G%domain%niglobal+G%domain%nihalo ; gjec = G%domain%njglobal+G%domain%njhalo +! gisc = G%domain%nihalo+1 ; gjsc = G%domain%njhalo+1 + gisc = 0*G%domain%nihalo+1 ; gjsc = 0*G%domain%njhalo+1 +! giec = G%domain%niglobal+G%domain%nihalo ; gjec = G%domain%njglobal+G%domain%njhalo + giec = G%domain%niglobal+0*G%domain%nihalo ; gjec = G%domain%njglobal+0*G%domain%njhalo is = iscq - 1; js = jscq - 1 i_off = G%idg_offset ; j_off = G%jdg_offset @@ -1802,9 +1827,10 @@ subroutine calc_shelf_driving_stress(CS, ISS, G, US, taudx, taudy, OD) S(:,:) = BASE(:,:) + ISS%h_shelf(:,:) ! check whether the ice is floating or grounded - do j=jsc-1,jec+1 - do i=isc-1,iec+1 -! do i=isc-G%domain%nihalo,iec+G%domain%nihalo +! do j=jsc-1,jec+1 !OVS 02/02/21 +! do i=isc-1,iec+1 !OVS 02/02/21 + do j=jsc-G%domain%njhalo,jec+G%domain%njhalo !OVS 02/02/21 + do i=isc-G%domain%nihalo,iec+G%domain%nihalo !OVS 02/02/21 ! if (ISS%h_shelf(i,j) < rhow/rho * G%bathyT(i,j)) then if (rhoi_rhow * ISS%h_shelf(i,j) - G%bathyT(i,j) <= 0) then @@ -1816,6 +1842,8 @@ subroutine calc_shelf_driving_stress(CS, ISS, G, US, taudx, taudy, OD) enddo do j=jsc-1,jec+1 do i=isc-1,iec+1 +! do j=jsc-G%domain%njhalo+1,jec+G%domain%njhalo-1 !OVS 02/02/21 +! do i=isc-G%domain%nihalo+1,iec+G%domain%nihalo-1 !OVS 02/02/21 cnt = 0 sx = 0 sy = 0 @@ -1826,12 +1854,14 @@ subroutine calc_shelf_driving_stress(CS, ISS, G, US, taudx, taudy, OD) ! calculate sx if ((i+i_off) == gisc) then ! at left computational bdry - if (ISS%hmask(i+1,j) == 1) then +! if ((i-i_off) == gisc) then ! at left computational bdry !OVS 02/02/21 + if (ISS%hmask(i+1,j) == 1) then sx = (S(i+1,j)-S(i,j))/dxh else sx = 0 endif elseif ((i+i_off) == giec) then ! at east computational bdry +! elseif ((i-i_off) == giec) then ! at east computational bdry !OVS 02/02/21 if (ISS%hmask(i-1,j) == 1) then sx = (S(i,j)-S(i-1,j))/dxh else @@ -1861,12 +1891,14 @@ subroutine calc_shelf_driving_stress(CS, ISS, G, US, taudx, taudy, OD) ! calculate sy, similarly if ((j+j_off) == gjsc) then ! at south computational bdry +! if ((j-j_off) == gjsc) then ! at south computational bdry !OVS 02/02/21 if (ISS%hmask(i,j+1) == 1) then sy = (S(i,j+1)-S(i,j))/dyh else sy = 0 endif elseif ((j+j_off) == gjec) then ! at nprth computational bdry +! elseif ((j-j_off) == gjec) then ! at nprth computational bdry !OVS 02/02/21 if (ISS%hmask(i,j-1) == 1) then sy = (S(i,j)-S(i,j-1))/dyh else @@ -1894,29 +1926,31 @@ subroutine calc_shelf_driving_stress(CS, ISS, G, US, taudx, taudy, OD) ! SW vertex if (ISS%hmask(I-1,J-1) == 1) then - if (CS%u_face_mask(I-1,J-1) /= 3) then +! if (CS%u_face_mask(I-1,J-1) /= 3) then taudx(I-1,J-1) = taudx(I-1,J-1) - .25 * rho * grav * ISS%h_shelf(i,j) * sx * G%areaT(i,j) taudy(I-1,J-1) = taudy(I-1,J-1) - .25 * rho * grav * ISS%h_shelf(i,j) * sy * G%areaT(i,j) - endif +! endif endif ! SE vertex if (ISS%hmask(I,J-1) == 1) then - if (CS%u_face_mask(I,J-1) /= 3) then +! if (CS%u_face_mask(I,J-1) /= 3) then taudx(I,J-1) = taudx(I,J-1) - .25 * rho * grav * ISS%h_shelf(i,j) * sx * G%areaT(i,j) taudy(I,J-1) = taudy(I,J-1) - .25 * rho * grav * ISS%h_shelf(i,j) * sy * G%areaT(i,j) - endif +! endif endif ! NW vertex - if (CS%u_face_mask(I-1,J) /= 3) then + if (ISS%hmask(I-1,J) == 1) then +! if (CS%u_face_mask(I-1,J) /= 3) then taudx(I-1,J) = taudx(I-1,J) - .25 * rho * grav * ISS%h_shelf(i,j) * sx * G%areaT(i,j) taudy(I-1,J) = taudy(I-1,J) - .25 * rho * grav * ISS%h_shelf(i,j) * sy * G%areaT(i,j) - endif +! endif + endif ! NE vertex if (ISS%hmask(I,J) == 1) then - if (CS%u_face_mask(I,J) /= 3) then +! if (CS%u_face_mask(I,J) /= 3) then taudx(I,J) = taudx(I,J) - .25 * rho * grav * ISS%h_shelf(i,j) * sx * G%areaT(i,j) taudy(I,J) = taudy(I,J) - .25 * rho * grav * ISS%h_shelf(i,j) * sy * G%areaT(i,j) - endif +! endif endif if (CS%ground_frac(i,j) == 1) then ! neumann_val = .5 * grav * (rho * ISS%h_shelf(i,j)**2 - rhow * G%bathyT(i,j)**2) @@ -2550,8 +2584,8 @@ subroutine calc_shelf_visc(CS, ISS, G, US, u_shlf, v_shlf) Visc_coef = US%kg_m2s_to_RZ_T*US%m_to_L*US%Z_to_L*(CS%A_glen_isothermal)**(-1./CS%n_glen) !OVS '-' in the exponent - do j=jsd+1,jed-1 - do i=isd+1,ied-1 + do j=jsd+1,jed!-1 OVS 02/01/21 + do i=isd+1,ied!-1 OVS 02/01/21 if (ISS%hmask(i,j) == 1) then ux = ((u_shlf(I,J) + u_shlf(I,J-1)) - (u_shlf(I-1,J) + u_shlf(I-1,J-1))) / (2*G%dxT(i,j)) @@ -2601,8 +2635,8 @@ subroutine calc_shelf_taub(CS, ISS, G, US, u_shlf, v_shlf) eps_min = CS%eps_glen_min - do j=jsd+1,jed-1 - do i=isd+1,ied-1 + do j=jsd+1,jed!-1 OVS 02/01/21 + do i=isd+1,ied!-1 OVS 02/01/21 if (ISS%hmask(i,j) == 1) then umid = ((u_shlf(I,J) + u_shlf(I-1,J-1)) + (u_shlf(I,J-1) + u_shlf(I-1,J))) * 0.25 @@ -2911,8 +2945,8 @@ subroutine update_velocity_masks(CS, G, hmask, umask, vmask, u_face_mask, v_face is = isd+1 ; js = jsd+1 endif -! do j=js,G%jed - do j=js-1,G%jed !OVS change index + do j=js,G%jed +! do j=js-1,G%jed !OVS change index do i=is,G%ied if (hmask(i,j) == 1) then @@ -2953,8 +2987,12 @@ subroutine update_velocity_masks(CS, G, hmask, umask, vmask, u_face_mask, v_face select case (int(CS%v_face_mask_bdry(i,J-1+k))) case (3) - vmask(I-1:I,J-1+k)=3. - umask(I-1:I,J-1+k)=0. +! vmask(I-1:I,J-1+k)=3. +! umask(I-1:I,J-1+k)=0. + vmask(I-1,J-1+k)=3. + umask(I-1,J-1+k)=0. + vmask(I,J-1+k)=3. + umask(I,J-1+k)=0. v_face_mask(i,J-1+k)=3. case (2) v_face_mask(i,J-1+k)=2. diff --git a/src/ice_shelf/MOM_ice_shelf_initialize.F90 b/src/ice_shelf/MOM_ice_shelf_initialize.F90 index 367f8d7dce..7025e53981 100644 --- a/src/ice_shelf/MOM_ice_shelf_initialize.F90 +++ b/src/ice_shelf/MOM_ice_shelf_initialize.F90 @@ -266,7 +266,7 @@ subroutine initialize_ice_thickness_channel(h_shelf, area_shelf_h, hmask, G, US, end subroutine initialize_ice_thickness_channel subroutine initialize_ice_shelf_boundary_channel(u_face_mask_bdry, v_face_mask_bdry, & u_flux_bdry_val, v_flux_bdry_val, u_bdry_val, v_bdry_val, h_bdry_val, & - thickness_bdry_val, hmask, h_shelf, G,& ! OVS h_shelf 11/10/20 + thickness_bdry_val, hmask, h_shelf, u_shelf, v_shelf, G,& ! OVS h_shelf 11/10/20 ! flux_bdry, & US, PF ) @@ -286,6 +286,10 @@ subroutine initialize_ice_shelf_boundary_channel(u_face_mask_bdry, v_face_mask_b !! boundary vertices [L T-1 ~> m s-1]. real, dimension(SZIB_(G),SZJB_(G)), & intent(inout) :: v_bdry_val !< The meridional ice shelf velocity at open + real, dimension(SZIB_(G),SZJB_(G)), & + intent(inout) :: u_shelf !< The zonal ice shelf velocity [L T-1 ~> m s-1]. + real, dimension(SZIB_(G),SZJB_(G)), & + intent(inout) :: v_shelf !< The meridional ice shelf velocity [L T-1 ~> m s-1]. real, dimension(SZDI_(G),SZDJ_(G)), & intent(inout) :: thickness_bdry_val !< The ice shelf thickness at open boundaries [Z ~> m] !! boundary vertices [L T-1 ~> m s-1]. @@ -362,9 +366,11 @@ subroutine initialize_ice_shelf_boundary_channel(u_face_mask_bdry, v_face_mask_b v_face_mask_bdry(i,j+1) = 0. u_face_mask_bdry(i,j-1) = 3. !OVS 11/25/20 else - v_face_mask_bdry(i,j+1) = 1. +! v_face_mask_bdry(i,j+1) = 1. + v_face_mask_bdry(i,j-1) = 3. !OVS 01/20/21 u_face_mask_bdry(i,j-1) = 3. !OVS 11/25/20 - u_bdry_val(i,j) = 0. +! u_bdry_val(i,j) = 0. +! v_bdry_val(i,j) = 0. !OVS 01/20/21 !hmask(i,j) = 0.0 !OVS 11/25/20 endif elseif (G%geoLatBu(i,j-1) == southlat+lenlat) then !top boundary @@ -372,7 +378,8 @@ subroutine initialize_ice_shelf_boundary_channel(u_face_mask_bdry, v_face_mask_b v_face_mask_bdry(i,j-1) = 0. u_face_mask_bdry(i,j-1) = 3. !OVS 11/25/20 else - v_face_mask_bdry(i,j-1) = 1. +! v_face_mask_bdry(i,j-1) = 1. + v_face_mask_bdry(i,j-1) = 3. !OVS 01/20/21 u_face_mask_bdry(i,j-1) = 3. !OVS 11/25/20 !u_bdry_val(i,j) = 0. !OVS 11/25/20 !hmask(i,j) = 0.0 !OVS 11/25/20 @@ -387,6 +394,29 @@ subroutine initialize_ice_shelf_boundary_channel(u_face_mask_bdry, v_face_mask_b enddo enddo + +! if (.not. G%symmetric) then +!! do j=G%jsd,G%jed +!! do i=G%isd,G%ied +! do j=jsc-1,jec+1 +! do i=isc-1,iec+1 +!! if (((i+G%idg_offset) == (G%domain%nihalo+1)).and.(u_face_mask_bdry(I-1,j) == 3)) then +! if (u_face_mask_bdry(I-1,j) == 3) then +! u_shelf(I-1,J-1) = u_bdry_val(I-1,J-1) +! u_shelf(I-1,J) = u_bdry_val(I-1,J) +! v_shelf(I-1,J-1) = v_bdry_val(I-1,J-1) +! v_shelf(I-1,J) = v_bdry_val(I-1,J) +! endif +!! if (((j+G%jdg_offset) == (G%domain%njhalo+1)).and.(v_face_mask_bdry(i,J-1) == 3)) then +! if (v_face_mask_bdry(I,j-1) == 3) then +! u_shelf(I-1,J-1) = u_bdry_val(I-1,J-1) +! u_shelf(I,J-1) = u_bdry_val(I,J-1) +! v_shelf(I-1,J-1) = v_bdry_val(I-1,J-1) +! v_shelf(I,J-1) = v_bdry_val(I,J-1) +! endif +! enddo +! enddo +! endif end subroutine initialize_ice_shelf_boundary_channel !BEGIN MJH From 775205208d4df98879e42ea66cd0e3b520f9a646 Mon Sep 17 00:00:00 2001 From: Olga Sergienko Date: Wed, 10 Feb 2021 12:39:08 -0500 Subject: [PATCH 14/35] fixed ice-shelf advection --- src/ice_shelf/MOM_ice_shelf_dynamics.F90 | 16 +++++++++------- src/ice_shelf/MOM_ice_shelf_initialize.F90 | 12 +++++++----- 2 files changed, 16 insertions(+), 12 deletions(-) diff --git a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 index ef884dc434..89c91172e1 100644 --- a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 +++ b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 @@ -558,9 +558,9 @@ subroutine initialize_ice_shelf_dyn(param_file, Time, ISS, CS, G, US, diag, new_ CS%id_v_shelf = register_diag_field('ice_shelf_model','v_shelf',CS%diag%axesCv1, Time, & 'y-velocity of ice', 'm yr-1', conversion=365.0*86400.0*US%L_T_to_m_s) CS%id_taudx_shelf = register_diag_field('ice_shelf_model','taudx_shelf',CS%diag%axesT1, Time, & - 'x-driving stress of ice', 'kPa', conversion=1.e-3*US%L_T_to_m_s) + 'x-driving stress of ice', 'kPa', conversion=1.e-9*US%L_T_to_m_s) CS%id_taudy_shelf = register_diag_field('ice_shelf_model','taudy_shelf',CS%diag%axesT1, Time, & - 'x-driving stress of ice', 'kPa', conversion=1.e-3*US%L_T_to_m_s) + 'x-driving stress of ice', 'kPa', conversion=1.e-9*US%L_T_to_m_s) ! CS%id_u_mask = register_diag_field('ocean_model','u_mask',CS%diag%axesCu1, Time, & ! 'mask for u-nodes', 'none') CS%id_u_mask = register_diag_field('ice_shelf_model','u_mask',CS%diag%axesCu1, Time, & @@ -693,7 +693,7 @@ subroutine update_ice_shelf(CS, ISS, G, US, time_step, Time, ocean_mass, coupled coupled_GL = .false. if (present(ocean_mass) .and. present(coupled_grounding)) coupled_GL = coupled_grounding -! call ice_shelf_advect(CS, ISS, G, time_step, Time) !OVS 02/08/21 + call ice_shelf_advect(CS, ISS, G, time_step, Time) !OVS 02/08/21 CS%elapsed_velocity_time = CS%elapsed_velocity_time + time_step if (CS%elapsed_velocity_time >= CS%velocity_update_time_step) update_ice_vel = .true. @@ -782,7 +782,7 @@ subroutine ice_shelf_advect(CS, ISS, G, time_step, Time) call ice_shelf_advect_thickness_x(CS, G, LB, time_step, ISS%hmask, ISS%h_shelf, h_after_uflux, uh_ice) ! call enable_averages(time_step, Time, CS%diag) -! call pass_var(h_after_uflux, G%domain) + call pass_var(h_after_uflux, G%domain) ! if (CS%id_h_after_uflux > 0) call post_data(CS%id_h_after_uflux, h_after_uflux, CS%diag) ! call disable_averaging(CS%diag) @@ -790,7 +790,7 @@ subroutine ice_shelf_advect(CS, ISS, G, time_step, Time) call ice_shelf_advect_thickness_y(CS, G, LB, time_step, ISS%hmask, h_after_uflux, h_after_vflux, vh_ice) ! call enable_averages(time_step, Time, CS%diag) -! call pass_var(h_after_vflux, G%domain) + call pass_var(h_after_vflux, G%domain) ! if (CS%id_h_after_vflux > 0) call post_data(CS%id_h_after_vflux, h_after_vflux, CS%diag) ! call disable_averaging(CS%diag) @@ -882,7 +882,7 @@ subroutine ice_shelf_solve_outer(CS, ISS, G, US, u_shlf, v_shlf,taudx,taudy, ite enddo call calc_shelf_driving_stress(CS, ISS, G, US, taudx, taudy, CS%OD_av) - call pass_vector(taudx, taudy, G%domain, TO_ALL, BGRID_NE) !OVS 02/01/21 +! call pass_vector(taudx, taudy, G%domain, TO_ALL, BGRID_NE) !OVS 02/01/21 ! call pass_var(taudx, G%Domain) !OVS 01/21/21 ! call pass_var(taudy, G%Domain) !OVS 01/21/21 ! This is to determine which cells contain the grounding line, the criterion being that the cell @@ -1842,6 +1842,8 @@ subroutine calc_shelf_driving_stress(CS, ISS, G, US, taudx, taudy, OD) enddo do j=jsc-1,jec+1 do i=isc-1,iec+1 +! do j=G%jsd+1,G%jed-1 !OVS 02/08/21 +! do i=G%isd+1,G%ied-1 !OVS 02/08/21 ! do j=jsc-G%domain%njhalo+1,jec+G%domain%njhalo-1 !OVS 02/02/21 ! do i=isc-G%domain%nihalo+1,iec+G%domain%nihalo-1 !OVS 02/02/21 cnt = 0 @@ -2594,7 +2596,7 @@ subroutine calc_shelf_visc(CS, ISS, G, US, u_shlf, v_shlf) vy = ((v_shlf(I,J) + v_shlf(I-1,J)) - (v_shlf(I,J-1) + v_shlf(I-1,J-1))) / (2*G%dyT(i,j)) CS%ice_visc(i,j) = 0.5 * Visc_coef * (G%areaT(i,j) * ISS%h_shelf(i,j)) * & (US%s_to_T**2 * (ux**2 + vy**2 + ux*vy + 0.25*(uy+vx)**2 + eps_min**2))**((1.-n_g)/(2.*n_g)) - +! CS%ice_visc(i,j) =1e15*(G%areaT(i,j) * ISS%h_shelf(i,j)) !OVS 02/09/21 constvisc ! umid = ((u_shlf(I,J) + u_shlf(I-1,J-1)) + (u_shlf(I,J-1) + u_shlf(I-1,J))) * 0.25 ! vmid = ((v_shlf(I,J) + v_shlf(I-1,J-1)) + (v_shlf(I,J-1) + v_shlf(I-1,J))) * 0.25 ! unorm = sqrt(umid**2 + vmid**2 + eps_min**2*(G%dxT(i,j)**2 + G%dyT(i,j)**2)) diff --git a/src/ice_shelf/MOM_ice_shelf_initialize.F90 b/src/ice_shelf/MOM_ice_shelf_initialize.F90 index 7025e53981..2bfe64677c 100644 --- a/src/ice_shelf/MOM_ice_shelf_initialize.F90 +++ b/src/ice_shelf/MOM_ice_shelf_initialize.F90 @@ -349,11 +349,13 @@ subroutine initialize_ice_shelf_boundary_channel(u_face_mask_bdry, v_face_mask_b ! u_face_mask_bdry(i-1,j) = 4.0 ! u_flux_bdry_val(i-1,j) = input_flux ! else - hmask(i+1,j) = 3.0 - h_bdry_val(i+1,j) = h_shelf(i+1,j) !OVS 11/10/20 !input_thick - thickness_bdry_val(i+1,j) = h_bdry_val(i+1,j) - u_face_mask_bdry(i+1,j) = 3.0 - u_bdry_val(i+1,j) = input_vel*(1-16.0*((G%geoLatBu(i-1,j)/lenlat-0.5))**4) !OVS 11/09/20 U b.c. +! hmask(i+1,j) = 3.0 + hmask(i,j) = 3.0 +! h_bdry_val(i+1,j) = h_shelf(i+1,j) !OVS 11/10/20 !input_thick + h_bdry_val(i,j) = h_shelf(i,j) + thickness_bdry_val(i+0*1,j) = h_bdry_val(i+0*1,j) + u_face_mask_bdry(i+0*1,j) = 3.0 + u_bdry_val(i+0*1,j) = input_vel*(1-16.0*((G%geoLatBu(i-1,j)/lenlat-0.5))**4) !OVS 11/09/20 U b.c. ! u_bdry_val(i+1,j) = (1 - ((G%geoLatBu(i,j) - 0.5*lenlat)*2./lenlat)**2) * & ! 1.5 * input_flux / input_thick ! endif From f0ae41c0caf262607b0c28b9e5e54bb313c7809a Mon Sep 17 00:00:00 2001 From: Olga Sergienko Date: Thu, 11 Feb 2021 17:33:02 -0500 Subject: [PATCH 15/35] modified viscosity computations --- src/ice_shelf/MOM_ice_shelf_dynamics.F90 | 204 +++++++++++++++++++---- 1 file changed, 168 insertions(+), 36 deletions(-) diff --git a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 index 89c91172e1..db3a49cfe9 100644 --- a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 +++ b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 @@ -925,10 +925,11 @@ subroutine ice_shelf_solve_outer(CS, ISS, G, US, u_shlf, v_shlf,taudx,taudy, ite enddo ; enddo call calc_shelf_visc(CS, ISS, G, US, u_shlf, v_shlf) - call pass_var(CS%ice_visc, G%domain) - +! call pass_var(CS%ice_visc, G%domain) +! call pass_vector(CS%ice_visc, G%domain, TO_ALL, BGRID_NE) !OVS 02/11/21 call calc_shelf_taub(CS, ISS, G, US, u_shlf, v_shlf) call pass_var(CS%basal_traction, G%domain) +! call pass_vector(CS%ice_visc,CS%basal_traction, G%domain, TO_ALL, BGRID_NE) !OVS 02/11/21 ! This makes sure basal stress is only applied when it is supposed to be do j=G%jsd,G%jed ; do i=G%isd,G%ied @@ -1842,10 +1843,6 @@ subroutine calc_shelf_driving_stress(CS, ISS, G, US, taudx, taudy, OD) enddo do j=jsc-1,jec+1 do i=isc-1,iec+1 -! do j=G%jsd+1,G%jed-1 !OVS 02/08/21 -! do i=G%isd+1,G%ied-1 !OVS 02/08/21 -! do j=jsc-G%domain%njhalo+1,jec+G%domain%njhalo-1 !OVS 02/02/21 -! do i=isc-G%domain%nihalo+1,iec+G%domain%nihalo-1 !OVS 02/02/21 cnt = 0 sx = 0 sy = 0 @@ -1856,14 +1853,12 @@ subroutine calc_shelf_driving_stress(CS, ISS, G, US, taudx, taudy, OD) ! calculate sx if ((i+i_off) == gisc) then ! at left computational bdry -! if ((i-i_off) == gisc) then ! at left computational bdry !OVS 02/02/21 if (ISS%hmask(i+1,j) == 1) then sx = (S(i+1,j)-S(i,j))/dxh else sx = 0 endif elseif ((i+i_off) == giec) then ! at east computational bdry -! elseif ((i-i_off) == giec) then ! at east computational bdry !OVS 02/02/21 if (ISS%hmask(i-1,j) == 1) then sx = (S(i,j)-S(i-1,j))/dxh else @@ -1893,14 +1888,12 @@ subroutine calc_shelf_driving_stress(CS, ISS, G, US, taudx, taudy, OD) ! calculate sy, similarly if ((j+j_off) == gjsc) then ! at south computational bdry -! if ((j-j_off) == gjsc) then ! at south computational bdry !OVS 02/02/21 if (ISS%hmask(i,j+1) == 1) then sy = (S(i,j+1)-S(i,j))/dyh else sy = 0 endif elseif ((j+j_off) == gjec) then ! at nprth computational bdry -! elseif ((j-j_off) == gjec) then ! at nprth computational bdry !OVS 02/02/21 if (ISS%hmask(i,j-1) == 1) then sy = (S(i,j)-S(i,j-1))/dyh else @@ -1928,31 +1921,23 @@ subroutine calc_shelf_driving_stress(CS, ISS, G, US, taudx, taudy, OD) ! SW vertex if (ISS%hmask(I-1,J-1) == 1) then -! if (CS%u_face_mask(I-1,J-1) /= 3) then taudx(I-1,J-1) = taudx(I-1,J-1) - .25 * rho * grav * ISS%h_shelf(i,j) * sx * G%areaT(i,j) taudy(I-1,J-1) = taudy(I-1,J-1) - .25 * rho * grav * ISS%h_shelf(i,j) * sy * G%areaT(i,j) -! endif endif ! SE vertex if (ISS%hmask(I,J-1) == 1) then -! if (CS%u_face_mask(I,J-1) /= 3) then taudx(I,J-1) = taudx(I,J-1) - .25 * rho * grav * ISS%h_shelf(i,j) * sx * G%areaT(i,j) taudy(I,J-1) = taudy(I,J-1) - .25 * rho * grav * ISS%h_shelf(i,j) * sy * G%areaT(i,j) -! endif endif ! NW vertex if (ISS%hmask(I-1,J) == 1) then -! if (CS%u_face_mask(I-1,J) /= 3) then taudx(I-1,J) = taudx(I-1,J) - .25 * rho * grav * ISS%h_shelf(i,j) * sx * G%areaT(i,j) taudy(I-1,J) = taudy(I-1,J) - .25 * rho * grav * ISS%h_shelf(i,j) * sy * G%areaT(i,j) -! endif endif ! NE vertex if (ISS%hmask(I,J) == 1) then -! if (CS%u_face_mask(I,J) /= 3) then taudx(I,J) = taudx(I,J) - .25 * rho * grav * ISS%h_shelf(i,j) * sx * G%areaT(i,j) taudy(I,J) = taudy(I,J) - .25 * rho * grav * ISS%h_shelf(i,j) * sy * G%areaT(i,j) -! endif endif if (CS%ground_frac(i,j) == 1) then ! neumann_val = .5 * grav * (rho * ISS%h_shelf(i,j)**2 - rhow * G%bathyT(i,j)**2) @@ -2567,11 +2552,11 @@ subroutine calc_shelf_visc(CS, ISS, G, US, u_shlf, v_shlf) ! also this subroutine updates the nonlinear part of the basal traction ! this may be subject to change later... to make it "hybrid" - + real, dimension(SZDIB_(G),SZDJB_(G)) :: eII integer :: i, j, iscq, iecq, jscq, jecq, isd, jsd, ied, jed, iegq, jegq - integer :: giec, gjec, gisc, gjsc, cnt, isc, jsc, iec, jec, is, js + integer :: giec, gjec, gisc, gjsc, cnt, isc, jsc, iec, jec, is, js, i_off, j_off real :: Visc_coef, n_g - real :: ux, uy, vx, vy, eps_min ! Velocity shears [T-1 ~> s-1] + real :: ux, uy, vx, vy, eps_min, dxh, dyh ! Velocity shears [T-1 ~> s-1] ! real :: umid, vmid, unorm ! Velocities [L T-1 ~> m s-1] isc = G%isc ; jsc = G%jsc ; iec = G%iec ; jec = G%jec @@ -2581,30 +2566,177 @@ subroutine calc_shelf_visc(CS, ISS, G, US, u_shlf, v_shlf) gisc = G%domain%nihalo+1 ; gjsc = G%domain%njhalo+1 giec = G%domain%niglobal+gisc ; gjec = G%domain%njglobal+gjsc is = iscq - 1; js = jscq - 1 + i_off = G%idg_offset ; j_off = G%jdg_offset n_g = CS%n_glen; eps_min = CS%eps_glen_min + CS%ice_visc(:,:) = 0.0 + eII(:,:) = (US%s_to_T**2 * (eps_min**2)) Visc_coef = US%kg_m2s_to_RZ_T*US%m_to_L*US%Z_to_L*(CS%A_glen_isothermal)**(-1./CS%n_glen) !OVS '-' in the exponent - - do j=jsd+1,jed!-1 OVS 02/01/21 - do i=isd+1,ied!-1 OVS 02/01/21 - - if (ISS%hmask(i,j) == 1) then - ux = ((u_shlf(I,J) + u_shlf(I,J-1)) - (u_shlf(I-1,J) + u_shlf(I-1,J-1))) / (2*G%dxT(i,j)) - vx = ((v_shlf(I,J) + v_shlf(I,J-1)) - (v_shlf(I-1,J) + v_shlf(I-1,J-1))) / (2*G%dxT(i,j)) - uy = ((u_shlf(I,J) + u_shlf(I-1,J)) - (u_shlf(I,J-1) + u_shlf(I-1,J-1))) / (2*G%dyT(i,j)) - vy = ((v_shlf(I,J) + v_shlf(I-1,J)) - (v_shlf(I,J-1) + v_shlf(I-1,J-1))) / (2*G%dyT(i,j)) - CS%ice_visc(i,j) = 0.5 * Visc_coef * (G%areaT(i,j) * ISS%h_shelf(i,j)) * & - (US%s_to_T**2 * (ux**2 + vy**2 + ux*vy + 0.25*(uy+vx)**2 + eps_min**2))**((1.-n_g)/(2.*n_g)) -! CS%ice_visc(i,j) =1e15*(G%areaT(i,j) * ISS%h_shelf(i,j)) !OVS 02/09/21 constvisc + call pass_vector(u_shlf, v_shlf, G%domain, TO_ALL, BGRID_NE) +! do j=jsc-1,jec+1 +! do i=isc-1,iec+1 +!! do j=jsd+1,jed!-1 OVS 02/01/21 +!! do i=isd+1,ied!-1 OVS 02/01/21 + +! if (ISS%hmask(i,j) == 1) then +! ux = ((u_shlf(I,J) + 0*u_shlf(I,J-1)) - (u_shlf(I-1,J) + 0*u_shlf(I-1,J-1))) / (G%dxT(i,j)) +! vx = ((v_shlf(I,J) + v_shlf(I,J-1)) - (v_shlf(I-1,J) + v_shlf(I-1,J-1))) / (2*G%dxT(i,j)) +! uy = ((u_shlf(I,J) + u_shlf(I-1,J)) - (u_shlf(I,J-1) + u_shlf(I-1,J-1))) / (2*G%dyT(i,j)) +! vy = ((v_shlf(I,J) + v_shlf(I-1,J)) - (v_shlf(I,J-1) + v_shlf(I-1,J-1))) / (2*G%dyT(i,j)) +!! ux = ((u_shlf(I,J) + u_shlf(I,J-1)) - (u_shlf(I-1,J) + u_shlf(I-1,J-1))) / (2*G%dxT(i,j)) +!! vx = ((v_shlf(I,J) + v_shlf(I,J-1)) - (v_shlf(I-1,J) + v_shlf(I-1,J-1))) / (2*G%dxT(i,j)) +!! uy = ((u_shlf(I,J) + u_shlf(I-1,J)) - (u_shlf(I,J-1) + u_shlf(I-1,J-1))) / (2*G%dyT(i,j)) +!! vy = ((v_shlf(I,J) + v_shlf(I-1,J)) - (v_shlf(I,J-1) + v_shlf(I-1,J-1))) / (2*G%dyT(i,j)) +! CS%ice_visc(i,j) = 0.5 * Visc_coef * (G%areaT(i,j) * ISS%h_shelf(i,j)) * & +! (US%s_to_T**2 * (ux**2 + vy**2 + ux*vy + 0.25*(uy+vx)**2 + eps_min**2))**((1.-n_g)/(2.*n_g)) +! CS%ice_visc(i,j) =1e15*(G%areaT(i,j) * ISS%h_shelf(i,j)) ! constant viscocity for debugging ! umid = ((u_shlf(I,J) + u_shlf(I-1,J-1)) + (u_shlf(I,J-1) + u_shlf(I-1,J))) * 0.25 ! vmid = ((v_shlf(I,J) + v_shlf(I-1,J-1)) + (v_shlf(I,J-1) + v_shlf(I-1,J))) * 0.25 ! unorm = sqrt(umid**2 + vmid**2 + eps_min**2*(G%dxT(i,j)**2 + G%dyT(i,j)**2)) ! CS%basal_traction(i,j) = G%areaT(i,j) * CS%C_basal_friction * (US%L_T_to_m_s*unorm)**(CS%n_basal_fric-1) - endif - enddo - enddo +! endif +! enddo +! enddo + + + do j=jsc-1,jec+1 + do i=isc-1,iec+1 + cnt = 0 + ux = 0 + uy = 0 + vx = 0 + vy = 0 + dxh = G%dxT(i,j) + dyh = G%dyT(i,j) + + if (ISS%hmask(i,j) == 1) then ! we are inside the global computational bdry, at an ice-filled cell + ! calculate sx +! if ((i+i_off) == gisc) then ! at left computational bdry +! if (ISS%hmask(i+1,j) == 1) then +! ux = (u_shlf(i+1,j)-u_shlf(i,j))/dxh +! vx = (v_shlf(i+1,j)-v_shlf(i,j))/dxh +! else +! ux = 0 +! vx = 0 +! endif +! elseif ((i+i_off) == giec) then ! at east computational bdry +! if (ISS%hmask(i-1,j) == 1) then +! ux = (u_shlf(i,j)-u_shlf(i-1,j))/dxh +! vx = (v_shlf(i,j)-v_shlf(i-1,j))/dxh +! else +! ux = 0 +! vx = 0 +! endif +! else ! interior + if (ISS%hmask(i+1,j) == 1) then + cnt = cnt+1 + ux = u_shlf(i+1,j) + vx = v_shlf(i+1,j) + else + ux = u_shlf(i,j) + vx = v_shlf(i,j) + endif + if (ISS%hmask(i-1,j) == 1) then + cnt = cnt+1 + ux = ux - u_shlf(i-1,j) + vx = vx - v_shlf(i-1,j) + else + ux = ux - u_shlf(i,j) + vx = vx - v_shlf(i,j) + endif + if (cnt == 0) then + ux = 0 + vx = 0 + else + ux = ux / (cnt * dxh) + vx = vx / (cnt * dxh) + endif +! endif + cnt = 0 + + ! calculate sy, similarly +! if ((j+j_off) == gjsc) then ! at south computational bdry +! if (ISS%hmask(i,j+1) == 1) then +! uy = (u_shlf(i,j+1)-u_shlf(i,j))/dyh +! vy = (v_shlf(i,j+1)-v_shlf(i,j))/dyh +! else +! vy = 0 +! endif +! elseif ((j+j_off) == gjec) then ! at nprth computational bdry +! if (ISS%hmask(i,j-1) == 1) then +! uy = (u_shlf(i,j)-u_shlf(i,j-1))/dyh +! vy = (v_shlf(i,j)-v_shlf(i,j-1))/dyh +! else +! uy = 0 +! vy = 0 +! endif +! else ! interior + if (ISS%hmask(i,j+1) == 1) then + cnt = cnt+1 + uy = u_shlf(i,j+1) + vy = v_shlf(i,j+1) + else + uy = u_shlf(i,j) + vy = v_shlf(i,j) + endif + if (ISS%hmask(i,j-1) == 1) then + cnt = cnt+1 + uy = uy - u_shlf(i,j-1) + vy = vy - v_shlf(i,j-1) + else + uy = uy - u_shlf(i,j) + vy = vy - v_shlf(i,j) + endif + if (cnt == 0) then + uy = 0 + vy = 0 + else + uy = uy / (cnt * dyh) + vy = vy / (cnt * dyh) + endif +! endif + + ! SW vertex + if (ISS%hmask(I-1,J-1) == 1) then + eII(i-1,j-1) = eII(i-1,j-1)+.125*(US%s_to_T**2 * (ux**2 + vy**2 + ux*vy + 0.25*(uy+vx)**2 + eps_min**2)) + endif + ! SE vertex + if (ISS%hmask(I,J-1) == 1) then + eII(i,j-1) = eII(i,j-1)+.125*(US%s_to_T**2 * (ux**2 + vy**2 + ux*vy + 0.25*(uy+vx)**2 + eps_min**2)) + +! CS%ice_visc(i,j-1) = CS%ice_visc(i,j-1)+.25*0.5 * Visc_coef * (G%areaT(i,j) * ISS%h_shelf(i,j)) * & +! (US%s_to_T**2 * (ux**2 + vy**2 + ux*vy + 0.25*(uy+vx)**2 + eps_min**2))**((1.-n_g)/(2.*n_g)) + endif + ! NW vertex + if (ISS%hmask(I-1,J) == 1) then + eII(i-1,j) = eII(i-1,j)+.125*(US%s_to_T**2 * (ux**2 + vy**2 + ux*vy + 0.25*(uy+vx)**2 + eps_min**2)) + +! CS%ice_visc(i-1,j) = CS%ice_visc(i-1,j)+.25*0.5 * Visc_coef * (G%areaT(i,j) * ISS%h_shelf(i,j)) * & +! (US%s_to_T**2 * (ux**2 + vy**2 + ux*vy + 0.25*(uy+vx)**2 + eps_min**2))**((1.-n_g)/(2.*n_g)) + endif + ! NE vertex + if (ISS%hmask(I,J) == 1) then + eII(i,j) = eII(i,j)+.25*(US%s_to_T**2 * (ux**2 + vy**2 + ux*vy + 0.25*(uy+vx)**2 + eps_min**2)) + +! CS%ice_visc(i,j) = CS%ice_visc(i,j)+.25*0.5 * Visc_coef * (G%areaT(i,j) * ISS%h_shelf(i,j)) * & +! (US%s_to_T**2 * (ux**2 + vy**2 + ux*vy + 0.25*(uy+vx)**2 + eps_min**2))**((1.-n_g)/(2.*n_g)) + endif + if (ISS%hmask(I+1,J+1) == 1) then + eII(i+1,j+1) = eII(i+1,j+1)+.125*(US%s_to_T**2 * (ux**2 + vy**2 + ux*vy + 0.25*(uy+vx)**2 + eps_min**2)) + endif + if (ISS%hmask(I,J+1) == 1) then + eII(i,j+1) = eII(i,j+1)+.125*(US%s_to_T**2 * (ux**2 + vy**2 + ux*vy + 0.25*(uy+vx)**2 + eps_min**2)) + endif + if (ISS%hmask(I+1,J) == 1) then + eII(i+1,j) = eII(i+1,j)+.125*(US%s_to_T**2 * (ux**2 + vy**2 + ux*vy + 0.25*(uy+vx)**2 + eps_min**2)) + endif + endif + CS%ice_visc(i,j) =0.5 * Visc_coef*(G%areaT(i,j) * ISS%h_shelf(i,j))*eII(i,j)**((1.-n_g)/(2.*n_g)) +! CS%ice_visc(i,j) =1e15*(G%areaT(i,j) * ISS%h_shelf(i,j)) !constant viscosity for debugging + enddo + enddo end subroutine calc_shelf_visc subroutine calc_shelf_taub(CS, ISS, G, US, u_shlf, v_shlf) From 89f4386eb153c63e55b942c4ec0fc8187d1ae8d5 Mon Sep 17 00:00:00 2001 From: Olga Sergienko Date: Thu, 18 Feb 2021 17:16:00 -0500 Subject: [PATCH 16/35] corrected initialize_boundary_channel call --- src/ice_shelf/MOM_ice_shelf_initialize.F90 | 28 ++++++++++++---------- 1 file changed, 16 insertions(+), 12 deletions(-) diff --git a/src/ice_shelf/MOM_ice_shelf_initialize.F90 b/src/ice_shelf/MOM_ice_shelf_initialize.F90 index 2bfe64677c..532729c58c 100644 --- a/src/ice_shelf/MOM_ice_shelf_initialize.F90 +++ b/src/ice_shelf/MOM_ice_shelf_initialize.F90 @@ -265,9 +265,8 @@ subroutine initialize_ice_thickness_channel(h_shelf, area_shelf_h, hmask, G, US, end subroutine initialize_ice_thickness_channel subroutine initialize_ice_shelf_boundary_channel(u_face_mask_bdry, v_face_mask_bdry, & - u_flux_bdry_val, v_flux_bdry_val, u_bdry_val, v_bdry_val, h_bdry_val, & - thickness_bdry_val, hmask, h_shelf, u_shelf, v_shelf, G,& ! OVS h_shelf 11/10/20 -! flux_bdry, & + u_flux_bdry_val, v_flux_bdry_val, u_bdry_val, v_bdry_val, u_shelf, v_shelf, h_bdry_val, & + thickness_bdry_val, hmask, h_shelf, G,& US, PF ) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure @@ -340,7 +339,8 @@ subroutine initialize_ice_shelf_boundary_channel(u_face_mask_bdry, v_face_mask_b giec = G%Domain%niglobal+gisc ; gjec = G%Domain%njglobal+gjsc !-----------b.c.s based on geopositions ----------------- - do j=jsc-1,jec+1 +! do j=jsc-1,jec+1 + do j=jsc-0*1,jec+1 do i=isc-1,iec+1 ! upstream boundary - set either dirichlet or flux condition @@ -349,13 +349,13 @@ subroutine initialize_ice_shelf_boundary_channel(u_face_mask_bdry, v_face_mask_b ! u_face_mask_bdry(i-1,j) = 4.0 ! u_flux_bdry_val(i-1,j) = input_flux ! else -! hmask(i+1,j) = 3.0 - hmask(i,j) = 3.0 -! h_bdry_val(i+1,j) = h_shelf(i+1,j) !OVS 11/10/20 !input_thick - h_bdry_val(i,j) = h_shelf(i,j) - thickness_bdry_val(i+0*1,j) = h_bdry_val(i+0*1,j) - u_face_mask_bdry(i+0*1,j) = 3.0 - u_bdry_val(i+0*1,j) = input_vel*(1-16.0*((G%geoLatBu(i-1,j)/lenlat-0.5))**4) !OVS 11/09/20 U b.c. + hmask(i+1,j) = 3.0 +! hmask(i,j) = 3.0 + h_bdry_val(i+1,j) = h_shelf(i+1,j) !OVS 11/10/20 !input_thick +! h_bdry_val(i,j) = h_shelf(i,j) + thickness_bdry_val(i+1,j) = h_bdry_val(i+0*1,j) + u_face_mask_bdry(i+1,j) = 3.0 + u_bdry_val(i+1,j) = input_vel*(1-16.0*((G%geoLatBu(i-1,j)/lenlat-0.5))**4) !OVS 11/09/20 U b.c. ! u_bdry_val(i+1,j) = (1 - ((G%geoLatBu(i,j) - 0.5*lenlat)*2./lenlat)**2) * & ! 1.5 * input_flux / input_thick ! endif @@ -396,7 +396,11 @@ subroutine initialize_ice_shelf_boundary_channel(u_face_mask_bdry, v_face_mask_b enddo enddo - +! call pass_var(hmask, G%domain) +! call pass_var(h_bdry_val, G%domain) +! call pass_var(thickness_bdry_val, G%domain) + + ! if (.not. G%symmetric) then !! do j=G%jsd,G%jed !! do i=G%isd,G%ied From 271bfce9402728937542e296e986c6aa4c172337 Mon Sep 17 00:00:00 2001 From: Olga Sergienko Date: Mon, 22 Feb 2021 15:10:32 -0500 Subject: [PATCH 17/35] corrected boundary mask in init_boundary_channel and updated u_ and v_bdry_val through halo --- src/ice_shelf/MOM_ice_shelf_dynamics.F90 | 342 +++++++++++++-------- src/ice_shelf/MOM_ice_shelf_initialize.F90 | 15 +- 2 files changed, 219 insertions(+), 138 deletions(-) diff --git a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 index db3a49cfe9..84605e3092 100644 --- a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 +++ b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 @@ -160,7 +160,7 @@ module MOM_ice_shelf_dynamics id_u_mask = -1, id_v_mask = -1, id_t_mask = -1 !>@} ! ids for outputting intermediate thickness in advection subroutine (debugging) - !integer :: id_h_after_uflux = -1, id_h_after_vflux = -1, id_h_after_adv = -1 + integer :: id_h_after_uflux = -1, id_h_after_vflux = -1, id_h_after_adv = -1, id_visc_shelf = -1 type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to control diagnostic output. @@ -535,18 +535,27 @@ subroutine initialize_ice_shelf_dyn(param_file, Time, ISS, CS, G, US, diag, new_ CS%thickness_bdry_val, ISS%hmask, ISS%h_shelf, G, & ! CS%flux_bdry, & US, param_file ) !OVS initialize b.c.s + + call pass_var(ISS%hmask, G%domain) + call pass_var(CS%h_bdry_val, G%domain) + call pass_var(CS%thickness_bdry_val, G%domain) + call pass_var(CS%u_bdry_val, G%domain) + call pass_var(CS%v_bdry_val, G%domain) + call pass_var(CS%u_face_mask_bdry, G%domain) + call pass_var(CS%v_face_mask_bdry, G%domain) ! call init_boundary_values(CS, G, time, ISS%hmask, CS%input_flux, CS%input_thickness, new_sim) call update_velocity_masks(CS, G, ISS%hmask, CS%umask, CS%vmask, CS%u_face_mask, CS%v_face_mask) - if (new_sim) then - call MOM_mesg("MOM_ice_shelf.F90, initialize_ice_shelf: initialize ice velocity.") - call update_OD_ffrac_uncoupled(CS, G, ISS%h_shelf(:,:)) -! call ice_shelf_solve_outer(CS, ISS, G, US, CS%u_shelf, CS%v_shelf, iters, Time) - call ice_shelf_solve_outer(CS, ISS, G, US, CS%u_shelf, CS%v_shelf,CS%taudx_shelf,CS%taudy_shelf, iters, Time) !OVS 02/08/21 - if (CS%id_u_shelf > 0) call post_data(CS%id_u_shelf, CS%u_shelf, CS%diag) - if (CS%id_v_shelf > 0) call post_data(CS%id_v_shelf, CS%v_shelf,CS%diag) - if (CS%id_taudx_shelf > 0) call post_data(CS%id_taudx_shelf, CS%taudx_shelf,CS%diag) - if (CS%id_taudy_shelf > 0) call post_data(CS%id_taudy_shelf, CS%taudy_shelf,CS%diag) - endif +! if (new_sim) then +! call MOM_mesg("MOM_ice_shelf.F90, initialize_ice_shelf: initialize ice velocity.") +! call update_OD_ffrac_uncoupled(CS, G, ISS%h_shelf(:,:)) +!! call ice_shelf_solve_outer(CS, ISS, G, US, CS%u_shelf, CS%v_shelf, iters, Time) +! call ice_shelf_solve_outer(CS, ISS, G, US, CS%u_shelf, CS%v_shelf,CS%taudx_shelf,CS%taudy_shelf, iters, Time) !OVS 02/08/21 +! if (CS%id_u_shelf > 0) call post_data(CS%id_u_shelf, CS%u_shelf, CS%diag) +! if (CS%id_v_shelf > 0) call post_data(CS%id_v_shelf, CS%v_shelf,CS%diag) +! if (CS%id_taudx_shelf > 0) call post_data(CS%id_taudx_shelf, CS%taudx_shelf,CS%diag) +! if (CS%id_taudy_shelf > 0) call post_data(CS%id_taudy_shelf, CS%taudy_shelf,CS%diag) +! if (CS%id_visc_shelf > 0) call post_data(CS%id_visc_shelf, CS%ice_visc,CS%diag) +! endif ! Register diagnostics. ! CS%id_u_shelf = register_diag_field('ocean_model','u_shelf',CS%diag%axesCu1, Time, & @@ -580,17 +589,29 @@ subroutine initialize_ice_shelf_dyn(param_file, Time, ISS, CS, G, US, diag, new_ ! 'ocean column thickness passed to ice model', 'm', conversion=US%Z_to_m) CS%id_col_thick = register_diag_field('ice_shelf_model','col_thick',CS%diag%axesT1, Time, & 'ocean column thickness passed to ice model', 'm', conversion=US%Z_to_m) + CS%id_visc_shelf = register_diag_field('ice_shelf_model','ice_visc',CS%diag%axesT1, Time, & + 'viscosity', 'm', conversion=1e-6*US%Z_to_m) ! CS%id_OD_av = register_diag_field('ocean_model','OD_av',CS%diag%axesT1, Time, & ! 'intermediate ocean column thickness passed to ice model', 'm', conversion=US%Z_to_m) CS%id_OD_av = register_diag_field('ice_shelf_model','OD_av',CS%diag%axesT1, Time, & 'intermediate ocean column thickness passed to ice model', 'm', conversion=US%Z_to_m) - !CS%id_h_after_uflux = register_diag_field('ocean_model','h_after_uflux',CS%diag%axesh1, Time, & - ! 'thickness after u flux ', 'none') - !CS%id_h_after_vflux = register_diag_field('ocean_model','h_after_vflux',CS%diag%axesh1, Time, & - ! 'thickness after v flux ', 'none') - !CS%id_h_after_adv = register_diag_field('ocean_model','h_after_adv',CS%diag%axesh1, Time, & - ! 'thickness after front adv ', 'none') - + CS%id_h_after_uflux = register_diag_field('ice_shelf_model','h_after_uflux',CS%diag%axesT1, Time, & + 'thickness after u flux ', 'none') + CS%id_h_after_vflux = register_diag_field('ice_shelf_model','h_after_vflux',CS%diag%axesT1, Time, & + 'thickness after v flux ', 'none') + CS%id_h_after_adv = register_diag_field('ice_shelf_model','h_after_adv',CS%diag%axesT1, Time, & + 'thickness after front adv ', 'none') + if (new_sim) then + call MOM_mesg("MOM_ice_shelf.F90, initialize_ice_shelf: initialize ice velocity.") + call update_OD_ffrac_uncoupled(CS, G, ISS%h_shelf(:,:)) +! call ice_shelf_solve_outer(CS, ISS, G, US, CS%u_shelf, CS%v_shelf, iters, Time) + call ice_shelf_solve_outer(CS, ISS, G, US, CS%u_shelf, CS%v_shelf,CS%taudx_shelf,CS%taudy_shelf, iters, Time) !OVS 02/08/21 + if (CS%id_u_shelf > 0) call post_data(CS%id_u_shelf, CS%u_shelf, CS%diag) + if (CS%id_v_shelf > 0) call post_data(CS%id_v_shelf, CS%v_shelf,CS%diag) + if (CS%id_taudx_shelf > 0) call post_data(CS%id_taudx_shelf, CS%taudx_shelf,CS%diag) + if (CS%id_taudy_shelf > 0) call post_data(CS%id_taudy_shelf, CS%taudy_shelf,CS%diag) + if (CS%id_visc_shelf > 0) call post_data(CS%id_visc_shelf, CS%ice_visc,CS%diag) + endif !!! OVS vertically integrated temperature ! CS%id_t_shelf = register_diag_field('ocean_model','t_shelf',CS%diag%axesT1, Time, & ! 'T of ice', 'oC') @@ -693,7 +714,7 @@ subroutine update_ice_shelf(CS, ISS, G, US, time_step, Time, ocean_mass, coupled coupled_GL = .false. if (present(ocean_mass) .and. present(coupled_grounding)) coupled_GL = coupled_grounding - call ice_shelf_advect(CS, ISS, G, time_step, Time) !OVS 02/08/21 +! call ice_shelf_advect(CS, ISS, G, time_step, Time) !OVS 02/08/21 CS%elapsed_velocity_time = CS%elapsed_velocity_time + time_step if (CS%elapsed_velocity_time >= CS%velocity_update_time_step) update_ice_vel = .true. @@ -721,6 +742,7 @@ subroutine update_ice_shelf(CS, ISS, G, US, time_step, Time, ocean_mass, coupled if (CS%id_taudy_shelf > 0) call post_data(CS%id_taudy_shelf, CS%taudy_shelf, CS%diag) if (CS%id_ground_frac > 0) call post_data(CS%id_ground_frac, CS%ground_frac,CS%diag) if (CS%id_OD_av >0) call post_data(CS%id_OD_av, CS%OD_av,CS%diag) + if (CS%id_visc_shelf > 0) call post_data(CS%id_visc_shelf, CS%ice_visc,CS%diag) if (CS%id_u_mask > 0) call post_data(CS%id_u_mask,CS%umask,CS%diag) if (CS%id_v_mask > 0) call post_data(CS%id_v_mask,CS%vmask,CS%diag) @@ -783,7 +805,7 @@ subroutine ice_shelf_advect(CS, ISS, G, time_step, Time) ! call enable_averages(time_step, Time, CS%diag) call pass_var(h_after_uflux, G%domain) -! if (CS%id_h_after_uflux > 0) call post_data(CS%id_h_after_uflux, h_after_uflux, CS%diag) + if (CS%id_h_after_uflux > 0) call post_data(CS%id_h_after_uflux, h_after_uflux, CS%diag) ! call disable_averaging(CS%diag) LB%ish = G%isc ; LB%ieh = G%iec ; LB%jsh = G%jsc ; LB%jeh = G%jec @@ -791,7 +813,7 @@ subroutine ice_shelf_advect(CS, ISS, G, time_step, Time) ! call enable_averages(time_step, Time, CS%diag) call pass_var(h_after_vflux, G%domain) -! if (CS%id_h_after_vflux > 0) call post_data(CS%id_h_after_vflux, h_after_vflux, CS%diag) + if (CS%id_h_after_vflux > 0) call post_data(CS%id_h_after_vflux, h_after_vflux, CS%diag) ! call disable_averaging(CS%diag) do j=jsd,jed @@ -882,7 +904,7 @@ subroutine ice_shelf_solve_outer(CS, ISS, G, US, u_shlf, v_shlf,taudx,taudy, ite enddo call calc_shelf_driving_stress(CS, ISS, G, US, taudx, taudy, CS%OD_av) -! call pass_vector(taudx, taudy, G%domain, TO_ALL, BGRID_NE) !OVS 02/01/21 + call pass_vector(taudx, taudy, G%domain, TO_ALL, BGRID_NE) !OVS 02/01/21 ! call pass_var(taudx, G%Domain) !OVS 01/21/21 ! call pass_var(taudy, G%Domain) !OVS 01/21/21 ! This is to determine which cells contain the grounding line, the criterion being that the cell @@ -925,7 +947,7 @@ subroutine ice_shelf_solve_outer(CS, ISS, G, US, u_shlf, v_shlf,taudx,taudy, ite enddo ; enddo call calc_shelf_visc(CS, ISS, G, US, u_shlf, v_shlf) -! call pass_var(CS%ice_visc, G%domain) + call pass_var(CS%ice_visc, G%domain) ! call pass_vector(CS%ice_visc, G%domain, TO_ALL, BGRID_NE) !OVS 02/11/21 call calc_shelf_taub(CS, ISS, G, US, u_shlf, v_shlf) call pass_var(CS%basal_traction, G%domain) @@ -1329,7 +1351,9 @@ subroutine ice_shelf_solve_inner(CS, ISS, G, US, u_shlf, v_shlf, taudx, taudy, H if (cg_halo == 0) then ! pass vectors call pass_vector(Du, Dv, G%domain, TO_ALL, BGRID_NE) - call pass_vector(u_shlf, v_shlf, G%domain, TO_ALL, BGRID_NE) +! call pass_vector(u_shlf, v_shlf, G%domain, TO_ALL, BGRID_NE) + call pass_var(u_shlf, G%domain) + call pass_var(v_shlf, G%domain) call pass_vector(Ru, Rv, G%domain, TO_ALL, BGRID_NE) cg_halo = 3 endif @@ -2531,6 +2555,8 @@ subroutine apply_boundary_values(CS, ISS, G, US, time, Phisub, H_node, ice_visc, endif endif ; enddo ; enddo + call pass_vector(u_bdry_contr, v_bdry_contr, G%domain, TO_ALL, BGRID_NE) !OVS 02/19/21 + end subroutine apply_boundary_values !> Update depth integrated viscosity, based on horizontal strain rates, and also update the @@ -2552,11 +2578,14 @@ subroutine calc_shelf_visc(CS, ISS, G, US, u_shlf, v_shlf) ! also this subroutine updates the nonlinear part of the basal traction ! this may be subject to change later... to make it "hybrid" - real, dimension(SZDIB_(G),SZDJB_(G)) :: eII - integer :: i, j, iscq, iecq, jscq, jecq, isd, jsd, ied, jed, iegq, jegq +! real, dimension(SZDIB_(G),SZDJB_(G)) :: eII, ux, uy, vx, vy + integer :: i, j, iscq, iecq, jscq, jecq, isd, jsd, ied, jed, iegq, jegq, iq, jq integer :: giec, gjec, gisc, gjsc, cnt, isc, jsc, iec, jec, is, js, i_off, j_off real :: Visc_coef, n_g - real :: ux, uy, vx, vy, eps_min, dxh, dyh ! Velocity shears [T-1 ~> s-1] + real :: ux, uy, vx, vy + real :: eps_min, dxh, dyh ! Velocity shears [T-1 ~> s-1] + real, dimension(8,4) :: Phi + real, dimension(2) :: xquad ! real :: umid, vmid, unorm ! Velocities [L T-1 ~> m s-1] isc = G%isc ; jsc = G%jsc ; iec = G%iec ; jec = G%jec @@ -2570,48 +2599,95 @@ subroutine calc_shelf_visc(CS, ISS, G, US, u_shlf, v_shlf) n_g = CS%n_glen; eps_min = CS%eps_glen_min - CS%ice_visc(:,:) = 0.0 - eII(:,:) = (US%s_to_T**2 * (eps_min**2)) +! CS%ice_visc(:,:) = 0.0 +! ux(:,:) = 0.0; uy(:,:) = 0.0; vx(:,:) =0.0; vy(:,:) =0.0 +! eII(:,:) = (US%s_to_T**2 * (eps_min**2)) Visc_coef = US%kg_m2s_to_RZ_T*US%m_to_L*US%Z_to_L*(CS%A_glen_isothermal)**(-1./CS%n_glen) !OVS '-' in the exponent - call pass_vector(u_shlf, v_shlf, G%domain, TO_ALL, BGRID_NE) +! call pass_vector(u_shlf, v_shlf, G%domain, TO_ALL, BGRID_NE) ! do j=jsc-1,jec+1 ! do i=isc-1,iec+1 -!! do j=jsd+1,jed!-1 OVS 02/01/21 -!! do i=isd+1,ied!-1 OVS 02/01/21 - -! if (ISS%hmask(i,j) == 1) then + do j=jsd+1,jed-1 !OVS 02/01/21 + do i=isd+1,ied-1 !OVS 02/01/21 + + if ((ISS%hmask(i,j) == 1) .OR. (ISS%hmask(i,j) == 3)) then +! ux(i,j) = ((u_shlf(I,J) + u_shlf(I,J-1)) - (u_shlf(I-1,J) + u_shlf(I-1,J-1))) / (2*G%dxT(i,j)) +! vx(i,j) = ((v_shlf(I,J) + v_shlf(I,J-1)) - (v_shlf(I-1,J) + v_shlf(I-1,J-1))) / (2*G%dxT(i,j)) +! uy(i,j) = ((u_shlf(I,J) + u_shlf(I-1,J)) - (u_shlf(I,J-1) + u_shlf(I-1,J-1))) / (2*G%dyT(i,j)) +! vy(i,j) = ((v_shlf(I,J) + v_shlf(I-1,J)) - (v_shlf(I,J-1) + v_shlf(I-1,J-1))) / (2*G%dyT(i,j)) +! endif +! enddo +! enddo +! call pass_vector(ux, uy, G%domain, TO_ALL, BGRID_NE) +! call pass_vector(vx, vy, G%domain, TO_ALL, BGRID_NE) ! ux = ((u_shlf(I,J) + 0*u_shlf(I,J-1)) - (u_shlf(I-1,J) + 0*u_shlf(I-1,J-1))) / (G%dxT(i,j)) ! vx = ((v_shlf(I,J) + v_shlf(I,J-1)) - (v_shlf(I-1,J) + v_shlf(I-1,J-1))) / (2*G%dxT(i,j)) ! uy = ((u_shlf(I,J) + u_shlf(I-1,J)) - (u_shlf(I,J-1) + u_shlf(I-1,J-1))) / (2*G%dyT(i,j)) ! vy = ((v_shlf(I,J) + v_shlf(I-1,J)) - (v_shlf(I,J-1) + v_shlf(I-1,J-1))) / (2*G%dyT(i,j)) -!! ux = ((u_shlf(I,J) + u_shlf(I,J-1)) - (u_shlf(I-1,J) + u_shlf(I-1,J-1))) / (2*G%dxT(i,j)) -!! vx = ((v_shlf(I,J) + v_shlf(I,J-1)) - (v_shlf(I-1,J) + v_shlf(I-1,J-1))) / (2*G%dxT(i,j)) -!! uy = ((u_shlf(I,J) + u_shlf(I-1,J)) - (u_shlf(I,J-1) + u_shlf(I-1,J-1))) / (2*G%dyT(i,j)) -!! vy = ((v_shlf(I,J) + v_shlf(I-1,J)) - (v_shlf(I,J-1) + v_shlf(I-1,J-1))) / (2*G%dyT(i,j)) -! CS%ice_visc(i,j) = 0.5 * Visc_coef * (G%areaT(i,j) * ISS%h_shelf(i,j)) * & -! (US%s_to_T**2 * (ux**2 + vy**2 + ux*vy + 0.25*(uy+vx)**2 + eps_min**2))**((1.-n_g)/(2.*n_g)) + ux = ((u_shlf(I,J) + u_shlf(I,J-1)) - (u_shlf(I-1,J) + u_shlf(I-1,J-1))) / (2*G%dxT(i,j)) + vx = ((v_shlf(I,J) + v_shlf(I,J-1)) - (v_shlf(I-1,J) + v_shlf(I-1,J-1))) / (2*G%dxT(i,j)) + uy = ((u_shlf(I,J) + u_shlf(I-1,J)) - (u_shlf(I,J-1) + u_shlf(I-1,J-1))) / (2*G%dyT(i,j)) + vy = ((v_shlf(I,J) + v_shlf(I-1,J)) - (v_shlf(I,J-1) + v_shlf(I-1,J-1))) / (2*G%dyT(i,j)) + CS%ice_visc(i,j) = 0.5 * Visc_coef * (G%areaT(i,j) * ISS%h_shelf(i,j)) * & + (US%s_to_T**2 * (ux**2 + vy**2 + ux*vy + 0.25*(uy+vx)**2 + eps_min**2))**((1.-n_g)/(2.*n_g)) ! CS%ice_visc(i,j) =1e15*(G%areaT(i,j) * ISS%h_shelf(i,j)) ! constant viscocity for debugging ! umid = ((u_shlf(I,J) + u_shlf(I-1,J-1)) + (u_shlf(I,J-1) + u_shlf(I-1,J))) * 0.25 ! vmid = ((v_shlf(I,J) + v_shlf(I-1,J-1)) + (v_shlf(I,J-1) + v_shlf(I-1,J))) * 0.25 ! unorm = sqrt(umid**2 + vmid**2 + eps_min**2*(G%dxT(i,j)**2 + G%dyT(i,j)**2)) ! CS%basal_traction(i,j) = G%areaT(i,j) * CS%C_basal_friction * (US%L_T_to_m_s*unorm)**(CS%n_basal_fric-1) -! endif -! enddo -! enddo + endif + enddo + enddo - - do j=jsc-1,jec+1 - do i=isc-1,iec+1 - cnt = 0 - ux = 0 - uy = 0 - vx = 0 - vy = 0 - dxh = G%dxT(i,j) - dyh = G%dyT(i,j) +! do j=jsc-1,jec+1 +! do i=isc-1,iec+1 +!! do j=jsd+1,jed!-1 OVS 02/01/21 +!! do i=isd+1,ied!-1 OVS 02/01/21 - if (ISS%hmask(i,j) == 1) then ! we are inside the global computational bdry, at an ice-filled cell +! if (ISS%hmask(i,j) == 1) then +! CS%ice_visc(i,j) = 0.5 * Visc_coef * (G%areaT(i,j) * ISS%h_shelf(i,j)) * & +! (US%s_to_T**2 * (ux(i,j)**2 + vy(i,j)**2 + ux(i,j)*vy(i,j) + 0.25*(uy(i,j)+vx(i,j))**2 + eps_min**2))**((1.-n_g)/(2.*n_g)) +! endif +! enddo +! enddo +! xquad(1) = .5 * (1-sqrt(1./3)) ; xquad(2) = .5 * (1+sqrt(1./3)) +! do j=jsc-1,jec+1 +! do i=isc-1,iec+1 +! cnt = 0 +! ux = 0 +! uy = 0 +! vx = 0 +! vy = 0 +! dxh = G%dxT(i,j) +! dyh = G%dyT(i,j) + +! if (ISS%hmask(i,j) == 1) then ! we are inside the global computational bdry, at an ice-filled cell + +! call bilinear_shape_fn_grid(G, i, j, Phi) +! do jq = 1,2 +! do iq = 1,2 + +! ux = u_shlf(I-1,J-1) * Phi(1,2*(jq-1)+iq) + & +! u_shlf(I,J-1) * Phi(3,2*(jq-1)+iq) + & +! u_shlf(I-1,J) * Phi(5,2*(jq-1)+iq) + & +! u_shlf(I,J) * Phi(7,2*(jq-1)+iq) + +! vx = v_shlf(I-1,J-1) * Phi(1,2*(jq-1)+iq) + & +! v_shlf(I,J-1) * Phi(3,2*(jq-1)+iq) + & +! v_shlf(I-1,J) * Phi(5,2*(jq-1)+iq) + & +! v_shlf(I,J) * Phi(7,2*(jq-1)+iq) + +! uy = u_shlf(I-1,J-1) * Phi(2,2*(jq-1)+iq) + & +! u_shlf(I,J-1) * Phi(4,2*(jq-1)+iq) + & +! u_shlf(I-1,J) * Phi(6,2*(jq-1)+iq) + & +! u_shlf(I,J) * Phi(8,2*(jq-1)+iq) + +! vy = v_shlf(I-1,J-1) * Phi(2,2*(jq-1)+iq) + & +! v_shlf(I,J-1) * Phi(4,2*(jq-1)+iq) + & +! v_shlf(I-1,J) * Phi(6,2*(jq-1)+iq) + & +! v_shlf(I,J) * Phi(8,2*(jq-1)+iq) +! enddo +! enddo ! calculate sx ! if ((i+i_off) == gisc) then ! at left computational bdry ! if (ISS%hmask(i+1,j) == 1) then @@ -2630,31 +2706,31 @@ subroutine calc_shelf_visc(CS, ISS, G, US, u_shlf, v_shlf) ! vx = 0 ! endif ! else ! interior - if (ISS%hmask(i+1,j) == 1) then - cnt = cnt+1 - ux = u_shlf(i+1,j) - vx = v_shlf(i+1,j) - else - ux = u_shlf(i,j) - vx = v_shlf(i,j) - endif - if (ISS%hmask(i-1,j) == 1) then - cnt = cnt+1 - ux = ux - u_shlf(i-1,j) - vx = vx - v_shlf(i-1,j) - else - ux = ux - u_shlf(i,j) - vx = vx - v_shlf(i,j) - endif - if (cnt == 0) then - ux = 0 - vx = 0 - else - ux = ux / (cnt * dxh) - vx = vx / (cnt * dxh) - endif -! endif - cnt = 0 +! if (ISS%hmask(i+1,j) == 1) then +! cnt = cnt+1 +! ux = u_shlf(i+1,j) +! vx = v_shlf(i+1,j) +! else +! ux = u_shlf(i,j) +! vx = v_shlf(i,j) +! endif +! if (ISS%hmask(i-1,j) == 1) then +! cnt = cnt+1 +! ux = ux - u_shlf(i-1,j) +! vx = vx - v_shlf(i-1,j) +! else +! ux = ux - u_shlf(i,j) +! vx = vx - v_shlf(i,j) +! endif +! if (cnt == 0) then +! ux = 0 +! vx = 0 +! else +! ux = ux / (cnt * dxh) +! vx = vx / (cnt * dxh) +! endif +!! endif +! cnt = 0 ! calculate sy, similarly ! if ((j+j_off) == gjsc) then ! at south computational bdry @@ -2673,70 +2749,72 @@ subroutine calc_shelf_visc(CS, ISS, G, US, u_shlf, v_shlf) ! vy = 0 ! endif ! else ! interior - if (ISS%hmask(i,j+1) == 1) then - cnt = cnt+1 - uy = u_shlf(i,j+1) - vy = v_shlf(i,j+1) - else - uy = u_shlf(i,j) - vy = v_shlf(i,j) - endif - if (ISS%hmask(i,j-1) == 1) then - cnt = cnt+1 - uy = uy - u_shlf(i,j-1) - vy = vy - v_shlf(i,j-1) - else - uy = uy - u_shlf(i,j) - vy = vy - v_shlf(i,j) - endif - if (cnt == 0) then - uy = 0 - vy = 0 - else - uy = uy / (cnt * dyh) - vy = vy / (cnt * dyh) - endif -! endif +! if (ISS%hmask(i,j+1) == 1) then +! cnt = cnt+1 +! uy = u_shlf(i,j+1) +! vy = v_shlf(i,j+1) +! else +! uy = u_shlf(i,j) +! vy = v_shlf(i,j) +! endif +! if (ISS%hmask(i,j-1) == 1) then +! cnt = cnt+1 +! uy = uy - u_shlf(i,j-1) +! vy = vy - v_shlf(i,j-1) +! else +! uy = uy - u_shlf(i,j) +! vy = vy - v_shlf(i,j) +! endif +! if (cnt == 0) then +! uy = 0 +! vy = 0 +! else +! uy = uy / (cnt * dyh) +! vy = vy / (cnt * dyh) +! endif +!! endif - ! SW vertex - if (ISS%hmask(I-1,J-1) == 1) then - eII(i-1,j-1) = eII(i-1,j-1)+.125*(US%s_to_T**2 * (ux**2 + vy**2 + ux*vy + 0.25*(uy+vx)**2 + eps_min**2)) - endif +! ! SW vertex +! if (ISS%hmask(I-1,J-1) == 1) then +! eII(i-1,j-1) = eII(i-1,j-1)+.125*(US%s_to_T**2 * (ux**2 + vy**2 + ux*vy + 0.25*(uy+vx)**2 + eps_min**2)) +! endif ! SE vertex - if (ISS%hmask(I,J-1) == 1) then - eII(i,j-1) = eII(i,j-1)+.125*(US%s_to_T**2 * (ux**2 + vy**2 + ux*vy + 0.25*(uy+vx)**2 + eps_min**2)) +! if (ISS%hmask(I,J-1) == 1) then +! eII(i,j-1) = eII(i,j-1)+.125*(US%s_to_T**2 * (ux**2 + vy**2 + ux*vy + 0.25*(uy+vx)**2 + eps_min**2)) ! CS%ice_visc(i,j-1) = CS%ice_visc(i,j-1)+.25*0.5 * Visc_coef * (G%areaT(i,j) * ISS%h_shelf(i,j)) * & ! (US%s_to_T**2 * (ux**2 + vy**2 + ux*vy + 0.25*(uy+vx)**2 + eps_min**2))**((1.-n_g)/(2.*n_g)) - endif +! endif ! NW vertex - if (ISS%hmask(I-1,J) == 1) then - eII(i-1,j) = eII(i-1,j)+.125*(US%s_to_T**2 * (ux**2 + vy**2 + ux*vy + 0.25*(uy+vx)**2 + eps_min**2)) +! if (ISS%hmask(I-1,J) == 1) then +! eII(i-1,j) = eII(i-1,j)+.125*(US%s_to_T**2 * (ux**2 + vy**2 + ux*vy + 0.25*(uy+vx)**2 + eps_min**2)) ! CS%ice_visc(i-1,j) = CS%ice_visc(i-1,j)+.25*0.5 * Visc_coef * (G%areaT(i,j) * ISS%h_shelf(i,j)) * & ! (US%s_to_T**2 * (ux**2 + vy**2 + ux*vy + 0.25*(uy+vx)**2 + eps_min**2))**((1.-n_g)/(2.*n_g)) - endif +! endif ! NE vertex - if (ISS%hmask(I,J) == 1) then - eII(i,j) = eII(i,j)+.25*(US%s_to_T**2 * (ux**2 + vy**2 + ux*vy + 0.25*(uy+vx)**2 + eps_min**2)) - +! if (ISS%hmask(I,J) == 1) then +! eII(i,j) = eII(i,j)+.25*(US%s_to_T**2 * (ux**2 + vy**2 + ux*vy + 0.25*(uy+vx)**2 + eps_min**2)) +! eII(i,j) = (US%s_to_T**2 * (ux**2 + vy**2 + ux*vy + 0.25*(uy+vx)**2 + eps_min**2)) + ! CS%ice_visc(i,j) = CS%ice_visc(i,j)+.25*0.5 * Visc_coef * (G%areaT(i,j) * ISS%h_shelf(i,j)) * & ! (US%s_to_T**2 * (ux**2 + vy**2 + ux*vy + 0.25*(uy+vx)**2 + eps_min**2))**((1.-n_g)/(2.*n_g)) - endif - if (ISS%hmask(I+1,J+1) == 1) then - eII(i+1,j+1) = eII(i+1,j+1)+.125*(US%s_to_T**2 * (ux**2 + vy**2 + ux*vy + 0.25*(uy+vx)**2 + eps_min**2)) - endif - if (ISS%hmask(I,J+1) == 1) then - eII(i,j+1) = eII(i,j+1)+.125*(US%s_to_T**2 * (ux**2 + vy**2 + ux*vy + 0.25*(uy+vx)**2 + eps_min**2)) - endif - if (ISS%hmask(I+1,J) == 1) then - eII(i+1,j) = eII(i+1,j)+.125*(US%s_to_T**2 * (ux**2 + vy**2 + ux*vy + 0.25*(uy+vx)**2 + eps_min**2)) - endif - endif - CS%ice_visc(i,j) =0.5 * Visc_coef*(G%areaT(i,j) * ISS%h_shelf(i,j))*eII(i,j)**((1.-n_g)/(2.*n_g)) -! CS%ice_visc(i,j) =1e15*(G%areaT(i,j) * ISS%h_shelf(i,j)) !constant viscosity for debugging - enddo - enddo +! endif +! if (ISS%hmask(I+1,J+1) == 1) then +! eII(i+1,j+1) = eII(i+1,j+1)+.125*(US%s_to_T**2 * (ux**2 + vy**2 + ux*vy + 0.25*(uy+vx)**2 + eps_min**2)) +! endif +! if (ISS%hmask(I,J+1) == 1) then +! eII(i,j+1) = eII(i,j+1)+.125*(US%s_to_T**2 * (ux**2 + vy**2 + ux*vy + 0.25*(uy+vx)**2 + eps_min**2)) +! endif +! if (ISS%hmask(I+1,J) == 1) then +! eII(i+1,j) = eII(i+1,j)+.125*(US%s_to_T**2 * (ux**2 + vy**2 + ux*vy + 0.25*(uy+vx)**2 + eps_min**2)) +! endif +! CS%ice_visc(i,j) =0.5 * Visc_coef*(G%areaT(i,j) * ISS%h_shelf(i,j))*eII(i,j)**((1.-n_g)/(2.*n_g)) +! endif +! CS%ice_visc(i,j) =0.5 * Visc_coef*(G%areaT(i,j) * ISS%h_shelf(i,j))*eII(i,j)**((1.-n_g)/(2.*n_g)) + ! CS%ice_visc(i,j) =1e15*(G%areaT(i,j) * ISS%h_shelf(i,j)) !constant viscosity for debugging +! enddo +! enddo end subroutine calc_shelf_visc subroutine calc_shelf_taub(CS, ISS, G, US, u_shlf, v_shlf) @@ -2772,7 +2850,7 @@ subroutine calc_shelf_taub(CS, ISS, G, US, u_shlf, v_shlf) do j=jsd+1,jed!-1 OVS 02/01/21 do i=isd+1,ied!-1 OVS 02/01/21 - if (ISS%hmask(i,j) == 1) then + if ((ISS%hmask(i,j) == 1) .OR. (ISS%hmask(i,j) == 3)) then umid = ((u_shlf(I,J) + u_shlf(I-1,J-1)) + (u_shlf(I,J-1) + u_shlf(I-1,J))) * 0.25 vmid = ((v_shlf(I,J) + v_shlf(I-1,J-1)) + (v_shlf(I,J-1) + v_shlf(I-1,J))) * 0.25 unorm = sqrt(umid**2 + vmid**2 + eps_min**2*(G%dxT(i,j)**2 + G%dyT(i,j)**2)) diff --git a/src/ice_shelf/MOM_ice_shelf_initialize.F90 b/src/ice_shelf/MOM_ice_shelf_initialize.F90 index 532729c58c..3b6926e58f 100644 --- a/src/ice_shelf/MOM_ice_shelf_initialize.F90 +++ b/src/ice_shelf/MOM_ice_shelf_initialize.F90 @@ -366,13 +366,16 @@ subroutine initialize_ice_shelf_boundary_channel(u_face_mask_bdry, v_face_mask_b if (G%geoLatBu(i,j-1) == southlat) then !bot boundary if (len_stress == 0. .OR. G%geoLonCv(i,j) <= len_stress) then v_face_mask_bdry(i,j+1) = 0. - u_face_mask_bdry(i,j-1) = 3. !OVS 11/25/20 +! u_face_mask_bdry(i,j-1) = 3. !OVS 11/25/20 + u_face_mask_bdry(i,j) = 3. !OVS 11/25/20 + u_bdry_val(i,j) = 0. + v_bdry_val(i,j) = 0. else -! v_face_mask_bdry(i,j+1) = 1. - v_face_mask_bdry(i,j-1) = 3. !OVS 01/20/21 - u_face_mask_bdry(i,j-1) = 3. !OVS 11/25/20 -! u_bdry_val(i,j) = 0. -! v_bdry_val(i,j) = 0. !OVS 01/20/21 + v_face_mask_bdry(i,j+1) = 1. +! v_face_mask_bdry(i,j) = 3. !OVS 01/20/21 + u_face_mask_bdry(i,j) = 3. !OVS 11/25/20 + u_bdry_val(i,j) = 0. + v_bdry_val(i,j) = 0. !OVS 01/20/21 !hmask(i,j) = 0.0 !OVS 11/25/20 endif elseif (G%geoLatBu(i,j-1) == southlat+lenlat) then !top boundary From fdd83e6583415d6355d4bc9dfb3de421ddb66f9e Mon Sep 17 00:00:00 2001 From: Olga Sergienko Date: Mon, 22 Feb 2021 17:15:13 -0500 Subject: [PATCH 18/35] dynamic ice shelf with non-linear viscosity and evolving ice thickness due to sub-ice-shelf melting --- src/ice_shelf/MOM_ice_shelf_dynamics.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 index 84605e3092..c63a42beaf 100644 --- a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 +++ b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 @@ -714,7 +714,7 @@ subroutine update_ice_shelf(CS, ISS, G, US, time_step, Time, ocean_mass, coupled coupled_GL = .false. if (present(ocean_mass) .and. present(coupled_grounding)) coupled_GL = coupled_grounding -! call ice_shelf_advect(CS, ISS, G, time_step, Time) !OVS 02/08/21 + call ice_shelf_advect(CS, ISS, G, time_step, Time) !OVS 02/08/21 CS%elapsed_velocity_time = CS%elapsed_velocity_time + time_step if (CS%elapsed_velocity_time >= CS%velocity_update_time_step) update_ice_vel = .true. From 32cfe35a44a40fd2947c089946b525d795b670b5 Mon Sep 17 00:00:00 2001 From: Olga Sergienko Date: Wed, 24 Feb 2021 15:41:54 -0500 Subject: [PATCH 19/35] modified MOM_ice_shelf_initialize for testing with viscosity from a file --- src/ice_shelf/MOM_ice_shelf_dynamics.F90 | 38 ++++++----- src/ice_shelf/MOM_ice_shelf_initialize.F90 | 77 ++++++++++++++++++++++ 2 files changed, 99 insertions(+), 16 deletions(-) diff --git a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 index c63a42beaf..5e6ba60a1a 100644 --- a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 +++ b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 @@ -23,7 +23,7 @@ module MOM_ice_shelf_dynamics use MOM_ice_shelf_state, only : ice_shelf_state use MOM_coms, only : reproducing_sum, sum_across_PEs, max_across_PEs, min_across_PEs use MOM_checksums, only : hchksum, qchksum -use MOM_ice_shelf_initialize, only : initialize_ice_shelf_boundary_channel !OVS intializing b.c.s +use MOM_ice_shelf_initialize, only : initialize_ice_shelf_boundary_channel,initialize_ice_flow_from_file !OVS intializing b.c.s implicit none ; private @@ -535,7 +535,6 @@ subroutine initialize_ice_shelf_dyn(param_file, Time, ISS, CS, G, US, diag, new_ CS%thickness_bdry_val, ISS%hmask, ISS%h_shelf, G, & ! CS%flux_bdry, & US, param_file ) !OVS initialize b.c.s - call pass_var(ISS%hmask, G%domain) call pass_var(CS%h_bdry_val, G%domain) call pass_var(CS%thickness_bdry_val, G%domain) @@ -545,6 +544,9 @@ subroutine initialize_ice_shelf_dyn(param_file, Time, ISS, CS, G, US, diag, new_ call pass_var(CS%v_face_mask_bdry, G%domain) ! call init_boundary_values(CS, G, time, ISS%hmask, CS%input_flux, CS%input_thickness, new_sim) call update_velocity_masks(CS, G, ISS%hmask, CS%umask, CS%vmask, CS%u_face_mask, CS%v_face_mask) +! call initialize_ice_flow_from_file(CS%u_shelf, CS%v_shelf,CS%ice_visc,CS%ground_frac, ISS%hmask,ISS%h_shelf, & +! G, US, param_file) !spacially variable viscosity from a file for debugging +! call pass_var(CS%ice_visc, G%domain) ! if (new_sim) then ! call MOM_mesg("MOM_ice_shelf.F90, initialize_ice_shelf: initialize ice velocity.") ! call update_OD_ffrac_uncoupled(CS, G, ISS%h_shelf(:,:)) @@ -713,7 +715,7 @@ subroutine update_ice_shelf(CS, ISS, G, US, time_step, Time, ocean_mass, coupled coupled_GL = .false. if (present(ocean_mass) .and. present(coupled_grounding)) coupled_GL = coupled_grounding - +! call ice_shelf_advect(CS, ISS, G, time_step, Time) !OVS 02/08/21 CS%elapsed_velocity_time = CS%elapsed_velocity_time + time_step if (CS%elapsed_velocity_time >= CS%velocity_update_time_step) update_ice_vel = .true. @@ -946,7 +948,7 @@ subroutine ice_shelf_solve_outer(CS, ISS, G, US, u_shlf, v_shlf,taudx,taudy, ite call bilinear_shape_fn_grid(G, i, j, Phi(:,:,i,j)) enddo ; enddo - call calc_shelf_visc(CS, ISS, G, US, u_shlf, v_shlf) + call calc_shelf_visc(CS, ISS, G, US, u_shlf, v_shlf) !OVS 02/24/21 call pass_var(CS%ice_visc, G%domain) ! call pass_vector(CS%ice_visc, G%domain, TO_ALL, BGRID_NE) !OVS 02/11/21 call calc_shelf_taub(CS, ISS, G, US, u_shlf, v_shlf) @@ -1000,7 +1002,7 @@ subroutine ice_shelf_solve_outer(CS, ISS, G, US, u_shlf, v_shlf,taudx,taudy, ite write(mesg,*) "ice_shelf_solve_outer: linear solve done in ",iters," iterations" call MOM_mesg(mesg, 5) - call calc_shelf_visc(CS, ISS, G, US, u_shlf, v_shlf) + call calc_shelf_visc(CS, ISS, G, US, u_shlf, v_shlf) !OVS 02/24/21 call pass_var(CS%ice_visc, G%domain) call calc_shelf_taub(CS, ISS, G, US, u_shlf, v_shlf) call pass_var(CS%basal_traction, G%domain) @@ -1351,7 +1353,7 @@ subroutine ice_shelf_solve_inner(CS, ISS, G, US, u_shlf, v_shlf, taudx, taudy, H if (cg_halo == 0) then ! pass vectors call pass_vector(Du, Dv, G%domain, TO_ALL, BGRID_NE) -! call pass_vector(u_shlf, v_shlf, G%domain, TO_ALL, BGRID_NE) + call pass_vector(u_shlf, v_shlf, G%domain, TO_ALL, BGRID_NE) call pass_var(u_shlf, G%domain) call pass_var(v_shlf, G%domain) call pass_vector(Ru, Rv, G%domain, TO_ALL, BGRID_NE) @@ -2604,10 +2606,10 @@ subroutine calc_shelf_visc(CS, ISS, G, US, u_shlf, v_shlf) ! eII(:,:) = (US%s_to_T**2 * (eps_min**2)) Visc_coef = US%kg_m2s_to_RZ_T*US%m_to_L*US%Z_to_L*(CS%A_glen_isothermal)**(-1./CS%n_glen) !OVS '-' in the exponent ! call pass_vector(u_shlf, v_shlf, G%domain, TO_ALL, BGRID_NE) -! do j=jsc-1,jec+1 -! do i=isc-1,iec+1 - do j=jsd+1,jed-1 !OVS 02/01/21 - do i=isd+1,ied-1 !OVS 02/01/21 + do j=jsc-0*1,jec+0*1 + do i=isc-0*1,iec+0*1 +! do j=jsd+1,jed-1 !OVS 02/01/21 +! do i=isd+1,ied-1 !OVS 02/01/21 if ((ISS%hmask(i,j) == 1) .OR. (ISS%hmask(i,j) == 3)) then ! ux(i,j) = ((u_shlf(I,J) + u_shlf(I,J-1)) - (u_shlf(I-1,J) + u_shlf(I-1,J-1))) / (2*G%dxT(i,j)) @@ -2619,14 +2621,18 @@ subroutine calc_shelf_visc(CS, ISS, G, US, u_shlf, v_shlf) ! enddo ! call pass_vector(ux, uy, G%domain, TO_ALL, BGRID_NE) ! call pass_vector(vx, vy, G%domain, TO_ALL, BGRID_NE) -! ux = ((u_shlf(I,J) + 0*u_shlf(I,J-1)) - (u_shlf(I-1,J) + 0*u_shlf(I-1,J-1))) / (G%dxT(i,j)) + ux = ((u_shlf(I,J) + u_shlf(I,J-1) + u_shlf(I,J+1)) - & + (u_shlf(I-1,J) + u_shlf(I-1,J-1) + u_shlf(I-1,J+1))) / (3*G%dxT(i,j)) + vx = ((v_shlf(I,J) + v_shlf(I,J-1) + v_shlf(I,J+1)) - & + (v_shlf(I-1,J) + v_shlf(I-1,J-1) + v_shlf(I-1,J+1))) / (3*G%dxT(i,j)) + uy = ((u_shlf(I,J) + u_shlf(I-1,J) + u_shlf(I+1,J)) - & + (u_shlf(I,J-1) + u_shlf(I-1,J-1) + u_shlf(I+1,J-1))) / (3*G%dyT(i,j)) + vy = ((v_shlf(I,J) + v_shlf(I-1,J)+ v_shlf(I+1,J)) - & + (v_shlf(I,J-1) + v_shlf(I-1,J-1)+ v_shlf(I+1,J-1))) / (3*G%dyT(i,j)) +! ux = ((u_shlf(I,J) + u_shlf(I,J-1)) - (u_shlf(I-1,J) + u_shlf(I-1,J-1))) / (2*G%dxT(i,j)) ! vx = ((v_shlf(I,J) + v_shlf(I,J-1)) - (v_shlf(I-1,J) + v_shlf(I-1,J-1))) / (2*G%dxT(i,j)) ! uy = ((u_shlf(I,J) + u_shlf(I-1,J)) - (u_shlf(I,J-1) + u_shlf(I-1,J-1))) / (2*G%dyT(i,j)) -! vy = ((v_shlf(I,J) + v_shlf(I-1,J)) - (v_shlf(I,J-1) + v_shlf(I-1,J-1))) / (2*G%dyT(i,j)) - ux = ((u_shlf(I,J) + u_shlf(I,J-1)) - (u_shlf(I-1,J) + u_shlf(I-1,J-1))) / (2*G%dxT(i,j)) - vx = ((v_shlf(I,J) + v_shlf(I,J-1)) - (v_shlf(I-1,J) + v_shlf(I-1,J-1))) / (2*G%dxT(i,j)) - uy = ((u_shlf(I,J) + u_shlf(I-1,J)) - (u_shlf(I,J-1) + u_shlf(I-1,J-1))) / (2*G%dyT(i,j)) - vy = ((v_shlf(I,J) + v_shlf(I-1,J)) - (v_shlf(I,J-1) + v_shlf(I-1,J-1))) / (2*G%dyT(i,j)) +! vy = ((v_shlf(I,J) + v_shlf(I-1,J)) - (v_shlf(I,J-1) + v_shlf(I-1,J-1))) / (2*G%dyT(i,j)) CS%ice_visc(i,j) = 0.5 * Visc_coef * (G%areaT(i,j) * ISS%h_shelf(i,j)) * & (US%s_to_T**2 * (ux**2 + vy**2 + ux*vy + 0.25*(uy+vx)**2 + eps_min**2))**((1.-n_g)/(2.*n_g)) ! CS%ice_visc(i,j) =1e15*(G%areaT(i,j) * ISS%h_shelf(i,j)) ! constant viscocity for debugging diff --git a/src/ice_shelf/MOM_ice_shelf_initialize.F90 b/src/ice_shelf/MOM_ice_shelf_initialize.F90 index 3b6926e58f..f2e01c461b 100644 --- a/src/ice_shelf/MOM_ice_shelf_initialize.F90 +++ b/src/ice_shelf/MOM_ice_shelf_initialize.F90 @@ -19,6 +19,7 @@ module MOM_ice_shelf_initialize !MJHpublic initialize_ice_shelf_boundary, initialize_ice_thickness public initialize_ice_thickness public initialize_ice_shelf_boundary_channel +public initialize_ice_flow_from_file ! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional ! consistency testing. These are noted in comments with units like Z, H, L, and T, along with @@ -589,4 +590,80 @@ end subroutine initialize_ice_shelf_boundary_channel !END MJH end subroutine initialize_ice_shelf_boundary_channel +subroutine initialize_ice_flow_from_file(u_shelf, v_shelf,ice_visc,float_cond, hmask,h_shelf, G, US, PF) + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + real, dimension(SZDI_(G),SZDJ_(G)), & + intent(inout) :: u_shelf !< The ice shelf u velocity [Z ~> m T ~>s]. + real, dimension(SZDI_(G),SZDJ_(G)), & + intent(inout) :: v_shelf !< The ice shelf v velocity [Z ~> m T ~> s]. + real, dimension(SZDI_(G),SZDJ_(G)), & + intent(inout) :: ice_visc !< The ice shelf viscosity [Pa ~> m T ~> s]. + real, dimension(SZDI_(G),SZDJ_(G)), & + intent(inout) :: float_cond !< An array indicating where the ice + !! shelf is floating: 0 if floating, 1 if not. + real, dimension(SZDI_(G),SZDJ_(G)), & + intent(in) :: hmask !< A mask indicating which tracer points are + !! partly or fully covered by an ice-shelf + real, dimension(SZDI_(G),SZDJ_(G)), & + intent(in) :: h_shelf !< A mask indicating which tracer points are + !! partly or fully covered by an ice-shelf + type(unit_scale_type), intent(in) :: US !< A structure containing unit conversion factors + type(param_file_type), intent(in) :: PF !< A structure to parse for run-time parameters + + ! This subroutine reads ice thickness and area from a file and puts it into + ! h_shelf [Z ~> m] and area_shelf_h [L2 ~> m2] (and dimensionless) and updates hmask + character(len=200) :: filename,vel_file,inputdir ! Strings for file/path + character(len=200) :: ushelf_varname, vshelf_varname, ice_visc_varname, floatfr_varname ! Variable name in file + character(len=40) :: mdl = "initialize_ice_velocity_from_file" ! This subroutine's name. + integer :: i, j, isc, jsc, iec, jec + real :: len_sidestress, mask, udh + + call MOM_mesg(" MOM_ice_shelf_init_profile.F90, initialize_velocity_from_file: reading velocity") + + call get_param(PF, mdl, "INPUTDIR", inputdir, default=".") + inputdir = slasher(inputdir) + call get_param(PF, mdl, "ICE_VELOCITY_FILE", vel_file, & + "The file from which the velocity is read.", & + default="ice_shelf_vel.nc") + call get_param(PF, mdl, "LEN_SIDE_STRESS", len_sidestress, & + "position past which shelf sides are stress free.", & + default=0.0, units="axis_units") + + filename = trim(inputdir)//trim(vel_file) + call log_param(PF, mdl, "INPUTDIR/THICKNESS_FILE", filename) + call get_param(PF, mdl, "ICE_U_VEL_VARNAME", ushelf_varname, & + "The name of the thickness variable in ICE_VELOCITY_FILE.", & + default="u_shelf") + call get_param(PF, mdl, "ICE_V_VEL_VARNAME", vshelf_varname, & + "The name of the thickness variable in ICE_VELOCITY_FILE.", & + default="v_shelf") + call get_param(PF, mdl, "ICE_VISC_VARNAME", ice_visc_varname, & + "The name of the thickness variable in ICE_VELOCITY_FILE.", & + default="viscosity") + + if (.not.file_exists(filename, G%Domain)) call MOM_error(FATAL, & + " initialize_ice_shelf_velocity_from_file: Unable to open "//trim(filename)) + + !hmask_varname = "hmask" + floatfr_varname = "float_frac" + +! call MOM_read_data(filename, trim(ushelf_varname), u_shelf, G%Domain, scale=1.0) !/(365.0*86400.0)) +! call MOM_read_data(filename,trim(vshelf_varname), v_shelf, G%Domain, scale=1.0) !/(365.0*86400.0)) + call MOM_read_data(filename,trim(ice_visc_varname), ice_visc, G%Domain, scale=1.0) !*(365.0*86400.0)) + call MOM_read_data(filename,trim(floatfr_varname), float_cond, G%Domain, scale=1.) +! call get_param(PF, mdl, "ICE_BOUNDARY_CONFIG", config, & +! "This specifies how the ice domain boundary is specified", & +! fail_if_missing=.true.) + + isc = G%isc ; jsc = G%jsc ; iec = G%iec ; jec = G%jec + + do j=jsc,jec + do i=isc,iec + if (hmask(i,j) == 1.) then + ice_visc(i,j) = ice_visc(i,j) * (G%areaT(i,j) * h_shelf(i,j)) + endif + enddo + enddo + +end subroutine initialize_ice_flow_from_file end module MOM_ice_shelf_initialize From 28b1ac9224da9fa5c81275ecb4132ed0c80121fb Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Tue, 2 Mar 2021 14:09:56 -0500 Subject: [PATCH 20/35] Update CVMix to v0.93-beta (no API change) - Tag v0.93-beta of CVMix is the last tag on their "master" branch before an API change within CVMix. - Answers reproduce with the three-year prior commit being used, as tested in MOM6-examples single_column cases. These do not cover all CVMix code. --- pkg/CVMix-src | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/pkg/CVMix-src b/pkg/CVMix-src index 534fc38e75..919a3a24ac 160000 --- a/pkg/CVMix-src +++ b/pkg/CVMix-src @@ -1 +1 @@ -Subproject commit 534fc38e759fcb8a2563fa0dc4c0bbf81f758db9 +Subproject commit 919a3a24acd67454df3ef8ad9854b734a472fea7 From 34dc0c848916075614eb7ec0a5b32a6f9fb6ebec Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Tue, 2 Mar 2021 14:16:39 -0500 Subject: [PATCH 21/35] Update CVMix to v0.94b-beta with API change - This tag involves an API change that requires changes to MOM_tidal_mixing.F90. - Changes are dropped arguments so presumably that data is not needed. - Answers reproduce in so far as they are covered by MOM6-examples. Not all of CVMix is covered in these tests and this code in particular is not. --- pkg/CVMix-src | 2 +- src/parameterizations/vertical/MOM_tidal_mixing.F90 | 2 -- 2 files changed, 1 insertion(+), 3 deletions(-) diff --git a/pkg/CVMix-src b/pkg/CVMix-src index 919a3a24ac..fee4701ac6 160000 --- a/pkg/CVMix-src +++ b/pkg/CVMix-src @@ -1 +1 @@ -Subproject commit 919a3a24acd67454df3ef8ad9854b734a472fea7 +Subproject commit fee4701ac61b69964850db5a4c3ebea41fb9346f diff --git a/src/parameterizations/vertical/MOM_tidal_mixing.F90 b/src/parameterizations/vertical/MOM_tidal_mixing.F90 index b870dff1af..512179445b 100644 --- a/src/parameterizations/vertical/MOM_tidal_mixing.F90 +++ b/src/parameterizations/vertical/MOM_tidal_mixing.F90 @@ -882,7 +882,6 @@ subroutine calculate_CVMix_tidal(h, j, G, GV, US, CS, N2_int, Kd_lay, Kd_int, Kv ! summing q_i*TidalConstituent_i over the number of constituents. call CVMix_compute_SchmittnerCoeff( nlev = GV%ke, & energy_flux = tidal_qe_md(:), & - rho = rho_fw, & SchmittnerCoeff = Schmittner_coeff, & exp_hab_zetar = exp_hab_zetar, & CVmix_tidal_params_user = CS%CVMix_tidal_params) @@ -896,7 +895,6 @@ subroutine calculate_CVMix_tidal(h, j, G, GV, US, CS, N2_int, Kd_lay, Kd_int, Kv Tdiff_out = Kd_tidal, & Nsqr = N2_int_i, & OceanDepth = -iFaceHeight(GV%ke+1), & - vert_dep = vert_dep, & nlev = GV%ke, & max_nlev = GV%ke, & SchmittnerCoeff = Schmittner_coeff, & From e56d4533587fdaac26f3f7faee54ab391cd6ad61 Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Tue, 2 Mar 2021 14:22:54 -0500 Subject: [PATCH 22/35] Update CVMix to v0.98-beta - v0.98-beta is the latest tag of CVMix that is available a.t.t. - There were no API changes since the v0.94b-beta that affected MOM6. - No answer changes for MOM6-examples, but these do not exercise much of CVMix. --- pkg/CVMix-src | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/pkg/CVMix-src b/pkg/CVMix-src index fee4701ac6..9423197f89 160000 --- a/pkg/CVMix-src +++ b/pkg/CVMix-src @@ -1 +1 @@ -Subproject commit fee4701ac61b69964850db5a4c3ebea41fb9346f +Subproject commit 9423197f894112edfcb1502245f7d7b873d551f9 From 5483bfed1243fd765b34059f96a68f4a0dc2b5ed Mon Sep 17 00:00:00 2001 From: Olga Sergienko Date: Wed, 3 Mar 2021 10:46:48 -0500 Subject: [PATCH 23/35] Cleaned initialize_ice_shelf_boundary_channel --- src/ice_shelf/MOM_ice_shelf_initialize.F90 | 33 ++++++++++------------ 1 file changed, 15 insertions(+), 18 deletions(-) diff --git a/src/ice_shelf/MOM_ice_shelf_initialize.F90 b/src/ice_shelf/MOM_ice_shelf_initialize.F90 index f2e01c461b..7ba1ab7076 100644 --- a/src/ice_shelf/MOM_ice_shelf_initialize.F90 +++ b/src/ice_shelf/MOM_ice_shelf_initialize.F90 @@ -265,6 +265,8 @@ subroutine initialize_ice_thickness_channel(h_shelf, area_shelf_h, hmask, G, US, endif ; enddo end subroutine initialize_ice_thickness_channel + +!> Initialize ice shelf boundary conditions for a channel configuration subroutine initialize_ice_shelf_boundary_channel(u_face_mask_bdry, v_face_mask_bdry, & u_flux_bdry_val, v_flux_bdry_val, u_bdry_val, v_bdry_val, u_shelf, v_shelf, h_bdry_val, & thickness_bdry_val, hmask, h_shelf, G,& @@ -309,7 +311,7 @@ subroutine initialize_ice_shelf_boundary_channel(u_face_mask_bdry, v_face_mask_b real :: input_thick ! The input ice shelf thickness [Z ~> m] ! real :: input_flux ! The input ice flux per unit length [L Z T-1 ~> m2 s-1] real :: input_vel ! The input ice velocity per [L Z T-1 ~> m s-1] - real :: lenlat, len_stress, westlon, lenlon, southlat + real :: lenlat, len_stress, westlon, lenlon, southlat ! The input positions of the channel boundarises call get_param(PF, mdl, "LENLAT", lenlat, fail_if_missing=.true.) @@ -352,11 +354,11 @@ subroutine initialize_ice_shelf_boundary_channel(u_face_mask_bdry, v_face_mask_b ! else hmask(i+1,j) = 3.0 ! hmask(i,j) = 3.0 - h_bdry_val(i+1,j) = h_shelf(i+1,j) !OVS 11/10/20 !input_thick + h_bdry_val(i+1,j) = h_shelf(i+1,j) ! h_bdry_val(i,j) = h_shelf(i,j) thickness_bdry_val(i+1,j) = h_bdry_val(i+0*1,j) u_face_mask_bdry(i+1,j) = 3.0 - u_bdry_val(i+1,j) = input_vel*(1-16.0*((G%geoLatBu(i-1,j)/lenlat-0.5))**4) !OVS 11/09/20 U b.c. + u_bdry_val(i+1,j) = input_vel*(1-16.0*((G%geoLatBu(i-1,j)/lenlat-0.5))**4) !velocity distribution ! u_bdry_val(i+1,j) = (1 - ((G%geoLatBu(i,j) - 0.5*lenlat)*2./lenlat)**2) * & ! 1.5 * input_flux / input_thick ! endif @@ -367,28 +369,26 @@ subroutine initialize_ice_shelf_boundary_channel(u_face_mask_bdry, v_face_mask_b if (G%geoLatBu(i,j-1) == southlat) then !bot boundary if (len_stress == 0. .OR. G%geoLonCv(i,j) <= len_stress) then v_face_mask_bdry(i,j+1) = 0. -! u_face_mask_bdry(i,j-1) = 3. !OVS 11/25/20 - u_face_mask_bdry(i,j) = 3. !OVS 11/25/20 +! u_face_mask_bdry(i,j-1) = 3. + u_face_mask_bdry(i,j) = 3. u_bdry_val(i,j) = 0. v_bdry_val(i,j) = 0. else v_face_mask_bdry(i,j+1) = 1. -! v_face_mask_bdry(i,j) = 3. !OVS 01/20/21 - u_face_mask_bdry(i,j) = 3. !OVS 11/25/20 + u_face_mask_bdry(i,j) = 3. u_bdry_val(i,j) = 0. - v_bdry_val(i,j) = 0. !OVS 01/20/21 - !hmask(i,j) = 0.0 !OVS 11/25/20 + v_bdry_val(i,j) = 0. endif elseif (G%geoLatBu(i,j-1) == southlat+lenlat) then !top boundary if (len_stress == 0. .OR. G%geoLonCv(i,j) <= len_stress) then v_face_mask_bdry(i,j-1) = 0. - u_face_mask_bdry(i,j-1) = 3. !OVS 11/25/20 + u_face_mask_bdry(i,j-1) = 3. else ! v_face_mask_bdry(i,j-1) = 1. - v_face_mask_bdry(i,j-1) = 3. !OVS 01/20/21 - u_face_mask_bdry(i,j-1) = 3. !OVS 11/25/20 - !u_bdry_val(i,j) = 0. !OVS 11/25/20 - !hmask(i,j) = 0.0 !OVS 11/25/20 + v_face_mask_bdry(i,j-1) = 3. + u_face_mask_bdry(i,j-1) = 3. + !u_bdry_val(i,j) = 0. + !hmask(i,j) = 0.0 endif endif @@ -400,9 +400,6 @@ subroutine initialize_ice_shelf_boundary_channel(u_face_mask_bdry, v_face_mask_b enddo enddo -! call pass_var(hmask, G%domain) -! call pass_var(h_bdry_val, G%domain) -! call pass_var(thickness_bdry_val, G%domain) ! if (.not. G%symmetric) then @@ -590,6 +587,7 @@ end subroutine initialize_ice_shelf_boundary_channel !END MJH end subroutine initialize_ice_shelf_boundary_channel +!> Initialize ice shelf flow from file subroutine initialize_ice_flow_from_file(u_shelf, v_shelf,ice_visc,float_cond, hmask,h_shelf, G, US, PF) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure real, dimension(SZDI_(G),SZDJ_(G)), & @@ -644,7 +642,6 @@ subroutine initialize_ice_flow_from_file(u_shelf, v_shelf,ice_visc,float_cond, h if (.not.file_exists(filename, G%Domain)) call MOM_error(FATAL, & " initialize_ice_shelf_velocity_from_file: Unable to open "//trim(filename)) - !hmask_varname = "hmask" floatfr_varname = "float_frac" ! call MOM_read_data(filename, trim(ushelf_varname), u_shelf, G%Domain, scale=1.0) !/(365.0*86400.0)) From 9aa75c8691c8c4e321a5894875d04a519bc4f0a1 Mon Sep 17 00:00:00 2001 From: Olga Sergienko Date: Wed, 3 Mar 2021 11:16:53 -0500 Subject: [PATCH 24/35] Modified MOM_ice_shelf_initialize.F90 --- src/ice_shelf/MOM_ice_shelf_initialize.F90 | 43 ++++++++++------------ 1 file changed, 19 insertions(+), 24 deletions(-) diff --git a/src/ice_shelf/MOM_ice_shelf_initialize.F90 b/src/ice_shelf/MOM_ice_shelf_initialize.F90 index 7ba1ab7076..f9f31a373e 100644 --- a/src/ice_shelf/MOM_ice_shelf_initialize.F90 +++ b/src/ice_shelf/MOM_ice_shelf_initialize.F90 @@ -302,14 +302,12 @@ subroutine initialize_ice_shelf_boundary_channel(u_face_mask_bdry, v_face_mask_b !! partly or fully covered by an ice-shelf real, dimension(SZDI_(G),SZDJ_(G)), & intent(inout) :: h_shelf !< Ice-shelf thickness OVS 11/10/20 -! logical, intent(in) :: flux_bdry !< If true, use mass fluxes as the boundary value. type(unit_scale_type), intent(in) :: US !< A structure containing unit conversion factors type(param_file_type), intent(in) :: PF !< A structure to parse for run-time parameters character(len=40) :: mdl = "initialize_ice_shelf_boundary_channel" ! This subroutine's name. integer :: i, j, isd, jsd, is, js, iegq, jegq, giec, gjec, gisc, gjsc,gisd,gjsd, isc, jsc, iec, jec, ied, jed - real :: input_thick ! The input ice shelf thickness [Z ~> m] -! real :: input_flux ! The input ice flux per unit length [L Z T-1 ~> m2 s-1] + real :: input_thick ! The input ice shelf thickness [Z ~> m] real :: input_vel ! The input ice velocity per [L Z T-1 ~> m s-1] real :: lenlat, len_stress, westlon, lenlon, southlat ! The input positions of the channel boundarises @@ -341,27 +339,27 @@ subroutine initialize_ice_shelf_boundary_channel(u_face_mask_bdry, v_face_mask_b gisc = G%Domain%nihalo ; gjsc = G%Domain%njhalo giec = G%Domain%niglobal+gisc ; gjec = G%Domain%njglobal+gjsc -!-----------b.c.s based on geopositions ----------------- -! do j=jsc-1,jec+1 + !---------b.c.s based on geopositions ----------------- + ! do j=jsc-1,jec+1 do j=jsc-0*1,jec+1 do i=isc-1,iec+1 ! upstream boundary - set either dirichlet or flux condition if (G%geoLonBu(i,j) == westlon) then - ! if (flux_bdry) then - ! u_face_mask_bdry(i-1,j) = 4.0 - ! u_flux_bdry_val(i-1,j) = input_flux - ! else + ! if (flux_bdry) then + ! u_face_mask_bdry(i-1,j) = 4.0 + ! u_flux_bdry_val(i-1,j) = input_flux + ! else hmask(i+1,j) = 3.0 -! hmask(i,j) = 3.0 + ! hmask(i,j) = 3.0 h_bdry_val(i+1,j) = h_shelf(i+1,j) -! h_bdry_val(i,j) = h_shelf(i,j) + ! h_bdry_val(i,j) = h_shelf(i,j) thickness_bdry_val(i+1,j) = h_bdry_val(i+0*1,j) u_face_mask_bdry(i+1,j) = 3.0 u_bdry_val(i+1,j) = input_vel*(1-16.0*((G%geoLatBu(i-1,j)/lenlat-0.5))**4) !velocity distribution - ! u_bdry_val(i+1,j) = (1 - ((G%geoLatBu(i,j) - 0.5*lenlat)*2./lenlat)**2) * & - ! 1.5 * input_flux / input_thick - ! endif + ! u_bdry_val(i+1,j) = (1 - ((G%geoLatBu(i,j) - 0.5*lenlat)*2./lenlat)**2) * & + ! 1.5 * input_flux / input_thick + ! endif endif @@ -369,7 +367,7 @@ subroutine initialize_ice_shelf_boundary_channel(u_face_mask_bdry, v_face_mask_b if (G%geoLatBu(i,j-1) == southlat) then !bot boundary if (len_stress == 0. .OR. G%geoLonCv(i,j) <= len_stress) then v_face_mask_bdry(i,j+1) = 0. -! u_face_mask_bdry(i,j-1) = 3. + ! u_face_mask_bdry(i,j-1) = 3. u_face_mask_bdry(i,j) = 3. u_bdry_val(i,j) = 0. v_bdry_val(i,j) = 0. @@ -384,7 +382,7 @@ subroutine initialize_ice_shelf_boundary_channel(u_face_mask_bdry, v_face_mask_b v_face_mask_bdry(i,j-1) = 0. u_face_mask_bdry(i,j-1) = 3. else -! v_face_mask_bdry(i,j-1) = 1. + !v_face_mask_bdry(i,j-1) = 1. v_face_mask_bdry(i,j-1) = 3. u_face_mask_bdry(i,j-1) = 3. !u_bdry_val(i,j) = 0. @@ -398,10 +396,7 @@ subroutine initialize_ice_shelf_boundary_channel(u_face_mask_bdry, v_face_mask_b endif enddo - enddo - - - + enddo ! if (.not. G%symmetric) then !! do j=G%jsd,G%jed !! do i=G%isd,G%ied @@ -623,7 +618,7 @@ subroutine initialize_ice_flow_from_file(u_shelf, v_shelf,ice_visc,float_cond, h call get_param(PF, mdl, "ICE_VELOCITY_FILE", vel_file, & "The file from which the velocity is read.", & default="ice_shelf_vel.nc") - call get_param(PF, mdl, "LEN_SIDE_STRESS", len_sidestress, & + call get_param(PF, mdl, "LEN_SIDE_STRESS", len_sidestress, & "position past which shelf sides are stress free.", & default=0.0, units="axis_units") @@ -642,12 +637,12 @@ subroutine initialize_ice_flow_from_file(u_shelf, v_shelf,ice_visc,float_cond, h if (.not.file_exists(filename, G%Domain)) call MOM_error(FATAL, & " initialize_ice_shelf_velocity_from_file: Unable to open "//trim(filename)) - floatfr_varname = "float_frac" + floatfr_varname = "float_frac" ! call MOM_read_data(filename, trim(ushelf_varname), u_shelf, G%Domain, scale=1.0) !/(365.0*86400.0)) ! call MOM_read_data(filename,trim(vshelf_varname), v_shelf, G%Domain, scale=1.0) !/(365.0*86400.0)) - call MOM_read_data(filename,trim(ice_visc_varname), ice_visc, G%Domain, scale=1.0) !*(365.0*86400.0)) - call MOM_read_data(filename,trim(floatfr_varname), float_cond, G%Domain, scale=1.) + call MOM_read_data(filename,trim(ice_visc_varname), ice_visc, G%Domain, scale=1.0) !*(365.0*86400.0)) + call MOM_read_data(filename,trim(floatfr_varname), float_cond, G%Domain, scale=1.) ! call get_param(PF, mdl, "ICE_BOUNDARY_CONFIG", config, & ! "This specifies how the ice domain boundary is specified", & ! fail_if_missing=.true.) From 2232fa2882806f8ebabb324d93cc580c107bb17a Mon Sep 17 00:00:00 2001 From: Olga Sergienko Date: Wed, 3 Mar 2021 15:51:11 -0500 Subject: [PATCH 25/35] corrected style errors in MOM_ice_shelf.F90; MOM_ice_shelf_dynamics.F90; MOM_ice_shelf_initialize.F90 --- src/ice_shelf/MOM_ice_shelf.F90 | 2 +- src/ice_shelf/MOM_ice_shelf_dynamics.F90 | 295 +++------------------ src/ice_shelf/MOM_ice_shelf_initialize.F90 | 41 +-- 3 files changed, 63 insertions(+), 275 deletions(-) diff --git a/src/ice_shelf/MOM_ice_shelf.F90 b/src/ice_shelf/MOM_ice_shelf.F90 index 5663b326b7..5d2bc88b4c 100644 --- a/src/ice_shelf/MOM_ice_shelf.F90 +++ b/src/ice_shelf/MOM_ice_shelf.F90 @@ -719,7 +719,7 @@ subroutine shelf_calc_flux(sfc_state_in, fluxes_in, Time, time_step, CS) call hchksum(ISS%mass_shelf, "mass_shelf after change thickness using melt", G%HI, haloshift=0, & scale=US%RZ_to_kg_m2) endif - endif !OVS 12/10/20 + endif !OVS 12/10/20 if (CS%debug) call MOM_forcing_chksum("Before add shelf flux", fluxes, G, CS%US, haloshift=0) diff --git a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 index 5e6ba60a1a..8640902989 100644 --- a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 +++ b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 @@ -23,7 +23,7 @@ module MOM_ice_shelf_dynamics use MOM_ice_shelf_state, only : ice_shelf_state use MOM_coms, only : reproducing_sum, sum_across_PEs, max_across_PEs, min_across_PEs use MOM_checksums, only : hchksum, qchksum -use MOM_ice_shelf_initialize, only : initialize_ice_shelf_boundary_channel,initialize_ice_flow_from_file !OVS intializing b.c.s +use MOM_ice_shelf_initialize, only : initialize_ice_shelf_boundary_channel,initialize_ice_flow_from_file implicit none ; private @@ -47,7 +47,7 @@ module MOM_ice_shelf_dynamics real, pointer, dimension(:,:) :: taudx_shelf => NULL() !< the driving stress of the ice shelf/sheet !! on q-points (C grid) [Pa ~> Pa] real, pointer, dimension(:,:) :: taudy_shelf => NULL() !< the meridional stress of the ice shelf/sheet - !! on q-points (C grid) [Pa ~> Pa] + !! on q-points (C grid) [Pa ~> Pa] real, pointer, dimension(:,:) :: u_face_mask => NULL() !< mask for velocity boundary conditions on the C-grid !! u-face - this is because the FEM cares about FACES THAT GET INTEGRATED OVER, !! not vertices. Will represent boundary conditions on computational boundary @@ -263,10 +263,10 @@ subroutine register_ice_shelf_dyn_restarts(G, param_file, CS, restart_CS) "ice sheet/shelf v-velocity", "m s-1", hor_grid='Bu') call register_restart_field(CS%t_shelf, "t_shelf", .true., restart_CS, & "ice sheet/shelf vertically averaged temperature", "deg C") - call register_restart_field(CS%taudx_shelf, "taudx_shelf", .true., restart_CS, & !OVS 02/8/21 + call register_restart_field(CS%taudx_shelf, "taudx_shelf", .true., restart_CS, & "ice sheet/shelf taudx-driving stress", "kPa") - call register_restart_field(CS%taudy_shelf, "taudy_shelf", .true., restart_CS, & !OVS 02/08/21 - "ice sheet/shelf taudy-driving stress", "kPa") + call register_restart_field(CS%taudy_shelf, "taudy_shelf", .true., restart_CS, & + "ice sheet/shelf taudy-driving stress", "kPa") call register_restart_field(CS%OD_av, "OD_av", .true., restart_CS, & "Average open ocean depth in a cell","m") call register_restart_field(CS%ground_frac, "ground_frac", .true., restart_CS, & @@ -376,23 +376,20 @@ subroutine initialize_ice_shelf_dyn(param_file, Time, ISS, CS, G, US, diag, new_ call get_param(param_file, mdl, "A_GLEN_ISOTHERM", CS%A_glen_isothermal, & "Ice viscosity parameter in Glen's Law", & - units="Pa-3 s-1", default=2.2261e-25, scale=1.0) !OVS change units to Pa-3 s-1 -! units="Pa-3 yr-1", default=9.461e-18, scale=1.0/(365.0*86400.0)) + units="Pa-3 s-1", default=2.2261e-25, scale=1.0) ! This default is equivalent to 3.0001e-25 Pa-3 s-1, appropriate at about -10 C. call get_param(param_file, mdl, "GLEN_EXPONENT", CS%n_glen, & "nonlinearity exponent in Glen's Law", & units="none", default=3.) call get_param(param_file, mdl, "MIN_STRAIN_RATE_GLEN", CS%eps_glen_min, & "min. strain rate to avoid infinite Glen's law viscosity", & - units="s-1", default=1.e-19, scale=US%T_to_s) !OVS change units to s-1 - !units="a-1", default=1.e-12, scale=US%T_to_s/(365.0*86400.0)) + units="s-1", default=1.e-19, scale=US%T_to_s) call get_param(param_file, mdl, "BASAL_FRICTION_EXP", CS%n_basal_fric, & "Exponent in sliding law \tau_b = C u^(n_basal_fric)", & units="none", fail_if_missing=.true.) call get_param(param_file, mdl, "BASAL_FRICTION_COEFF", CS%C_basal_friction, & "Coefficient in sliding law \tau_b = C u^(n_basal_fric)", & - units="Pa (m s-1)^(n_basal_fric)", scale=US%kg_m2s_to_RZ_T**CS%n_basal_fric, & ! OVS change units to s-1 - !units="Pa (m yr-1)-(n_basal_fric)", scale=US%kg_m2s_to_RZ_T*((365.0*86400.0)**CS%n_basal_fric), & + units="Pa (m s-1)^(n_basal_fric)", scale=US%kg_m2s_to_RZ_T**CS%n_basal_fric, & fail_if_missing=.true.) call get_param(param_file, mdl, "DENSITY_ICE", CS%density_ice, & "A typical density of ice.", units="kg m-3", default=917.0, scale=US%kg_m3_to_R) @@ -416,7 +413,7 @@ subroutine initialize_ice_shelf_dyn(param_file, Time, ISS, CS, G, US, diag, new_ call get_param(param_file, mdl, "CALVE_TO_MASK", CS%calve_to_mask, & "If true, do not allow an ice shelf where prohibited by a mask.", & default=.false.) - + endif call get_param(param_file, mdl, "MIN_THICKNESS_SIMPLE_CALVE", CS%min_thickness_simple_calve, & "Min thickness rule for the VERY simple calving law",& @@ -424,7 +421,6 @@ subroutine initialize_ice_shelf_dyn(param_file, Time, ISS, CS, G, US, diag, new_ ! Allocate memory in the ice shelf dynamics control structure that was not ! previously allocated for registration for restarts. - ! OVS vertically integrated Temperature if (active_shelf_dynamics) then ! DNG @@ -533,68 +529,37 @@ subroutine initialize_ice_shelf_dyn(param_file, Time, ISS, CS, G, US, diag, new_ CS%u_flux_bdry_val, CS%v_flux_bdry_val, CS%u_bdry_val, CS%v_bdry_val, CS%u_shelf, CS%v_shelf,& CS%h_bdry_val, & CS%thickness_bdry_val, ISS%hmask, ISS%h_shelf, G, & -! CS%flux_bdry, & - US, param_file ) !OVS initialize b.c.s + US, param_file ) call pass_var(ISS%hmask, G%domain) call pass_var(CS%h_bdry_val, G%domain) - call pass_var(CS%thickness_bdry_val, G%domain) - call pass_var(CS%u_bdry_val, G%domain) - call pass_var(CS%v_bdry_val, G%domain) - call pass_var(CS%u_face_mask_bdry, G%domain) - call pass_var(CS%v_face_mask_bdry, G%domain) -! call init_boundary_values(CS, G, time, ISS%hmask, CS%input_flux, CS%input_thickness, new_sim) + call pass_var(CS%thickness_bdry_val, G%domain) + call pass_var(CS%u_bdry_val, G%domain) + call pass_var(CS%v_bdry_val, G%domain) + call pass_var(CS%u_face_mask_bdry, G%domain) + call pass_var(CS%v_face_mask_bdry, G%domain) + !call init_boundary_values(CS, G, time, ISS%hmask, CS%input_flux, CS%input_thickness, new_sim) call update_velocity_masks(CS, G, ISS%hmask, CS%umask, CS%vmask, CS%u_face_mask, CS%v_face_mask) -! call initialize_ice_flow_from_file(CS%u_shelf, CS%v_shelf,CS%ice_visc,CS%ground_frac, ISS%hmask,ISS%h_shelf, & -! G, US, param_file) !spacially variable viscosity from a file for debugging -! call pass_var(CS%ice_visc, G%domain) -! if (new_sim) then -! call MOM_mesg("MOM_ice_shelf.F90, initialize_ice_shelf: initialize ice velocity.") -! call update_OD_ffrac_uncoupled(CS, G, ISS%h_shelf(:,:)) -!! call ice_shelf_solve_outer(CS, ISS, G, US, CS%u_shelf, CS%v_shelf, iters, Time) -! call ice_shelf_solve_outer(CS, ISS, G, US, CS%u_shelf, CS%v_shelf,CS%taudx_shelf,CS%taudy_shelf, iters, Time) !OVS 02/08/21 -! if (CS%id_u_shelf > 0) call post_data(CS%id_u_shelf, CS%u_shelf, CS%diag) -! if (CS%id_v_shelf > 0) call post_data(CS%id_v_shelf, CS%v_shelf,CS%diag) -! if (CS%id_taudx_shelf > 0) call post_data(CS%id_taudx_shelf, CS%taudx_shelf,CS%diag) -! if (CS%id_taudy_shelf > 0) call post_data(CS%id_taudy_shelf, CS%taudy_shelf,CS%diag) -! if (CS%id_visc_shelf > 0) call post_data(CS%id_visc_shelf, CS%ice_visc,CS%diag) -! endif ! Register diagnostics. -! CS%id_u_shelf = register_diag_field('ocean_model','u_shelf',CS%diag%axesCu1, Time, & -! 'x-velocity of ice', 'm yr-1', conversion=365.0*86400.0*US%L_T_to_m_s) CS%id_u_shelf = register_diag_field('ice_shelf_model','u_shelf',CS%diag%axesCu1, Time, & 'x-velocity of ice', 'm yr-1', conversion=365.0*86400.0*US%L_T_to_m_s) -! CS%id_v_shelf = register_diag_field('ocean_model','v_shelf',CS%diag%axesCv1, Time, & -! 'y-velocity of ice', 'm yr-1', conversion=365.0*86400.0*US%L_T_to_m_s) CS%id_v_shelf = register_diag_field('ice_shelf_model','v_shelf',CS%diag%axesCv1, Time, & 'y-velocity of ice', 'm yr-1', conversion=365.0*86400.0*US%L_T_to_m_s) CS%id_taudx_shelf = register_diag_field('ice_shelf_model','taudx_shelf',CS%diag%axesT1, Time, & 'x-driving stress of ice', 'kPa', conversion=1.e-9*US%L_T_to_m_s) CS%id_taudy_shelf = register_diag_field('ice_shelf_model','taudy_shelf',CS%diag%axesT1, Time, & 'x-driving stress of ice', 'kPa', conversion=1.e-9*US%L_T_to_m_s) -! CS%id_u_mask = register_diag_field('ocean_model','u_mask',CS%diag%axesCu1, Time, & -! 'mask for u-nodes', 'none') CS%id_u_mask = register_diag_field('ice_shelf_model','u_mask',CS%diag%axesCu1, Time, & 'mask for u-nodes', 'none') -! CS%id_v_mask = register_diag_field('ocean_model','v_mask',CS%diag%axesCv1, Time, & -! 'mask for v-nodes', 'none') CS%id_v_mask = register_diag_field('ice_shelf_model','v_mask',CS%diag%axesCv1, Time, & 'mask for v-nodes', 'none') -! CS%id_surf_elev = register_diag_field('ocean_model','ice_surf',CS%diag%axesT1, Time, & -! 'ice surf elev', 'm') -! CS%id_ground_frac = register_diag_field('ocean_model','ice_ground_frac',CS%diag%axesT1, Time, & -! 'fraction of cell that is grounded', 'none') CS%id_ground_frac = register_diag_field('ice_shelf_model','ice_ground_frac',CS%diag%axesT1, Time, & 'fraction of cell that is grounded', 'none') -! CS%id_col_thick = register_diag_field('ocean_model','col_thick',CS%diag%axesT1, Time, & -! 'ocean column thickness passed to ice model', 'm', conversion=US%Z_to_m) CS%id_col_thick = register_diag_field('ice_shelf_model','col_thick',CS%diag%axesT1, Time, & 'ocean column thickness passed to ice model', 'm', conversion=US%Z_to_m) CS%id_visc_shelf = register_diag_field('ice_shelf_model','ice_visc',CS%diag%axesT1, Time, & 'viscosity', 'm', conversion=1e-6*US%Z_to_m) -! CS%id_OD_av = register_diag_field('ocean_model','OD_av',CS%diag%axesT1, Time, & -! 'intermediate ocean column thickness passed to ice model', 'm', conversion=US%Z_to_m) CS%id_OD_av = register_diag_field('ice_shelf_model','OD_av',CS%diag%axesT1, Time, & 'intermediate ocean column thickness passed to ice model', 'm', conversion=US%Z_to_m) CS%id_h_after_uflux = register_diag_field('ice_shelf_model','h_after_uflux',CS%diag%axesT1, Time, & @@ -606,8 +571,8 @@ subroutine initialize_ice_shelf_dyn(param_file, Time, ISS, CS, G, US, diag, new_ if (new_sim) then call MOM_mesg("MOM_ice_shelf.F90, initialize_ice_shelf: initialize ice velocity.") call update_OD_ffrac_uncoupled(CS, G, ISS%h_shelf(:,:)) -! call ice_shelf_solve_outer(CS, ISS, G, US, CS%u_shelf, CS%v_shelf, iters, Time) - call ice_shelf_solve_outer(CS, ISS, G, US, CS%u_shelf, CS%v_shelf,CS%taudx_shelf,CS%taudy_shelf, iters, Time) !OVS 02/08/21 + !call ice_shelf_solve_outer(CS, ISS, G, US, CS%u_shelf, CS%v_shelf, iters, Time) + call ice_shelf_solve_outer(CS, ISS, G, US, CS%u_shelf, CS%v_shelf,CS%taudx_shelf,CS%taudy_shelf, iters, Time) if (CS%id_u_shelf > 0) call post_data(CS%id_u_shelf, CS%u_shelf, CS%diag) if (CS%id_v_shelf > 0) call post_data(CS%id_v_shelf, CS%v_shelf,CS%diag) if (CS%id_taudx_shelf > 0) call post_data(CS%id_taudx_shelf, CS%taudx_shelf,CS%diag) @@ -655,8 +620,7 @@ subroutine initialize_diagnostic_fields(CS, ISS, G, US, Time) enddo enddo -! call ice_shelf_solve_outer(CS, ISS, G, US, CS%u_shelf, CS%v_shelf, iters, dummy_time) - call ice_shelf_solve_outer(CS, ISS, G, US, CS%u_shelf, CS%v_shelf,CS%taudx_shelf,CS%taudy_shelf, iters, Time) !OVS 02/08/21 + call ice_shelf_solve_outer(CS, ISS, G, US, CS%u_shelf, CS%v_shelf,CS%taudx_shelf,CS%taudy_shelf, iters, Time) end subroutine initialize_diagnostic_fields !> This function returns the global maximum advective timestep that can be taken based on the current @@ -716,7 +680,7 @@ subroutine update_ice_shelf(CS, ISS, G, US, time_step, Time, ocean_mass, coupled coupled_GL = .false. if (present(ocean_mass) .and. present(coupled_grounding)) coupled_GL = coupled_grounding ! - call ice_shelf_advect(CS, ISS, G, time_step, Time) !OVS 02/08/21 + call ice_shelf_advect(CS, ISS, G, time_step, Time) CS%elapsed_velocity_time = CS%elapsed_velocity_time + time_step if (CS%elapsed_velocity_time >= CS%velocity_update_time_step) update_ice_vel = .true. @@ -729,7 +693,7 @@ subroutine update_ice_shelf(CS, ISS, G, US, time_step, Time, ocean_mass, coupled if (update_ice_vel) then ! call ice_shelf_solve_outer(CS, ISS, G, US, CS%u_shelf, CS%v_shelf, iters, Time) - call ice_shelf_solve_outer(CS, ISS, G, US, CS%u_shelf, CS%v_shelf,CS%taudx_shelf,CS%taudy_shelf, iters, Time) !OVS 02/08/21 + call ice_shelf_solve_outer(CS, ISS, G, US, CS%u_shelf, CS%v_shelf,CS%taudx_shelf,CS%taudy_shelf, iters, Time) endif call ice_shelf_temp(CS, ISS, G, US, time_step, ISS%water_flux, Time) @@ -741,10 +705,10 @@ subroutine update_ice_shelf(CS, ISS, G, US, time_step, Time, ocean_mass, coupled if (CS%id_v_shelf > 0) call post_data(CS%id_v_shelf, CS%v_shelf, CS%diag) if (CS%id_t_shelf > 0) call post_data(CS%id_t_shelf,CS%t_shelf,CS%diag) if (CS%id_taudx_shelf > 0) call post_data(CS%id_taudx_shelf, CS%taudx_shelf, CS%diag) - if (CS%id_taudy_shelf > 0) call post_data(CS%id_taudy_shelf, CS%taudy_shelf, CS%diag) + if (CS%id_taudy_shelf > 0) call post_data(CS%id_taudy_shelf, CS%taudy_shelf, CS%diag) if (CS%id_ground_frac > 0) call post_data(CS%id_ground_frac, CS%ground_frac,CS%diag) if (CS%id_OD_av >0) call post_data(CS%id_OD_av, CS%OD_av,CS%diag) - if (CS%id_visc_shelf > 0) call post_data(CS%id_visc_shelf, CS%ice_visc,CS%diag) + if (CS%id_visc_shelf > 0) call post_data(CS%id_visc_shelf, CS%ice_visc,CS%diag) if (CS%id_u_mask > 0) call post_data(CS%id_u_mask,CS%umask,CS%diag) if (CS%id_v_mask > 0) call post_data(CS%id_v_mask,CS%vmask,CS%diag) @@ -908,7 +872,7 @@ subroutine ice_shelf_solve_outer(CS, ISS, G, US, u_shlf, v_shlf,taudx,taudy, ite call calc_shelf_driving_stress(CS, ISS, G, US, taudx, taudy, CS%OD_av) call pass_vector(taudx, taudy, G%domain, TO_ALL, BGRID_NE) !OVS 02/01/21 ! call pass_var(taudx, G%Domain) !OVS 01/21/21 -! call pass_var(taudy, G%Domain) !OVS 01/21/21 +! call pass_var(taudy, G%Domain) !OVS 01/21/21 ! This is to determine which cells contain the grounding line, the criterion being that the cell ! is ice-covered, with some nodes floating and some grounded flotation condition is estimated by ! assuming topography is cellwise constant and H is bilinear in a cell; floating where @@ -1072,7 +1036,7 @@ subroutine ice_shelf_solve_outer(CS, ISS, G, US, u_shlf, v_shlf,taudx,taudy, ite if (err_max <= CS%nonlinear_tolerance * err_init) then write(mesg,*) "ice_shelf_solve_outer: nonlinear fractional residual = ", err_max/err_init - call MOM_mesg(mesg) + call MOM_mesg(mesg) write(mesg,*) "ice_shelf_solve_outer: exiting nonlinear solve after ",iter," iterations" ! call MOM_mesg(mesg, 5) call MOM_mesg(mesg) @@ -1354,8 +1318,8 @@ subroutine ice_shelf_solve_inner(CS, ISS, G, US, u_shlf, v_shlf, taudx, taudy, H ! pass vectors call pass_vector(Du, Dv, G%domain, TO_ALL, BGRID_NE) call pass_vector(u_shlf, v_shlf, G%domain, TO_ALL, BGRID_NE) - call pass_var(u_shlf, G%domain) - call pass_var(v_shlf, G%domain) + call pass_var(u_shlf, G%domain) + call pass_var(v_shlf, G%domain) call pass_vector(Ru, Rv, G%domain, TO_ALL, BGRID_NE) cg_halo = 3 endif @@ -1856,7 +1820,7 @@ subroutine calc_shelf_driving_stress(CS, ISS, G, US, taudx, taudy, OD) ! check whether the ice is floating or grounded ! do j=jsc-1,jec+1 !OVS 02/02/21 ! do i=isc-1,iec+1 !OVS 02/02/21 - do j=jsc-G%domain%njhalo,jec+G%domain%njhalo !OVS 02/02/21 + do j=jsc-G%domain%njhalo,jec+G%domain%njhalo !OVS 02/02/21 do i=isc-G%domain%nihalo,iec+G%domain%nihalo !OVS 02/02/21 ! if (ISS%h_shelf(i,j) < rhow/rho * G%bathyT(i,j)) then @@ -1866,7 +1830,7 @@ subroutine calc_shelf_driving_stress(CS, ISS, G, US, taudx, taudy, OD) enddo - enddo + enddo do j=jsc-1,jec+1 do i=isc-1,iec+1 cnt = 0 @@ -1956,16 +1920,16 @@ subroutine calc_shelf_driving_stress(CS, ISS, G, US, taudx, taudy, OD) taudy(I,J-1) = taudy(I,J-1) - .25 * rho * grav * ISS%h_shelf(i,j) * sy * G%areaT(i,j) endif ! NW vertex - if (ISS%hmask(I-1,J) == 1) then + if (ISS%hmask(I-1,J) == 1) then taudx(I-1,J) = taudx(I-1,J) - .25 * rho * grav * ISS%h_shelf(i,j) * sx * G%areaT(i,j) taudy(I-1,J) = taudy(I-1,J) - .25 * rho * grav * ISS%h_shelf(i,j) * sy * G%areaT(i,j) - endif + endif ! NE vertex if (ISS%hmask(I,J) == 1) then taudx(I,J) = taudx(I,J) - .25 * rho * grav * ISS%h_shelf(i,j) * sx * G%areaT(i,j) taudy(I,J) = taudy(I,J) - .25 * rho * grav * ISS%h_shelf(i,j) * sy * G%areaT(i,j) endif - if (CS%ground_frac(i,j) == 1) then + if (CS%ground_frac(i,j) == 1) then ! neumann_val = .5 * grav * (rho * ISS%h_shelf(i,j)**2 - rhow * G%bathyT(i,j)**2) neumann_val = .5 * grav * (1-rho/rhow) * rho * ISS%h_shelf(i,j)**2 else @@ -2325,7 +2289,7 @@ subroutine matrix_diagonal(CS, G, US, float_cond, H_node, ice_visc, basal_trac, ! Phi(2*i-1,j) gives d(Phi_i)/dx at quadrature point j ! Phi(2*i,j) gives d(Phi_i)/dy at quadrature point j - do iq=1,2 ; do jq=1,2 ; do iphi=1,2 ; do jphi=1,2 ; Itgt = I-2+iphi ; Jtgt = J-2+jphi !Jtgt = J-2-jphi !OVS fix index + do iq=1,2 ; do jq=1,2 ; do iphi=1,2 ; do jphi=1,2 ; Itgt = I-2+iphi ; Jtgt = J-2+jphi ilq = 1 ; if (iq == iphi) ilq = 2 jlq = 1 ; if (jq == jphi) jlq = 2 @@ -2584,7 +2548,7 @@ subroutine calc_shelf_visc(CS, ISS, G, US, u_shlf, v_shlf) integer :: i, j, iscq, iecq, jscq, jecq, isd, jsd, ied, jed, iegq, jegq, iq, jq integer :: giec, gjec, gisc, gjsc, cnt, isc, jsc, iec, jec, is, js, i_off, j_off real :: Visc_coef, n_g - real :: ux, uy, vx, vy + real :: ux, uy, vx, vy real :: eps_min, dxh, dyh ! Velocity shears [T-1 ~> s-1] real, dimension(8,4) :: Phi real, dimension(2) :: xquad @@ -2602,7 +2566,7 @@ subroutine calc_shelf_visc(CS, ISS, G, US, u_shlf, v_shlf) n_g = CS%n_glen; eps_min = CS%eps_glen_min ! CS%ice_visc(:,:) = 0.0 -! ux(:,:) = 0.0; uy(:,:) = 0.0; vx(:,:) =0.0; vy(:,:) =0.0 +! ux(:,:) = 0.0; uy(:,:) = 0.0; vx(:,:) =0.0; vy(:,:) =0.0 ! eII(:,:) = (US%s_to_T**2 * (eps_min**2)) Visc_coef = US%kg_m2s_to_RZ_T*US%m_to_L*US%Z_to_L*(CS%A_glen_isothermal)**(-1./CS%n_glen) !OVS '-' in the exponent ! call pass_vector(u_shlf, v_shlf, G%domain, TO_ALL, BGRID_NE) @@ -2616,11 +2580,11 @@ subroutine calc_shelf_visc(CS, ISS, G, US, u_shlf, v_shlf) ! vx(i,j) = ((v_shlf(I,J) + v_shlf(I,J-1)) - (v_shlf(I-1,J) + v_shlf(I-1,J-1))) / (2*G%dxT(i,j)) ! uy(i,j) = ((u_shlf(I,J) + u_shlf(I-1,J)) - (u_shlf(I,J-1) + u_shlf(I-1,J-1))) / (2*G%dyT(i,j)) ! vy(i,j) = ((v_shlf(I,J) + v_shlf(I-1,J)) - (v_shlf(I,J-1) + v_shlf(I-1,J-1))) / (2*G%dyT(i,j)) -! endif +! endif +! enddo ! enddo -! enddo ! call pass_vector(ux, uy, G%domain, TO_ALL, BGRID_NE) -! call pass_vector(vx, vy, G%domain, TO_ALL, BGRID_NE) +! call pass_vector(vx, vy, G%domain, TO_ALL, BGRID_NE) ux = ((u_shlf(I,J) + u_shlf(I,J-1) + u_shlf(I,J+1)) - & (u_shlf(I-1,J) + u_shlf(I-1,J-1) + u_shlf(I-1,J+1))) / (3*G%dxT(i,j)) vx = ((v_shlf(I,J) + v_shlf(I,J-1) + v_shlf(I,J+1)) - & @@ -2628,14 +2592,14 @@ subroutine calc_shelf_visc(CS, ISS, G, US, u_shlf, v_shlf) uy = ((u_shlf(I,J) + u_shlf(I-1,J) + u_shlf(I+1,J)) - & (u_shlf(I,J-1) + u_shlf(I-1,J-1) + u_shlf(I+1,J-1))) / (3*G%dyT(i,j)) vy = ((v_shlf(I,J) + v_shlf(I-1,J)+ v_shlf(I+1,J)) - & - (v_shlf(I,J-1) + v_shlf(I-1,J-1)+ v_shlf(I+1,J-1))) / (3*G%dyT(i,j)) + (v_shlf(I,J-1) + v_shlf(I-1,J-1)+ v_shlf(I+1,J-1))) / (3*G%dyT(i,j)) ! ux = ((u_shlf(I,J) + u_shlf(I,J-1)) - (u_shlf(I-1,J) + u_shlf(I-1,J-1))) / (2*G%dxT(i,j)) ! vx = ((v_shlf(I,J) + v_shlf(I,J-1)) - (v_shlf(I-1,J) + v_shlf(I-1,J-1))) / (2*G%dxT(i,j)) ! uy = ((u_shlf(I,J) + u_shlf(I-1,J)) - (u_shlf(I,J-1) + u_shlf(I-1,J-1))) / (2*G%dyT(i,j)) ! vy = ((v_shlf(I,J) + v_shlf(I-1,J)) - (v_shlf(I,J-1) + v_shlf(I-1,J-1))) / (2*G%dyT(i,j)) CS%ice_visc(i,j) = 0.5 * Visc_coef * (G%areaT(i,j) * ISS%h_shelf(i,j)) * & (US%s_to_T**2 * (ux**2 + vy**2 + ux*vy + 0.25*(uy+vx)**2 + eps_min**2))**((1.-n_g)/(2.*n_g)) -! CS%ice_visc(i,j) =1e15*(G%areaT(i,j) * ISS%h_shelf(i,j)) ! constant viscocity for debugging + CS%ice_visc(i,j) =1e14*(G%areaT(i,j) * ISS%h_shelf(i,j)) ! constant viscocity for debugging ! umid = ((u_shlf(I,J) + u_shlf(I-1,J-1)) + (u_shlf(I,J-1) + u_shlf(I-1,J))) * 0.25 ! vmid = ((v_shlf(I,J) + v_shlf(I-1,J-1)) + (v_shlf(I,J-1) + v_shlf(I-1,J))) * 0.25 ! unorm = sqrt(umid**2 + vmid**2 + eps_min**2*(G%dxT(i,j)**2 + G%dyT(i,j)**2)) @@ -2644,183 +2608,6 @@ subroutine calc_shelf_visc(CS, ISS, G, US, u_shlf, v_shlf) enddo enddo -! do j=jsc-1,jec+1 -! do i=isc-1,iec+1 -!! do j=jsd+1,jed!-1 OVS 02/01/21 -!! do i=isd+1,ied!-1 OVS 02/01/21 - -! if (ISS%hmask(i,j) == 1) then -! CS%ice_visc(i,j) = 0.5 * Visc_coef * (G%areaT(i,j) * ISS%h_shelf(i,j)) * & -! (US%s_to_T**2 * (ux(i,j)**2 + vy(i,j)**2 + ux(i,j)*vy(i,j) + 0.25*(uy(i,j)+vx(i,j))**2 + eps_min**2))**((1.-n_g)/(2.*n_g)) -! endif -! enddo -! enddo - -! xquad(1) = .5 * (1-sqrt(1./3)) ; xquad(2) = .5 * (1+sqrt(1./3)) -! do j=jsc-1,jec+1 -! do i=isc-1,iec+1 -! cnt = 0 -! ux = 0 -! uy = 0 -! vx = 0 -! vy = 0 -! dxh = G%dxT(i,j) -! dyh = G%dyT(i,j) - -! if (ISS%hmask(i,j) == 1) then ! we are inside the global computational bdry, at an ice-filled cell - -! call bilinear_shape_fn_grid(G, i, j, Phi) -! do jq = 1,2 -! do iq = 1,2 - -! ux = u_shlf(I-1,J-1) * Phi(1,2*(jq-1)+iq) + & -! u_shlf(I,J-1) * Phi(3,2*(jq-1)+iq) + & -! u_shlf(I-1,J) * Phi(5,2*(jq-1)+iq) + & -! u_shlf(I,J) * Phi(7,2*(jq-1)+iq) - -! vx = v_shlf(I-1,J-1) * Phi(1,2*(jq-1)+iq) + & -! v_shlf(I,J-1) * Phi(3,2*(jq-1)+iq) + & -! v_shlf(I-1,J) * Phi(5,2*(jq-1)+iq) + & -! v_shlf(I,J) * Phi(7,2*(jq-1)+iq) - -! uy = u_shlf(I-1,J-1) * Phi(2,2*(jq-1)+iq) + & -! u_shlf(I,J-1) * Phi(4,2*(jq-1)+iq) + & -! u_shlf(I-1,J) * Phi(6,2*(jq-1)+iq) + & -! u_shlf(I,J) * Phi(8,2*(jq-1)+iq) - -! vy = v_shlf(I-1,J-1) * Phi(2,2*(jq-1)+iq) + & -! v_shlf(I,J-1) * Phi(4,2*(jq-1)+iq) + & -! v_shlf(I-1,J) * Phi(6,2*(jq-1)+iq) + & -! v_shlf(I,J) * Phi(8,2*(jq-1)+iq) -! enddo -! enddo - ! calculate sx -! if ((i+i_off) == gisc) then ! at left computational bdry -! if (ISS%hmask(i+1,j) == 1) then -! ux = (u_shlf(i+1,j)-u_shlf(i,j))/dxh -! vx = (v_shlf(i+1,j)-v_shlf(i,j))/dxh -! else -! ux = 0 -! vx = 0 -! endif -! elseif ((i+i_off) == giec) then ! at east computational bdry -! if (ISS%hmask(i-1,j) == 1) then -! ux = (u_shlf(i,j)-u_shlf(i-1,j))/dxh -! vx = (v_shlf(i,j)-v_shlf(i-1,j))/dxh -! else -! ux = 0 -! vx = 0 -! endif -! else ! interior -! if (ISS%hmask(i+1,j) == 1) then -! cnt = cnt+1 -! ux = u_shlf(i+1,j) -! vx = v_shlf(i+1,j) -! else -! ux = u_shlf(i,j) -! vx = v_shlf(i,j) -! endif -! if (ISS%hmask(i-1,j) == 1) then -! cnt = cnt+1 -! ux = ux - u_shlf(i-1,j) -! vx = vx - v_shlf(i-1,j) -! else -! ux = ux - u_shlf(i,j) -! vx = vx - v_shlf(i,j) -! endif -! if (cnt == 0) then -! ux = 0 -! vx = 0 -! else -! ux = ux / (cnt * dxh) -! vx = vx / (cnt * dxh) -! endif -!! endif -! cnt = 0 - - ! calculate sy, similarly -! if ((j+j_off) == gjsc) then ! at south computational bdry -! if (ISS%hmask(i,j+1) == 1) then -! uy = (u_shlf(i,j+1)-u_shlf(i,j))/dyh -! vy = (v_shlf(i,j+1)-v_shlf(i,j))/dyh -! else -! vy = 0 -! endif -! elseif ((j+j_off) == gjec) then ! at nprth computational bdry -! if (ISS%hmask(i,j-1) == 1) then -! uy = (u_shlf(i,j)-u_shlf(i,j-1))/dyh -! vy = (v_shlf(i,j)-v_shlf(i,j-1))/dyh -! else -! uy = 0 -! vy = 0 -! endif -! else ! interior -! if (ISS%hmask(i,j+1) == 1) then -! cnt = cnt+1 -! uy = u_shlf(i,j+1) -! vy = v_shlf(i,j+1) -! else -! uy = u_shlf(i,j) -! vy = v_shlf(i,j) -! endif -! if (ISS%hmask(i,j-1) == 1) then -! cnt = cnt+1 -! uy = uy - u_shlf(i,j-1) -! vy = vy - v_shlf(i,j-1) -! else -! uy = uy - u_shlf(i,j) -! vy = vy - v_shlf(i,j) -! endif -! if (cnt == 0) then -! uy = 0 -! vy = 0 -! else -! uy = uy / (cnt * dyh) -! vy = vy / (cnt * dyh) -! endif -!! endif - -! ! SW vertex -! if (ISS%hmask(I-1,J-1) == 1) then -! eII(i-1,j-1) = eII(i-1,j-1)+.125*(US%s_to_T**2 * (ux**2 + vy**2 + ux*vy + 0.25*(uy+vx)**2 + eps_min**2)) -! endif - ! SE vertex -! if (ISS%hmask(I,J-1) == 1) then -! eII(i,j-1) = eII(i,j-1)+.125*(US%s_to_T**2 * (ux**2 + vy**2 + ux*vy + 0.25*(uy+vx)**2 + eps_min**2)) - -! CS%ice_visc(i,j-1) = CS%ice_visc(i,j-1)+.25*0.5 * Visc_coef * (G%areaT(i,j) * ISS%h_shelf(i,j)) * & -! (US%s_to_T**2 * (ux**2 + vy**2 + ux*vy + 0.25*(uy+vx)**2 + eps_min**2))**((1.-n_g)/(2.*n_g)) -! endif - ! NW vertex -! if (ISS%hmask(I-1,J) == 1) then -! eII(i-1,j) = eII(i-1,j)+.125*(US%s_to_T**2 * (ux**2 + vy**2 + ux*vy + 0.25*(uy+vx)**2 + eps_min**2)) - -! CS%ice_visc(i-1,j) = CS%ice_visc(i-1,j)+.25*0.5 * Visc_coef * (G%areaT(i,j) * ISS%h_shelf(i,j)) * & -! (US%s_to_T**2 * (ux**2 + vy**2 + ux*vy + 0.25*(uy+vx)**2 + eps_min**2))**((1.-n_g)/(2.*n_g)) -! endif - ! NE vertex -! if (ISS%hmask(I,J) == 1) then -! eII(i,j) = eII(i,j)+.25*(US%s_to_T**2 * (ux**2 + vy**2 + ux*vy + 0.25*(uy+vx)**2 + eps_min**2)) -! eII(i,j) = (US%s_to_T**2 * (ux**2 + vy**2 + ux*vy + 0.25*(uy+vx)**2 + eps_min**2)) - -! CS%ice_visc(i,j) = CS%ice_visc(i,j)+.25*0.5 * Visc_coef * (G%areaT(i,j) * ISS%h_shelf(i,j)) * & -! (US%s_to_T**2 * (ux**2 + vy**2 + ux*vy + 0.25*(uy+vx)**2 + eps_min**2))**((1.-n_g)/(2.*n_g)) -! endif -! if (ISS%hmask(I+1,J+1) == 1) then -! eII(i+1,j+1) = eII(i+1,j+1)+.125*(US%s_to_T**2 * (ux**2 + vy**2 + ux*vy + 0.25*(uy+vx)**2 + eps_min**2)) -! endif -! if (ISS%hmask(I,J+1) == 1) then -! eII(i,j+1) = eII(i,j+1)+.125*(US%s_to_T**2 * (ux**2 + vy**2 + ux*vy + 0.25*(uy+vx)**2 + eps_min**2)) -! endif -! if (ISS%hmask(I+1,J) == 1) then -! eII(i+1,j) = eII(i+1,j)+.125*(US%s_to_T**2 * (ux**2 + vy**2 + ux*vy + 0.25*(uy+vx)**2 + eps_min**2)) -! endif -! CS%ice_visc(i,j) =0.5 * Visc_coef*(G%areaT(i,j) * ISS%h_shelf(i,j))*eII(i,j)**((1.-n_g)/(2.*n_g)) -! endif -! CS%ice_visc(i,j) =0.5 * Visc_coef*(G%areaT(i,j) * ISS%h_shelf(i,j))*eII(i,j)**((1.-n_g)/(2.*n_g)) - ! CS%ice_visc(i,j) =1e15*(G%areaT(i,j) * ISS%h_shelf(i,j)) !constant viscosity for debugging -! enddo -! enddo end subroutine calc_shelf_visc subroutine calc_shelf_taub(CS, ISS, G, US, u_shlf, v_shlf) @@ -3181,7 +2968,7 @@ subroutine update_velocity_masks(CS, G, hmask, umask, vmask, u_face_mask, v_face umask(I-1+k,J)=3. !vmask(I-1+k,J)=0. vmask(I-1+k,J)=3. - !u_face_mask(I-1+k,j-1)=3. + !u_face_mask(I-1+k,j-1)=3. ! umask(I-1+k,J-1:J)=3. ! vmask(I-1+k,J-1:J)=0. ! u_face_mask(I-1+k,j)=3. diff --git a/src/ice_shelf/MOM_ice_shelf_initialize.F90 b/src/ice_shelf/MOM_ice_shelf_initialize.F90 index f9f31a373e..d77efa358b 100644 --- a/src/ice_shelf/MOM_ice_shelf_initialize.F90 +++ b/src/ice_shelf/MOM_ice_shelf_initialize.F90 @@ -269,7 +269,7 @@ end subroutine initialize_ice_thickness_channel !> Initialize ice shelf boundary conditions for a channel configuration subroutine initialize_ice_shelf_boundary_channel(u_face_mask_bdry, v_face_mask_bdry, & u_flux_bdry_val, v_flux_bdry_val, u_bdry_val, v_bdry_val, u_shelf, v_shelf, h_bdry_val, & - thickness_bdry_val, hmask, h_shelf, G,& + thickness_bdry_val, hmask, h_shelf, G,& US, PF ) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure @@ -289,9 +289,9 @@ subroutine initialize_ice_shelf_boundary_channel(u_face_mask_bdry, v_face_mask_b real, dimension(SZIB_(G),SZJB_(G)), & intent(inout) :: v_bdry_val !< The meridional ice shelf velocity at open real, dimension(SZIB_(G),SZJB_(G)), & - intent(inout) :: u_shelf !< The zonal ice shelf velocity [L T-1 ~> m s-1]. + intent(inout) :: u_shelf !< The zonal ice shelf velocity [L T-1 ~> m s-1]. real, dimension(SZIB_(G),SZJB_(G)), & - intent(inout) :: v_shelf !< The meridional ice shelf velocity [L T-1 ~> m s-1]. + intent(inout) :: v_shelf !< The meridional ice shelf velocity [L T-1 ~> m s-1]. real, dimension(SZDI_(G),SZDJ_(G)), & intent(inout) :: thickness_bdry_val !< The ice shelf thickness at open boundaries [Z ~> m] !! boundary vertices [L T-1 ~> m s-1]. @@ -301,7 +301,7 @@ subroutine initialize_ice_shelf_boundary_channel(u_face_mask_bdry, v_face_mask_b intent(inout) :: hmask !< A mask indicating which tracer points are !! partly or fully covered by an ice-shelf real, dimension(SZDI_(G),SZDJ_(G)), & - intent(inout) :: h_shelf !< Ice-shelf thickness OVS 11/10/20 + intent(inout) :: h_shelf !< Ice-shelf thickness OVS 11/10/20 type(unit_scale_type), intent(in) :: US !< A structure containing unit conversion factors type(param_file_type), intent(in) :: PF !< A structure to parse for run-time parameters @@ -367,26 +367,26 @@ subroutine initialize_ice_shelf_boundary_channel(u_face_mask_bdry, v_face_mask_b if (G%geoLatBu(i,j-1) == southlat) then !bot boundary if (len_stress == 0. .OR. G%geoLonCv(i,j) <= len_stress) then v_face_mask_bdry(i,j+1) = 0. - ! u_face_mask_bdry(i,j-1) = 3. - u_face_mask_bdry(i,j) = 3. + ! u_face_mask_bdry(i,j-1) = 3. + u_face_mask_bdry(i,j) = 3. u_bdry_val(i,j) = 0. - v_bdry_val(i,j) = 0. + v_bdry_val(i,j) = 0. else v_face_mask_bdry(i,j+1) = 1. - u_face_mask_bdry(i,j) = 3. + u_face_mask_bdry(i,j) = 3. u_bdry_val(i,j) = 0. - v_bdry_val(i,j) = 0. + v_bdry_val(i,j) = 0. endif elseif (G%geoLatBu(i,j-1) == southlat+lenlat) then !top boundary if (len_stress == 0. .OR. G%geoLonCv(i,j) <= len_stress) then v_face_mask_bdry(i,j-1) = 0. - u_face_mask_bdry(i,j-1) = 3. + u_face_mask_bdry(i,j-1) = 3. else !v_face_mask_bdry(i,j-1) = 1. - v_face_mask_bdry(i,j-1) = 3. - u_face_mask_bdry(i,j-1) = 3. - !u_bdry_val(i,j) = 0. - !hmask(i,j) = 0.0 + v_face_mask_bdry(i,j-1) = 3. + u_face_mask_bdry(i,j-1) = 3. + !u_bdry_val(i,j) = 0. + !hmask(i,j) = 0.0 endif endif @@ -396,9 +396,9 @@ subroutine initialize_ice_shelf_boundary_channel(u_face_mask_bdry, v_face_mask_b endif enddo - enddo + enddo ! if (.not. G%symmetric) then -!! do j=G%jsd,G%jed +!! do j=G%jsd,G%jed !! do i=G%isd,G%ied ! do j=jsc-1,jec+1 ! do i=isc-1,iec+1 @@ -416,7 +416,7 @@ subroutine initialize_ice_shelf_boundary_channel(u_face_mask_bdry, v_face_mask_b ! v_shelf(I-1,J-1) = v_bdry_val(I-1,J-1) ! v_shelf(I,J-1) = v_bdry_val(I,J-1) ! endif -! enddo +! enddo ! enddo ! endif end subroutine initialize_ice_shelf_boundary_channel @@ -583,7 +583,8 @@ end subroutine initialize_ice_shelf_boundary_channel !END MJH end subroutine initialize_ice_shelf_boundary_channel !> Initialize ice shelf flow from file -subroutine initialize_ice_flow_from_file(u_shelf, v_shelf,ice_visc,float_cond, hmask,h_shelf, G, US, PF) +subroutine initialize_ice_flow_from_file(u_shelf, v_shelf,ice_visc,float_cond,& + hmask,h_shelf, G, US, PF) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure real, dimension(SZDI_(G),SZDJ_(G)), & intent(inout) :: u_shelf !< The ice shelf u velocity [Z ~> m T ~>s]. @@ -593,13 +594,13 @@ subroutine initialize_ice_flow_from_file(u_shelf, v_shelf,ice_visc,float_cond, h intent(inout) :: ice_visc !< The ice shelf viscosity [Pa ~> m T ~> s]. real, dimension(SZDI_(G),SZDJ_(G)), & intent(inout) :: float_cond !< An array indicating where the ice - !! shelf is floating: 0 if floating, 1 if not. + !! shelf is floating: 0 if floating, 1 if not. real, dimension(SZDI_(G),SZDJ_(G)), & intent(in) :: hmask !< A mask indicating which tracer points are !! partly or fully covered by an ice-shelf real, dimension(SZDI_(G),SZDJ_(G)), & intent(in) :: h_shelf !< A mask indicating which tracer points are - !! partly or fully covered by an ice-shelf + !! partly or fully covered by an ice-shelf type(unit_scale_type), intent(in) :: US !< A structure containing unit conversion factors type(param_file_type), intent(in) :: PF !< A structure to parse for run-time parameters From aed4f0ee71e4c6e179ebe196e6b4d48935c76ee1 Mon Sep 17 00:00:00 2001 From: Olga Sergienko Date: Wed, 3 Mar 2021 16:35:41 -0500 Subject: [PATCH 26/35] More style errors --- src/ice_shelf/MOM_ice_shelf_dynamics.F90 | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 index 8640902989..4abcda0aa0 100644 --- a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 +++ b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 @@ -160,8 +160,9 @@ module MOM_ice_shelf_dynamics id_u_mask = -1, id_v_mask = -1, id_t_mask = -1 !>@} ! ids for outputting intermediate thickness in advection subroutine (debugging) + !>@{ Diagnostic handles for debugging integer :: id_h_after_uflux = -1, id_h_after_vflux = -1, id_h_after_adv = -1, id_visc_shelf = -1 - + !>@} type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to control diagnostic output. end type ice_shelf_dyn_CS @@ -809,8 +810,9 @@ subroutine ice_shelf_advect(CS, ISS, G, time_step, Time) end subroutine ice_shelf_advect +!>This subroutine computes u- and v-velocities of the ice shelf iterating on non-linear ice viscosity !subroutine ice_shelf_solve_outer(CS, ISS, G, US, u_shlf, v_shlf, iters, time) - subroutine ice_shelf_solve_outer(CS, ISS, G, US, u_shlf, v_shlf,taudx,taudy, iters, Time) !OVS 02/08/21 + subroutine ice_shelf_solve_outer(CS, ISS, G, US, u_shlf, v_shlf,taudx,taudy, iters, Time) type(ice_shelf_dyn_CS), intent(inout) :: CS !< The ice shelf dynamics control structure type(ice_shelf_state), intent(in) :: ISS !< A structure with elements that describe !! the ice-shelf state @@ -823,7 +825,7 @@ subroutine ice_shelf_solve_outer(CS, ISS, G, US, u_shlf, v_shlf,taudx,taudy, ite integer, intent(out) :: iters !< The number of iterations used in the solver. type(time_type), intent(in) :: Time !< The current model time - real, dimension(SZDIB_(G),SZDJB_(G)) :: taudx, taudy ! Driving stresses at q-points [R L3 Z T-2 ~> kg m s-2] + real, dimension(SZDIB_(G),SZDJB_(G)) :: taudx, taudy !< Driving stresses at q-points [R L3 Z T-2 ~> kg m s-2] real, dimension(SZDIB_(G),SZDJB_(G)) :: u_bdry_cont ! Boundary u-stress contribution [R L3 Z T-2 ~> kg m s-2] real, dimension(SZDIB_(G),SZDJB_(G)) :: v_bdry_cont ! Boundary v-stress contribution [R L3 Z T-2 ~> kg m s-2] real, dimension(SZDIB_(G),SZDJB_(G)) :: Au, Av ! The retarding lateral stress contributions [R L3 Z T-2 ~> kg m s-2] From 43dadc16a357c891df640400c4cb7902e3064e5d Mon Sep 17 00:00:00 2001 From: Olga Sergienko Date: Wed, 3 Mar 2021 17:11:13 -0500 Subject: [PATCH 27/35] Defined variables in ice_shelf_solve_outer --- src/ice_shelf/MOM_ice_shelf_dynamics.F90 | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 index 4abcda0aa0..299eda4f33 100644 --- a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 +++ b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 @@ -825,7 +825,10 @@ subroutine ice_shelf_solve_outer(CS, ISS, G, US, u_shlf, v_shlf,taudx,taudy, ite integer, intent(out) :: iters !< The number of iterations used in the solver. type(time_type), intent(in) :: Time !< The current model time - real, dimension(SZDIB_(G),SZDJB_(G)) :: taudx, taudy !< Driving stresses at q-points [R L3 Z T-2 ~> kg m s-2] + real, dimension(SZDIB_(G),SZDJB_(G)), & + intent(out) :: taudx !< Driving x-stress at q-points [R L3 Z T-2 ~> kg m s-2] + real, dimension(SZDIB_(G),SZDJB_(G)), & + intent(out) :: taudy !< Driving y-stress at q-points [R L3 Z T-2 ~> kg m s-2] real, dimension(SZDIB_(G),SZDJB_(G)) :: u_bdry_cont ! Boundary u-stress contribution [R L3 Z T-2 ~> kg m s-2] real, dimension(SZDIB_(G),SZDJB_(G)) :: v_bdry_cont ! Boundary v-stress contribution [R L3 Z T-2 ~> kg m s-2] real, dimension(SZDIB_(G),SZDJB_(G)) :: Au, Av ! The retarding lateral stress contributions [R L3 Z T-2 ~> kg m s-2] @@ -2601,7 +2604,7 @@ subroutine calc_shelf_visc(CS, ISS, G, US, u_shlf, v_shlf) ! vy = ((v_shlf(I,J) + v_shlf(I-1,J)) - (v_shlf(I,J-1) + v_shlf(I-1,J-1))) / (2*G%dyT(i,j)) CS%ice_visc(i,j) = 0.5 * Visc_coef * (G%areaT(i,j) * ISS%h_shelf(i,j)) * & (US%s_to_T**2 * (ux**2 + vy**2 + ux*vy + 0.25*(uy+vx)**2 + eps_min**2))**((1.-n_g)/(2.*n_g)) - CS%ice_visc(i,j) =1e14*(G%areaT(i,j) * ISS%h_shelf(i,j)) ! constant viscocity for debugging +! CS%ice_visc(i,j) =1e14*(G%areaT(i,j) * ISS%h_shelf(i,j)) ! constant viscocity for debugging ! umid = ((u_shlf(I,J) + u_shlf(I-1,J-1)) + (u_shlf(I,J-1) + u_shlf(I-1,J))) * 0.25 ! vmid = ((v_shlf(I,J) + v_shlf(I-1,J-1)) + (v_shlf(I,J-1) + v_shlf(I-1,J))) * 0.25 ! unorm = sqrt(umid**2 + vmid**2 + eps_min**2*(G%dxT(i,j)**2 + G%dyT(i,j)**2)) From 651b4673f46a83f5fc741feaafe9cc0586e4bb0b Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Sat, 6 Mar 2021 01:19:08 -0500 Subject: [PATCH 28/35] Bugfix: FGNV streamfunction vertical bounds This patch fixes an issue with the vertical array bounds of the Ferrari et al. streamfunction. The array is bounded across interfaces, from 1 to nz+1, but only the interior values need to be determined due to the arbitrary boundary value (set here to zero). In the current source, the streamfunction is rescaled before calling streamfn_solver, but need not be applied to the boundary values. This is unlikely to cause errors in production, since the values are later reset to zero, but the rescaling can raise errors in more aggressive debugging builds, such as when the arrays are initialized with NaN values. --- .../lateral/MOM_thickness_diffuse.F90 | 16 ++++++++++++---- 1 file changed, 12 insertions(+), 4 deletions(-) diff --git a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 index 8c6a90ba9c..4d602f9a67 100644 --- a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 +++ b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 @@ -993,10 +993,14 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV ! Solve an elliptic equation for the streamfunction following Ferrari et al., 2010. do I=is-1,ie if (G%mask2dCu(I,j)>0.) then - Sfn_unlim_u(I,:) = ( 1. + CS%FGNV_scale ) * Sfn_unlim_u(I,:) + do K=2,nz + Sfn_unlim_u(I,K) = (1. + CS%FGNV_scale) * Sfn_unlim_u(I,K) + enddo call streamfn_solver(nz, c2_h_u(I,:), hN2_u(I,:), Sfn_unlim_u(I,:)) else - Sfn_unlim_u(I,:) = 0. + do K=2,nz + Sfn_unlim_u(I,K) = 0. + enddo endif enddo endif @@ -1259,10 +1263,14 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV ! Solve an elliptic equation for the streamfunction following Ferrari et al., 2010. do i=is,ie if (G%mask2dCv(i,J)>0.) then - Sfn_unlim_v(i,:) = ( 1. + CS%FGNV_scale ) * Sfn_unlim_v(i,:) + do K=2,nz + Sfn_unlim_v(i,K) = (1. + CS%FGNV_scale) * Sfn_unlim_v(i,K) + enddo call streamfn_solver(nz, c2_h_v(i,:), hN2_v(i,:), Sfn_unlim_v(i,:)) else - Sfn_unlim_v(i,:) = 0. + do K=2,nz + Sfn_unlim_v(i,K) = 0. + enddo endif enddo endif From b47e493d3ba28ac5544c22231a8cfb4e88feeed8 Mon Sep 17 00:00:00 2001 From: Olga Sergienko Date: Tue, 9 Mar 2021 13:15:10 -0500 Subject: [PATCH 29/35] Removed blocks of commented code. Added parentheses in calc_shelf_visc --- src/ice_shelf/MOM_ice_shelf_dynamics.F90 | 56 ++----- src/ice_shelf/MOM_ice_shelf_initialize.F90 | 184 +-------------------- 2 files changed, 18 insertions(+), 222 deletions(-) diff --git a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 index 299eda4f33..6b30b2d83d 100644 --- a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 +++ b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 @@ -579,12 +579,11 @@ subroutine initialize_ice_shelf_dyn(param_file, Time, ISS, CS, G, US, diag, new_ if (CS%id_taudx_shelf > 0) call post_data(CS%id_taudx_shelf, CS%taudx_shelf,CS%diag) if (CS%id_taudy_shelf > 0) call post_data(CS%id_taudy_shelf, CS%taudy_shelf,CS%diag) if (CS%id_visc_shelf > 0) call post_data(CS%id_visc_shelf, CS%ice_visc,CS%diag) - endif -!!! OVS vertically integrated temperature ! CS%id_t_shelf = register_diag_field('ocean_model','t_shelf',CS%diag%axesT1, Time, & ! 'T of ice', 'oC') ! CS%id_t_mask = register_diag_field('ocean_model','tmask',CS%diag%axesT1, Time, & ! 'mask for T-nodes', 'none') + endif endif end subroutine initialize_ice_shelf_dyn @@ -875,9 +874,7 @@ subroutine ice_shelf_solve_outer(CS, ISS, G, US, u_shlf, v_shlf,taudx,taudy, ite enddo call calc_shelf_driving_stress(CS, ISS, G, US, taudx, taudy, CS%OD_av) - call pass_vector(taudx, taudy, G%domain, TO_ALL, BGRID_NE) !OVS 02/01/21 -! call pass_var(taudx, G%Domain) !OVS 01/21/21 -! call pass_var(taudy, G%Domain) !OVS 01/21/21 + call pass_vector(taudx, taudy, G%domain, TO_ALL, BGRID_NE) ! This is to determine which cells contain the grounding line, the criterion being that the cell ! is ice-covered, with some nodes floating and some grounded flotation condition is estimated by ! assuming topography is cellwise constant and H is bilinear in a cell; floating where @@ -917,12 +914,10 @@ subroutine ice_shelf_solve_outer(CS, ISS, G, US, u_shlf, v_shlf,taudx,taudy, ite call bilinear_shape_fn_grid(G, i, j, Phi(:,:,i,j)) enddo ; enddo - call calc_shelf_visc(CS, ISS, G, US, u_shlf, v_shlf) !OVS 02/24/21 + call calc_shelf_visc(CS, ISS, G, US, u_shlf, v_shlf) call pass_var(CS%ice_visc, G%domain) -! call pass_vector(CS%ice_visc, G%domain, TO_ALL, BGRID_NE) !OVS 02/11/21 call calc_shelf_taub(CS, ISS, G, US, u_shlf, v_shlf) call pass_var(CS%basal_traction, G%domain) -! call pass_vector(CS%ice_visc,CS%basal_traction, G%domain, TO_ALL, BGRID_NE) !OVS 02/11/21 ! This makes sure basal stress is only applied when it is supposed to be do j=G%jsd,G%jed ; do i=G%isd,G%ied @@ -937,7 +932,7 @@ subroutine ice_shelf_solve_outer(CS, ISS, G, US, u_shlf, v_shlf,taudx,taudy, ite call CG_action(Au, Av, u_shlf, v_shlf, Phi, Phisub, CS%umask, CS%vmask, ISS%hmask, H_node, & CS%ice_visc, float_cond, G%bathyT, CS%basal_traction, & G, US, G%isc-1, G%iec+1, G%jsc-1, G%jec+1, rhoi_rhow) - call pass_vector(Au,Av,G%domain) !OVS pass Au and Av + call pass_vector(Au,Av,G%domain) if (CS%nonlin_solve_err_mode == 1) then err_init = 0 ; err_tempu = 0 ; err_tempv = 0 do J=G%IscB,G%JecB ; do I=G%IscB,G%IecB @@ -971,7 +966,7 @@ subroutine ice_shelf_solve_outer(CS, ISS, G, US, u_shlf, v_shlf,taudx,taudy, ite write(mesg,*) "ice_shelf_solve_outer: linear solve done in ",iters," iterations" call MOM_mesg(mesg, 5) - call calc_shelf_visc(CS, ISS, G, US, u_shlf, v_shlf) !OVS 02/24/21 + call calc_shelf_visc(CS, ISS, G, US, u_shlf, v_shlf) call pass_var(CS%ice_visc, G%domain) call calc_shelf_taub(CS, ISS, G, US, u_shlf, v_shlf) call pass_var(CS%basal_traction, G%domain) @@ -1823,10 +1818,8 @@ subroutine calc_shelf_driving_stress(CS, ISS, G, US, taudx, taudy, OD) S(:,:) = BASE(:,:) + ISS%h_shelf(:,:) ! check whether the ice is floating or grounded -! do j=jsc-1,jec+1 !OVS 02/02/21 -! do i=isc-1,iec+1 !OVS 02/02/21 - do j=jsc-G%domain%njhalo,jec+G%domain%njhalo !OVS 02/02/21 - do i=isc-G%domain%nihalo,iec+G%domain%nihalo !OVS 02/02/21 + do j=jsc-G%domain%njhalo,jec+G%domain%njhalo + do i=isc-G%domain%nihalo,iec+G%domain%nihalo ! if (ISS%h_shelf(i,j) < rhow/rho * G%bathyT(i,j)) then if (rhoi_rhow * ISS%h_shelf(i,j) - G%bathyT(i,j) <= 0) then @@ -2160,7 +2153,7 @@ subroutine CG_action(uret, vret, u_shlf, v_shlf, Phi, Phisub, umask, vmask, hmas v_shlf(I-1,J) * Phi(6,2*(jq-1)+iq,i,j) + & v_shlf(I,J) * Phi(8,2*(jq-1)+iq,i,j) - do iphi=1,2 ; do jphi=1,2 ; Itgt = I-2+iphi ; ;Jtgt = J-2+jphi !Jtgt = J-2-jphi !OVS fix index + do iphi=1,2 ; do jphi=1,2 ; Itgt = I-2+iphi ; ;Jtgt = J-2+jphi if (umask(Itgt,Jtgt) == 1) uret(Itgt,Jtgt) = uret(Itgt,Jtgt) + 0.25 * ice_visc(i,j) * & ((4*ux+2*vy) * Phi(2*(2*(jphi-1)+iphi)-1,2*(jq-1)+iq,i,j) + & (uy+vx) * Phi(2*(2*(jphi-1)+iphi),2*(jq-1)+iq,i,j)) @@ -2338,7 +2331,7 @@ subroutine matrix_diagonal(CS, G, US, float_cond, H_node, ice_visc, basal_trac, if (float_cond(i,j) == 1) then Hcell(:,:) = H_node(i-1:i,j-1:j) call CG_diagonal_subgrid_basal(Phisub, Hcell, G%bathyT(i,j), dens_ratio, sub_ground) - do iphi=1,2 ; do jphi=1,2 ; Itgt = I-2+iphi ; Jtgt = J-2+jphi !Jtgt = J-2-jphi !OVS fix index + do iphi=1,2 ; do jphi=1,2 ; Itgt = I-2+iphi ; Jtgt = J-2+jphi if (CS%umask(Itgt,Jtgt) == 1) then u_diagonal(Itgt,Jtgt) = u_diagonal(Itgt,Jtgt) + sub_ground(iphi,jphi) * basal_trac(i,j) v_diagonal(Itgt,Jtgt) = v_diagonal(Itgt,Jtgt) + sub_ground(iphi,jphi) * basal_trac(i,j) @@ -2479,7 +2472,7 @@ subroutine apply_boundary_values(CS, ISS, G, US, time, Phisub, H_node, ice_visc, CS%v_bdry_val(I-1,J) * Phi(6,2*(jq-1)+iq) + & CS%v_bdry_val(I,J) * Phi(8,2*(jq-1)+iq) - do iphi=1,2 ; do jphi=1,2 ; Itgt = I-2+iphi ; Jtgt = J-2+jphi !Jtgt = J-2-jphi !OVS fix index + do iphi=1,2 ; do jphi=1,2 ; Itgt = I-2+iphi ; Jtgt = J-2+jphi ilq = 1 ; if (iq == iphi) ilq = 2 jlq = 1 ; if (jq == jphi) jlq = 2 @@ -2590,14 +2583,14 @@ subroutine calc_shelf_visc(CS, ISS, G, US, u_shlf, v_shlf) ! enddo ! call pass_vector(ux, uy, G%domain, TO_ALL, BGRID_NE) ! call pass_vector(vx, vy, G%domain, TO_ALL, BGRID_NE) - ux = ((u_shlf(I,J) + u_shlf(I,J-1) + u_shlf(I,J+1)) - & - (u_shlf(I-1,J) + u_shlf(I-1,J-1) + u_shlf(I-1,J+1))) / (3*G%dxT(i,j)) + ux = ((u_shlf(I,J) + (u_shlf(I,J-1) + u_shlf(I,J+1))) - & + (u_shlf(I-1,J) + (u_shlf(I-1,J-1) + u_shlf(I-1,J+1)))) / (3*G%dxT(i,j)) vx = ((v_shlf(I,J) + v_shlf(I,J-1) + v_shlf(I,J+1)) - & - (v_shlf(I-1,J) + v_shlf(I-1,J-1) + v_shlf(I-1,J+1))) / (3*G%dxT(i,j)) - uy = ((u_shlf(I,J) + u_shlf(I-1,J) + u_shlf(I+1,J)) - & - (u_shlf(I,J-1) + u_shlf(I-1,J-1) + u_shlf(I+1,J-1))) / (3*G%dyT(i,j)) - vy = ((v_shlf(I,J) + v_shlf(I-1,J)+ v_shlf(I+1,J)) - & - (v_shlf(I,J-1) + v_shlf(I-1,J-1)+ v_shlf(I+1,J-1))) / (3*G%dyT(i,j)) + (v_shlf(I-1,J) + (v_shlf(I-1,J-1) + v_shlf(I-1,J+1)))) / (3*G%dxT(i,j)) + uy = ((u_shlf(I,J) + (u_shlf(I-1,J) + u_shlf(I+1,J))) - & + (u_shlf(I,J-1) + (u_shlf(I-1,J-1) + u_shlf(I+1,J-1)))) / (3*G%dyT(i,j)) + vy = ((v_shlf(I,J) + (v_shlf(I-1,J)+ v_shlf(I+1,J))) - & + (v_shlf(I,J-1) + (v_shlf(I-1,J-1)+ v_shlf(I+1,J-1)))) / (3*G%dyT(i,j)) ! ux = ((u_shlf(I,J) + u_shlf(I,J-1)) - (u_shlf(I-1,J) + u_shlf(I-1,J-1))) / (2*G%dxT(i,j)) ! vx = ((v_shlf(I,J) + v_shlf(I,J-1)) - (v_shlf(I-1,J) + v_shlf(I-1,J-1))) / (2*G%dxT(i,j)) ! uy = ((u_shlf(I,J) + u_shlf(I-1,J)) - (u_shlf(I,J-1) + u_shlf(I-1,J-1))) / (2*G%dyT(i,j)) @@ -3020,21 +3013,6 @@ subroutine update_velocity_masks(CS, G, hmask, umask, vmask, u_face_mask, v_face end select enddo - !if (CS%u_face_mask_bdry(I-1,j) >= 0) then ! Western boundary - ! u_face_mask(I-1,j) = CS%u_face_mask_bdry(I-1,j) - ! umask(I-1,J-1:J) = 3. - ! vmask(I-1,J-1:J) = 0. - !endif - - !if (j_off+j == gjsc+1) then ! SoutherN boundary - ! v_face_mask(i,J-1) = 0. - ! umask(I-1:I,J-1) = 0. - ! vmask(I-1:I,J-1) = 0. - !elseif (j_off+j == gjec) then ! Northern boundary - ! v_face_mask(i,J) = 0. - ! umask(I-1:I,J) = 0. - ! vmask(I-1:I,J) = 0. - !endif if (i < G%ied) then if ((hmask(i+1,j) == 0) .OR. (hmask(i+1,j) == 2)) then diff --git a/src/ice_shelf/MOM_ice_shelf_initialize.F90 b/src/ice_shelf/MOM_ice_shelf_initialize.F90 index d77efa358b..ff05ed7c6a 100644 --- a/src/ice_shelf/MOM_ice_shelf_initialize.F90 +++ b/src/ice_shelf/MOM_ice_shelf_initialize.F90 @@ -397,190 +397,8 @@ subroutine initialize_ice_shelf_boundary_channel(u_face_mask_bdry, v_face_mask_b enddo enddo -! if (.not. G%symmetric) then -!! do j=G%jsd,G%jed -!! do i=G%isd,G%ied -! do j=jsc-1,jec+1 -! do i=isc-1,iec+1 -!! if (((i+G%idg_offset) == (G%domain%nihalo+1)).and.(u_face_mask_bdry(I-1,j) == 3)) then -! if (u_face_mask_bdry(I-1,j) == 3) then -! u_shelf(I-1,J-1) = u_bdry_val(I-1,J-1) -! u_shelf(I-1,J) = u_bdry_val(I-1,J) -! v_shelf(I-1,J-1) = v_bdry_val(I-1,J-1) -! v_shelf(I-1,J) = v_bdry_val(I-1,J) -! endif -!! if (((j+G%jdg_offset) == (G%domain%njhalo+1)).and.(v_face_mask_bdry(i,J-1) == 3)) then -! if (v_face_mask_bdry(I,j-1) == 3) then -! u_shelf(I-1,J-1) = u_bdry_val(I-1,J-1) -! u_shelf(I,J-1) = u_bdry_val(I,J-1) -! v_shelf(I-1,J-1) = v_bdry_val(I-1,J-1) -! v_shelf(I,J-1) = v_bdry_val(I,J-1) -! endif -! enddo -! enddo -! endif end subroutine initialize_ice_shelf_boundary_channel -!BEGIN MJH -! subroutine initialize_ice_shelf_boundary(u_face_mask_bdry, v_face_mask_bdry, & -! u_flux_bdry_val, v_flux_bdry_val, u_bdry_val, v_bdry_val, h_bdry_val, & -! hmask, G, US, PF ) - -! type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure -! real, dimension(SZIB_(G),SZJ_(G)), & -! intent(inout) :: u_face_mask_bdry !< A boundary-type mask at C-grid u faces -! real, dimension(SZIB_(G),SZJ_(G)), & -! intent(inout) :: u_flux_bdry_val !< The boundary thickness flux through -! !! C-grid u faces [L Z T-1 ~> m2 s-1]. -! real, dimension(SZI_(G),SZJB_(G)), & -! intent(inout) :: v_face_mask_bdry !< A boundary-type mask at C-grid v faces -! real, dimension(SZI_(G),SZJB_(G)), & -! intent(inout) :: v_flux_bdry_val !< The boundary thickness flux through -! !! C-grid v faces [L Z T-1 ~> m2 s-1]. -! real, dimension(SZIB_(G),SZJB_(G)), & -! intent(inout) :: u_bdry_val !< The zonal ice shelf velocity at open -! !! boundary vertices [L T-1 ~> m s-1]. -! real, dimension(SZIB_(G),SZJB_(G)), & -! intent(inout) :: v_bdry_val !< The meridional ice shelf velocity at open -! !! boundary vertices [L T-1 ~> m s-1]. -! real, dimension(SZDI_(G),SZDJ_(G)), & -! intent(inout) :: h_bdry_val !< The ice shelf thickness at open boundaries [Z ~> m] -! real, dimension(SZDI_(G),SZDJ_(G)), & -! intent(inout) :: hmask !< A mask indicating which tracer points are -! !! partly or fully covered by an ice-shelf -! type(unit_scale_type), intent(in) :: US !< A structure containing unit conversion factors -! type(param_file_type), intent(in) :: PF !< A structure to parse for run-time parameters - -! character(len=40) :: mdl = "initialize_ice_shelf_boundary" ! This subroutine's name. -! character(len=200) :: config -! logical flux_bdry - -! call get_param(PF, mdl, "ICE_BOUNDARY_CONFIG", config, & -! "This specifies how the ice domain boundary is specified. "//& -! "valid values include CHANNEL, FILE and USER.", & -! fail_if_missing=.true.) -! call get_param(PF, mdl, "ICE_BOUNDARY_FLUX_CONDITION", flux_bdry, & -! "This specifies whether mass input is a dirichlet or "//& -! "flux condition", default=.true.) - -! select case ( trim(config) ) -! case ("CHANNEL") -! call initialize_ice_shelf_boundary_channel(u_face_mask_bdry, & -! v_face_mask_bdry, u_flux_bdry_val, v_flux_bdry_val, & -! u_bdry_val, v_bdry_val, h_bdry_val, hmask, G, & -! flux_bdry, PF) -! case ("FILE"); call MOM_error(FATAL,"MOM_initialize: "// & -! "Unrecognized topography setup "//trim(config)) -! case ("USER"); call MOM_error(FATAL,"MOM_initialize: "// & -! "Unrecognized topography setup "//trim(config)) -! case default ; call MOM_error(FATAL,"MOM_initialize: "// & -! "Unrecognized topography setup "//trim(config)) -! end select - -! end subroutine initialize_ice_shelf_boundary - -! subroutine initialize_ice_shelf_boundary_channel(u_face_mask_bdry, v_face_mask_bdry, & -! u_flux_bdry_val, v_flux_bdry_val, u_bdry_val, v_bdry_val, h_bdry_val, & -! hmask, G, flux_bdry, US, PF ) - -! type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure -! real, dimension(SZIB_(G),SZJ_(G)), & -! intent(inout) :: u_face_mask_bdry !< A boundary-type mask at C-grid u faces -! real, dimension(SZIB_(G),SZJ_(G)), & -! intent(inout) :: u_flux_bdry_val !< The boundary thickness flux through -! !! C-grid u faces [L Z T-1 ~> m2 s-1]. -! real, dimension(SZI_(G),SZJB_(G)), & -! intent(inout) :: v_face_mask_bdry !< A boundary-type mask at C-grid v faces -! real, dimension(SZI_(G),SZJB_(G)), & -! intent(inout) :: v_flux_bdry_val !< The boundary thickness flux through -! !! C-grid v faces [L Z T-1 ~> m2 s-1]. -! real, dimension(SZIB_(G),SZJB_(G)), & -! intent(inout) :: u_bdry_val !< The zonal ice shelf velocity at open - !! boundary vertices [L T-1 ~> m s-1]. -! real, dimension(SZIB_(G),SZJB_(G)), & -! intent(inout) :: v_bdry_val !< The meridional ice shelf velocity at open - !! boundary vertices [L T-1 ~> m s-1]. -! real, dimension(SZDI_(G),SZDJ_(G)), & -! intent(inout) :: h_bdry_val !< The ice shelf thickness at open boundaries [Z ~> m] -! real, dimension(SZDI_(G),SZDJ_(G)), & -! intent(inout) :: hmask !< A mask indicating which tracer points are -! !! partly or fully covered by an ice-shelf -! logical, intent(in) :: flux_bdry !< If true, use mass fluxes as the boundary value. -! type(unit_scale_type), intent(in) :: US !< A structure containing unit conversion factors -! type(param_file_type), intent(in) :: PF !< A structure to parse for run-time parameters - -! character(len=40) :: mdl = "initialize_ice_shelf_boundary_channel" ! This subroutine's name. -! integer :: i, j, isd, jsd, is, js, iegq, jegq, giec, gjec, gisc, gjsc, isc, jsc, iec, jec, ied, jed -! real :: input_thick ! The input ice shelf thickness [Z ~> m] -! real :: input_flux ! The input ice flux per unit length [L Z T-1 ~> m2 s-1] -! real :: lenlat, len_stress - -! call get_param(PF, mdl, "LENLAT", lenlat, fail_if_missing=.true.) - -! call get_param(PF, mdl, "INPUT_FLUX_ICE_SHELF", input_flux, & -! "volume flux at upstream boundary", & -! units="m2 s-1", default=0., scale=US%m_s_to_L_T*US%m_to_Z) -! call get_param(PF, mdl, "INPUT_THICK_ICE_SHELF", input_thick, & -! "flux thickness at upstream boundary", & -! units="m", default=1000., scale=US%m_to_Z) -! call get_param(PF, mdl, "LEN_SIDE_STRESS", len_stress, & -! "maximum position of no-flow condition in along-flow direction", & -! units="km", default=0.) - -! call MOM_mesg(mdl//": setting boundary") - -! isd = G%isd ; ied = G%ied -! jsd = G%jsd ; jed = G%jed -! isc = G%isc ; jsc = G%jsc ; iec = G%iec ; jec = G%jec -! gisc = G%Domain%nihalo ; gjsc = G%Domain%njhalo -! giec = G%Domain%niglobal+gisc ; gjec = G%Domain%njglobal+gjsc - -! do j=jsd,jed -! do i=isd,ied - -! ! upstream boundary - set either dirichlet or flux condition - -! if ((i+G%idg_offset) == G%domain%nihalo+1) then -! if (flux_bdry) then -! u_face_mask_bdry(i-1,j) = 4.0 -! u_flux_bdry_val(i-1,j) = input_flux -! else -! hmask(i-1,j) = 3.0 -! h_bdry_val(i-1,j) = input_thick -! u_face_mask_bdry(i-1,j) = 3.0 -! u_bdry_val(i-1,j-1) = (1 - ((G%geoLatBu(i-1,j-1) - 0.5*lenlat)*2./lenlat)**2) * & -! 1.5 * input_flux / input_thick -! u_bdry_val(i-1,j) = (1 - ((G%geoLatBu(i-1,j) - 0.5*lenlat)*2./lenlat)**2) * & -! 1.5 * input_flux / input_thick -! endif -! endif - -! ! side boundaries: no flow - -! if (G%jdg_offset+j == gjsc+1) then !bot boundary -! if (len_stress == 0. .OR. G%geoLonCv(i,j-1) <= len_stress) then -! v_face_mask_bdry(i,j-1) = 0. -! else -! v_face_mask_bdry(i,j-1) = 1. -! endif -! elseif (G%jdg_offset+j == gjec) then !top boundary -! if (len_stress == 0. .OR. G%geoLonCv(i,j-1) <= len_stress) then -! v_face_mask_bdry(i,j) = 0. -! else -! v_face_mask_bdry(i,j) = 1. -! endif -! endif - -! ! downstream boundary - CFBC - -! if (i+G%idg_offset == giec) then -! u_face_mask_bdry(i,j) = 2.0 -! endif - -! enddo -! enddo - -!END MJH end subroutine initialize_ice_shelf_boundary_channel !> Initialize ice shelf flow from file subroutine initialize_ice_flow_from_file(u_shelf, v_shelf,ice_visc,float_cond,& @@ -642,7 +460,7 @@ subroutine initialize_ice_flow_from_file(u_shelf, v_shelf,ice_visc,float_cond,& ! call MOM_read_data(filename, trim(ushelf_varname), u_shelf, G%Domain, scale=1.0) !/(365.0*86400.0)) ! call MOM_read_data(filename,trim(vshelf_varname), v_shelf, G%Domain, scale=1.0) !/(365.0*86400.0)) - call MOM_read_data(filename,trim(ice_visc_varname), ice_visc, G%Domain, scale=1.0) !*(365.0*86400.0)) + call MOM_read_data(filename,trim(ice_visc_varname), ice_visc, G%Domain, scale=1.0) call MOM_read_data(filename,trim(floatfr_varname), float_cond, G%Domain, scale=1.) ! call get_param(PF, mdl, "ICE_BOUNDARY_CONFIG", config, & ! "This specifies how the ice domain boundary is specified", & From 5b686c838b54c8c129c48470f25ced9b92f9149a Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Wed, 10 Mar 2021 21:52:04 +0000 Subject: [PATCH 30/35] add parameter for allowing land mask changes * if true, allow the topog overrides to change the land mask --- src/initialization/MOM_shared_initialization.F90 | 14 ++++++++++++-- 1 file changed, 12 insertions(+), 2 deletions(-) diff --git a/src/initialization/MOM_shared_initialization.F90 b/src/initialization/MOM_shared_initialization.F90 index 70ef0768d5..dced42574e 100644 --- a/src/initialization/MOM_shared_initialization.F90 +++ b/src/initialization/MOM_shared_initialization.F90 @@ -196,6 +196,7 @@ subroutine apply_topography_edits_from_file(D, G, param_file, US) character(len=40) :: mdl = "apply_topography_edits_from_file" ! This subroutine's name. integer :: i, j, n, ncid, n_edits, i_file, j_file, ndims, sizes(8) logical :: found + logical :: topog_edits_change_mask call callTree_enter(trim(mdl)//"(), MOM_shared_initialization.F90") @@ -206,6 +207,9 @@ subroutine apply_topography_edits_from_file(D, G, param_file, US) call get_param(param_file, mdl, "TOPO_EDITS_FILE", topo_edits_file, & "The file from which to read a list of i,j,z topography overrides.", & default="") + call get_param(param_file, mdl, "ALLOW_LANDMASK_CHANGES", topog_edits_change_mask, & + "If true, allow topography overrides to change land mask.", & + default=.false.) if (len_trim(topo_edits_file)==0) return @@ -250,8 +254,14 @@ subroutine apply_topography_edits_from_file(D, G, param_file, US) 'Ocean topography edit: ', n, ig(n), jg(n), D(i,j)/m_to_Z, '->', abs(new_depth(n)), i, j D(i,j) = abs(m_to_Z*new_depth(n)) ! Allows for height-file edits (i.e. converts negatives) else - call MOM_error(FATAL, trim(mdl)//': A zero depth edit would change the land mask and '//& - "is not allowed in"//trim(topo_edits_file)) + if (topog_edits_change_mask) then + write(stdout,'(a,3i5,f8.2,a,f8.2,2i4)') & + 'Ocean topography edit: ',n,ig(n),jg(n),D(i,j)/m_to_Z,'->',abs(new_depth(n)),i,j + D(i,j) = abs(m_to_Z*new_depth(n)) ! Allows for height-file edits (i.e. converts negatives) + else + call MOM_error(FATAL, ' apply_topography_edits_from_file: '//& + "A zero depth edit would change the land mask and is not allowed in"//trim(topo_edits_file)) + endif endif endif enddo From 8494ba8d67b7db9563050938904beb29f1be956c Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Wed, 10 Mar 2021 18:53:40 -0500 Subject: [PATCH 31/35] change logical from "topog_..." to "topo_..." --- src/initialization/MOM_shared_initialization.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/initialization/MOM_shared_initialization.F90 b/src/initialization/MOM_shared_initialization.F90 index dced42574e..ee80bbdace 100644 --- a/src/initialization/MOM_shared_initialization.F90 +++ b/src/initialization/MOM_shared_initialization.F90 @@ -196,7 +196,7 @@ subroutine apply_topography_edits_from_file(D, G, param_file, US) character(len=40) :: mdl = "apply_topography_edits_from_file" ! This subroutine's name. integer :: i, j, n, ncid, n_edits, i_file, j_file, ndims, sizes(8) logical :: found - logical :: topog_edits_change_mask + logical :: topo_edits_change_mask call callTree_enter(trim(mdl)//"(), MOM_shared_initialization.F90") @@ -207,7 +207,7 @@ subroutine apply_topography_edits_from_file(D, G, param_file, US) call get_param(param_file, mdl, "TOPO_EDITS_FILE", topo_edits_file, & "The file from which to read a list of i,j,z topography overrides.", & default="") - call get_param(param_file, mdl, "ALLOW_LANDMASK_CHANGES", topog_edits_change_mask, & + call get_param(param_file, mdl, "ALLOW_LANDMASK_CHANGES", topo_edits_change_mask, & "If true, allow topography overrides to change land mask.", & default=.false.) @@ -254,7 +254,7 @@ subroutine apply_topography_edits_from_file(D, G, param_file, US) 'Ocean topography edit: ', n, ig(n), jg(n), D(i,j)/m_to_Z, '->', abs(new_depth(n)), i, j D(i,j) = abs(m_to_Z*new_depth(n)) ! Allows for height-file edits (i.e. converts negatives) else - if (topog_edits_change_mask) then + if (topo_edits_change_mask) then write(stdout,'(a,3i5,f8.2,a,f8.2,2i4)') & 'Ocean topography edit: ',n,ig(n),jg(n),D(i,j)/m_to_Z,'->',abs(new_depth(n)),i,j D(i,j) = abs(m_to_Z*new_depth(n)) ! Allows for height-file edits (i.e. converts negatives) From abc8fe46324f4f7711100da37ad4b6bec0162cb0 Mon Sep 17 00:00:00 2001 From: Olga Sergienko Date: Thu, 11 Mar 2021 12:30:24 -0500 Subject: [PATCH 32/35] Removed blocks of commented text and multiplications by 0 --- src/ice_shelf/MOM_ice_shelf.F90 | 6 +- src/ice_shelf/MOM_ice_shelf_dynamics.F90 | 69 +++++----------------- src/ice_shelf/MOM_ice_shelf_initialize.F90 | 39 ++---------- 3 files changed, 23 insertions(+), 91 deletions(-) diff --git a/src/ice_shelf/MOM_ice_shelf.F90 b/src/ice_shelf/MOM_ice_shelf.F90 index 5d2bc88b4c..b2cb9f9c29 100644 --- a/src/ice_shelf/MOM_ice_shelf.F90 +++ b/src/ice_shelf/MOM_ice_shelf.F90 @@ -711,15 +711,15 @@ subroutine shelf_calc_flux(sfc_state_in, fluxes_in, Time, time_step, CS) endif ! Melting has been computed, now is time to update thickness and mass with dynamic ice shelf - if (CS%active_shelf_dynamics) then !OVS 12/10/20 - call change_thickness_using_melt(ISS, G, US, US%s_to_T*time_step, fluxes, CS%density_ice, CS%debug) !OVS 12/10/20 + if (CS%active_shelf_dynamics) then + call change_thickness_using_melt(ISS, G, US, US%s_to_T*time_step, fluxes, CS%density_ice, CS%debug) if (CS%debug) then call hchksum(ISS%h_shelf, "h_shelf after change thickness using melt", G%HI, haloshift=0, scale=US%Z_to_m) call hchksum(ISS%mass_shelf, "mass_shelf after change thickness using melt", G%HI, haloshift=0, & scale=US%RZ_to_kg_m2) endif - endif !OVS 12/10/20 + endif if (CS%debug) call MOM_forcing_chksum("Before add shelf flux", fluxes, G, CS%US, haloshift=0) diff --git a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 index 6b30b2d83d..8360530f21 100644 --- a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 +++ b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 @@ -424,7 +424,6 @@ subroutine initialize_ice_shelf_dyn(param_file, Time, ISS, CS, G, US, diag, new_ ! previously allocated for registration for restarts. if (active_shelf_dynamics) then - ! DNG allocate( CS%u_bdry_val(Isdq:Iedq,Jsdq:Jedq) ) ; CS%u_bdry_val(:,:) = 0.0 allocate( CS%v_bdry_val(Isdq:Iedq,Jsdq:Jedq) ) ; CS%v_bdry_val(:,:) = 0.0 allocate( CS%t_bdry_val(isd:ied,jsd:jed) ) ; CS%t_bdry_val(:,:) = -15.0 @@ -572,7 +571,6 @@ subroutine initialize_ice_shelf_dyn(param_file, Time, ISS, CS, G, US, diag, new_ if (new_sim) then call MOM_mesg("MOM_ice_shelf.F90, initialize_ice_shelf: initialize ice velocity.") call update_OD_ffrac_uncoupled(CS, G, ISS%h_shelf(:,:)) - !call ice_shelf_solve_outer(CS, ISS, G, US, CS%u_shelf, CS%v_shelf, iters, Time) call ice_shelf_solve_outer(CS, ISS, G, US, CS%u_shelf, CS%v_shelf,CS%taudx_shelf,CS%taudy_shelf, iters, Time) if (CS%id_u_shelf > 0) call post_data(CS%id_u_shelf, CS%u_shelf, CS%diag) if (CS%id_v_shelf > 0) call post_data(CS%id_v_shelf, CS%v_shelf,CS%diag) @@ -692,7 +690,6 @@ subroutine update_ice_shelf(CS, ISS, G, US, time_step, Time, ocean_mass, coupled if (update_ice_vel) then -! call ice_shelf_solve_outer(CS, ISS, G, US, CS%u_shelf, CS%v_shelf, iters, Time) call ice_shelf_solve_outer(CS, ISS, G, US, CS%u_shelf, CS%v_shelf,CS%taudx_shelf,CS%taudy_shelf, iters, Time) endif @@ -1801,9 +1798,9 @@ subroutine calc_shelf_driving_stress(CS, ISS, G, US, taudx, taudy, OD) isd = G%isd ; jsd = G%jsd iegq = G%iegB ; jegq = G%jegB ! gisc = G%domain%nihalo+1 ; gjsc = G%domain%njhalo+1 - gisc = 0*G%domain%nihalo+1 ; gjsc = 0*G%domain%njhalo+1 + gisc = 1 ; gjsc = 1 ! giec = G%domain%niglobal+G%domain%nihalo ; gjec = G%domain%njglobal+G%domain%njhalo - giec = G%domain%niglobal+0*G%domain%nihalo ; gjec = G%domain%njglobal+0*G%domain%njhalo + giec = G%domain%niglobal ; gjec = G%domain%njglobal is = iscq - 1; js = jscq - 1 i_off = G%idg_offset ; j_off = G%jdg_offset @@ -2519,7 +2516,7 @@ subroutine apply_boundary_values(CS, ISS, G, US, time, Phisub, H_node, ice_visc, endif endif ; enddo ; enddo - call pass_vector(u_bdry_contr, v_bdry_contr, G%domain, TO_ALL, BGRID_NE) !OVS 02/19/21 + call pass_vector(u_bdry_contr, v_bdry_contr, G%domain, TO_ALL, BGRID_NE) end subroutine apply_boundary_values @@ -2563,26 +2560,11 @@ subroutine calc_shelf_visc(CS, ISS, G, US, u_shlf, v_shlf) n_g = CS%n_glen; eps_min = CS%eps_glen_min -! CS%ice_visc(:,:) = 0.0 -! ux(:,:) = 0.0; uy(:,:) = 0.0; vx(:,:) =0.0; vy(:,:) =0.0 -! eII(:,:) = (US%s_to_T**2 * (eps_min**2)) - Visc_coef = US%kg_m2s_to_RZ_T*US%m_to_L*US%Z_to_L*(CS%A_glen_isothermal)**(-1./CS%n_glen) !OVS '-' in the exponent -! call pass_vector(u_shlf, v_shlf, G%domain, TO_ALL, BGRID_NE) - do j=jsc-0*1,jec+0*1 - do i=isc-0*1,iec+0*1 -! do j=jsd+1,jed-1 !OVS 02/01/21 -! do i=isd+1,ied-1 !OVS 02/01/21 + Visc_coef = US%kg_m2s_to_RZ_T*US%m_to_L*US%Z_to_L*(CS%A_glen_isothermal)**(-1./CS%n_glen) + do j=jsc,jec + do i=isc,iec if ((ISS%hmask(i,j) == 1) .OR. (ISS%hmask(i,j) == 3)) then -! ux(i,j) = ((u_shlf(I,J) + u_shlf(I,J-1)) - (u_shlf(I-1,J) + u_shlf(I-1,J-1))) / (2*G%dxT(i,j)) -! vx(i,j) = ((v_shlf(I,J) + v_shlf(I,J-1)) - (v_shlf(I-1,J) + v_shlf(I-1,J-1))) / (2*G%dxT(i,j)) -! uy(i,j) = ((u_shlf(I,J) + u_shlf(I-1,J)) - (u_shlf(I,J-1) + u_shlf(I-1,J-1))) / (2*G%dyT(i,j)) -! vy(i,j) = ((v_shlf(I,J) + v_shlf(I-1,J)) - (v_shlf(I,J-1) + v_shlf(I-1,J-1))) / (2*G%dyT(i,j)) -! endif -! enddo -! enddo -! call pass_vector(ux, uy, G%domain, TO_ALL, BGRID_NE) -! call pass_vector(vx, vy, G%domain, TO_ALL, BGRID_NE) ux = ((u_shlf(I,J) + (u_shlf(I,J-1) + u_shlf(I,J+1))) - & (u_shlf(I-1,J) + (u_shlf(I-1,J-1) + u_shlf(I-1,J+1)))) / (3*G%dxT(i,j)) vx = ((v_shlf(I,J) + v_shlf(I,J-1) + v_shlf(I,J+1)) - & @@ -2591,17 +2573,8 @@ subroutine calc_shelf_visc(CS, ISS, G, US, u_shlf, v_shlf) (u_shlf(I,J-1) + (u_shlf(I-1,J-1) + u_shlf(I+1,J-1)))) / (3*G%dyT(i,j)) vy = ((v_shlf(I,J) + (v_shlf(I-1,J)+ v_shlf(I+1,J))) - & (v_shlf(I,J-1) + (v_shlf(I-1,J-1)+ v_shlf(I+1,J-1)))) / (3*G%dyT(i,j)) -! ux = ((u_shlf(I,J) + u_shlf(I,J-1)) - (u_shlf(I-1,J) + u_shlf(I-1,J-1))) / (2*G%dxT(i,j)) -! vx = ((v_shlf(I,J) + v_shlf(I,J-1)) - (v_shlf(I-1,J) + v_shlf(I-1,J-1))) / (2*G%dxT(i,j)) -! uy = ((u_shlf(I,J) + u_shlf(I-1,J)) - (u_shlf(I,J-1) + u_shlf(I-1,J-1))) / (2*G%dyT(i,j)) -! vy = ((v_shlf(I,J) + v_shlf(I-1,J)) - (v_shlf(I,J-1) + v_shlf(I-1,J-1))) / (2*G%dyT(i,j)) CS%ice_visc(i,j) = 0.5 * Visc_coef * (G%areaT(i,j) * ISS%h_shelf(i,j)) * & (US%s_to_T**2 * (ux**2 + vy**2 + ux*vy + 0.25*(uy+vx)**2 + eps_min**2))**((1.-n_g)/(2.*n_g)) -! CS%ice_visc(i,j) =1e14*(G%areaT(i,j) * ISS%h_shelf(i,j)) ! constant viscocity for debugging -! umid = ((u_shlf(I,J) + u_shlf(I-1,J-1)) + (u_shlf(I,J-1) + u_shlf(I-1,J))) * 0.25 -! vmid = ((v_shlf(I,J) + v_shlf(I-1,J-1)) + (v_shlf(I,J-1) + v_shlf(I-1,J))) * 0.25 -! unorm = sqrt(umid**2 + vmid**2 + eps_min**2*(G%dxT(i,j)**2 + G%dyT(i,j)**2)) -! CS%basal_traction(i,j) = G%areaT(i,j) * CS%C_basal_friction * (US%L_T_to_m_s*unorm)**(CS%n_basal_fric-1) endif enddo enddo @@ -2638,8 +2611,8 @@ subroutine calc_shelf_taub(CS, ISS, G, US, u_shlf, v_shlf) eps_min = CS%eps_glen_min - do j=jsd+1,jed!-1 OVS 02/01/21 - do i=isd+1,ied!-1 OVS 02/01/21 + do j=jsd+1,jed + do i=isd+1,ied if ((ISS%hmask(i,j) == 1) .OR. (ISS%hmask(i,j) == 3)) then umid = ((u_shlf(I,J) + u_shlf(I-1,J-1)) + (u_shlf(I,J-1) + u_shlf(I-1,J))) * 0.25 @@ -2949,7 +2922,6 @@ subroutine update_velocity_masks(CS, G, hmask, umask, vmask, u_face_mask, v_face endif do j=js,G%jed -! do j=js-1,G%jed !OVS change index do i=is,G%ied if (hmask(i,j) == 1) then @@ -2966,10 +2938,6 @@ subroutine update_velocity_masks(CS, G, hmask, umask, vmask, u_face_mask, v_face umask(I-1+k,J)=3. !vmask(I-1+k,J)=0. vmask(I-1+k,J)=3. - !u_face_mask(I-1+k,j-1)=3. -! umask(I-1+k,J-1:J)=3. -! vmask(I-1+k,J-1:J)=0. -! u_face_mask(I-1+k,j)=3. case (2) u_face_mask(I-1+k,j)=2. case (4) @@ -2977,9 +2945,9 @@ subroutine update_velocity_masks(CS, G, hmask, umask, vmask, u_face_mask, v_face vmask(I-1+k,J-1:J)=0. u_face_mask(I-1+k,j)=4. case (0) -! umask(I-1+k,J-1:J)=0. -! vmask(I-1+k,J-1:J)=0. -! u_face_mask(I-1+k,j)=0. + umask(I-1+k,J-1:J)=0. + vmask(I-1+k,J-1:J)=0. + u_face_mask(I-1+k,j)=0. case (1) ! stress free x-boundary umask(I-1+k,J-1:J)=0. case default @@ -2990,8 +2958,6 @@ subroutine update_velocity_masks(CS, G, hmask, umask, vmask, u_face_mask, v_face select case (int(CS%v_face_mask_bdry(i,J-1+k))) case (3) -! vmask(I-1:I,J-1+k)=3. -! umask(I-1:I,J-1+k)=0. vmask(I-1,J-1+k)=3. umask(I-1,J-1+k)=0. vmask(I,J-1+k)=3. @@ -3004,9 +2970,9 @@ subroutine update_velocity_masks(CS, G, hmask, umask, vmask, u_face_mask, v_face vmask(I-1:I,J-1+k)=0. v_face_mask(i,J-1+k)=4. case (0) -! umask(I-1:I,J-1+k)=0. -! vmask(I-1:I,J-1+k)=0. -! v_face_mask(i,J-1+k)=0. + umask(I-1:I,J-1+k)=0. + vmask(I-1:I,J-1+k)=0. + v_face_mask(i,J-1+k)=0. case (1) ! stress free y-boundary vmask(I-1:I,J-1+k)=0. case default @@ -3134,7 +3100,6 @@ subroutine ice_shelf_temp(CS, ISS, G, US, time_step, melt_rate, Time) intent(in) :: melt_rate !< basal melt rate [R Z T-1 ~> kg m-2 s-1] type(time_type), intent(in) :: Time !< The current model time -! 5/23/12 OVS ! This subroutine takes the velocity (on the Bgrid) and timesteps ! (HT)_t = - div (uHT) + (adot Tsurf -bdot Tbot) once and then calculates T=HT/H ! @@ -3170,12 +3135,6 @@ subroutine ice_shelf_temp(CS, ISS, G, US, time_step, melt_rate, Time) TH(i,j) = CS%t_shelf(i,j)*ISS%h_shelf(i,j) enddo ; enddo -! call enable_averages(time_step, Time, CS%diag) -! call pass_var(h_after_uflux, G%domain) -! call pass_var(h_after_vflux, G%domain) -! if (CS%id_h_after_uflux > 0) call post_data(CS%id_h_after_uflux, h_after_uflux, CS%diag) -! if (CS%id_h_after_vflux > 0) call post_data(CS%id_h_after_vflux, h_after_vflux, CS%diag) -! call disable_averaging(CS%diag) call ice_shelf_advect_temp_x(CS, G, time_step, ISS%hmask, TH, th_after_uflux) call ice_shelf_advect_temp_y(CS, G, time_step, ISS%hmask, th_after_uflux, th_after_vflux) diff --git a/src/ice_shelf/MOM_ice_shelf_initialize.F90 b/src/ice_shelf/MOM_ice_shelf_initialize.F90 index ff05ed7c6a..1f5ddf909b 100644 --- a/src/ice_shelf/MOM_ice_shelf_initialize.F90 +++ b/src/ice_shelf/MOM_ice_shelf_initialize.F90 @@ -16,7 +16,6 @@ module MOM_ice_shelf_initialize #include -!MJHpublic initialize_ice_shelf_boundary, initialize_ice_thickness public initialize_ice_thickness public initialize_ice_shelf_boundary_channel public initialize_ice_flow_from_file @@ -132,10 +131,6 @@ subroutine initialize_ice_thickness_from_file(h_shelf, area_shelf_h, hmask, G, U call MOM_read_data(filename, trim(thickness_varname), h_shelf, G%Domain, scale=US%m_to_Z) call MOM_read_data(filename,trim(area_varname), area_shelf_h, G%Domain, scale=US%m_to_L**2) -! call get_param(PF, mdl, "ICE_BOUNDARY_CONFIG", config, & -! "This specifies how the ice domain boundary is specified", & -! fail_if_missing=.true.) - isc = G%isc ; jsc = G%jsc ; iec = G%iec ; jec = G%jec do j=jsc,jec @@ -228,7 +223,6 @@ subroutine initialize_ice_thickness_channel(h_shelf, area_shelf_h, hmask, G, US, if (G%geoLonCu(i-1,j) >= edge_pos) then ! Everything past the edge is open ocean. -! mass_shelf(i,j) = 0.0 area_shelf_h(i,j) = 0.0 hmask (i,j) = 0.0 h_shelf (i,j) = 0.0 @@ -244,11 +238,7 @@ subroutine initialize_ice_thickness_channel(h_shelf, area_shelf_h, hmask, G, US, if (G%geoLonT(i,j) > slope_pos) then h_shelf(i,j) = min_draft -! mass_shelf(i,j) = Rho_ocean * min_draft else -! mass_shelf(i,j) = Rho_ocean * (min_draft + & -! (CS%max_draft - CS%min_draft) * & -! min(1.0, (c1*(slope_pos - G%geoLonT(i,j)))**2) ) h_shelf(i,j) = (min_draft + & (max_draft - min_draft) * & min(1.0, (c1*(slope_pos - G%geoLonT(i,j)))**2) ) @@ -301,7 +291,7 @@ subroutine initialize_ice_shelf_boundary_channel(u_face_mask_bdry, v_face_mask_b intent(inout) :: hmask !< A mask indicating which tracer points are !! partly or fully covered by an ice-shelf real, dimension(SZDI_(G),SZDJ_(G)), & - intent(inout) :: h_shelf !< Ice-shelf thickness OVS 11/10/20 + intent(inout) :: h_shelf !< Ice-shelf thickness type(unit_scale_type), intent(in) :: US !< A structure containing unit conversion factors type(param_file_type), intent(in) :: PF !< A structure to parse for run-time parameters @@ -340,26 +330,16 @@ subroutine initialize_ice_shelf_boundary_channel(u_face_mask_bdry, v_face_mask_b giec = G%Domain%niglobal+gisc ; gjec = G%Domain%njglobal+gjsc !---------b.c.s based on geopositions ----------------- - ! do j=jsc-1,jec+1 - do j=jsc-0*1,jec+1 + do j=jsc,jec+1 do i=isc-1,iec+1 ! upstream boundary - set either dirichlet or flux condition if (G%geoLonBu(i,j) == westlon) then - ! if (flux_bdry) then - ! u_face_mask_bdry(i-1,j) = 4.0 - ! u_flux_bdry_val(i-1,j) = input_flux - ! else hmask(i+1,j) = 3.0 - ! hmask(i,j) = 3.0 h_bdry_val(i+1,j) = h_shelf(i+1,j) - ! h_bdry_val(i,j) = h_shelf(i,j) thickness_bdry_val(i+1,j) = h_bdry_val(i+0*1,j) u_face_mask_bdry(i+1,j) = 3.0 u_bdry_val(i+1,j) = input_vel*(1-16.0*((G%geoLatBu(i-1,j)/lenlat-0.5))**4) !velocity distribution - ! u_bdry_val(i+1,j) = (1 - ((G%geoLatBu(i,j) - 0.5*lenlat)*2./lenlat)**2) * & - ! 1.5 * input_flux / input_thick - ! endif endif @@ -367,7 +347,6 @@ subroutine initialize_ice_shelf_boundary_channel(u_face_mask_bdry, v_face_mask_b if (G%geoLatBu(i,j-1) == southlat) then !bot boundary if (len_stress == 0. .OR. G%geoLonCv(i,j) <= len_stress) then v_face_mask_bdry(i,j+1) = 0. - ! u_face_mask_bdry(i,j-1) = 3. u_face_mask_bdry(i,j) = 3. u_bdry_val(i,j) = 0. v_bdry_val(i,j) = 0. @@ -382,11 +361,8 @@ subroutine initialize_ice_shelf_boundary_channel(u_face_mask_bdry, v_face_mask_b v_face_mask_bdry(i,j-1) = 0. u_face_mask_bdry(i,j-1) = 3. else - !v_face_mask_bdry(i,j-1) = 1. v_face_mask_bdry(i,j-1) = 3. u_face_mask_bdry(i,j-1) = 3. - !u_bdry_val(i,j) = 0. - !hmask(i,j) = 0.0 endif endif @@ -458,13 +434,10 @@ subroutine initialize_ice_flow_from_file(u_shelf, v_shelf,ice_visc,float_cond,& floatfr_varname = "float_frac" -! call MOM_read_data(filename, trim(ushelf_varname), u_shelf, G%Domain, scale=1.0) !/(365.0*86400.0)) -! call MOM_read_data(filename,trim(vshelf_varname), v_shelf, G%Domain, scale=1.0) !/(365.0*86400.0)) - call MOM_read_data(filename,trim(ice_visc_varname), ice_visc, G%Domain, scale=1.0) - call MOM_read_data(filename,trim(floatfr_varname), float_cond, G%Domain, scale=1.) -! call get_param(PF, mdl, "ICE_BOUNDARY_CONFIG", config, & -! "This specifies how the ice domain boundary is specified", & -! fail_if_missing=.true.) + call MOM_read_data(filename, trim(ushelf_varname), u_shelf, G%Domain, scale=1.0) + call MOM_read_data(filename,trim(vshelf_varname), v_shelf, G%Domain, scale=1.0) + call MOM_read_data(filename,trim(ice_visc_varname), ice_visc, G%Domain, scale=1.0) + call MOM_read_data(filename,trim(floatfr_varname), float_cond, G%Domain, scale=1.) isc = G%isc ; jsc = G%jsc ; iec = G%iec ; jec = G%jec From 0d60fd0264ee271b1ce2a7b6c5e92d853c0c2769 Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Fri, 12 Mar 2021 09:39:17 -0500 Subject: [PATCH 33/35] Change units of slope returned from calc_isoneutral_slopes() to "Z L-1" - Units of isoneutral or interface slope were recorded as "nondim". While true in SI units, not so for MOM6 units. MOM6 distinguishes between units of length in the vertical (Z) and horizontal (L) the slopes should have units of "Z L-1 ~> nondim". - This has consequences for other variables in calc_isoneutral_slopes(). - An internal constant, G_Rho0, was defined differently from elsewhere in the code. "g" has units of "L2 Z-1 T-2 ~ m s-2" because it is the vertical component of the gradient of geopotential in "L2 T-2 ~ m2 s-2". Everywhere else `G_Rho0 = g_Earth/Rho0` but in this routine it was different in order render N2 (the Brunt-Vaisala frequency) in units of "T-2" (s-2). - N2 is a quantity associated with dispersion relations and defined N2 = - g/Rho0 d/dz rho and either way acquires units of "L2 Z-2 T-2" and not just "T-2". In SI units L2 Z-2 = 1. So I have also changed the units of N2 in this, and connected, modules. - The changes also propagate to MOM_lateral_mixing_coeffs.F90 and MOM_thickness_diffuse.F90. - Changing the definition of G_Rho0 in calc_isoneutral_slopes(), and its units to "L2 Z-1 T-2", the slope and N2 calculations then require many less inline conversions. Many of the one-line changes in this commit remove factors like US%Z_to_L.There is one exception: - In the calculation of slope, we use in the denominator a mostly non-vanishing replacement for d/dz rho, the magnitude of grad rho from mag_grad2 = ( d/dx rho )^2 + ( d/dz rho )^2. In code this had `mag_grad2 = drdy**2 + (L_to_Z*drdz)**2` since this is mixing gradients in the horizontal and vertical. The result should be in "R2 Z-2" so now `mag_grad2 = (Z_to_L*drdy)**2 + drdz**2` - A few diagnostics needed new, or changed, conversion factors. - One run-time parameter needed a conversion parameter. - For the most part this commit moves inline conversions of units to the I/O stage, which is an indicator that it is the right thing to do. --- src/core/MOM_isopycnal_slopes.F90 | 26 ++++++------- .../lateral/MOM_lateral_mixing_coeffs.F90 | 10 +++-- .../lateral/MOM_thickness_diffuse.F90 | 38 +++++++++---------- 3 files changed, 38 insertions(+), 36 deletions(-) diff --git a/src/core/MOM_isopycnal_slopes.F90 b/src/core/MOM_isopycnal_slopes.F90 index e1f573f6ea..98b5b10998 100644 --- a/src/core/MOM_isopycnal_slopes.F90 +++ b/src/core/MOM_isopycnal_slopes.F90 @@ -37,14 +37,14 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, & !! thermodynamic variables real, intent(in) :: dt_kappa_smooth !< A smoothing vertical diffusivity !! times a smoothing timescale [Z2 ~> m2]. - real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)+1), intent(inout) :: slope_x !< Isopycnal slope in i-direction [nondim] - real, dimension(SZI_(G),SZJB_(G),SZK_(GV)+1), intent(inout) :: slope_y !< Isopycnal slope in j-direction [nondim] + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)+1), intent(inout) :: slope_x !< Isopycnal slope in i-dir [Z L-1 ~> nondim] + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)+1), intent(inout) :: slope_y !< Isopycnal slope in j-dir [Z L-1 ~> nondim] real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)+1), & optional, intent(inout) :: N2_u !< Brunt-Vaisala frequency squared at - !! interfaces between u-points [T-2 ~> s-2] + !! interfaces between u-points [L2 Z-2 T-2 ~> s-2] real, dimension(SZI_(G),SZJB_(G),SZK_(GV)+1), & optional, intent(inout) :: N2_v !< Brunt-Vaisala frequency squared at - !! interfaces between u-points [T-2 ~> s-2] + !! interfaces between v-points [L2 Z-2 T-2 ~> s-2] integer, optional, intent(in) :: halo !< Halo width over which to compute type(ocean_OBC_type), optional, pointer :: OBC !< Open boundaries control structure. @@ -86,7 +86,7 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, & real :: drdz ! Vertical density gradient [R Z-1 ~> kg m-4]. real :: Slope ! The slope of density surfaces, calculated in a way ! that is always between -1 and 1. - real :: mag_grad2 ! The squared magnitude of the 3-d density gradient [R2 L-2 ~> kg2 m-8]. + real :: mag_grad2 ! The squared magnitude of the 3-d density gradient [R2 Z-2 ~> kg2 m-8]. real :: slope2_Ratio ! The ratio of the slope squared to slope_max squared. real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected [H ~> m or kg m-2]. @@ -94,7 +94,7 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, & real :: dz_neglect ! A change in interface heighs that is so small it is usually lost ! in roundoff and can be neglected [Z ~> m]. logical :: use_EOS ! If true, density is calculated from T & S using an equation of state. - real :: G_Rho0 ! The gravitational acceleration divided by density [Z2 T-2 R-1 ~> m5 kg-2 s-2] + real :: G_Rho0 ! The gravitational acceleration divided by density [L2 Z-1 T-2 R-1 ~> m4 s-2 kg-1] real :: Z_to_L ! A conversion factor between from units for e to the ! units for lateral distances. real :: L_to_Z ! A conversion factor between from units for lateral distances @@ -134,7 +134,7 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, & present_N2_u = PRESENT(N2_u) present_N2_v = PRESENT(N2_v) - G_Rho0 = (US%L_to_Z*L_to_Z*GV%g_Earth) / GV%Rho0 + G_Rho0 = GV%g_Earth / GV%Rho0 if (present_N2_u) then do j=js,je ; do I=is-1,ie N2_u(I,j,1) = 0. @@ -248,17 +248,17 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, & ! This estimate of slope is accurate for small slopes, but bounded ! to be between -1 and 1. - mag_grad2 = drdx**2 + (L_to_Z*drdz)**2 + mag_grad2 = (Z_to_L*drdx)**2 + drdz**2 if (mag_grad2 > 0.0) then slope_x(I,j,K) = drdx / sqrt(mag_grad2) else ! Just in case mag_grad2 = 0 ever. slope_x(I,j,K) = 0.0 endif - if (present_N2_u) N2_u(I,j,k) = G_Rho0 * drdz * G%mask2dCu(I,j) ! Square of buoyancy frequency [T-2 ~> s-2] + if (present_N2_u) N2_u(I,j,k) = G_Rho0 * drdz * G%mask2dCu(I,j) ! Square of buoyancy freq. [L2 Z-2 T-2 ~> s-2] else ! With .not.use_EOS, the layers are constant density. - slope_x(I,j,K) = (Z_to_L*(e(i,j,K)-e(i+1,j,K))) * G%IdxCu(I,j) + slope_x(I,j,K) = (e(i,j,K)-e(i+1,j,K)) * G%IdxCu(I,j) endif if (local_open_u_BC) then l_seg = OBC%segnum_u(I,j) @@ -351,17 +351,17 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, & ! This estimate of slope is accurate for small slopes, but bounded ! to be between -1 and 1. - mag_grad2 = drdy**2 + (L_to_Z*drdz)**2 + mag_grad2 = (Z_to_L*drdy)**2 + drdz**2 if (mag_grad2 > 0.0) then slope_y(i,J,K) = drdy / sqrt(mag_grad2) else ! Just in case mag_grad2 = 0 ever. slope_y(i,J,K) = 0.0 endif - if (present_N2_v) N2_v(i,J,k) = G_Rho0 * drdz * G%mask2dCv(i,J) ! Square of buoyancy frequency [T-2 ~> s-2] + if (present_N2_v) N2_v(i,J,k) = G_Rho0 * drdz * G%mask2dCv(i,J) ! Square of buoyancy freq. [L2 Z-2 T-2 ~> s-2] else ! With .not.use_EOS, the layers are constant density. - slope_y(i,J,K) = (Z_to_L*(e(i,j,K)-e(i,j+1,K))) * G%IdyCv(i,J) + slope_y(i,J,K) = (e(i,j,K)-e(i,j+1,K)) * G%IdyCv(i,J) endif if (local_open_v_BC) then l_seg = OBC%segnum_v(i,J) diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index e3a6f1599e..7d95c43b98 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -1125,16 +1125,18 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) if (CS%calculate_Eady_growth_rate .and. CS%use_stored_slopes) then CS%id_N2_u = register_diag_field('ocean_model', 'N2_u', diag%axesCui, Time, & 'Square of Brunt-Vaisala frequency, N^2, at u-points, as used in Visbeck et al.', & - 's-2', conversion=US%s_to_T**2) + 's-2', conversion=(US%L_to_Z*US%s_to_T)**2) CS%id_N2_v = register_diag_field('ocean_model', 'N2_v', diag%axesCvi, Time, & 'Square of Brunt-Vaisala frequency, N^2, at v-points, as used in Visbeck et al.', & - 's-2', conversion=US%s_to_T**2) + 's-2', conversion=(US%L_to_Z*US%s_to_T)**2) endif if (CS%use_stored_slopes) then CS%id_S2_u = register_diag_field('ocean_model', 'S2_u', diag%axesCu1, Time, & - 'Depth average square of slope magnitude, S^2, at u-points, as used in Visbeck et al.', 'nondim') + 'Depth average square of slope magnitude, S^2, at u-points, as used in Visbeck et al.', & + 'nondim', conversion=US%Z_to_L**2) CS%id_S2_v = register_diag_field('ocean_model', 'S2_v', diag%axesCv1, Time, & - 'Depth average square of slope magnitude, S^2, at v-points, as used in Visbeck et al.', 'nondim') + 'Depth average square of slope magnitude, S^2, at v-points, as used in Visbeck et al.', & + 'nondim', conversion=US%Z_to_L**2) endif oneOrTwo = 1.0 diff --git a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 index 8c6a90ba9c..99ecca9745 100644 --- a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 +++ b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 @@ -40,7 +40,7 @@ module MOM_thickness_diffuse real :: max_Khth_CFL !< Maximum value of the diffusive CFL for thickness diffusion real :: Khth_Min !< Minimum value of Khth [L2 T-1 ~> m2 s-1] real :: Khth_Max !< Maximum value of Khth [L2 T-1 ~> m2 s-1], or 0 for no max - real :: slope_max !< Slopes steeper than slope_max are limited in some way [nondim]. + real :: slope_max !< Slopes steeper than slope_max are limited in some way [Z L-1 ~> nondim]. real :: kappa_smooth !< Vertical diffusivity used to interpolate more !! sensible values of T & S into thin layers [Z2 T-1 ~> m2 s-1]. logical :: thickness_diffuse !< If true, interfaces heights are diffused. @@ -83,8 +83,8 @@ module MOM_thickness_diffuse type(diag_ctrl), pointer :: diag => NULL() !< structure used to regulate timing of diagnostics real, pointer :: GMwork(:,:) => NULL() !< Work by thickness diffusivity [R Z L2 T-3 ~> W m-2] - real, pointer :: diagSlopeX(:,:,:) => NULL() !< Diagnostic: zonal neutral slope [nondim] - real, pointer :: diagSlopeY(:,:,:) => NULL() !< Diagnostic: zonal neutral slope [nondim] + real, pointer :: diagSlopeX(:,:,:) => NULL() !< Diagnostic: zonal neutral slope [Z L-1 ~> nondim] + real, pointer :: diagSlopeY(:,:,:) => NULL() !< Diagnostic: zonal neutral slope [Z L-1 ~> nondim] real, dimension(:,:,:), pointer :: & KH_u_GME => NULL(), & !< interface height diffusivities in u-columns [L2 T-1 ~> m2 s-1] @@ -578,8 +578,8 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV !! the isopycnal slopes are taken directly from !! the interface slopes without consideration of !! density gradients [nondim]. - real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)+1), optional, intent(in) :: slope_x !< Isopycnal slope at u-points - real, dimension(SZI_(G),SZJB_(G),SZK_(GV)+1), optional, intent(in) :: slope_y !< Isopycnal slope at v-points + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)+1), optional, intent(in) :: slope_x !< Isopyc. slope at u [Z L-1 ~> nondim] + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)+1), optional, intent(in) :: slope_y !< Isopyc. slope at v [Z L-1 ~> nondim] ! Local variables real, dimension(SZI_(G), SZJ_(G), SZK_(GV)) :: & T, & ! The temperature (or density) [degC], with the values in @@ -660,7 +660,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV real :: Slope ! The slope of density surfaces, calculated in a way ! that is always between -1 and 1, nondimensional. real :: mag_grad2 ! The squared magnitude of the 3-d density gradient [R2 L-2 ~> kg2 m-8]. - real :: I_slope_max2 ! The inverse of slope_max squared, nondimensional. + real :: I_slope_max2 ! The inverse of slope_max squared [L2 Z-2 ~> nondim]. real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected [H ~> m or kg m-2]. real :: h_neglect2 ! h_neglect^2 [H2 ~> m2 or kg2 m-4]. @@ -919,7 +919,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV ! This estimate of slope is accurate for small slopes, but bounded ! to be between -1 and 1. - mag_grad2 = drdx**2 + (US%L_to_Z*drdz)**2 + mag_grad2 = (US%Z_to_L*drdx)**2 + drdz**2 if (mag_grad2 > 0.0) then Slope = drdx / sqrt(mag_grad2) slope2_Ratio_u(I,K) = Slope**2 * I_slope_max2 @@ -933,7 +933,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV ! that ignore density gradients along layers. if (present_int_slope_u) then Slope = (1.0 - int_slope_u(I,j,K)) * Slope + & - int_slope_u(I,j,K) * US%Z_to_L*((e(i+1,j,K)-e(i,j,K)) * G%IdxCu(I,j)) + int_slope_u(I,j,K) * ((e(i+1,j,K)-e(i,j,K)) * G%IdxCu(I,j)) slope2_Ratio_u(I,K) = (1.0 - int_slope_u(I,j,K)) * slope2_Ratio_u(I,K) endif @@ -942,7 +942,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV if (CS%id_slope_x > 0) CS%diagSlopeX(I,j,k) = Slope ! Estimate the streamfunction at each interface [Z L2 T-1 ~> m3 s-1]. - Sfn_unlim_u(I,K) = -((KH_u(I,j,K)*G%dy_Cu(I,j))*US%L_to_Z*Slope) + Sfn_unlim_u(I,K) = -((KH_u(I,j,K)*G%dy_Cu(I,j))*Slope) ! Avoid moving dense water upslope from below the level of ! the bottom on the receiving side. @@ -968,10 +968,10 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV if (present_slope_x) then Slope = slope_x(I,j,k) else - Slope = US%Z_to_L*((e(i,j,K)-e(i+1,j,K))*G%IdxCu(I,j)) * G%mask2dCu(I,j) + Slope = ((e(i,j,K)-e(i+1,j,K))*G%IdxCu(I,j)) * G%mask2dCu(I,j) endif if (CS%id_slope_x > 0) CS%diagSlopeX(I,j,k) = Slope - Sfn_unlim_u(I,K) = ((KH_u(I,j,K)*G%dy_Cu(I,j))*US%L_to_Z*Slope) + Sfn_unlim_u(I,K) = ((KH_u(I,j,K)*G%dy_Cu(I,j))*Slope) hN2_u(I,K) = GV%g_prime(K) endif ! if (use_EOS) else ! if (k > nk_linear) @@ -1185,7 +1185,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV ! This estimate of slope is accurate for small slopes, but bounded ! to be between -1 and 1. - mag_grad2 = drdy**2 + (US%L_to_Z*drdz)**2 + mag_grad2 = (US%Z_to_L*drdy)**2 + drdz**2 if (mag_grad2 > 0.0) then Slope = drdy / sqrt(mag_grad2) slope2_Ratio_v(i,K) = Slope**2 * I_slope_max2 @@ -1199,7 +1199,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV ! that ignore density gradients along layers. if (present_int_slope_v) then Slope = (1.0 - int_slope_v(i,J,K)) * Slope + & - int_slope_v(i,J,K) * US%Z_to_L*((e(i,j+1,K)-e(i,j,K)) * G%IdyCv(i,J)) + int_slope_v(i,J,K) * ((e(i,j+1,K)-e(i,j,K)) * G%IdyCv(i,J)) slope2_Ratio_v(i,K) = (1.0 - int_slope_v(i,J,K)) * slope2_Ratio_v(i,K) endif @@ -1208,7 +1208,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV if (CS%id_slope_y > 0) CS%diagSlopeY(I,j,k) = Slope ! Estimate the streamfunction at each interface [Z L2 T-1 ~> m3 s-1]. - Sfn_unlim_v(i,K) = -((KH_v(i,J,K)*G%dx_Cv(i,J))*US%L_to_Z*Slope) + Sfn_unlim_v(i,K) = -((KH_v(i,J,K)*G%dx_Cv(i,J))*Slope) ! Avoid moving dense water upslope from below the level of ! the bottom on the receiving side. @@ -1234,10 +1234,10 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV if (present_slope_y) then Slope = slope_y(i,J,k) else - Slope = US%Z_to_L*((e(i,j,K)-e(i,j+1,K))*G%IdyCv(i,J)) * G%mask2dCv(i,J) + Slope = ((e(i,j,K)-e(i,j+1,K))*G%IdyCv(i,J)) * G%mask2dCv(i,J) endif if (CS%id_slope_y > 0) CS%diagSlopeY(I,j,k) = Slope - Sfn_unlim_v(i,K) = ((KH_v(i,J,K)*G%dx_Cv(i,J))*US%L_to_Z*Slope) + Sfn_unlim_v(i,K) = ((KH_v(i,J,K)*G%dx_Cv(i,J))*Slope) hN2_v(i,K) = GV%g_prime(K) endif ! if (use_EOS) else ! if (k > nk_linear) @@ -1947,7 +1947,7 @@ subroutine thickness_diffuse_init(Time, G, GV, US, param_file, diag, CDp, CS) "longer than DT, or 0 to use DT.", units="s", default=0.0, scale=US%s_to_T) call get_param(param_file, mdl, "KHTH_SLOPE_MAX", CS%slope_max, & "A slope beyond which the calculated isopycnal slope is "//& - "not reliable and is scaled away.", units="nondim", default=0.01) + "not reliable and is scaled away.", units="nondim", default=0.01, scale=US%L_to_Z) call get_param(param_file, mdl, "KD_SMOOTH", CS%kappa_smooth, & "A diapycnal diffusivity that is used to interpolate "//& "more sensible values of T & S into thin layers.", & @@ -2065,10 +2065,10 @@ subroutine thickness_diffuse_init(Time, G, GV, US, param_file, diag, CDp, CS) 'm2 s-1', conversion=US%L_to_m**2*US%s_to_T) CS%id_slope_x = register_diag_field('ocean_model', 'neutral_slope_x', diag%axesCui, Time, & - 'Zonal slope of neutral surface', 'nondim') + 'Zonal slope of neutral surface', 'nondim', conversion=US%Z_to_L) if (CS%id_slope_x > 0) call safe_alloc_ptr(CS%diagSlopeX,G%IsdB,G%IedB,G%jsd,G%jed,GV%ke+1) CS%id_slope_y = register_diag_field('ocean_model', 'neutral_slope_y', diag%axesCvi, Time, & - 'Meridional slope of neutral surface', 'nondim') + 'Meridional slope of neutral surface', 'nondim', conversion=US%Z_to_L) if (CS%id_slope_y > 0) call safe_alloc_ptr(CS%diagSlopeY,G%isd,G%ied,G%JsdB,G%JedB,GV%ke+1) CS%id_sfn_x = register_diag_field('ocean_model', 'GM_sfn_x', diag%axesCui, Time, & 'Parameterized Zonal Overturning Streamfunction', & From b33b3af7fe084dd2f8828aee2187549fa52d1ed2 Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Tue, 23 Mar 2021 10:38:21 -0400 Subject: [PATCH 34/35] Testing: Recurse target submodules, LDFLAGS hook Two minor changes to the .testing build: - We now apply `--recurse-submodules` to the target build in the regression test. This is required after an update to the submodules, when the target submodule is out of sync with the main branch (e.g. dev/gfdl at NOAA-GFDL). - A LDFLAGS_USER hook was added to the `.testing/Makefile` configuration, similar to the FCFLAGS_* hooks. This is required if the library dependencies do not reside in the default directores. For example, this may be needed for a custom netCDF or MPI library. --- .testing/Makefile | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/.testing/Makefile b/.testing/Makefile index 21da6cfde4..02f6557c09 100644 --- a/.testing/Makefile +++ b/.testing/Makefile @@ -84,6 +84,9 @@ FCFLAGS_COVERAGE ?= # - FMS cannot be built with the same aggressive initialization flags as MOM6, # so FCFLAGS_INIT is used to provide additional MOM6 configuration. +# User-defined LDFLAGS (applied to all builds and FMS) +LDFLAGS_USER ?= + # Set to `true` to require identical results from DEBUG and REPRO builds # NOTE: Many compilers (Intel, GCC on ARM64) do not yet produce identical # results across DEBUG and REPRO builds (as defined below), so we disable on @@ -217,8 +220,8 @@ REPRO_FCFLAGS := FCFLAGS="$(FCFLAGS_REPRO) $(FCFLAGS_FMS)" OPENMP_FCFLAGS := FCFLAGS="$(FCFLAGS_DEBUG) $(FCFLAGS_INIT) $(FCFLAGS_FMS)" TARGET_FCFLAGS := FCFLAGS="$(FCFLAGS_DEBUG) $(FCFLAGS_INIT) $(FCFLAGS_FMS)" -MOM_LDFLAGS := LDFLAGS="$(LDFLAGS_FMS)" -SYMMETRIC_LDFLAGS := LDFLAGS="$(COVERAGE) $(LDFLAGS_FMS)" +MOM_LDFLAGS := LDFLAGS="$(LDFLAGS_FMS) $(LDFLAGS_USER)" +SYMMETRIC_LDFLAGS := LDFLAGS="$(COVERAGE) $(LDFLAGS_FMS) $(LDFLAGS_USER)" # Environment variable configuration @@ -286,7 +289,7 @@ $(TARGET_CODEBASE)/ac/configure: $(TARGET_CODEBASE) $(TARGET_CODEBASE): git clone --recursive $(MOM_TARGET_URL) $@ - cd $@ && git checkout $(MOM_TARGET_BRANCH) + cd $@ && git checkout --recurse-submodules $(MOM_TARGET_BRANCH) #--- From 8cc501820892c6c4403bdc76ffc4f0257d8d2948 Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Tue, 23 Mar 2021 15:53:38 -0400 Subject: [PATCH 35/35] Style: Line length fix in MCT_cap --- config_src/drivers/mct_cap/mom_surface_forcing_mct.F90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/config_src/drivers/mct_cap/mom_surface_forcing_mct.F90 b/config_src/drivers/mct_cap/mom_surface_forcing_mct.F90 index ef0527dd1c..e675170575 100644 --- a/config_src/drivers/mct_cap/mom_surface_forcing_mct.F90 +++ b/config_src/drivers/mct_cap/mom_surface_forcing_mct.F90 @@ -496,7 +496,8 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, valid_time, G, if (associated(fluxes%frunoff)) then fluxes%latent(i,j) = fluxes%latent(i,j) - & IOB%rofi_flux(i-i0,j-j0)*US%W_m2_to_QRZ_T*CS%latent_heat_fusion - fluxes%latent_frunoff_diag(i,j) = - G%mask2dT(i,j) * IOB%rofi_flux(i-i0,j-j0)*US%W_m2_to_QRZ_T*CS%latent_heat_fusion + fluxes%latent_frunoff_diag(i,j) = -G%mask2dT(i,j) & + * IOB%rofi_flux(i-i0,j-j0)*US%W_m2_to_QRZ_T*CS%latent_heat_fusion endif ! contribution from evaporation if (associated(IOB%q_flux)) then