From 7951a843612a76ec57d818bf190429c3c53fddfc Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Tue, 31 Dec 2019 19:31:38 +0000 Subject: [PATCH 01/19] fix divide by zero --- src/user/MOM_wave_interface.F90 | 12 ++++++++---- 1 file changed, 8 insertions(+), 4 deletions(-) diff --git a/src/user/MOM_wave_interface.F90 b/src/user/MOM_wave_interface.F90 index 0da6285f37..042df7c02f 100644 --- a/src/user/MOM_wave_interface.F90 +++ b/src/user/MOM_wave_interface.F90 @@ -1069,10 +1069,14 @@ subroutine get_StokesSL_LiFoxKemper(ustar, hbl, GV, US, UStokes_SL, LA) sqrt( 2.0 * PI *kstar * z0) * & erfc( sqrt( 2.0 * kstar * z0 ) ) UStokes_sl = UStokes * (0.715 + r1 + r2 + r3 + r4) - LA = sqrt(US%Z_to_m*US%s_to_T*ustar / UStokes_sl) - else - UStokes_sl = 0.0 - LA=1.e8 + if(UStokes_sl .ne. 0.0)then + LA = sqrt(US%Z_to_m*US%s_to_T*ustar / UStokes_sl) + else + LA=1.e8 + endif + !else + ! UStokes_sl = 0.0 + ! LA=1.e8 endif end subroutine Get_StokesSL_LiFoxKemper From ae51d44ecafafaa5cab4da3fefc1ed71fb5cf7b8 Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Tue, 31 Dec 2019 20:42:16 +0000 Subject: [PATCH 02/19] fix to wave_interface for debugging; looked safe but gave error about mixed complex and real variables --- src/user/MOM_wave_interface.F90 | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/src/user/MOM_wave_interface.F90 b/src/user/MOM_wave_interface.F90 index 042df7c02f..88a29f5577 100644 --- a/src/user/MOM_wave_interface.F90 +++ b/src/user/MOM_wave_interface.F90 @@ -1072,11 +1072,12 @@ subroutine get_StokesSL_LiFoxKemper(ustar, hbl, GV, US, UStokes_SL, LA) if(UStokes_sl .ne. 0.0)then LA = sqrt(US%Z_to_m*US%s_to_T*ustar / UStokes_sl) else - LA=1.e8 + UStokes_sl = 0.0 + LA=1.e8 endif - !else - ! UStokes_sl = 0.0 - ! LA=1.e8 + else + UStokes_sl = 0.0 + LA=1.e8 endif end subroutine Get_StokesSL_LiFoxKemper From 40871c180d0497029e90ac0776f5340ac4573765 Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Wed, 1 Jan 2020 13:07:09 +0000 Subject: [PATCH 03/19] more better way of fixing divide by zero --- src/user/MOM_wave_interface.F90 | 12 +++--------- 1 file changed, 3 insertions(+), 9 deletions(-) diff --git a/src/user/MOM_wave_interface.F90 b/src/user/MOM_wave_interface.F90 index 88a29f5577..2d2e3cafd3 100644 --- a/src/user/MOM_wave_interface.F90 +++ b/src/user/MOM_wave_interface.F90 @@ -1022,6 +1022,8 @@ subroutine get_StokesSL_LiFoxKemper(ustar, hbl, GV, US, UStokes_SL, LA) real :: z0, z0i, r1, r2, r3, r4, tmp, lasl_sqr_i real :: u10 + UStokes_sl = 0.0 + LA=1.e8 if (ustar > 0.0) then ! Computing u10 based on u_star and COARE 3.5 relationships call ust_2_u10_coare3p5(US%Z_to_m*US%s_to_T*ustar*sqrt(GV%Rho0/1.225), u10, GV, US) @@ -1069,15 +1071,7 @@ subroutine get_StokesSL_LiFoxKemper(ustar, hbl, GV, US, UStokes_SL, LA) sqrt( 2.0 * PI *kstar * z0) * & erfc( sqrt( 2.0 * kstar * z0 ) ) UStokes_sl = UStokes * (0.715 + r1 + r2 + r3 + r4) - if(UStokes_sl .ne. 0.0)then - LA = sqrt(US%Z_to_m*US%s_to_T*ustar / UStokes_sl) - else - UStokes_sl = 0.0 - LA=1.e8 - endif - else - UStokes_sl = 0.0 - LA=1.e8 + if(UStokes_sl .ne. 0.0)LA = sqrt(US%Z_to_m*US%s_to_T*ustar / UStokes_sl) endif end subroutine Get_StokesSL_LiFoxKemper From 8c23ae9ad74f5d9098e88dc222b2394ed042eff3 Mon Sep 17 00:00:00 2001 From: Denise Worthen Date: Mon, 13 Jan 2020 11:58:43 -0500 Subject: [PATCH 04/19] fix divide by zero in wave_interface which allows for running in debug mode for NEMS (#12) --- src/user/MOM_wave_interface.F90 | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/src/user/MOM_wave_interface.F90 b/src/user/MOM_wave_interface.F90 index 0da6285f37..2d2e3cafd3 100644 --- a/src/user/MOM_wave_interface.F90 +++ b/src/user/MOM_wave_interface.F90 @@ -1022,6 +1022,8 @@ subroutine get_StokesSL_LiFoxKemper(ustar, hbl, GV, US, UStokes_SL, LA) real :: z0, z0i, r1, r2, r3, r4, tmp, lasl_sqr_i real :: u10 + UStokes_sl = 0.0 + LA=1.e8 if (ustar > 0.0) then ! Computing u10 based on u_star and COARE 3.5 relationships call ust_2_u10_coare3p5(US%Z_to_m*US%s_to_T*ustar*sqrt(GV%Rho0/1.225), u10, GV, US) @@ -1069,10 +1071,7 @@ subroutine get_StokesSL_LiFoxKemper(ustar, hbl, GV, US, UStokes_SL, LA) sqrt( 2.0 * PI *kstar * z0) * & erfc( sqrt( 2.0 * kstar * z0 ) ) UStokes_sl = UStokes * (0.715 + r1 + r2 + r3 + r4) - LA = sqrt(US%Z_to_m*US%s_to_T*ustar / UStokes_sl) - else - UStokes_sl = 0.0 - LA=1.e8 + if(UStokes_sl .ne. 0.0)LA = sqrt(US%Z_to_m*US%s_to_T*ustar / UStokes_sl) endif end subroutine Get_StokesSL_LiFoxKemper From f8bc91c14107c3fae5e1c139be911d9aeb75fea5 Mon Sep 17 00:00:00 2001 From: Denise Worthen Date: Thu, 9 Apr 2020 10:42:43 -0400 Subject: [PATCH 05/19] Feature/logcleanup (#20) * cleanup of ESMF error handling Co-authored-by: Mariana Vertenstein --- config_src/nuopc_driver/mom_cap.F90 | 874 +++++--------------- config_src/nuopc_driver/mom_cap_methods.F90 | 215 ++--- config_src/nuopc_driver/mom_cap_time.F90 | 127 +-- config_src/nuopc_driver/time_utils.F90 | 30 +- 4 files changed, 298 insertions(+), 948 deletions(-) diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index 219245e473..690b881375 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -132,7 +132,7 @@ module MOM_cap_mod integer :: scalar_field_count = 0 integer :: scalar_field_idx_grid_nx = 0 integer :: scalar_field_idx_grid_ny = 0 -character(len=*),parameter :: u_file_u = & +character(len=*),parameter :: u_FILE_u = & __FILE__ #ifdef CESMCOUPLED @@ -163,32 +163,20 @@ subroutine SetServices(gcomp, rc) ! the NUOPC model component will register the generic methods call NUOPC_CompDerive(gcomp, model_routine_SS, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return ! switching to IPD versions call ESMF_GridCompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, & userRoutine=InitializeP0, phase=0, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return ! set entry point for methods that require specific implementation call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, & phaseLabelList=(/"IPDv03p1"/), userRoutine=InitializeAdvertise, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, & phaseLabelList=(/"IPDv03p3"/), userRoutine=InitializeRealize, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return !------------------ ! attach specializing method(s) @@ -196,36 +184,21 @@ subroutine SetServices(gcomp, rc) call NUOPC_CompSpecialize(gcomp, specLabel=model_label_DataInitialize, & specRoutine=DataInitialize, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompSpecialize(gcomp, specLabel=model_label_Advance, & specRoutine=ModelAdvance, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_MethodRemove(gcomp, label=model_label_SetRunClock, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompSpecialize(gcomp, specLabel=model_label_SetRunClock, & specRoutine=ModelSetRunClock, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompSpecialize(gcomp, specLabel=model_label_Finalize, & specRoutine=ocean_model_finalize, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return end subroutine SetServices @@ -258,95 +231,54 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) ! Switch to IPDv03 by filtering all other phaseMap entries call NUOPC_CompFilterPhaseMap(gcomp, ESMF_METHOD_INITIALIZE, & acceptStringList=(/"IPDv03p"/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + if (ChkErr(rc,__LINE__,u_FILE_u)) return write_diagnostics = .false. call NUOPC_CompAttributeGet(gcomp, name="DumpFields", value=value, & isPresent=isPresent, isSet=isSet, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + if (ChkErr(rc,__LINE__,u_FILE_u)) return if (isPresent .and. isSet) write_diagnostics=(trim(value)=="true") write(logmsg,*) write_diagnostics - call ESMF_LogWrite('MOM_cap:DumpFields = '//trim(logmsg), ESMF_LOGMSG_INFO, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + call ESMF_LogWrite('MOM_cap:DumpFields = '//trim(logmsg), ESMF_LOGMSG_INFO) overwrite_timeslice = .false. call NUOPC_CompAttributeGet(gcomp, name="OverwriteSlice", value=value, & isPresent=isPresent, isSet=isSet, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + if (ChkErr(rc,__LINE__,u_FILE_u)) return if (isPresent .and. isSet) overwrite_timeslice=(trim(value)=="true") write(logmsg,*) overwrite_timeslice - call ESMF_LogWrite('MOM_cap:OverwriteSlice = '//trim(logmsg), ESMF_LOGMSG_INFO, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + call ESMF_LogWrite('MOM_cap:OverwriteSlice = '//trim(logmsg), ESMF_LOGMSG_INFO) profile_memory = .false. call NUOPC_CompAttributeGet(gcomp, name="ProfileMemory", value=value, & isPresent=isPresent, isSet=isSet, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + if (ChkErr(rc,__LINE__,u_FILE_u)) return if (isPresent .and. isSet) profile_memory=(trim(value)=="true") write(logmsg,*) profile_memory - call ESMF_LogWrite('MOM_cap:ProfileMemory = '//trim(logmsg), ESMF_LOGMSG_INFO, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + call ESMF_LogWrite('MOM_cap:ProfileMemory = '//trim(logmsg), ESMF_LOGMSG_INFO) grid_attach_area = .false. call NUOPC_CompAttributeGet(gcomp, name="GridAttachArea", value=value, & isPresent=isPresent, isSet=isSet, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + if (ChkErr(rc,__LINE__,u_FILE_u)) return 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, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + call ESMF_LogWrite('MOM_cap:GridAttachArea = '//trim(logmsg), ESMF_LOGMSG_INFO) scalar_field_name = "" call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldName", value=value, & isPresent=isPresent, isSet=isSet, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + if (ChkErr(rc,__LINE__,u_FILE_u)) return if (isPresent .and. isSet) then scalar_field_name = trim(value) - call ESMF_LogWrite('MOM_cap:ScalarFieldName = '//trim(scalar_field_name), ESMF_LOGMSG_INFO, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + call ESMF_LogWrite('MOM_cap:ScalarFieldName = '//trim(scalar_field_name), ESMF_LOGMSG_INFO) endif scalar_field_count = 0 call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldCount", value=value, & isPresent=isPresent, isSet=isSet, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + if (ChkErr(rc,__LINE__,u_FILE_u)) return if (isPresent .and. isSet) then read(value, '(i)', iostat=iostat) scalar_field_count if (iostat /= 0) then @@ -356,20 +288,13 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) return endif write(logmsg,*) scalar_field_count - call ESMF_LogWrite('MOM_cap:ScalarFieldCount = '//trim(logmsg), ESMF_LOGMSG_INFO, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + call ESMF_LogWrite('MOM_cap:ScalarFieldCount = '//trim(logmsg), ESMF_LOGMSG_INFO) endif scalar_field_idx_grid_nx = 0 call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldIdxGridNX", value=value, & isPresent=isPresent, isSet=isSet, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + if (ChkErr(rc,__LINE__,u_FILE_u)) return if (isPresent .and. isSet) then read(value, '(i)', iostat=iostat) scalar_field_idx_grid_nx if (iostat /= 0) then @@ -379,20 +304,13 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) return endif write(logmsg,*) scalar_field_idx_grid_nx - call ESMF_LogWrite('MOM_cap:ScalarFieldIdxGridNX = '//trim(logmsg), ESMF_LOGMSG_INFO, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + call ESMF_LogWrite('MOM_cap:ScalarFieldIdxGridNX = '//trim(logmsg), ESMF_LOGMSG_INFO) endif scalar_field_idx_grid_ny = 0 call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldIdxGridNY", value=value, & isPresent=isPresent, isSet=isSet, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + if (ChkErr(rc,__LINE__,u_FILE_u)) return if (isPresent .and. isSet) then read(value, '(i)', iostat=iostat) scalar_field_idx_grid_ny if (iostat /= 0) then @@ -402,19 +320,12 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) return endif write(logmsg,*) scalar_field_idx_grid_ny - call ESMF_LogWrite('MOM_cap:ScalarFieldIdxGridNY = '//trim(logmsg), ESMF_LOGMSG_INFO, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + call ESMF_LogWrite('MOM_cap:ScalarFieldIdxGridNY = '//trim(logmsg), ESMF_LOGMSG_INFO) endif call NUOPC_CompAttributeAdd(gcomp, & attrList=(/'RestartFileToRead', 'RestartFileToWrite'/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + if (ChkErr(rc,__LINE__,u_FILE_u)) return end subroutine @@ -469,11 +380,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) rc = ESMF_SUCCESS - call ESMF_LogWrite(subname//' enter', ESMF_LOGMSG_INFO, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + call ESMF_LogWrite(subname//' enter', ESMF_LOGMSG_INFO) allocate(Ice_ocean_boundary) !allocate(ocean_state) ! ocean_model_init allocate this pointer @@ -484,34 +391,19 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ocean_internalstate%ptr%ocean_state_type_ptr => ocean_state call ESMF_VMGetCurrent(vm, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_VMGet(VM, mpiCommunicator=mpi_comm_mom, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_ClockGet(CLOCK, currTIME=MyTime, TimeStep=TINT, RC=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_TimeGet (MyTime, YY=YEAR, MM=MONTH, DD=DAY, H=HOUR, M=MINUTE, S=SECOND, RC=rc ) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return CALL ESMF_TimeIntervalGet(TINT, S=DT_OCEAN, RC=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return call fms_init(mpi_comm_mom) call constants_init @@ -521,10 +413,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) if (cesm_coupled) then call NUOPC_CompAttributeGet(gcomp, name="calendar", value=cvalue, & isPresent=isPresent, isSet=isSet, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return if (isPresent .and. isSet) then read(cvalue,*) calendar select case (trim(calendar)) @@ -558,16 +447,10 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! get start/reference time call ESMF_ClockGet(CLOCK, refTime=MyTime, RC=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_TimeGet (MyTime, YY=YEAR, MM=MONTH, DD=DAY, H=HOUR, M=MINUTE, S=SECOND, RC=rc ) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return time0 = set_date (YEAR,MONTH,DAY,HOUR,MINUTE,SECOND) @@ -583,28 +466,16 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) if (is_root_pe()) then call NUOPC_CompAttributeGet(gcomp, name="diro", & isPresent=isPresentDiro, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + if (ChkErr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompAttributeGet(gcomp, name="logfile", & isPresent=isPresentLogfile, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + if (ChkErr(rc,__LINE__,u_FILE_u)) return if (isPresentDiro .and. isPresentLogfile) then call NUOPC_CompAttributeGet(gcomp, name="diro", value=diro, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + if (ChkErr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompAttributeGet(gcomp, name="logfile", value=logfile, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return - open(newunit=logunit,file=trim(diro)//"/"//trim(logfile)) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + open(newunit=logunit,file=trim(diro)//"/"//trim(logfile)) else logunit = output_unit endif @@ -615,19 +486,12 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) starttype = "" call NUOPC_CompAttributeGet(gcomp, name='start_type', value=cvalue, & isPresent=isPresent, isSet=isSet, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + if (ChkErr(rc,__LINE__,u_FILE_u)) return if (isPresent .and. isSet) then read(cvalue,*) starttype else call ESMF_LogWrite('MOM_cap:start_type unset - using input.nml for restart option', & - ESMF_LOGMSG_INFO, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + ESMF_LOGMSG_INFO) endif runtype = "" @@ -645,11 +509,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) endif if (len_trim(runtype) > 0) then - call ESMF_LogWrite('MOM_cap:startup = '//trim(runtype), ESMF_LOGMSG_INFO, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + call ESMF_LogWrite('MOM_cap:startup = '//trim(runtype), ESMF_LOGMSG_INFO) endif restartfile = "" @@ -662,41 +522,22 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call ESMF_MethodExecute(gcomp, label="GetRestartFileToRead", & existflag=existflag, userRc=userRc, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg="Error executing user method to get restart filename", & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, file=__FILE__)) return ! bail out if (ESMF_LogFoundError(rcToCheck=userRc, msg="Error in method to get restart filename", & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, file=__FILE__)) return ! bail out if (existflag) then - call ESMF_LogWrite('MOM_cap: called user GetRestartFileToRead', ESMF_LOGMSG_INFO, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + call ESMF_LogWrite('MOM_cap: called user GetRestartFileToRead', ESMF_LOGMSG_INFO) endif call NUOPC_CompAttributeGet(gcomp, name='RestartFileToRead', & value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + if (ChkErr(rc,__LINE__,u_FILE_u)) return if (isPresent .and. isSet) then restartfile = trim(cvalue) - call ESMF_LogWrite('MOM_cap: RestartFileToRead = '//trim(restartfile), ESMF_LOGMSG_INFO, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + call ESMF_LogWrite('MOM_cap: RestartFileToRead = '//trim(restartfile), ESMF_LOGMSG_INFO) else call ESMF_LogWrite('MOM_cap: restart requested, no RestartFileToRead attribute provided-will use input.nml',& - ESMF_LOGMSG_WARNING, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + ESMF_LOGMSG_WARNING) endif endif @@ -752,10 +593,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ocean_internalstate%ptr%ocean_state_type_ptr => ocean_state call ESMF_GridCompSetInternalState(gcomp, ocean_internalstate, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return if (len_trim(scalar_field_name) > 0) then call fld_list_add(fldsToOcn_num, fldsToOcn, trim(scalar_field_name), "will_provide") @@ -810,18 +648,12 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) do n = 1,fldsToOcn_num call NUOPC_Advertise(importState, standardName=fldsToOcn(n)%stdname, name=fldsToOcn(n)%shortname, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return enddo do n = 1,fldsFrOcn_num call NUOPC_Advertise(exportState, standardName=fldsFrOcn(n)%stdname, name=fldsFrOcn(n)%shortname, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return enddo end subroutine InitializeAdvertise @@ -905,10 +737,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) !---------------------------------------------------------------------------- call ESMF_GridCompGetInternalState(gcomp, ocean_internalstate, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return Ice_ocean_boundary => ocean_internalstate%ptr%ice_ocean_boundary_type_ptr ocean_public => ocean_internalstate%ptr%ocean_public_type_ptr @@ -919,16 +748,10 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) !---------------------------------------------------------------------------- call ESMF_VMGetCurrent(vm, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_VMGet(vm, petCount=npet, mpiCommunicator=mpicom, localPet=localPet, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return !--------------------------------- ! global mom grid size @@ -936,11 +759,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) call mpp_get_global_domain(ocean_public%domain, xsize=nxg, ysize=nyg) write(tmpstr,'(a,2i6)') subname//' nxg,nyg = ',nxg,nyg - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) !--------------------------------- ! number of tiles per PET, assumed to be 1, and number of pes (tiles) total @@ -949,19 +768,11 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ntiles=mpp_get_ntile_count(ocean_public%domain) ! this is tiles on this pe if (ntiles /= 1) then rc = ESMF_FAILURE - call ESMF_LogWrite(subname//' ntiles must be 1', ESMF_LOGMSG_ERROR, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + call ESMF_LogWrite(subname//' ntiles must be 1', ESMF_LOGMSG_ERROR) endif ntiles=mpp_get_domain_npes(ocean_public%domain) write(tmpstr,'(a,1i6)') subname//' ntiles = ',ntiles - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) !--------------------------------- ! get start and end indices of each tile and their PET @@ -973,11 +784,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) 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, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) enddo endif @@ -1010,23 +817,14 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) enddo DistGrid = ESMF_DistGridCreate(arbSeqIndexList=gindex, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + if (ChkErr(rc,__LINE__,u_FILE_u)) return ! read in the mesh call NUOPC_CompAttributeGet(gcomp, name='mesh_ocn', value=cvalue, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + if (ChkErr(rc,__LINE__,u_FILE_u)) return EMeshTemp = ESMF_MeshCreate(filename=trim(cvalue), fileformat=ESMF_FILEFORMAT_ESMFMESH, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + if (ChkErr(rc,__LINE__,u_FILE_u)) return if (localPet == 0) then write(logunit,*)'mesh file for mom6 domain is ',trim(cvalue) @@ -1034,17 +832,11 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! recreate the mesh using the above distGrid EMesh = ESMF_MeshCreate(EMeshTemp, elementDistgrid=Distgrid, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + if (ChkErr(rc,__LINE__,u_FILE_u)) return ! Check for consistency of lat, lon and mask between mesh and mom6 grid call ESMF_MeshGet(Emesh, spatialDim=spatialDim, numOwnedElements=numOwnedElements, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + if (ChkErr(rc,__LINE__,u_FILE_u)) return allocate(ownedElemCoords(spatialDim*numOwnedElements)) allocate(lonMesh(numOwnedElements), lon(numOwnedElements)) @@ -1052,25 +844,16 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) allocate(maskMesh(numOwnedElements), mask(numOwnedElements)) call ESMF_MeshGet(Emesh, ownedElemCoords=ownedElemCoords, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + if (ChkErr(rc,__LINE__,u_FILE_u)) return do n = 1,numOwnedElements lonMesh(n) = ownedElemCoords(2*n-1) latMesh(n) = ownedElemCoords(2*n) end do elemMaskArray = ESMF_ArrayCreate(Distgrid, maskMesh, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_MeshGet(Emesh, elemMaskArray=elemMaskArray, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + if (ChkErr(rc,__LINE__,u_FILE_u)) return call mpp_get_compute_domain(ocean_public%domain, isc, iec, jsc, jec) n = 0 @@ -1117,16 +900,10 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) deallocate(maskMesh, mask) ! realize the import and export fields using the mesh call MOM_RealizeFields(importState, fldsToOcn_num, fldsToOcn, "Ocn import", mesh=Emesh, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + if (ChkErr(rc,__LINE__,u_FILE_u)) return call MOM_RealizeFields(exportState, fldsFrOcn_num, fldsFrOcn, "Ocn export", mesh=Emesh, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + if (ChkErr(rc,__LINE__,u_FILE_u)) return else if (geomtype == ESMF_GEOMTYPE_GRID) then @@ -1148,19 +925,16 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) deBlockList(2,2,n) = ye(n) petMap(n) = pe(n) ! write(tmpstr,'(a,3i8)') subname//' iglo = ',n,deBlockList(1,1,n),deBlockList(1,2,n) - ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) ! write(tmpstr,'(a,3i8)') subname//' jglo = ',n,deBlockList(2,1,n),deBlockList(2,2,n) - ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) ! write(tmpstr,'(a,2i8)') subname//' pe = ',n,petMap(n) - ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) !--- assume a tile with starting index of 1 has an equivalent wraparound tile on the other side enddo delayout = ESMF_DELayoutCreate(petMap, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return ! rsd this assumes tripole grid, but sometimes in CESM a bipole ! grid is used -- need to introduce conditional logic here @@ -1171,18 +945,12 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) call ESMF_DistGridConnectionSet(connectionList(1), tileIndexA=1, & tileIndexB=1, positionVector=(/nxg+1, 2*nyg+1/), & orientationVector=(/-1, -2/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return ! periodic boundary condition along first dimension call ESMF_DistGridConnectionSet(connectionList(2), tileIndexA=1, & tileIndexB=1, positionVector=(/nxg, 0/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + if (ChkErr(rc,__LINE__,u_FILE_u)) return distgrid = ESMF_DistGridCreate(minIndex=(/1,1/), maxIndex=(/nxg,nyg/), & ! indexflag = ESMF_INDEX_DELOCAL, & @@ -1191,10 +959,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) delayout=delayout, & connectionList=connectionList, & rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + if (ChkErr(rc,__LINE__,u_FILE_u)) return deallocate(xb,xe,yb,ye,pe) deallocate(connectionList) @@ -1203,32 +968,18 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) deallocate(petMap) call ESMF_DistGridGet(distgrid=distgrid, localDE=0, elementCount=cnt, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + if (ChkErr(rc,__LINE__,u_FILE_u)) return allocate(indexList(cnt)) write(tmpstr,'(a,i8)') subname//' distgrid cnt= ',cnt - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) call ESMF_DistGridGet(distgrid=distgrid, localDE=0, seqIndexList=indexList, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + if (ChkErr(rc,__LINE__,u_FILE_u)) return write(tmpstr,'(a,4i8)') subname//' distgrid list= ',& indexList(1),indexList(cnt),minval(indexList), maxval(indexList) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) deallocate(IndexList) @@ -1238,91 +989,55 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) gridEdgeLWidth=(/0,0/), gridEdgeUWidth=(/0,1/), & coordSys = ESMF_COORDSYS_SPH_DEG, & rc = rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return - + if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_GridAddCoord(gridIn, staggerLoc=ESMF_STAGGERLOC_CENTER, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_GridAddCoord(gridIn, staggerLoc=ESMF_STAGGERLOC_CORNER, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_GridAddItem(gridIn, itemFlag=ESMF_GRIDITEM_MASK, itemTypeKind=ESMF_TYPEKIND_I4, & staggerLoc=ESMF_STAGGERLOC_CENTER, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + if (ChkErr(rc,__LINE__,u_FILE_u)) return ! Attach area to the Grid optionally. By default the cell areas are computed. if(grid_attach_area) then call ESMF_GridAddItem(gridIn, itemFlag=ESMF_GRIDITEM_AREA, itemTypeKind=ESMF_TYPEKIND_R8, & staggerLoc=ESMF_STAGGERLOC_CENTER, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return - + if (ChkErr(rc,__LINE__,u_FILE_u)) return endif call ESMF_GridGetCoord(gridIn, coordDim=1, & staggerloc=ESMF_STAGGERLOC_CENTER, & farrayPtr=dataPtr_xcen, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_GridGetCoord(gridIn, coordDim=2, & staggerloc=ESMF_STAGGERLOC_CENTER, & farrayPtr=dataPtr_ycen, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return - + if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_GridGetCoord(gridIn, coordDim=1, & staggerloc=ESMF_STAGGERLOC_CORNER, & farrayPtr=dataPtr_xcor, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_GridGetCoord(gridIn, coordDim=2, & staggerloc=ESMF_STAGGERLOC_CORNER, & farrayPtr=dataPtr_ycor, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_GridGetItem(gridIn, itemflag=ESMF_GRIDITEM_MASK, & staggerloc=ESMF_STAGGERLOC_CENTER, & farrayPtr=dataPtr_mask, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + if (ChkErr(rc,__LINE__,u_FILE_u)) return if(grid_attach_area) then call ESMF_GridGetItem(gridIn, itemflag=ESMF_GRIDITEM_AREA, & staggerloc=ESMF_STAGGERLOC_CENTER, & farrayPtr=dataPtr_area, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + if (ChkErr(rc,__LINE__,u_FILE_u)) return endif ! load up area, mask, center and corner values @@ -1345,13 +1060,13 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ubnd4 = ubound(dataPtr_xcor,2) write(tmpstr,*) subname//' iscjsc = ',isc,iec,jsc,jec - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) write(tmpstr,*) subname//' lbub12 = ',lbnd1,ubnd1,lbnd2,ubnd2 - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) write(tmpstr,*) subname//' lbub34 = ',lbnd3,ubnd3,lbnd4,ubnd4 - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) if (iec-isc /= ubnd1-lbnd1 .or. jec-jsc /= ubnd2-lbnd2) then call ESMF_LogSetError(ESMF_RC_ARG_BAD, & @@ -1390,38 +1105,32 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) enddo write(tmpstr,*) subname//' mask = ',minval(dataPtr_mask),maxval(dataPtr_mask) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) if(grid_attach_area) then write(tmpstr,*) subname//' area = ',minval(dataPtr_area),maxval(dataPtr_area) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) endif write(tmpstr,*) subname//' xcen = ',minval(dataPtr_xcen),maxval(dataPtr_xcen) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) write(tmpstr,*) subname//' ycen = ',minval(dataPtr_ycen),maxval(dataPtr_ycen) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) write(tmpstr,*) subname//' xcor = ',minval(dataPtr_xcor),maxval(dataPtr_xcor) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) write(tmpstr,*) subname//' ycor = ',minval(dataPtr_ycor),maxval(dataPtr_ycor) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) gridOut = gridIn ! for now out same as in call MOM_RealizeFields(importState, fldsToOcn_num, fldsToOcn, "Ocn import", grid=gridIn, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + if (ChkErr(rc,__LINE__,u_FILE_u)) return call MOM_RealizeFields(exportState, fldsFrOcn_num, fldsFrOcn, "Ocn export", grid=gridOut, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + if (ChkErr(rc,__LINE__,u_FILE_u)) return endif @@ -1432,18 +1141,11 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) if (len_trim(scalar_field_name) > 0) then call State_SetScalar(dble(nxg),scalar_field_idx_grid_nx, exportState, localPet, & scalar_field_name, scalar_field_count, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + if (ChkErr(rc,__LINE__,u_FILE_u)) return call State_SetScalar(dble(nyg),scalar_field_idx_grid_ny, exportState, localPet, & scalar_field_name, scalar_field_count, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return - + if (ChkErr(rc,__LINE__,u_FILE_u)) return endif !--------------------------------- @@ -1457,10 +1159,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) !call NUOPC_Write(exportState, fileNamePrefix='post_realize_field_ocn_export_', & ! timeslice=1, relaxedFlag=.true., rc=rc) - !if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - ! line=__LINE__, & - ! file=__FILE__)) & - ! return ! bail out + !if (ChkErr(rc,__LINE__,u_FILE_u)) return end subroutine InitializeRealize @@ -1489,16 +1188,10 @@ subroutine DataInitialize(gcomp, rc) ! query the Component for its clock, importState and exportState call ESMF_GridCompGet(gcomp, clock=clock, importState=importState, exportState=exportState, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_GridCompGetInternalState(gcomp, ocean_internalstate, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return Ice_ocean_boundary => ocean_internalstate%ptr%ice_ocean_boundary_type_ptr ocean_public => ocean_internalstate%ptr%ocean_public_type_ptr @@ -1506,57 +1199,35 @@ subroutine DataInitialize(gcomp, rc) call get_ocean_grid(ocean_state, ocean_grid) call mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_StateGet(exportState, itemCount=fieldCount, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return allocate(fieldNameList(fieldCount)) call ESMF_StateGet(exportState, itemNameList=fieldNameList, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return do n=1, fieldCount call ESMF_StateGet(exportState, itemName=fieldNameList(n), field=field, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return call NUOPC_SetAttribute(field, name="Updated", value="true", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return enddo deallocate(fieldNameList) ! check whether all Fields in the exportState are "Updated" if (NUOPC_IsUpdated(exportState)) then call NUOPC_CompAttributeSet(gcomp, name="InitializeDataComplete", value="true", rc=rc) - - call ESMF_LogWrite("MOM6 - Initialize-Data-Dependency SATISFIED!!!", ESMF_LOGMSG_INFO, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_LogWrite("MOM6 - Initialize-Data-Dependency SATISFIED!!!", ESMF_LOGMSG_INFO) endif if(write_diagnostics) then call NUOPC_Write(exportState, fileNamePrefix='field_init_ocn_export_', & overwrite=overwrite_timeslice,timeslice=import_slice, relaxedFlag=.true., rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return endif end subroutine DataInitialize @@ -1606,43 +1277,23 @@ subroutine ModelAdvance(gcomp, rc) ! query the Component for its clock, importState and exportState call ESMF_GridCompGet(gcomp, clock=clock, importState=importState, & exportState=exportState, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return ! HERE THE MODEL ADVANCES: currTime -> currTime + timeStep call ESMF_ClockPrint(clock, options="currTime", & preString="------>Advancing OCN from: ", unit=msgString, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call ESMF_LogWrite(subname//trim(msgString), ESMF_LOGMSG_INFO, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_LogWrite(subname//trim(msgString), ESMF_LOGMSG_INFO) call ESMF_ClockGet(clock, startTime=startTime, currTime=currTime, & timeStep=timeStep, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_TimePrint(currTime + timeStep, & preString="--------------------------------> to: ", unit=msgString, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) Time_step_coupled = esmf2fms_time(timeStep) Time = esmf2fms_time(currTime) @@ -1656,11 +1307,7 @@ subroutine ModelAdvance(gcomp, rc) ! Do not call MOM6 timestepping routine if the first cpl tstep of a startup run if (currTime == startTime) then - call ESMF_LogWrite("MOM6 - Skipping the first coupling timestep", ESMF_LOGMSG_INFO, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + call ESMF_LogWrite("MOM6 - Skipping the first coupling timestep", ESMF_LOGMSG_INFO) do_advance = .false. else do_advance = .true. @@ -1669,18 +1316,10 @@ subroutine ModelAdvance(gcomp, rc) if (do_advance) then ! If the second cpl tstep of a startup run, step back a cpl tstep and advance for two cpl tsteps if (currTime == startTime + timeStep) then - call ESMF_LogWrite("MOM6 - Stepping back one coupling timestep", ESMF_LOGMSG_INFO, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + call ESMF_LogWrite("MOM6 - Stepping back one coupling timestep", ESMF_LOGMSG_INFO) Time = esmf2fms_time(currTime-timeStep) ! i.e., startTime - call ESMF_LogWrite("MOM6 - doubling the coupling timestep", ESMF_LOGMSG_INFO, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + call ESMF_LogWrite("MOM6 - doubling the coupling timestep", ESMF_LOGMSG_INFO) Time_step_coupled = 2 * esmf2fms_time(timeStep) endif end if @@ -1691,10 +1330,7 @@ subroutine ModelAdvance(gcomp, rc) if (do_advance) then call ESMF_GridCompGetInternalState(gcomp, ocean_internalstate, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return Ice_ocean_boundary => ocean_internalstate%ptr%ice_ocean_boundary_type_ptr ocean_public => ocean_internalstate%ptr%ocean_public_type_ptr @@ -1707,10 +1343,7 @@ subroutine ModelAdvance(gcomp, rc) if (write_diagnostics) then call NUOPC_Write(importState, fileNamePrefix='field_ocn_import_', & overwrite=overwrite_timeslice,timeslice=import_slice, relaxedFlag=.true., rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return import_slice = import_slice + 1 endif @@ -1725,10 +1358,7 @@ subroutine ModelAdvance(gcomp, rc) !--------------- call mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return !--------------- ! Update MOM6 @@ -1743,10 +1373,7 @@ subroutine ModelAdvance(gcomp, rc) !--------------- call mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return endif @@ -1755,78 +1382,44 @@ subroutine ModelAdvance(gcomp, rc) !--------------- call ESMF_ClockGetAlarm(clock, alarmname='alarm_restart', alarm=alarm, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return if (ESMF_AlarmIsRinging(alarm, rc=rc)) then - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_AlarmRingerOff(alarm, rc=rc ) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return ! call into system specific method to get desired restart filename restartname = "" call ESMF_MethodExecute(gcomp, label="GetRestartFileToWrite", & existflag=existflag, userRc=userRc, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg="Error executing user method to get restart filename", & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, file=__FILE__)) return ! bail out if (ESMF_LogFoundError(rcToCheck=userRc, msg="Error in method to get restart filename", & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, file=__FILE__)) return ! bail out if (existflag) then - call ESMF_LogWrite("MOM_cap: called user GetRestartFileToWrite method", ESMF_LOGMSG_INFO, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + call ESMF_LogWrite("MOM_cap: called user GetRestartFileToWrite method", ESMF_LOGMSG_INFO) call NUOPC_CompAttributeGet(gcomp, name='RestartFileToWrite', & isPresent=isPresent, isSet=isSet, value=cvalue, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return if (isPresent .and. isSet) then restartname = trim(cvalue) - call ESMF_LogWrite("MOM_cap: User RestartFileToWrite: "//trim(restartname), ESMF_LOGMSG_INFO, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + call ESMF_LogWrite("MOM_cap: User RestartFileToWrite: "//trim(restartname), ESMF_LOGMSG_INFO) endif endif if (len_trim(restartname) == 0) then ! none provided, so use a default restart filename call ESMF_ClockGetNextTime(clock, MyTime, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_TimeGet (MyTime, yy=year, mm=month, dd=day, & h=hour, m=minute, s=seconds, rc=rc ) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return write(restartname,'(A,".mom6.r.",I4.4,"-",I2.2,"-",I2.2,"-",I2.2,"-",I2.2,"-",I2.2)') & "ocn", year, month, day, hour, minute, seconds - call ESMF_LogWrite("MOM_cap: Using default restart filename: "//trim(restartname), ESMF_LOGMSG_INFO, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + call ESMF_LogWrite("MOM_cap: Using default restart filename: "//trim(restartname), ESMF_LOGMSG_INFO) endif ! TODO: address if this requirement is being met for the DA group @@ -1834,15 +1427,12 @@ subroutine ModelAdvance(gcomp, rc) ! if (restart_interval > 0 ) then ! time_elapsed = currTime - startTime ! call ESMF_TimeIntervalGet(time_elapsed, s_i8=time_elapsed_sec, rc=rc) - ! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - ! line=__LINE__, & - ! file=__FILE__)) & - ! return ! bail out + ! if (ChkErr(rc,__LINE__,u_FILE_u)) return ! n_interval = time_elapsed_sec / restart_interval ! if ((n_interval .gt. 0) .and. (n_interval*restart_interval == time_elapsed_sec)) then ! time_restart_current = esmf2fms_time(currTime) ! timestamp = date_to_string(time_restart_current) - ! call ESMF_LogWrite("MOM: Writing restart at "//trim(timestamp), ESMF_LOGMSG_INFO, rc=rc) + ! call ESMF_LogWrite("MOM: Writing restart at "//trim(timestamp), ESMF_LOGMSG_INFO) ! write(*,*) 'calling ocean_model_restart' ! call ocean_model_restart(ocean_state, timestamp) ! endif @@ -1863,10 +1453,7 @@ subroutine ModelAdvance(gcomp, rc) if (write_diagnostics) then call NUOPC_Write(exportState, fileNamePrefix='field_ocn_export_', & overwrite=overwrite_timeslice,timeslice=export_slice, relaxedFlag=.true., rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return export_slice = export_slice + 1 endif @@ -1899,22 +1486,13 @@ subroutine ModelSetRunClock(gcomp, rc) ! query the Component for its clock, importState and exportState call NUOPC_ModelGet(gcomp, driverClock=dclock, modelClock=mclock, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_ClockGet(dclock, currTime=dcurrtime, timeStep=dtimestep, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_ClockGet(mclock, currTime=mcurrtime, timeStep=mtimestep, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return !-------------------------------- ! check that the current time in the model and driver are the same @@ -1922,16 +1500,10 @@ subroutine ModelSetRunClock(gcomp, rc) if (mcurrtime /= dcurrtime) then call ESMF_TimeGet(dcurrtime, timeString=dtimestring, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_TimeGet(mcurrtime, timeString=mtimestring, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_LogSetError(ESMF_RC_VAL_WRONG, & msg=subname//": ERROR in time consistency: "//trim(dtimestring)//" != "//trim(mtimestring), & @@ -1946,10 +1518,7 @@ subroutine ModelSetRunClock(gcomp, rc) mstoptime = mcurrtime + dtimestep call ESMF_ClockSet(mclock, currTime=dcurrtime, timeStep=dtimestep, stopTime=mstoptime, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return if (first_time) then !-------------------------------- @@ -1962,26 +1531,17 @@ subroutine ModelSetRunClock(gcomp, rc) call NUOPC_CompAttributeGet(gcomp, name="restart_option", isPresent=isPresent, & isSet=isSet, value=restart_option, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return if (isPresent .and. isSet) then call NUOPC_CompAttributeGet(gcomp, name="restart_n", value=cvalue, & isPresent=isPresent, isSet=isSet, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return if (isPresent .and. isSet) then read(cvalue,*) restart_n endif call NUOPC_CompAttributeGet(gcomp, name="restart_ymd", value=cvalue, & isPresent=isPresent, isSet=isSet, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return if (isPresent .and. isSet) then read(cvalue,*) restart_ymd endif @@ -1996,24 +1556,13 @@ subroutine ModelSetRunClock(gcomp, rc) opt_ymd = restart_ymd, & RefTime = mcurrTime, & alarmname = 'alarm_restart', rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_AlarmSet(restart_alarm, clock=mclock, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return first_time = .false. - call ESMF_LogWrite(subname//" Set restart option = "//restart_option, & - ESMF_LOGMSG_INFO, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + call ESMF_LogWrite(subname//" Set restart option = "//restart_option, ESMF_LOGMSG_INFO) endif @@ -2022,20 +1571,13 @@ subroutine ModelSetRunClock(gcomp, rc) !-------------------------------- call ESMF_ClockAdvance(mclock,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_ClockSet(mclock, currTime=dcurrtime, timeStep=dtimestep, stopTime=mstoptime, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return end subroutine ModelSetRunClock - !=============================================================================== !> Called by NUOPC at the end of the run to clean up. @@ -2061,25 +1603,16 @@ subroutine ocean_model_finalize(gcomp, rc) rc = ESMF_SUCCESS call ESMF_GridCompGetInternalState(gcomp, ocean_internalstate, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return ocean_public => ocean_internalstate%ptr%ocean_public_type_ptr ocean_state => ocean_internalstate%ptr%ocean_state_type_ptr call NUOPC_ModelGet(gcomp, modelClock=clock, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_ClockGet(clock, currTime=currTime, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return Time = esmf2fms_time(currTime) if (cesm_coupled) then @@ -2116,16 +1649,15 @@ subroutine State_SetScalar(value, scalar_id, State, mytask, scalar_name, scalar_ rc = ESMF_SUCCESS call ESMF_StateGet(State, itemName=trim(scalar_name), field=field, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return if (mytask == 0) then call ESMF_FieldGet(field, farrayPtr=farrayptr, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return if (scalar_id < 0 .or. scalar_id > scalar_count) then call ESMF_LogSetError(ESMF_RC_ARG_BAD, & - msg=subname//": ERROR in scalar_id", & - line=__LINE__, file=__FILE__, rcToReturn=rc) + msg=subname//": ERROR in scalar_id", line=__LINE__, file=__FILE__, rcToReturn=rc) return endif @@ -2163,57 +1695,36 @@ subroutine MOM_RealizeFields(state, nfields, field_defs, tag, grid, mesh, rc) if (field_defs(i)%shortname == scalar_field_name) then call ESMF_LogWrite(subname // tag // " Field "// trim(field_defs(i)%stdname) // " is connected on root pe.", & - ESMF_LOGMSG_INFO, & - line=__LINE__, & - file=__FILE__, & - rc=rc) + ESMF_LOGMSG_INFO) call SetScalarField(field, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return else call ESMF_LogWrite(subname // tag // " Field "// trim(field_defs(i)%stdname) // " is connected.", & - ESMF_LOGMSG_INFO, & - line=__LINE__, & - file=__FILE__, & - rc=rc) + ESMF_LOGMSG_INFO) if (present(grid)) then field = ESMF_FieldCreate(grid, ESMF_TYPEKIND_R8, indexflag=ESMF_INDEX_DELOCAL, & name=field_defs(i)%shortname, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return ! initialize fldptr to zero call ESMF_FieldGet(field, farrayPtr=fldptr2d, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return fldptr2d(:,:) = 0.0 else if (present(mesh)) then field = ESMF_FieldCreate(mesh=mesh, typekind=ESMF_TYPEKIND_R8, meshloc=ESMF_MESHLOC_ELEMENT, & name=field_defs(i)%shortname, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return ! initialize fldptr to zero call ESMF_FieldGet(field, farrayPtr=fldptr1d, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return fldptr1d(:) = 0.0 endif @@ -2222,24 +1733,16 @@ subroutine MOM_RealizeFields(state, nfields, field_defs, tag, grid, mesh, rc) ! Realize connected field call NUOPC_Realize(state, field=field, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return else ! field is not connected call ESMF_LogWrite(subname // tag // " Field "// trim(field_defs(i)%stdname) // " is not connected.", & - ESMF_LOGMSG_INFO, & - line=__LINE__, & - file=__FILE__, & - rc=rc) + ESMF_LOGMSG_INFO) + ! remove a not connected Field from State call ESMF_StateRemove(state, (/field_defs(i)%shortname/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return endif @@ -2262,24 +1765,15 @@ subroutine SetScalarField(field, rc) ! create a DistGrid with a single index space element, which gets mapped onto DE 0. distgrid = ESMF_DistGridCreate(minIndex=(/1/), maxIndex=(/1/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return grid = ESMF_GridCreate(distgrid, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return ! num of scalar values field = ESMF_FieldCreate(name=trim(scalar_field_name), grid=grid, typekind=ESMF_TYPEKIND_R8, & ungriddedLBound=(/1/), ungriddedUBound=(/scalar_field_count/), gridToFieldMap=(/2/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return end subroutine SetScalarField @@ -2333,6 +1827,18 @@ subroutine shr_file_getLogUnit(nunit) end subroutine shr_file_getLogUnit #endif +logical function chkerr(rc, line, file) + integer, intent(in) :: rc + integer, intent(in) :: line + character(len=*), intent(in) :: file + integer :: lrc + chkerr = .false. + lrc = rc + if (ESMF_LogFoundError(rcToCheck=lrc, msg=ESMF_LOGERR_PASSTHRU, line=line, file=file)) then + chkerr = .true. + endif +end function chkerr + !> !! @page nuopc_cap NUOPC Cap !! @author Fei Liu (fei.liu@gmail.com) diff --git a/config_src/nuopc_driver/mom_cap_methods.F90 b/config_src/nuopc_driver/mom_cap_methods.F90 index 70915d0e95..2c69b504e0 100644 --- a/config_src/nuopc_driver/mom_cap_methods.F90 +++ b/config_src/nuopc_driver/mom_cap_methods.F90 @@ -43,6 +43,9 @@ module MOM_cap_methods type(ESMF_GeomType_Flag) :: geomtype !< SMF type describing type of !! geometry (mesh or grid) +character(len=*),parameter :: u_FILE_u = & + __FILE__ + contains !> Sets module variable geometry type @@ -86,60 +89,42 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, !---- call state_getimport(importState, 'inst_pres_height_surface', & isc, iec, jsc, jec, ice_ocean_boundary%p, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return !---- ! near-IR, direct shortwave (W/m2) !---- call state_getimport(importState, 'mean_net_sw_ir_dir_flx', & isc, iec, jsc, jec, ice_ocean_boundary%sw_flux_nir_dir, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return !---- ! near-IR, diffuse shortwave (W/m2) !---- call state_getimport(importState, 'mean_net_sw_ir_dif_flx', & isc, iec, jsc, jec, ice_ocean_boundary%sw_flux_nir_dif, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return !---- ! visible, direct shortwave (W/m2) !---- call state_getimport(importState, 'mean_net_sw_vis_dir_flx', & isc, iec, jsc, jec, ice_ocean_boundary%sw_flux_vis_dir, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return !---- ! visible, diffuse shortwave (W/m2) !---- call state_getimport(importState, 'mean_net_sw_vis_dif_flx', & isc, iec, jsc, jec, ice_ocean_boundary%sw_flux_vis_dif, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return ! ------- ! Net longwave radiation (W/m2) ! ------- call state_getimport(importState, 'mean_net_lw_flx', & isc, iec, jsc, jec, ice_ocean_boundary%lw_flux, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return !---- ! zonal and meridional surface stress @@ -148,15 +133,9 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, allocate (tauy(isc:iec,jsc:jec)) call state_getimport(importState, 'mean_zonal_moment_flx', isc, iec, jsc, jec, taux, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return call state_getimport(importState, 'mean_merid_moment_flx', isc, iec, jsc, jec, tauy, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return ! rotate taux and tauy from true zonal/meridional to local coordinates @@ -178,40 +157,28 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, !---- call state_getimport(importState, 'mean_sensi_heat_flx', & isc, iec, jsc, jec, ice_ocean_boundary%t_flux, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return !---- ! evaporation flux (W/m2) !---- call state_getimport(importState, 'mean_evap_rate', & isc, iec, jsc, jec, ice_ocean_boundary%q_flux, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return !---- ! liquid precipitation (rain) !---- call state_getimport(importState, 'mean_prec_rate', & isc, iec, jsc, jec, ice_ocean_boundary%lprec, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return !---- ! frozen precipitation (snow) !---- call state_getimport(importState, 'mean_fprec_rate', & isc, iec, jsc, jec, ice_ocean_boundary%fprec, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return !---- ! mass and heat content of liquid and frozen runoff @@ -223,37 +190,25 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, ice_ocean_boundary%lrunoff (:,:) = 0._ESMF_KIND_R8 call state_getimport(importState, 'Foxx_rofl', & isc, iec, jsc, jec, ice_ocean_boundary%lrunoff,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return ! ice runoff ice_ocean_boundary%frunoff (:,:) = 0._ESMF_KIND_R8 call state_getimport(importState, 'Foxx_rofi', & isc, iec, jsc, jec, ice_ocean_boundary%frunoff,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return ! heat content of lrunoff ice_ocean_boundary%lrunoff_hflx(:,:) = 0._ESMF_KIND_R8 call state_getimport(importState, 'mean_runoff_heat_flx', & isc, iec, jsc, jec, ice_ocean_boundary%lrunoff_hflx, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return ! heat content of frunoff ice_ocean_boundary%frunoff_hflx(:,:) = 0._ESMF_KIND_R8 call state_getimport(importState, 'mean_calving_heat_flx', & isc, iec, jsc, jec, ice_ocean_boundary%frunoff_hflx, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return !---- ! salt flux from ice @@ -261,10 +216,7 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, ice_ocean_boundary%salt_flux(:,:) = 0._ESMF_KIND_R8 call state_getimport(importState, 'mean_salt_rate', & isc, iec, jsc, jec, ice_ocean_boundary%salt_flux,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return ! !---- ! ! snow&ice melt heat flux (W/m^2) @@ -272,10 +224,7 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, ice_ocean_boundary%seaice_melt_heat(:,:) = 0._ESMF_KIND_R8 call state_getimport(importState, 'net_heat_flx_to_ocn', & isc, iec, jsc, jec, ice_ocean_boundary%seaice_melt_heat,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return ! !---- ! ! snow&ice melt water flux (W/m^2) @@ -283,10 +232,7 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, ice_ocean_boundary%seaice_melt(:,:) = 0._ESMF_KIND_R8 call state_getimport(importState, 'mean_fresh_water_to_ocean_rate', & isc, iec, jsc, jec, ice_ocean_boundary%seaice_melt,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return !---- ! mass of overlying ice @@ -297,10 +243,7 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, ice_ocean_boundary%mi(:,:) = 0._ESMF_KIND_R8 call state_getimport(importState, 'mass_of_overlying_ice', & isc, iec, jsc, jec, ice_ocean_boundary%mi, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return end subroutine mom_import @@ -339,16 +282,10 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, rc = ESMF_SUCCESS call ESMF_ClockGet( clock, timeStep=timeStep, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_TimeIntervalGet( timeStep, s=dt_int, rc=rc ) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return ! Use Adcroft's rule of reciprocals; it does the right thing here. if (real(dt_int) > 0.0) then @@ -378,10 +315,7 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, call State_SetExport(exportState, 'ocean_mask', & isc, iec, jsc, jec, omask, ocean_grid, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return deallocate(omask) @@ -390,20 +324,14 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, ! ------- call State_SetExport(exportState, 'sea_surface_temperature', & isc, iec, jsc, jec, ocean_public%t_surf, ocean_grid, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return ! ------- ! Sea surface salinity ! ------- call State_SetExport(exportState, 's_surf', & isc, iec, jsc, jec, ocean_public%s_surf, ocean_grid, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return ! ------- ! zonal and meridional currents @@ -430,17 +358,11 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, call State_SetExport(exportState, 'ocn_current_zonal', & isc, iec, jsc, jec, ocz_rot, ocean_grid, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return call State_SetExport(exportState, 'ocn_current_merid', & isc, iec, jsc, jec, ocm_rot, ocean_grid, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return deallocate(ocz, ocm, ocz_rot, ocm_rot) @@ -451,10 +373,7 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, if (itemFlag /= ESMF_STATEITEM_NOTFOUND) then call State_SetExport(exportState, 'So_bldepth', & isc, iec, jsc, jec, ocean_public%obld, ocean_grid, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return endif ! ------- @@ -478,10 +397,7 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, call State_SetExport(exportState, 'freezing_melting_potential', & isc, iec, jsc, jec, melt_potential, ocean_grid, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return deallocate(melt_potential) @@ -492,10 +408,7 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, if (itemFlag /= ESMF_STATEITEM_NOTFOUND) then call State_SetExport(exportState, 'sea_level', & isc, iec, jsc, jec, ocean_public%sea_lev, ocean_grid, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return endif !---------------- @@ -598,17 +511,11 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, call State_SetExport(exportState, 'sea_surface_slope_zonal', & isc, iec, jsc, jec, dhdx_rot, ocean_grid, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return call State_SetExport(exportState, 'sea_surface_slope_merid', & isc, iec, jsc, jec, dhdy_rot, ocean_grid, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return deallocate(ssh, dhdx, dhdy, dhdx_rot, dhdy_rot) @@ -627,15 +534,9 @@ subroutine State_GetFldPtr_1d(State, fldname, fldptr, rc) character(len=*),parameter :: subname='(MOM_cap:State_GetFldPtr)' call ESMF_StateGet(State, itemName=trim(fldname), field=lfield, rc=lrc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_FieldGet(lfield, farrayPtr=fldptr, rc=lrc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return if (present(rc)) rc = lrc @@ -654,15 +555,9 @@ subroutine State_GetFldPtr_2d(State, fldname, fldptr, rc) character(len=*),parameter :: subname='(MOM_cap:State_GetFldPtr)' call ESMF_StateGet(State, itemName=trim(fldname), field=lfield, rc=lrc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_FieldGet(lfield, farrayPtr=fldptr, rc=lrc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return if (present(rc)) rc = lrc @@ -702,10 +597,7 @@ subroutine State_GetImport(state, fldname, isc, iec, jsc, jec, output, do_sum, r ! get field pointer call state_getfldptr(state, trim(fldname), dataptr1d, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return ! determine output array n = 0 @@ -723,10 +615,7 @@ subroutine State_GetImport(state, fldname, isc, iec, jsc, jec, output, do_sum, r else if (geomtype == ESMF_GEOMTYPE_GRID) then call state_getfldptr(state, trim(fldname), dataptr2d, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return lbnd1 = lbound(dataPtr2d,1) lbnd2 = lbound(dataPtr2d,2) @@ -786,10 +675,7 @@ subroutine State_SetExport(state, fldname, isc, iec, jsc, jec, input, ocean_grid if (geomtype == ESMF_GEOMTYPE_MESH) then call state_getfldptr(state, trim(fldname), dataptr1d, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return n = 0 do j = jsc, jec @@ -804,10 +690,7 @@ subroutine State_SetExport(state, fldname, isc, iec, jsc, jec, input, ocean_grid else if (geomtype == ESMF_GEOMTYPE_GRID) then call state_getfldptr(state, trim(fldname), dataptr2d, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return lbnd1 = lbound(dataPtr2d,1) lbnd2 = lbound(dataPtr2d,2) @@ -828,4 +711,16 @@ subroutine State_SetExport(state, fldname, isc, iec, jsc, jec, input, ocean_grid end subroutine State_SetExport +logical function chkerr(rc, line, file) + integer, intent(in) :: rc + integer, intent(in) :: line + character(len=*), intent(in) :: file + integer :: lrc + chkerr = .false. + lrc = rc + if (ESMF_LogFoundError(rcToCheck=lrc, msg=ESMF_LOGERR_PASSTHRU, line=line, file=file)) then + chkerr = .true. + endif +end function chkerr + end module MOM_cap_methods diff --git a/config_src/nuopc_driver/mom_cap_time.F90 b/config_src/nuopc_driver/mom_cap_time.F90 index daf9889c43..aa1a6c7072 100644 --- a/config_src/nuopc_driver/mom_cap_time.F90 +++ b/config_src/nuopc_driver/mom_cap_time.F90 @@ -125,22 +125,13 @@ subroutine AlarmInit( clock, alarm, option, & endif call ESMF_ClockGet(clock, CurrTime=CurrTime, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_TimeGet(CurrTime, yy=cyy, mm=cmm, dd=cdd, s=csec, rc=rc ) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_TimeGet(CurrTime, yy=nyy, mm=nmm, dd=ndd, s=nsec, rc=rc ) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + if (ChkErr(rc,__LINE__,u_FILE_u)) return ! initial guess of next alarm, this will be updated below if (present(RefTime)) then @@ -151,25 +142,16 @@ subroutine AlarmInit( clock, alarm, option, & ! Determine calendar call ESMF_ClockGet(clock, calendar=cal, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + if (ChkErr(rc,__LINE__,u_FILE_u)) return ! Determine inputs for call to create alarm selectcase (trim(option)) case (optNONE, optNever) call ESMF_TimeIntervalSet(AlarmInterval, yy=9999, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_TimeSet( NextAlarm, yy=9999, mm=12, dd=1, s=0, calendar=cal, rc=rc ) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + if (ChkErr(rc,__LINE__,u_FILE_u)) return update_nextalarm = .false. case (optDate) @@ -188,15 +170,9 @@ subroutine AlarmInit( clock, alarm, option, & return endif call ESMF_TimeIntervalSet(AlarmInterval, yy=9999, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + if (ChkErr(rc,__LINE__,u_FILE_u)) return call TimeInit(NextAlarm, lymd, cal, tod=ltod, desc="optDate", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + if (ChkErr(rc,__LINE__,u_FILE_u)) return update_nextalarm = .false. case (optIfdays0) @@ -208,104 +184,65 @@ subroutine AlarmInit( clock, alarm, option, & return endif call ESMF_TimeIntervalSet(AlarmInterval, mm=1, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_TimeSet( NextAlarm, yy=cyy, mm=cmm, dd=opt_n, s=0, calendar=cal, rc=rc ) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + if (ChkErr(rc,__LINE__,u_FILE_u)) return update_nextalarm = .true. case (optNSteps, optNStep) call ESMF_ClockGet(clock, TimeStep=AlarmInterval, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + if (ChkErr(rc,__LINE__,u_FILE_u)) return AlarmInterval = AlarmInterval * opt_n update_nextalarm = .true. case (optNSeconds, optNSecond) call ESMF_TimeIntervalSet(AlarmInterval, s=1, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + if (ChkErr(rc,__LINE__,u_FILE_u)) return AlarmInterval = AlarmInterval * opt_n update_nextalarm = .true. case (optNMinutes, optNMinute) call ESMF_TimeIntervalSet(AlarmInterval, s=60, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + if (ChkErr(rc,__LINE__,u_FILE_u)) return AlarmInterval = AlarmInterval * opt_n update_nextalarm = .true. case (optNHours, optNHour) call ESMF_TimeIntervalSet(AlarmInterval, s=3600, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + if (ChkErr(rc,__LINE__,u_FILE_u)) return AlarmInterval = AlarmInterval * opt_n update_nextalarm = .true. case (optNDays, optNDay) call ESMF_TimeIntervalSet(AlarmInterval, d=1, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + if (ChkErr(rc,__LINE__,u_FILE_u)) return AlarmInterval = AlarmInterval * opt_n update_nextalarm = .true. case (optNMonths, optNMonth) call ESMF_TimeIntervalSet(AlarmInterval, mm=1, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + if (ChkErr(rc,__LINE__,u_FILE_u)) return AlarmInterval = AlarmInterval * opt_n update_nextalarm = .true. case (optMonthly) call ESMF_TimeIntervalSet(AlarmInterval, mm=1, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_TimeSet( NextAlarm, yy=cyy, mm=cmm, dd=1, s=0, calendar=cal, rc=rc ) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + if (ChkErr(rc,__LINE__,u_FILE_u)) return update_nextalarm = .true. case (optNYears, optNYear) call ESMF_TimeIntervalSet(AlarmInterval, yy=1, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + if (ChkErr(rc,__LINE__,u_FILE_u)) return AlarmInterval = AlarmInterval * opt_n update_nextalarm = .true. case (optYearly) call ESMF_TimeIntervalSet(AlarmInterval, yy=1, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_TimeSet( NextAlarm, yy=cyy, mm=1, dd=1, s=0, calendar=cal, rc=rc ) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + if (ChkErr(rc,__LINE__,u_FILE_u)) return update_nextalarm = .true. case default @@ -332,10 +269,7 @@ subroutine AlarmInit( clock, alarm, option, & endif alarm = ESMF_AlarmCreate( name=lalarmname, clock=clock, ringTime=NextAlarm, ringInterval=AlarmInterval, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + if (ChkErr(rc,__LINE__,u_FILE_u)) return end subroutine AlarmInit @@ -378,10 +312,7 @@ subroutine TimeInit( Time, ymd, cal, tod, desc, logunit, rc) call date2ymd (ymd,yr,mon,day) call ESMF_TimeSet( Time, yy=yr, mm=mon, dd=day, s=ltod, calendar=cal, rc=rc ) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + if (ChkErr(rc,__LINE__,u_FILE_u)) return end subroutine TimeInit @@ -405,4 +336,16 @@ subroutine date2ymd (date, year, month, day) end subroutine date2ymd +logical function chkerr(rc, line, file) + integer, intent(in) :: rc + integer, intent(in) :: line + character(len=*), intent(in) :: file + integer :: lrc + chkerr = .false. + lrc = rc + if (ESMF_LogFoundError(rcToCheck=lrc, msg=ESMF_LOGERR_PASSTHRU, line=line, file=file)) then + chkerr = .true. + endif +end function chkerr + end module MOM_cap_time diff --git a/config_src/nuopc_driver/time_utils.F90 b/config_src/nuopc_driver/time_utils.F90 index e995c1b697..db056f4bf5 100644 --- a/config_src/nuopc_driver/time_utils.F90 +++ b/config_src/nuopc_driver/time_utils.F90 @@ -34,6 +34,9 @@ module time_utils_mod public fms2esmf_time public string_to_date +character(len=*),parameter :: u_FILE_u = & + __FILE__ + contains !> Sets fms2esmf_cal_c to the corresponding ESMF calendar type @@ -90,10 +93,7 @@ function esmf2fms_time_t(time) call ESMF_TimeGet(time, yy=yy, mm=mm, dd=dd, h=h, m=m, s=s, & calkindflag=calkind, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return esmf2fms_time_t = set_date(yy, mm, dd, h, m, s) @@ -111,10 +111,7 @@ function esmf2fms_timestep(timestep) integer :: rc call ESMF_TimeIntervalGet(timestep, s=s, calkindflag=calkind, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return esmf2fms_timestep = set_time(s, 0) @@ -142,10 +139,7 @@ function fms2esmf_time(time, calkind) call ESMF_TimeSet(fms2esmf_time, yy=yy, mm=mm, d=d, h=h, m=m, s=s, & calkindflag=l_calkind, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return end function fms2esmf_time @@ -166,4 +160,16 @@ function string_to_date(string, rc) end function string_to_date +logical function chkerr(rc, line, file) + integer, intent(in) :: rc + integer, intent(in) :: line + character(len=*), intent(in) :: file + integer :: lrc + chkerr = .false. + lrc = rc + if (ESMF_LogFoundError(rcToCheck=lrc, msg=ESMF_LOGERR_PASSTHRU, line=line, file=file)) then + chkerr = .true. + endif +end function chkerr + end module time_utils_mod From 8d565ccdd2863107371581b97375b281ad6691f0 Mon Sep 17 00:00:00 2001 From: Denise Worthen Date: Wed, 15 Apr 2020 08:13:20 -0400 Subject: [PATCH 06/19] nuopc_driver updates (#22) * allows control of MOM6 restarts and MOM6 intermediate restarts using nems.configure settings restart_n and restart_option. Fixes duplicate restart issue when running with CMEPS (#16). * when field dumping is turned on, all fields in import state and export state are written to single file with timestamped file name (#15) * moves call to data_override field lrunoff out of the enclosing do loop (#21 ) Co-authored-by: Mariana Vertenstein --- config_src/nuopc_driver/mom_cap.F90 | 416 ++++++++++++------ config_src/nuopc_driver/mom_cap_methods.F90 | 2 +- .../nuopc_driver/mom_ocean_model_nuopc.F90 | 2 +- .../mom_surface_forcing_nuopc.F90 | 6 +- 4 files changed, 296 insertions(+), 130 deletions(-) diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index 690b881375..12b12cf717 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -70,6 +70,11 @@ module MOM_cap_mod use ESMF, only: ESMF_MESHLOC_ELEMENT, ESMF_RC_VAL_OUTOFRANGE, ESMF_StateGet use ESMF, only: ESMF_TimePrint, ESMF_AlarmSet, ESMF_FieldGet, ESMF_Array use ESMF, only: ESMF_ArrayCreate +use ESMF, only: ESMF_RC_FILE_OPEN, ESMF_RC_FILE_READ, ESMF_RC_FILE_WRITE +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: operator(==), operator(/=), operator(+), operator(-) ! TODO ESMF_GridCompGetInternalState does not have an explicit Fortran interface. @@ -81,16 +86,17 @@ module MOM_cap_mod use NUOPC, only: NUOPC_Advertise, NUOPC_SetAttribute, NUOPC_IsUpdated, NUOPC_Write use NUOPC, only: NUOPC_IsConnected, NUOPC_Realize, NUOPC_CompAttributeSet use NUOPC_Model, only: NUOPC_ModelGet -use NUOPC_Model, & - model_routine_SS => SetServices, & - model_label_Advance => label_Advance, & - model_label_DataInitialize => label_DataInitialize, & - model_label_SetRunClock => label_SetRunClock, & - model_label_Finalize => label_Finalize +use NUOPC_Model, only: model_routine_SS => SetServices +use NUOPC_Model, only: model_label_Advance => label_Advance +use NUOPC_Model, only: model_label_DataInitialize => label_DataInitialize +use NUOPC_Model, only: model_label_SetRunClock => label_SetRunClock +use NUOPC_Model, only: model_label_Finalize => label_Finalize +use NUOPC_Model, only: SetVM implicit none; private public SetServices +public SetVM !> Internal state type with pointers to three types defined by MOM. type ocean_internalstate_type @@ -142,6 +148,7 @@ module MOM_cap_mod logical :: cesm_coupled = .false. type(ESMF_GeomType_Flag) :: geomtype = ESMF_GEOMTYPE_GRID #endif +character(len=8) :: restart_mode = 'cmeps' contains @@ -323,10 +330,6 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) call ESMF_LogWrite('MOM_cap:ScalarFieldIdxGridNY = '//trim(logmsg), ESMF_LOGMSG_INFO) endif - call NUOPC_CompAttributeAdd(gcomp, & - attrList=(/'RestartFileToRead', 'RestartFileToWrite'/), rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end subroutine !> Called by NUOPC to advertise import and export fields. "Advertise" @@ -373,6 +376,9 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) logical :: isPresent, isPresentDiro, isPresentLogfile, isSet logical :: existflag integer :: userRc + integer :: localPet + integer :: iostat + integer :: readunit character(len=512) :: restartfile ! Path/Name of restart file character(len=*), parameter :: subname='(MOM_cap:InitializeAdvertise)' character(len=32) :: calendar @@ -514,31 +520,40 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) restartfile = "" if (runtype == "initial") then - ! startup (new run) - 'n' is needed below if we don't specify input_filename in input.nml + restartfile = "n" - else if (runtype == "continue") then ! hybrid or branch or continuos runs - ! optionally call into system-specific implementation to get restart file name - call ESMF_MethodExecute(gcomp, label="GetRestartFileToRead", & - existflag=existflag, userRc=userRc, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg="Error executing user method to get restart filename", & - line=__LINE__, file=__FILE__)) return ! bail out - if (ESMF_LogFoundError(rcToCheck=userRc, msg="Error in method to get restart filename", & - line=__LINE__, file=__FILE__)) return ! bail out - if (existflag) then - call ESMF_LogWrite('MOM_cap: called user GetRestartFileToRead', ESMF_LOGMSG_INFO) - endif + else if (runtype == "continue") then ! hybrid or branch or continuos runs - call NUOPC_CompAttributeGet(gcomp, name='RestartFileToRead', & - value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (isPresent .and. isSet) then - restartfile = trim(cvalue) - call ESMF_LogWrite('MOM_cap: RestartFileToRead = '//trim(restartfile), ESMF_LOGMSG_INFO) - else - call ESMF_LogWrite('MOM_cap: restart requested, no RestartFileToRead attribute provided-will use input.nml',& - ESMF_LOGMSG_WARNING) - endif + if (cesm_coupled) then + call ESMF_LogWrite('MOM_cap: restart requested, using rpointer.ocn', ESMF_LOGMSG_WARNING) + call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + call ESMF_VMGet(vm, localPet=localPet, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + + if (localPet == 0) then + ! this hard coded for rpointer.ocn right now + open(newunit=readunit, file='rpointer.ocn', form='formatted', status='old', iostat=iostat) + if (iostat /= 0) then + call ESMF_LogSetError(ESMF_RC_FILE_OPEN, msg=subname//' ERROR opening rpointer.ocn', & + line=__LINE__, file=u_FILE_u, rcToReturn=rc) + return + endif + read(readunit,'(a)', iostat=iostat) restartfile + if (iostat /= 0) then + call ESMF_LogSetError(ESMF_RC_FILE_READ, msg=subname//' ERROR reading rpointer.ocn', & + line=__LINE__, file=u_FILE_u, rcToReturn=rc) + return + endif + close(readunit) + endif + ! broadcast attribute set on master task to all tasks + call ESMF_VMBroadcast(vm, restartfile, count=ESMF_MAXSTR-1, rootPet=0, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + else + call ESMF_LogWrite('MOM_cap: restart requested, use input.nml', ESMF_LOGMSG_WARNING) + endif endif @@ -1174,12 +1189,17 @@ subroutine DataInitialize(gcomp, rc) ! local variables type(ESMF_Clock) :: clock type(ESMF_State) :: importState, exportState + type(ESMF_Time) :: currTime + type(ESMF_TimeInterval) :: timeStep + type(ESMF_StateItem_Flag) :: itemType type (ocean_public_type), pointer :: ocean_public => NULL() type (ocean_state_type), pointer :: ocean_state => NULL() type(ice_ocean_boundary_type), pointer :: Ice_ocean_boundary => NULL() type(ocean_internalstate_wrapper) :: ocean_internalstate type(ocean_grid_type), pointer :: ocean_grid character(240) :: msgString + character(240) :: fldname + character(240) :: timestr integer :: fieldCount, n type(ESMF_Field) :: field character(len=64),allocatable :: fieldNameList(:) @@ -1190,6 +1210,11 @@ subroutine DataInitialize(gcomp, rc) call ESMF_GridCompGet(gcomp, clock=clock, importState=importState, exportState=exportState, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_ClockGet(clock, currTime=currTime, timeStep=timeStep, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_TimeGet(currTime, timestring=timestr, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_GridCompGetInternalState(gcomp, ocean_internalstate, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -1220,14 +1245,25 @@ subroutine DataInitialize(gcomp, rc) ! check whether all Fields in the exportState are "Updated" if (NUOPC_IsUpdated(exportState)) then call NUOPC_CompAttributeSet(gcomp, name="InitializeDataComplete", value="true", rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_LogWrite("MOM6 - Initialize-Data-Dependency SATISFIED!!!", ESMF_LOGMSG_INFO) + if (ChkErr(rc,__LINE__,u_FILE_u)) return endif if(write_diagnostics) then - call NUOPC_Write(exportState, fileNamePrefix='field_init_ocn_export_', & - overwrite=overwrite_timeslice,timeslice=import_slice, relaxedFlag=.true., rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + do n = 1,fldsFrOcn_num + fldname = fldsFrOcn(n)%shortname + call ESMF_StateGet(exportState, itemName=trim(fldname), itemType=itemType, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + if (itemType /= ESMF_STATEITEM_NOTFOUND) then + call ESMF_StateGet(exportState, itemName=trim(fldname), field=field, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_FieldWrite(field, fileName='field_init_ocn_export_'//trim(timestr)//'.nc', & + timeslice=1, overwrite=overwrite_timeslice, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + endif + enddo endif end subroutine DataInitialize @@ -1245,13 +1281,15 @@ subroutine ModelAdvance(gcomp, rc) logical :: existflag, isPresent, isSet logical :: do_advance = .true. type(ESMF_Clock) :: clock!< ESMF Clock class definition - type(ESMF_Alarm) :: alarm + type(ESMF_Alarm) :: restart_alarm, stop_alarm type(ESMF_State) :: importState, exportState type(ESMF_Time) :: currTime type(ESMF_TimeInterval) :: timeStep type(ESMF_Time) :: startTime type(ESMF_TimeInterval) :: time_elapsed integer(ESMF_KIND_I8) :: n_interval, time_elapsed_sec + type(ESMF_Field) :: lfield + type(ESMF_StateItem_Flag) :: itemType character(len=64) :: timestamp type (ocean_public_type), pointer :: ocean_public => NULL() type (ocean_state_type), pointer :: ocean_state => NULL() @@ -1267,6 +1305,14 @@ subroutine ModelAdvance(gcomp, rc) integer :: seconds, day, year, month, hour, minute character(ESMF_MAXSTR) :: restartname, cvalue character(240) :: msgString + character(ESMF_MAXSTR) :: casename + integer :: iostat + integer :: writeunit + integer :: localPet + type(ESMF_VM) :: vm + integer :: n + character(240) :: import_timestr, export_timestr + character(len=128) :: fldname character(len=*),parameter :: subname='(MOM_cap:ModelAdvance)' rc = ESMF_SUCCESS @@ -1295,6 +1341,9 @@ subroutine ModelAdvance(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) + call ESMF_TimeGet(currTime, timestring=import_timestr, rc=rc) + call ESMF_TimeGet(currTime+timestep, timestring=export_timestr, rc=rc) + Time_step_coupled = esmf2fms_time(timeStep) Time = esmf2fms_time(currTime) @@ -1341,10 +1390,20 @@ subroutine ModelAdvance(gcomp, rc) !--------------- if (write_diagnostics) then - call NUOPC_Write(importState, fileNamePrefix='field_ocn_import_', & - overwrite=overwrite_timeslice,timeslice=import_slice, relaxedFlag=.true., rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - import_slice = import_slice + 1 + do n = 1,fldsToOcn_num + fldname = fldsToOcn(n)%shortname + call ESMF_StateGet(importState, itemName=trim(fldname), itemType=itemType, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + if (itemType /= ESMF_STATEITEM_NOTFOUND) then + call ESMF_StateGet(importState, itemName=trim(fldname), field=lfield, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_FieldWrite(lfield, fileName='field_ocn_import_'//trim(import_timestr)//'.nc', & + timeslice=1, overwrite=overwrite_timeslice, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + endif + enddo endif !--------------- @@ -1378,65 +1437,80 @@ subroutine ModelAdvance(gcomp, rc) endif !--------------- - ! If restart alarm is ringing - write restart file + ! Get the stop alarm !--------------- - call ESMF_ClockGetAlarm(clock, alarmname='alarm_restart', alarm=alarm, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - if (ESMF_AlarmIsRinging(alarm, rc=rc)) then - if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_ClockGetAlarm(clock, alarmname='stop_alarm', alarm=stop_alarm, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out - call ESMF_AlarmRingerOff(alarm, rc=rc ) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + !--------------- + ! If restart alarm exists and is ringing - write restart file + !--------------- - ! call into system specific method to get desired restart filename - restartname = "" - call ESMF_MethodExecute(gcomp, label="GetRestartFileToWrite", & - existflag=existflag, userRc=userRc, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg="Error executing user method to get restart filename", & - line=__LINE__, file=__FILE__)) return ! bail out - - if (ESMF_LogFoundError(rcToCheck=userRc, msg="Error in method to get restart filename", & - line=__LINE__, file=__FILE__)) return ! bail out - if (existflag) then - call ESMF_LogWrite("MOM_cap: called user GetRestartFileToWrite method", ESMF_LOGMSG_INFO) - call NUOPC_CompAttributeGet(gcomp, name='RestartFileToWrite', & - isPresent=isPresent, isSet=isSet, value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (isPresent .and. isSet) then - restartname = trim(cvalue) - call ESMF_LogWrite("MOM_cap: User RestartFileToWrite: "//trim(restartname), ESMF_LOGMSG_INFO) + if (restart_mode == 'cmeps') then + call ESMF_ClockGetAlarm(clock, alarmname='restart_alarm', alarm=restart_alarm, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + if (ESMF_AlarmIsRinging(restart_alarm, rc=rc)) then + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + ! turn off the alarm + call ESMF_AlarmRingerOff(restart_alarm, rc=rc ) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call ESMF_ClockGetNextTime(clock, MyTime, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call ESMF_TimeGet (MyTime, yy=year, mm=month, dd=day, h=hour, m=minute, s=seconds, rc=rc ) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + if (cesm_coupled) then + call NUOPC_CompAttributeGet(gcomp, name='case_name', value=casename, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + call ESMF_VMGet(vm, localPet=localPet, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + + write(restartname,'(A,".mom6.r.",I4.4,"-",I2.2,"-",I2.2,"-",I5.5)') & + trim(casename), year, month, day, seconds + if (localPet == 0) then + ! Write name of restart file in the rpointer file - this is currently hard-coded for the ocean + open(newunit=writeunit, file='rpointer.ocn', form='formatted', status='unknown', iostat=iostat) + if (iostat /= 0) then + call ESMF_LogSetError(ESMF_RC_FILE_OPEN, & + msg=subname//' ERROR opening rpointer.ocn', line=__LINE__, file=u_FILE_u, rcToReturn=rc) + return + endif + write(writeunit,'(a)') trim(restartname)//'.nc' + close(writeunit) endif - endif - - if (len_trim(restartname) == 0) then - ! none provided, so use a default restart filename - call ESMF_ClockGetNextTime(clock, MyTime, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_TimeGet (MyTime, yy=year, mm=month, dd=day, & - h=hour, m=minute, s=seconds, rc=rc ) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - write(restartname,'(A,".mom6.r.",I4.4,"-",I2.2,"-",I2.2,"-",I2.2,"-",I2.2,"-",I2.2)') & - "ocn", year, month, day, hour, minute, seconds - call ESMF_LogWrite("MOM_cap: Using default restart filename: "//trim(restartname), ESMF_LOGMSG_INFO) - endif - - ! TODO: address if this requirement is being met for the DA group - ! Optionally write restart files when currTime-startTime is integer multiples of restart_interval - ! if (restart_interval > 0 ) then - ! time_elapsed = currTime - startTime - ! call ESMF_TimeIntervalGet(time_elapsed, s_i8=time_elapsed_sec, rc=rc) - ! if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! n_interval = time_elapsed_sec / restart_interval - ! if ((n_interval .gt. 0) .and. (n_interval*restart_interval == time_elapsed_sec)) then - ! time_restart_current = esmf2fms_time(currTime) - ! timestamp = date_to_string(time_restart_current) - ! call ESMF_LogWrite("MOM: Writing restart at "//trim(timestamp), ESMF_LOGMSG_INFO) - ! write(*,*) 'calling ocean_model_restart' - ! call ocean_model_restart(ocean_state, timestamp) - ! endif - ! endif + else + ! write the final restart without a timestamp + if (ESMF_AlarmIsRinging(stop_alarm, rc=rc)) then + write(restartname,'(A)')"MOM.res" + else + write(restartname,'(A,I4.4,"-",I2.2,"-",I2.2,"-",I2.2,"-",I2.2,"-",I2.2)') & + "MOM.res.", year, month, day, hour, minute, seconds + endif + end if + call ESMF_LogWrite("MOM_cap: Writing restart : "//trim(restartname), ESMF_LOGMSG_INFO) ! write restart file(s) call ocean_model_restart(ocean_state, restartname=restartname) @@ -1444,17 +1518,28 @@ subroutine ModelAdvance(gcomp, rc) if (is_root_pe()) then write(logunit,*) subname//' writing restart file ',trim(restartname) endif - endif + endif + end if ! end of restart_mode is cmeps !--------------- ! Write diagnostics !--------------- if (write_diagnostics) then - call NUOPC_Write(exportState, fileNamePrefix='field_ocn_export_', & - overwrite=overwrite_timeslice,timeslice=export_slice, relaxedFlag=.true., rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - export_slice = export_slice + 1 + do n = 1,fldsFrOcn_num + fldname = fldsFrOcn(n)%shortname + call ESMF_StateGet(exportState, itemName=trim(fldname), itemType=itemType, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + if (itemType /= ESMF_STATEITEM_NOTFOUND) then + call ESMF_StateGet(exportState, itemName=trim(fldname), field=lfield, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_FieldWrite(lfield, fileName='field_ocn_export_'//trim(export_timestr)//'.nc', & + timeslice=1, overwrite=overwrite_timeslice, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + endif + enddo endif if(profile_memory) call ESMF_VMLogMemInfo("Leaving MOM Model_ADVANCE: ") @@ -1469,17 +1554,19 @@ subroutine ModelSetRunClock(gcomp, rc) ! local variables type(ESMF_Clock) :: mclock, dclock type(ESMF_Time) :: mcurrtime, dcurrtime - type(ESMF_Time) :: mstoptime + type(ESMF_Time) :: mstoptime, dstoptime type(ESMF_TimeInterval) :: mtimestep, dtimestep character(len=128) :: mtimestring, dtimestring character(len=256) :: cvalue character(len=256) :: restart_option ! Restart option units integer :: restart_n ! Number until restart interval integer :: restart_ymd ! Restart date (YYYYMMDD) - type(ESMF_ALARM) :: restart_alarm + type(ESMF_Alarm) :: restart_alarm + type(ESMF_Alarm) :: stop_alarm logical :: isPresent, isSet logical :: first_time = .true. character(len=*),parameter :: subname='MOM_cap:(ModelSetRunClock) ' + character(len=256) :: timestr !-------------------------------- rc = ESMF_SUCCESS @@ -1488,7 +1575,8 @@ subroutine ModelSetRunClock(gcomp, rc) call NUOPC_ModelGet(gcomp, driverClock=dclock, modelClock=mclock, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_ClockGet(dclock, currTime=dcurrtime, timeStep=dtimestep, rc=rc) + call ESMF_ClockGet(dclock, currTime=dcurrtime, timeStep=dtimestep, & + stopTime=dstoptime, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_ClockGet(mclock, currTime=mcurrtime, timeStep=mtimestep, rc=rc) @@ -1529,12 +1617,14 @@ subroutine ModelSetRunClock(gcomp, rc) restart_n = 0 restart_ymd = 0 - call NUOPC_CompAttributeGet(gcomp, name="restart_option", isPresent=isPresent, & - isSet=isSet, value=restart_option, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (isPresent .and. isSet) then - call NUOPC_CompAttributeGet(gcomp, name="restart_n", value=cvalue, & - isPresent=isPresent, isSet=isSet, rc=rc) + if (cesm_coupled) then + + call NUOPC_CompAttributeGet(gcomp, name="restart_option", value=restart_option, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! If restart_option is set then must also have set either restart_n or restart_ymd + call NUOPC_CompAttributeGet(gcomp, name="restart_n", value=cvalue, & + isPresent=isPresent, isSet=isSet, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (isPresent .and. isSet) then read(cvalue,*) restart_n @@ -1545,25 +1635,93 @@ subroutine ModelSetRunClock(gcomp, rc) if (isPresent .and. isSet) then read(cvalue,*) restart_ymd endif + if (restart_n == 0 .and. restart_ymd == 0) then + call ESMF_LogSetError(ESMF_RC_VAL_WRONG, & + msg=subname//": ERROR both restart_n and restart_ymd are zero for restart_option set ", & + line=__LINE__, file=__FILE__, rcToReturn=rc) + return + endif + call ESMF_LogWrite(subname//" Set restart option = "//restart_option, ESMF_LOGMSG_INFO) + else - restart_option = "none" + call NUOPC_CompAttributeGet(gcomp, name="restart_n", value=cvalue, & + isPresent=isPresent, isSet=isSet, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return + + ! If restart_n is set and non-zero, then restart_option must be available from config + if (isPresent .and. isSet) then + call ESMF_LogWrite(subname//" Restart_n = "//trim(cvalue), ESMF_LOGMSG_INFO) + read(cvalue,*) restart_n + if(restart_n /= 0)then + call NUOPC_CompAttributeGet(gcomp, name="restart_option", value=cvalue, & + isPresent=isPresent, isSet=isSet, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return + if (isPresent .and. isSet) then + read(cvalue,*) restart_option + call ESMF_LogWrite(subname//" Restart_option = "//restart_option, & + ESMF_LOGMSG_INFO) + else + call ESMF_LogSetError(ESMF_RC_VAL_WRONG, & + msg=subname//": ERROR both restart_n and restart_option must be set ", & + line=__LINE__, file=__FILE__, rcToReturn=rc) + return + endif + + ! not used in nems + call NUOPC_CompAttributeGet(gcomp, name="restart_ymd", value=cvalue, & + isPresent=isPresent, isSet=isSet, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return + if (isPresent .and. isSet) then + read(cvalue,*) restart_ymd + call ESMF_LogWrite(subname//" Restart_ymd = "//trim(cvalue), ESMF_LOGMSG_INFO) + endif + else + ! restart_n is zero, restart_mode will be nems + restart_mode = 'nems' + call ESMF_LogWrite(subname//" Set restart_mode to nems", ESMF_LOGMSG_INFO) + endif + else + ! restart_n is not set, restart_mode will be nems + restart_mode = 'nems' + call ESMF_LogWrite(subname//" Set restart_mode to nems", ESMF_LOGMSG_INFO) + endif endif - call AlarmInit(mclock, & - alarm = restart_alarm, & - option = trim(restart_option), & - opt_n = restart_n, & - opt_ymd = restart_ymd, & - RefTime = mcurrTime, & - alarmname = 'alarm_restart', rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (restart_mode == 'cmeps') then + call AlarmInit(mclock, & + alarm = restart_alarm, & + option = trim(restart_option), & + opt_n = restart_n, & + opt_ymd = restart_ymd, & + RefTime = mcurrTime, & + alarmname = 'restart_alarm', rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call ESMF_AlarmSet(restart_alarm, clock=mclock, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call ESMF_LogWrite(subname//" Restart alarm is Created and Set", ESMF_LOGMSG_INFO) + end if + + ! create a 1-shot alarm at the driver stop time + stop_alarm = ESMF_AlarmCreate(mclock, ringtime=dstopTime, name = "stop_alarm", rc=rc) + call ESMF_LogWrite(subname//" Create Stop alarm", ESMF_LOGMSG_INFO) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return + + call ESMF_TimeGet(dstoptime, timestring=timestr, rc=rc) + call ESMF_LogWrite("Stop Alarm will ring at : "//trim(timestr), ESMF_LOGMSG_INFO) - call ESMF_AlarmSet(restart_alarm, clock=mclock, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return first_time = .false. - call ESMF_LogWrite(subname//" Set restart option = "//restart_option, ESMF_LOGMSG_INFO) - endif !-------------------------------- @@ -1597,6 +1755,7 @@ subroutine ocean_model_finalize(gcomp, rc) type(ESMF_Clock) :: clock type(ESMF_Time) :: currTime character(len=64) :: timestamp + logical :: write_restart character(len=*),parameter :: subname='(MOM_cap:ocean_model_finalize)' write(*,*) 'MOM: --- finalize called ---' @@ -1615,11 +1774,16 @@ subroutine ocean_model_finalize(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return Time = esmf2fms_time(currTime) - if (cesm_coupled) then - call ocean_model_end(ocean_public, ocean_State, Time, write_restart=.false.) + ! Do not write a restart unless mode is nems + if (restart_mode == 'nems') then + write_restart = .true. else - call ocean_model_end(ocean_public, ocean_State, Time, write_restart=.true.) - endif + write_restart = .false. + end if + if (write_restart)call ESMF_LogWrite("No Restart Alarm, writing restart at Finalize ", & + ESMF_LOGMSG_INFO) + + call ocean_model_end(ocean_public, ocean_State, Time, write_restart=write_restart) call field_manager_end() call fms_io_exit() diff --git a/config_src/nuopc_driver/mom_cap_methods.F90 b/config_src/nuopc_driver/mom_cap_methods.F90 index 2c69b504e0..f1be8a3ea3 100644 --- a/config_src/nuopc_driver/mom_cap_methods.F90 +++ b/config_src/nuopc_driver/mom_cap_methods.F90 @@ -681,7 +681,7 @@ subroutine State_SetExport(state, fldname, isc, iec, jsc, jec, input, ocean_grid do j = jsc, jec jg = j + ocean_grid%jsc - jsc do i = isc, iec - ig = i + ocean_grid%isc - isc + ig = i + ocean_grid%isc - isc n = n+1 dataPtr1d(n) = input(i,j) * ocean_grid%mask2dT(ig,jg) enddo diff --git a/config_src/nuopc_driver/mom_ocean_model_nuopc.F90 b/config_src/nuopc_driver/mom_ocean_model_nuopc.F90 index 202fa5791d..0245d9633d 100644 --- a/config_src/nuopc_driver/mom_ocean_model_nuopc.F90 +++ b/config_src/nuopc_driver/mom_ocean_model_nuopc.F90 @@ -730,7 +730,7 @@ subroutine ocean_model_end(Ocean_sfc, Ocean_state, Time, write_restart) type(time_type), intent(in) :: Time !< The model time, used for writing restarts. logical, intent(in) :: write_restart !< true => write restart file - call ocean_model_save_restart(Ocean_state, Time) + if(write_restart)call ocean_model_save_restart(Ocean_state, Time) call diag_mediator_end(Time, Ocean_state%diag, end_diag_manager=.true.) call MOM_end(Ocean_state%MOM_CSp) if (Ocean_state%use_ice_shelf) call ice_shelf_end(Ocean_state%Ice_shelf_CSp) diff --git a/config_src/nuopc_driver/mom_surface_forcing_nuopc.F90 b/config_src/nuopc_driver/mom_surface_forcing_nuopc.F90 index b75ff96532..7f729e3c3e 100644 --- a/config_src/nuopc_driver/mom_surface_forcing_nuopc.F90 +++ b/config_src/nuopc_driver/mom_surface_forcing_nuopc.F90 @@ -426,7 +426,10 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, valid_time, G, call MOM_error(FATAL, "liquid runoff is being added via data_override but "// & "there is no associated runoff in the IOB") return - end if + endif + if (associated(IOB%lrunoff)) then + if(CS%liquid_runoff_from_data)call data_override('OCN', 'runoff', IOB%lrunoff, Time) + endif ! obtain fluxes from IOB; note the staggering of indices i0 = is - isc_bnd ; j0 = js - jsc_bnd @@ -443,7 +446,6 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, valid_time, G, ! liquid runoff flux if (associated(IOB%lrunoff)) then - if(CS%liquid_runoff_from_data)call data_override('OCN', 'runoff', IOB%lrunoff, Time) fluxes%lrunoff(i,j) = kg_m2_s_conversion * IOB%lrunoff(i-i0,j-j0) * G%mask2dT(i,j) endif From bbdef39ae9e48c74f3f82a1d6ed4f8ac358b37dc Mon Sep 17 00:00:00 2001 From: Jessica Meixner Date: Wed, 13 May 2020 14:23:35 -0400 Subject: [PATCH 07/19] Updates for wave coupling in NUOPC (#23) * Adding extra ensemble slot for waves. * Updates for wave coupling - Adding wave information to mech_forcing type to pass from ice_ocean_boundary to wave types - This is only set-up to read surface Stokes drift and guess the wavelength as something reasonable for now to demonstrate that it works. This needs to be set-up properly before merging this into the main repository. * Updates to make Stokes drift from multiple bands work with the coupler approach * Adding wave stokes drift import to nuopc cap Co-authored-by: Brandon Reichl --- .../MOM_surface_forcing_gfdl.F90 | 27 ++- config_src/coupled_driver/ocean_model_MOM.F90 | 2 +- config_src/nuopc_driver/mom_cap.F90 | 25 +++ config_src/nuopc_driver/mom_cap_methods.F90 | 52 +++++ .../nuopc_driver/mom_ocean_model_nuopc.F90 | 9 +- .../mom_surface_forcing_nuopc.F90 | 32 ++- src/core/MOM_forcing_type.F90 | 25 ++- src/user/MOM_wave_interface.F90 | 188 ++++++++++++------ 8 files changed, 289 insertions(+), 71 deletions(-) diff --git a/config_src/coupled_driver/MOM_surface_forcing_gfdl.F90 b/config_src/coupled_driver/MOM_surface_forcing_gfdl.F90 index 9743c7fa3f..187f8ab7b2 100644 --- a/config_src/coupled_driver/MOM_surface_forcing_gfdl.F90 +++ b/config_src/coupled_driver/MOM_surface_forcing_gfdl.F90 @@ -189,6 +189,12 @@ module MOM_surface_forcing_gfdl !! ice-shelves, expressed as a coefficient !! for divergence damping, as determined !! outside of the ocean model [m3 s-1] + real, pointer, dimension(:,:) :: ustk0 => NULL() !< + real, pointer, dimension(:,:) :: vstk0 => NULL() !< + real, pointer, dimension(:) :: stk_wavenumbers => NULL() !< + real, pointer, dimension(:,:,:) :: ustkb => NULL() !< + real, pointer, dimension(:,:,:) :: vstkb => NULL() !< + integer :: xtype !< The type of the exchange - REGRID, REDIST or DIRECT type(coupler_2d_bc_type) :: fluxes !< A structure that may contain an array of named fields !! used for passive tracer fluxes. @@ -196,6 +202,7 @@ module MOM_surface_forcing_gfdl !! This flag may be set by the flux-exchange code, based on what !! the sea-ice model is providing. Otherwise, the value from !! the surface_forcing_CS is used. + integer :: num_stk_bands !< Number of Stokes drift bands passed through the coupler end type ice_ocean_boundary_type integer :: id_clock_forcing !< A CPU time clock @@ -275,7 +282,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, valid_time, G, ! flux type has been used. if (fluxes%dt_buoy_accum < 0) then call allocate_forcing_type(G, fluxes, water=.true., heat=.true., & - ustar=.true., press=.true.) + ustar=.true., press=.true. ) call safe_alloc_ptr(fluxes%sw_vis_dir,isd,ied,jsd,jed) call safe_alloc_ptr(fluxes%sw_vis_dif,isd,ied,jsd,jed) @@ -669,7 +676,7 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS, dt_ real :: mass_eff ! effective mass of sea ice for rigidity [kg m-2] real :: wt1, wt2 ! Relative weights of previous and current values of ustar, ND. - integer :: i, j, is, ie, js, je, Isq, Ieq, Jsq, Jeq, i0, j0 + integer :: i, j, is, ie, js, je, Isq, Ieq, Jsq, Jeq, i0, j0, istk integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB, isr, ier, jsr, jer integer :: isc_bnd, iec_bnd, jsc_bnd, jec_bnd @@ -710,6 +717,9 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS, dt_ (associated(IOB%mass_berg) .and. (.not. associated(forces%mass_berg))) ) & call allocate_mech_forcing(G, forces, iceberg=.true.) + if ( associated(IOB%ustk0) ) & + call allocate_mech_forcing(G, forces, waves=.true., num_stk_bands=IOB%num_stk_bands) + if (associated(IOB%ice_rigidity)) then rigidity_at_h(:,:) = 0.0 call safe_alloc_ptr(forces%rigidity_ice_u,IsdB,IedB,jsd,jed) @@ -769,6 +779,19 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS, dt_ forces%ustar(i,j) = wt1*forces%ustar(i,j) + wt2*ustar_tmp(i,j) enddo ; enddo endif + forces%stk_wavenumbers(:) = IOB%stk_wavenumbers + do j=js,je; do i=is,ie + forces%ustk0(i,j) = IOB%ustk0(i-I0,j-J0) ! How to be careful here that the domains are right? + forces%vstk0(i,j) = IOB%vstk0(i-I0,j-J0) + enddo ; enddo + call pass_vector(forces%ustk0,forces%vstk0, G%domain ) + do istk = 1,IOB%num_stk_bands + do j=js,je; do i=is,ie + forces%ustkb(i,j,istk) = IOB%ustkb(i-I0,j-J0,istk) + forces%vstkb(i,j,istk) = IOB%vstkb(i-I0,j-J0,istk) + enddo; enddo + call pass_vector(forces%ustkb(:,:,istk),forces%vstkb(:,:,istk), G%domain ) + enddo ! Find the net mass source in the input forcing without other adjustments. if (CS%approx_net_mass_src .and. associated(forces%net_mass_src)) then diff --git a/config_src/coupled_driver/ocean_model_MOM.F90 b/config_src/coupled_driver/ocean_model_MOM.F90 index 1f01845ae4..75b604a9d8 100644 --- a/config_src/coupled_driver/ocean_model_MOM.F90 +++ b/config_src/coupled_driver/ocean_model_MOM.F90 @@ -557,7 +557,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, time_start_upda ! For now, the waves are only updated on the thermodynamics steps, because that is where ! the wave intensities are actually used to drive mixing. At some point, the wave updates ! might also need to become a part of the ocean dynamics, according to B. Reichl. - call Update_Surface_Waves(OS%grid, OS%GV, OS%US, OS%time, ocean_coupling_time_step, OS%waves) + call Update_Surface_Waves(OS%grid, OS%GV, OS%US, OS%time, ocean_coupling_time_step, OS%waves, OS%forces) endif if ((OS%nstep==0) .and. (OS%nstep_thermo==0)) then ! This is the first call to update_ocean_model. diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index 12b12cf717..a8056129ff 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -606,6 +606,20 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) Ice_ocean_boundary%lrunoff = 0.0 Ice_ocean_boundary%frunoff = 0.0 + if (ocean_state%use_waves) then + Ice_ocean_boundary%num_stk_bands=ocean_state%Waves%NumBands + allocate ( Ice_ocean_boundary% ustk0 (isc:iec,jsc:jec), & + Ice_ocean_boundary% vstk0 (isc:iec,jsc:jec), & + Ice_ocean_boundary% ustkb (isc:iec,jsc:jec,Ice_ocean_boundary%num_stk_bands), & + Ice_ocean_boundary% vstkb (isc:iec,jsc:jec,Ice_ocean_boundary%num_stk_bands), & + Ice_ocean_boundary%stk_wavenumbers (Ice_ocean_boundary%num_stk_bands)) + Ice_ocean_boundary%ustk0 = 0.0 + Ice_ocean_boundary%vstk0 = 0.0 + Ice_ocean_boundary%stk_wavenumbers = ocean_state%Waves%WaveNum_Cen + Ice_ocean_boundary%ustkb = 0.0 + Ice_ocean_boundary%vstkb = 0.0 + endif + ocean_internalstate%ptr%ocean_state_type_ptr => ocean_state call ESMF_GridCompSetInternalState(gcomp, ocean_internalstate, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -649,6 +663,17 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) !These are not currently used and changing requires a nuopc dictionary change !call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_runoff_heat_flx" , "will provide") !call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_calving_heat_flx" , "will provide") + if (ocean_state%use_waves) then + if (Ice_ocean_boundary%num_stk_bands > 3) then + call MOM_error(FATAL, "Number of Stokes Bands > 3, NUOPC cap not set up for this") + endif + call fld_list_add(fldsToOcn_num, fldsToOcn, "eastward_partitioned_stokes_drift_1" , "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "northward_partitioned_stokes_drift_1", "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "eastward_partitioned_stokes_drift_2" , "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "northward_partitioned_stokes_drift_2", "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "eastward_partitioned_stokes_drift_3" , "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "northward_partitioned_stokes_drift_3", "will provide") + endif !--------- export fields ------------- call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocean_mask" , "will provide") diff --git a/config_src/nuopc_driver/mom_cap_methods.F90 b/config_src/nuopc_driver/mom_cap_methods.F90 index f1be8a3ea3..8aca45094f 100644 --- a/config_src/nuopc_driver/mom_cap_methods.F90 +++ b/config_src/nuopc_driver/mom_cap_methods.F90 @@ -73,6 +73,8 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, character(len=128) :: fldname real(ESMF_KIND_R8), allocatable :: taux(:,:) real(ESMF_KIND_R8), allocatable :: tauy(:,:) + real(ESMF_KIND_R8), allocatable :: stkx1(:,:),stkx2(:,:),stkx3(:,:) + real(ESMF_KIND_R8), allocatable :: stky1(:,:),stky2(:,:),stky3(:,:) character(len=*) , parameter :: subname = '(mom_import)' rc = ESMF_SUCCESS @@ -245,6 +247,56 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, isc, iec, jsc, jec, ice_ocean_boundary%mi, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + + !---- + ! Partitioned Stokes Drift Components + !---- + if ( associated(ice_ocean_boundary%ustkb) ) then + allocate(stkx1(isc:iec,jsc:jec)) + allocate(stky1(isc:iec,jsc:jec)) + allocate(stkx2(isc:iec,jsc:jec)) + allocate(stky2(isc:iec,jsc:jec)) + allocate(stkx3(isc:iec,jsc:jec)) + allocate(stky3(isc:iec,jsc:jec)) + + call state_getimport(importState,'eastward_partitioned_stokes_drift_1' , isc, iec, jsc, jec, stkx1,rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call state_getimport(importState,'northward_partitioned_stokes_drift_1', isc, iec, jsc, jec, stky1,rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call state_getimport(importState,'eastward_partitioned_stokes_drift_2' , isc, iec, jsc, jec, stkx2,rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call state_getimport(importState,'northward_partitioned_stokes_drift_2', isc, iec, jsc, jec, stky2,rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call state_getimport(importState,'eastward_partitioned_stokes_drift_3' , isc, iec, jsc, jec, stkx3,rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call state_getimport(importState,'northward_partitioned_stokes_drift_3', isc, iec, jsc, jec, stky3,rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! rotate from true zonal/meridional to local coordinates + do j = jsc, jec + jg = j + ocean_grid%jsc - jsc + do i = isc, iec + ig = i + ocean_grid%isc - isc + ice_ocean_boundary%ustkb(i,j,1) = ocean_grid%cos_rot(ig,jg)*stkx1(i,j) & + - ocean_grid%sin_rot(ig,jg)*stky1(i,j) + ice_ocean_boundary%vstkb(i,j,1) = ocean_grid%cos_rot(ig,jg)*stky1(i,j) & + + ocean_grid%sin_rot(ig,jg)*stkx1(i,j) + + ice_ocean_boundary%ustkb(i,j,2) = ocean_grid%cos_rot(ig,jg)*stkx2(i,j) & + - ocean_grid%sin_rot(ig,jg)*stky2(i,j) + ice_ocean_boundary%vstkb(i,j,2) = ocean_grid%cos_rot(ig,jg)*stky2(i,j) & + + ocean_grid%sin_rot(ig,jg)*stkx2(i,j) + + ice_ocean_boundary%ustkb(i,j,3) = ocean_grid%cos_rot(ig,jg)*stkx3(i,j) & + - ocean_grid%sin_rot(ig,jg)*stky3(i,j) + ice_ocean_boundary%vstkb(i,j,3) = ocean_grid%cos_rot(ig,jg)*stky3(i,j) & + + ocean_grid%sin_rot(ig,jg)*stkx3(i,j) + enddo + enddo + + deallocate(stkx1,stkx2,stkx3,stky1,stky2,stky3) + endif + end subroutine mom_import !> Maps outgoing ocean data to ESMF State diff --git a/config_src/nuopc_driver/mom_ocean_model_nuopc.F90 b/config_src/nuopc_driver/mom_ocean_model_nuopc.F90 index 0245d9633d..6a50d3c03c 100644 --- a/config_src/nuopc_driver/mom_ocean_model_nuopc.F90 +++ b/config_src/nuopc_driver/mom_ocean_model_nuopc.F90 @@ -143,7 +143,7 @@ module MOM_ocean_model_nuopc integer :: nstep = 0 !< The number of calls to update_ocean. logical :: use_ice_shelf !< If true, the ice shelf model is enabled. - logical :: use_waves !< If true use wave coupling. + logical,public :: use_waves !< If true use wave coupling. logical :: icebergs_alter_ocean !< If true, the icebergs can change ocean the !! ocean dynamics and forcing fluxes. @@ -203,7 +203,7 @@ module MOM_ocean_model_nuopc type(marine_ice_CS), pointer :: & marine_ice_CSp => NULL() !< A pointer to the control structure for the !! marine ice effects module. - type(wave_parameters_cs), pointer :: & + type(wave_parameters_cs), pointer, public :: & Waves !< A structure containing pointers to the surface wave fields type(surface_forcing_CS), pointer :: & forcing_CSp => NULL() !< A pointer to the MOM forcing control structure @@ -386,6 +386,9 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i "If true, enables surface wave modules.", default=.false.) if (OS%use_waves) then call MOM_wave_interface_init(OS%Time, OS%grid, OS%GV, OS%US, param_file, OS%Waves, OS%diag) + call get_param(param_file,mdl,"SURFBAND_WAVENUMBERS",OS%Waves%WaveNum_Cen, & + "Central wavenumbers for surface Stokes drift bands.",units='rad/m', & + default=0.12566) else call MOM_wave_interface_init_lite(param_file) endif @@ -570,7 +573,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & call set_net_mass_forcing(OS%fluxes, OS%forces, OS%grid, OS%US) if (OS%use_waves) then - call Update_Surface_Waves(OS%grid, OS%GV, OS%US, OS%time, ocean_coupling_time_step, OS%waves) + call Update_Surface_Waves(OS%grid, OS%GV, OS%US, OS%time, ocean_coupling_time_step, OS%waves, OS%forces) endif if (OS%nstep==0) then diff --git a/config_src/nuopc_driver/mom_surface_forcing_nuopc.F90 b/config_src/nuopc_driver/mom_surface_forcing_nuopc.F90 index 7f729e3c3e..7714793e42 100644 --- a/config_src/nuopc_driver/mom_surface_forcing_nuopc.F90 +++ b/config_src/nuopc_driver/mom_surface_forcing_nuopc.F90 @@ -181,9 +181,15 @@ module MOM_surface_forcing_nuopc !! ice-shelves, expressed as a coefficient !! for divergence damping, as determined !! outside of the ocean model in [m3/s] + real, pointer, dimension(:,:) :: ustk0 => NULL() !< + real, pointer, dimension(:,:) :: vstk0 => NULL() !< + real, pointer, dimension(:) :: stk_wavenumbers => NULL() !< + real, pointer, dimension(:,:,:) :: ustkb => NULL() !< + real, pointer, dimension(:,:,:) :: vstkb => NULL() !< + integer :: num_stk_bands !< Number of Stokes drift bands passed through the coupler integer :: xtype !< The type of the exchange - REGRID, REDIST or DIRECT type(coupler_2d_bc_type) :: fluxes !< A structure that may contain an array of - !! named fields used for passive tracer fluxes. + !! namedfields used for passive tracer fluxes. integer :: wind_stagger = -999 !< A flag indicating the spatial discretization of !! wind stresses. This flag may be set by the !! flux-exchange code, based on what the sea-ice @@ -619,7 +625,7 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS) real :: mass_eff !< effective mass of sea ice for rigidity (kg/m^2) integer :: wind_stagger !< AGRID, BGRID_NE, or CGRID_NE (integers from MOM_domains) - integer :: i, j, is, ie, js, je, Isq, Ieq, Jsq, Jeq, i0, j0 + integer :: i, j, is, ie, js, je, Isq, Ieq, Jsq, Jeq, i0, j0, istk integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB, isr, ier, jsr, jer integer :: isc_bnd, iec_bnd, jsc_bnd, jec_bnd @@ -658,6 +664,7 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS) if ( (associated(IOB%area_berg) .and. (.not. associated(forces%area_berg))) .or. & (associated(IOB%mass_berg) .and. (.not. associated(forces%mass_berg))) ) & call allocate_mech_forcing(G, forces, iceberg=.true.) + if (associated(IOB%ice_rigidity)) then rigidity_at_h(:,:) = 0.0 call safe_alloc_ptr(forces%rigidity_ice_u,IsdB,IedB,jsd,jed) @@ -668,6 +675,9 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS) if (associated(forces%rigidity_ice_u)) forces%rigidity_ice_u(:,:) = 0.0 if (associated(forces%rigidity_ice_v)) forces%rigidity_ice_v(:,:) = 0.0 + if ( associated(IOB%ustkb) ) & + call allocate_mech_forcing(G, forces, waves=.true., num_stk_bands=IOB%num_stk_bands) + ! applied surface pressure from atmosphere and cryosphere if (CS%use_limited_P_SSH) then forces%p_surf_SSH => forces%p_surf @@ -825,6 +835,24 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS) endif ! endif for wind related fields + ! wave to ocean coupling + if ( associated(IOB%ustkb) ) then + + forces%stk_wavenumbers(:) = IOB%stk_wavenumbers + do j=js,je; do i=is,ie + forces%ustk0(i,j) = IOB%ustk0(i-I0,j-J0) ! How to be careful here that the domains are right? + forces%vstk0(i,j) = IOB%vstk0(i-I0,j-J0) + enddo ; enddo + call pass_vector(forces%ustk0,forces%vstk0, G%domain ) + do istk = 1,IOB%num_stk_bands + do j=js,je; do i=is,ie + forces%ustkb(i,j,istk) = IOB%ustkb(i-I0,j-J0,istk) + forces%vstkb(i,j,istk) = IOB%vstkb(i-I0,j-J0,istk) + enddo; enddo + call pass_vector(forces%ustkb(:,:,istk),forces%vstkb(:,:,istk), G%domain ) + enddo + endif + ! sea ice related dynamic fields if (associated(IOB%ice_rigidity)) then call pass_var(rigidity_at_h, G%Domain, halo=1) diff --git a/src/core/MOM_forcing_type.F90 b/src/core/MOM_forcing_type.F90 index 3dd3af8fbf..699709722d 100644 --- a/src/core/MOM_forcing_type.F90 +++ b/src/core/MOM_forcing_type.F90 @@ -230,6 +230,15 @@ module MOM_forcing_type !! ice needs to be accumulated, and the rigidity explicitly !! reset to zero at the driver level when appropriate. + real, pointer, dimension(:,:) :: & + ustk0 => NULL(), & + vstk0 => NULL() + real, pointer, dimension(:) :: & + stk_wavenumbers => NULL() + real, pointer, dimension(:,:,:) :: & + ustkb => NULL(), & + vstkb => NULL() + logical :: initialized = .false. !< This indicates whether the appropriate arrays have been initialized. end type mech_forcing @@ -2875,7 +2884,7 @@ subroutine allocate_forcing_type(G, fluxes, water, heat, ustar, press, shelf, ic end subroutine allocate_forcing_type !> Conditionally allocate fields within the mechanical forcing type -subroutine allocate_mech_forcing(G, forces, stress, ustar, shelf, press, iceberg) +subroutine allocate_mech_forcing(G, forces, stress, ustar, shelf, press, iceberg, waves, num_stk_bands) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(mech_forcing), intent(inout) :: forces !< Forcing fields structure @@ -2884,6 +2893,8 @@ subroutine allocate_mech_forcing(G, forces, stress, ustar, shelf, press, iceberg logical, optional, intent(in) :: shelf !< If present and true, allocate forces for ice-shelf logical, optional, intent(in) :: press !< If present and true, allocate p_surf and related fields logical, optional, intent(in) :: iceberg !< If present and true, allocate forces for icebergs + logical, optional, intent(in) :: waves !< If present and true, allocate wave fields + integer, optional, intent(in) :: num_stk_bands !< Number of Stokes bands to allocate ! Local variables integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB @@ -2910,6 +2921,18 @@ subroutine allocate_mech_forcing(G, forces, stress, ustar, shelf, press, iceberg call myAlloc(forces%area_berg,isd,ied,jsd,jed, iceberg) call myAlloc(forces%mass_berg,isd,ied,jsd,jed, iceberg) + !These fields should only be allocated when waves are being passed through the coupler + call myAlloc(forces%ustk0,isd,ied,jsd,jed, waves) + call myAlloc(forces%vstk0,isd,ied,jsd,jed, waves) + if (present(waves)) then; if (waves) then; if (.not.associated(forces%ustkb)) then + if (.not.(present(num_stk_bands))) call MOM_error(FATAL,"Requested to initialize with waves, but no waves are present.") + allocate(forces%stk_wavenumbers(num_stk_bands)) ; forces%stk_wavenumbers (:) = 0.0 + allocate(forces%ustkb(isd:ied,jsd:jed,num_stk_bands)) ; forces%ustkb(isd:ied,jsd:jed,:) = 0.0 + endif; endif; endif + if (present(waves)) then; if (waves) then; if (.not.associated(forces%vstkb)) then + allocate(forces%vstkb(isd:ied,jsd:jed,num_stk_bands)) ; forces%vstkb(isd:ied,jsd:jed,:) = 0.0 + endif; endif; endif + end subroutine allocate_mech_forcing !> Allocates and zeroes-out array. diff --git a/src/user/MOM_wave_interface.F90 b/src/user/MOM_wave_interface.F90 index 46aced3127..23c9c3a678 100644 --- a/src/user/MOM_wave_interface.F90 +++ b/src/user/MOM_wave_interface.F90 @@ -9,6 +9,7 @@ module MOM_wave_interface use MOM_domains, only : To_South, To_West, To_All use MOM_error_handler, only : MOM_error, FATAL, WARNING use MOM_file_parser, only : get_param, log_version, param_file_type +use MOM_forcing_type, only : mech_forcing use MOM_grid, only : ocean_grid_type use MOM_safe_alloc, only : safe_alloc_ptr use MOM_time_manager, only : time_type, operator(+), operator(/) @@ -68,6 +69,9 @@ module MOM_wave_interface !! approach. ! Surface Wave Dependent 1d/2d/3d vars + integer, public :: NumBands =0 !< Number of wavenumber/frequency partitions to receive + !! This needs to match the number of bands provided + !! via either coupling or file. real, allocatable, dimension(:), public :: & WaveNum_Cen !< Wavenumber bands for read/coupled [m-1] real, allocatable, dimension(:), public :: & @@ -138,10 +142,6 @@ module MOM_wave_interface !! \todo Module variable! Move into a control structure. ! Options if WaveMethod is Surface Stokes Drift Bands (1) -integer, public :: NumBands =0 !< Number of wavenumber/frequency partitions to receive - !! This needs to match the number of bands provided - !! via either coupling or file. - !! \todo Module variable! Move into a control structure. integer, public :: PartitionMode !< Method for partition mode (meant to check input) !! 0 - wavenumbers !! 1 - frequencies @@ -300,22 +300,34 @@ subroutine MOM_wave_interface_init(time, G, GV, US, param_file, CS, diag ) "Filename of surface Stokes drift input band data.", default="StkSpec.nc") case (COUPLER_STRING)! Reserved for coupling DataSource = Coupler + ! This is just to make something work, but it needs to be read from the wavemodel. + call get_param(param_file,mdl,"STK_BAND_COUPLER",CS%NumBands, & + "STK_BAND_COUPLER is the number of Stokes drift bands in the coupler. "// & + "This has to be consistent with the number of Stokes drift bands in WW3, "//& + "or the model will fail.",units='', default=1) + allocate( CS%WaveNum_Cen(CS%NumBands) ) + allocate( CS%STKx0(G%isdB:G%iedB,G%jsd:G%jed,CS%NumBands)) + allocate( CS%STKy0(G%isdB:G%iedB,G%jsd:G%jed,CS%NumBands)) + CS%WaveNum_Cen(:) = 0.0 + CS%STKx0(:,:,:) = 0.0 + CS%STKy0(:,:,:) = 0.0 + partitionmode = 0 case (INPUT_STRING)! A method to input the Stokes band (globally uniform) DataSource = Input - call get_param(param_file,mdl,"SURFBAND_NB",NumBands, & + call get_param(param_file,mdl,"SURFBAND_NB",CS%NumBands, & "Prescribe number of wavenumber bands for Stokes drift. "// & "Make sure this is consistnet w/ WAVENUMBERS, STOKES_X, and "// & "STOKES_Y, there are no safety checks in the code.", & units='', default=1) - allocate( CS%WaveNum_Cen(1:NumBands) ) + allocate( CS%WaveNum_Cen(1:CS%NumBands) ) CS%WaveNum_Cen(:) = 0.0 - allocate( CS%PrescribedSurfStkX(1:NumBands)) + allocate( CS%PrescribedSurfStkX(1:CS%NumBands)) CS%PrescribedSurfStkX(:) = 0.0 - allocate( CS%PrescribedSurfStkY(1:NumBands)) + allocate( CS%PrescribedSurfStkY(1:CS%NumBands)) CS%PrescribedSurfStkY(:) = 0.0 - allocate( CS%STKx0(G%isdB:G%iedB,G%jsd:G%jed,1:NumBands)) + allocate( CS%STKx0(G%isdB:G%iedB,G%jsd:G%jed,1:CS%NumBands)) CS%STKx0(:,:,:) = 0.0 - allocate( CS%STKy0(G%isd:G%ied,G%jsdB:G%jedB,1:NumBands)) + allocate( CS%STKy0(G%isd:G%ied,G%jsdB:G%jedB,1:CS%NumBands)) CS%STKy0(:,:,:) = 0.0 partitionmode=0 call get_param(param_file,mdl,"SURFBAND_WAVENUMBERS",CS%WaveNum_Cen, & @@ -433,13 +445,14 @@ subroutine MOM_wave_interface_init_lite(param_file) end subroutine MOM_wave_interface_init_lite !> Subroutine that handles updating of surface wave/Stokes drift related properties -subroutine Update_Surface_Waves(G, GV, US, Day, dt, CS) +subroutine Update_Surface_Waves(G, GV, US, Day, dt, CS, forces) type(wave_parameters_CS), pointer :: CS !< Wave parameter Control structure type(ocean_grid_type), intent(inout) :: G !< Grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(time_type), intent(in) :: Day !< Current model time type(time_type), intent(in) :: dt !< Timestep as a time-type + type(mech_forcing), intent(in) :: forces !< MOM_forcing_type ! Local variables integer :: ii, jj, kk, b type(time_type) :: Day_Center @@ -453,9 +466,29 @@ subroutine Update_Surface_Waves(G, GV, US, Day, dt, CS) if (DataSource==DATAOVR) then call Surface_Bands_by_data_override(day_center, G, GV, US, CS) elseif (DataSource==Coupler) then - ! Reserve for coupler hooks + if (size(CS%WaveNum_Cen).ne.size(forces%stk_wavenumbers)) then + call MOM_error(FATAL, "Number of wavenumber bands in WW3 does not match that in MOM6. "//& + "Make sure that STK_BAND_COUPLER in MOM6 input is equal to the number of bands in "//& + "ww3_grid.inp, and that your mod_def.ww3 is up to date.") + endif + + do b=1,CS%NumBands + CS%WaveNum_Cen(b) = forces%stk_wavenumbers(b) + !Interpolate from a grid to c grid + do II=G%iscB,G%iecB + do jj=G%jsc,G%jec + CS%STKx0(II,jj,b) = 0.5*(forces%UStkb(ii,jj,b)+forces%UStkb(ii+1,jj,b)) + enddo + enddo + do ii=G%isc,G%iec + do JJ=G%jscB, G%jecB + CS%STKY0(ii,JJ,b) = 0.5*(forces%VStkb(ii,jj,b)+forces%VStkb(ii,jj+1,b)) + enddo + enddo + call pass_vector(CS%STKx0(:,:,b),CS%STKy0(:,:,b), G%Domain) + enddo elseif (DataSource==Input) then - do b=1,NumBands + do b=1,CS%NumBands do II=G%isdB,G%iedB do jj=G%jsd,G%jed CS%STKx0(II,jj,b) = CS%PrescribedSurfStkX(b) @@ -485,13 +518,14 @@ subroutine Update_Stokes_Drift(G, GV, US, CS, h, ustar) real, dimension(SZI_(G),SZJ_(G)), & intent(in) :: ustar !< Wind friction velocity [Z T-1 ~> m s-1]. ! Local Variables - real :: Top, MidPoint, Bottom, one_cm + real :: Top, MidPoint, Bottom, one_cm, level_thick, min_level_thick_avg real :: DecayScale real :: CMN_FAC, WN, UStokes real :: La integer :: ii, jj, kk, b, iim1, jjm1 one_cm = 0.01*US%m_to_Z + min_level_thick_avg = 1.e-3*US%m_to_Z ! 1. If Test Profile Option is chosen ! Computing mid-point value from surface value and decay wavelength @@ -536,7 +570,7 @@ subroutine Update_Stokes_Drift(G, GV, US, CS, h, ustar) do jj = G%jsd,G%jed ! 1. First compute the surface Stokes drift ! by integrating over the partitionas. - do b = 1,NumBands + do b = 1,CS%NumBands if (PartitionMode==0) then ! In wavenumber we are averaging over (small) level CMN_FAC = (1.0-exp(-one_cm*2.*CS%WaveNum_Cen(b))) / & @@ -552,26 +586,40 @@ subroutine Update_Stokes_Drift(G, GV, US, CS, h, ustar) do kk = 1,G%ke Top = Bottom IIm1 = max(II-1,1) - MidPoint = Bottom - GV%H_to_Z*0.25*(h(II,jj,kk)+h(IIm1,jj,kk)) - Bottom = Bottom - GV%H_to_Z*0.5*(h(II,jj,kk)+h(IIm1,jj,kk)) - do b = 1,NumBands - if (PartitionMode==0) then + level_thick = 0.5*GV%H_to_Z*(h(II,jj,kk)+h(IIm1,jj,kk)) + MidPoint = Bottom - 0.5*level_thick + Bottom = Bottom - level_thick + ! -> Stokes drift in thin layers not averaged. + if (level_thick>min_level_thick_avg) then + do b = 1,CS%NumBands + if (PartitionMode==0) then ! In wavenumber we are averaging over level - CMN_FAC = (exp(Top*2.*CS%WaveNum_Cen(b))-exp(Bottom*2.*CS%WaveNum_Cen(b)))& - / ((Top-Bottom)*(2.*CS%WaveNum_Cen(b))) - elseif (PartitionMode==1) then - if (CS%StkLevelMode==0) then - ! Take the value at the midpoint - CMN_FAC = exp(MidPoint*2.*(2.*PI*CS%Freq_Cen(b)*US%T_to_s)**2/(US%L_to_Z**2*GV%g_Earth)) - elseif (CS%StkLevelMode==1) then - ! Use a numerical integration and then - ! divide by layer thickness - WN = (2.*PI*CS%Freq_Cen(b)*US%T_to_s)**2 / (US%L_to_Z**2*GV%g_Earth) !bgr bug-fix missing g - CMN_FAC = (exp(2.*WN*Top)-exp(2.*WN*Bottom)) / (2.*WN*(Top-Bottom)) + CMN_FAC = (exp(Top*2.*CS%WaveNum_Cen(b))-exp(Bottom*2.*CS%WaveNum_Cen(b)))& + / ((Top-Bottom)*(2.*CS%WaveNum_Cen(b))) + elseif (PartitionMode==1) then + if (CS%StkLevelMode==0) then + ! Take the value at the midpoint + CMN_FAC = exp(MidPoint*2.*(2.*PI*CS%Freq_Cen(b)*US%T_to_s)**2/(US%L_to_Z**2*GV%g_Earth)) + elseif (CS%StkLevelMode==1) then + ! Use a numerical integration and then + ! divide by layer thickness + WN = (2.*PI*CS%Freq_Cen(b)*US%T_to_s)**2 / (US%L_to_Z**2*GV%g_Earth) !bgr bug-fix missing g + CMN_FAC = (exp(2.*WN*Top)-exp(2.*WN*Bottom)) / (2.*WN*(Top-Bottom)) + endif endif - endif - CS%US_x(II,jj,kk) = CS%US_x(II,jj,kk) + CS%STKx0(II,jj,b)*CMN_FAC - enddo + CS%US_x(II,jj,kk) = CS%US_x(II,jj,kk) + CS%STKx0(II,jj,b)*CMN_FAC + enddo + else + ! Take the value at the midpoint + do b = 1,CS%NumBands + if (PartitionMode==0) then + CMN_FAC = exp(MidPoint*2.*CS%WaveNum_Cen(b)) + elseif (PartitionMode==1) then + CMN_FAC = exp(MidPoint*2.*(2.*PI*CS%Freq_Cen(b)*US%T_to_s)**2/(US%L_to_Z**2*GV%g_Earth)) + endif + CS%US_x(II,jj,kk) = CS%US_x(II,jj,kk) + CS%STKx0(II,jj,b)*CMN_FAC + enddo + endif enddo enddo enddo @@ -579,7 +627,7 @@ subroutine Update_Stokes_Drift(G, GV, US, CS, h, ustar) do ii = G%isd,G%ied do JJ = G%jsdB,G%jedB ! Compute the surface values. - do b = 1,NumBands + do b = 1,CS%NumBands if (PartitionMode==0) then ! In wavenumber we are averaging over (small) level CMN_FAC = (1.0-exp(-one_cm*2.*CS%WaveNum_Cen(b))) / & @@ -595,27 +643,40 @@ subroutine Update_Stokes_Drift(G, GV, US, CS, h, ustar) do kk = 1,G%ke Top = Bottom JJm1 = max(JJ-1,1) - MidPoint = Bottom - GV%H_to_Z*0.25*(h(ii,JJ,kk)+h(ii,JJm1,kk)) - Bottom = Bottom - GV%H_to_Z*0.5*(h(ii,JJ,kk)+h(ii,JJm1,kk)) - do b = 1,NumBands - if (PartitionMode==0) then + level_thick = 0.5*GV%H_to_Z*(h(ii,JJ,kk)+h(ii,JJm1,kk)) + MidPoint = Bottom - 0.5*level_thick + Bottom = Bottom - level_thick + ! -> Stokes drift in thin layers not averaged. + if (level_thick>min_level_thick_avg) then + do b = 1,CS%NumBands + if (PartitionMode==0) then ! In wavenumber we are averaging over level - CMN_FAC = (exp(Top*2.*CS%WaveNum_Cen(b)) - & - exp(Bottom*2.*CS%WaveNum_Cen(b))) / & - ((Top-Bottom)*(2.*CS%WaveNum_Cen(b))) - elseif (PartitionMode==1) then - if (CS%StkLevelMode==0) then - ! Take the value at the midpoint - CMN_FAC = exp(MidPoint*2.*(2.*PI*CS%Freq_Cen(b)*US%T_to_s)**2/(US%L_to_Z**2*GV%g_Earth)) - elseif (CS%StkLevelMode==1) then - ! Use a numerical integration and then - ! divide by layer thickness - WN = (2.*PI*CS%Freq_Cen(b)*US%T_to_s)**2 / (US%L_to_Z**2*GV%g_Earth) - CMN_FAC = (exp(2.*WN*Top)-exp(2.*WN*Bottom)) / (2.*WN*(Top-Bottom)) + CMN_FAC = (exp(Top*2.*CS%WaveNum_Cen(b))-exp(Bottom*2.*CS%WaveNum_Cen(b)))& + / ((Top-Bottom)*(2.*CS%WaveNum_Cen(b))) + elseif (PartitionMode==1) then + if (CS%StkLevelMode==0) then + ! Take the value at the midpoint + CMN_FAC = exp(MidPoint*2.*(2.*PI*CS%Freq_Cen(b)*US%T_to_s)**2/(US%L_to_Z**2*GV%g_Earth)) + elseif (CS%StkLevelMode==1) then + ! Use a numerical integration and then + ! divide by layer thickness + WN = (2.*PI*CS%Freq_Cen(b)*US%T_to_s)**2 / (US%L_to_Z**2*GV%g_Earth) !bgr bug-fix missing g + CMN_FAC = (exp(2.*WN*Top)-exp(2.*WN*Bottom)) / (2.*WN*(Top-Bottom)) + endif endif - endif - CS%US_y(ii,JJ,kk) = CS%US_y(ii,JJ,kk) + CS%STKy0(ii,JJ,b)*CMN_FAC - enddo + CS%US_y(ii,JJ,kk) = CS%US_y(ii,JJ,kk) + CS%STKy0(ii,JJ,b)*CMN_FAC + enddo + else + ! Take the value at the midpoint + do b = 1,CS%NumBands + if (PartitionMode==0) then + CMN_FAC = exp(MidPoint*2.*CS%WaveNum_Cen(b)) + elseif (PartitionMode==1) then + CMN_FAC = exp(MidPoint*2.*(2.*PI*CS%Freq_Cen(b)*US%T_to_s)**2/(US%L_to_Z**2*GV%g_Earth)) + endif + CS%US_y(ii,JJ,kk) = CS%US_y(ii,JJ,kk) + CS%STKy0(ii,JJ,b)*CMN_FAC + enddo + endif enddo enddo enddo @@ -812,8 +873,8 @@ subroutine Surface_Bands_by_data_override(day_center, G, GV, US, CS) trim(varread1)//",dim_name "//trim(dim_name(1))// & " in file "// trim(SurfBandFileName)//" in MOM_wave_interface") endif - NUMBANDS = ID - do B = 1,NumBands ; CS%WaveNum_Cen(b) = US%Z_to_m*CS%WaveNum_Cen(b) ; enddo + CS%NUMBANDS = ID + do B = 1,CS%NumBands ; CS%WaveNum_Cen(b) = US%Z_to_m*CS%WaveNum_Cen(b) ; enddo elseif (PartitionMode==1) then rcode_fr = NF90_GET_VAR(ncid, dim_id(1), CS%Freq_Cen, start, counter) if (rcode_fr /= 0) then @@ -822,15 +883,15 @@ subroutine Surface_Bands_by_data_override(day_center, G, GV, US, CS) trim(varread2)//",dim_name "//trim(dim_name(1))// & " in file "// trim(SurfBandFileName)//" in MOM_wave_interface") endif - NUMBANDS = ID - do B = 1,NumBands + CS%NUMBANDS = ID + do B = 1,CS%NumBands CS%WaveNum_Cen(b) = (2.*PI*CS%Freq_Cen(b)*US%T_to_s)**2 / (US%L_to_Z**2*GV%g_Earth) enddo endif endif - do b = 1,NumBands + do b = 1,CS%NumBands temp_x(:,:) = 0.0 temp_y(:,:) = 0.0 varname = ' ' @@ -904,9 +965,10 @@ subroutine get_Langmuir_Number( LA, G, GV, US, HBL, ustar, i, j, & real :: LA_STKx, LA_STKy, LA_STK ! Stokes velocities in [m s-1] logical :: ContinueLoop, USE_MA real, dimension(SZK_(G)) :: US_H, VS_H - real, dimension(NumBands) :: StkBand_X, StkBand_Y + real, allocatable :: StkBand_X(:), StkBand_Y(:) integer :: KK, BB + ! Compute averaging depth for Stokes drift (negative) Dpt_LASL = min(-0.1*US%m_to_Z, -LA_FracHBL*HBL) @@ -940,13 +1002,15 @@ subroutine get_Langmuir_Number( LA, G, GV, US, HBL, ustar, i, j, & call Get_SL_Average_Prof( GV, Dpt_LASL, H, VS_H, LA_STKy) LA_STK = sqrt(LA_STKX*LA_STKX+LA_STKY*LA_STKY) elseif (WaveMethod==SURFBANDS) then - do bb = 1,NumBands + allocate(StkBand_X(WAVES%NumBands), StkBand_Y(WAVES%NumBands)) + do bb = 1,WAVES%NumBands StkBand_X(bb) = 0.5*(WAVES%STKx0(I,j,bb)+WAVES%STKx0(I-1,j,bb)) StkBand_Y(bb) = 0.5*(WAVES%STKy0(i,J,bb)+WAVES%STKy0(i,J-1,bb)) enddo - call Get_SL_Average_Band(GV, Dpt_LASL, NumBands, WAVES%WaveNum_Cen, StkBand_X, LA_STKx ) - call Get_SL_Average_Band(GV, Dpt_LASL, NumBands, WAVES%WaveNum_Cen, StkBand_Y, LA_STKy ) + call Get_SL_Average_Band(GV, Dpt_LASL, WAVES%NumBands, WAVES%WaveNum_Cen, StkBand_X, LA_STKx ) + call Get_SL_Average_Band(GV, Dpt_LASL, WAVES%NumBands, WAVES%WaveNum_Cen, StkBand_Y, LA_STKy ) LA_STK = sqrt(LA_STKX**2 + LA_STKY**2) + deallocate(StkBand_X, StkBand_Y) elseif (WaveMethod==DHH85) then ! Temporarily integrating profile rather than spectrum for simplicity do kk = 1,GV%ke From cbcf3ec9b19c6e35ea836b1d5cf1bacebbdc414a Mon Sep 17 00:00:00 2001 From: jiandewang Date: Fri, 10 Jul 2020 23:34:22 -0400 Subject: [PATCH 08/19] bug fixing: (1) add missing halo in MOM_full_convection.F90 (2) remove wrong logic "not" in MOM.F90 at line 2669 --- src/core/MOM.F90 | 2 +- src/parameterizations/vertical/MOM_full_convection.F90 | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index a044f95893..4c3d6bd250 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -2666,7 +2666,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & call register_obsolete_diagnostics(param_file, CS%diag) if (use_frazil) then - if (.not.query_initialized(CS%tv%frazil,"frazil",restart_CSp)) then + if (query_initialized(CS%tv%frazil,"frazil",restart_CSp)) then ! Test whether the dimensional rescaling has changed for heat content. if ((US%kg_m3_to_R_restart*US%m_to_Z_restart*US%J_kg_to_Q_restart /= 0.0) .and. & ((US%J_kg_to_Q*US%kg_m3_to_R*US%m_to_Z) /= & diff --git a/src/parameterizations/vertical/MOM_full_convection.F90 b/src/parameterizations/vertical/MOM_full_convection.F90 index 1783955d53..3be6628b14 100644 --- a/src/parameterizations/vertical/MOM_full_convection.F90 +++ b/src/parameterizations/vertical/MOM_full_convection.F90 @@ -408,7 +408,7 @@ subroutine smoothed_dRdT_dRdS(h, tv, Kddt, dR_dT, dR_dS, G, GV, US, j, p_surf, h else do i=is,ie ; pres(i) = 0.0 ; enddo endif - EOSdom(:) = EOS_domain(G%HI) + EOSdom(:) = EOS_domain(G%HI, halo) call calculate_density_derivs(T_f(:,1), S_f(:,1), pres, dR_dT(:,1), dR_dS(:,1), tv%eqn_of_state, EOSdom) do i=is,ie ; pres(i) = pres(i) + h(i,j,1)*(GV%H_to_RZ*GV%g_Earth) ; enddo do K=2,nz From 7e1188c7221076acfabe877b6ca919eb42c7a07b Mon Sep 17 00:00:00 2001 From: Denise Worthen Date: Thu, 6 Aug 2020 16:57:53 -0400 Subject: [PATCH 09/19] add statediagnose feature (#31) --- config_src/nuopc_driver/mom_cap.F90 | 35 +++- config_src/nuopc_driver/mom_cap_methods.F90 | 183 +++++++++++++++++++- 2 files changed, 210 insertions(+), 8 deletions(-) diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index a8056129ff..d49f370a47 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 @@ -273,6 +273,14 @@ 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) @@ -358,6 +366,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 @@ -520,8 +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) @@ -1431,6 +1445,11 @@ 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 !--------------- @@ -1459,6 +1478,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..0997fbc635 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 @@ -763,6 +765,183 @@ 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 eb58a2e23242ec0c23dd645ac4e21eaab2a3d490 Mon Sep 17 00:00:00 2001 From: Denise Worthen Date: Wed, 9 Sep 2020 09:41:54 -0400 Subject: [PATCH 10/19] add ocean lag option, make cap consistent (#33) * use flag to control lag startup * additional log msg cleanup * clarify restart_mode control --- config_src/nuopc_driver/mom_cap.F90 | 175 +++++++++--------- config_src/nuopc_driver/mom_cap_methods.F90 | 8 +- .../nuopc_driver/mom_ocean_model_nuopc.F90 | 5 +- .../mom_surface_forcing_nuopc.F90 | 2 +- src/framework/MOM_restart.F90 | 4 +- 5 files changed, 103 insertions(+), 91 deletions(-) diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index d49f370a47..67bae67f74 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -72,7 +72,7 @@ module MOM_cap_mod use ESMF, only: ESMF_ArrayCreate use ESMF, only: ESMF_RC_FILE_OPEN, ESMF_RC_FILE_READ, ESMF_RC_FILE_WRITE use ESMF, only: ESMF_VMBroadcast -use ESMF, only: ESMF_AlarmCreate, ESMF_ClockGetAlarmList, ESMF_AlarmList_Flag +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: operator(==), operator(/=), operator(+), operator(-) @@ -134,6 +134,7 @@ module MOM_cap_mod integer :: logunit !< stdout logging unit number logical :: profile_memory = .true. logical :: grid_attach_area = .false. +logical :: use_coldstart = .true. character(len=128) :: scalar_field_name = '' integer :: scalar_field_count = 0 integer :: scalar_field_idx_grid_nx = 0 @@ -148,7 +149,7 @@ module MOM_cap_mod logical :: cesm_coupled = .false. type(ESMF_GeomType_Flag) :: geomtype = ESMF_GEOMTYPE_GRID #endif -character(len=8) :: restart_mode = 'cmeps' +character(len=8) :: restart_mode = 'alarms' contains @@ -338,6 +339,14 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) call ESMF_LogWrite('MOM_cap:ScalarFieldIdxGridNY = '//trim(logmsg), ESMF_LOGMSG_INFO) endif + use_coldstart = .true. + call NUOPC_CompAttributeGet(gcomp, name="use_coldstart", value=value, & + isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) use_coldstart=(trim(value)=="true") + write(logmsg,*) use_coldstart + call ESMF_LogWrite('MOM_cap:use_coldstart = '//trim(logmsg), ESMF_LOGMSG_INFO) + end subroutine !> Called by NUOPC to advertise import and export fields. "Advertise" @@ -389,6 +398,8 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) integer :: iostat integer :: readunit character(len=512) :: restartfile ! Path/Name of restart file + character(len=2048) :: restartfiles ! Path/Name of restart files + ! (same as restartfile if single restart file) character(len=*), parameter :: subname='(MOM_cap:InitializeAdvertise)' character(len=32) :: calendar !-------------------------------- @@ -420,6 +431,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) CALL ESMF_TimeIntervalGet(TINT, S=DT_OCEAN, RC=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + !TODO: next two lines not present in NCAR call fms_init(mpi_comm_mom) call constants_init call field_manager_init @@ -527,24 +539,24 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call ESMF_LogWrite('MOM_cap:startup = '//trim(runtype), ESMF_LOGMSG_INFO) endif - restartfile = "" + restartfile = ""; restartfiles = "" if (runtype == "initial") then if (cesm_coupled) then - restartfile = "n" + restartfiles = "n" else call get_MOM_input(dirs=dirs) - restartfile = dirs%input_filename(1:1) + restartfiles = dirs%input_filename(1:1) endif - call ESMF_LogWrite('MOM_cap:restartfile = '//trim(restartfile), ESMF_LOGMSG_INFO) + call ESMF_LogWrite('MOM_cap:restartfile = '//trim(restartfiles), ESMF_LOGMSG_INFO) else if (runtype == "continue") then ! hybrid or branch or continuos runs if (cesm_coupled) then call ESMF_LogWrite('MOM_cap: restart requested, using rpointer.ocn', ESMF_LOGMSG_WARNING) call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_VMGet(vm, localPet=localPet, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return if (localPet == 0) then ! this hard coded for rpointer.ocn right now @@ -554,17 +566,28 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) line=__LINE__, file=u_FILE_u, rcToReturn=rc) return endif - read(readunit,'(a)', iostat=iostat) restartfile - if (iostat /= 0) then - call ESMF_LogSetError(ESMF_RC_FILE_READ, msg=subname//' ERROR reading rpointer.ocn', & - line=__LINE__, file=u_FILE_u, rcToReturn=rc) - return - endif + do + read(readunit,'(a)', iostat=iostat) restartfile + if (iostat /= 0) then + if (len(trim(restartfiles))>1 .and. iostat<0) then + exit ! done reading restart files list. + else + call ESMF_LogSetError(ESMF_RC_FILE_READ, msg=subname//' ERROR reading rpointer.ocn', & + line=__LINE__, file=u_FILE_u, rcToReturn=rc) + return + endif + endif + ! check if the length of restartfiles variable is sufficient: + if (len(restartfiles)-len(trim(restartfiles)) < len(trim(restartfile))) then + call MOM_error(FATAL, "Restart file name(s) too long.") + endif + restartfiles = trim(restartfiles) // " " // trim(restartfile) + enddo close(readunit) endif ! broadcast attribute set on master task to all tasks - call ESMF_VMBroadcast(vm, restartfile, count=ESMF_MAXSTR-1, rootPet=0, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + call ESMF_VMBroadcast(vm, restartfiles, count=len(restartfiles), rootPet=0, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return else call ESMF_LogWrite('MOM_cap: restart requested, use input.nml', ESMF_LOGMSG_WARNING) endif @@ -572,7 +595,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) endif ocean_public%is_ocean_pe = .true. - call ocean_model_init(ocean_public, ocean_state, time0, time_start, input_restart_file=trim(restartfile)) + call ocean_model_init(ocean_public, ocean_state, time0, time_start, input_restart_file=trim(restartfiles)) call ocean_model_init_sfc(ocean_state, ocean_public) @@ -1250,9 +1273,9 @@ subroutine DataInitialize(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_ClockGet(clock, currTime=currTime, timeStep=timeStep, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_TimeGet(currTime, timestring=timestr, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_GridCompGetInternalState(gcomp, ocean_internalstate, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -1349,10 +1372,12 @@ subroutine ModelAdvance(gcomp, rc) integer :: writeunit integer :: localPet type(ESMF_VM) :: vm - integer :: n + integer :: n, i character(240) :: import_timestr, export_timestr character(len=128) :: fldname character(len=*),parameter :: subname='(MOM_cap:ModelAdvance)' + character(len=8) :: suffix + integer :: num_rest_files rc = ESMF_SUCCESS if(profile_memory) call ESMF_VMLogMemInfo("Entering MOM Model_ADVANCE: ") @@ -1390,7 +1415,7 @@ subroutine ModelAdvance(gcomp, rc) ! Apply ocean lag for startup runs: !--------------- - if (cesm_coupled) then + if (cesm_coupled .or. (.not.use_coldstart)) then if (trim(runtype) == "initial") then ! Do not call MOM6 timestepping routine if the first cpl tstep of a startup run @@ -1489,55 +1514,42 @@ subroutine ModelAdvance(gcomp, rc) !--------------- call ESMF_ClockGetAlarm(clock, alarmname='stop_alarm', alarm=stop_alarm, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return !--------------- ! If restart alarm exists and is ringing - write restart file !--------------- - if (restart_mode == 'cmeps') then + if (restart_mode == 'alarms') then call ESMF_ClockGetAlarm(clock, alarmname='restart_alarm', alarm=restart_alarm, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return if (ESMF_AlarmIsRinging(restart_alarm, rc=rc)) then - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return ! turn off the alarm call ESMF_AlarmRingerOff(restart_alarm, rc=rc ) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! determine restart filename call ESMF_ClockGetNextTime(clock, MyTime, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_TimeGet (MyTime, yy=year, mm=month, dd=day, h=hour, m=minute, s=seconds, rc=rc ) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (cesm_coupled) then call NUOPC_CompAttributeGet(gcomp, name='case_name', value=casename, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_VMGet(vm, localPet=localPet, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return write(restartname,'(A,".mom6.r.",I4.4,"-",I2.2,"-",I2.2,"-",I5.5)') & trim(casename), year, month, day, seconds + call ESMF_LogWrite("MOM_cap: Writing restart : "//trim(restartname), ESMF_LOGMSG_INFO) + ! write restart file(s) + call ocean_model_restart(ocean_state, restartname=restartname, num_rest_files=num_rest_files) if (localPet == 0) then ! Write name of restart file in the rpointer file - this is currently hard-coded for the ocean open(newunit=writeunit, file='rpointer.ocn', form='formatted', status='unknown', iostat=iostat) @@ -1547,9 +1559,20 @@ subroutine ModelAdvance(gcomp, rc) return endif write(writeunit,'(a)') trim(restartname)//'.nc' + if (num_rest_files > 1) then + ! append i.th restart file name to rpointer + do i=1, num_rest_files-1 + if (i < 10) then + write(suffix,'("_",I1)') i + else + write(suffix,'("_",I2)') i + endif + write(writeunit,'(a)') trim(restartname) // trim(suffix) // '.nc' + enddo + endif close(writeunit) endif - else + else ! not cesm_coupled ! write the final restart without a timestamp if (ESMF_AlarmIsRinging(stop_alarm, rc=rc)) then write(restartname,'(A)')"MOM.res" @@ -1557,17 +1580,17 @@ subroutine ModelAdvance(gcomp, rc) write(restartname,'(A,I4.4,"-",I2.2,"-",I2.2,"-",I2.2,"-",I2.2,"-",I2.2)') & "MOM.res.", year, month, day, hour, minute, seconds endif - end if - call ESMF_LogWrite("MOM_cap: Writing restart : "//trim(restartname), ESMF_LOGMSG_INFO) + call ESMF_LogWrite("MOM_cap: Writing restart : "//trim(restartname), ESMF_LOGMSG_INFO) - ! write restart file(s) - call ocean_model_restart(ocean_state, restartname=restartname) + ! write restart file(s) + call ocean_model_restart(ocean_state, restartname=restartname) + endif if (is_root_pe()) then write(logunit,*) subname//' writing restart file ',trim(restartname) endif - endif - end if ! end of restart_mode is cmeps + endif + end if ! restart_mode !--------------- ! Write diagnostics @@ -1694,8 +1717,7 @@ subroutine ModelSetRunClock(gcomp, rc) else call NUOPC_CompAttributeGet(gcomp, name="restart_n", value=cvalue, & isPresent=isPresent, isSet=isSet, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return ! If restart_n is set and non-zero, then restart_option must be available from config if (isPresent .and. isSet) then @@ -1704,8 +1726,7 @@ subroutine ModelSetRunClock(gcomp, rc) if(restart_n /= 0)then call NUOPC_CompAttributeGet(gcomp, name="restart_option", value=cvalue, & isPresent=isPresent, isSet=isSet, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return if (isPresent .and. isSet) then read(cvalue,*) restart_option call ESMF_LogWrite(subname//" Restart_option = "//restart_option, & @@ -1720,25 +1741,20 @@ subroutine ModelSetRunClock(gcomp, rc) ! not used in nems call NUOPC_CompAttributeGet(gcomp, name="restart_ymd", value=cvalue, & isPresent=isPresent, isSet=isSet, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return if (isPresent .and. isSet) then read(cvalue,*) restart_ymd call ESMF_LogWrite(subname//" Restart_ymd = "//trim(cvalue), ESMF_LOGMSG_INFO) endif else - ! restart_n is zero, restart_mode will be nems - restart_mode = 'nems' - call ESMF_LogWrite(subname//" Set restart_mode to nems", ESMF_LOGMSG_INFO) + ! restart_n is zero, restarts will be written at finalize only (no alarm control) + restart_mode = 'no_alarms' + call ESMF_LogWrite(subname//" Restarts will be written at finalize only", ESMF_LOGMSG_INFO) endif - else - ! restart_n is not set, restart_mode will be nems - restart_mode = 'nems' - call ESMF_LogWrite(subname//" Set restart_mode to nems", ESMF_LOGMSG_INFO) endif endif - if (restart_mode == 'cmeps') then + if (restart_mode == 'alarms') then call AlarmInit(mclock, & alarm = restart_alarm, & option = trim(restart_option), & @@ -1746,25 +1762,18 @@ subroutine ModelSetRunClock(gcomp, rc) opt_ymd = restart_ymd, & RefTime = mcurrTime, & alarmname = 'restart_alarm', rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_AlarmSet(restart_alarm, clock=mclock, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_LogWrite(subname//" Restart alarm is Created and Set", ESMF_LOGMSG_INFO) end if ! create a 1-shot alarm at the driver stop time stop_alarm = ESMF_AlarmCreate(mclock, ringtime=dstopTime, name = "stop_alarm", rc=rc) call ESMF_LogWrite(subname//" Create Stop alarm", ESMF_LOGMSG_INFO) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return - + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_TimeGet(dstoptime, timestring=timestr, rc=rc) call ESMF_LogWrite("Stop Alarm will ring at : "//trim(timestr), ESMF_LOGMSG_INFO) @@ -1822,8 +1831,8 @@ subroutine ocean_model_finalize(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return Time = esmf2fms_time(currTime) - ! Do not write a restart unless mode is nems - if (restart_mode == 'nems') then + ! Do not write a restart unless mode is no_alarms + if (restart_mode == 'no_alarms') then write_restart = .true. else write_restart = .false. diff --git a/config_src/nuopc_driver/mom_cap_methods.F90 b/config_src/nuopc_driver/mom_cap_methods.F90 index 0997fbc635..1d51c1e6dd 100644 --- a/config_src/nuopc_driver/mom_cap_methods.F90 +++ b/config_src/nuopc_driver/mom_cap_methods.F90 @@ -735,7 +735,7 @@ subroutine State_SetExport(state, fldname, isc, iec, jsc, jec, input, ocean_grid do j = jsc, jec jg = j + ocean_grid%jsc - jsc do i = isc, iec - ig = i + ocean_grid%isc - isc + ig = i + ocean_grid%isc - isc n = n+1 dataPtr1d(n) = input(i,j) * ocean_grid%mask2dT(ig,jg) enddo @@ -877,11 +877,11 @@ subroutine field_getfldptr(field, fldptr1, fldptr2, rank, abort, rc) 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) + call ESMF_LogWrite(trim(subname)//": ERROR data not allocated ", ESMF_LOGMSG_INFO) rc = ESMF_FAILURE return else - call ESMF_LogWrite(trim(subname)//": WARNING data not allocated ", ESMF_LOGMSG_INFO, rc=rc) + call ESMF_LogWrite(trim(subname)//": WARNING data not allocated ", ESMF_LOGMSG_INFO) endif else @@ -901,7 +901,7 @@ subroutine field_getfldptr(field, fldptr1, fldptr2, rank, abort, rc) if (nnodes == 0 .and. nelements == 0) lrank = 0 else call ESMF_LogWrite(trim(subname)//": ERROR geomtype not supported ", & - ESMF_LOGMSG_INFO, rc=rc) + ESMF_LOGMSG_INFO) rc = ESMF_FAILURE return endif ! geomtype diff --git a/config_src/nuopc_driver/mom_ocean_model_nuopc.F90 b/config_src/nuopc_driver/mom_ocean_model_nuopc.F90 index 22fc90d0c1..2616d99e75 100644 --- a/config_src/nuopc_driver/mom_ocean_model_nuopc.F90 +++ b/config_src/nuopc_driver/mom_ocean_model_nuopc.F90 @@ -671,7 +671,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & end subroutine update_ocean_model !> This subroutine writes out the ocean model restart file. -subroutine ocean_model_restart(OS, timestamp, restartname) +subroutine ocean_model_restart(OS, timestamp, restartname, num_rest_files) type(ocean_state_type), pointer :: OS !< A pointer to the structure containing the !! internal ocean state being saved to a restart file character(len=*), optional, intent(in) :: timestamp !< An optional timestamp string that should be @@ -679,6 +679,7 @@ subroutine ocean_model_restart(OS, timestamp, restartname) character(len=*), optional, intent(in) :: restartname !< Name of restart file to use !! This option distinguishes the cesm interface from the !! non-cesm interface + integer, optional, intent(out) :: num_rest_files !< number of restart files written if (.not.MOM_state_is_synchronized(OS%MOM_CSp)) & call MOM_error(WARNING, "End of MOM_main reached with inconsistent "//& @@ -690,7 +691,7 @@ subroutine ocean_model_restart(OS, timestamp, restartname) if (present(restartname)) then call save_restart(OS%dirs%restart_output_dir, OS%Time, OS%grid, & - OS%restart_CSp, GV=OS%GV, filename=restartname) + OS%restart_CSp, GV=OS%GV, filename=restartname, num_rest_files=num_rest_files) call forcing_save_restart(OS%forcing_CSp, OS%grid, OS%Time, & OS%dirs%restart_output_dir) ! Is this needed? if (OS%use_ice_shelf) then diff --git a/config_src/nuopc_driver/mom_surface_forcing_nuopc.F90 b/config_src/nuopc_driver/mom_surface_forcing_nuopc.F90 index 9f207c4a63..3516ad3803 100644 --- a/config_src/nuopc_driver/mom_surface_forcing_nuopc.F90 +++ b/config_src/nuopc_driver/mom_surface_forcing_nuopc.F90 @@ -191,7 +191,7 @@ module MOM_surface_forcing_nuopc integer :: num_stk_bands !< Number of Stokes drift bands passed through the coupler integer :: xtype !< The type of the exchange - REGRID, REDIST or DIRECT type(coupler_2d_bc_type) :: fluxes !< A structure that may contain an array of - !! namedfields used for passive tracer fluxes. + !! named fields used for passive tracer fluxes. integer :: wind_stagger = -999 !< A flag indicating the spatial discretization of !! wind stresses. This flag may be set by the !! flux-exchange code, based on what the sea-ice diff --git a/src/framework/MOM_restart.F90 b/src/framework/MOM_restart.F90 index c918f3a9ee..ca2e37afb9 100644 --- a/src/framework/MOM_restart.F90 +++ b/src/framework/MOM_restart.F90 @@ -849,7 +849,7 @@ function query_initialized_4d_name(f_ptr, name, CS) result(query_initialized) end function query_initialized_4d_name !> save_restart saves all registered variables to restart files. -subroutine save_restart(directory, time, G, CS, time_stamped, filename, GV) +subroutine save_restart(directory, time, G, CS, time_stamped, filename, GV, num_rest_files) character(len=*), intent(in) :: directory !< The directory where the restart files !! are to be written type(time_type), intent(in) :: time !< The current model time @@ -860,6 +860,7 @@ subroutine save_restart(directory, time, G, CS, time_stamped, filename, GV) !! to the restart file names. character(len=*), optional, intent(in) :: filename !< A filename that overrides the name in CS%restartfile. type(verticalGrid_type), optional, intent(in) :: GV !< The ocean's vertical grid structure + integer, optional, intent(out) :: num_rest_files !< number of restart files written ! Local variables type(vardesc) :: vars(CS%max_fields) ! Descriptions of the fields that @@ -1056,6 +1057,7 @@ subroutine save_restart(directory, time, G, CS, time_stamped, filename, GV) num_files = num_files+1 enddo + if (present(num_rest_files)) num_rest_files = num_files end subroutine save_restart !> restore_state reads the model state from previously generated files. All From d13efbe1c55d8989481ef90a6ad90379c3cecaff Mon Sep 17 00:00:00 2001 From: Rahul Mahajan Date: Thu, 8 Oct 2020 17:41:15 -0400 Subject: [PATCH 11/19] fix fieldwidth error with gfortran --- config_src/nuopc_driver/mom_cap.F90 | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index ce11cfb3f9..8d48607281 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -295,7 +295,7 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) isPresent=isPresent, isSet=isSet, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (isPresent .and. isSet) then - read(value, '(i)', iostat=iostat) scalar_field_count + read(value, *, iostat=iostat) scalar_field_count if (iostat /= 0) then call ESMF_LogSetError(ESMF_RC_ARG_BAD, & msg=subname//": ScalarFieldCount not an integer: "//trim(value), & @@ -311,7 +311,7 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) isPresent=isPresent, isSet=isSet, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (isPresent .and. isSet) then - read(value, '(i)', iostat=iostat) scalar_field_idx_grid_nx + read(value, *, iostat=iostat) scalar_field_idx_grid_nx if (iostat /= 0) then call ESMF_LogSetError(ESMF_RC_ARG_BAD, & msg=subname//": ScalarFieldIdxGridNX not an integer: "//trim(value), & @@ -327,7 +327,7 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) isPresent=isPresent, isSet=isSet, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (isPresent .and. isSet) then - read(value, '(i)', iostat=iostat) scalar_field_idx_grid_ny + read(value, *, iostat=iostat) scalar_field_idx_grid_ny if (iostat /= 0) then call ESMF_LogSetError(ESMF_RC_ARG_BAD, & msg=subname//": ScalarFieldIdxGridNY not an integer: "//trim(value), & @@ -700,16 +700,16 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) !call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_runoff_heat_flx" , "will provide") !call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_calving_heat_flx" , "will provide") if (ocean_state%use_waves) then - if (Ice_ocean_boundary%num_stk_bands > 3) then + if (Ice_ocean_boundary%num_stk_bands > 3) then call MOM_error(FATAL, "Number of Stokes Bands > 3, NUOPC cap not set up for this") - endif + endif call fld_list_add(fldsToOcn_num, fldsToOcn, "eastward_partitioned_stokes_drift_1" , "will provide") call fld_list_add(fldsToOcn_num, fldsToOcn, "northward_partitioned_stokes_drift_1", "will provide") call fld_list_add(fldsToOcn_num, fldsToOcn, "eastward_partitioned_stokes_drift_2" , "will provide") call fld_list_add(fldsToOcn_num, fldsToOcn, "northward_partitioned_stokes_drift_2", "will provide") call fld_list_add(fldsToOcn_num, fldsToOcn, "eastward_partitioned_stokes_drift_3" , "will provide") call fld_list_add(fldsToOcn_num, fldsToOcn, "northward_partitioned_stokes_drift_3", "will provide") - endif + endif !--------- export fields ------------- call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocean_mask" , "will provide") @@ -1746,7 +1746,7 @@ subroutine ModelSetRunClock(gcomp, rc) call ESMF_LogWrite(subname//" Restart_ymd = "//trim(cvalue), ESMF_LOGMSG_INFO) endif else - ! restart_n is zero, restarts will be written at finalize only (no alarm control) + ! restart_n is zero, restarts will be written at finalize only (no alarm control) restart_mode = 'no_alarms' call ESMF_LogWrite(subname//" Restarts will be written at finalize only", ESMF_LOGMSG_INFO) endif From 2c150d951f867c9793bdf7191fa76b149acb8492 Mon Sep 17 00:00:00 2001 From: Rahul Mahajan Date: Fri, 20 Nov 2020 13:47:38 -0500 Subject: [PATCH 12/19] bugfix: make the last argument in subroutine Update_Surface_Waves to be optional in src/user/MOM_wave_interface.F90. This is a bug from PR #23 bbdef39. --- src/user/MOM_wave_interface.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/user/MOM_wave_interface.F90 b/src/user/MOM_wave_interface.F90 index e9b0669f43..4ba1b779e3 100644 --- a/src/user/MOM_wave_interface.F90 +++ b/src/user/MOM_wave_interface.F90 @@ -452,7 +452,7 @@ subroutine Update_Surface_Waves(G, GV, US, Day, dt, CS, forces) type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(time_type), intent(in) :: Day !< Current model time type(time_type), intent(in) :: dt !< Timestep as a time-type - type(mech_forcing), intent(in) :: forces !< MOM_forcing_type + type(mech_forcing), intent(in), optional :: forces !< MOM_forcing_type ! Local variables integer :: ii, jj, kk, b type(time_type) :: Day_Center From d502516329fe3ebb28f5465d9ef10d4486f5c674 Mon Sep 17 00:00:00 2001 From: jiandewang Date: Sat, 19 Dec 2020 22:56:26 -0500 Subject: [PATCH 13/19] minor enhancement in MOM_wave_interface.F90 to aviod undocumented error --- src/user/MOM_wave_interface.F90 | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/src/user/MOM_wave_interface.F90 b/src/user/MOM_wave_interface.F90 index 4ba1b779e3..e79f7b65ef 100644 --- a/src/user/MOM_wave_interface.F90 +++ b/src/user/MOM_wave_interface.F90 @@ -466,6 +466,12 @@ subroutine Update_Surface_Waves(G, GV, US, Day, dt, CS, forces) if (DataSource==DATAOVR) then call Surface_Bands_by_data_override(day_center, G, GV, US, CS) elseif (DataSource==Coupler) then + if (.not.present(FORCES)) then + call MOM_error(FATAL,"The code cannot be run with the options "//& + "SURFBAND_SOURCE = COUPLER for with this driver. If you are using a "//& + "wave coupled driver then check the call to update_surface_waves, otherwise"//& + "select another option for SURFBAND_SOURCE.") + endif if (size(CS%WaveNum_Cen).ne.size(forces%stk_wavenumbers)) then call MOM_error(FATAL, "Number of wavenumber bands in WW3 does not match that in MOM6. "//& "Make sure that STK_BAND_COUPLER in MOM6 input is equal to the number of bands in "//& From 971802a7d9b41aee75407e729e3bb17dafdcc0fd Mon Sep 17 00:00:00 2001 From: jiandewang Date: Mon, 4 Jan 2021 10:39:29 -0500 Subject: [PATCH 14/19] revert back to GFDL main for coupled_driver codes --- .../MOM_surface_forcing_gfdl.F90 | 25 +------------------ config_src/coupled_driver/ocean_model_MOM.F90 | 2 +- 2 files changed, 2 insertions(+), 25 deletions(-) diff --git a/config_src/coupled_driver/MOM_surface_forcing_gfdl.F90 b/config_src/coupled_driver/MOM_surface_forcing_gfdl.F90 index 3c8f084b4a..7075fb7c10 100644 --- a/config_src/coupled_driver/MOM_surface_forcing_gfdl.F90 +++ b/config_src/coupled_driver/MOM_surface_forcing_gfdl.F90 @@ -189,12 +189,6 @@ module MOM_surface_forcing_gfdl !! ice-shelves, expressed as a coefficient !! for divergence damping, as determined !! outside of the ocean model [m3 s-1] - real, pointer, dimension(:,:) :: ustk0 => NULL() !< - real, pointer, dimension(:,:) :: vstk0 => NULL() !< - real, pointer, dimension(:) :: stk_wavenumbers => NULL() !< - real, pointer, dimension(:,:,:) :: ustkb => NULL() !< - real, pointer, dimension(:,:,:) :: vstkb => NULL() !< - integer :: xtype !< The type of the exchange - REGRID, REDIST or DIRECT type(coupler_2d_bc_type) :: fluxes !< A structure that may contain an array of named fields !! used for passive tracer fluxes. @@ -202,7 +196,6 @@ module MOM_surface_forcing_gfdl !! This flag may be set by the flux-exchange code, based on what !! the sea-ice model is providing. Otherwise, the value from !! the surface_forcing_CS is used. - integer :: num_stk_bands !< Number of Stokes drift bands passed through the coupler end type ice_ocean_boundary_type integer :: id_clock_forcing !< A CPU time clock @@ -684,7 +677,7 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS, dt_ real :: mass_eff ! effective mass of sea ice for rigidity [R Z ~> kg m-2] real :: wt1, wt2 ! Relative weights of previous and current values of ustar, ND. - integer :: i, j, is, ie, js, je, Isq, Ieq, Jsq, Jeq, i0, j0, istk + integer :: i, j, is, ie, js, je, Isq, Ieq, Jsq, Jeq, i0, j0 integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB, isr, ier, jsr, jer integer :: isc_bnd, iec_bnd, jsc_bnd, jec_bnd @@ -725,9 +718,6 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS, dt_ (associated(IOB%mass_berg) .and. (.not. associated(forces%mass_berg))) ) & call allocate_mech_forcing(G, forces, iceberg=.true.) - if ( associated(IOB%ustk0) ) & - call allocate_mech_forcing(G, forces, waves=.true., num_stk_bands=IOB%num_stk_bands) - if (associated(IOB%ice_rigidity)) then rigidity_at_h(:,:) = 0.0 call safe_alloc_ptr(forces%rigidity_ice_u,IsdB,IedB,jsd,jed) @@ -787,19 +777,6 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS, dt_ forces%ustar(i,j) = wt1*forces%ustar(i,j) + wt2*ustar_tmp(i,j) enddo ; enddo endif - forces%stk_wavenumbers(:) = IOB%stk_wavenumbers - do j=js,je; do i=is,ie - forces%ustk0(i,j) = IOB%ustk0(i-I0,j-J0) ! How to be careful here that the domains are right? - forces%vstk0(i,j) = IOB%vstk0(i-I0,j-J0) - enddo ; enddo - call pass_vector(forces%ustk0,forces%vstk0, G%domain ) - do istk = 1,IOB%num_stk_bands - do j=js,je; do i=is,ie - forces%ustkb(i,j,istk) = IOB%ustkb(i-I0,j-J0,istk) - forces%vstkb(i,j,istk) = IOB%vstkb(i-I0,j-J0,istk) - enddo; enddo - call pass_vector(forces%ustkb(:,:,istk),forces%vstkb(:,:,istk), G%domain ) - enddo ! Find the net mass source in the input forcing without other adjustments. if (CS%approx_net_mass_src .and. associated(forces%net_mass_src)) then diff --git a/config_src/coupled_driver/ocean_model_MOM.F90 b/config_src/coupled_driver/ocean_model_MOM.F90 index 6cb358cdcb..082099158c 100644 --- a/config_src/coupled_driver/ocean_model_MOM.F90 +++ b/config_src/coupled_driver/ocean_model_MOM.F90 @@ -565,7 +565,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, time_start_upda ! For now, the waves are only updated on the thermodynamics steps, because that is where ! the wave intensities are actually used to drive mixing. At some point, the wave updates ! might also need to become a part of the ocean dynamics, according to B. Reichl. - call Update_Surface_Waves(OS%grid, OS%GV, OS%US, OS%time, ocean_coupling_time_step, OS%waves, OS%forces) + call Update_Surface_Waves(OS%grid, OS%GV, OS%US, OS%time, ocean_coupling_time_step, OS%waves) endif if ((OS%nstep==0) .and. (OS%nstep_thermo==0)) then ! This is the first call to update_ocean_model. From 5f5871c1df3e95201292039e3247439f2ff48c17 Mon Sep 17 00:00:00 2001 From: "Jessica.Meixner" Date: Tue, 5 Jan 2021 20:20:02 +0000 Subject: [PATCH 15/19] Addressing reviewers comments: * document wave coupling variables * switch ii jj loops for computational efficiency * clarify error message * fix indexing and style --- .../mom_surface_forcing_nuopc.F90 | 14 +++-- src/core/MOM_forcing_type.F90 | 18 +++--- src/user/MOM_wave_interface.F90 | 60 +++++++++---------- 3 files changed, 50 insertions(+), 42 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..585117c3ba 100644 --- a/config_src/nuopc_driver/mom_surface_forcing_nuopc.F90 +++ b/config_src/nuopc_driver/mom_surface_forcing_nuopc.F90 @@ -183,11 +183,15 @@ module MOM_surface_forcing_nuopc !! ice-shelves, expressed as a coefficient !! for divergence damping, as determined !! outside of the ocean model in [m3/s] - real, pointer, dimension(:,:) :: ustk0 => NULL() !< - real, pointer, dimension(:,:) :: vstk0 => NULL() !< - real, pointer, dimension(:) :: stk_wavenumbers => NULL() !< - real, pointer, dimension(:,:,:) :: ustkb => NULL() !< - real, pointer, dimension(:,:,:) :: vstkb => NULL() !< + real, pointer, dimension(:,:) :: ustk0 => NULL() !< Surface Stokes drift, zonal [m/s] + real, pointer, dimension(:,:) :: vstk0 => NULL() !< Surface Stokes drift, meridional [m/s] + real, pointer, dimension(:) :: stk_wavenumbers => NULL() !< The central wave number of Stokes bands [rad/m] + real, pointer, dimension(:,:,:) :: ustkb => NULL() !< Stokes Drift spectrum, zonal [m/s] + !! Horizontal - u points + !! 3rd dimension - wavenumber + real, pointer, dimension(:,:,:) :: vstkb => NULL() !< Stokes Drift spectrum, meridional [m/s] + !! Horizontal - v points + !! 3rd dimension - wavenumber integer :: num_stk_bands !< Number of Stokes drift bands passed through the coupler integer :: xtype !< The type of the exchange - REGRID, REDIST or DIRECT type(coupler_2d_bc_type) :: fluxes !< A structure that may contain an array of diff --git a/src/core/MOM_forcing_type.F90 b/src/core/MOM_forcing_type.F90 index 6720414b2b..a135107025 100644 --- a/src/core/MOM_forcing_type.F90 +++ b/src/core/MOM_forcing_type.F90 @@ -250,13 +250,17 @@ module MOM_forcing_type !! reset to zero at the driver level when appropriate. real, pointer, dimension(:,:) :: & - ustk0 => NULL(), & - vstk0 => NULL() + ustk0 => NULL(), & !< Surface Stokes drift, zonal [m/s] + vstk0 => NULL() !< Surface Stokes drift, meridional [m/s] real, pointer, dimension(:) :: & - stk_wavenumbers => NULL() + stk_wavenumbers => NULL() !< The central wave number of Stokes bands [rad/m] real, pointer, dimension(:,:,:) :: & - ustkb => NULL(), & - vstkb => NULL() + ustkb => NULL(), & !< Stokes Drift spectrum, zonal [m/s] + !! Horizontal - u points + !! 3rd dimension - wavenumber + vstkb => NULL() !< Stokes Drift spectrum, meridional [m/s] + !! Horizontal - v points + !! 3rd dimension - wavenumber logical :: initialized = .false. !< This indicates whether the appropriate arrays have been initialized. end type mech_forcing @@ -3041,12 +3045,12 @@ subroutine allocate_mech_forcing_by_group(G, forces, stress, ustar, shelf, & forces%stk_wavenumbers(:) = 0.0 allocate(forces%ustkb(isd:ied,jsd:jed,num_stk_bands)) forces%ustkb(isd:ied,jsd:jed,:) = 0.0 - endif; endif; endif + endif ; endif ; endif if (present(waves)) then; if (waves) then; if (.not.associated(forces%vstkb)) then allocate(forces%vstkb(isd:ied,jsd:jed,num_stk_bands)) forces%vstkb(isd:ied,jsd:jed,:) = 0.0 - endif; endif; endif + endif ; endif ; endif end subroutine allocate_mech_forcing_by_group diff --git a/src/user/MOM_wave_interface.F90 b/src/user/MOM_wave_interface.F90 index e79f7b65ef..6352774fa7 100644 --- a/src/user/MOM_wave_interface.F90 +++ b/src/user/MOM_wave_interface.F90 @@ -467,10 +467,10 @@ subroutine Update_Surface_Waves(G, GV, US, Day, dt, CS, forces) call Surface_Bands_by_data_override(day_center, G, GV, US, CS) elseif (DataSource==Coupler) then if (.not.present(FORCES)) then - call MOM_error(FATAL,"The code cannot be run with the options "//& - "SURFBAND_SOURCE = COUPLER for with this driver. If you are using a "//& - "wave coupled driver then check the call to update_surface_waves, otherwise"//& - "select another option for SURFBAND_SOURCE.") + call MOM_error(FATAL,"The option SURFBAND = COUPLER can not be used with "//& + "this driver. If you are using a coupled driver with a wave model then "//& + "check the arguments in the subroutine call to Update_Surface_Waves, "//& + "otherwise select another option for SURFBAND_SOURCE.") endif if (size(CS%WaveNum_Cen).ne.size(forces%stk_wavenumbers)) then call MOM_error(FATAL, "Number of wavenumber bands in WW3 does not match that in MOM6. "//& @@ -481,13 +481,13 @@ subroutine Update_Surface_Waves(G, GV, US, Day, dt, CS, forces) do b=1,CS%NumBands CS%WaveNum_Cen(b) = forces%stk_wavenumbers(b) !Interpolate from a grid to c grid - do II=G%iscB,G%iecB - do jj=G%jsc,G%jec + do jj=G%jsc,G%jec + do II=G%iscB,G%iecB CS%STKx0(II,jj,b) = 0.5*(forces%UStkb(ii,jj,b)+forces%UStkb(ii+1,jj,b)) enddo enddo - do ii=G%isc,G%iec - do JJ=G%jscB, G%jecB + do JJ=G%jscB, G%jecB + do ii=G%isc,G%iec CS%STKY0(ii,JJ,b) = 0.5*(forces%VStkb(ii,jj,b)+forces%VStkb(ii,jj+1,b)) enddo enddo @@ -495,13 +495,13 @@ subroutine Update_Surface_Waves(G, GV, US, Day, dt, CS, forces) enddo elseif (DataSource==Input) then do b=1,CS%NumBands - do II=G%isdB,G%iedB - do jj=G%jsd,G%jed + do jj=G%jsd,G%jed + do II=G%isdB,G%iedB CS%STKx0(II,jj,b) = CS%PrescribedSurfStkX(b) enddo enddo - do ii=G%isd,G%ied - do JJ=G%jsdB, G%jedB + do JJ=G%jsdB, G%jedB + do ii=G%isd,G%ied CS%STKY0(ii,JJ,b) = CS%PrescribedSurfStkY(b) enddo enddo @@ -537,8 +537,8 @@ subroutine Update_Stokes_Drift(G, GV, US, CS, h, ustar) ! Computing mid-point value from surface value and decay wavelength if (WaveMethod==TESTPROF) then DecayScale = 4.*PI / TP_WVL !4pi - do II = G%isdB,G%iedB - do jj = G%jsd,G%jed + do jj = G%jsd,G%jed + do II = G%isdB,G%iedB IIm1 = max(1,II-1) Bottom = 0.0 MidPoint = 0.0 @@ -550,8 +550,8 @@ subroutine Update_Stokes_Drift(G, GV, US, CS, h, ustar) enddo enddo enddo - do ii = G%isd,G%ied - do JJ = G%jsdB,G%jedB + do JJ = G%jsdB,G%jedB + do ii = G%isd,G%ied JJm1 = max(1,JJ-1) Bottom = 0.0 MidPoint = 0.0 @@ -572,8 +572,8 @@ subroutine Update_Stokes_Drift(G, GV, US, CS, h, ustar) CS%Us0_x(:,:) = 0.0 CS%Us0_y(:,:) = 0.0 ! Computing X direction Stokes drift - do II = G%isdB,G%iedB - do jj = G%jsd,G%jed + do jj = G%jsd,G%jed + do II = G%isdB,G%iedB ! 1. First compute the surface Stokes drift ! by integrating over the partitionas. do b = 1,CS%NumBands @@ -630,8 +630,8 @@ subroutine Update_Stokes_Drift(G, GV, US, CS, h, ustar) enddo enddo ! Computing Y direction Stokes drift - do ii = G%isd,G%ied - do JJ = G%jsdB,G%jedB + do JJ = G%jsdB,G%jedB + do ii = G%isd,G%ied ! Compute the surface values. do b = 1,CS%NumBands if (PartitionMode==0) then @@ -688,8 +688,8 @@ subroutine Update_Stokes_Drift(G, GV, US, CS, h, ustar) enddo elseif (WaveMethod==DHH85) then if (.not.(StaticWaves .and. DHH85_is_set)) then - do II = G%isdB,G%iedB - do jj = G%jsd,G%jed + do jj = G%jsd,G%jed + do II = G%isdB,G%iedB bottom = 0.0 do kk = 1,G%ke Top = Bottom @@ -706,8 +706,8 @@ subroutine Update_Stokes_Drift(G, GV, US, CS, h, ustar) enddo enddo enddo - do ii = G%isd,G%ied - do JJ = G%jsdB,G%jedB + do JJ = G%jsdB,G%jedB + do ii = G%isd,G%ied Bottom = 0.0 do kk=1, G%ke Top = Bottom @@ -732,13 +732,13 @@ subroutine Update_Stokes_Drift(G, GV, US, CS, h, ustar) endif else! Keep this else, fallback to 0 Stokes drift do kk= 1,G%ke - do II = G%isdB,G%iedB - do jj = G%jsd,G%jed + do jj = G%jsd,G%jed + do II = G%isdB,G%iedB CS%Us_x(II,jj,kk) = 0. enddo enddo - do ii = G%isd,G%ied - do JJ = G%jsdB,G%jedB + do JJ = G%jsdB,G%jedB + do ii = G%isd,G%ied CS%Us_y(ii,JJ,kk) = 0. enddo enddo @@ -748,8 +748,8 @@ subroutine Update_Stokes_Drift(G, GV, US, CS, h, ustar) ! Turbulent Langmuir number is computed here and available to use anywhere. ! SL Langmuir number requires mixing layer depth, and therefore is computed ! in the routine it is needed by (e.g. KPP or ePBL). - do ii = G%isc,G%iec - do jj = G%jsc, G%jec + do jj = G%jsc, G%jec + do ii = G%isc,G%iec Top = h(ii,jj,1)*GV%H_to_Z call get_Langmuir_Number( La, G, GV, US, Top, ustar(ii,jj), ii, jj, & H(ii,jj,:),Override_MA=.false.,WAVES=CS) From 633dc9241b698c3512a9c09eb58f3f12897ced8a Mon Sep 17 00:00:00 2001 From: jiandewang Date: Wed, 6 Jan 2021 14:06:04 -0500 Subject: [PATCH 16/19] add documentation for mom_cap_methods remove duplicated declearation of function chkerr, change case to match --- config_src/nuopc_driver/mom_cap.F90 | 13 +--- config_src/nuopc_driver/mom_cap_methods.F90 | 69 ++++++++++----------- config_src/nuopc_driver/mom_cap_time.F90 | 13 +--- config_src/nuopc_driver/time_utils.F90 | 13 +--- 4 files changed, 36 insertions(+), 72 deletions(-) diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index 4bfc9e1cb6..f0ce8720bb 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -36,6 +36,7 @@ module MOM_cap_mod 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: ChkErr #ifdef CESMCOUPLED use shr_file_mod, only: shr_file_setLogUnit, shr_file_getLogUnit #endif @@ -2049,18 +2050,6 @@ subroutine shr_file_getLogUnit(nunit) end subroutine shr_file_getLogUnit #endif -logical function chkerr(rc, line, file) - integer, intent(in) :: rc - integer, intent(in) :: line - character(len=*), intent(in) :: file - integer :: lrc - chkerr = .false. - lrc = rc - if (ESMF_LogFoundError(rcToCheck=lrc, msg=ESMF_LOGERR_PASSTHRU, line=line, file=file)) then - chkerr = .true. - endif -end function chkerr - !> !! @page nuopc_cap NUOPC Cap !! @author Fei Liu (fei.liu@gmail.com) diff --git a/config_src/nuopc_driver/mom_cap_methods.F90 b/config_src/nuopc_driver/mom_cap_methods.F90 index 1d51c1e6dd..39f450d453 100644 --- a/config_src/nuopc_driver/mom_cap_methods.F90 +++ b/config_src/nuopc_driver/mom_cap_methods.F90 @@ -30,6 +30,7 @@ module MOM_cap_methods public :: mom_import public :: mom_export public :: state_diagnose +public :: ChkErr private :: State_getImport private :: State_setExport @@ -251,9 +252,9 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, !---- - ! Partitioned Stokes Drift Components + ! Partitioned Stokes Drift Components !---- - if ( associated(ice_ocean_boundary%ustkb) ) then + if ( associated(ice_ocean_boundary%ustkb) ) then allocate(stkx1(isc:iec,jsc:jec)) allocate(stky1(isc:iec,jsc:jec)) allocate(stkx2(isc:iec,jsc:jec)) @@ -765,15 +766,18 @@ subroutine State_SetExport(state, fldname, isc, iec, jsc, jec, input, ocean_grid end subroutine State_SetExport +!> This subroutine writes the minimum, maximum and sum of each field +!! contained within an ESMF state. 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 + type(ESMF_State), intent(in) :: state !< An ESMF State + character(len=*), intent(in) :: string !< A string indicating whether the State is an + !! import or export State + integer , intent(out) :: rc !< Return code ! local variables integer :: i,j,n @@ -787,19 +791,19 @@ subroutine state_diagnose(State, string, rc) ! ---------------------------------------------- call ESMF_StateGet(state, itemCount=fieldCount, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return + 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 + 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 + 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 (ChkErr(rc,__LINE__,u_FILE_u)) return if (lrank == 0) then ! no local data @@ -829,23 +833,16 @@ subroutine state_diagnose(State, string, rc) end subroutine state_diagnose -!=============================================================================== - +!> Obtain a pointer to a rank 1 or rank 2 ESMF field 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 + type(ESMF_Field) , intent(in) :: field !< An ESMF field + real(ESMF_KIND_R8), pointer , intent(inout), optional :: fldptr1(:) !< A pointer to a rank 1 ESMF field + real(ESMF_KIND_R8), pointer , intent(inout), optional :: fldptr2(:,:) !< A pointer to a rank 2 ESMF field + integer , intent(out) , optional :: rank !< Field rank + logical , intent(in) , optional :: abort !< Abort code + integer , intent(out) , optional :: rc !< Return code ! local variables type(ESMF_GeomType_Flag) :: geomtype @@ -872,7 +869,7 @@ subroutine field_getfldptr(field, fldptr1, fldptr2, rank, abort, rc) lrank = -99 call ESMF_FieldGet(field, status=status, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return if (status /= ESMF_FIELDSTATUS_COMPLETE) then lrank = 0 @@ -886,20 +883,20 @@ subroutine field_getfldptr(field, fldptr1, fldptr2, rank, abort, rc) else call ESMF_FieldGet(field, geomtype=geomtype, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return + 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 + 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 + if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_FieldGet(field, mesh=lmesh, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return + 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 (ChkErr(rc,__LINE__,u_FILE_u)) return if (nnodes == 0 .and. nelements == 0) lrank = 0 - else + else call ESMF_LogWrite(trim(subname)//": ERROR geomtype not supported ", & ESMF_LOGMSG_INFO) rc = ESMF_FAILURE @@ -917,7 +914,7 @@ subroutine field_getfldptr(field, fldptr1, fldptr2, rank, abort, rc) return endif call ESMF_FieldGet(field, farrayPtr=fldptr1, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return + 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 ", & @@ -926,7 +923,7 @@ subroutine field_getfldptr(field, fldptr1, fldptr2, rank, abort, rc) return endif call ESMF_FieldGet(field, farrayPtr=fldptr2, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return + 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) @@ -942,16 +939,16 @@ subroutine field_getfldptr(field, fldptr1, fldptr2, rank, abort, rc) end subroutine field_getfldptr -logical function chkerr(rc, line, file) +logical function ChkErr(rc, line, file) integer, intent(in) :: rc integer, intent(in) :: line character(len=*), intent(in) :: file integer :: lrc - chkerr = .false. + ChkErr = .false. lrc = rc if (ESMF_LogFoundError(rcToCheck=lrc, msg=ESMF_LOGERR_PASSTHRU, line=line, file=file)) then - chkerr = .true. + ChkErr = .true. endif -end function chkerr +end function ChkErr end module MOM_cap_methods diff --git a/config_src/nuopc_driver/mom_cap_time.F90 b/config_src/nuopc_driver/mom_cap_time.F90 index aa1a6c7072..7f210bda71 100644 --- a/config_src/nuopc_driver/mom_cap_time.F90 +++ b/config_src/nuopc_driver/mom_cap_time.F90 @@ -16,6 +16,7 @@ module MOM_cap_time use ESMF , only : ESMF_RC_ARG_BAD use ESMF , only : operator(<), operator(/=), operator(+), operator(-), operator(*) , operator(>=) use ESMF , only : operator(<=), operator(>), operator(==) +use MOM_cap_methods , only : ChkErr implicit none; private @@ -336,16 +337,4 @@ subroutine date2ymd (date, year, month, day) end subroutine date2ymd -logical function chkerr(rc, line, file) - integer, intent(in) :: rc - integer, intent(in) :: line - character(len=*), intent(in) :: file - integer :: lrc - chkerr = .false. - lrc = rc - if (ESMF_LogFoundError(rcToCheck=lrc, msg=ESMF_LOGERR_PASSTHRU, line=line, file=file)) then - chkerr = .true. - endif -end function chkerr - end module MOM_cap_time diff --git a/config_src/nuopc_driver/time_utils.F90 b/config_src/nuopc_driver/time_utils.F90 index db056f4bf5..81efcd2765 100644 --- a/config_src/nuopc_driver/time_utils.F90 +++ b/config_src/nuopc_driver/time_utils.F90 @@ -14,6 +14,7 @@ module time_utils_mod use ESMF, only: ESMF_Time, ESMF_TimeGet, ESMF_LogFoundError use ESMF, only: ESMF_LOGERR_PASSTHRU,ESMF_TimeInterval use ESMF, only: ESMF_TimeIntervalGet, ESMF_TimeSet, ESMF_SUCCESS +use MOM_cap_methods, only: ChkErr implicit none; private @@ -160,16 +161,4 @@ function string_to_date(string, rc) end function string_to_date -logical function chkerr(rc, line, file) - integer, intent(in) :: rc - integer, intent(in) :: line - character(len=*), intent(in) :: file - integer :: lrc - chkerr = .false. - lrc = rc - if (ESMF_LogFoundError(rcToCheck=lrc, msg=ESMF_LOGERR_PASSTHRU, line=line, file=file)) then - chkerr = .true. - endif -end function chkerr - end module time_utils_mod From 172025dd87ef1042d652286e0eccd0f56dc56fd9 Mon Sep 17 00:00:00 2001 From: jiandewang Date: Wed, 20 Jan 2021 12:24:14 -0500 Subject: [PATCH 17/19] add documentation for function ChkErr --- config_src/nuopc_driver/mom_cap_methods.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/config_src/nuopc_driver/mom_cap_methods.F90 b/config_src/nuopc_driver/mom_cap_methods.F90 index 39f450d453..4946fc9927 100644 --- a/config_src/nuopc_driver/mom_cap_methods.F90 +++ b/config_src/nuopc_driver/mom_cap_methods.F90 @@ -940,9 +940,9 @@ subroutine field_getfldptr(field, fldptr1, fldptr2, rank, abort, rc) end subroutine field_getfldptr logical function ChkErr(rc, line, file) - integer, intent(in) :: rc - integer, intent(in) :: line - character(len=*), intent(in) :: file + integer, intent(in) :: rc !< return code to check + integer, intent(in) :: line !< Integer source line number + character(len=*), intent(in) :: file !< User-provided source file name integer :: lrc ChkErr = .false. lrc = rc From c05b042d9e9e16efc6afb36a0e8d8a888d82bde2 Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Wed, 20 Jan 2021 14:54:46 -0500 Subject: [PATCH 18/19] Added API documentation for chkerr() --- config_src/nuopc_driver/mom_cap_methods.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/config_src/nuopc_driver/mom_cap_methods.F90 b/config_src/nuopc_driver/mom_cap_methods.F90 index 4946fc9927..78014f1c63 100644 --- a/config_src/nuopc_driver/mom_cap_methods.F90 +++ b/config_src/nuopc_driver/mom_cap_methods.F90 @@ -939,6 +939,7 @@ subroutine field_getfldptr(field, fldptr1, fldptr2, rank, abort, rc) end subroutine field_getfldptr +!> Returns true if ESMF_LogFoundError() determines that rc is an error code. Otherwise false. logical function ChkErr(rc, line, file) integer, intent(in) :: rc !< return code to check integer, intent(in) :: line !< Integer source line number From ea5e2458fbd8b39f07e7598195d39f54c352a78a Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Wed, 20 Jan 2021 18:02:52 -0500 Subject: [PATCH 19/19] Fixed white space and line length --- .../nuopc_driver/mom_surface_forcing_nuopc.F90 | 2 +- src/core/MOM_forcing_type.F90 | 16 ++++++++-------- src/tracer/MOM_lateral_boundary_diffusion.F90 | 12 ++++++------ src/user/MOM_wave_interface.F90 | 4 ++-- 4 files changed, 17 insertions(+), 17 deletions(-) diff --git a/config_src/nuopc_driver/mom_surface_forcing_nuopc.F90 b/config_src/nuopc_driver/mom_surface_forcing_nuopc.F90 index 585117c3ba..689a9f0f4a 100644 --- a/config_src/nuopc_driver/mom_surface_forcing_nuopc.F90 +++ b/config_src/nuopc_driver/mom_surface_forcing_nuopc.F90 @@ -862,7 +862,7 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS) enddo; enddo call pass_vector(forces%ustkb(:,:,istk),forces%vstkb(:,:,istk), G%domain ) enddo - endif + endif ! sea ice related dynamic fields if (associated(IOB%ice_rigidity)) then diff --git a/src/core/MOM_forcing_type.F90 b/src/core/MOM_forcing_type.F90 index a135107025..f0cc8f553c 100644 --- a/src/core/MOM_forcing_type.F90 +++ b/src/core/MOM_forcing_type.F90 @@ -3007,8 +3007,8 @@ subroutine allocate_mech_forcing_by_group(G, forces, stress, ustar, shelf, & logical, optional, intent(in) :: shelf !< If present and true, allocate forces for ice-shelf logical, optional, intent(in) :: press !< If present and true, allocate p_surf and related fields logical, optional, intent(in) :: iceberg !< If present and true, allocate forces for icebergs - logical, optional, intent(in) :: waves !< If present and true, allocate wave fields - integer, optional, intent(in) :: num_stk_bands !< Number of Stokes bands to allocate + logical, optional, intent(in) :: waves !< If present and true, allocate wave fields + integer, optional, intent(in) :: num_stk_bands !< Number of Stokes bands to allocate ! Local variables integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB @@ -3038,16 +3038,16 @@ subroutine allocate_mech_forcing_by_group(G, forces, stress, ustar, shelf, & !These fields should only be allocated when waves call myAlloc(forces%ustk0,isd,ied,jsd,jed, waves) call myAlloc(forces%vstk0,isd,ied,jsd,jed, waves) - if (present(waves)) then; if (waves) then; if (.not.associated(forces%ustkb)) then + if (present(waves)) then; if (waves) then; if (.not.associated(forces%ustkb)) then if (.not.(present(num_stk_bands))) call MOM_error(FATAL,"Requested to & - initialize with waves, but no waves are present.") - allocate(forces%stk_wavenumbers(num_stk_bands)) - forces%stk_wavenumbers(:) = 0.0 - allocate(forces%ustkb(isd:ied,jsd:jed,num_stk_bands)) + initialize with waves, but no waves are present.") + allocate(forces%stk_wavenumbers(num_stk_bands)) + forces%stk_wavenumbers(:) = 0.0 + allocate(forces%ustkb(isd:ied,jsd:jed,num_stk_bands)) forces%ustkb(isd:ied,jsd:jed,:) = 0.0 endif ; endif ; endif - if (present(waves)) then; if (waves) then; if (.not.associated(forces%vstkb)) then + if (present(waves)) then; if (waves) then; if (.not.associated(forces%vstkb)) then allocate(forces%vstkb(isd:ied,jsd:jed,num_stk_bands)) forces%vstkb(isd:ied,jsd:jed,:) = 0.0 endif ; endif ; endif diff --git a/src/tracer/MOM_lateral_boundary_diffusion.F90 b/src/tracer/MOM_lateral_boundary_diffusion.F90 index 2b7a5646cc..01d8e4163b 100644 --- a/src/tracer/MOM_lateral_boundary_diffusion.F90 +++ b/src/tracer/MOM_lateral_boundary_diffusion.F90 @@ -579,13 +579,13 @@ subroutine fluxes_layer_method(boundary, ke, hbl_L, hbl_R, h_L, h_R, phi_L, phi_ type(lbd_CS), pointer :: CS !< Lateral diffusion control structure !! the boundary layer ! Local variables - real, dimension(:), allocatable :: dz_top !< The LBD z grid to be created [L ~ m] - real, dimension(:), allocatable :: phi_L_z !< Tracer values in the ztop grid (left) [conc] - real, dimension(:), allocatable :: phi_R_z !< Tracer values in the ztop grid (right) [conc] - real, dimension(:), allocatable :: F_layer_z !< Diffusive flux at U- or V-point in the ztop grid [H L2 conc ~> m3 conc] + real, dimension(:), allocatable :: dz_top !< The LBD z grid to be created [L ~ m] + real, dimension(:), allocatable :: phi_L_z !< Tracer values in the ztop grid (left) [conc] + real, dimension(:), allocatable :: phi_R_z !< Tracer values in the ztop grid (right) [conc] + real, dimension(:), allocatable :: F_layer_z !< Diffusive flux at U/V-point in the ztop grid [H L2 conc ~> m3 conc] real, dimension(ke) :: h_vel !< Thicknesses at u- and v-points in the native grid - !! The harmonic mean is used to avoid zero values [H ~> m or kg m-2] - real :: khtr_avg !< Thickness-weighted diffusivity at the u-point [m^2 s^-1] + !! The harmonic mean is used to avoid zero values [H ~> m or kg m-2] + real :: khtr_avg !< Thickness-weighted diffusivity at the u-point [m^2 s^-1] !! This is just to remind developers that khtr_avg should be !! computed once khtr is 3D. real :: htot !< Total column thickness [H ~> m or kg m-2] diff --git a/src/user/MOM_wave_interface.F90 b/src/user/MOM_wave_interface.F90 index 6352774fa7..0780ca5e3d 100644 --- a/src/user/MOM_wave_interface.F90 +++ b/src/user/MOM_wave_interface.F90 @@ -466,9 +466,9 @@ subroutine Update_Surface_Waves(G, GV, US, Day, dt, CS, forces) if (DataSource==DATAOVR) then call Surface_Bands_by_data_override(day_center, G, GV, US, CS) elseif (DataSource==Coupler) then - if (.not.present(FORCES)) then + if (.not.present(FORCES)) then call MOM_error(FATAL,"The option SURFBAND = COUPLER can not be used with "//& - "this driver. If you are using a coupled driver with a wave model then "//& + "this driver. If you are using a coupled driver with a wave model then "//& "check the arguments in the subroutine call to Update_Surface_Waves, "//& "otherwise select another option for SURFBAND_SOURCE.") endif