From 2fe5224543c49c77c45fbca7d36a908543850231 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Mon, 23 Mar 2020 20:28:05 -0600 Subject: [PATCH 01/53] updates to clean up differences between nems and cmeps for restarts --- config_src/nuopc_driver/mom_cap.F90 | 894 ++++++++-------------------- 1 file changed, 246 insertions(+), 648 deletions(-) diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index 219245e473..ba3c3e80d8 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -70,6 +70,8 @@ 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: operator(==), operator(/=), operator(+), operator(-) ! TODO ESMF_GridCompGetInternalState does not have an explicit Fortran interface. @@ -258,95 +260,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 (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=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 (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=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 (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=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 (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=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 (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=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 (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=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 (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return if (isPresent .and. isSet) then read(value, '(i)', iostat=iostat) scalar_field_count if (iostat /= 0) then @@ -356,20 +317,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 (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=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 +333,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 (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return if (isPresent .and. isSet) then read(value, '(i)', iostat=iostat) scalar_field_idx_grid_ny if (iostat /= 0) then @@ -402,20 +349,9 @@ 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 - end subroutine !> Called by NUOPC to advertise import and export fields. "Advertise" @@ -462,6 +398,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 @@ -469,11 +408,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 +419,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 (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=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 (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=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 (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=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 (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=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 (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return call fms_init(mpi_comm_mom) call constants_init @@ -521,10 +441,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 (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return if (isPresent .and. isSet) then read(cvalue,*) calendar select case (trim(calendar)) @@ -558,16 +475,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 (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=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 (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return time0 = set_date (YEAR,MONTH,DAY,HOUR,MINUTE,SECOND) @@ -583,27 +494,15 @@ 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 (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=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 (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=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 - call NUOPC_CompAttributeGet(gcomp, name="logfile", value=logfile, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + call NUOPC_CompAttributeGet(gcomp, name="diro", value=diro, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=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=u_FILE_u)) return open(newunit=logunit,file=trim(diro)//"/"//trim(logfile)) else logunit = output_unit @@ -615,19 +514,11 @@ 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 (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=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 + call ESMF_LogWrite('MOM_cap:start_type unset - using input.nml for restart option', ESMF_LOGMSG_INFO) endif runtype = "" @@ -645,58 +536,44 @@ 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 = "" 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, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return - 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 (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - 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 + 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, 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 + call ESMF_LogWrite('MOM_cap: restart requested, use input.nml', ESMF_LOGMSG_WARNING) endif endif @@ -905,10 +782,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 (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=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 +793,9 @@ 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 (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=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 (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return !--------------------------------- ! global mom grid size @@ -936,11 +803,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 +812,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 +828,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 +861,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 (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=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 (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=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 (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return if (localPet == 0) then write(logunit,*)'mesh file for mom6 domain is ',trim(cvalue) @@ -1034,17 +876,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 (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=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 (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return allocate(ownedElemCoords(spatialDim*numOwnedElements)) allocate(lonMesh(numOwnedElements), lon(numOwnedElements)) @@ -1062,15 +898,10 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) end do elemMaskArray = ESMF_ArrayCreate(Distgrid, maskMesh, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=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 (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return call mpp_get_compute_domain(ocean_public%domain, isc, iec, jsc, jec) n = 0 @@ -1117,16 +948,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 (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=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 (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return else if (geomtype == ESMF_GEOMTYPE_GRID) then @@ -1148,19 +973,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 (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=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 +993,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 (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=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 (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return distgrid = ESMF_DistGridCreate(minIndex=(/1,1/), maxIndex=(/nxg,nyg/), & ! indexflag = ESMF_INDEX_DELOCAL, & @@ -1191,10 +1007,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 (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return deallocate(xb,xe,yb,ye,pe) deallocate(connectionList) @@ -1203,32 +1016,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 (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=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 (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=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 +1037,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 (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=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 (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=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 (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=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 (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=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 (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=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 (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=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 (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=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 (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=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 (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=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 (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=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 (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return endif ! load up area, mask, center and corner values @@ -1345,13 +1108,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 +1153,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 (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=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 (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return endif @@ -1432,18 +1189,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 (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=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 (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return endif !--------------------------------- @@ -1489,16 +1239,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 (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=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 (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=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,48 +1250,27 @@ 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 (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=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 (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=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 (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=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 (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=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 (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=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 + call ESMF_LogWrite("MOM6 - Initialize-Data-Dependency SATISFIED!!!", ESMF_LOGMSG_INFO) endif if(write_diagnostics) then @@ -1596,6 +1319,11 @@ 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 character(len=*),parameter :: subname='(MOM_cap:ModelAdvance)' rc = ESMF_SUCCESS @@ -1604,45 +1332,21 @@ subroutine ModelAdvance(gcomp, rc) call shr_file_setLogUnit (logunit) ! 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 + call ESMF_GridCompGet(gcomp, clock=clock, importState=importState, exportState=exportState, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=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 + 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=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 + call ESMF_ClockGet(clock, startTime=startTime, currTime=currTime, timeStep=timeStep, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=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 + call ESMF_TimePrint(currTime + timeStep, preString="--------------------------------> to: ", unit=msgString, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) Time_step_coupled = esmf2fms_time(timeStep) Time = esmf2fms_time(currTime) @@ -1656,11 +1360,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 +1369,9 @@ 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 +1382,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 (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=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 +1395,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 (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return import_slice = import_slice + 1 endif @@ -1725,10 +1410,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 (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return !--------------- ! Update MOM6 @@ -1743,10 +1425,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 (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return endif @@ -1755,78 +1434,67 @@ 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 (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=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 (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=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 - - ! 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, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - 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 (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 + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + + call ESMF_ClockGetNextTime(clock, MyTime, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=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=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 + 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 (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 + else 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 + endif + call ESMF_LogWrite("MOM_cap: Using restart filename: "//trim(restartname), ESMF_LOGMSG_INFO) + + ! 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 (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=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) + ! write(*,*) 'calling ocean_model_restart' + ! call ocean_model_restart(ocean_state, timestamp) + ! endif + ! endif + + ! write restart file(s) + call ocean_model_restart(ocean_state, restartname=restartname) + + if (is_root_pe()) then + write(logunit,*) subname//' writing restart file ',trim(restartname) endif ! TODO: address if this requirement is being met for the DA group @@ -1863,10 +1531,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 (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return export_slice = export_slice + 1 endif @@ -1899,22 +1564,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 (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=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 (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=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 (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return !-------------------------------- ! check that the current time in the model and driver are the same @@ -1922,17 +1578,9 @@ 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 (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=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 (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return call ESMF_LogSetError(ESMF_RC_VAL_WRONG, & msg=subname//": ERROR in time consistency: "//trim(dtimestring)//" != "//trim(mtimestring), & line=__LINE__, file=__FILE__, rcToReturn=rc) @@ -1946,49 +1594,47 @@ 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 (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return if (first_time) then !-------------------------------- ! set restart alarm !-------------------------------- - ! defaults + ! set ddefaults restart_n = 0 restart_ymd = 0 - 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 + call NUOPC_CompAttributeGet(gcomp, name="restart_option", value=restart_option, & + isPresent=isPresent, isSet=isSet, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + + ! If restart_option is set then must also have set either restart_n or restart_ymd if (isPresent .and. isSet) then - call NUOPC_CompAttributeGet(gcomp, name="restart_n", value=cvalue, & + 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 (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=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 (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return 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 + end if else restart_option = "none" endif + call ESMF_LogWrite(subname//" Set restart option = "//restart_option, ESMF_LOGMSG_INFO) + ! initialize restart alarm call AlarmInit(mclock, & alarm = restart_alarm, & option = trim(restart_option), & @@ -1996,25 +1642,12 @@ 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 (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=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 - 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 + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + first_time = .false. endif !-------------------------------- @@ -2022,16 +1655,10 @@ 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 (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=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 (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return end subroutine ModelSetRunClock @@ -2162,58 +1789,37 @@ 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) + call ESMF_LogWrite(subname//tag//" Field "//trim(field_defs(i)%stdname)//" is connected on root pe.", & + ESMF_LOGMSG_INFO) call SetScalarField(field, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=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 (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=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 (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=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 (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=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 (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return fldptr1d(:) = 0.0 endif @@ -2222,24 +1828,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 (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=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 (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return endif From 1a6411f0c0a83e35b1613e0e829b408d0bf09fc8 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Mon, 6 Apr 2020 20:52:33 -0600 Subject: [PATCH 02/53] added changes to unify cap with EMC changes --- config_src/nuopc_driver/mom_cap.F90 | 1008 ++++++++++++++++++++------- 1 file changed, 745 insertions(+), 263 deletions(-) diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index ba3c3e80d8..26cff18324 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -72,6 +72,9 @@ 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_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. @@ -83,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 @@ -260,54 +264,95 @@ 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=u_FILE_u)) return + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + 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=u_FILE_u)) return + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + 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) + 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 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=u_FILE_u)) return + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + 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) + 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 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=u_FILE_u)) return + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + 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) + 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 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=u_FILE_u)) return + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + 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) + 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 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=u_FILE_u)) return + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return if (isPresent .and. isSet) then scalar_field_name = trim(value) - call ESMF_LogWrite('MOM_cap:ScalarFieldName = '//trim(scalar_field_name), ESMF_LOGMSG_INFO) + 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 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=u_FILE_u)) return + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return if (isPresent .and. isSet) then read(value, '(i)', iostat=iostat) scalar_field_count if (iostat /= 0) then @@ -317,13 +362,20 @@ 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) + 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 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=u_FILE_u)) return + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return if (isPresent .and. isSet) then read(value, '(i)', iostat=iostat) scalar_field_idx_grid_nx if (iostat /= 0) then @@ -333,13 +385,20 @@ 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) + 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 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=u_FILE_u)) return + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return if (isPresent .and. isSet) then read(value, '(i)', iostat=iostat) scalar_field_idx_grid_ny if (iostat /= 0) then @@ -349,7 +408,11 @@ 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) + 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 endif end subroutine @@ -400,7 +463,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) integer :: userRc integer :: localPet integer :: iostat - integer :: readunit + integer :: readunit character(len=512) :: restartfile ! Path/Name of restart file character(len=*), parameter :: subname='(MOM_cap:InitializeAdvertise)' character(len=32) :: calendar @@ -408,7 +471,11 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) rc = ESMF_SUCCESS - call ESMF_LogWrite(subname//' enter', ESMF_LOGMSG_INFO) + call ESMF_LogWrite(subname//' enter', ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return allocate(Ice_ocean_boundary) !allocate(ocean_state) ! ocean_model_init allocate this pointer @@ -419,19 +486,34 @@ 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=u_FILE_u)) return + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out call ESMF_VMGet(VM, mpiCommunicator=mpi_comm_mom, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out call ESMF_ClockGet(CLOCK, currTIME=MyTime, TimeStep=TINT, RC=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + 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=SECOND, RC=rc ) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out CALL ESMF_TimeIntervalGet(TINT, S=DT_OCEAN, RC=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out call fms_init(mpi_comm_mom) call constants_init @@ -441,7 +523,10 @@ 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=u_FILE_u)) return + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out if (isPresent .and. isSet) then read(cvalue,*) calendar select case (trim(calendar)) @@ -475,10 +560,16 @@ 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=u_FILE_u)) return + 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=SECOND, RC=rc ) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out time0 = set_date (YEAR,MONTH,DAY,HOUR,MINUTE,SECOND) @@ -494,15 +585,27 @@ 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=u_FILE_u)) return + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return call NUOPC_CompAttributeGet(gcomp, name="logfile", & isPresent=isPresentLogfile, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + 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=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=u_FILE_u)) return + call NUOPC_CompAttributeGet(gcomp, name="diro", value=diro, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + 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)) else logunit = output_unit @@ -514,11 +617,19 @@ 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=u_FILE_u)) return + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + 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) + 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 endif runtype = "" @@ -536,7 +647,11 @@ 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) + 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 endif restartfile = "" @@ -555,26 +670,26 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) 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 + 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 @@ -782,7 +897,10 @@ 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=u_FILE_u)) return + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out Ice_ocean_boundary => ocean_internalstate%ptr%ice_ocean_boundary_type_ptr ocean_public => ocean_internalstate%ptr%ocean_public_type_ptr @@ -793,9 +911,16 @@ 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=u_FILE_u)) return + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call ESMF_VMGet(vm, petCount=npet, mpiCommunicator=mpicom, localPet=localPet, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out !--------------------------------- ! global mom grid size @@ -803,7 +928,11 @@ 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) + 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 !--------------------------------- ! number of tiles per PET, assumed to be 1, and number of pes (tiles) total @@ -812,11 +941,19 @@ 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) + 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 endif ntiles=mpp_get_domain_npes(ocean_public%domain) write(tmpstr,'(a,1i6)') subname//' ntiles = ',ntiles - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return !--------------------------------- ! get start and end indices of each tile and their PET @@ -828,7 +965,11 @@ 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) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return enddo endif @@ -861,14 +1002,23 @@ 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=u_FILE_u)) return + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + 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=u_FILE_u)) return + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + 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=u_FILE_u)) return + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return if (localPet == 0) then write(logunit,*)'mesh file for mom6 domain is ',trim(cvalue) @@ -876,11 +1026,17 @@ 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=u_FILE_u)) return + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + 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=u_FILE_u)) return + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return allocate(ownedElemCoords(spatialDim*numOwnedElements)) allocate(lonMesh(numOwnedElements), lon(numOwnedElements)) @@ -898,10 +1054,15 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) end do elemMaskArray = ESMF_ArrayCreate(Distgrid, maskMesh, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return - + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return call ESMF_MeshGet(Emesh, elemMaskArray=elemMaskArray, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return call mpp_get_compute_domain(ocean_public%domain, isc, iec, jsc, jec) n = 0 @@ -948,10 +1109,16 @@ 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=u_FILE_u)) return + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + 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=u_FILE_u)) return + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return else if (geomtype == ESMF_GEOMTYPE_GRID) then @@ -973,16 +1140,19 @@ 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) + ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) ! write(tmpstr,'(a,3i8)') subname//' jglo = ',n,deBlockList(2,1,n),deBlockList(2,2,n) - ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) + ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) ! write(tmpstr,'(a,2i8)') subname//' pe = ',n,petMap(n) - ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) + ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) !--- 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=u_FILE_u)) return + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out ! rsd this assumes tripole grid, but sometimes in CESM a bipole ! grid is used -- need to introduce conditional logic here @@ -993,12 +1163,18 @@ 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=u_FILE_u)) return + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out ! 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=u_FILE_u)) return + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return distgrid = ESMF_DistGridCreate(minIndex=(/1,1/), maxIndex=(/nxg,nyg/), & ! indexflag = ESMF_INDEX_DELOCAL, & @@ -1007,7 +1183,10 @@ 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=u_FILE_u)) return + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return deallocate(xb,xe,yb,ye,pe) deallocate(connectionList) @@ -1016,18 +1195,32 @@ 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=u_FILE_u)) return + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return allocate(indexList(cnt)) write(tmpstr,'(a,i8)') subname//' distgrid cnt= ',cnt - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) + 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_DistGridGet(distgrid=distgrid, localDE=0, seqIndexList=indexList, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return write(tmpstr,'(a,4i8)') subname//' distgrid list= ',& indexList(1),indexList(cnt),minval(indexList), maxval(indexList) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return deallocate(IndexList) @@ -1037,55 +1230,91 @@ 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=u_FILE_u)) return + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + call ESMF_GridAddCoord(gridIn, staggerLoc=ESMF_STAGGERLOC_CENTER, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return call ESMF_GridAddCoord(gridIn, staggerLoc=ESMF_STAGGERLOC_CORNER, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + 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=u_FILE_u)) return + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + 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=u_FILE_u)) return + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + 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=u_FILE_u)) return + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + 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=u_FILE_u)) return + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + 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=u_FILE_u)) return + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + 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=u_FILE_u)) return + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + 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=u_FILE_u)) return + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + 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=u_FILE_u)) return + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return endif ! load up area, mask, center and corner values @@ -1108,13 +1337,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) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) write(tmpstr,*) subname//' lbub12 = ',lbnd1,ubnd1,lbnd2,ubnd2 - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) write(tmpstr,*) subname//' lbub34 = ',lbnd3,ubnd3,lbnd4,ubnd4 - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) if (iec-isc /= ubnd1-lbnd1 .or. jec-jsc /= ubnd2-lbnd2) then call ESMF_LogSetError(ESMF_RC_ARG_BAD, & @@ -1153,32 +1382,38 @@ 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) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) if(grid_attach_area) then write(tmpstr,*) subname//' area = ',minval(dataPtr_area),maxval(dataPtr_area) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) endif write(tmpstr,*) subname//' xcen = ',minval(dataPtr_xcen),maxval(dataPtr_xcen) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) write(tmpstr,*) subname//' ycen = ',minval(dataPtr_ycen),maxval(dataPtr_ycen) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) write(tmpstr,*) subname//' xcor = ',minval(dataPtr_xcor),maxval(dataPtr_xcor) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) write(tmpstr,*) subname//' ycor = ',minval(dataPtr_ycor),maxval(dataPtr_ycor) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) 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=u_FILE_u)) return + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + 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=u_FILE_u)) return + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return endif @@ -1189,11 +1424,18 @@ 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=u_FILE_u)) return + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + 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=u_FILE_u)) return + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + endif !--------------------------------- @@ -1225,12 +1467,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(:) @@ -1239,10 +1486,21 @@ 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=u_FILE_u)) return + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + 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 (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out Ice_ocean_boundary => ocean_internalstate%ptr%ice_ocean_boundary_type_ptr ocean_public => ocean_internalstate%ptr%ocean_public_type_ptr @@ -1250,38 +1508,66 @@ 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=u_FILE_u)) return + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out call ESMF_StateGet(exportState, itemCount=fieldCount, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out allocate(fieldNameList(fieldCount)) call ESMF_StateGet(exportState, itemNameList=fieldNameList, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out 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=u_FILE_u)) return + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call NUOPC_SetAttribute(field, name="Updated", value="true", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out 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) - endif - - if(write_diagnostics) then - call NUOPC_Write(exportState, fileNamePrefix='field_init_ocn_export_', & - overwrite=overwrite_timeslice,timeslice=import_slice, relaxedFlag=.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 endif + if(write_diagnostics) then + do n = 1,fldsFrOcn_num + fldname = fldsFrOcn(n)%shortname + call ESMF_StateGet(exportState, itemName=trim(fldname), itemType=itemType, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + if (itemType /= ESMF_STATEITEM_NOTFOUND) then + call ESMF_StateGet(exportState, itemName=trim(fldname), field=field, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + call ESMF_FieldWrite(field, fileName='field_init_ocn_export_'//trim(timestr)//'.nc', & + timeslice=1, overwrite=overwrite_timeslice, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + endif + enddo + endif + end subroutine DataInitialize !> Called by NUOPC to advance the model a single timestep. @@ -1297,13 +1583,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() @@ -1321,9 +1609,12 @@ subroutine ModelAdvance(gcomp, rc) character(240) :: msgString character(ESMF_MAXSTR) :: casename integer :: iostat - integer :: writeunit + 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 @@ -1332,21 +1623,48 @@ subroutine ModelAdvance(gcomp, rc) call shr_file_setLogUnit (logunit) ! 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=u_FILE_u)) return + 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 ! 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=u_FILE_u)) return - call ESMF_LogWrite(subname//trim(msgString), ESMF_LOGMSG_INFO) + 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 - call ESMF_ClockGet(clock, startTime=startTime, currTime=currTime, timeStep=timeStep, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + 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 - call ESMF_TimePrint(currTime + timeStep, preString="--------------------------------> to: ", unit=msgString, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) + 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 + + 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) @@ -1360,7 +1678,11 @@ 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) + 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 do_advance = .false. else do_advance = .true. @@ -1369,9 +1691,18 @@ 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) + 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 Time = esmf2fms_time(currTime-timeStep) ! i.e., startTime - call ESMF_LogWrite("MOM6 - doubling the coupling timestep", ESMF_LOGMSG_INFO) + + 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 Time_step_coupled = 2 * esmf2fms_time(timeStep) endif end if @@ -1382,7 +1713,10 @@ 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=u_FILE_u)) return + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out Ice_ocean_boundary => ocean_internalstate%ptr%ice_ocean_boundary_type_ptr ocean_public => ocean_internalstate%ptr%ocean_public_type_ptr @@ -1393,10 +1727,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 (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=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 (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + if (itemType /= ESMF_STATEITEM_NOTFOUND) then + call ESMF_StateGet(importState, itemName=trim(fldname), field=lfield, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + call ESMF_FieldWrite(lfield, fileName='field_ocn_import_'//trim(import_timestr)//'.nc', & + timeslice=1, overwrite=overwrite_timeslice, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + endif + enddo endif !--------------- @@ -1410,7 +1754,10 @@ 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=u_FILE_u)) return + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out !--------------- ! Update MOM6 @@ -1425,29 +1772,58 @@ 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=u_FILE_u)) return + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out 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 (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=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 - if (ESMF_AlarmIsRinging(alarm, rc=rc)) then - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + !--------------- + ! If restart alarm exists and is ringing - write restart file + !--------------- - call ESMF_AlarmRingerOff(alarm, rc=rc ) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + 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 - call ESMF_ClockGetNextTime(clock, MyTime, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=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=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 (cesm_coupled) then + ! 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 + + ! 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 + 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) @@ -1468,53 +1844,16 @@ subroutine ModelAdvance(gcomp, rc) write(writeunit,'(a)') trim(restartname)//'.nc' close(writeunit) endif - else - write(restartname,'(A,".mom6.r.",I4.4,"-",I2.2,"-",I2.2,"-",I2.2,"-",I2.2,"-",I2.2)') & - "ocn", year, month, day, hour, minute, seconds - endif - call ESMF_LogWrite("MOM_cap: Using restart filename: "//trim(restartname), ESMF_LOGMSG_INFO) - - ! 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 (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=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) - ! write(*,*) 'calling ocean_model_restart' - ! call ocean_model_restart(ocean_state, timestamp) - ! endif - ! endif - - ! write restart file(s) - call ocean_model_restart(ocean_state, restartname=restartname) - - if (is_root_pe()) then - write(logunit,*) subname//' writing restart file ',trim(restartname) - 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 (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - ! line=__LINE__, & - ! file=__FILE__)) & - ! return ! bail out - ! 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) - ! 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, rc=rc) ! write restart file(s) call ocean_model_restart(ocean_state, restartname=restartname) @@ -1522,17 +1861,27 @@ subroutine ModelAdvance(gcomp, rc) if (is_root_pe()) then write(logunit,*) subname//' writing restart file ',trim(restartname) endif - endif + endif !--------------- ! 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 (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=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 (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + if (itemType /= ESMF_STATEITEM_NOTFOUND) then + call ESMF_StateGet(exportState, itemName=trim(fldname), field=lfield, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + call ESMF_FieldWrite(lfield, fileName='field_ocn_export_'//trim(export_timestr)//'.nc', & + timeslice=1, overwrite=overwrite_timeslice, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + endif + enddo endif if(profile_memory) call ESMF_VMLogMemInfo("Leaving MOM Model_ADVANCE: ") @@ -1547,30 +1896,42 @@ 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 ! 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=u_FILE_u)) return + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out - call ESMF_ClockGet(dclock, currTime=dcurrtime, timeStep=dtimestep, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + call ESMF_ClockGet(dclock, currTime=dcurrtime, timeStep=dtimestep, & + stopTime=dstoptime, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out call ESMF_ClockGet(mclock, currTime=mcurrtime, timeStep=mtimestep, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out !-------------------------------- ! check that the current time in the model and driver are the same @@ -1578,9 +1939,17 @@ 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=u_FILE_u)) return + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call ESMF_TimeGet(mcurrtime, timeString=mtimestring, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call ESMF_LogSetError(ESMF_RC_VAL_WRONG, & msg=subname//": ERROR in time consistency: "//trim(dtimestring)//" != "//trim(mtimestring), & line=__LINE__, file=__FILE__, rcToReturn=rc) @@ -1594,25 +1963,27 @@ 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=u_FILE_u)) return + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out if (first_time) then !-------------------------------- ! set restart alarm !-------------------------------- - ! set ddefaults + ! defaults restart_n = 0 restart_ymd = 0 - call NUOPC_CompAttributeGet(gcomp, name="restart_option", value=restart_option, & - isPresent=isPresent, isSet=isSet, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + if (cesm_coupled) then + call NUOPC_CompAttributeGet(gcomp, name="restart_option", value=restart_option, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return - ! If restart_option is set then must also have set either restart_n or restart_ymd - if (isPresent .and. isSet) then + ! 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) + isPresent=isPresent, isSet=isSet, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return if (isPresent .and. isSet) then read(cvalue,*) restart_n @@ -1628,26 +1999,83 @@ subroutine ModelSetRunClock(gcomp, rc) msg=subname//": ERROR both restart_n and restart_ymd are zero for restart_option set ", & line=__LINE__, file=__FILE__, rcToReturn=rc) return - end if + endif + call ESMF_LogWrite(subname//" Set restart option = "//restart_option, ESMF_LOGMSG_INFO) + else - restart_option = "none" - endif - call ESMF_LogWrite(subname//" Set restart option = "//restart_option, ESMF_LOGMSG_INFO) + 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 - ! initialize restart alarm - 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 (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + ! If restart_option is set then must also have set either restart_n or restart_ymd + if (isPresent .and. isSet) then + call ESMF_LogWrite(subname//" Restart_n = "//trim(cvalue), ESMF_LOGMSG_INFO, rc=rc) + 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, rc=rc) + 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 + if (isPresent .and. isSet) then + read(cvalue,*) restart_ymd + call ESMF_LogWrite(subname//" Restart_ymd = "//trim(cvalue), ESMF_LOGMSG_INFO, rc=rc) + endif + else + restart_option = 'none' + call ESMF_LogWrite(subname//" Set restart option = "//restart_option, & + ESMF_LOGMSG_INFO, rc=rc) + !TODO: Find a better way + !Create but disable the restart_alarm; this is so restart writing can function w or w/o + !restart_n=0 + restart_alarm = ESMF_AlarmCreate(mclock, ringtime=dstopTime, name = "restart_alarm", enabled = .false., rc=rc) + call ESMF_LogWrite(subname//" Restart alarm is Created but Disabled", ESMF_LOGMSG_INFO, rc=rc) + endif + endif + endif - call ESMF_AlarmSet(restart_alarm, clock=mclock, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + ! Do not initialize an alarm if the restart option is none + if (restart_option /= 'none') 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, rc=rc) + end if first_time = .false. + + ! 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, rc=rc) + 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, rc=rc) endif !-------------------------------- @@ -1655,10 +2083,16 @@ subroutine ModelSetRunClock(gcomp, rc) !-------------------------------- call ESMF_ClockAdvance(mclock,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out call ESMF_ClockSet(mclock, currTime=dcurrtime, timeStep=dtimestep, stopTime=mstoptime, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out end subroutine ModelSetRunClock @@ -1681,7 +2115,12 @@ subroutine ocean_model_finalize(gcomp, rc) type(TIME_TYPE) :: Time type(ESMF_Clock) :: clock type(ESMF_Time) :: currTime + type(ESMF_Alarm), allocatable :: alarmList(:) + integer :: alarmCount character(len=64) :: timestamp + character(len=64) :: alarm_name + logical :: write_restart + integer :: i character(len=*),parameter :: subname='(MOM_cap:ocean_model_finalize)' write(*,*) 'MOM: --- finalize called ---' @@ -1709,11 +2148,25 @@ subroutine ocean_model_finalize(gcomp, rc) return ! bail out Time = esmf2fms_time(currTime) - if (cesm_coupled) then - call ocean_model_end(ocean_public, ocean_State, Time, write_restart=.false.) - else - call ocean_model_end(ocean_public, ocean_State, Time, write_restart=.true.) - endif + ! Check if the clock has a restart alarm - and if it does do not write a restart + call ESMF_ClockGet(clock, alarmCount=alarmCount, rc = rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return + + allocate(alarmList(1:alarmCount)) + call ESMF_ClockGetAlarmList(clock, alarmlistflag=ESMF_ALARMLIST_ALL, alarmList=alarmList, rc = rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return + + write_restart = .true. + do i = 1,alarmCount + call ESMF_AlarmGet(alarmlist(i), name=alarm_name, rc = rc) + if(trim(alarm_name) == 'restart_alarm' .and. ESMF_AlarmIsEnabled(alarmlist(i), rc=rc))write_restart = .false. + enddo + deallocate(alarmList) + + if(write_restart)call ESMF_LogWrite("No Restart Alarm, writing restart at Finalize ", ESMF_LOGMSG_INFO, rc=rc) + call ocean_model_end(ocean_public, ocean_State, Time, write_restart=write_restart) call field_manager_end() call fms_io_exit() @@ -1789,37 +2242,58 @@ 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) + 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) call SetScalarField(field, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out else call ESMF_LogWrite(subname // tag // " Field "// trim(field_defs(i)%stdname) // " is connected.", & - ESMF_LOGMSG_INFO) + ESMF_LOGMSG_INFO, & + line=__LINE__, & + file=__FILE__, & + rc=rc) 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=u_FILE_u)) return + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out ! initialize fldptr to zero call ESMF_FieldGet(field, farrayPtr=fldptr2d, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out 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=u_FILE_u)) return + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out ! initialize fldptr to zero call ESMF_FieldGet(field, farrayPtr=fldptr1d, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out fldptr1d(:) = 0.0 endif @@ -1828,16 +2302,24 @@ 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=u_FILE_u)) return + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out else ! field is not connected call ESMF_LogWrite(subname // tag // " Field "// trim(field_defs(i)%stdname) // " is not connected.", & - ESMF_LOGMSG_INFO) - + ESMF_LOGMSG_INFO, & + line=__LINE__, & + file=__FILE__, & + rc=rc) ! 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=u_FILE_u)) return + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out endif From e089a159fdfb7c2cb143da83d6084e6860147c05 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Tue, 7 Apr 2020 12:55:57 -0600 Subject: [PATCH 03/53] bug fix for cesm when restart_option is none --- config_src/nuopc_driver/mom_cap.F90 | 51 +++++++++++++---------------- 1 file changed, 22 insertions(+), 29 deletions(-) diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index 26cff18324..232a97ad41 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -1978,6 +1978,7 @@ subroutine ModelSetRunClock(gcomp, rc) restart_ymd = 0 if (cesm_coupled) then + call NUOPC_CompAttributeGet(gcomp, name="restart_option", value=restart_option, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return @@ -2033,40 +2034,29 @@ subroutine ModelSetRunClock(gcomp, rc) endif else restart_option = 'none' - call ESMF_LogWrite(subname//" Set restart option = "//restart_option, & - ESMF_LOGMSG_INFO, rc=rc) - !TODO: Find a better way - !Create but disable the restart_alarm; this is so restart writing can function w or w/o - !restart_n=0 - restart_alarm = ESMF_AlarmCreate(mclock, ringtime=dstopTime, name = "restart_alarm", enabled = .false., rc=rc) - call ESMF_LogWrite(subname//" Restart alarm is Created but Disabled", ESMF_LOGMSG_INFO, rc=rc) + call ESMF_LogWrite(subname//" Set restart option = "//restart_option, ESMF_LOGMSG_INFO, rc=rc) endif endif endif - ! Do not initialize an alarm if the restart option is none - if (restart_option /= 'none') 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, rc=rc) - end if + 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 - first_time = .false. + 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, rc=rc) ! create a 1-shot alarm at the driver stop time stop_alarm = ESMF_AlarmCreate(mclock, ringtime=dstopTime, name = "stop_alarm", rc=rc) @@ -2076,6 +2066,9 @@ subroutine ModelSetRunClock(gcomp, rc) call ESMF_TimeGet(dstoptime, timestring=timestr, rc=rc) call ESMF_LogWrite("Stop Alarm will ring at : "//trim(timestr), ESMF_LOGMSG_INFO, rc=rc) + + first_time = .false. + endif !-------------------------------- From 0a2bb505fd0988371f7f7b6b9739ddd75ea33d3e Mon Sep 17 00:00:00 2001 From: alperaltuntas Date: Sun, 12 Apr 2020 17:42:31 -0600 Subject: [PATCH 04/53] uncomment omp directive for KPP_compute_BLD --- .../vertical/MOM_CVMix_KPP.F90 | 20 +++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 index 5ed9e2a7a4..8c9c2b0e06 100644 --- a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 @@ -962,16 +962,16 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, EOS, uStar, buoyF buoy_scale = US%L_to_m**2*US%s_to_T**3 ! loop over horizontal points on processor - !GOMP parallel do default(none) private(surfFricVel, iFaceHeight, hcorr, dh, cellHeight, & - !GOMP surfBuoyFlux, U_H, V_H, u, v, Coriolis, pRef, SLdepth_0d, & - !GOMP ksfc, surfHtemp, surfHsalt, surfHu, surfHv, surfHuS, & - !GOMP surfHvS, hTot, delH, surftemp, surfsalt, surfu, surfv, & - !GOMP surfUs, surfVs, Uk, Vk, deltaU2, km1, kk, pres_1D, & - !GOMP Temp_1D, salt_1D, surfBuoyFlux2, MLD_GUESS, LA, rho_1D, & - !GOMP deltarho, N2_1d, ws_1d, LangEnhVT2, enhvt2, wst, & - !GOMP BulkRi_1d, zBottomMinusOffset) & - !GOMP shared(G, GV, CS, US, uStar, h, buoy_scale, buoyFlux, & - !GOMP Temp, Salt, waves, EOS, GoRho) + !$OMP parallel do default(none) private(surfFricVel, iFaceHeight, hcorr, dh, cellHeight, & + !$OMP surfBuoyFlux, U_H, V_H, Coriolis, pRef, SLdepth_0d, & + !$OMP ksfc, surfHtemp, surfHsalt, surfHu, surfHv, surfHuS, & + !$OMP surfHvS, hTot, delH, surftemp, surfsalt, surfu, surfv, & + !$OMP surfUs, surfVs, Uk, Vk, deltaU2, km1, kk, pres_1D, & + !$OMP Temp_1D, salt_1D, surfBuoyFlux2, MLD_GUESS, LA, rho_1D, & + !$OMP deltarho, N2_1d, ws_1d, LangEnhVT2, enhvt2, wst, & + !$OMP BulkRi_1d, zBottomMinusOffset) & + !$OMP shared(G, GV, CS, US, uStar, h, buoy_scale, buoyFlux, & + !$OMP Temp, Salt, waves, EOS, GoRho, u, v) do j = G%jsc, G%jec do i = G%isc, G%iec From 01f7c452e0808719dcebd7fb180024b83e1b80e8 Mon Sep 17 00:00:00 2001 From: alperaltuntas Date: Sun, 12 Apr 2020 21:31:58 -0600 Subject: [PATCH 05/53] uncomment omp in barotropic solver --- src/core/MOM_barotropic.F90 | 108 ++++++++++++++++++------------------ 1 file changed, 54 insertions(+), 54 deletions(-) diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index 14fc918b60..d3dabd2147 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -1584,24 +1584,24 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, call find_face_areas(Datu, Datv, G, GV, US, CS, MS, eta, 1+iev-ie) endif - !GOMP parallel default(shared) + !$OMP parallel default(shared) if (CS%dynamic_psurf .or. .not.project_velocity) then if (use_BT_cont) then - !GOMP do + !$OMP do do j=jsv-1,jev+1 ; do I=isv-2,iev+1 uhbt(I,j) = find_uhbt(ubt(I,j), BTCL_u(I,j), US) + uhbt0(I,j) enddo ; enddo - !GOMP do + !$OMP do do J=jsv-2,jev+1 ; do i=isv-1,iev+1 vhbt(i,J) = find_vhbt(vbt(i,J), BTCL_v(i,J), US) + vhbt0(i,J) enddo ; enddo - !GOMP do + !$OMP do do j=jsv-1,jev+1 ; do i=isv-1,iev+1 eta_pred(i,j) = (eta(i,j) + eta_src(i,j)) + (dtbt * CS%IareaT(i,j)) * & ((uhbt(I-1,j) - uhbt(I,j)) + (vhbt(i,J-1) - vhbt(i,J))) enddo ; enddo else - !GOMP do + !$OMP do do j=jsv-1,jev+1 ; do i=isv-1,iev+1 eta_pred(i,j) = (eta(i,j) + eta_src(i,j)) + (dtbt * CS%IareaT(i,j)) * & (((Datu(I-1,j)*ubt(I-1,j) + uhbt0(I-1,j)) - & @@ -1612,7 +1612,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, endif if (CS%dynamic_psurf) then - !GOMP do + !$OMP do do j=jsv-1,jev+1 ; do i=isv-1,iev+1 p_surf_dyn(i,j) = dyn_coef_eta(i,j) * (eta_pred(i,j) - eta(i,j)) enddo ; enddo @@ -1623,7 +1623,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, ! eta_PF_BT => eta_pred ; if (project_velocity) eta_PF_BT => eta if (find_etaav) then - !GOMP do + !$OMP do do j=js,je ; do i=is,ie eta_sum(i,j) = eta_sum(i,j) + wt_accel2(n) * eta_PF_BT(i,j) enddo ; enddo @@ -1631,23 +1631,23 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, if (interp_eta_PF) then wt_end = n*Instep ! This could be (n-0.5)*Instep. - !GOMP do + !$OMP do do j=jsv-1,jev+1 ; do i=isv-1,iev+1 eta_PF(i,j) = eta_PF_1(i,j) + wt_end*d_eta_PF(i,j) enddo ; enddo endif if (apply_OBC_flather .or. apply_OBC_open) then - !GOMP do + !$OMP do do j=jsv,jev ; do I=isv-2,iev+1 ubt_old(I,j) = ubt(I,j) enddo ; enddo - !GOMP do + !$OMP do do J=jsv-2,jev+1 ; do i=isv,iev vbt_old(i,J) = vbt(i,J) enddo ; enddo endif - !GOMP end parallel + !$OMP end parallel if (apply_OBCs) then if (MOD(n+G%first_direction,2)==1) then @@ -1657,7 +1657,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, endif if (CS%BT_OBC%apply_u_OBCs) then ! save the old value of ubt and uhbt - !GOMP parallel do default(shared) + !$OMP parallel do default(shared) do J=jsv-joff,jev+joff ; do i=isv-1,iev ubt_prev(i,J) = ubt(i,J) ; uhbt_prev(i,J) = uhbt(i,J) ubt_sum_prev(i,J) = ubt_sum(i,J) ; uhbt_sum_prev(i,J) = uhbt_sum(i,J) ; ubt_wtd_prev(i,J) = ubt_wtd(i,J) @@ -1665,7 +1665,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, endif if (CS%BT_OBC%apply_v_OBCs) then ! save the old value of vbt and vhbt - !GOMP parallel do default(shared) + !$OMP parallel do default(shared) do J=jsv-1,jev ; do i=isv-ioff,iev+ioff vbt_prev(i,J) = vbt(i,J) ; vhbt_prev(i,J) = vhbt(i,J) vbt_sum_prev(i,J) = vbt_sum(i,J) ; vhbt_sum_prev(i,J) = vhbt_sum(i,J) ; vbt_wtd_prev(i,J) = vbt_wtd(i,J) @@ -1673,10 +1673,10 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, endif endif - !GOMP parallel default(shared) private(vel_prev) + !$OMP parallel default(shared) private(vel_prev) if (MOD(n+G%first_direction,2)==1) then ! On odd-steps, update v first. - !GOMP do + !$OMP do do J=jsv-1,jev ; do i=isv-1,iev+1 Cor_v(i,J) = -1.0*((amer(I-1,j) * ubt(I-1,j) + cmer(I,j+1) * ubt(I,j+1)) + & (bmer(I,j) * ubt(I,j) + dmer(I-1,j+1) * ubt(I-1,j+1))) - Cor_ref_v(i,J) @@ -1685,19 +1685,19 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, dgeo_de * CS%IdyCv(i,J) enddo ; enddo if (CS%dynamic_psurf) then - !GOMP do + !$OMP do do J=jsv-1,jev ; do i=isv-1,iev+1 PFv(i,J) = PFv(i,J) + (p_surf_dyn(i,j) - p_surf_dyn(i,j+1)) * CS%IdyCv(i,J) enddo ; enddo endif if (CS%BT_OBC%apply_v_OBCs) then ! zero out PF across boundary - !GOMP do + !$OMP do do J=jsv-1,jev ; do i=isv-1,iev+1 ; if (OBC%segnum_v(i,J) /= OBC_NONE) then PFv(i,J) = 0.0 endif ; enddo ; enddo endif - !GOMP do + !$OMP do do J=jsv-1,jev ; do i=isv-1,iev+1 vel_prev = vbt(i,J) vbt(i,J) = bt_rem_v(i,J) * (vbt(i,J) + & @@ -1713,24 +1713,24 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, enddo ; enddo if (use_BT_cont) then - !GOMP do + !$OMP do do J=jsv-1,jev ; do i=isv-1,iev+1 vhbt(i,J) = find_vhbt(vbt_trans(i,J), BTCL_v(i,J), US) + vhbt0(i,J) enddo ; enddo else - !GOMP do + !$OMP do do J=jsv-1,jev ; do i=isv-1,iev+1 vhbt(i,J) = Datv(i,J)*vbt_trans(i,J) + vhbt0(i,J) enddo ; enddo endif if (CS%BT_OBC%apply_v_OBCs) then ! copy back the value for v-points on the boundary. - !GOMP do + !$OMP do do J=jsv-1,jev ; do i=isv-1,iev+1 ; if (OBC%segnum_v(i,J) /= OBC_NONE) then vbt(i,J) = vbt_prev(i,J) ; vhbt(i,J) = vhbt_prev(i,J) endif ; enddo ; enddo endif ! Now update the zonal velocity. - !GOMP do + !$OMP do do j=jsv,jev ; do I=isv-1,iev Cor_u(I,j) = ((azon(I,j) * vbt(i+1,J) + czon(I,j) * vbt(i,J-1)) + & (bzon(I,j) * vbt(i,J) + dzon(I,j) * vbt(i+1,J-1))) - & @@ -1741,19 +1741,19 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, enddo ; enddo if (CS%dynamic_psurf) then - !GOMP do + !$OMP do do j=jsv,jev ; do I=isv-1,iev PFu(I,j) = PFu(I,j) + (p_surf_dyn(i,j) - p_surf_dyn(i+1,j)) * CS%IdxCu(I,j) enddo ; enddo endif if (CS%BT_OBC%apply_u_OBCs) then ! zero out pressure force across boundary - !GOMP do + !$OMP do do j=jsv,jev ; do I=isv-1,iev ; if (OBC%segnum_u(I,j) /= OBC_NONE) then PFu(I,j) = 0.0 endif ; enddo ; enddo endif - !GOMP do + !$OMP do do j=jsv,jev ; do I=isv-1,iev vel_prev = ubt(I,j) ubt(I,j) = bt_rem_u(I,j) * (ubt(I,j) + & @@ -1770,25 +1770,25 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, enddo ; enddo if (use_BT_cont) then - !GOMP do + !$OMP do do j=jsv,jev ; do I=isv-1,iev uhbt(I,j) = find_uhbt(ubt_trans(I,j), BTCL_u(I,j), US) + uhbt0(I,j) enddo ; enddo else - !GOMP do + !$OMP do do j=jsv,jev ; do I=isv-1,iev uhbt(I,j) = Datu(I,j)*ubt_trans(I,j) + uhbt0(I,j) enddo ; enddo endif if (CS%BT_OBC%apply_u_OBCs) then ! copy back the value for u-points on the boundary. - !GOMP do + !$OMP do do j=jsv,jev ; do I=isv-1,iev ; if (OBC%segnum_u(I,j) /= OBC_NONE) then ubt(I,j) = ubt_prev(I,j); uhbt(I,j) = uhbt_prev(I,j) endif ; enddo ; enddo endif else ! On even steps, update u first. - !GOMP do + !$OMP do do j=jsv-1,jev+1 ; do I=isv-1,iev Cor_u(I,j) = ((azon(I,j) * vbt(i+1,J) + czon(I,j) * vbt(i,J-1)) + & (bzon(I,j) * vbt(i,J) + dzon(I,j) * vbt(i+1,J-1))) - & @@ -1799,20 +1799,20 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, enddo ; enddo if (CS%dynamic_psurf) then - !GOMP do + !$OMP do do j=jsv-1,jev+1 ; do I=isv-1,iev PFu(I,j) = PFu(I,j) + (p_surf_dyn(i,j) - p_surf_dyn(i+1,j)) * CS%IdxCu(I,j) enddo ; enddo endif if (CS%BT_OBC%apply_u_OBCs) then ! zero out pressure force across boundary - !GOMP do + !$OMP do do j=jsv,jev ; do I=isv-1,iev ; if (OBC%segnum_u(I,j) /= OBC_NONE) then PFu(I,j) = 0.0 endif ; enddo ; enddo endif - !GOMP do + !$OMP do do j=jsv-1,jev+1 ; do I=isv-1,iev vel_prev = ubt(I,j) ubt(I,j) = bt_rem_u(I,j) * (ubt(I,j) + & @@ -1829,18 +1829,18 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, enddo ; enddo if (use_BT_cont) then - !GOMP do + !$OMP do do j=jsv-1,jev+1 ; do I=isv-1,iev uhbt(I,j) = find_uhbt(ubt_trans(I,j), BTCL_u(I,j), US) + uhbt0(I,j) enddo ; enddo else - !GOMP do + !$OMP do do j=jsv-1,jev+1 ; do I=isv-1,iev uhbt(I,j) = Datu(I,j)*ubt_trans(I,j) + uhbt0(I,j) enddo ; enddo endif if (CS%BT_OBC%apply_u_OBCs) then ! copy back the value for u-points on the boundary. - !GOMP do + !$OMP do do j=jsv-1,jev+1 ; do I=isv-1,iev ; if (OBC%segnum_u(I,j) /= OBC_NONE) then ubt(I,j) = ubt_prev(I,j); uhbt(I,j) = uhbt_prev(I,j) endif ; enddo ; enddo @@ -1848,7 +1848,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, ! Now update the meridional velocity. if (CS%use_old_coriolis_bracket_bug) then - !GOMP do + !$OMP do do J=jsv-1,jev ; do i=isv,iev Cor_v(i,J) = -1.0*((amer(I-1,j) * ubt(I-1,j) + bmer(I,j) * ubt(I,j)) + & (cmer(I,j+1) * ubt(I,j+1) + dmer(I-1,j+1) * ubt(I-1,j+1))) - Cor_ref_v(i,J) @@ -1857,7 +1857,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, dgeo_de * CS%IdyCv(i,J) enddo ; enddo else - !GOMP do + !$OMP do do J=jsv-1,jev ; do i=isv,iev Cor_v(i,J) = -1.0*((amer(I-1,j) * ubt(I-1,j) + cmer(I,j+1) * ubt(I,j+1)) + & (bmer(I,j) * ubt(I,j) + dmer(I-1,j+1) * ubt(I-1,j+1))) - Cor_ref_v(i,J) @@ -1868,20 +1868,20 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, endif if (CS%dynamic_psurf) then - !GOMP do + !$OMP do do J=jsv-1,jev ; do i=isv,iev PFv(i,J) = PFv(i,J) + (p_surf_dyn(i,j) - p_surf_dyn(i,j+1)) * CS%IdyCv(i,J) enddo ; enddo endif if (CS%BT_OBC%apply_v_OBCs) then ! zero out PF across boundary - !GOMP do + !$OMP do do J=jsv-1,jev ; do i=isv-1,iev+1 ; if (OBC%segnum_v(i,J) /= OBC_NONE) then PFv(i,J) = 0.0 endif ; enddo ; enddo endif - !GOMP do + !$OMP do do J=jsv-1,jev ; do i=isv,iev vel_prev = vbt(i,J) vbt(i,J) = bt_rem_v(i,J) * (vbt(i,J) + & @@ -1897,64 +1897,64 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, endif enddo ; enddo if (use_BT_cont) then - !GOMP do + !$OMP do do J=jsv-1,jev ; do i=isv,iev vhbt(i,J) = find_vhbt(vbt_trans(i,J), BTCL_v(i,J), US) + vhbt0(i,J) enddo ; enddo else - !GOMP do + !$OMP do do J=jsv-1,jev ; do i=isv,iev vhbt(i,J) = Datv(i,J)*vbt_trans(i,J) + vhbt0(i,J) enddo ; enddo endif if (CS%BT_OBC%apply_v_OBCs) then ! copy back the value for v-points on the boundary. - !GOMP do + !$OMP do do J=jsv-1,jev ; do i=isv,iev ; if (OBC%segnum_v(i,J) /= OBC_NONE) then vbt(i,J) = vbt_prev(i,J); vhbt(i,J) = vhbt_prev(i,J) endif ; enddo ; enddo endif endif - !GOMP end parallel + !$OMP end parallel - !GOMP parallel default(shared) + !$OMP parallel default(shared) if (find_PF) then - !GOMP do + !$OMP do do j=js,je ; do I=is-1,ie PFu_bt_sum(I,j) = PFu_bt_sum(I,j) + wt_accel2(n) * PFu(I,j) enddo ; enddo - !GOMP do + !$OMP do do J=js-1,je ; do i=is,ie PFv_bt_sum(i,J) = PFv_bt_sum(i,J) + wt_accel2(n) * PFv(i,J) enddo ; enddo endif if (find_Cor) then - !GOMP do + !$OMP do do j=js,je ; do I=is-1,ie Coru_bt_sum(I,j) = Coru_bt_sum(I,j) + wt_accel2(n) * Cor_u(I,j) enddo ; enddo - !GOMP do + !$OMP do do J=js-1,je ; do i=is,ie Corv_bt_sum(i,J) = Corv_bt_sum(i,J) + wt_accel2(n) * Cor_v(i,J) enddo ; enddo endif - !GOMP do + !$OMP do do j=js,je ; do I=is-1,ie ubt_sum(I,j) = ubt_sum(I,j) + wt_trans(n) * ubt_trans(I,j) uhbt_sum(I,j) = uhbt_sum(I,j) + wt_trans(n) * uhbt(I,j) ubt_wtd(I,j) = ubt_wtd(I,j) + wt_vel(n) * ubt(I,j) enddo ; enddo - !GOMP do + !$OMP do do J=js-1,je ; do i=is,ie vbt_sum(i,J) = vbt_sum(i,J) + wt_trans(n) * vbt_trans(i,J) vhbt_sum(i,J) = vhbt_sum(i,J) + wt_trans(n) * vhbt(i,J) vbt_wtd(i,J) = vbt_wtd(i,J) + wt_vel(n) * vbt(i,J) enddo ; enddo - !GOMP end parallel + !$OMP end parallel if (apply_OBCs) then if (CS%BT_OBC%apply_u_OBCs) then ! copy back the value for u-points on the boundary. - !GOMP parallel do default(shared) + !$OMP parallel do default(shared) do j=js,je ; do I=is-1,ie if (OBC%segnum_u(I,j) /= OBC_NONE) then ubt_sum(I,j) = ubt_sum_prev(I,j) ; uhbt_sum(I,j) = uhbt_sum_prev(I,j) @@ -1964,7 +1964,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, endif if (CS%BT_OBC%apply_v_OBCs) then ! copy back the value for v-points on the boundary. - !GOMP parallel do default(shared) + !$OMP parallel do default(shared) do J=js-1,je ; do I=is,ie if (OBC%segnum_v(i,J) /= OBC_NONE) then vbt_sum(i,J) = vbt_sum_prev(i,J) ; vhbt_sum(i,J) = vhbt_sum_prev(i,J) From 2aa10917d947819a958610e611e8ce91858ef797 Mon Sep 17 00:00:00 2001 From: alperaltuntas Date: Tue, 14 Apr 2020 11:01:53 -0600 Subject: [PATCH 06/53] optimize barotropic timestepping openmp --- src/core/MOM_barotropic.F90 | 137 ++++++++++++++++++++++-------------- 1 file changed, 83 insertions(+), 54 deletions(-) diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index d3dabd2147..fbaadc869f 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -1584,13 +1584,14 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, call find_face_areas(Datu, Datv, G, GV, US, CS, MS, eta, 1+iev-ie) endif - !$OMP parallel default(shared) + !$OMP parallel default(shared) private(vel_prev, ioff, joff) if (CS%dynamic_psurf .or. .not.project_velocity) then if (use_BT_cont) then !$OMP do do j=jsv-1,jev+1 ; do I=isv-2,iev+1 uhbt(I,j) = find_uhbt(ubt(I,j), BTCL_u(I,j), US) + uhbt0(I,j) enddo ; enddo + !$OMP end do nowait !$OMP do do J=jsv-2,jev+1 ; do i=isv-1,iev+1 vhbt(i,J) = find_vhbt(vbt(i,J), BTCL_v(i,J), US) + vhbt0(i,J) @@ -1627,6 +1628,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, do j=js,je ; do i=is,ie eta_sum(i,j) = eta_sum(i,j) + wt_accel2(n) * eta_PF_BT(i,j) enddo ; enddo + !$OMP end do nowait endif if (interp_eta_PF) then @@ -1647,7 +1649,6 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, vbt_old(i,J) = vbt(i,J) enddo ; enddo endif - !$OMP end parallel if (apply_OBCs) then if (MOD(n+G%first_direction,2)==1) then @@ -1657,7 +1658,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, endif if (CS%BT_OBC%apply_u_OBCs) then ! save the old value of ubt and uhbt - !$OMP parallel do default(shared) + !$OMP do do J=jsv-joff,jev+joff ; do i=isv-1,iev ubt_prev(i,J) = ubt(i,J) ; uhbt_prev(i,J) = uhbt(i,J) ubt_sum_prev(i,J) = ubt_sum(i,J) ; uhbt_sum_prev(i,J) = uhbt_sum(i,J) ; ubt_wtd_prev(i,J) = ubt_wtd(i,J) @@ -1665,7 +1666,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, endif if (CS%BT_OBC%apply_v_OBCs) then ! save the old value of vbt and vhbt - !$OMP parallel do default(shared) + !$OMP do do J=jsv-1,jev ; do i=isv-ioff,iev+ioff vbt_prev(i,J) = vbt(i,J) ; vhbt_prev(i,J) = vhbt(i,J) vbt_sum_prev(i,J) = vbt_sum(i,J) ; vhbt_sum_prev(i,J) = vhbt_sum(i,J) ; vbt_wtd_prev(i,J) = vbt_wtd(i,J) @@ -1673,10 +1674,9 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, endif endif - !$OMP parallel default(shared) private(vel_prev) if (MOD(n+G%first_direction,2)==1) then ! On odd-steps, update v first. - !$OMP do + !$OMP do schedule(static) do J=jsv-1,jev ; do i=isv-1,iev+1 Cor_v(i,J) = -1.0*((amer(I-1,j) * ubt(I-1,j) + cmer(I,j+1) * ubt(I,j+1)) + & (bmer(I,j) * ubt(I,j) + dmer(I-1,j+1) * ubt(I-1,j+1))) - Cor_ref_v(i,J) @@ -1684,20 +1684,23 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, (eta_PF_BT(i,j+1)-eta_PF(i,j+1))*gtot_S(i,j+1)) * & dgeo_de * CS%IdyCv(i,J) enddo ; enddo + !$OMP end do nowait if (CS%dynamic_psurf) then - !$OMP do + !$OMP do schedule(static) do J=jsv-1,jev ; do i=isv-1,iev+1 PFv(i,J) = PFv(i,J) + (p_surf_dyn(i,j) - p_surf_dyn(i,j+1)) * CS%IdyCv(i,J) enddo ; enddo + !$OMP end do nowait endif if (CS%BT_OBC%apply_v_OBCs) then ! zero out PF across boundary - !$OMP do + !$OMP do schedule(static) do J=jsv-1,jev ; do i=isv-1,iev+1 ; if (OBC%segnum_v(i,J) /= OBC_NONE) then PFv(i,J) = 0.0 endif ; enddo ; enddo + !$OMP end do nowait endif - !$OMP do + !$OMP do schedule(static) do J=jsv-1,jev ; do i=isv-1,iev+1 vel_prev = vbt(i,J) vbt(i,J) = bt_rem_v(i,J) * (vbt(i,J) + & @@ -1713,24 +1716,26 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, enddo ; enddo if (use_BT_cont) then - !$OMP do + !$OMP do schedule(static) do J=jsv-1,jev ; do i=isv-1,iev+1 vhbt(i,J) = find_vhbt(vbt_trans(i,J), BTCL_v(i,J), US) + vhbt0(i,J) enddo ; enddo + !$OMP end do nowait else - !$OMP do + !$OMP do schedule(static) do J=jsv-1,jev ; do i=isv-1,iev+1 vhbt(i,J) = Datv(i,J)*vbt_trans(i,J) + vhbt0(i,J) enddo ; enddo + !$OMP end do nowait endif if (CS%BT_OBC%apply_v_OBCs) then ! copy back the value for v-points on the boundary. - !$OMP do + !$OMP do schedule(static) do J=jsv-1,jev ; do i=isv-1,iev+1 ; if (OBC%segnum_v(i,J) /= OBC_NONE) then vbt(i,J) = vbt_prev(i,J) ; vhbt(i,J) = vhbt_prev(i,J) endif ; enddo ; enddo endif ! Now update the zonal velocity. - !$OMP do + !$OMP do schedule(static) do j=jsv,jev ; do I=isv-1,iev Cor_u(I,j) = ((azon(I,j) * vbt(i+1,J) + czon(I,j) * vbt(i,J-1)) + & (bzon(I,j) * vbt(i,J) + dzon(I,j) * vbt(i+1,J-1))) - & @@ -1739,21 +1744,24 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, (eta_PF_BT(i+1,j)-eta_PF(i+1,j))*gtot_W(i+1,j)) * & dgeo_de * CS%IdxCu(I,j) enddo ; enddo + !$OMP end do nowait if (CS%dynamic_psurf) then - !$OMP do + !$OMP do schedule(static) do j=jsv,jev ; do I=isv-1,iev PFu(I,j) = PFu(I,j) + (p_surf_dyn(i,j) - p_surf_dyn(i+1,j)) * CS%IdxCu(I,j) enddo ; enddo + !$OMP end do nowait endif if (CS%BT_OBC%apply_u_OBCs) then ! zero out pressure force across boundary - !$OMP do + !$OMP do schedule(static) do j=jsv,jev ; do I=isv-1,iev ; if (OBC%segnum_u(I,j) /= OBC_NONE) then PFu(I,j) = 0.0 endif ; enddo ; enddo + !$OMP end do nowait endif - !$OMP do + !$OMP do schedule(static) do j=jsv,jev ; do I=isv-1,iev vel_prev = ubt(I,j) ubt(I,j) = bt_rem_u(I,j) * (ubt(I,j) + & @@ -1768,27 +1776,28 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, u_accel_bt(I,j) = u_accel_bt(I,j) + wt_accel(n) * (Cor_u(I,j) + PFu(I,j)) endif enddo ; enddo + !$OMP end do nowait if (use_BT_cont) then - !$OMP do + !$OMP do schedule(static) do j=jsv,jev ; do I=isv-1,iev uhbt(I,j) = find_uhbt(ubt_trans(I,j), BTCL_u(I,j), US) + uhbt0(I,j) enddo ; enddo else - !$OMP do + !$OMP do schedule(static) do j=jsv,jev ; do I=isv-1,iev uhbt(I,j) = Datu(I,j)*ubt_trans(I,j) + uhbt0(I,j) enddo ; enddo endif if (CS%BT_OBC%apply_u_OBCs) then ! copy back the value for u-points on the boundary. - !$OMP do + !$OMP do schedule(static) do j=jsv,jev ; do I=isv-1,iev ; if (OBC%segnum_u(I,j) /= OBC_NONE) then ubt(I,j) = ubt_prev(I,j); uhbt(I,j) = uhbt_prev(I,j) endif ; enddo ; enddo endif else ! On even steps, update u first. - !$OMP do + !$OMP do schedule(static) do j=jsv-1,jev+1 ; do I=isv-1,iev Cor_u(I,j) = ((azon(I,j) * vbt(i+1,J) + czon(I,j) * vbt(i,J-1)) + & (bzon(I,j) * vbt(i,J) + dzon(I,j) * vbt(i+1,J-1))) - & @@ -1797,22 +1806,24 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, (eta_PF_BT(i+1,j)-eta_PF(i+1,j))*gtot_W(i+1,j)) * & dgeo_de * CS%IdxCu(I,j) enddo ; enddo + !$OMP end do nowait if (CS%dynamic_psurf) then - !$OMP do + !$OMP do schedule(static) do j=jsv-1,jev+1 ; do I=isv-1,iev PFu(I,j) = PFu(I,j) + (p_surf_dyn(i,j) - p_surf_dyn(i+1,j)) * CS%IdxCu(I,j) enddo ; enddo + !$OMP end do nowait endif if (CS%BT_OBC%apply_u_OBCs) then ! zero out pressure force across boundary - !$OMP do + !$OMP do schedule(static) do j=jsv,jev ; do I=isv-1,iev ; if (OBC%segnum_u(I,j) /= OBC_NONE) then PFu(I,j) = 0.0 endif ; enddo ; enddo endif - !$OMP do + !$OMP do schedule(static) do j=jsv-1,jev+1 ; do I=isv-1,iev vel_prev = ubt(I,j) ubt(I,j) = bt_rem_u(I,j) * (ubt(I,j) + & @@ -1829,18 +1840,20 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, enddo ; enddo if (use_BT_cont) then - !$OMP do + !$OMP do schedule(static) do j=jsv-1,jev+1 ; do I=isv-1,iev uhbt(I,j) = find_uhbt(ubt_trans(I,j), BTCL_u(I,j), US) + uhbt0(I,j) enddo ; enddo + !$OMP end do nowait else - !$OMP do + !$OMP do schedule(static) do j=jsv-1,jev+1 ; do I=isv-1,iev uhbt(I,j) = Datu(I,j)*ubt_trans(I,j) + uhbt0(I,j) enddo ; enddo + !$OMP end do nowait endif if (CS%BT_OBC%apply_u_OBCs) then ! copy back the value for u-points on the boundary. - !$OMP do + !$OMP do schedule(static) do j=jsv-1,jev+1 ; do I=isv-1,iev ; if (OBC%segnum_u(I,j) /= OBC_NONE) then ubt(I,j) = ubt_prev(I,j); uhbt(I,j) = uhbt_prev(I,j) endif ; enddo ; enddo @@ -1848,7 +1861,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, ! Now update the meridional velocity. if (CS%use_old_coriolis_bracket_bug) then - !$OMP do + !$OMP do schedule(static) do J=jsv-1,jev ; do i=isv,iev Cor_v(i,J) = -1.0*((amer(I-1,j) * ubt(I-1,j) + bmer(I,j) * ubt(I,j)) + & (cmer(I,j+1) * ubt(I,j+1) + dmer(I-1,j+1) * ubt(I-1,j+1))) - Cor_ref_v(i,J) @@ -1856,8 +1869,9 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, (eta_PF_BT(i,j+1)-eta_PF(i,j+1))*gtot_S(i,j+1)) * & dgeo_de * CS%IdyCv(i,J) enddo ; enddo + !$OMP end do nowait else - !$OMP do + !$OMP do schedule(static) do J=jsv-1,jev ; do i=isv,iev Cor_v(i,J) = -1.0*((amer(I-1,j) * ubt(I-1,j) + cmer(I,j+1) * ubt(I,j+1)) + & (bmer(I,j) * ubt(I,j) + dmer(I-1,j+1) * ubt(I-1,j+1))) - Cor_ref_v(i,J) @@ -1865,23 +1879,25 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, (eta_PF_BT(i,j+1)-eta_PF(i,j+1))*gtot_S(i,j+1)) * & dgeo_de * CS%IdyCv(i,J) enddo ; enddo + !$OMP end do nowait endif if (CS%dynamic_psurf) then - !$OMP do + !$OMP do schedule(static) do J=jsv-1,jev ; do i=isv,iev PFv(i,J) = PFv(i,J) + (p_surf_dyn(i,j) - p_surf_dyn(i,j+1)) * CS%IdyCv(i,J) enddo ; enddo + !$OMP end do nowait endif if (CS%BT_OBC%apply_v_OBCs) then ! zero out PF across boundary - !$OMP do + !$OMP do schedule(static) do J=jsv-1,jev ; do i=isv-1,iev+1 ; if (OBC%segnum_v(i,J) /= OBC_NONE) then PFv(i,J) = 0.0 endif ; enddo ; enddo endif - !$OMP do + !$OMP do schedule(static) do J=jsv-1,jev ; do i=isv,iev vel_prev = vbt(i,J) vbt(i,J) = bt_rem_v(i,J) * (vbt(i,J) + & @@ -1896,46 +1912,49 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, v_accel_bt(I,j) = v_accel_bt(I,j) + wt_accel(n) * (Cor_v(i,J) + PFv(i,J)) endif enddo ; enddo + !$OMP end do nowait if (use_BT_cont) then - !$OMP do + !$OMP do schedule(static) do J=jsv-1,jev ; do i=isv,iev vhbt(i,J) = find_vhbt(vbt_trans(i,J), BTCL_v(i,J), US) + vhbt0(i,J) enddo ; enddo else - !$OMP do + !$OMP do schedule(static) do J=jsv-1,jev ; do i=isv,iev vhbt(i,J) = Datv(i,J)*vbt_trans(i,J) + vhbt0(i,J) enddo ; enddo endif if (CS%BT_OBC%apply_v_OBCs) then ! copy back the value for v-points on the boundary. - !$OMP do + !$OMP do schedule(static) do J=jsv-1,jev ; do i=isv,iev ; if (OBC%segnum_v(i,J) /= OBC_NONE) then vbt(i,J) = vbt_prev(i,J); vhbt(i,J) = vhbt_prev(i,J) endif ; enddo ; enddo endif endif - !$OMP end parallel - !$OMP parallel default(shared) if (find_PF) then !$OMP do do j=js,je ; do I=is-1,ie PFu_bt_sum(I,j) = PFu_bt_sum(I,j) + wt_accel2(n) * PFu(I,j) enddo ; enddo + !$OMP end do nowait !$OMP do do J=js-1,je ; do i=is,ie PFv_bt_sum(i,J) = PFv_bt_sum(i,J) + wt_accel2(n) * PFv(i,J) enddo ; enddo + !$OMP end do nowait endif if (find_Cor) then !$OMP do do j=js,je ; do I=is-1,ie Coru_bt_sum(I,j) = Coru_bt_sum(I,j) + wt_accel2(n) * Cor_u(I,j) enddo ; enddo + !$OMP end do nowait !$OMP do do J=js-1,je ; do i=is,ie Corv_bt_sum(i,J) = Corv_bt_sum(i,J) + wt_accel2(n) * Cor_v(i,J) enddo ; enddo + !$OMP end do nowait endif !$OMP do @@ -1944,17 +1963,18 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, uhbt_sum(I,j) = uhbt_sum(I,j) + wt_trans(n) * uhbt(I,j) ubt_wtd(I,j) = ubt_wtd(I,j) + wt_vel(n) * ubt(I,j) enddo ; enddo + !$OMP end do nowait !$OMP do do J=js-1,je ; do i=is,ie vbt_sum(i,J) = vbt_sum(i,J) + wt_trans(n) * vbt_trans(i,J) vhbt_sum(i,J) = vhbt_sum(i,J) + wt_trans(n) * vhbt(i,J) vbt_wtd(i,J) = vbt_wtd(i,J) + wt_vel(n) * vbt(i,J) enddo ; enddo - !$OMP end parallel + !$OMP end do nowait if (apply_OBCs) then if (CS%BT_OBC%apply_u_OBCs) then ! copy back the value for u-points on the boundary. - !$OMP parallel do default(shared) + !$OMP do do j=js,je ; do I=is-1,ie if (OBC%segnum_u(I,j) /= OBC_NONE) then ubt_sum(I,j) = ubt_sum_prev(I,j) ; uhbt_sum(I,j) = uhbt_sum_prev(I,j) @@ -1964,7 +1984,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, endif if (CS%BT_OBC%apply_v_OBCs) then ! copy back the value for v-points on the boundary. - !$OMP parallel do default(shared) + !$OMP do do J=js-1,je ; do I=is,ie if (OBC%segnum_v(i,J) /= OBC_NONE) then vbt_sum(i,J) = vbt_sum_prev(i,J) ; vhbt_sum(i,J) = vhbt_sum_prev(i,J) @@ -1973,24 +1993,32 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, enddo ; enddo endif + !$OMP single call apply_velocity_OBCs(OBC, ubt, vbt, uhbt, vhbt, & ubt_trans, vbt_trans, eta, ubt_old, vbt_old, CS%BT_OBC, & G, MS, US, iev-ie, dtbt, bebt, use_BT_cont, Datu, Datv, BTCL_u, BTCL_v, & uhbt0, vhbt0) - if (CS%BT_OBC%apply_u_OBCs) then ; do j=js,je ; do I=is-1,ie - if (OBC%segnum_u(I,j) /= OBC_NONE) then - ubt_sum(I,j) = ubt_sum(I,j) + wt_trans(n) * ubt_trans(I,j) - uhbt_sum(I,j) = uhbt_sum(I,j) + wt_trans(n) * uhbt(I,j) - ubt_wtd(I,j) = ubt_wtd(I,j) + wt_vel(n) * ubt(I,j) - endif - enddo ; enddo ; endif - if (CS%BT_OBC%apply_v_OBCs) then ; do J=js-1,je ; do i=is,ie - if (OBC%segnum_v(i,J) /= OBC_NONE) then - vbt_sum(i,J) = vbt_sum(i,J) + wt_trans(n) * vbt_trans(i,J) - vhbt_sum(i,J) = vhbt_sum(i,J) + wt_trans(n) * vhbt(i,J) - vbt_wtd(i,J) = vbt_wtd(i,J) + wt_vel(n) * vbt(i,J) - endif - enddo ; enddo ; endif + !$OMP end single + if (CS%BT_OBC%apply_u_OBCs) then + !$OMP do + do j=js,je ; do I=is-1,ie + if (OBC%segnum_u(I,j) /= OBC_NONE) then + ubt_sum(I,j) = ubt_sum(I,j) + wt_trans(n) * ubt_trans(I,j) + uhbt_sum(I,j) = uhbt_sum(I,j) + wt_trans(n) * uhbt(I,j) + ubt_wtd(I,j) = ubt_wtd(I,j) + wt_vel(n) * ubt(I,j) + endif + enddo ; enddo + endif + if (CS%BT_OBC%apply_v_OBCs) then + !$OMP do + do J=js-1,je ; do i=is,ie + if (OBC%segnum_v(i,J) /= OBC_NONE) then + vbt_sum(i,J) = vbt_sum(i,J) + wt_trans(n) * vbt_trans(i,J) + vhbt_sum(i,J) = vhbt_sum(i,J) + wt_trans(n) * vhbt(i,J) + vbt_wtd(i,J) = vbt_wtd(i,J) + wt_vel(n) * vbt(i,J) + endif + enddo ; enddo + endif endif if (CS%debug_bt) then @@ -1998,13 +2026,14 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, scale=US%s_to_T*US%L_to_m**2*GV%H_to_m) endif - !$OMP parallel do default(shared) + !$OMP do do j=jsv,jev ; do i=isv,iev eta(i,j) = (eta(i,j) + eta_src(i,j)) + (dtbt * CS%IareaT(i,j)) * & ((uhbt(I-1,j) - uhbt(I,j)) + (vhbt(i,J-1) - vhbt(i,J))) eta_wtd(i,j) = eta_wtd(i,j) + eta(i,j) * wt_eta(n) ! Should there be a concern if eta drops below 0 or G%bathyT? enddo ; enddo + !$OMP end parallel if (do_hifreq_output) then time_step_end = time_bt_start + real_to_time(n*US%T_to_s*dtbt) From 3dd70fe71930faaff5f8818ef3f9256335393ef4 Mon Sep 17 00:00:00 2001 From: alperaltuntas Date: Wed, 15 Apr 2020 11:56:23 -0600 Subject: [PATCH 07/53] remove unnecessary kOBL computation --- .../vertical/MOM_CVMix_KPP.F90 | 25 ------------------- 1 file changed, 25 deletions(-) diff --git a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 index 8c9c2b0e06..6056dd3eab 100644 --- a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 @@ -1415,31 +1415,6 @@ subroutine KPP_smooth_BLD(CS,G,GV,h) enddo ! s-loop - ! Update kOBL for smoothed OBL depths - do j = G%jsc, G%jec - do i = G%isc, G%iec - - ! skip land points - if (G%mask2dT(i,j)==0.) cycle - - iFaceHeight(1) = 0.0 ! BBL is all relative to the surface - hcorr = 0. - do k=1,G%ke - - ! cell center and cell bottom in meters (negative values in the ocean) - dh = h(i,j,k) * GV%H_to_m ! Nominal thickness to use for increment - dh = dh + hcorr ! Take away the accumulated error (could temporarily make dh<0) - hcorr = min( dh - CS%min_thickness, 0. ) ! If inflating then hcorr<0 - dh = max( dh, CS%min_thickness ) ! Limit increment dh>=min_thickness - cellHeight(k) = iFaceHeight(k) - 0.5 * dh - iFaceHeight(k+1) = iFaceHeight(k) - dh - enddo - - CS%kOBL(i,j) = CVMix_kpp_compute_kOBL_depth( iFaceHeight, cellHeight, CS%OBLdepth(i,j) ) - - enddo - enddo - end subroutine KPP_smooth_BLD From 6cf28bf15f06ce9f7015b2db1fc51d63438f4501 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Wed, 15 Apr 2020 15:06:55 -0600 Subject: [PATCH 08/53] Add option to scale AH via a biharmonic Reynolds # This is done via parameter RE_AH: if nonzero, the biharmonic coefficient is scaled so that the biharmonic Reynolds number is equal to this. --- .../lateral/MOM_hor_visc.F90 | 137 ++++-------------- 1 file changed, 30 insertions(+), 107 deletions(-) diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index c3ec878bc1..f3c593819a 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -46,6 +46,8 @@ module MOM_hor_visc !! limited to guarantee stability. logical :: better_bound_Ah !< If true, use a more careful bounding of the !! biharmonic viscosity to guarantee stability. + real :: Re_Ah !! If nonzero, the biharmonic coefficient is scaled + !< so that the biharmonic Reynolds number is equal to this. real :: bound_coef !< The nondimensional coefficient of the ratio of !! the viscosity bounds to the theoretical maximum !! for stability without considering other terms [nondim]. @@ -163,14 +165,16 @@ module MOM_hor_visc Biharm5_const_xx, & !< Biharmonic metric-dependent constants [L5 ~> m5] Laplac3_const_xx, & !< Laplacian metric-dependent constants [L3 ~> m3] Biharm_const_xx, & !< Biharmonic metric-dependent constants [L4 ~> m4] - Biharm_const2_xx !< Biharmonic metric-dependent constants [T L4 ~> s m4] + Biharm_const2_xx, & !< Biharmonic metric-dependent constants [T L4 ~> s m4] + Re_Ah_const_xx !< Biharmonic metric-dependent constants [L3 ~> m3] real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEMB_PTR_) :: & Laplac2_const_xy, & !< Laplacian metric-dependent constants [L2 ~> m2] Biharm5_const_xy, & !< Biharmonic metric-dependent constants [L5 ~> m5] Laplac3_const_xy, & !< Laplacian metric-dependent constants [L3 ~> m3] Biharm_const_xy, & !< Biharmonic metric-dependent constants [L4 ~> m4] - Biharm_const2_xy !< Biharmonic metric-dependent constants [T L4 ~> s m4] + Biharm_const2_xy, & !< Biharmonic metric-dependent constants [T L4 ~> s m4] + Re_Ah_const_xy !< Biharmonic metric-dependent constants [L3 ~> m3] type(diag_ctrl), pointer :: diag => NULL() !< structure to regulate diagnostics @@ -339,6 +343,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, real :: backscat_subround ! The ratio of f over Shear_mag that is so small that the backscatter ! calculation gives the same value as if f were 0 [nondim]. real :: H0_GME ! Depth used to scale down GME coefficient in shallow areas [Z ~> m] + real :: KE ! Local kinetic energy [L2 T-2 ~> m2 s-2] logical :: rescale_Kh, legacy_bound logical :: find_FrictWork logical :: apply_OBC = .false. @@ -874,6 +879,11 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, if (use_MEKE_Au) Ah = Ah + MEKE%Au(i,j) ! *Add* the MEKE contribution + if (CS%Re_Ah > 0.0) then + KE = 0.125*((u(I,j,k)+u(I-1,j,k))**2 + (v(i,J,k)+v(i,J-1,k))**2) + Ah = sqrt(KE) * CS%Re_Ah_const_xx(i,j) + endif + if (CS%better_bound_Ah) then Ah = MIN(Ah, visc_bound_rem*hrat_min*CS%Ah_Max_xx(i,j)) endif @@ -1047,6 +1057,11 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, (MEKE%Au(I+1,J) + MEKE%Au(I,J+1)) ) endif + if (CS%Re_Ah > 0.0) then + KE = 0.125*((u(I,j,k)+u(I,j+1,k))**2 + (v(i,J,k)+v(i+1,J,k))**2) + Ah = sqrt(KE) * CS%Re_Ah_const_xy(i,j) + endif + if (CS%better_bound_Ah) then Ah = MIN(Ah, visc_bound_rem*hrat_min*CS%Ah_Max_xy(I,J)) endif @@ -1363,7 +1378,6 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) logical :: split ! If true, use the split time stepping scheme. ! If false and USE_GME = True, issue a FATAL error. logical :: default_2018_answers - character(len=64) :: inputdir, filename real :: deg2rad ! Converts degrees to radians real :: slat_fn ! sin(lat)**Kh_pwr_of_sine @@ -1372,28 +1386,22 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB integer :: i, j - ! This include declares and sets the variable "version". #include "version_variable.h" character(len=40) :: mdl = "MOM_hor_visc" ! module name - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB - if (associated(CS)) then call MOM_error(WARNING, "hor_visc_init called with an associated "// & "control structure.") return endif allocate(CS) - CS%diag => diag - ! Read parameters and write them to the model log. call log_version(param_file, mdl, version, "") - ! It is not clear whether these initialization lines are needed for the ! cases where the corresponding parameters are not read. CS%bound_Kh = .false. ; CS%better_bound_Kh = .false. ; CS%Smagorinsky_Kh = .false. ; CS%Leith_Kh = .false. @@ -1403,13 +1411,10 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) CS%Modified_Leith = .false. CS%anisotropic = .false. CS%dynamic_aniso = .false. - Kh = 0.0 ; Ah = 0.0 - ! If GET_ALL_PARAMS is true, all parameters are read in all cases to enable ! parameter spelling checks. call get_param(param_file, mdl, "GET_ALL_PARAMS", get_all, default=.false.) - call get_param(param_file, mdl, "DEFAULT_2018_ANSWERS", default_2018_answers, & "This sets the default value for the various _2018_ANSWERS parameters.", & default=.true.) @@ -1417,9 +1422,7 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) "If true, use the order of arithmetic and expressions that recover the "//& "answers from the end of 2018. Otherwise, use updated and more robust "//& "forms of the same expressions.", default=default_2018_answers) - call get_param(param_file, mdl, "DEBUG", CS%debug, default=.false.) - call get_param(param_file, mdl, "LAPLACIAN", CS%Laplacian, & "If true, use a Laplacian horizontal viscosity.", & default=.false.) @@ -1445,7 +1448,6 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) "The power used to raise SIN(LAT) when using a latitudinally "//& "dependent background viscosity.", & units = "nondim", default=4.0) - call get_param(param_file, mdl, "SMAGORINSKY_KH", CS%Smagorinsky_Kh, & "If true, use a Smagorinsky nonlinear eddy viscosity.", & default=.false.) @@ -1454,11 +1456,9 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) "The nondimensional Laplacian Smagorinsky constant, "//& "often 0.15.", units="nondim", default=0.0, & fail_if_missing = CS%Smagorinsky_Kh) - call get_param(param_file, mdl, "LEITH_KH", CS%Leith_Kh, & "If true, use a Leith nonlinear eddy viscosity.", & default=.false.) - call get_param(param_file, mdl, "MODIFIED_LEITH", CS%Modified_Leith, & "If true, add a term to Leith viscosity which is "//& "proportional to the gradient of divergence.", & @@ -1466,7 +1466,6 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) call get_param(param_file, mdl, "RES_SCALE_MEKE_VISC", CS%res_scale_MEKE, & "If true, the viscosity contribution from MEKE is scaled by "//& "the resolution function.", default=.false.) - if (CS%Leith_Kh .or. get_all) then call get_param(param_file, mdl, "LEITH_LAP_CONST", Leith_Lap_const, & "The nondimensional Laplacian Leith constant, "//& @@ -1525,7 +1524,6 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) "to the spherical coordinates.", units = "nondim", fail_if_missing=.true.) end select endif - call get_param(param_file, mdl, "BIHARMONIC", CS%biharmonic, & "If true, use a biharmonic horizontal viscosity. "//& "BIHARMONIC may be used with LAPLACIAN.", & @@ -1552,7 +1550,6 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) call get_param(param_file, mdl, "LEITH_AH", CS%Leith_Ah, & "If true, use a biharmonic Leith nonlinear eddy "//& "viscosity.", default=.false.) - call get_param(param_file, mdl, "BOUND_AH", CS%bound_Ah, & "If true, the biharmonic coefficient is locally limited "//& "to be stable.", default=.true.) @@ -1560,13 +1557,16 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) "If true, the biharmonic coefficient is locally limited "//& "to be stable with a better bounding than just BOUND_AH.", & default=CS%bound_Ah) + call get_param(param_file, mdl, "RE_AH", CS%Re_Ah, & + "If nonzero, the biharmonic coefficient is scaled "//& + "so that the biharmonic Reynolds number is equal to this.", & + units="nondim", default=0.0) if (CS%Smagorinsky_Ah .or. get_all) then call get_param(param_file, mdl, "SMAG_BI_CONST",Smag_bi_const, & "The nondimensional biharmonic Smagorinsky constant, "//& "typically 0.015 - 0.06.", units="nondim", default=0.0, & fail_if_missing = CS%Smagorinsky_Ah) - call get_param(param_file, mdl, "BOUND_CORIOLIS", bound_Cor_def, default=.false.) call get_param(param_file, mdl, "BOUND_CORIOLIS_BIHARM", CS%bound_Coriolis, & "If true use a viscosity that increases with the square "//& @@ -1585,29 +1585,24 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) units="m s-1", default=maxvel, scale=US%m_s_to_L_T) endif endif - if (CS%Leith_Ah .or. get_all) & call get_param(param_file, mdl, "LEITH_BI_CONST", Leith_bi_const, & "The nondimensional biharmonic Leith constant, "//& "typical values are thus far undetermined.", units="nondim", default=0.0, & fail_if_missing = CS%Leith_Ah) - endif - call get_param(param_file, mdl, "USE_LAND_MASK_FOR_HVISC", CS%use_land_mask, & "If true, use Use the land mask for the computation of thicknesses "//& "at velocity locations. This eliminates the dependence on arbitrary "//& "values over land or outside of the domain. Default is False in order to "//& "maintain answers with legacy experiments but should be changed to True "//& "for new experiments.", default=.false.) - if (CS%better_bound_Ah .or. CS%better_bound_Kh .or. get_all) & call get_param(param_file, mdl, "HORVISC_BOUND_COEF", CS%bound_coef, & "The nondimensional coefficient of the ratio of the "//& "viscosity bounds to the theoretical maximum for "//& "stability without considering other terms.", units="nondim", & default=0.8) - call get_param(param_file, mdl, "NOSLIP", CS%no_slip, & "If true, no slip boundary conditions are used; otherwise "//& "free slip boundary conditions are assumed. The "//& @@ -1615,47 +1610,37 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) "cleaner than the no slip BCs. The use of free slip BCs "//& "is strongly encouraged, and no slip BCs are not used with "//& "the biharmonic viscosity.", default=.false.) - call get_param(param_file, mdl, "USE_KH_BG_2D", CS%use_Kh_bg_2d, & "If true, read a file containing 2-d background harmonic "//& "viscosities. The final viscosity is the maximum of the other "//& "terms and this background value.", default=.false.) - call get_param(param_file, mdl, "USE_GME", CS%use_GME, & "If true, use the GM+E backscatter scheme in association \n"//& "with the Gent and McWilliams parameterization.", default=.false.) - if (CS%use_GME) then call get_param(param_file, mdl, "SPLIT", split, & "Use the split time stepping if true.", default=.true., & do_not_log=.true.) if (.not. split) call MOM_error(FATAL,"ERROR: Currently, USE_GME = True "// & "cannot be used with SPLIT=False.") - call get_param(param_file, mdl, "GME_H0", CS%GME_h0, & "The strength of GME tapers quadratically to zero when the bathymetric "//& "depth is shallower than GME_H0.", units="m", scale=US%m_to_Z, & default=1000.0) - call get_param(param_file, mdl, "GME_EFFICIENCY", CS%GME_efficiency, & "The nondimensional prefactor multiplying the GME coefficient.", & units="nondim", default=1.0) - call get_param(param_file, mdl, "GME_LIMITER", CS%GME_limiter, & "The absolute maximum value the GME coefficient is allowed to take.", & units="m2 s-1", scale=US%m_to_L**2*US%T_to_s, default=1.0e7) - endif - if (CS%bound_Kh .or. CS%bound_Ah .or. CS%better_bound_Kh .or. CS%better_bound_Ah) & call get_param(param_file, mdl, "DT", dt, & "The (baroclinic) dynamics time step.", units="s", scale=US%s_to_T, & fail_if_missing=.true.) - if (CS%no_slip .and. CS%biharmonic) & call MOM_error(FATAL,"ERROR: NOSLIP and BIHARMONIC cannot be defined "// & "at the same time in MOM.") - if (.not.(CS%Laplacian .or. CS%biharmonic)) then ! Only issue inviscid warning if not in single column mode (usually 2x2 domain) if ( max(G%domain%niglobal, G%domain%njglobal)>2 ) call MOM_error(WARNING, & @@ -1663,9 +1648,7 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) "LAPLACIAN or BIHARMONIC viscosity.") return ! We are not using either Laplacian or Bi-harmonic lateral viscosity endif - deg2rad = atan(1.0) / 45. - ALLOC_(CS%dx2h(isd:ied,jsd:jed)) ; CS%dx2h(:,:) = 0.0 ALLOC_(CS%dy2h(isd:ied,jsd:jed)) ; CS%dy2h(:,:) = 0.0 ALLOC_(CS%dx2q(IsdB:IedB,JsdB:JedB)) ; CS%dx2q(:,:) = 0.0 @@ -1674,7 +1657,6 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) ALLOC_(CS%dy_dxT(isd:ied,jsd:jed)) ; CS%dy_dxT(:,:) = 0.0 ALLOC_(CS%dx_dyBu(IsdB:IedB,JsdB:JedB)) ; CS%dx_dyBu(:,:) = 0.0 ALLOC_(CS%dy_dxBu(IsdB:IedB,JsdB:JedB)) ; CS%dy_dxBu(:,:) = 0.0 - if (CS%Laplacian) then ALLOC_(CS%Kh_bg_xx(isd:ied,jsd:jed)) ; CS%Kh_bg_xx(:,:) = 0.0 ALLOC_(CS%Kh_bg_xy(IsdB:IedB,JsdB:JedB)) ; CS%Kh_bg_xy(:,:) = 0.0 @@ -1693,7 +1675,6 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) endif ALLOC_(CS%reduction_xx(isd:ied,jsd:jed)) ; CS%reduction_xx(:,:) = 0.0 ALLOC_(CS%reduction_xy(IsdB:IedB,JsdB:JedB)) ; CS%reduction_xy(:,:) = 0.0 - if (CS%anisotropic) then ALLOC_(CS%n1n2_h(isd:ied,jsd:jed)) ; CS%n1n2_h(:,:) = 0.0 ALLOC_(CS%n1n1_m_n2n2_h(isd:ied,jsd:jed)) ; CS%n1n1_m_n2n2_h(:,:) = 0.0 @@ -1711,7 +1692,6 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) "Runtime parameter ANISOTROPIC_MODE is out of range.") end select endif - if (CS%use_Kh_bg_2d) then ALLOC_(CS%Kh_bg_2d(isd:ied,jsd:jed)) ; CS%Kh_bg_2d(:,:) = 0.0 call get_param(param_file, mdl, "KH_BG_2D_FILENAME", filename, & @@ -1723,13 +1703,11 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) G%domain, timelevel=1, scale=US%m_to_L**2*US%T_to_s) call pass_var(CS%Kh_bg_2d, G%domain) endif - if (CS%biharmonic) then ALLOC_(CS%Idx2dyCu(IsdB:IedB,jsd:jed)) ; CS%Idx2dyCu(:,:) = 0.0 ALLOC_(CS%Idx2dyCv(isd:ied,JsdB:JedB)) ; CS%Idx2dyCv(:,:) = 0.0 ALLOC_(CS%Idxdy2u(IsdB:IedB,jsd:jed)) ; CS%Idxdy2u(:,:) = 0.0 ALLOC_(CS%Idxdy2v(isd:ied,JsdB:JedB)) ; CS%Idxdy2v(:,:) = 0.0 - ALLOC_(CS%Ah_bg_xx(isd:ied,jsd:jed)) ; CS%Ah_bg_xx(:,:) = 0.0 ALLOC_(CS%Ah_bg_xy(IsdB:IedB,JsdB:JedB)) ; CS%Ah_bg_xy(:,:) = 0.0 if (CS%bound_Ah .or. CS%better_bound_Ah) then @@ -1748,8 +1726,11 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) ALLOC_(CS%biharm5_const_xx(isd:ied,jsd:jed)) ; CS%biharm5_const_xx(:,:) = 0.0 ALLOC_(CS%biharm5_const_xy(IsdB:IedB,JsdB:JedB)) ; CS%biharm5_const_xy(:,:) = 0.0 endif + if (CS%Re_Ah > 0.0) then + ALLOC_(CS%Re_Ah_const_xx(isd:ied,jsd:jed)); CS%Re_Ah_const_xx(:,:) = 0.0 + ALLOC_(CS%Re_Ah_const_xy(IsdB:IedB,JsdB:JedB)); CS%Re_Ah_const_xy(:,:) = 0.0 + endif endif - do J=js-2,Jeq+1 ; do I=is-2,Ieq+1 CS%dx2q(I,J) = G%dxBu(I,J)*G%dxBu(I,J) ; CS%dy2q(I,J) = G%dyBu(I,J)*G%dyBu(I,J) CS%DX_dyBu(I,J) = G%dxBu(I,J)*G%IdyBu(I,J) ; CS%DY_dxBu(I,J) = G%dyBu(I,J)*G%IdxBu(I,J) @@ -1758,7 +1739,6 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) CS%dx2h(i,j) = G%dxT(i,j)*G%dxT(i,j) ; CS%dy2h(i,j) = G%dyT(i,j)*G%dyT(i,j) CS%DX_dyT(i,j) = G%dxT(i,j)*G%IdyT(i,j) ; CS%DY_dxT(i,j) = G%dyT(i,j)*G%IdxT(i,j) enddo ; enddo - do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 CS%reduction_xx(i,j) = 1.0 if ((G%dy_Cu(I,j) > 0.0) .and. (G%dy_Cu(I,j) < G%dyCu(I,j)) .and. & @@ -1774,7 +1754,6 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) (G%dx_Cv(i,J-1) < G%dxCv(i,J-1) * CS%reduction_xx(i,j))) & CS%reduction_xx(i,j) = G%dx_Cv(i,J-1) / (G%dxCv(i,J-1)) enddo ; enddo - do J=js-1,Jeq ; do I=is-1,Ieq CS%reduction_xy(I,J) = 1.0 if ((G%dy_Cu(I,j) > 0.0) .and. (G%dy_Cu(I,j) < G%dyCu(I,j)) .and. & @@ -1790,12 +1769,10 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) (G%dx_Cv(i+1,J) < G%dxCv(i+1,J) * CS%reduction_xy(I,J))) & CS%reduction_xy(I,J) = G%dx_Cv(i+1,J) / (G%dxCv(i+1,J)) enddo ; enddo - if (CS%Laplacian) then ! The 0.3 below was 0.4 in MOM1.10. The change in hq requires ! this to be less than 1/3, rather than 1/2 as before. if (CS%bound_Kh .or. CS%bound_Ah) Kh_Limit = 0.3 / (dt*4.0) - ! Calculate and store the background viscosity at h-points do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 ! Static factors in the Smagorinsky and Leith schemes @@ -1805,23 +1782,19 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) if (CS%Leith_Kh) CS%Laplac3_const_xx(i,j) = Leith_Lap_const * grid_sp_h3 ! Maximum of constant background and MICOM viscosity CS%Kh_bg_xx(i,j) = MAX(Kh, Kh_vel_scale * sqrt(grid_sp_h2)) - ! Use the larger of the above and values read from a file if (CS%use_Kh_bg_2d) CS%Kh_bg_xx(i,j) = MAX(CS%Kh_bg_2d(i,j), CS%Kh_bg_xx(i,j)) - ! Use the larger of the above and a function of sin(latitude) if (Kh_sin_lat>0.) then slat_fn = abs( sin( deg2rad * G%geoLatT(i,j) ) ) ** Kh_pwr_of_sine CS%Kh_bg_xx(i,j) = MAX(Kh_sin_lat * slat_fn, CS%Kh_bg_xx(i,j)) endif - if (CS%bound_Kh .and. .not.CS%better_bound_Kh) then ! Limit the background viscosity to be numerically stable CS%Kh_Max_xx(i,j) = Kh_Limit * grid_sp_h2 CS%Kh_bg_xx(i,j) = MIN(CS%Kh_bg_xx(i,j), CS%Kh_Max_xx(i,j)) endif enddo ; enddo - ! Calculate and store the background viscosity at q-points do J=js-1,Jeq ; do I=is-1,Ieq ! Static factors in the Smagorinsky and Leith schemes @@ -1831,17 +1804,14 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) if (CS%Leith_Kh) CS%Laplac3_const_xy(I,J) = Leith_Lap_const * grid_sp_q3 ! Maximum of constant background and MICOM viscosity CS%Kh_bg_xy(I,J) = MAX(Kh, Kh_vel_scale * sqrt(grid_sp_q2)) - ! Use the larger of the above and values read from a file !### This expression uses inconsistent staggering if (CS%use_Kh_bg_2d) CS%Kh_bg_xy(I,J) = MAX(CS%Kh_bg_2d(i,j), CS%Kh_bg_xy(I,J)) - ! Use the larger of the above and a function of sin(latitude) if (Kh_sin_lat>0.) then slat_fn = abs( sin( deg2rad * G%geoLatBu(I,J) ) ) ** Kh_pwr_of_sine CS%Kh_bg_xy(I,J) = MAX(Kh_sin_lat * slat_fn, CS%Kh_bg_xy(I,J)) endif - if (CS%bound_Kh .and. .not.CS%better_bound_Kh) then ! Limit the background viscosity to be numerically stable CS%Kh_Max_xy(I,J) = Kh_Limit * grid_sp_q2 @@ -1849,9 +1819,7 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) endif enddo ; enddo endif - if (CS%biharmonic) then - do j=js-1,Jeq+1 ; do I=Isq-1,Ieq+1 CS%Idx2dyCu(I,j) = (G%IdxCu(I,j)*G%IdxCu(I,j)) * G%IdyCu(I,j) CS%Idxdy2u(I,j) = G%IdxCu(I,j) * (G%IdyCu(I,j)*G%IdyCu(I,j)) @@ -1860,7 +1828,6 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) CS%Idx2dyCv(i,J) = (G%IdxCv(i,J)*G%IdxCv(i,J)) * G%IdyCv(i,J) CS%Idxdy2v(i,J) = G%IdxCv(i,J) * (G%IdyCv(i,J)*G%IdyCv(i,J)) enddo ; enddo - CS%Ah_bg_xy(:,:) = 0.0 ! The 0.3 below was 0.4 in MOM1.10. The change in hq requires ! this to be less than 1/3, rather than 1/2 as before. @@ -1870,7 +1837,6 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 grid_sp_h2 = (2.0*CS%dx2h(i,j)*CS%dy2h(i,j)) / (CS%dx2h(i,j)+CS%dy2h(i,j)) grid_sp_h3 = grid_sp_h2*sqrt(grid_sp_h2) - if (CS%Smagorinsky_Ah) then CS%Biharm_const_xx(i,j) = Smag_bi_const * (grid_sp_h2 * grid_sp_h2) if (CS%bound_Coriolis) then @@ -1884,6 +1850,7 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) CS%biharm5_const_xx(i,j) = Leith_bi_const * (grid_sp_h3 * grid_sp_h2) endif CS%Ah_bg_xx(i,j) = MAX(Ah, Ah_vel_scale * grid_sp_h2 * sqrt(grid_sp_h2)) + if (CS%Re_Ah > 0.0) CS%Re_Ah_const_xx(i,j) = grid_sp_h3 / CS%Re_Ah if (Ah_time_scale > 0.) CS%Ah_bg_xx(i,j) = & MAX(CS%Ah_bg_xx(i,j), (grid_sp_h2 * grid_sp_h2) / Ah_time_scale) if (CS%bound_Ah .and. .not.CS%better_bound_Ah) then @@ -1894,7 +1861,6 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) do J=js-1,Jeq ; do I=is-1,Ieq grid_sp_q2 = (2.0*CS%dx2q(I,J)*CS%dy2q(I,J)) / (CS%dx2q(I,J)+CS%dy2q(I,J)) grid_sp_q3 = grid_sp_q2*sqrt(grid_sp_q2) - if (CS%Smagorinsky_Ah) then CS%Biharm_const_xy(I,J) = Smag_bi_const * (grid_sp_q2 * grid_sp_q2) if (CS%bound_Coriolis) then @@ -1905,8 +1871,8 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) if (CS%Leith_Ah) then CS%biharm5_const_xy(i,j) = Leith_bi_const * (grid_sp_q3 * grid_sp_q2) endif - CS%Ah_bg_xy(I,J) = MAX(Ah, Ah_vel_scale * grid_sp_q2 * sqrt(grid_sp_q2)) + if (CS%Re_Ah > 0.0) CS%Re_Ah_const_xy(i,j) = grid_sp_q3 / CS%Re_Ah if (Ah_time_scale > 0.) CS%Ah_bg_xy(i,j) = & MAX(CS%Ah_bg_xy(i,j), (grid_sp_q2 * grid_sp_q2) / Ah_time_scale) if (CS%bound_Ah .and. .not.CS%better_bound_Ah) then @@ -1915,7 +1881,6 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) endif enddo ; enddo endif - ! The Laplacian bounds should avoid overshoots when CS%bound_coef < 1. if (CS%Laplacian .and. CS%better_bound_Kh) then Idt = 1.0 / dt @@ -1944,7 +1909,6 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) call Bchksum(CS%Kh_Max_xy, "Kh_Max_xy", G%HI, haloshift=0, scale=US%L_to_m**2*US%s_to_T) endif endif - ! The biharmonic bounds should avoid overshoots when CS%bound_coef < 0.5, but ! empirically work for CS%bound_coef <~ 1.0 if (CS%biharmonic .and. CS%better_bound_Ah) then @@ -1954,7 +1918,6 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) CS%dy2h(i,j) * CS%DY_dxT(i,j) * (G%IdyCu(I,j) + G%IdyCu(I-1,j)) ) + & CS%Idx2dyCu(I,j)*(CS%dx2q(I,J) * CS%DX_dyBu(I,J) * (G%IdxCu(I,j+1) + G%IdxCu(I,j)) + & CS%dx2q(I,J-1)*CS%DX_dyBu(I,J-1)*(G%IdxCu(I,j) + G%IdxCu(I,j-1)) ) ) - u0v(I,j) = (CS%Idxdy2u(I,j)*(CS%dy2h(i+1,j)*CS%DX_dyT(i+1,j)*(G%IdxCv(i+1,J) + G%IdxCv(i+1,J-1)) + & CS%dy2h(i,j) * CS%DX_dyT(i,j) * (G%IdxCv(i,J) + G%IdxCv(i,J-1)) ) + & CS%Idx2dyCu(I,j)*(CS%dx2q(I,J) * CS%DY_dxBu(I,J) * (G%IdyCv(i+1,J) + G%IdyCv(i,J)) + & @@ -1965,13 +1928,11 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) CS%dy2q(I-1,J)*CS%DX_dyBu(I-1,J)*(G%IdxCu(I-1,j+1) + G%IdxCu(I-1,j)) ) + & CS%Idx2dyCv(i,J)*(CS%dx2h(i,j+1)*CS%DY_dxT(i,j+1)*(G%IdyCu(I,j+1) + G%IdyCu(I-1,j+1)) + & CS%dx2h(i,j) * CS%DY_dxT(i,j) * (G%IdyCu(I,j) + G%IdyCu(I-1,j)) ) ) - v0v(i,J) = (CS%Idxdy2v(i,J)*(CS%dy2q(I,J) * CS%DY_dxBu(I,J) * (G%IdyCv(i+1,J) + G%IdyCv(i,J)) + & CS%dy2q(I-1,J)*CS%DY_dxBu(I-1,J)*(G%IdyCv(i,J) + G%IdyCv(i-1,J)) ) + & CS%Idx2dyCv(i,J)*(CS%dx2h(i,j+1)*CS%DX_dyT(i,j+1)*(G%IdxCv(i,J+1) + G%IdxCv(i,J)) + & CS%dx2h(i,j) * CS%DX_dyT(i,j) * (G%IdxCv(i,J) + G%IdxCv(i,J-1)) ) ) enddo ; enddo - do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 denom = max( & (CS%dy2h(i,j) * & @@ -1986,7 +1947,6 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) if (denom > 0.0) & CS%Ah_Max_xx(I,J) = CS%bound_coef * 0.5 * Idt / denom enddo ; enddo - do J=js-1,Jeq ; do I=is-1,Ieq denom = max( & (CS%dx2q(I,J) * & @@ -2006,74 +1966,56 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) call Bchksum(CS%Ah_Max_xy, "Ah_Max_xy", G%HI, haloshift=0, scale=US%L_to_m**4*US%s_to_T) endif endif - ! Register fields for output from this module. - CS%id_diffu = register_diag_field('ocean_model', 'diffu', diag%axesCuL, Time, & 'Zonal Acceleration from Horizontal Viscosity', 'm s-2', conversion=US%L_T2_to_m_s2) - CS%id_diffv = register_diag_field('ocean_model', 'diffv', diag%axesCvL, Time, & 'Meridional Acceleration from Horizontal Viscosity', 'm s-2', conversion=US%L_T2_to_m_s2) - if (CS%biharmonic) then CS%id_Ah_h = register_diag_field('ocean_model', 'Ahh', diag%axesTL, Time, & 'Biharmonic Horizontal Viscosity at h Points', 'm4 s-1', conversion=US%L_to_m**4*US%s_to_T, & cmor_field_name='difmxybo', & cmor_long_name='Ocean lateral biharmonic viscosity', & cmor_standard_name='ocean_momentum_xy_biharmonic_diffusivity') - CS%id_Ah_q = register_diag_field('ocean_model', 'Ahq', diag%axesBL, Time, & 'Biharmonic Horizontal Viscosity at q Points', 'm4 s-1', conversion=US%L_to_m**4*US%s_to_T) endif - if (CS%Laplacian) then CS%id_Kh_h = register_diag_field('ocean_model', 'Khh', diag%axesTL, Time, & 'Laplacian Horizontal Viscosity at h Points', 'm2 s-1', conversion=US%L_to_m**2*US%s_to_T, & cmor_field_name='difmxylo', & cmor_long_name='Ocean lateral Laplacian viscosity', & cmor_standard_name='ocean_momentum_xy_laplacian_diffusivity') - CS%id_Kh_q = register_diag_field('ocean_model', 'Khq', diag%axesBL, Time, & 'Laplacian Horizontal Viscosity at q Points', 'm2 s-1', conversion=US%L_to_m**2*US%s_to_T) - if (CS%Leith_Kh) then CS%id_vort_xy_q = register_diag_field('ocean_model', 'vort_xy_q', diag%axesBL, Time, & 'Vertical vorticity at q Points', 's-1', conversion=US%s_to_T) - CS%id_div_xx_h = register_diag_field('ocean_model', 'div_xx_h', diag%axesTL, Time, & 'Horizontal divergence at h Points', 's-1', conversion=US%s_to_T) endif - endif - if (CS%use_GME) then CS%id_GME_coeff_h = register_diag_field('ocean_model', 'GME_coeff_h', diag%axesTL, Time, & 'GME coefficient at h Points', 'm2 s-1', conversion=US%L_to_m**2*US%s_to_T) - CS%id_GME_coeff_q = register_diag_field('ocean_model', 'GME_coeff_q', diag%axesBL, Time, & 'GME coefficient at q Points', 'm2 s-1', conversion=US%L_to_m**2*US%s_to_T) - CS%id_FrictWork_GME = register_diag_field('ocean_model','FrictWork_GME',diag%axesTL,Time,& 'Integral work done by lateral friction terms in GME (excluding diffusion of energy)', & 'W m-2', conversion=US%R_to_kg_m3*US%Z_to_m*US%s_to_T**3*US%L_to_m**2) endif - CS%id_FrictWork = register_diag_field('ocean_model','FrictWork',diag%axesTL,Time,& 'Integral work done by lateral friction terms', & 'W m-2', conversion=US%R_to_kg_m3*US%Z_to_m*US%s_to_T**3*US%L_to_m**2) - CS%id_FrictWorkIntz = register_diag_field('ocean_model','FrictWorkIntz',diag%axesT1,Time, & 'Depth integrated work done by lateral friction', & 'W m-2', conversion=US%R_to_kg_m3*US%Z_to_m*US%s_to_T**3*US%L_to_m**2, & cmor_field_name='dispkexyfo', & cmor_long_name='Depth integrated ocean kinetic energy dissipation due to lateral friction',& cmor_standard_name='ocean_kinetic_energy_dissipation_per_unit_area_due_to_xy_friction') - if (CS%Laplacian .or. get_all) then endif - end subroutine hor_visc_init - !> Calculates factors in the anisotropic orientation tensor to be align with the grid. !! With n1=1 and n2=0, this recovers the approach of Large et al, 2001. subroutine align_aniso_tensor_to_grid(CS, n1, n2) @@ -2082,18 +2024,14 @@ subroutine align_aniso_tensor_to_grid(CS, n1, n2) real, intent(in) :: n2 !< j-component of direction vector [nondim] ! Local variables real :: recip_n2_norm - ! For normalizing n=(n1,n2) in case arguments are not a unit vector recip_n2_norm = n1**2 + n2**2 if (recip_n2_norm > 0.) recip_n2_norm = 1./recip_n2_norm - CS%n1n2_h(:,:) = 2. * ( n1 * n2 ) * recip_n2_norm CS%n1n2_q(:,:) = 2. * ( n1 * n2 ) * recip_n2_norm CS%n1n1_m_n2n2_h(:,:) = ( n1 * n1 - n2 * n2 ) * recip_n2_norm CS%n1n1_m_n2n2_q(:,:) = ( n1 * n1 - n2 * n2 ) * recip_n2_norm - end subroutine align_aniso_tensor_to_grid - !> Apply a 1-1-4-1-1 Laplacian filter one time on GME diffusive flux to reduce any !! horizontal two-grid-point noise subroutine smooth_GME(CS,G,GME_flux_h,GME_flux_q) @@ -2104,15 +2042,12 @@ subroutine smooth_GME(CS,G,GME_flux_h,GME_flux_q) !! at h points real, dimension(SZIB_(G),SZJB_(G)), optional, intent(inout) :: GME_flux_q!< GME diffusive flux !! at q points - ! local variables real, dimension(SZI_(G),SZJ_(G)) :: GME_flux_h_original real, dimension(SZIB_(G),SZJB_(G)) :: GME_flux_q_original real :: wc, ww, we, wn, ws ! averaging weights for smoothing integer :: i, j, k, s - do s=1,1 - ! Update halos if (present(GME_flux_h)) then call pass_var(GME_flux_h, G%Domain) @@ -2122,14 +2057,12 @@ subroutine smooth_GME(CS,G,GME_flux_h,GME_flux_q) do i = G%isc, G%iec ! skip land points if (G%mask2dT(i,j)==0.) cycle - ! compute weights ww = 0.125 * G%mask2dT(i-1,j) we = 0.125 * G%mask2dT(i+1,j) ws = 0.125 * G%mask2dT(i,j-1) wn = 0.125 * G%mask2dT(i,j+1) wc = 1.0 - (ww+we+wn+ws) - GME_flux_h(i,j) = wc * GME_flux_h_original(i,j) & + ww * GME_flux_h_original(i-1,j) & + we * GME_flux_h_original(i+1,j) & @@ -2137,7 +2070,6 @@ subroutine smooth_GME(CS,G,GME_flux_h,GME_flux_q) + wn * GME_flux_h_original(i,j+1) enddo; enddo endif - ! Update halos if (present(GME_flux_q)) then call pass_var(GME_flux_q, G%Domain, position=CORNER, complete=.true.) @@ -2147,14 +2079,12 @@ subroutine smooth_GME(CS,G,GME_flux_h,GME_flux_q) do I = G%IscB, G%IecB ! skip land points if (G%mask2dBu(I,J)==0.) cycle - ! compute weights ww = 0.125 * G%mask2dBu(I-1,J) we = 0.125 * G%mask2dBu(I+1,J) ws = 0.125 * G%mask2dBu(I,J-1) wn = 0.125 * G%mask2dBu(I,J+1) wc = 1.0 - (ww+we+wn+ws) - GME_flux_q(I,J) = wc * GME_flux_q_original(I,J) & + ww * GME_flux_q_original(I-1,J) & + we * GME_flux_q_original(I+1,J) & @@ -2162,22 +2092,17 @@ subroutine smooth_GME(CS,G,GME_flux_h,GME_flux_q) + wn * GME_flux_q_original(I,J+1) enddo; enddo endif - enddo ! s-loop - end subroutine smooth_GME - !> Deallocates any variables allocated in hor_visc_init. subroutine hor_visc_end(CS) type(hor_visc_CS), pointer :: CS !< The control structure returned by a !! previous call to hor_visc_init. - if (CS%Laplacian .or. CS%biharmonic) then DEALLOC_(CS%dx2h) ; DEALLOC_(CS%dx2q) ; DEALLOC_(CS%dy2h) ; DEALLOC_(CS%dy2q) DEALLOC_(CS%dx_dyT) ; DEALLOC_(CS%dy_dxT) ; DEALLOC_(CS%dx_dyBu) ; DEALLOC_(CS%dy_dxBu) DEALLOC_(CS%reduction_xx) ; DEALLOC_(CS%reduction_xy) endif - if (CS%Laplacian) then DEALLOC_(CS%Kh_bg_xx) ; DEALLOC_(CS%Kh_bg_xy) if (CS%bound_Kh) then @@ -2190,7 +2115,6 @@ subroutine hor_visc_end(CS) DEALLOC_(CS%Laplac3_const_xx) ; DEALLOC_(CS%Laplac3_const_xy) endif endif - if (CS%biharmonic) then DEALLOC_(CS%Idx2dyCu) ; DEALLOC_(CS%Idx2dyCv) DEALLOC_(CS%Idxdy2u) ; DEALLOC_(CS%Idxdy2v) @@ -2207,6 +2131,9 @@ subroutine hor_visc_end(CS) if (CS%Leith_Ah) then DEALLOC_(CS%Biharm_const_xx) ; DEALLOC_(CS%Biharm_const_xy) endif + if (CS%Re_Ah > 0.0) then + DEALLOC_(CS%Re_Ah_const_xx) ; DEALLOC_(CS%Re_Ah_const_xy) + endif endif if (CS%anisotropic) then DEALLOC_(CS%n1n2_h) @@ -2215,10 +2142,7 @@ subroutine hor_visc_end(CS) DEALLOC_(CS%n1n1_m_n2n2_q) endif deallocate(CS) - end subroutine hor_visc_end - - !> \namespace mom_hor_visc !! !! This module contains the subroutine horizontal_viscosity() that calculates the @@ -2519,5 +2443,4 @@ end subroutine hor_visc_end !! Smith, R.D., and McWilliams, J.C., 2003: Anisotropic horizontal viscosity for !! ocean models. Ocean Modelling, 5(2), 129-156. !! https://doi.org/10.1016/S1463-5003(02)00016-1 - end module MOM_hor_visc From 65f36d76866904f53fb9f73a498365bcd2806e8f Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Thu, 16 Apr 2020 10:40:02 -0600 Subject: [PATCH 09/53] Add diags for Lapl. and Bihar grid Reynolds #s grid_Re_Kh = (U sqtr(dx2))/Kh grid_Re_Kh = (U dx3)/Ah where dx2 is the harmonic mean of the squares of the grid [L2], and dx3 is the harmonic mean of the squares of the grid^(3/2) [L3] --- .../lateral/MOM_hor_visc.F90 | 33 +++++++++++++++++-- 1 file changed, 30 insertions(+), 3 deletions(-) diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index f3c593819a..1458706316 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -117,8 +117,9 @@ module MOM_hor_visc Kh_Max_xx, & !< The maximum permitted Laplacian viscosity [L2 T-1 ~> m2 s-1]. Ah_Max_xx, & !< The maximum permitted biharmonic viscosity [L4 T-1 ~> m4 s-1]. n1n2_h, & !< Factor n1*n2 in the anisotropic direction tensor at h-points - n1n1_m_n2n2_h !< Factor n1**2-n2**2 in the anisotropic direction tensor at h-points - + n1n1_m_n2n2_h, & !< Factor n1**2-n2**2 in the anisotropic direction tensor at h-points + grid_sp_h2, & !< Harmonic mean of the squares of the grid [L2 ~> m2] + grid_sp_h3 !< Harmonic mean of the squares of the grid^(3/2) [L3 ~> m3] real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEMB_PTR_) :: Kh_bg_xy !< The background Laplacian viscosity at q points [L2 T-1 ~> m2 s-1]. !! The actual viscosity may be the larger of this @@ -180,6 +181,7 @@ module MOM_hor_visc !>@{ !! Diagnostic id + integer :: id_grid_Re_Ah = -1, id_grid_Re_Kh = -1 integer :: id_diffu = -1, id_diffv = -1 integer :: id_Ah_h = -1, id_Ah_q = -1 integer :: id_Kh_h = -1, id_Kh_q = -1 @@ -304,9 +306,11 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, Kh_h, & ! Laplacian viscosity at thickness points [L2 T-1 ~> m2 s-1] max_diss_rate_h, & ! maximum possible energy dissipated by lateral friction [L2 T-3 ~> m2 s-3] FrictWork, & ! work done by MKE dissipation mechanisms [R L2 T-3 ~> W m-2] - FrictWork_GME, & ! work done by GME [R L2 T-3 ~> W m-2] + FrictWork_GME, & ! work done by GME [R L2 T-3 ~> W m-2] div_xx_h ! horizontal divergence [T-1 ~> s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & + grid_Re_Kh, & !< Grid Reynolds number for Laplacian horizontal viscosity at h points [nondim] + grid_Re_Ah, & !< Grid Reynolds number for Biharmonic horizontal viscosity at h points [nondim] GME_coeff_h !< GME coeff. at h-points [L2 T-1 ~> m2 s-1] real :: Ah ! biharmonic viscosity [L4 T-1 ~> m4 s-1] real :: Kh ! Laplacian viscosity [L2 T-1 ~> m2 s-1] @@ -842,6 +846,12 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, endif if ((CS%id_Kh_h>0) .or. find_FrictWork .or. CS%debug) Kh_h(i,j,k) = Kh + + if (CS%id_grid_Re_Kh>0) then + KE = 0.125*((u(I,j,k)+u(I-1,j,k))**2 + (v(i,J,k)+v(i,J-1,k))**2) + grid_Re_Kh(i,j,k) = (sqrt(KE) * sqrt(CS%grid_sp_h2(i,j)))/Kh + endif + if (CS%id_div_xx_h>0) div_xx_h(i,j,k) = div_xx(i,j) str_xx(i,j) = -Kh * sh_xx(i,j) @@ -890,6 +900,11 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, if ((CS%id_Ah_h>0) .or. find_FrictWork .or. CS%debug) Ah_h(i,j,k) = Ah + if (CS%id_grid_Re_Ah>0) then + KE = 0.125*((u(I,j,k)+u(I-1,j,k))**2 + (v(i,J,k)+v(i,J-1,k))**2) + grid_Re_Ah(i,j,k) = (sqrt(KE) * CS%grid_sp_h3(i,j))/Ah + endif + str_xx(i,j) = str_xx(i,j) + Ah * & (CS%DY_dxT(i,j) * (G%IdyCu(I,j)*Del2u(I,j) - G%IdyCu(I-1,j)*Del2u(I-1,j)) - & CS%DX_dyT(i,j) * (G%IdxCv(i,J)*Del2v(i,J) - G%IdxCv(i,J-1)*Del2v(i,J-1))) @@ -1295,10 +1310,12 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, if (CS%id_FrictWork>0) call post_data(CS%id_FrictWork, FrictWork, CS%diag) if (CS%id_FrictWork_GME>0) call post_data(CS%id_FrictWork_GME, FrictWork_GME, CS%diag) if (CS%id_Ah_h>0) call post_data(CS%id_Ah_h, Ah_h, CS%diag) + if (CS%id_grid_Re_Ah>0) call post_data(CS%id_grid_Re_Ah, grid_Re_Ah, CS%diag) if (CS%id_div_xx_h>0) call post_data(CS%id_div_xx_h, div_xx_h, CS%diag) if (CS%id_vort_xy_q>0) call post_data(CS%id_vort_xy_q, vort_xy_q, CS%diag) if (CS%id_Ah_q>0) call post_data(CS%id_Ah_q, Ah_q, CS%diag) if (CS%id_Kh_h>0) call post_data(CS%id_Kh_h, Kh_h, CS%diag) + if (CS%id_grid_Re_Kh>0) call post_data(CS%id_grid_Re_Kh, grid_Re_Kh, CS%diag) if (CS%id_Kh_q>0) call post_data(CS%id_Kh_q, Kh_q, CS%diag) if (CS%id_GME_coeff_h > 0) call post_data(CS%id_GME_coeff_h, GME_coeff_h, CS%diag) if (CS%id_GME_coeff_q > 0) call post_data(CS%id_GME_coeff_q, GME_coeff_q, CS%diag) @@ -1658,6 +1675,7 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) ALLOC_(CS%dx_dyBu(IsdB:IedB,JsdB:JedB)) ; CS%dx_dyBu(:,:) = 0.0 ALLOC_(CS%dy_dxBu(IsdB:IedB,JsdB:JedB)) ; CS%dy_dxBu(:,:) = 0.0 if (CS%Laplacian) then + ALLOC_(CS%grid_sp_h2(isd:ied,jsd:jed)) ; CS%grid_sp_h2(:,:) = 0.0 ALLOC_(CS%Kh_bg_xx(isd:ied,jsd:jed)) ; CS%Kh_bg_xx(:,:) = 0.0 ALLOC_(CS%Kh_bg_xy(IsdB:IedB,JsdB:JedB)) ; CS%Kh_bg_xy(:,:) = 0.0 if (CS%bound_Kh .or. CS%better_bound_Kh) then @@ -1710,6 +1728,7 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) ALLOC_(CS%Idxdy2v(isd:ied,JsdB:JedB)) ; CS%Idxdy2v(:,:) = 0.0 ALLOC_(CS%Ah_bg_xx(isd:ied,jsd:jed)) ; CS%Ah_bg_xx(:,:) = 0.0 ALLOC_(CS%Ah_bg_xy(IsdB:IedB,JsdB:JedB)) ; CS%Ah_bg_xy(:,:) = 0.0 + ALLOC_(CS%grid_sp_h3(IsdB:IedB,JsdB:JedB)); CS%grid_sp_h3(:,:) = 0.0 if (CS%bound_Ah .or. CS%better_bound_Ah) then ALLOC_(CS%Ah_Max_xx(isd:ied,jsd:jed)) ; CS%Ah_Max_xx(:,:) = 0.0 ALLOC_(CS%Ah_Max_xy(IsdB:IedB,JsdB:JedB)) ; CS%Ah_Max_xy(:,:) = 0.0 @@ -1777,6 +1796,7 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 ! Static factors in the Smagorinsky and Leith schemes grid_sp_h2 = (2.0*CS%dx2h(i,j)*CS%dy2h(i,j)) / (CS%dx2h(i,j) + CS%dy2h(i,j)) + CS%grid_sp_h2(i,j) = grid_sp_h2 grid_sp_h3 = grid_sp_h2*sqrt(grid_sp_h2) if (CS%Smagorinsky_Kh) CS%Laplac2_const_xx(i,j) = Smag_Lap_const * grid_sp_h2 if (CS%Leith_Kh) CS%Laplac3_const_xx(i,j) = Leith_Lap_const * grid_sp_h3 @@ -1837,6 +1857,7 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 grid_sp_h2 = (2.0*CS%dx2h(i,j)*CS%dy2h(i,j)) / (CS%dx2h(i,j)+CS%dy2h(i,j)) grid_sp_h3 = grid_sp_h2*sqrt(grid_sp_h2) + CS%grid_sp_h3(i,j) = grid_sp_h3 if (CS%Smagorinsky_Ah) then CS%Biharm_const_xx(i,j) = Smag_bi_const * (grid_sp_h2 * grid_sp_h2) if (CS%bound_Coriolis) then @@ -1979,6 +2000,8 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) cmor_standard_name='ocean_momentum_xy_biharmonic_diffusivity') CS%id_Ah_q = register_diag_field('ocean_model', 'Ahq', diag%axesBL, Time, & 'Biharmonic Horizontal Viscosity at q Points', 'm4 s-1', conversion=US%L_to_m**4*US%s_to_T) + CS%id_grid_Re_Ah = register_diag_field('ocean_model', 'grid_Re_Ah', diag%axesTL, Time, & + 'Grid Reynolds number for the Biharmonic horizontal viscosity at h points', 'nondim') endif if (CS%Laplacian) then CS%id_Kh_h = register_diag_field('ocean_model', 'Khh', diag%axesTL, Time, & @@ -1988,6 +2011,8 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) cmor_standard_name='ocean_momentum_xy_laplacian_diffusivity') CS%id_Kh_q = register_diag_field('ocean_model', 'Khq', diag%axesBL, Time, & 'Laplacian Horizontal Viscosity at q Points', 'm2 s-1', conversion=US%L_to_m**2*US%s_to_T) + CS%id_grid_Re_Kh = register_diag_field('ocean_model', 'grid_Re_Kh', diag%axesTL, Time, & + 'Grid Reynolds number for the Laplacian horizontal viscosity at h points', 'nondim') if (CS%Leith_Kh) then CS%id_vort_xy_q = register_diag_field('ocean_model', 'vort_xy_q', diag%axesBL, Time, & 'Vertical vorticity at q Points', 's-1', conversion=US%s_to_T) @@ -2105,6 +2130,7 @@ subroutine hor_visc_end(CS) endif if (CS%Laplacian) then DEALLOC_(CS%Kh_bg_xx) ; DEALLOC_(CS%Kh_bg_xy) + DEALLOC_(CS%grid_sp_h2) if (CS%bound_Kh) then DEALLOC_(CS%Kh_Max_xx) ; DEALLOC_(CS%Kh_Max_xy) endif @@ -2116,6 +2142,7 @@ subroutine hor_visc_end(CS) endif endif if (CS%biharmonic) then + DEALLOC_(CS%grid_sp_h3) DEALLOC_(CS%Idx2dyCu) ; DEALLOC_(CS%Idx2dyCv) DEALLOC_(CS%Idxdy2u) ; DEALLOC_(CS%Idxdy2v) DEALLOC_(CS%Ah_bg_xx) ; DEALLOC_(CS%Ah_bg_xy) From 49ab54ab5a6491728dd0b6b60ac58e6e87739e92 Mon Sep 17 00:00:00 2001 From: alperaltuntas Date: Fri, 17 Apr 2020 08:21:24 -0600 Subject: [PATCH 10/53] move pass_var in KPP smoothing outside the do-loop --- src/parameterizations/vertical/MOM_CVMix_KPP.F90 | 11 ++++++++--- 1 file changed, 8 insertions(+), 3 deletions(-) diff --git a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 index 6056dd3eab..8151511bbf 100644 --- a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 @@ -225,6 +225,11 @@ logical function KPP_init(paramFile, G, GV, US, diag, Time, CS, passive, Waves) 'The number of times the 1-1-4-1-1 Laplacian filter is applied on '// & 'OBL depth.', & default=0) + if ((CS%n_smooth > G%domain%nihalo) then + call MOM_error(FATAL,'KPP smoothing number (N_SMOOTH) cannot be greater than NIHALO.') + elseif ((CS%n_smooth > G%domain%njhalo) then + call MOM_error(FATAL,'KPP smoothing number (N_SMOOTH) cannot be greater than NJHALO.') + endif if (CS%n_smooth > 0) then call get_param(paramFile, mdl, 'DEEPEN_ONLY_VIA_SMOOTHING', CS%deepen_only, & 'If true, apply OBLdepth smoothing at a cell only if the OBLdepth '// & @@ -1362,10 +1367,10 @@ subroutine KPP_smooth_BLD(CS,G,GV,h) real :: pref integer :: i, j, k, s - do s=1,CS%n_smooth + ! Update halos + call pass_var(CS%OBLdepth, G%Domain, halo=CS%n_smooth) - ! Update halos - call pass_var(CS%OBLdepth, G%Domain) + do s=1,CS%n_smooth OBLdepth_original = CS%OBLdepth if (CS%id_OBLdepth_original > 0) CS%OBLdepth_original = OBLdepth_original From b609dead273f162d47f4d80d4062d56e59fb4232 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Fri, 17 Apr 2020 16:41:09 -0600 Subject: [PATCH 11/53] Fix indices in KE calculation Hoping this will fix the floating point exception in symmetric mode. --- src/parameterizations/lateral/MOM_hor_visc.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index 1458706316..e18b626c37 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -1073,7 +1073,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, endif if (CS%Re_Ah > 0.0) then - KE = 0.125*((u(I,j,k)+u(I,j+1,k))**2 + (v(i,J,k)+v(i+1,J,k))**2) + KE = 0.125*((u(I,j,k)+u(I-1,j,k))**2 + (v(i,J,k)+v(i,J-1,k))**2) Ah = sqrt(KE) * CS%Re_Ah_const_xy(i,j) endif From 3fb86e3ed4f7bf1eae44a1c6bb2564ad65c8ad66 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Tue, 21 Apr 2020 12:18:34 -0600 Subject: [PATCH 12/53] Avoid division by zero This PR add two hard-coded parameters (AH_min and KH_min) to avoid dividing by zero when computing the Biharmonic and Laplacian grid Reynolds numbers, respectively. It also fixed the size of an array used in the Biharmonic Re calculation. --- src/parameterizations/lateral/MOM_hor_visc.F90 | 11 ++++++++--- 1 file changed, 8 insertions(+), 3 deletions(-) diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index e18b626c37..de00aa4a96 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -348,6 +348,11 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, ! calculation gives the same value as if f were 0 [nondim]. real :: H0_GME ! Depth used to scale down GME coefficient in shallow areas [Z ~> m] real :: KE ! Local kinetic energy [L2 T-2 ~> m2 s-2] + real, parameter :: KH_min = 1.E-30 ! This is the minimun horizontal Laplacian viscosity used to estimate the + ! grid Raynolds number [L2 T-1 ~> m2 s-1] + real, parameter :: AH_min = 1.E-30 ! This is the minimun horizontal Biharmonic viscosity used to estimate the + ! grid Raynolds number [L4 T-1 ~> m4 s-1] + logical :: rescale_Kh, legacy_bound logical :: find_FrictWork logical :: apply_OBC = .false. @@ -849,7 +854,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, if (CS%id_grid_Re_Kh>0) then KE = 0.125*((u(I,j,k)+u(I-1,j,k))**2 + (v(i,J,k)+v(i,J-1,k))**2) - grid_Re_Kh(i,j,k) = (sqrt(KE) * sqrt(CS%grid_sp_h2(i,j)))/Kh + grid_Re_Kh(i,j,k) = (sqrt(KE) * sqrt(CS%grid_sp_h2(i,j)))/MAX(Kh,KH_min) endif if (CS%id_div_xx_h>0) div_xx_h(i,j,k) = div_xx(i,j) @@ -902,7 +907,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, if (CS%id_grid_Re_Ah>0) then KE = 0.125*((u(I,j,k)+u(I-1,j,k))**2 + (v(i,J,k)+v(i,J-1,k))**2) - grid_Re_Ah(i,j,k) = (sqrt(KE) * CS%grid_sp_h3(i,j))/Ah + grid_Re_Ah(i,j,k) = (sqrt(KE) * CS%grid_sp_h3(i,j))/MAX(Ah,AH_min) endif str_xx(i,j) = str_xx(i,j) + Ah * & @@ -1728,7 +1733,7 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) ALLOC_(CS%Idxdy2v(isd:ied,JsdB:JedB)) ; CS%Idxdy2v(:,:) = 0.0 ALLOC_(CS%Ah_bg_xx(isd:ied,jsd:jed)) ; CS%Ah_bg_xx(:,:) = 0.0 ALLOC_(CS%Ah_bg_xy(IsdB:IedB,JsdB:JedB)) ; CS%Ah_bg_xy(:,:) = 0.0 - ALLOC_(CS%grid_sp_h3(IsdB:IedB,JsdB:JedB)); CS%grid_sp_h3(:,:) = 0.0 + ALLOC_(CS%grid_sp_h3(isd:ied,jsd:jed)) ; CS%grid_sp_h3(:,:) = 0.0 if (CS%bound_Ah .or. CS%better_bound_Ah) then ALLOC_(CS%Ah_Max_xx(isd:ied,jsd:jed)) ; CS%Ah_Max_xx(:,:) = 0.0 ALLOC_(CS%Ah_Max_xy(IsdB:IedB,JsdB:JedB)) ; CS%Ah_Max_xy(:,:) = 0.0 From e955c6d9ad0f9f1b6cc6555b5443a0ce0a49c60a Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Tue, 21 Apr 2020 14:13:44 -0600 Subject: [PATCH 13/53] Fix openmp directives --- src/parameterizations/lateral/MOM_hor_visc.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index de00aa4a96..19e0586bfd 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -478,12 +478,12 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, !$OMP is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz, & !$OMP apply_OBC, rescale_Kh, legacy_bound, find_FrictWork, & !$OMP use_MEKE_Ku, use_MEKE_Au, boundary_mask_h, boundary_mask_q, & - !$OMP backscat_subround, GME_coeff_limiter, & + !$OMP backscat_subround, GME_coeff_limiter, KH_min, AH_min, & !$OMP h_neglect, h_neglect3, FWfrac, inv_PI3, inv_PI5, H0_GME, & !$OMP diffu, diffv, max_diss_rate_h, max_diss_rate_q, & !$OMP Kh_h, Kh_q, Ah_h, Ah_q, FrictWork, FrictWork_GME, & !$OMP div_xx_h, vort_xy_q, GME_coeff_h, GME_coeff_q, & - !$OMP TD, KH_u_GME, KH_v_GME & + !$OMP TD, KH_u_GME, KH_v_GME, grid_Re_Kh, grid_Re_Ah, & !$OMP ) & !$OMP private( & !$OMP i, j, k, n, & @@ -497,7 +497,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, !$OMP grad_vel_mag_bt_h, grad_vel_mag_bt_q, grad_d2vel_mag_h, & !$OMP meke_res_fn, Shear_mag, vert_vort_mag, hrat_min, visc_bound_rem, & !$OMP Kh, Ah, AhSm, AhLth, local_strain, Sh_F_pow, & - !$OMP dDel2vdx, dDel2udy, & + !$OMP dDel2vdx, dDel2udy, KE, & !$OMP h2uq, h2vq, hu, hv, hq, FatH, RoScl, GME_coeff & !$OMP ) do k=1,nz From e3cbcbbd0dd2a213c8bf15f6a0067591772034ae Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Tue, 21 Apr 2020 14:13:44 -0600 Subject: [PATCH 14/53] Fix openmp directives --- src/parameterizations/lateral/MOM_hor_visc.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index de00aa4a96..7f5e63394f 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -483,7 +483,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, !$OMP diffu, diffv, max_diss_rate_h, max_diss_rate_q, & !$OMP Kh_h, Kh_q, Ah_h, Ah_q, FrictWork, FrictWork_GME, & !$OMP div_xx_h, vort_xy_q, GME_coeff_h, GME_coeff_q, & - !$OMP TD, KH_u_GME, KH_v_GME & + !$OMP TD, KH_u_GME, KH_v_GME, grid_Re_Kh, grid_Re_Ah & !$OMP ) & !$OMP private( & !$OMP i, j, k, n, & @@ -497,7 +497,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, !$OMP grad_vel_mag_bt_h, grad_vel_mag_bt_q, grad_d2vel_mag_h, & !$OMP meke_res_fn, Shear_mag, vert_vort_mag, hrat_min, visc_bound_rem, & !$OMP Kh, Ah, AhSm, AhLth, local_strain, Sh_F_pow, & - !$OMP dDel2vdx, dDel2udy, & + !$OMP dDel2vdx, dDel2udy, KE, & !$OMP h2uq, h2vq, hu, hv, hq, FatH, RoScl, GME_coeff & !$OMP ) do k=1,nz From 1e7fa519b1004af16ab8cf417a0b4ef650899f74 Mon Sep 17 00:00:00 2001 From: alperaltuntas Date: Tue, 21 Apr 2020 21:41:37 -0600 Subject: [PATCH 15/53] add KPP timing clocks and omp directives --- .../vertical/MOM_CVMix_KPP.F90 | 31 +++++++++++++++++-- 1 file changed, 29 insertions(+), 2 deletions(-) diff --git a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 index 8151511bbf..b17d91ff8d 100644 --- a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 @@ -16,6 +16,8 @@ module MOM_CVMix_KPP use MOM_verticalGrid, only : verticalGrid_type use MOM_wave_interface, only : wave_parameters_CS, Get_Langmuir_Number use MOM_domains, only : pass_var +use MOM_cpu_clock, only : cpu_clock_id, cpu_clock_begin, cpu_clock_end +use MOM_cpu_clock, only : CLOCK_MODULE, CLOCK_ROUTINE use CVMix_kpp, only : CVMix_init_kpp, CVMix_put_kpp, CVMix_get_kpp_real use CVMix_kpp, only : CVMix_coeffs_kpp @@ -168,6 +170,10 @@ module MOM_CVMix_KPP end type KPP_CS +!>@{ CPU time clocks +integer :: id_clock_KPP_calc, id_clock_KPP_compute_BLD, id_clock_KPP_smoothing +!!@} + #define __DO_SAFETY_CHECKS__ contains @@ -225,9 +231,9 @@ logical function KPP_init(paramFile, G, GV, US, diag, Time, CS, passive, Waves) 'The number of times the 1-1-4-1-1 Laplacian filter is applied on '// & 'OBL depth.', & default=0) - if ((CS%n_smooth > G%domain%nihalo) then + if (CS%n_smooth > G%domain%nihalo) then call MOM_error(FATAL,'KPP smoothing number (N_SMOOTH) cannot be greater than NIHALO.') - elseif ((CS%n_smooth > G%domain%njhalo) then + elseif (CS%n_smooth > G%domain%njhalo) then call MOM_error(FATAL,'KPP smoothing number (N_SMOOTH) cannot be greater than NJHALO.') endif if (CS%n_smooth > 0) then @@ -235,6 +241,7 @@ logical function KPP_init(paramFile, G, GV, US, diag, Time, CS, passive, Waves) 'If true, apply OBLdepth smoothing at a cell only if the OBLdepth '// & 'gets deeper via smoothing.', & default=.false.) + id_clock_KPP_smoothing = cpu_clock_id('Ocean KPP BLD smoothing)', grain=CLOCK_ROUTINE) endif call get_param(paramFile, mdl, 'RI_CRIT', CS%Ri_crit, & 'Critical bulk Richardson number used to define depth of the '// & @@ -582,6 +589,8 @@ logical function KPP_init(paramFile, G, GV, US, diag, Time, CS, passive, Waves) if (CS%id_EnhK > 0) allocate( CS%EnhK( SZI_(G), SZJ_(G), SZK_(G)+1 ) ) if (CS%id_EnhK > 0) CS%EnhK(:,:,:) = 0. + id_clock_KPP_calc = cpu_clock_id('Ocean KPP calculate)', grain=CLOCK_MODULE) + id_clock_KPP_compute_BLD = cpu_clock_id('Ocean KPP comp BLD)', grain=CLOCK_ROUTINE) end function KPP_init @@ -643,6 +652,7 @@ subroutine KPP_calculate(CS, G, GV, US, h, uStar, & if (CS%id_Kd_in > 0) call post_data(CS%id_Kd_in, Kt, CS%diag) + call cpu_clock_begin(id_clock_KPP_calc) buoy_scale = US%L_to_m**2*US%s_to_T**3 !$OMP parallel do default(none) firstprivate(nonLocalTrans) & @@ -863,6 +873,7 @@ subroutine KPP_calculate(CS, G, GV, US, h, uStar, & enddo ! i enddo ! j + call cpu_clock_end(id_clock_KPP_calc) #ifdef __DO_SAFETY_CHECKS__ if (CS%debug) then @@ -962,6 +973,8 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, EOS, uStar, buoyF endif #endif + !call cpu_clock_begin(id_clock_KPP_compute_BLD) + ! some constants GoRho = GV%mks_g_Earth / (US%R_to_kg_m3*GV%Rho0) buoy_scale = US%L_to_m**2*US%s_to_T**3 @@ -1327,6 +1340,8 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, EOS, uStar, buoyF enddo enddo + !call cpu_clock_end(id_clock_KPP_compute_BLD) + ! send diagnostics to post_data if (CS%id_BulkRi > 0) call post_data(CS%id_BulkRi, CS%BulkRi, CS%diag) if (CS%id_N > 0) call post_data(CS%id_N, CS%N, CS%diag) @@ -1367,15 +1382,20 @@ subroutine KPP_smooth_BLD(CS,G,GV,h) real :: pref integer :: i, j, k, s + !call cpu_clock_begin(id_clock_KPP_smoothing) + ! Update halos call pass_var(CS%OBLdepth, G%Domain, halo=CS%n_smooth) + do s=1,CS%n_smooth OBLdepth_original = CS%OBLdepth if (CS%id_OBLdepth_original > 0) CS%OBLdepth_original = OBLdepth_original ! apply smoothing on OBL depth + !$OMP parallel do default(none) shared(G, GV, CS, h, OBLdepth_original) & + !$OMP private(wc, ww, we, wn, ws, dh, hcorr, pref, cellHeight, iFaceHeight) do j = G%jsc, G%jec do i = G%isc, G%iec @@ -1420,6 +1440,8 @@ subroutine KPP_smooth_BLD(CS,G,GV,h) enddo ! s-loop + !call cpu_clock_end(id_clock_KPP_smoothing) + end subroutine KPP_smooth_BLD @@ -1432,6 +1454,7 @@ subroutine KPP_get_BLD(CS, BLD, G) real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: BLD!< bnd. layer depth [m] ! Local variables integer :: i,j + !$OMP parallel do default(none) shared(BLD, CS, G) do j = G%jsc, G%jec ; do i = G%isc, G%iec BLD(i,j) = CS%OBLdepth(i,j) enddo ; enddo @@ -1469,6 +1492,7 @@ subroutine KPP_NonLocalTransport_temp(CS, G, GV, h, nonLocalTrans, surfFlux, & ! Update tracer due to non-local redistribution of surface flux if (CS%applyNonLocalTrans) then + !$OMP parallel do default(none) shared(dt, scalar, dtracer, G) do k = 1, G%ke do j = G%jsc, G%jec do i = G%isc, G%iec @@ -1483,6 +1507,7 @@ subroutine KPP_NonLocalTransport_temp(CS, G, GV, h, nonLocalTrans, surfFlux, & if (CS%id_NLT_dTdt > 0) call post_data(CS%id_NLT_dTdt, dtracer, CS%diag) if (CS%id_NLT_temp_budget > 0) then dtracer(:,:,:) = 0.0 + !$OMP parallel do default(none) shared(dtracer, nonLocalTrans, surfFlux, C_p, G, GV) do k = 1, G%ke do j = G%jsc, G%jec do i = G%isc, G%iec @@ -1528,6 +1553,7 @@ subroutine KPP_NonLocalTransport_saln(CS, G, GV, h, nonLocalTrans, surfFlux, dt, ! Update tracer due to non-local redistribution of surface flux if (CS%applyNonLocalTrans) then + !$OMP parallel do default(none) shared(G, dt, scalar, dtracer) do k = 1, G%ke do j = G%jsc, G%jec do i = G%isc, G%iec @@ -1542,6 +1568,7 @@ subroutine KPP_NonLocalTransport_saln(CS, G, GV, h, nonLocalTrans, surfFlux, dt, if (CS%id_NLT_dSdt > 0) call post_data(CS%id_NLT_dSdt, dtracer, CS%diag) if (CS%id_NLT_saln_budget > 0) then dtracer(:,:,:) = 0.0 + !$OMP parallel do default(none) shared(G, GV, dtracer, nonLocalTrans, surfFlux) do k = 1, G%ke do j = G%jsc, G%jec do i = G%isc, G%iec From e5fcc694d57cacd19229210a18960d28427f581b Mon Sep 17 00:00:00 2001 From: alperaltuntas Date: Wed, 22 Apr 2020 10:30:42 -0600 Subject: [PATCH 16/53] remove OMP enclosing get_BLD call --- src/parameterizations/vertical/MOM_CVMix_KPP.F90 | 4 ++-- src/parameterizations/vertical/MOM_diabatic_driver.F90 | 2 -- 2 files changed, 2 insertions(+), 4 deletions(-) diff --git a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 index b17d91ff8d..c155bf56c7 100644 --- a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 @@ -241,7 +241,7 @@ logical function KPP_init(paramFile, G, GV, US, diag, Time, CS, passive, Waves) 'If true, apply OBLdepth smoothing at a cell only if the OBLdepth '// & 'gets deeper via smoothing.', & default=.false.) - id_clock_KPP_smoothing = cpu_clock_id('Ocean KPP BLD smoothing)', grain=CLOCK_ROUTINE) + id_clock_KPP_smoothing = cpu_clock_id('(Ocean KPP BLD smoothing)', grain=CLOCK_ROUTINE) endif call get_param(paramFile, mdl, 'RI_CRIT', CS%Ri_crit, & 'Critical bulk Richardson number used to define depth of the '// & @@ -590,7 +590,7 @@ logical function KPP_init(paramFile, G, GV, US, diag, Time, CS, passive, Waves) if (CS%id_EnhK > 0) CS%EnhK(:,:,:) = 0. id_clock_KPP_calc = cpu_clock_id('Ocean KPP calculate)', grain=CLOCK_MODULE) - id_clock_KPP_compute_BLD = cpu_clock_id('Ocean KPP comp BLD)', grain=CLOCK_ROUTINE) + id_clock_KPP_compute_BLD = cpu_clock_id('(Ocean KPP comp BLD)', grain=CLOCK_ROUTINE) end function KPP_init diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 38cecf0425..369852ce23 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -1448,9 +1448,7 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, Kd_salt, visc%Kv_shear, CS%KPP_NLTheat, CS%KPP_NLTscalar, Waves=Waves) if (associated(Hml)) then - !$OMP parallel default(shared) call KPP_get_BLD(CS%KPP_CSp, Hml(:,:), G) - !$OMP end parallel call pass_var(Hml, G%domain, halo=1) ! If visc%MLD exists, copy KPP's BLD into it if (associated(visc%MLD)) visc%MLD(:,:) = Hml(:,:) From e47e8b712c8dde2abbeb89d58f2fe12bde29c303 Mon Sep 17 00:00:00 2001 From: alperaltuntas Date: Wed, 22 Apr 2020 11:05:40 -0600 Subject: [PATCH 17/53] uncomment KPP clocks --- src/parameterizations/vertical/MOM_CVMix_KPP.F90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 index c155bf56c7..bcf2037c12 100644 --- a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 @@ -973,7 +973,7 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, EOS, uStar, buoyF endif #endif - !call cpu_clock_begin(id_clock_KPP_compute_BLD) + call cpu_clock_begin(id_clock_KPP_compute_BLD) ! some constants GoRho = GV%mks_g_Earth / (US%R_to_kg_m3*GV%Rho0) @@ -1340,7 +1340,7 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, EOS, uStar, buoyF enddo enddo - !call cpu_clock_end(id_clock_KPP_compute_BLD) + call cpu_clock_end(id_clock_KPP_compute_BLD) ! send diagnostics to post_data if (CS%id_BulkRi > 0) call post_data(CS%id_BulkRi, CS%BulkRi, CS%diag) @@ -1382,7 +1382,7 @@ subroutine KPP_smooth_BLD(CS,G,GV,h) real :: pref integer :: i, j, k, s - !call cpu_clock_begin(id_clock_KPP_smoothing) + call cpu_clock_begin(id_clock_KPP_smoothing) ! Update halos call pass_var(CS%OBLdepth, G%Domain, halo=CS%n_smooth) @@ -1440,7 +1440,7 @@ subroutine KPP_smooth_BLD(CS,G,GV,h) enddo ! s-loop - !call cpu_clock_end(id_clock_KPP_smoothing) + call cpu_clock_end(id_clock_KPP_smoothing) end subroutine KPP_smooth_BLD From 1165a61ba18b01967dc90f28cfc3428aa4e9bd7f Mon Sep 17 00:00:00 2001 From: alperaltuntas Date: Wed, 22 Apr 2020 15:11:17 -0600 Subject: [PATCH 18/53] further refactor smoothing subroutine --- .../vertical/MOM_CVMix_KPP.F90 | 20 +++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 index bcf2037c12..38a7bff4df 100644 --- a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 @@ -1371,7 +1371,7 @@ subroutine KPP_smooth_BLD(CS,G,GV,h) real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer/level thicknesses [H ~> m or kg m-2] ! local - real, dimension(SZI_(G),SZJ_(G)) :: OBLdepth_original ! Original OBL depths computed by CVMix + real, dimension(SZI_(G),SZJ_(G)) :: OBLdepth_prev ! OBLdepth before s.th smoothing iteration real, dimension( G%ke ) :: cellHeight ! Cell center heights referenced to surface [m] ! (negative in the ocean) real, dimension( G%ke+1 ) :: iFaceHeight ! Interface heights referenced to surface [m] @@ -1387,14 +1387,14 @@ subroutine KPP_smooth_BLD(CS,G,GV,h) ! Update halos call pass_var(CS%OBLdepth, G%Domain, halo=CS%n_smooth) + if (CS%id_OBLdepth_original > 0) CS%OBLdepth_original = CS%OBLdepth do s=1,CS%n_smooth - OBLdepth_original = CS%OBLdepth - if (CS%id_OBLdepth_original > 0) CS%OBLdepth_original = OBLdepth_original + OBLdepth_prev = CS%OBLdepth ! apply smoothing on OBL depth - !$OMP parallel do default(none) shared(G, GV, CS, h, OBLdepth_original) & + !$OMP parallel do default(none) shared(G, GV, CS, h, OBLdepth_prev) & !$OMP private(wc, ww, we, wn, ws, dh, hcorr, pref, cellHeight, iFaceHeight) do j = G%jsc, G%jec do i = G%isc, G%iec @@ -1423,14 +1423,14 @@ subroutine KPP_smooth_BLD(CS,G,GV,h) wn = 0.125 * G%mask2dT(i,j+1) wc = 1.0 - (ww+we+wn+ws) - CS%OBLdepth(i,j) = wc * OBLdepth_original(i,j) & - + ww * OBLdepth_original(i-1,j) & - + we * OBLdepth_original(i+1,j) & - + ws * OBLdepth_original(i,j-1) & - + wn * OBLdepth_original(i,j+1) + CS%OBLdepth(i,j) = wc * OBLdepth_prev(i,j) & + + ww * OBLdepth_prev(i-1,j) & + + we * OBLdepth_prev(i+1,j) & + + ws * OBLdepth_prev(i,j-1) & + + wn * OBLdepth_prev(i,j+1) ! Apply OBLdepth smoothing at a cell only if the OBLdepth gets deeper via smoothing. - if (CS%deepen_only) CS%OBLdepth(i,j) = max(CS%OBLdepth(i,j),CS%OBLdepth_original(i,j)) + if (CS%deepen_only) CS%OBLdepth(i,j) = max(CS%OBLdepth(i,j), OBLdepth_prev(i,j)) ! prevent OBL depths deeper than the bathymetric depth CS%OBLdepth(i,j) = min( CS%OBLdepth(i,j), -iFaceHeight(G%ke+1) ) ! no deeper than bottom From 98f5a8d97637d71c075a9f3f0b2ab1009f3836bd Mon Sep 17 00:00:00 2001 From: alperaltuntas Date: Wed, 22 Apr 2020 22:44:35 -0600 Subject: [PATCH 19/53] add omp directives to int_density_dz_generic_plm --- src/equation_of_state/MOM_EOS.F90 | 292 +++++++++++++++--------------- 1 file changed, 151 insertions(+), 141 deletions(-) diff --git a/src/equation_of_state/MOM_EOS.F90 b/src/equation_of_state/MOM_EOS.F90 index 5d3d33534b..c26317d3a9 100644 --- a/src/equation_of_state/MOM_EOS.F90 +++ b/src/equation_of_state/MOM_EOS.F90 @@ -1270,6 +1270,8 @@ subroutine int_density_dz_generic_plm (T_t, T_b, S_t, S_b, z_t, z_b, rho_ref, & ! ============================= ! 1. Compute vertical integrals ! ============================= + + !$OMP parallel do default(shared) private(jin,iin,dz,p5,S5,T5,r5,rho_anom) do j=Jsq,Jeq+1 jin = j+joff do i = Isq,Ieq+1 ; iin = i+ioff @@ -1300,163 +1302,171 @@ subroutine int_density_dz_generic_plm (T_t, T_b, S_t, S_b, z_t, z_b, rho_ref, & ! ================================================== ! 2. Compute horizontal integrals in the x direction ! ================================================== - if (present(intx_dpa)) then ; do j=HIO%jsc,HIO%jec ; jin = j+joff - do I=Isq,Ieq ; iin = i+ioff - ! Corner values of T and S - ! hWght is the distance measure by which the cell is violation of - ! hydrostatic consistency. For large hWght we bias the interpolation - ! of T,S along the top and bottom integrals, almost like thickness - ! weighting. - ! Note: To work in terrain following coordinates we could offset - ! this distance by the layer thickness to replicate other models. - hWght = massWeightToggle * & - max(0., -bathyT(iin,jin)-z_t(iin+1,jin), -bathyT(iin+1,jin)-z_t(iin,jin)) - if (hWght > 0.) then - hL = (z_t(iin,jin) - z_b(iin,jin)) + dz_subroundoff - hR = (z_t(iin+1,jin) - z_b(iin+1,jin)) + dz_subroundoff - hWght = hWght * ( (hL-hR)/(hL+hR) )**2 - iDenom = 1./( hWght*(hR + hL) + hL*hR ) - Ttl = ( (hWght*hR)*T_t(iin+1,jin) + (hWght*hL + hR*hL)*T_t(iin,jin) ) * iDenom - Ttr = ( (hWght*hL)*T_t(iin,jin) + (hWght*hR + hR*hL)*T_t(iin+1,jin) ) * iDenom - Tbl = ( (hWght*hR)*T_b(iin+1,jin) + (hWght*hL + hR*hL)*T_b(iin,jin) ) * iDenom - Tbr = ( (hWght*hL)*T_b(iin,jin) + (hWght*hR + hR*hL)*T_b(iin+1,jin) ) * iDenom - Stl = ( (hWght*hR)*S_t(iin+1,jin) + (hWght*hL + hR*hL)*S_t(iin,jin) ) * iDenom - Str = ( (hWght*hL)*S_t(iin,jin) + (hWght*hR + hR*hL)*S_t(iin+1,jin) ) * iDenom - Sbl = ( (hWght*hR)*S_b(iin+1,jin) + (hWght*hL + hR*hL)*S_b(iin,jin) ) * iDenom - Sbr = ( (hWght*hL)*S_b(iin,jin) + (hWght*hR + hR*hL)*S_b(iin+1,jin) ) * iDenom - else - Ttl = T_t(iin,jin); Tbl = T_b(iin,jin); Ttr = T_t(iin+1,jin); Tbr = T_b(iin+1,jin) - Stl = S_t(iin,jin); Sbl = S_b(iin,jin); Str = S_t(iin+1,jin); Sbr = S_b(iin+1,jin) - endif - - do m=2,4 - w_left = 0.25*real(5-m) ; w_right = 1.0-w_left - dz_x(m,i) = w_left*(z_t(iin,jin) - z_b(iin,jin)) + w_right*(z_t(iin+1,jin) - z_b(iin+1,jin)) - - ! Salinity and temperature points are linearly interpolated in - ! the horizontal. The subscript (1) refers to the top value in - ! the vertical profile while subscript (5) refers to the bottom - ! value in the vertical profile. - pos = i*15+(m-2)*5 - T15(pos+1) = w_left*Ttl + w_right*Ttr - T15(pos+5) = w_left*Tbl + w_right*Tbr - - S15(pos+1) = w_left*Stl + w_right*Str - S15(pos+5) = w_left*Sbl + w_right*Sbr - - p15(pos+1) = -GxRho*(w_left*z_t(iin,jin) + w_right*z_t(iin+1,jin)) - - ! Pressure - do n=2,5 - p15(pos+n) = p15(pos+n-1) + GxRho*0.25*dz_x(m,i) - enddo - - ! Salinity and temperature (linear interpolation in the vertical) - do n=2,4 - weight_t = 0.25 * real(5-n) - weight_b = 1.0 - weight_t - S15(pos+n) = weight_t * S15(pos+1) + weight_b * S15(pos+5) - T15(pos+n) = weight_t * T15(pos+1) + weight_b * T15(pos+5) + if (present(intx_dpa)) then + !$OMP parallel do default(shared) private(jin,iin,hWght,hL,hR,iDenom,Ttl,Ttr,Tbl,Tbr,Stl,Str,Sbl,Sbr, & + !$OMP w_left,w_right,dz_x,pos,T15,S15,p15,r15,weight_t,weight_b,intz) + do j=HIO%jsc,HIO%jec ; jin = j+joff + do I=Isq,Ieq ; iin = i+ioff + ! Corner values of T and S + ! hWght is the distance measure by which the cell is violation of + ! hydrostatic consistency. For large hWght we bias the interpolation + ! of T,S along the top and bottom integrals, almost like thickness + ! weighting. + ! Note: To work in terrain following coordinates we could offset + ! this distance by the layer thickness to replicate other models. + hWght = massWeightToggle * & + max(0., -bathyT(iin,jin)-z_t(iin+1,jin), -bathyT(iin+1,jin)-z_t(iin,jin)) + if (hWght > 0.) then + hL = (z_t(iin,jin) - z_b(iin,jin)) + dz_subroundoff + hR = (z_t(iin+1,jin) - z_b(iin+1,jin)) + dz_subroundoff + hWght = hWght * ( (hL-hR)/(hL+hR) )**2 + iDenom = 1./( hWght*(hR + hL) + hL*hR ) + Ttl = ( (hWght*hR)*T_t(iin+1,jin) + (hWght*hL + hR*hL)*T_t(iin,jin) ) * iDenom + Ttr = ( (hWght*hL)*T_t(iin,jin) + (hWght*hR + hR*hL)*T_t(iin+1,jin) ) * iDenom + Tbl = ( (hWght*hR)*T_b(iin+1,jin) + (hWght*hL + hR*hL)*T_b(iin,jin) ) * iDenom + Tbr = ( (hWght*hL)*T_b(iin,jin) + (hWght*hR + hR*hL)*T_b(iin+1,jin) ) * iDenom + Stl = ( (hWght*hR)*S_t(iin+1,jin) + (hWght*hL + hR*hL)*S_t(iin,jin) ) * iDenom + Str = ( (hWght*hL)*S_t(iin,jin) + (hWght*hR + hR*hL)*S_t(iin+1,jin) ) * iDenom + Sbl = ( (hWght*hR)*S_b(iin+1,jin) + (hWght*hL + hR*hL)*S_b(iin,jin) ) * iDenom + Sbr = ( (hWght*hL)*S_b(iin,jin) + (hWght*hR + hR*hL)*S_b(iin+1,jin) ) * iDenom + else + Ttl = T_t(iin,jin); Tbl = T_b(iin,jin); Ttr = T_t(iin+1,jin); Tbr = T_b(iin+1,jin) + Stl = S_t(iin,jin); Sbl = S_b(iin,jin); Str = S_t(iin+1,jin); Sbr = S_b(iin+1,jin) + endif + + do m=2,4 + w_left = 0.25*real(5-m) ; w_right = 1.0-w_left + dz_x(m,i) = w_left*(z_t(iin,jin) - z_b(iin,jin)) + w_right*(z_t(iin+1,jin) - z_b(iin+1,jin)) + + ! Salinity and temperature points are linearly interpolated in + ! the horizontal. The subscript (1) refers to the top value in + ! the vertical profile while subscript (5) refers to the bottom + ! value in the vertical profile. + pos = i*15+(m-2)*5 + T15(pos+1) = w_left*Ttl + w_right*Ttr + T15(pos+5) = w_left*Tbl + w_right*Tbr + + S15(pos+1) = w_left*Stl + w_right*Str + S15(pos+5) = w_left*Sbl + w_right*Sbr + + p15(pos+1) = -GxRho*(w_left*z_t(iin,jin) + w_right*z_t(iin+1,jin)) + + ! Pressure + do n=2,5 + p15(pos+n) = p15(pos+n-1) + GxRho*0.25*dz_x(m,i) + enddo + + ! Salinity and temperature (linear interpolation in the vertical) + do n=2,4 + weight_t = 0.25 * real(5-n) + weight_b = 1.0 - weight_t + S15(pos+n) = weight_t * S15(pos+1) + weight_b * S15(pos+5) + T15(pos+n) = weight_t * T15(pos+1) + weight_b * T15(pos+5) + enddo enddo enddo - enddo - call calculate_density(T15, S15, p15, r15, 1, 15*(ieq-isq+1), EOS, rho_ref) + call calculate_density(T15, S15, p15, r15, 1, 15*(ieq-isq+1), EOS, rho_ref) - do I=Isq,Ieq ; iin = i+ioff - intz(1) = dpa(i,j) ; intz(5) = dpa(i+1,j) + do I=Isq,Ieq ; iin = i+ioff + intz(1) = dpa(i,j) ; intz(5) = dpa(i+1,j) - ! Use Bode's rule to estimate the pressure anomaly change. - do m = 2,4 - pos = i*15+(m-2)*5 - intz(m) = G_e*dz_x(m,i)*( C1_90*(7.0*(r15(pos+1)+r15(pos+5)) + 32.0*(r15(pos+2)+r15(pos+4)) + & - 12.0*r15(pos+3))) + ! Use Bode's rule to estimate the pressure anomaly change. + do m = 2,4 + pos = i*15+(m-2)*5 + intz(m) = G_e*dz_x(m,i)*( C1_90*(7.0*(r15(pos+1)+r15(pos+5)) + 32.0*(r15(pos+2)+r15(pos+4)) + & + 12.0*r15(pos+3))) + enddo + ! Use Bode's rule to integrate the bottom pressure anomaly values in x. + intx_dpa(i,j) = C1_90*(7.0*(intz(1)+intz(5)) + 32.0*(intz(2)+intz(4)) + & + 12.0*intz(3)) enddo - ! Use Bode's rule to integrate the bottom pressure anomaly values in x. - intx_dpa(i,j) = C1_90*(7.0*(intz(1)+intz(5)) + 32.0*(intz(2)+intz(4)) + & - 12.0*intz(3)) enddo - enddo ; endif + endif ! ================================================== ! 3. Compute horizontal integrals in the y direction ! ================================================== - if (present(inty_dpa)) then ; do J=Jsq,Jeq ; jin = j+joff - do i=HIO%isc,HIO%iec ; iin = i+ioff - ! Corner values of T and S - ! hWght is the distance measure by which the cell is violation of - ! hydrostatic consistency. For large hWght we bias the interpolation - ! of T,S along the top and bottom integrals, almost like thickness - ! weighting. - ! Note: To work in terrain following coordinates we could offset - ! this distance by the layer thickness to replicate other models. - hWght = massWeightToggle * & - max(0., -bathyT(i,j)-z_t(iin,jin+1), -bathyT(i,j+1)-z_t(iin,jin)) - if (hWght > 0.) then - hL = (z_t(iin,jin) - z_b(iin,jin)) + dz_subroundoff - hR = (z_t(iin,jin+1) - z_b(iin,jin+1)) + dz_subroundoff - hWght = hWght * ( (hL-hR)/(hL+hR) )**2 - iDenom = 1./( hWght*(hR + hL) + hL*hR ) - Ttl = ( (hWght*hR)*T_t(iin,jin+1) + (hWght*hL + hR*hL)*T_t(iin,jin) ) * iDenom - Ttr = ( (hWght*hL)*T_t(iin,jin) + (hWght*hR + hR*hL)*T_t(iin,jin+1) ) * iDenom - Tbl = ( (hWght*hR)*T_b(iin,jin+1) + (hWght*hL + hR*hL)*T_b(iin,jin) ) * iDenom - Tbr = ( (hWght*hL)*T_b(iin,jin) + (hWght*hR + hR*hL)*T_b(iin,jin+1) ) * iDenom - Stl = ( (hWght*hR)*S_t(iin,jin+1) + (hWght*hL + hR*hL)*S_t(iin,jin) ) * iDenom - Str = ( (hWght*hL)*S_t(iin,jin) + (hWght*hR + hR*hL)*S_t(iin,jin+1) ) * iDenom - Sbl = ( (hWght*hR)*S_b(iin,jin+1) + (hWght*hL + hR*hL)*S_b(iin,jin) ) * iDenom - Sbr = ( (hWght*hL)*S_b(iin,jin) + (hWght*hR + hR*hL)*S_b(iin,jin+1) ) * iDenom - else - Ttl = T_t(iin,jin); Tbl = T_b(iin,jin); Ttr = T_t(iin,jin+1); Tbr = T_b(iin,jin+1) - Stl = S_t(iin,jin); Sbl = S_b(iin,jin); Str = S_t(iin,jin+1); Sbr = S_b(iin,jin+1) - endif - - do m=2,4 - w_left = 0.25*real(5-m) ; w_right = 1.0-w_left - dz_y(m,i) = w_left*(z_t(iin,jin) - z_b(iin,jin)) + w_right*(z_t(iin,jin+1) - z_b(iin,jin+1)) - - ! Salinity and temperature points are linearly interpolated in - ! the horizontal. The subscript (1) refers to the top value in - ! the vertical profile while subscript (5) refers to the bottom - ! value in the vertical profile. - pos = i*15+(m-2)*5 - T15(pos+1) = w_left*Ttl + w_right*Ttr - T15(pos+5) = w_left*Tbl + w_right*Tbr - - S15(pos+1) = w_left*Stl + w_right*Str - S15(pos+5) = w_left*Sbl + w_right*Sbr - - p15(pos+1) = -GxRho*(w_left*z_t(iin,jin) + w_right*z_t(iin,jin+1)) - - ! Pressure - do n=2,5 ; p15(pos+n) = p15(pos+n-1) + GxRho*0.25*dz_y(m,i) ; enddo - - ! Salinity and temperature (linear interpolation in the vertical) - do n=2,4 - weight_t = 0.25 * real(5-n) - weight_b = 1.0 - weight_t - S15(pos+n) = weight_t * S15(pos+1) + weight_b * S15(pos+5) - T15(pos+n) = weight_t * T15(pos+1) + weight_b * T15(pos+5) + if (present(inty_dpa)) then + !$OMP parallel do default(shared) private(jin,iin,hWght,hL,hR,iDenom,Ttl,Ttr,Tbl,Tbr,Stl,Str,Sbl,Sbr, & + !$OMP w_left,w_right,dz_y,pos,T15,S15,p15,r15,weight_t,weight_b,intz) + do J=Jsq,Jeq ; jin = j+joff + do i=HIO%isc,HIO%iec ; iin = i+ioff + ! Corner values of T and S + ! hWght is the distance measure by which the cell is violation of + ! hydrostatic consistency. For large hWght we bias the interpolation + ! of T,S along the top and bottom integrals, almost like thickness + ! weighting. + ! Note: To work in terrain following coordinates we could offset + ! this distance by the layer thickness to replicate other models. + hWght = massWeightToggle * & + max(0., -bathyT(i,j)-z_t(iin,jin+1), -bathyT(i,j+1)-z_t(iin,jin)) + if (hWght > 0.) then + hL = (z_t(iin,jin) - z_b(iin,jin)) + dz_subroundoff + hR = (z_t(iin,jin+1) - z_b(iin,jin+1)) + dz_subroundoff + hWght = hWght * ( (hL-hR)/(hL+hR) )**2 + iDenom = 1./( hWght*(hR + hL) + hL*hR ) + Ttl = ( (hWght*hR)*T_t(iin,jin+1) + (hWght*hL + hR*hL)*T_t(iin,jin) ) * iDenom + Ttr = ( (hWght*hL)*T_t(iin,jin) + (hWght*hR + hR*hL)*T_t(iin,jin+1) ) * iDenom + Tbl = ( (hWght*hR)*T_b(iin,jin+1) + (hWght*hL + hR*hL)*T_b(iin,jin) ) * iDenom + Tbr = ( (hWght*hL)*T_b(iin,jin) + (hWght*hR + hR*hL)*T_b(iin,jin+1) ) * iDenom + Stl = ( (hWght*hR)*S_t(iin,jin+1) + (hWght*hL + hR*hL)*S_t(iin,jin) ) * iDenom + Str = ( (hWght*hL)*S_t(iin,jin) + (hWght*hR + hR*hL)*S_t(iin,jin+1) ) * iDenom + Sbl = ( (hWght*hR)*S_b(iin,jin+1) + (hWght*hL + hR*hL)*S_b(iin,jin) ) * iDenom + Sbr = ( (hWght*hL)*S_b(iin,jin) + (hWght*hR + hR*hL)*S_b(iin,jin+1) ) * iDenom + else + Ttl = T_t(iin,jin); Tbl = T_b(iin,jin); Ttr = T_t(iin,jin+1); Tbr = T_b(iin,jin+1) + Stl = S_t(iin,jin); Sbl = S_b(iin,jin); Str = S_t(iin,jin+1); Sbr = S_b(iin,jin+1) + endif + + do m=2,4 + w_left = 0.25*real(5-m) ; w_right = 1.0-w_left + dz_y(m,i) = w_left*(z_t(iin,jin) - z_b(iin,jin)) + w_right*(z_t(iin,jin+1) - z_b(iin,jin+1)) + + ! Salinity and temperature points are linearly interpolated in + ! the horizontal. The subscript (1) refers to the top value in + ! the vertical profile while subscript (5) refers to the bottom + ! value in the vertical profile. + pos = i*15+(m-2)*5 + T15(pos+1) = w_left*Ttl + w_right*Ttr + T15(pos+5) = w_left*Tbl + w_right*Tbr + + S15(pos+1) = w_left*Stl + w_right*Str + S15(pos+5) = w_left*Sbl + w_right*Sbr + + p15(pos+1) = -GxRho*(w_left*z_t(iin,jin) + w_right*z_t(iin,jin+1)) + + ! Pressure + do n=2,5 ; p15(pos+n) = p15(pos+n-1) + GxRho*0.25*dz_y(m,i) ; enddo + + ! Salinity and temperature (linear interpolation in the vertical) + do n=2,4 + weight_t = 0.25 * real(5-n) + weight_b = 1.0 - weight_t + S15(pos+n) = weight_t * S15(pos+1) + weight_b * S15(pos+5) + T15(pos+n) = weight_t * T15(pos+1) + weight_b * T15(pos+5) + enddo enddo enddo - enddo - call calculate_density_array(T15(15*HIO%isc+1:), S15(15*HIO%isc+1:), p15(15*HIO%isc+1:), & - r15(15*HIO%isc+1:), 1, 15*(HIO%iec-HIO%isc+1), EOS, rho_ref) - do i=HIO%isc,HIO%iec ; iin = i+ioff - intz(1) = dpa(i,j) ; intz(5) = dpa(i,j+1) - - ! Use Bode's rule to estimate the pressure anomaly change. - do m = 2,4 - pos = i*15+(m-2)*5 - intz(m) = G_e*dz_y(m,i)*( C1_90*(7.0*(r15(pos+1)+r15(pos+5)) + & - 32.0*(r15(pos+2)+r15(pos+4)) + & - 12.0*r15(pos+3))) + call calculate_density_array(T15(15*HIO%isc+1:), S15(15*HIO%isc+1:), p15(15*HIO%isc+1:), & + r15(15*HIO%isc+1:), 1, 15*(HIO%iec-HIO%isc+1), EOS, rho_ref) + do i=HIO%isc,HIO%iec ; iin = i+ioff + intz(1) = dpa(i,j) ; intz(5) = dpa(i,j+1) + + ! Use Bode's rule to estimate the pressure anomaly change. + do m = 2,4 + pos = i*15+(m-2)*5 + intz(m) = G_e*dz_y(m,i)*( C1_90*(7.0*(r15(pos+1)+r15(pos+5)) + & + 32.0*(r15(pos+2)+r15(pos+4)) + & + 12.0*r15(pos+3))) + enddo + ! Use Bode's rule to integrate the values. + inty_dpa(i,j) = C1_90*(7.0*(intz(1)+intz(5)) + 32.0*(intz(2)+intz(4)) + & + 12.0*intz(3)) enddo - ! Use Bode's rule to integrate the values. - inty_dpa(i,j) = C1_90*(7.0*(intz(1)+intz(5)) + 32.0*(intz(2)+intz(4)) + & - 12.0*intz(3)) enddo - enddo ; endif + endif end subroutine int_density_dz_generic_plm ! ========================================================================== From 48310e3d61c2256f2b7f8686cbb0712a805f89a7 Mon Sep 17 00:00:00 2001 From: alperaltuntas Date: Thu, 23 Apr 2020 00:40:36 -0600 Subject: [PATCH 20/53] eliminate omp parallel open/close in to int_density_dz_generic_plm --- src/equation_of_state/MOM_EOS.F90 | 13 ++++++++----- 1 file changed, 8 insertions(+), 5 deletions(-) diff --git a/src/equation_of_state/MOM_EOS.F90 b/src/equation_of_state/MOM_EOS.F90 index c26317d3a9..fcc5cc1352 100644 --- a/src/equation_of_state/MOM_EOS.F90 +++ b/src/equation_of_state/MOM_EOS.F90 @@ -1271,7 +1271,11 @@ subroutine int_density_dz_generic_plm (T_t, T_b, S_t, S_b, z_t, z_b, rho_ref, & ! 1. Compute vertical integrals ! ============================= - !$OMP parallel do default(shared) private(jin,iin,dz,p5,S5,T5,r5,rho_anom) + !$OMP parallel default(shared) private(jin,iin,dz,p5,S5,T5,r5,rho_anom,hWght,hL,hR,iDenom,Ttl,Ttr, & + !$OMP Tbl,Tbr,Stl,Str,Sbl,Sbr,w_left,w_right,dz_x,dz_y,pos,T15,S15, & + !$OMP p15,r15,weight_t,weight_b,intz) + + !$OMP do do j=Jsq,Jeq+1 jin = j+joff do i = Isq,Ieq+1 ; iin = i+ioff @@ -1303,8 +1307,7 @@ subroutine int_density_dz_generic_plm (T_t, T_b, S_t, S_b, z_t, z_b, rho_ref, & ! 2. Compute horizontal integrals in the x direction ! ================================================== if (present(intx_dpa)) then - !$OMP parallel do default(shared) private(jin,iin,hWght,hL,hR,iDenom,Ttl,Ttr,Tbl,Tbr,Stl,Str,Sbl,Sbr, & - !$OMP w_left,w_right,dz_x,pos,T15,S15,p15,r15,weight_t,weight_b,intz) + !$OMP do do j=HIO%jsc,HIO%jec ; jin = j+joff do I=Isq,Ieq ; iin = i+ioff ! Corner values of T and S @@ -1388,8 +1391,7 @@ subroutine int_density_dz_generic_plm (T_t, T_b, S_t, S_b, z_t, z_b, rho_ref, & ! 3. Compute horizontal integrals in the y direction ! ================================================== if (present(inty_dpa)) then - !$OMP parallel do default(shared) private(jin,iin,hWght,hL,hR,iDenom,Ttl,Ttr,Tbl,Tbr,Stl,Str,Sbl,Sbr, & - !$OMP w_left,w_right,dz_y,pos,T15,S15,p15,r15,weight_t,weight_b,intz) + !$OMP do do J=Jsq,Jeq ; jin = j+joff do i=HIO%isc,HIO%iec ; iin = i+ioff ! Corner values of T and S @@ -1467,6 +1469,7 @@ subroutine int_density_dz_generic_plm (T_t, T_b, S_t, S_b, z_t, z_b, rho_ref, & enddo enddo endif + !$OMP end parallel end subroutine int_density_dz_generic_plm ! ========================================================================== From c53525eae1cbd37fece82be8b0093da2479bbdec Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Wed, 22 Apr 2020 17:14:25 -0600 Subject: [PATCH 21/53] Clean QG_Leith * Follow Bob's suggestion throughout the code: - remove unnecessary halo updates - change loop indices - make expressions rotationally symmetric - fix bugs in vort_xy_dy and grid_sp_v2 * clean the code by deleting commented lines --- .../lateral/MOM_lateral_mixing_coeffs.F90 | 82 +++++-------------- 1 file changed, 21 insertions(+), 61 deletions(-) diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index d9543322c9..d616812b2f 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -93,9 +93,6 @@ module MOM_lateral_mixing_coeffs real, dimension(:,:,:), pointer :: & slope_x => NULL(), & !< Zonal isopycnal slope [nondim] slope_y => NULL(), & !< Meridional isopycnal slope [nondim] - !### These are posted as diagnostics but are never set. - N2_u => NULL(), & !< Brunt-Vaisala frequency at u-points [s-2] - N2_v => NULL(), & !< Brunt-Vaisala frequency at v-points [s-2] ebt_struct => NULL() !< Vertical structure function to scale diffusivities with [nondim] real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_) :: & Laplac3_const_u !< Laplacian metric-dependent constants [L3 ~> m3] @@ -470,10 +467,6 @@ subroutine calc_slope_functions(h, tv, dt, G, GV, US, CS) if (CS%id_SN_v > 0) call post_data(CS%id_SN_v, CS%SN_v, CS%diag) if (CS%id_L2u > 0) call post_data(CS%id_L2u, CS%L2u, CS%diag) if (CS%id_L2v > 0) call post_data(CS%id_L2v, CS%L2v, CS%diag) - !### I do not believe that CS%N2_u and CS%N2_v are ever set, but because the contents - ! of CS are public, they might be set somewhere outside of this module. - if (CS%id_N2_u > 0) call post_data(CS%id_N2_u, CS%N2_u, CS%diag) - if (CS%id_N2_v > 0) call post_data(CS%id_N2_v, CS%N2_v, CS%diag) endif end subroutine calc_slope_functions @@ -752,8 +745,6 @@ subroutine calc_QG_Leith_viscosity(CS, G, GV, US, h, k, div_xx_dx, div_xx_dy, vo type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type -! real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< Zonal flow [L T-1 ~> m s-1] -! real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< Meridional flow [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< Layer thickness [H ~> m or kg m-2] integer, intent(in) :: k !< Layer for which to calculate vorticity magnitude real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: div_xx_dx !< x-derivative of horizontal divergence @@ -764,15 +755,6 @@ subroutine calc_QG_Leith_viscosity(CS, G, GV, US, h, k, div_xx_dx, div_xx_dy, vo !! (d/dx(dv/dx - du/dy)) [L-1 T-1 ~> m-1 s-1] real, dimension(SZIB_(G),SZJ_(G)), intent(inout) :: vort_xy_dy !< y-derivative of vertical vorticity !! (d/dy(dv/dx - du/dy)) [L-1 T-1 ~> m-1 s-1] -! real, dimension(SZI_(G),SZJ_(G)), intent(out) :: Leith_Kh_h !< Leith Laplacian viscosity - !! at h-points [L2 T-1 ~> m2 s-1] -! real, dimension(SZIB_(G),SZJB_(G)), intent(out) :: Leith_Kh_q !< Leith Laplacian viscosity - !! at q-points [L2 T-1 ~> m2 s-1] -! real, dimension(SZI_(G),SZJ_(G)), intent(out) :: Leith_Ah_h !< Leith bi-harmonic viscosity - !! at h-points [L4 T-1 ~> m4 s-1] -! real, dimension(SZIB_(G),SZJB_(G)), intent(out) :: Leith_Ah_q !< Leith bi-harmonic viscosity - !! at q-points [L4 T-1 ~> m4 s-1] - ! Local variables real, dimension(SZI_(G),SZJB_(G)) :: & dslopey_dz, & ! z-derivative of y-slope at v-points [Z-1 ~> m-1] @@ -800,16 +782,9 @@ subroutine calc_QG_Leith_viscosity(CS, G, GV, US, h, k, div_xx_dx, div_xx_dy, vo inv_PI3 = 1.0/((4.0*atan(1.0))**3) - !### I believe this halo update to be unnecessary. -RWH - call pass_var(h, G%Domain) - if ((k > 1) .and. (k < nz)) then - ! Add in stretching term for the QG Leith vsicosity -! if (CS%use_QG_Leith) then - - !### do j=js-1,je+1 ; do I=is-2,Ieq+1 - do j=js-2,Jeq+2 ; do I=is-2,Ieq+1 + do j=js-1,je+1 ; do I=is-2,Ieq+1 h_at_slope_above = 2. * ( h(i,j,k-1) * h(i+1,j,k-1) ) * ( h(i,j,k) * h(i+1,j,k) ) / & ( ( h(i,j,k-1) * h(i+1,j,k-1) ) * ( h(i,j,k) + h(i+1,j,k) ) & + ( h(i,j,k) * h(i+1,j,k) ) * ( h(i,j,k-1) + h(i+1,j,k-1) ) + GV%H_subroundoff ) @@ -821,8 +796,7 @@ subroutine calc_QG_Leith_viscosity(CS, G, GV, US, h, k, div_xx_dx, div_xx_dy, vo h_at_u(I,j) = 2. * ( h_at_slope_above * h_at_slope_below ) * Ih enddo ; enddo - !### do J=js-2,Jeq+1 ; do i=is-1,ie+1 - do J=js-2,Jeq+1 ; do i=is-2,Ieq+2 + do J=js-2,Jeq+1 ; do i=is-1,ie+1 h_at_slope_above = 2. * ( h(i,j,k-1) * h(i,j+1,k-1) ) * ( h(i,j,k) * h(i,j+1,k) ) / & ( ( h(i,j,k-1) * h(i,j+1,k-1) ) * ( h(i,j,k) + h(i,j+1,k) ) & + ( h(i,j,k) * h(i,j+1,k) ) * ( h(i,j,k-1) + h(i,j+1,k-1) ) + GV%H_subroundoff ) @@ -834,8 +808,7 @@ subroutine calc_QG_Leith_viscosity(CS, G, GV, US, h, k, div_xx_dx, div_xx_dy, vo h_at_v(i,J) = 2. * ( h_at_slope_above * h_at_slope_below ) * Ih enddo ; enddo - !### do J=js-1,je ; do i=is-1,Ieq+1 - do J=js-2,Jeq+1 ; do i=is-1,Ieq+1 + do J=js-1,je ; do i=is-1,Ieq+1 f = 0.5 * ( G%CoriolisBu(I,J) + G%CoriolisBu(I-1,J) ) vort_xy_dx(i,J) = vort_xy_dx(i,J) - f * US%L_to_Z * & ( ( h_at_u(I,j) * dslopex_dz(I,j) + h_at_u(I-1,j+1) * dslopex_dz(I-1,j+1) ) & @@ -843,33 +816,25 @@ subroutine calc_QG_Leith_viscosity(CS, G, GV, US, h, k, div_xx_dx, div_xx_dy, vo ( ( h_at_u(I,j) + h_at_u(I-1,j+1) ) + ( h_at_u(I-1,j) + h_at_u(I,j+1) ) + GV%H_subroundoff) enddo ; enddo - !### do j=js-1,Jeq+1 ; do I=is-1,ie - do j=js-1,Jeq+1 ; do I=is-2,Ieq+1 + do j=js-1,Jeq+1 ; do I=is-1,ie f = 0.5 * ( G%CoriolisBu(I,J) + G%CoriolisBu(I,J-1) ) - !### I think that this should be vort_xy_dy(I,j) = vort_xy_dy(I,j) - f * & - vort_xy_dy(I,j) = vort_xy_dx(I,j) - f * US%L_to_Z * & + vort_xy_dy(I,j) = vort_xy_dy(I,j) - f * US%L_to_Z * & ( ( h_at_v(i,J) * dslopey_dz(i,J) + h_at_v(i+1,J-1) * dslopey_dz(i+1,J-1) ) & + ( h_at_v(i,J-1) * dslopey_dz(i,J-1) + h_at_v(i+1,J) * dslopey_dz(i+1,J) ) ) / & ( ( h_at_v(i,J) + h_at_v(i+1,J-1) ) + ( h_at_v(i,J-1) + h_at_v(i+1,J) ) + GV%H_subroundoff) enddo ; enddo endif ! k > 1 - !### I believe this halo update to be unnecessary. -RWH - call pass_vector(vort_xy_dy,vort_xy_dx,G%Domain) - if (CS%use_QG_Leith_GM) then do j=js,je ; do I=is-1,Ieq - !### These expressions are not rotationally symmetric. Add parentheses and regroup, as in: - ! grad_vort_mag_u(I,j) = SQRT(vort_xy_dy(I,j)**2 + (0.25*((vort_xy_dx(i,J) + vort_xy_dx(i+1,J-1)) + - ! (vort_xy_dx(i+1,J) + vort_xy_dx(i,J-1))))**2 ) - grad_vort_mag_u(I,j) = SQRT(vort_xy_dy(I,j)**2 + (0.25*(vort_xy_dx(i,J) + vort_xy_dx(i+1,J) & - + vort_xy_dx(i,J-1) + vort_xy_dx(i+1,J-1)))**2) - grad_div_mag_u(I,j) = SQRT(div_xx_dx(I,j)**2 + (0.25*(div_xx_dy(i,J) + div_xx_dy(i+1,J) & - + div_xx_dy(i,J-1) + div_xx_dy(i+1,J-1)))**2) + grad_vort_mag_u(I,j) = SQRT(vort_xy_dy(I,j)**2 + (0.25*((vort_xy_dx(i,J) + vort_xy_dx(i+1,J-1)) & + + (vort_xy_dx(i+1,J) + vort_xy_dx(i,J-1))))**2) + grad_div_mag_u(I,j) = SQRT(div_xx_dx(I,j)**2 + (0.25*((div_xx_dy(i,J) + div_xx_dy(i+1,J-1)) & + + (div_xx_dy(i+1,J) + div_xx_dy(i,J-1))))**2) if (CS%use_beta_in_QG_Leith) then - beta_u(I,j) = sqrt( (0.5*(G%dF_dx(i,j)+G%dF_dx(i+1,j))**2) + & - (0.5*(G%dF_dy(i,j)+G%dF_dy(i+1,j))**2) ) + beta_u(I,j) = sqrt((0.5*(G%dF_dx(i,j)+G%dF_dx(i+1,j))**2) + & + (0.5*(G%dF_dy(i,j)+G%dF_dy(i+1,j))**2)) CS%KH_u_QG(I,j,k) = MIN(grad_vort_mag_u(I,j) + grad_div_mag_u(I,j), 3.0*beta_u(I,j)) * & CS%Laplac3_const_u(I,j) * inv_PI3 else @@ -879,14 +844,13 @@ subroutine calc_QG_Leith_viscosity(CS, G, GV, US, h, k, div_xx_dx, div_xx_dy, vo enddo ; enddo do J=js-1,Jeq ; do i=is,ie - !### These expressions are not rotationally symmetric. Add parentheses and regroup. - grad_vort_mag_v(i,J) = SQRT(vort_xy_dx(i,J)**2 + (0.25*(vort_xy_dy(I,j) + vort_xy_dy(I-1,j) & - + vort_xy_dy(I,j+1) + vort_xy_dy(I-1,j+1)))**2) - grad_div_mag_v(i,J) = SQRT(div_xx_dy(i,J)**2 + (0.25*(div_xx_dx(I,j) + div_xx_dx(I-1,j) & - + div_xx_dx(I,j+1) + div_xx_dx(I-1,j+1)))**2) + grad_vort_mag_v(i,J) = SQRT(vort_xy_dx(i,J)**2 + (0.25*((vort_xy_dy(I,j) + vort_xy_dy(I-1,j+1)) & + + (vort_xy_dy(I,j+1) + vort_xy_dy(I-1,j))))**2) + grad_div_mag_v(i,J) = SQRT(div_xx_dy(i,J)**2 + (0.25*((div_xx_dx(I,j) + div_xx_dx(I-1,j+1)) & + + (div_xx_dx(I,j+1) + div_xx_dx(I-1,j))))**2) if (CS%use_beta_in_QG_Leith) then - beta_v(i,J) = sqrt( (0.5*(G%dF_dx(i,j)+G%dF_dx(i,j+1))**2) + & - (0.5*(G%dF_dy(i,j)+G%dF_dy(i,j+1))**2) ) + beta_v(i,J) = sqrt((0.5*(G%dF_dx(i,j)+G%dF_dx(i,j+1))**2) + & + (0.5*(G%dF_dy(i,j)+G%dF_dy(i,j+1))**2)) CS%KH_v_QG(i,J,k) = MIN(grad_vort_mag_v(i,J) + grad_div_mag_v(i,J), 3.0*beta_v(i,J)) * & CS%Laplac3_const_v(i,J) * inv_PI3 else @@ -1042,8 +1006,6 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) in_use = .true. allocate(CS%slope_x(IsdB:IedB,jsd:jed,G%ke+1)) ; CS%slope_x(:,:,:) = 0.0 allocate(CS%slope_y(isd:ied,JsdB:JedB,G%ke+1)) ; CS%slope_y(:,:,:) = 0.0 - allocate(CS%N2_u(IsdB:IedB,jsd:jed,G%ke+1)) ; CS%N2_u(:,:,:) = 0.0 - allocate(CS%N2_v(isd:ied,JsdB:JedB,G%ke+1)) ; CS%N2_v(:,:,:) = 0.0 call get_param(param_file, mdl, "KD_SMOOTH", CS%kappa_smooth, & "A diapycnal diffusivity that is used to interpolate "//& "more sensible values of T & S into thin layers.", & @@ -1096,11 +1058,10 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) 'Square of Brunt-Vaisala frequency, N^2, at u-points, as used in Visbeck et al.', 's-2') CS%id_N2_v = register_diag_field('ocean_model', 'N2_v', diag%axesCvi, Time, & 'Square of Brunt-Vaisala frequency, N^2, at v-points, as used in Visbeck et al.', 's-2') - !### The units of the next two diagnostics should be 'nondim'. CS%id_S2_u = register_diag_field('ocean_model', 'S2_u', diag%axesCu1, Time, & - 'Depth average square of slope magnitude, S^2, at u-points, as used in Visbeck et al.', 's-2') + 'Depth average square of slope magnitude, S^2, at u-points, as used in Visbeck et al.', 'nondim') CS%id_S2_v = register_diag_field('ocean_model', 'S2_v', diag%axesCv1, Time, & - 'Depth average square of slope magnitude, S^2, at v-points, as used in Visbeck et al.', 's-2') + 'Depth average square of slope magnitude, S^2, at v-points, as used in Visbeck et al.', 'nondim') endif oneOrTwo = 1.0 @@ -1272,13 +1233,12 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) do j=Jsq,Jeq+1 ; do I=is-1,Ieq ! Static factors in the Leith schemes grid_sp_u2 = G%dyCu(I,j)*G%dxCu(I,j) - grid_sp_u3 = sqrt(grid_sp_u2) + grid_sp_u3 = grid_sp_u2*sqrt(grid_sp_u2) CS%Laplac3_const_u(I,j) = Leith_Lap_const * grid_sp_u3 enddo ; enddo do j=js-1,Jeq ; do I=Isq,Ieq+1 ! Static factors in the Leith schemes - !### The second factor here is wrong. It should be G%dxCv(i,J). - grid_sp_v2 = G%dyCv(i,J)*G%dxCu(i,J) + grid_sp_v2 = G%dyCv(i,J)*G%dxCv(i,J) grid_sp_v3 = grid_sp_v2*sqrt(grid_sp_v2) CS%Laplac3_const_v(i,J) = Leith_Lap_const * grid_sp_v3 enddo ; enddo From b412fde96f2d48592cff2f35a255ef4f386efd2e Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Fri, 1 May 2020 16:40:13 -0600 Subject: [PATCH 22/53] Fix Leith_Ah There were a few mistakes in the Leith AH coefficient calculation that are now fixed. * Use inv_PI6 instead of inv_PI5 * Use Del2vort_q instead of vert_vort_mag --- .../lateral/MOM_hor_visc.F90 | 64 +++++++++---------- 1 file changed, 32 insertions(+), 32 deletions(-) diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index c3ec878bc1..c95ddee281 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -103,11 +103,6 @@ module MOM_hor_visc !< The background biharmonic viscosity at h points [L4 T-1 ~> m4 s-1]. !! The actual viscosity may be the larger of this !! viscosity and the Smagorinsky and Leith viscosities. -! real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: Biharm5_const2_xx - !< A constant relating the biharmonic viscosity to the - !! square of the velocity shear [L4 T ~> m4 s]. This value is - !! set to be the magnitude of the Coriolis terms once the - !! velocity differences reach a value of order 1/2 MAXVEL. real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: reduction_xx !< The amount by which stresses through h points are reduced !! due to partial barriers [nondim]. @@ -125,11 +120,6 @@ module MOM_hor_visc !< The background biharmonic viscosity at q points [L4 T-1 ~> m4 s-1]. !! The actual viscosity may be the larger of this !! viscosity and the Smagorinsky and Leith viscosities. -! real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEMB_PTR_) :: Biharm5_const2_xy - !< A constant relating the biharmonic viscosity to the - !! square of the velocity shear [L4 T ~> m4 s]. This value is - !! set to be the magnitude of the Coriolis terms once the - !! velocity differences reach a value of order 1/2 MAXVEL. real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEMB_PTR_) :: reduction_xy !< The amount by which stresses through q points are reduced !! due to partial barriers [nondim]. @@ -160,14 +150,14 @@ module MOM_hor_visc ! parameters and metric terms. real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: & Laplac2_const_xx, & !< Laplacian metric-dependent constants [L2 ~> m2] - Biharm5_const_xx, & !< Biharmonic metric-dependent constants [L5 ~> m5] + Biharm6_const_xx, & !< Biharmonic metric-dependent constants [L6 ~> m6] Laplac3_const_xx, & !< Laplacian metric-dependent constants [L3 ~> m3] Biharm_const_xx, & !< Biharmonic metric-dependent constants [L4 ~> m4] Biharm_const2_xx !< Biharmonic metric-dependent constants [T L4 ~> s m4] real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEMB_PTR_) :: & Laplac2_const_xy, & !< Laplacian metric-dependent constants [L2 ~> m2] - Biharm5_const_xy, & !< Biharmonic metric-dependent constants [L5 ~> m5] + Biharm6_const_xy, & !< Biharmonic metric-dependent constants [L6 ~> m6] Laplac3_const_xy, & !< Laplacian metric-dependent constants [L3 ~> m3] Biharm_const_xy, & !< Biharmonic metric-dependent constants [L4 ~> m4] Biharm_const2_xy !< Biharmonic metric-dependent constants [T L4 ~> s m4] @@ -256,6 +246,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, ! Leith_Ah_h, & ! Leith bi-harmonic viscosity at h-points [L4 T-1 ~> m4 s-1] grad_vort_mag_h, & ! Magnitude of vorticity gradient at h-points [L-1 T-1 ~> m-1 s-1] grad_vort_mag_h_2d, & ! Magnitude of 2d vorticity gradient at h-points [L-1 T-1 ~> m-1 s-1] + Del2vort_h, & ! Laplacian of vorticity at h-points [L-2 T-1 ~> m-2 s-1] grad_div_mag_h, & ! Magnitude of divergence gradient at h-points [L-1 T-1 ~> m-1 s-1] dudx, dvdy, & ! components in the horizontal tension [T-1 ~> s-1] grad_vel_mag_h, & ! Magnitude of the velocity gradient tensor squared at h-points [T-2 ~> s-2] @@ -277,6 +268,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, Leith_Ah_q, & ! Leith bi-harmonic viscosity at q-points [L4 T-1 ~> m4 s-1] grad_vort_mag_q, & ! Magnitude of vorticity gradient at q-points [L-1 T-1 ~> m-1 s-1] grad_vort_mag_q_2d, & ! Magnitude of 2d vorticity gradient at q-points [L-1 T-1 ~> m-1 s-1] + Del2vort_q, & ! Laplacian of vorticity at q-points [L-2 T-1 ~> m-2 s-1] grad_div_mag_q, & ! Magnitude of divergence gradient at q-points [L-1 T-1 ~> m-1 s-1] grad_vel_mag_q, & ! Magnitude of the velocity gradient tensor squared at q-points [T-2 ~> s-2] hq, & ! harmonic mean of the harmonic means of the u- & v point thicknesses [H ~> m or kg m-2] @@ -335,6 +327,8 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, real :: FWfrac ! Fraction of maximum theoretical energy transfer to use when scaling GME coefficient [nondim] real :: DY_dxBu ! Ratio of meridional over zonal grid spacing at vertices [nondim] real :: DX_dyBu ! Ratio of zonal over meridiononal grid spacing at vertices [nondim] + real :: DY_dxCv ! Ratio of meridional over zonal grid spacing at faces [nondim] + real :: DX_dyCu ! Ratio of zonal over meridional grid spacing at faces [nondim] real :: Sh_F_pow ! The ratio of shear over the absolute value of f raised to some power and rescaled [nondim] real :: backscat_subround ! The ratio of f over Shear_mag that is so small that the backscatter ! calculation gives the same value as if f were 0 [nondim]. @@ -346,7 +340,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, logical :: use_MEKE_Au integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz integer :: i, j, k, n - real :: inv_PI3, inv_PI2, inv_PI5 + real :: inv_PI3, inv_PI2, inv_PI6 is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB @@ -354,7 +348,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, h_neglect3 = h_neglect**3 inv_PI3 = 1.0/((4.0*atan(1.0))**3) inv_PI2 = 1.0/((4.0*atan(1.0))**2) - inv_PI5 = inv_PI3 * inv_PI2 + inv_PI6 = inv_PI3 * inv_PI3 Ah_h(:,:,:) = 0.0 Kh_h(:,:,:) = 0.0 @@ -465,7 +459,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, !$OMP apply_OBC, rescale_Kh, legacy_bound, find_FrictWork, & !$OMP use_MEKE_Ku, use_MEKE_Au, boundary_mask_h, boundary_mask_q, & !$OMP backscat_subround, GME_coeff_limiter, & - !$OMP h_neglect, h_neglect3, FWfrac, inv_PI3, inv_PI5, H0_GME, & + !$OMP h_neglect, h_neglect3, FWfrac, inv_PI3, inv_PI6, H0_GME, & !$OMP diffu, diffv, max_diss_rate_h, max_diss_rate_q, & !$OMP Kh_h, Kh_q, Ah_h, Ah_q, FrictWork, FrictWork_GME, & !$OMP div_xx_h, vort_xy_q, GME_coeff_h, GME_coeff_q, & @@ -502,7 +496,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, enddo ; enddo ! Components for the shearing strain - do J=js-2,Jeq+1 ; do I=is-2,Ieq+1 + do J=js-2,Jeq+2 ; do I=is-2,Ieq+2 dvdx(I,J) = CS%DY_dxBu(I,J)*(v(i+1,J,k)*G%IdyCv(i+1,J) - v(i,J,k)*G%IdyCv(i,J)) dudy(I,J) = CS%DX_dyBu(I,J)*(u(I,j+1,k)*G%IdxCu(I,j+1) - u(I,j,k)*G%IdxCu(I,j)) enddo ; enddo @@ -683,26 +677,37 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, ! Vorticity if (CS%no_slip) then - do J=js-2,Jeq+1 ; do I=is-2,Ieq+1 + do J=js-2,Jeq+2 ; do I=is-2,Ieq+2 vort_xy(I,J) = (2.0-G%mask2dBu(I,J)) * ( dvdx(I,J) - dudy(I,J) ) enddo ; enddo else - do J=js-2,Jeq+1 ; do I=is-2,Ieq+1 + do J=js-2,Jeq+2 ; do I=is-2,Ieq+2 vort_xy(I,J) = G%mask2dBu(I,J) * ( dvdx(I,J) - dudy(I,J) ) enddo ; enddo endif ! Vorticity gradient - do J=js-2,Jeq+1 ; do i=is-1,Ieq+1 + do J=js-2,Jeq+2 ; do i=is-1,Ieq+2 DY_dxBu = G%dyBu(I,J) * G%IdxBu(I,J) vort_xy_dx(i,J) = DY_dxBu * (vort_xy(I,J) * G%IdyCu(I,j) - vort_xy(I-1,J) * G%IdyCu(I-1,j)) enddo ; enddo - do j=js-1,Jeq+1 ; do I=is-2,Ieq+1 + do j=js-1,Jeq+2 ; do I=is-2,Ieq+2 DX_dyBu = G%dxBu(I,J) * G%IdyBu(I,J) vort_xy_dy(I,j) = DX_dyBu * (vort_xy(I,J) * G%IdxCv(i,J) - vort_xy(I,J-1) * G%IdxCv(i,J-1)) enddo ; enddo + ! Laplacian of vorticity + do J=Jsq-1,Jeq+1 ; do I=Isq-1,Ieq+1 + DY_dxCv = G%dyCv(i,J) * G%IdxCv(i,J) + DX_dyCu = G%dyCu(I,j) * G%IdyCu(I,j) + Del2vort_q(I,J) = DY_dxCv * (vort_xy_dx(i+1,J) * G%IdyT(i+1,j) - vort_xy_dx(i,J) * G%IdyT(i,j)) + & + DX_dyCu * (vort_xy_dy(I,j+1) * G%IdyT(i,j+1) - vort_xy_dy(I,j) * G%IdyT(i,j)) + enddo ; enddo + do J=Jsq,Jeq+1 ; do I=Isq,Ieq+1 + Del2vort_h(i,j) = 0.25*(Del2vort_q(I,J) + Del2vort_q(I-1,J) + Del2vort_q(I,J-1) + Del2vort_q(I-1,J-1)) + enddo ; enddo + if (CS%modified_Leith) then ! Divergence do j=Jsq-1,Jeq+2 ; do i=Isq-1,Ieq+2 @@ -864,7 +869,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, AhSm = CS%Biharm_const_xx(i,j) * Shear_mag endif endif - if (CS%Leith_Ah) AhLth = CS%Biharm5_const_xx(i,j) * vert_vort_mag * inv_PI5 + if (CS%Leith_Ah) AhLth = CS%Biharm6_const_xx(i,j) * abs(Del2vort_h(i,j)) * inv_PI6 Ah = MAX(MAX(CS%Ah_bg_xx(i,j), AhSm), AhLth) if (CS%bound_Ah .and. .not.CS%better_bound_Ah) & Ah = MIN(Ah, CS%Ah_Max_xx(i,j)) @@ -1034,7 +1039,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, AhSm = CS%Biharm_const_xy(I,J) * Shear_mag endif endif - if (CS%Leith_Ah) AhLth = CS%Biharm5_const_xy(I,J) * vert_vort_mag * inv_PI5 + if (CS%Leith_Ah) AhLth = CS%Biharm6_const_xy(I,J) * abs(Del2vort_q(I,J)) * inv_PI6 Ah = MAX(MAX(CS%Ah_bg_xy(I,J), AhSm), AhLth) if (CS%bound_Ah .and. .not.CS%better_bound_Ah) & Ah = MIN(Ah, CS%Ah_Max_xy(I,J)) @@ -1745,8 +1750,8 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) endif endif if (CS%Leith_Ah) then - ALLOC_(CS%biharm5_const_xx(isd:ied,jsd:jed)) ; CS%biharm5_const_xx(:,:) = 0.0 - ALLOC_(CS%biharm5_const_xy(IsdB:IedB,JsdB:JedB)) ; CS%biharm5_const_xy(:,:) = 0.0 + ALLOC_(CS%biharm6_const_xx(isd:ied,jsd:jed)) ; CS%biharm6_const_xx(:,:) = 0.0 + ALLOC_(CS%biharm6_const_xy(IsdB:IedB,JsdB:JedB)) ; CS%biharm6_const_xy(:,:) = 0.0 endif endif @@ -1870,7 +1875,6 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 grid_sp_h2 = (2.0*CS%dx2h(i,j)*CS%dy2h(i,j)) / (CS%dx2h(i,j)+CS%dy2h(i,j)) grid_sp_h3 = grid_sp_h2*sqrt(grid_sp_h2) - if (CS%Smagorinsky_Ah) then CS%Biharm_const_xx(i,j) = Smag_bi_const * (grid_sp_h2 * grid_sp_h2) if (CS%bound_Coriolis) then @@ -1881,7 +1885,7 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) endif endif if (CS%Leith_Ah) then - CS%biharm5_const_xx(i,j) = Leith_bi_const * (grid_sp_h3 * grid_sp_h2) + CS%biharm6_const_xx(i,j) = Leith_bi_const * (grid_sp_h3 * grid_sp_h3) endif CS%Ah_bg_xx(i,j) = MAX(Ah, Ah_vel_scale * grid_sp_h2 * sqrt(grid_sp_h2)) if (Ah_time_scale > 0.) CS%Ah_bg_xx(i,j) = & @@ -1903,7 +1907,7 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) endif endif if (CS%Leith_Ah) then - CS%biharm5_const_xy(i,j) = Leith_bi_const * (grid_sp_q3 * grid_sp_q2) + CS%biharm6_const_xy(i,j) = Leith_bi_const * (grid_sp_q3 * grid_sp_q3) endif CS%Ah_bg_xy(I,J) = MAX(Ah, Ah_vel_scale * grid_sp_q2 * sqrt(grid_sp_q2)) @@ -2035,7 +2039,6 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) CS%id_Kh_q = register_diag_field('ocean_model', 'Khq', diag%axesBL, Time, & 'Laplacian Horizontal Viscosity at q Points', 'm2 s-1', conversion=US%L_to_m**2*US%s_to_T) - if (CS%Leith_Kh) then CS%id_vort_xy_q = register_diag_field('ocean_model', 'vort_xy_q', diag%axesBL, Time, & 'Vertical vorticity at q Points', 's-1', conversion=US%s_to_T) @@ -2199,10 +2202,7 @@ subroutine hor_visc_end(CS) DEALLOC_(CS%Ah_Max_xx) ; DEALLOC_(CS%Ah_Max_xy) endif if (CS%Smagorinsky_Ah) then - DEALLOC_(CS%Biharm5_const_xx) ; DEALLOC_(CS%Biharm5_const_xy) - ! if (CS%bound_Coriolis) then - ! DEALLOC_(CS%Biharm5_const2_xx) ; DEALLOC_(CS%Biharm5_const2_xy) - ! endif + DEALLOC_(CS%Biharm6_const_xx) ; DEALLOC_(CS%Biharm6_const_xy) endif if (CS%Leith_Ah) then DEALLOC_(CS%Biharm_const_xx) ; DEALLOC_(CS%Biharm_const_xy) From 7d228f73a1b098da434a59e54dd9b9c2f5978292 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Mon, 4 May 2020 10:29:48 -0600 Subject: [PATCH 23/53] Add missing OMP directives --- src/parameterizations/lateral/MOM_hor_visc.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index c95ddee281..11fd7b6644 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -477,8 +477,8 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, !$OMP grad_vel_mag_bt_h, grad_vel_mag_bt_q, grad_d2vel_mag_h, & !$OMP meke_res_fn, Shear_mag, vert_vort_mag, hrat_min, visc_bound_rem, & !$OMP Kh, Ah, AhSm, AhLth, local_strain, Sh_F_pow, & - !$OMP dDel2vdx, dDel2udy, & - !$OMP h2uq, h2vq, hu, hv, hq, FatH, RoScl, GME_coeff & + !$OMP dDel2vdx, dDel2udy, DY_dxCv, DX_dyCu, Del2vort_q, Del2vort_h, & + !$OMP h2uq, h2vq, hu, hv, hq, FatH, RoScl, GME_coeff, KE & !$OMP ) do k=1,nz From 933b09abea4fbc2152ed497ba98a07f46d41dc10 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Mon, 4 May 2020 14:26:04 -0600 Subject: [PATCH 24/53] Remove OMP directive that came with cherry-picking --- src/parameterizations/lateral/MOM_hor_visc.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index 11fd7b6644..3aac2c6b38 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -478,7 +478,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, !$OMP meke_res_fn, Shear_mag, vert_vort_mag, hrat_min, visc_bound_rem, & !$OMP Kh, Ah, AhSm, AhLth, local_strain, Sh_F_pow, & !$OMP dDel2vdx, dDel2udy, DY_dxCv, DX_dyCu, Del2vort_q, Del2vort_h, & - !$OMP h2uq, h2vq, hu, hv, hq, FatH, RoScl, GME_coeff, KE & + !$OMP h2uq, h2vq, hu, hv, hq, FatH, RoScl, GME_coeff & !$OMP ) do k=1,nz From c06515f19878517e1de6477f69c609005067b045 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Wed, 6 May 2020 10:15:06 -0600 Subject: [PATCH 25/53] Add tidal diffusivities (Kd_tidal) into Kd_int --- .../vertical/MOM_tidal_mixing.F90 | 20 +++++++++++++++---- 1 file changed, 16 insertions(+), 4 deletions(-) diff --git a/src/parameterizations/vertical/MOM_tidal_mixing.F90 b/src/parameterizations/vertical/MOM_tidal_mixing.F90 index 887cc6d067..14e72f97ea 100644 --- a/src/parameterizations/vertical/MOM_tidal_mixing.F90 +++ b/src/parameterizations/vertical/MOM_tidal_mixing.F90 @@ -681,7 +681,7 @@ subroutine calculate_tidal_mixing(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, US, C real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(inout) :: Kd_lay !< The diapycnal diffusvity in layers [Z2 T-1 ~> m2 s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), & - optional, intent(inout) :: Kd_int !< The diapycnal diffusvity at interfaces, + optional, intent(inout) :: Kd_int !< The diapycnal diffusvity at interfaces, !! [Z2 T-1 ~> m2 s-1]. real, intent(in) :: Kd_max !< The maximum increment for diapycnal !! diffusivity due to TKE-based processes, @@ -692,7 +692,7 @@ subroutine calculate_tidal_mixing(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, US, C if (CS%Int_tide_dissipation .or. CS%Lee_wave_dissipation .or. CS%Lowmode_itidal_dissipation) then if (CS%use_CVMix_tidal) then - call calculate_CVMix_tidal(h, j, G, GV, US, CS, N2_int, Kd_lay, Kv) + call calculate_CVMix_tidal(h, j, G, GV, US, CS, N2_int, Kd_lay, Kd_int, Kv) else call add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, & G, GV, US, CS, N2_lay, Kd_lay, Kd_int, Kd_max) @@ -703,7 +703,7 @@ end subroutine calculate_tidal_mixing !> Calls the CVMix routines to compute tidal dissipation and to add the effect of internal-tide-driven !! mixing to the interface diffusivities. -subroutine calculate_CVMix_tidal(h, j, G, GV, US, CS, N2_int, Kd_lay, Kv) +subroutine calculate_CVMix_tidal(h, j, G, GV, US, CS, N2_int, Kd_lay, Kd_int, Kv) integer, intent(in) :: j !< The j-index to work on type(ocean_grid_type), intent(in) :: G !< Grid structure. type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure @@ -715,6 +715,9 @@ subroutine calculate_CVMix_tidal(h, j, G, GV, US, CS, N2_int, Kd_lay, Kv) intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(inout) :: Kd_lay!< The diapycnal diffusivities in the layers [Z2 T-1 ~> m2 s-1]. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), & + optional, intent(inout) :: Kd_int !< The diapycnal diffusvity at interfaces, + !! [Z2 T-1 ~> m2 s-1]. real, dimension(:,:,:), pointer :: Kv !< The "slow" vertical viscosity at each interface !! (not layer!) [Z2 T-1 ~> m2 s-1]. ! Local variables @@ -794,7 +797,11 @@ subroutine calculate_CVMix_tidal(h, j, G, GV, US, CS, N2_int, Kd_lay, Kv) do k=1,G%ke Kd_lay(i,j,k) = Kd_lay(i,j,k) + 0.5 * US%m2_s_to_Z2_T * (Kd_tidal(k) + Kd_tidal(k+1)) enddo - + if (present(Kd_int)) then + do k=1,G%ke+1 + Kd_int(i,j,k) = Kd_int(i,j,k) + (US%m2_s_to_Z2_T * Kd_tidal(k)) + enddo + endif ! Update viscosity with the proper unit conversion. if (associated(Kv)) then do k=1,G%ke+1 @@ -896,6 +903,11 @@ subroutine calculate_CVMix_tidal(h, j, G, GV, US, CS, N2_int, Kd_lay, Kv) do k=1,G%ke Kd_lay(i,j,k) = Kd_lay(i,j,k) + 0.5 * US%m2_s_to_Z2_T * (Kd_tidal(k) + Kd_tidal(k+1)) enddo + if (present(Kd_int)) then + do k=1,G%ke+1 + Kd_int(i,j,k) = Kd_int(i,j,k) + (US%m2_s_to_Z2_T * Kd_tidal(k)) + enddo + endif ! Update viscosity if (associated(Kv)) then From fab21a74923ed373d158fde0fe80e003cb071baa Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Tue, 19 May 2020 13:54:17 +0000 Subject: [PATCH 26/53] Fixes an integer-kind mismatch in MOM_random, seed_from_time() - gcc/8.3.0 issued `Error: Integer too big for its kind` reported in feedback on PR #1111. The intent was to assume kind=4 in these calculations but apparently our compilers were promoting `mod(dy + 32*(mo + 13*yr), 2147483648)` to kind=8. There were two mistakes in the expression: - the use of `2147483648` in the `mod` is not representable with kind=4; - the `mod` produces negative values and should have been a `modulo`. - This commit reduces the range of the results by one number on the positive side and removes all the negatives. --- src/framework/MOM_random.F90 | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/src/framework/MOM_random.F90 b/src/framework/MOM_random.F90 index c37893012e..14800df9aa 100644 --- a/src/framework/MOM_random.F90 +++ b/src/framework/MOM_random.F90 @@ -143,8 +143,9 @@ integer function seed_from_time(Time) call get_date(Time,yr,mo,dy,hr,mn,sc) s1 = sc + 61*(mn + 61*hr) + 379 ! Range 379 .. 89620 ! Fun fact: 2147483647 is the eighth Mersenne prime. - ! This is not the reason for using 2147483647+1 here. - s2 = mod(dy + 32*(mo + 13*yr), 2147483648) ! Range 0 .. 2147483647 + ! This is not the reason for using 2147483647 here. It is the + ! largest integer of kind=4. + s2 = modulo(dy + 32*(mo + 13*yr), 2147483647_4) ! Range 0 .. 2147483646 seed_from_time = ieor(s1*4111, s2) end function seed_from_time From 2f44ca7ce12410272a185556348547000d095790 Mon Sep 17 00:00:00 2001 From: Alper Altuntas Date: Tue, 19 May 2020 13:03:35 -0600 Subject: [PATCH 27/53] correct conflict resolve in KPP --- src/parameterizations/vertical/MOM_CVMix_KPP.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 index 2a160a3021..a6b370f17e 100644 --- a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 @@ -992,7 +992,7 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, tv, uStar, buoyFl !$OMP deltarho, N2_1d, ws_1d, LangEnhVT2, enhvt2, wst, & !$OMP BulkRi_1d, zBottomMinusOffset) & !$OMP shared(G, GV, CS, US, uStar, h, buoy_scale, buoyFlux, & - !$OMP Temp, Salt, waves, EOS, GoRho, u, v) + !$OMP Temp, Salt, waves, tv, EOS, GoRho, u, v) do j = G%jsc, G%jec do i = G%isc, G%iec From b34478800b61164622271590882f4218b1a15ee6 Mon Sep 17 00:00:00 2001 From: Alper Altuntas Date: Tue, 19 May 2020 13:05:57 -0600 Subject: [PATCH 28/53] undo indent change from conflict resolve --- src/equation_of_state/MOM_EOS.F90 | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/src/equation_of_state/MOM_EOS.F90 b/src/equation_of_state/MOM_EOS.F90 index 25bd7580d9..6de99c5bef 100644 --- a/src/equation_of_state/MOM_EOS.F90 +++ b/src/equation_of_state/MOM_EOS.F90 @@ -1757,15 +1757,15 @@ subroutine int_density_dz_generic_plm (T_t, T_b, S_t, S_b, z_t, z_b, rho_ref, & do I=Isq,Ieq intz(1) = dpa(i,j) ; intz(5) = dpa(i+1,j) - ! Use Bode's rule to estimate the pressure anomaly change. - do m = 2,4 - pos = i*15+(m-2)*5 - intz(m) = G_e*dz_x(m,i)*( C1_90*(7.0*(r15(pos+1)+r15(pos+5)) + 32.0*(r15(pos+2)+r15(pos+4)) + & - 12.0*r15(pos+3))) - enddo - ! Use Bode's rule to integrate the bottom pressure anomaly values in x. - intx_dpa(i,j) = C1_90*(7.0*(intz(1)+intz(5)) + 32.0*(intz(2)+intz(4)) + & - 12.0*intz(3)) + ! Use Bode's rule to estimate the pressure anomaly change. + do m = 2,4 + pos = i*15+(m-2)*5 + intz(m) = G_e*dz_x(m,i)*( C1_90*(7.0*(r15(pos+1)+r15(pos+5)) + 32.0*(r15(pos+2)+r15(pos+4)) + & + 12.0*r15(pos+3))) + enddo + ! Use Bode's rule to integrate the bottom pressure anomaly values in x. + intx_dpa(i,j) = C1_90*(7.0*(intz(1)+intz(5)) + 32.0*(intz(2)+intz(4)) + & + 12.0*intz(3)) enddo enddo endif From 532e65ad51a05dfe29cbc79e719cda765e5b25f8 Mon Sep 17 00:00:00 2001 From: Alper Altuntas Date: Tue, 19 May 2020 14:39:38 -0600 Subject: [PATCH 29/53] undo OMP changes in MOM_EOS --- src/equation_of_state/MOM_EOS.F90 | 33 ++++++++++++++----------------- 1 file changed, 15 insertions(+), 18 deletions(-) diff --git a/src/equation_of_state/MOM_EOS.F90 b/src/equation_of_state/MOM_EOS.F90 index 6de99c5bef..c584b68c89 100644 --- a/src/equation_of_state/MOM_EOS.F90 +++ b/src/equation_of_state/MOM_EOS.F90 @@ -1649,12 +1649,6 @@ subroutine int_density_dz_generic_plm (T_t, T_b, S_t, S_b, z_t, z_b, rho_ref, & ! ============================= ! 1. Compute vertical integrals ! ============================= - - !$OMP parallel default(shared) private(jin,iin,dz,p5,S5,T5,r5,rho_anom,hWght,hL,hR,iDenom,Ttl,Ttr, & - !$OMP Tbl,Tbr,Stl,Str,Sbl,Sbr,w_left,w_right,dz_x,dz_y,pos,T15,S15, & - !$OMP p15,r15,weight_t,weight_b,intz) - - !$OMP do do j=Jsq,Jeq+1 do i = Isq,Ieq+1 dz(i) = z_t(i,j) - z_b(i,j) @@ -1747,6 +1741,7 @@ subroutine int_density_dz_generic_plm (T_t, T_b, S_t, S_b, z_t, z_b, rho_ref, & T15(pos+n) = weight_t * T15(pos+1) + weight_b * T15(pos+5) enddo enddo + enddo if (rho_scale /= 1.0) then call calculate_density(T15, S15, p15, r15, 1, 15*(ieq-isq+1), EOS, rho_ref=rho_ref_mks, scale=rho_scale) @@ -1757,18 +1752,17 @@ subroutine int_density_dz_generic_plm (T_t, T_b, S_t, S_b, z_t, z_b, rho_ref, & do I=Isq,Ieq intz(1) = dpa(i,j) ; intz(5) = dpa(i+1,j) - ! Use Bode's rule to estimate the pressure anomaly change. - do m = 2,4 - pos = i*15+(m-2)*5 - intz(m) = G_e*dz_x(m,i)*( C1_90*(7.0*(r15(pos+1)+r15(pos+5)) + 32.0*(r15(pos+2)+r15(pos+4)) + & - 12.0*r15(pos+3))) - enddo - ! Use Bode's rule to integrate the bottom pressure anomaly values in x. - intx_dpa(i,j) = C1_90*(7.0*(intz(1)+intz(5)) + 32.0*(intz(2)+intz(4)) + & - 12.0*intz(3)) + ! Use Bode's rule to estimate the pressure anomaly change. + do m = 2,4 + pos = i*15+(m-2)*5 + intz(m) = G_e*dz_x(m,i)*( C1_90*(7.0*(r15(pos+1)+r15(pos+5)) + 32.0*(r15(pos+2)+r15(pos+4)) + & + 12.0*r15(pos+3))) enddo + ! Use Bode's rule to integrate the bottom pressure anomaly values in x. + intx_dpa(i,j) = C1_90*(7.0*(intz(1)+intz(5)) + 32.0*(intz(2)+intz(4)) + & + 12.0*intz(3)) enddo - endif + enddo ; endif ! ================================================== ! 3. Compute horizontal integrals in the y direction @@ -1830,6 +1824,7 @@ subroutine int_density_dz_generic_plm (T_t, T_b, S_t, S_b, z_t, z_b, rho_ref, & T15(pos+n) = weight_t * T15(pos+1) + weight_b * T15(pos+5) enddo enddo + enddo if (rho_scale /= 1.0) then call calculate_density_array(T15(15*HI%isc+1:), S15(15*HI%isc+1:), p15(15*HI%isc+1:), & @@ -1849,9 +1844,11 @@ subroutine int_density_dz_generic_plm (T_t, T_b, S_t, S_b, z_t, z_b, rho_ref, & 32.0*(r15(pos+2)+r15(pos+4)) + & 12.0*r15(pos+3))) enddo + ! Use Bode's rule to integrate the values. + inty_dpa(i,j) = C1_90*(7.0*(intz(1)+intz(5)) + 32.0*(intz(2)+intz(4)) + & + 12.0*intz(3)) enddo - endif - !$OMP end parallel + enddo ; endif end subroutine int_density_dz_generic_plm ! ========================================================================== From 97547426a9942e4c1acb3a68e38b61d70fb77b61 Mon Sep 17 00:00:00 2001 From: Alper Altuntas Date: Tue, 19 May 2020 16:24:15 -0600 Subject: [PATCH 30/53] Fix OMP directives broken by merge --- src/parameterizations/vertical/MOM_CVMix_KPP.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 index a6b370f17e..01a39d394b 100644 --- a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 @@ -992,7 +992,7 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, tv, uStar, buoyFl !$OMP deltarho, N2_1d, ws_1d, LangEnhVT2, enhvt2, wst, & !$OMP BulkRi_1d, zBottomMinusOffset) & !$OMP shared(G, GV, CS, US, uStar, h, buoy_scale, buoyFlux, & - !$OMP Temp, Salt, waves, tv, EOS, GoRho, u, v) + !$OMP Temp, Salt, waves, tv, GoRho, u, v) do j = G%jsc, G%jec do i = G%isc, G%iec @@ -1317,7 +1317,7 @@ subroutine KPP_smooth_BLD(CS,G,GV,h) ! apply smoothing on OBL depth !$OMP parallel do default(none) shared(G, GV, CS, h, OBLdepth_prev) & - !$OMP private(wc, ww, we, wn, ws, dh, hcorr, pref, cellHeight, iFaceHeight) + !$OMP private(wc, ww, we, wn, ws, dh, hcorr, cellHeight, iFaceHeight) do j = G%jsc, G%jec do i = G%isc, G%iec @@ -1382,7 +1382,7 @@ subroutine KPP_get_BLD(CS, BLD, G, US, m_to_BLD_units) scale = US%m_to_Z ; if (present(m_to_BLD_units)) scale = m_to_BLD_units - !$OMP parallel do default(none) shared(BLD, CS, G) + !$OMP parallel do default(none) shared(BLD, CS, G, scale) do j = G%jsc, G%jec ; do i = G%isc, G%iec BLD(i,j) = scale * CS%OBLdepth(i,j) enddo ; enddo From 4041cc90b81ff51dc8ae1e981bb847bbdaa15f49 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Mon, 25 May 2020 12:12:52 -0600 Subject: [PATCH 31/53] Fix bug when applying ND only in the interior When using the option to apply neutral diffusion only below the surface boundary layer we were using (1.-zeta). This is wrong. It should be just (zeta). --- src/tracer/MOM_neutral_diffusion.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/tracer/MOM_neutral_diffusion.F90 b/src/tracer/MOM_neutral_diffusion.F90 index 30cdec3b37..890bae928c 100644 --- a/src/tracer/MOM_neutral_diffusion.F90 +++ b/src/tracer/MOM_neutral_diffusion.F90 @@ -461,7 +461,7 @@ subroutine neutral_diffusion_calc_coeffs(G, GV, US, h, T, S, CS, p_surf) CS%Pint(i,j,:), CS%Tint(i,j,:), CS%Sint(i,j,:), CS%dRdT(i,j,:), CS%dRdS(i,j,:), & CS%Pint(i+1,j,:), CS%Tint(i+1,j,:), CS%Sint(i+1,j,:), CS%dRdT(i+1,j,:), CS%dRdS(i+1,j,:), & CS%uPoL(I,j,:), CS%uPoR(I,j,:), CS%uKoL(I,j,:), CS%uKoR(I,j,:), CS%uhEff(I,j,:), & - k_bot(I,j), k_bot(I+1,j), 1.-zeta_bot(I,j), 1.-zeta_bot(I+1,j)) + k_bot(I,j), k_bot(I+1,j), zeta_bot(I,j), zeta_bot(I+1,j)) else call find_neutral_surface_positions_discontinuous(CS, G%ke, & CS%P_i(i,j,:,:), h(i,j,:), CS%T_i(i,j,:,:), CS%S_i(i,j,:,:), CS%ppoly_coeffs_T(i,j,:,:), & @@ -482,7 +482,7 @@ subroutine neutral_diffusion_calc_coeffs(G, GV, US, h, T, S, CS, p_surf) CS%Pint(i,j,:), CS%Tint(i,j,:), CS%Sint(i,j,:), CS%dRdT(i,j,:), CS%dRdS(i,j,:), & CS%Pint(i,j+1,:), CS%Tint(i,j+1,:), CS%Sint(i,j+1,:), CS%dRdT(i,j+1,:), CS%dRdS(i,j+1,:), & CS%vPoL(i,J,:), CS%vPoR(i,J,:), CS%vKoL(i,J,:), CS%vKoR(i,J,:), CS%vhEff(i,J,:), & - k_bot(i,J), k_bot(i,J+1), 1.-zeta_bot(i,J), 1.-zeta_bot(i,J+1)) + k_bot(i,J), k_bot(i,J+1), zeta_bot(i,J), zeta_bot(i,J+1)) else call find_neutral_surface_positions_discontinuous(CS, G%ke, & CS%P_i(i,j,:,:), h(i,j,:), CS%T_i(i,j,:,:), CS%S_i(i,j,:,:), CS%ppoly_coeffs_T(i,j,:,:), & From a69aea96164c73db20b3e1b204b7ff89e704799c Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Thu, 28 May 2020 16:23:40 -0600 Subject: [PATCH 32/53] Add new diagnostics Moved calculation of vorticity and divergence outside the Leith loop. Added diagnostics for shearing strain and horizontal tension. --- .../lateral/MOM_hor_visc.F90 | 56 +++++++++++-------- 1 file changed, 33 insertions(+), 23 deletions(-) diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index 0a126f10d8..a60d60bb9d 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -179,6 +179,7 @@ module MOM_hor_visc integer :: id_Kh_h = -1, id_Kh_q = -1 integer :: id_GME_coeff_h = -1, id_GME_coeff_q = -1 integer :: id_vort_xy_q = -1, id_div_xx_h = -1 + integer :: id_sh_xy_q = -1, id_sh_xx_h = -1 integer :: id_FrictWork = -1, id_FrictWorkIntz = -1 integer :: id_FrictWork_GME = -1 !>@} @@ -288,6 +289,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, Ah_q, & ! biharmonic viscosity at corner points [L4 T-1 ~> m4 s-1] Kh_q, & ! Laplacian viscosity at corner points [L2 T-1 ~> m2 s-1] vort_xy_q, & ! vertical vorticity at corner points [T-1 ~> s-1] + sh_xy_q, & ! horizontal shearing strain at corner points [T-1 ~> s-1] GME_coeff_q, & !< GME coeff. at q-points [L2 T-1 ~> m2 s-1] max_diss_rate_q ! maximum possible energy dissipated by lateral friction [L2 T-3 ~> m2 s-3] @@ -301,7 +303,8 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, max_diss_rate_h, & ! maximum possible energy dissipated by lateral friction [L2 T-3 ~> m2 s-3] FrictWork, & ! work done by MKE dissipation mechanisms [R L2 T-3 ~> W m-2] FrictWork_GME, & ! work done by GME [R L2 T-3 ~> W m-2] - div_xx_h ! horizontal divergence [T-1 ~> s-1] + div_xx_h, & ! horizontal divergence [T-1 ~> s-1] + sh_xx_h ! horizontal tension (du/dx - dv/dy) including metric terms [T-1 ~> s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & grid_Re_Kh, & !< Grid Reynolds number for Laplacian horizontal viscosity at h points [nondim] grid_Re_Ah, & !< Grid Reynolds number for Biharmonic horizontal viscosity at h points [nondim] @@ -478,7 +481,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, !$OMP h_neglect, h_neglect3, FWfrac, inv_PI3, inv_PI6, H0_GME, & !$OMP diffu, diffv, max_diss_rate_h, max_diss_rate_q, & !$OMP Kh_h, Kh_q, Ah_h, Ah_q, FrictWork, FrictWork_GME, & - !$OMP div_xx_h, vort_xy_q, GME_coeff_h, GME_coeff_q, & + !$OMP div_xx_h, sh_xx_h, vort_xy_q, sh_xy_q, GME_coeff_h, GME_coeff_q, & !$OMP TD, KH_u_GME, KH_v_GME, grid_Re_Kh, grid_Re_Ah & !$OMP ) & !$OMP private( & @@ -689,18 +692,23 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, endif; endif endif - if ((CS%Leith_Kh) .or. (CS%Leith_Ah)) then + ! Vorticity + if (CS%no_slip) then + do J=js-2,Jeq+2 ; do I=is-2,Ieq+2 + vort_xy(I,J) = (2.0-G%mask2dBu(I,J)) * ( dvdx(I,J) - dudy(I,J) ) + enddo ; enddo + else + do J=js-2,Jeq+2 ; do I=is-2,Ieq+2 + vort_xy(I,J) = G%mask2dBu(I,J) * ( dvdx(I,J) - dudy(I,J) ) + enddo ; enddo + endif - ! Vorticity - if (CS%no_slip) then - do J=js-2,Jeq+2 ; do I=is-2,Ieq+2 - vort_xy(I,J) = (2.0-G%mask2dBu(I,J)) * ( dvdx(I,J) - dudy(I,J) ) - enddo ; enddo - else - do J=js-2,Jeq+2 ; do I=is-2,Ieq+2 - vort_xy(I,J) = G%mask2dBu(I,J) * ( dvdx(I,J) - dudy(I,J) ) - enddo ; enddo - endif + ! Divergence + do j=Jsq-1,Jeq+2 ; do i=Isq-1,Ieq+2 + div_xx(i,j) = dudx(i,j) + dvdy(i,j) + enddo ; enddo + + if ((CS%Leith_Kh) .or. (CS%Leith_Ah)) then ! Vorticity gradient do J=js-2,Jeq+2 ; do i=is-1,Ieq+2 @@ -725,10 +733,6 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, enddo ; enddo if (CS%modified_Leith) then - ! Divergence - do j=Jsq-1,Jeq+2 ; do i=Isq-1,Ieq+2 - div_xx(i,j) = dudx(i,j) + dvdy(i,j) - enddo ; enddo ! Divergence gradient do j=Jsq-1,Jeq+2 ; do I=Isq-1,Ieq+1 @@ -865,6 +869,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, endif if (CS%id_div_xx_h>0) div_xx_h(i,j,k) = div_xx(i,j) + if (CS%id_sh_xx_h>0) sh_xx_h(i,j,k) = sh_xx(i,j) str_xx(i,j) = -Kh * sh_xx(i,j) else ! not Laplacian @@ -1045,6 +1050,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, if (CS%id_Kh_q>0 .or. CS%debug) Kh_q(I,J,k) = Kh if (CS%id_vort_xy_q>0) vort_xy_q(I,J,k) = vort_xy(I,J) + if (CS%id_sh_xy_q>0) sh_xy_q(I,J,k) = sh_xy(I,J) str_xy(I,J) = -Kh * sh_xy(I,J) else ! not Laplacian @@ -1325,6 +1331,8 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, if (CS%id_grid_Re_Ah>0) call post_data(CS%id_grid_Re_Ah, grid_Re_Ah, CS%diag) if (CS%id_div_xx_h>0) call post_data(CS%id_div_xx_h, div_xx_h, CS%diag) if (CS%id_vort_xy_q>0) call post_data(CS%id_vort_xy_q, vort_xy_q, CS%diag) + if (CS%id_sh_xx_h>0) call post_data(CS%id_sh_xx_h, sh_xx_h, CS%diag) + if (CS%id_sh_xy_q>0) call post_data(CS%id_sh_xy_q, sh_xy_q, CS%diag) if (CS%id_Ah_q>0) call post_data(CS%id_Ah_q, Ah_q, CS%diag) if (CS%id_Kh_h>0) call post_data(CS%id_Kh_h, Kh_h, CS%diag) if (CS%id_grid_Re_Kh>0) call post_data(CS%id_grid_Re_Kh, grid_Re_Kh, CS%diag) @@ -2037,12 +2045,14 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) 'Laplacian Horizontal Viscosity at q Points', 'm2 s-1', conversion=US%L_to_m**2*US%s_to_T) CS%id_grid_Re_Kh = register_diag_field('ocean_model', 'grid_Re_Kh', diag%axesTL, Time, & 'Grid Reynolds number for the Laplacian horizontal viscosity at h points', 'nondim') - if (CS%Leith_Kh) then - CS%id_vort_xy_q = register_diag_field('ocean_model', 'vort_xy_q', diag%axesBL, Time, & - 'Vertical vorticity at q Points', 's-1', conversion=US%s_to_T) - CS%id_div_xx_h = register_diag_field('ocean_model', 'div_xx_h', diag%axesTL, Time, & - 'Horizontal divergence at h Points', 's-1', conversion=US%s_to_T) - endif + CS%id_vort_xy_q = register_diag_field('ocean_model', 'vort_xy_q', diag%axesBL, Time, & + 'Vertical vorticity at q Points', 's-1', conversion=US%s_to_T) + CS%id_div_xx_h = register_diag_field('ocean_model', 'div_xx_h', diag%axesTL, Time, & + 'Horizontal divergence at h Points', 's-1', conversion=US%s_to_T) + CS%id_sh_xy_q = register_diag_field('ocean_model', 'sh_xy_q', diag%axesBL, Time, & + 'Shearing strain at q Points', 's-1', conversion=US%s_to_T) + CS%id_sh_xx_h = register_diag_field('ocean_model', 'sh_xx_h', diag%axesTL, Time, & + 'Horizontal tension at h Points', 's-1', conversion=US%s_to_T) endif if (CS%use_GME) then CS%id_GME_coeff_h = register_diag_field('ocean_model', 'GME_coeff_h', diag%axesTL, Time, & From 473c3f47b70998e5a7a84e7e0ca0d08588049938 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Tue, 9 Jun 2020 13:24:38 -0600 Subject: [PATCH 33/53] Remove unused module --- config_src/nuopc_driver/mom_cap.F90 | 1 - 1 file changed, 1 deletion(-) diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index 219245e473..6b8d11141b 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -15,7 +15,6 @@ module MOM_cap_mod use mpp_mod, only: stdlog, stdout, mpp_root_pe, mpp_clock_id use mpp_mod, only: mpp_clock_begin, mpp_clock_end, MPP_CLOCK_SYNC use mpp_mod, only: MPP_CLOCK_DETAILED, CLOCK_COMPONENT, MAXPES -use time_interp_external_mod, only: time_interp_external_init use time_manager_mod, only: set_calendar_type, time_type, increment_date use time_manager_mod, only: set_time, set_date, get_time, get_date, month_name use time_manager_mod, only: GREGORIAN, JULIAN, NOLEAP, THIRTY_DAY_MONTHS, NO_CALENDAR From abb10ed4cd3054dd2a0ba2d5c099ea0bd0620cc2 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Tue, 9 Jun 2020 14:00:20 -0600 Subject: [PATCH 34/53] Add calls to time_interp_external_init --- config_src/mct_driver/mom_ocean_model_mct.F90 | 103 +++++++++--------- .../nuopc_driver/mom_ocean_model_nuopc.F90 | 3 + 2 files changed, 56 insertions(+), 50 deletions(-) diff --git a/config_src/mct_driver/mom_ocean_model_mct.F90 b/config_src/mct_driver/mom_ocean_model_mct.F90 index f8a4a19532..2f94c9b7f9 100644 --- a/config_src/mct_driver/mom_ocean_model_mct.F90 +++ b/config_src/mct_driver/mom_ocean_model_mct.F90 @@ -11,56 +11,57 @@ module MOM_ocean_model_mct ! This code is a stop-gap wrapper of the MOM6 code to enable it to be called ! in the same way as MOM4. -use MOM, only : initialize_MOM, step_MOM, MOM_control_struct, MOM_end -use MOM, only : extract_surface_state, allocate_surface_state, finish_MOM_initialization -use MOM, only : get_MOM_state_elements, MOM_state_is_synchronized -use MOM, only : get_ocean_stocks, step_offline -use MOM_constants, only : CELSIUS_KELVIN_OFFSET, hlf -use MOM_diag_mediator, only : diag_ctrl, enable_averaging, disable_averaging -use MOM_diag_mediator, only : diag_mediator_close_registration, diag_mediator_end -use MOM_domains, only : pass_var, pass_vector, AGRID, BGRID_NE, CGRID_NE -use MOM_domains, only : TO_ALL, Omit_Corners -use MOM_error_handler, only : MOM_error, FATAL, WARNING, is_root_pe -use MOM_error_handler, only : callTree_enter, callTree_leave -use MOM_file_parser, only : get_param, log_version, close_param_file, param_file_type -use MOM_forcing_type, only : allocate_forcing_type -use MOM_forcing_type, only : forcing, mech_forcing -use MOM_forcing_type, only : forcing_accumulate, copy_common_forcing_fields -use MOM_forcing_type, only : copy_back_forcing_fields, set_net_mass_forcing -use MOM_forcing_type, only : set_derived_forcing_fields -use MOM_forcing_type, only : forcing_diagnostics, mech_forcing_diags -use MOM_get_input, only : Get_MOM_Input, directories -use MOM_grid, only : ocean_grid_type -use MOM_io, only : close_file, file_exists, read_data, write_version_number -use MOM_marine_ice, only : iceberg_forces, iceberg_fluxes, marine_ice_init, marine_ice_CS -use MOM_restart, only : MOM_restart_CS, save_restart -use MOM_string_functions, only : uppercase -use MOM_surface_forcing_mct, only : surface_forcing_init, convert_IOB_to_fluxes -use MOM_surface_forcing_mct, only : convert_IOB_to_forces, ice_ocn_bnd_type_chksum -use MOM_surface_forcing_mct, only : ice_ocean_boundary_type, surface_forcing_CS -use MOM_surface_forcing_mct, only : forcing_save_restart -use MOM_time_manager, only : time_type, get_time, set_time, operator(>) -use MOM_time_manager, only : operator(+), operator(-), operator(*), operator(/) -use MOM_time_manager, only : operator(/=), operator(<=), operator(>=) -use MOM_time_manager, only : operator(<), real_to_time_type, time_type_to_real -use MOM_tracer_flow_control, only : call_tracer_register, tracer_flow_control_init -use MOM_tracer_flow_control, only : call_tracer_flux_init -use MOM_unit_scaling, only : unit_scale_type -use MOM_variables, only : surface -use MOM_verticalGrid, only : verticalGrid_type -use MOM_ice_shelf, only : initialize_ice_shelf, shelf_calc_flux, ice_shelf_CS -use MOM_ice_shelf, only : add_shelf_forces, ice_shelf_end, ice_shelf_save_restart -use coupler_types_mod, only : coupler_1d_bc_type, coupler_2d_bc_type -use coupler_types_mod, only : coupler_type_spawn, coupler_type_write_chksums -use coupler_types_mod, only : coupler_type_initialized, coupler_type_copy_data -use coupler_types_mod, only : coupler_type_set_diags, coupler_type_send_data -use mpp_domains_mod, only : domain2d, mpp_get_layout, mpp_get_global_domain -use mpp_domains_mod, only : mpp_define_domains, mpp_get_compute_domain, mpp_get_data_domain -use fms_mod, only : stdout -use mpp_mod, only : mpp_chksum -use MOM_EOS, only : gsw_sp_from_sr, gsw_pt_from_ct -use MOM_wave_interface, only: wave_parameters_CS, MOM_wave_interface_init -use MOM_wave_interface, only: MOM_wave_interface_init_lite, Update_Surface_Waves +use MOM, only : initialize_MOM, step_MOM, MOM_control_struct, MOM_end +use MOM, only : extract_surface_state, allocate_surface_state, finish_MOM_initialization +use MOM, only : get_MOM_state_elements, MOM_state_is_synchronized +use MOM, only : get_ocean_stocks, step_offline +use MOM_constants, only : CELSIUS_KELVIN_OFFSET, hlf +use MOM_diag_mediator, only : diag_ctrl, enable_averaging, disable_averaging +use MOM_diag_mediator, only : diag_mediator_close_registration, diag_mediator_end +use MOM_domains, only : pass_var, pass_vector, AGRID, BGRID_NE, CGRID_NE +use MOM_domains, only : TO_ALL, Omit_Corners +use MOM_error_handler, only : MOM_error, FATAL, WARNING, is_root_pe +use MOM_error_handler, only : callTree_enter, callTree_leave +use MOM_file_parser, only : get_param, log_version, close_param_file, param_file_type +use MOM_forcing_type, only : allocate_forcing_type +use MOM_forcing_type, only : forcing, mech_forcing +use MOM_forcing_type, only : forcing_accumulate, copy_common_forcing_fields +use MOM_forcing_type, only : copy_back_forcing_fields, set_net_mass_forcing +use MOM_forcing_type, only : set_derived_forcing_fields +use MOM_forcing_type, only : forcing_diagnostics, mech_forcing_diags +use MOM_get_input, only : Get_MOM_Input, directories +use MOM_grid, only : ocean_grid_type +use MOM_io, only : close_file, file_exists, read_data, write_version_number +use MOM_marine_ice, only : iceberg_forces, iceberg_fluxes, marine_ice_init, marine_ice_CS +use MOM_restart, only : MOM_restart_CS, save_restart +use MOM_string_functions, only : uppercase +use MOM_surface_forcing_mct, only : surface_forcing_init, convert_IOB_to_fluxes +use MOM_surface_forcing_mct, only : convert_IOB_to_forces, ice_ocn_bnd_type_chksum +use MOM_surface_forcing_mct, only : ice_ocean_boundary_type, surface_forcing_CS +use MOM_surface_forcing_mct, only : forcing_save_restart +use MOM_time_manager, only : time_type, get_time, set_time, operator(>) +use MOM_time_manager, only : operator(+), operator(-), operator(*), operator(/) +use MOM_time_manager, only : operator(/=), operator(<=), operator(>=) +use MOM_time_manager, only : operator(<), real_to_time_type, time_type_to_real +use MOM_tracer_flow_control, only : call_tracer_register, tracer_flow_control_init +use MOM_tracer_flow_control, only : call_tracer_flux_init +use MOM_unit_scaling, only : unit_scale_type +use MOM_variables, only : surface +use MOM_verticalGrid, only : verticalGrid_type +use MOM_ice_shelf, only : initialize_ice_shelf, shelf_calc_flux, ice_shelf_CS +use MOM_ice_shelf, only : add_shelf_forces, ice_shelf_end, ice_shelf_save_restart +use coupler_types_mod, only : coupler_1d_bc_type, coupler_2d_bc_type +use coupler_types_mod, only : coupler_type_spawn, coupler_type_write_chksums +use coupler_types_mod, only : coupler_type_initialized, coupler_type_copy_data +use coupler_types_mod, only : coupler_type_set_diags, coupler_type_send_data +use mpp_domains_mod, only : domain2d, mpp_get_layout, mpp_get_global_domain +use mpp_domains_mod, only : mpp_define_domains, mpp_get_compute_domain, mpp_get_data_domain +use fms_mod, only : stdout +use mpp_mod, only : mpp_chksum +use MOM_EOS, only : gsw_sp_from_sr, gsw_pt_from_ct +use MOM_wave_interface, only : wave_parameters_CS, MOM_wave_interface_init +use MOM_wave_interface, only : MOM_wave_interface_init_lite, Update_Surface_Waves +use time_interp_external_mod, only : time_interp_external_init ! MCT specfic routines use MOM_domains, only : MOM_infra_end @@ -265,6 +266,8 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i OS%is_ocean_pe = Ocean_sfc%is_ocean_pe if (.not.OS%is_ocean_pe) return + call time_interp_external_init + OS%Time = Time_in call initialize_MOM(OS%Time, Time_init, param_file, OS%dirs, OS%MOM_CSp, & OS%restart_CSp, Time_in, offline_tracer_mode=OS%offline_tracer_mode, & diff --git a/config_src/nuopc_driver/mom_ocean_model_nuopc.F90 b/config_src/nuopc_driver/mom_ocean_model_nuopc.F90 index 9946aec4f9..aabf456ca8 100644 --- a/config_src/nuopc_driver/mom_ocean_model_nuopc.F90 +++ b/config_src/nuopc_driver/mom_ocean_model_nuopc.F90 @@ -39,6 +39,7 @@ module MOM_ocean_model_nuopc use MOM_time_manager, only : operator(+), operator(-), operator(*), operator(/) use MOM_time_manager, only : operator(/=), operator(<=), operator(>=) use MOM_time_manager, only : operator(<), real_to_time_type, time_type_to_real +use time_interp_external_mod,only : time_interp_external_init use MOM_tracer_flow_control, only : call_tracer_register, tracer_flow_control_init use MOM_tracer_flow_control, only : call_tracer_flux_init use MOM_unit_scaling, only : unit_scale_type @@ -267,6 +268,8 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i OS%is_ocean_pe = Ocean_sfc%is_ocean_pe if (.not.OS%is_ocean_pe) return + call time_interp_external_init + OS%Time = Time_in call initialize_MOM(OS%Time, Time_init, param_file, OS%dirs, OS%MOM_CSp, & OS%restart_CSp, Time_in, offline_tracer_mode=OS%offline_tracer_mode, & From 7f478aa3e3734de8d0b88ad143e41f468e373d18 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Mon, 25 May 2020 12:13:34 -0600 Subject: [PATCH 35/53] Add option to apply linear decay at the base of hbl This patch adds the option to apply a linear decay of the fluxes at the base of hbl. This had been already implemented but since it breaks the unit tests, which were designed to work without this option, adding this option will avoid breaking the tests. Also adding minor improvements in the bulk method. --- src/tracer/MOM_lateral_boundary_diffusion.F90 | 271 +++++++++++------- 1 file changed, 175 insertions(+), 96 deletions(-) diff --git a/src/tracer/MOM_lateral_boundary_diffusion.F90 b/src/tracer/MOM_lateral_boundary_diffusion.F90 index f244931376..a4b4bcb567 100644 --- a/src/tracer/MOM_lateral_boundary_diffusion.F90 +++ b/src/tracer/MOM_lateral_boundary_diffusion.F90 @@ -23,8 +23,7 @@ module MOM_lateral_boundary_diffusion use MOM_CVMix_KPP, only : KPP_get_BLD, KPP_CS use MOM_energetic_PBL, only : energetic_PBL_get_MLD, energetic_PBL_CS use MOM_diabatic_driver, only : diabatic_CS, extract_diabatic_member - -use iso_fortran_env, only : stdout=>output_unit, stderr=>error_unit +use iso_fortran_env, only : stdout=>output_unit, stderr=>error_unit implicit none ; private @@ -38,15 +37,18 @@ module MOM_lateral_boundary_diffusion !> Sets parameters for lateral boundary mixing module. type, public :: lateral_boundary_diffusion_CS ; private - integer :: method !< Determine which of the three methods calculate - !! and apply near boundary layer fluxes - !! 1. Bulk-layer approach - !! 2. Along layer - integer :: deg !< Degree of polynomial reconstruction - integer :: surface_boundary_scheme !< Which boundary layer scheme to use - !! 1. ePBL; 2. KPP - logical :: limiter !< Controls wether a flux limiter is applied. - !! Only valid when method = 1. + integer :: method !< Determine which of the three methods calculate + !! and apply near boundary layer fluxes + !! 1. Bulk-layer approach + !! 2. Along layer + integer :: deg !< Degree of polynomial reconstruction + integer :: surface_boundary_scheme !< Which boundary layer scheme to use + !! 1. ePBL; 2. KPP + logical :: limiter !< Controls wether a flux limiter is applied. + !! Only valid when method = 1. + logical :: linear !< If True, apply a linear transition at the base/top of the boundary. + !! The flux will be fully applied at k=k_min and zero at k=k_max. + type(remapping_CS) :: remap_CS !< Control structure to hold remapping configuration type(KPP_CS), pointer :: KPP_CSp => NULL() !< KPP control structure needed to get BLD type(energetic_PBL_CS), pointer :: energetic_PBL_CSp => NULL() !< ePBL control structure needed to get BLD @@ -110,6 +112,9 @@ logical function lateral_boundary_diffusion_init(Time, G, param_file, diag, diab "If True, apply a flux limiter in the LBD. This is only available \n"//& "when LATERAL_BOUNDARY_METHOD=1.", default=.false.) endif + call get_param(param_file, mdl, "LBD_LINEAR_TRANSITION", CS%linear, & + "If True, apply a linear transition at the base/top of the boundary. \n"//& + "The flux will be fully applied at k=k_min and zero at k=k_max.", default=.false.) call get_param(param_file, mdl, "LBD_BOUNDARY_EXTRAP", boundary_extrap, & "Use boundary extrapolation in LBD code", & default=.false.) @@ -179,6 +184,7 @@ subroutine lateral_boundary_diffusion(G, GV, US, h, Coef_x, Coef_y, dt, Reg, CS) call build_reconstructions_1d( CS%remap_CS, G%ke, h(i,j,:), tracer%t(i,j,:), ppoly0_coefs(i,j,:,:), & ppoly0_E(i,j,:,:), ppoly_S, remap_method, GV%H_subroundoff, GV%H_subroundoff) enddo ; enddo + ! Diffusive fluxes in the i-direction uFlx(:,:,:) = 0. vFlx(:,:,:) = 0. @@ -193,7 +199,8 @@ subroutine lateral_boundary_diffusion(G, GV, US, h, Coef_x, Coef_y, dt, Reg, CS) call fluxes_bulk_method(SURFACE, GV%ke, CS%deg, h(I,j,:), h(I+1,j,:), hbl(I,j), hbl(I+1,j), & G%areaT(I,j), G%areaT(I+1,j), tracer%t(I,j,:), tracer%t(I+1,j,:), & ppoly0_coefs(I,j,:,:), ppoly0_coefs(I+1,j,:,:), ppoly0_E(I,j,:,:), & - ppoly0_E(I+1,j,:,:), remap_method, Coef_x(I,j), uFlx_bulk(I,j), uFlx(I,j,:), CS%limiter) + ppoly0_E(I+1,j,:,:), remap_method, Coef_x(I,j), uFlx_bulk(I,j), uFlx(I,j,:), CS%limiter, & + CS%linear) endif enddo enddo @@ -203,7 +210,8 @@ subroutine lateral_boundary_diffusion(G, GV, US, h, Coef_x, Coef_y, dt, Reg, CS) call fluxes_bulk_method(SURFACE, GV%ke, CS%deg, h(i,J,:), h(i,J+1,:), hbl(i,J), hbl(i,J+1), & G%areaT(i,J), G%areaT(i,J+1), tracer%t(i,J,:), tracer%t(i,J+1,:), & ppoly0_coefs(i,J,:,:), ppoly0_coefs(i,J+1,:,:), ppoly0_E(i,J,:,:), & - ppoly0_E(i,J+1,:,:), remap_method, Coef_y(i,J), vFlx_bulk(i,J), vFlx(i,J,:), CS%limiter) + ppoly0_E(i,J+1,:,:), remap_method, Coef_y(i,J), vFlx_bulk(i,J), vFlx(i,J,:), CS%limiter, & + CS%linear) endif enddo enddo @@ -216,18 +224,20 @@ subroutine lateral_boundary_diffusion(G, GV, US, h, Coef_x, Coef_y, dt, Reg, CS) do j=G%jsc,G%jec do i=G%isc-1,G%iec if (G%mask2dCu(I,j)>0.) then - call fluxes_layer_method(SURFACE, GV%ke, CS%deg, h(I,j,:), h(I+1,j,:), hbl(I,j), hbl(I+1,j), & - G%areaT(I,j), G%areaT(I+1,j), tracer%t(I,j,:), tracer%t(I+1,j,:), ppoly0_coefs(I,j,:,:), & - ppoly0_coefs(I+1,j,:,:), ppoly0_E(I,j,:,:), ppoly0_E(I+1,j,:,:), remap_method, Coef_x(I,j), uFlx(I,j,:)) + call fluxes_layer_method(SURFACE, GV%ke, CS%deg, h(I,j,:), h(I+1,j,:), hbl(I,j), hbl(I+1,j), & + G%areaT(I,j), G%areaT(I+1,j), tracer%t(I,j,:), tracer%t(I+1,j,:), ppoly0_coefs(I,j,:,:), & + ppoly0_coefs(I+1,j,:,:), ppoly0_E(I,j,:,:), ppoly0_E(I+1,j,:,:), remap_method, Coef_x(I,j), & + uFlx(I,j,:), CS%linear) endif enddo enddo do J=G%jsc-1,G%jec do i=G%isc,G%iec if (G%mask2dCv(i,J)>0.) then - call fluxes_layer_method(SURFACE, GV%ke, CS%deg, h(i,J,:), h(i,J+1,:), hbl(i,J), hbl(i,J+1), & - G%areaT(i,J), G%areaT(i,J+1), tracer%t(i,J,:), tracer%t(i,J+1,:), ppoly0_coefs(i,J,:,:), & - ppoly0_coefs(i,J+1,:,:), ppoly0_E(i,J,:,:), ppoly0_E(i,J+1,:,:), remap_method, Coef_y(i,J), vFlx(i,J,:)) + call fluxes_layer_method(SURFACE, GV%ke, CS%deg, h(i,J,:), h(i,J+1,:), hbl(i,J), hbl(i,J+1), & + G%areaT(i,J), G%areaT(i,J+1), tracer%t(i,J,:), tracer%t(i,J+1,:), ppoly0_coefs(i,J,:,:), & + ppoly0_coefs(i,J+1,:,:), ppoly0_E(i,J,:,:), ppoly0_E(i,J+1,:,:), remap_method, Coef_y(i,J), & + vFlx(i,J,:), CS%linear) endif enddo enddo @@ -298,26 +308,26 @@ end subroutine lateral_boundary_diffusion !< Calculate bulk layer value of a scalar quantity as the thickness weighted average real function bulk_average(boundary, nk, deg, h, hBLT, phi, ppoly0_E, ppoly0_coefs, method, k_top, zeta_top, k_bot, & zeta_bot) - integer :: boundary !< SURFACE or BOTTOM [nondim] - integer :: nk !< Number of layers [nondim] - integer :: deg !< Degree of polynomial [nondim] - real, dimension(nk) :: h !< Layer thicknesses [H ~> m or kg m-2] - real :: hBLT !< Depth of the boundary layer [H ~> m or kg m-2] + integer :: boundary !< SURFACE or BOTTOM [nondim] + integer :: nk !< Number of layers [nondim] + integer :: deg !< Degree of polynomial [nondim] + real, dimension(nk) :: h !< Layer thicknesses [H ~> m or kg m-2] + real :: hBLT !< Depth of the boundary layer [H ~> m or kg m-2] real, dimension(nk) :: phi !< Scalar quantity - real, dimension(nk,2) :: ppoly0_E !< Edge value of polynomial - real, dimension(nk,deg+1) :: ppoly0_coefs !< Coefficients of polynomial - integer :: method !< Remapping scheme to use + real, dimension(nk,2) :: ppoly0_E(:,:) !< Edge value of polynomial + real, dimension(nk,deg+1) :: ppoly0_coefs(:,:) !< Coefficients of polynomial + integer :: method !< Remapping scheme to use integer :: k_top !< Index of the first layer within the boundary real :: zeta_top !< Fraction of the layer encompassed by the bottom boundary layer !! (0 if none, 1. if all). For the surface, this is always 0. because - !! integration starts at the surface [nondim] + !! integration starts at the surface [nondim] integer :: k_bot !< Index of the last layer within the boundary real :: zeta_bot !< Fraction of the layer encompassed by the surface boundary layer !! (0 if none, 1. if all). For the bottom boundary layer, this is always 1. - !! because integration starts at the bottom [nondim] + !! because integration starts at the bottom [nondim] ! Local variables - real :: htot !< Running sum of the thicknesses (top to bottom) [H ~> m or kg m-2] + real :: htot !< Running sum of the thicknesses (top to bottom) integer :: k !< k indice @@ -428,43 +438,48 @@ end subroutine boundary_k_range !> Calculate the lateral boundary diffusive fluxes using the layer by layer method. !! See \ref section_method2 subroutine fluxes_layer_method(boundary, nk, deg, h_L, h_R, hbl_L, hbl_R, area_L, area_R, phi_L, phi_R, & - ppoly0_coefs_L, ppoly0_coefs_R, ppoly0_E_L, ppoly0_E_R, method, khtr_u, F_layer) + ppoly0_coefs_L, ppoly0_coefs_R, ppoly0_E_L, ppoly0_E_R, method, khtr_u, & + F_layer, linear_decay) integer, intent(in ) :: boundary !< Which boundary layer SURFACE or BOTTOM [nondim] integer, intent(in ) :: nk !< Number of layers [nondim] integer, intent(in ) :: deg !< order of the polynomial reconstruction [nondim] - real, dimension(nk), intent(in ) :: h_L !< Layer thickness (left) [H ~> m or kg m-2] - real, dimension(nk), intent(in ) :: h_R !< Layer thickness (right) [H ~> m or kg m-2] + real, dimension(nk), intent(in ) :: h_L !< Layer thickness (left) [H ~> m or kg m-2] + real, dimension(nk), intent(in ) :: h_R !< Layer thickness (right) [H ~> m or kg m-2] real, intent(in ) :: hbl_L !< Thickness of the boundary boundary - !! layer (left) [H ~> m or kg m-2] + !! layer (left) [H ~> m or kg m-2] real, intent(in ) :: hbl_R !< Thickness of the boundary boundary - !! layer (right) [H ~> m or kg m-2] - real, intent(in ) :: area_L !< Area of the horizontal grid (left) [L2 ~> m2] - real, intent(in ) :: area_R !< Area of the horizontal grid (right) [L2 ~> m2] - real, dimension(nk), intent(in ) :: phi_L !< Tracer values (left) [conc] - real, dimension(nk), intent(in ) :: phi_R !< Tracer values (right) [conc] - real, dimension(nk,deg+1), intent(in ) :: ppoly0_coefs_L !< Tracer reconstruction (left) [conc] - real, dimension(nk,deg+1), intent(in ) :: ppoly0_coefs_R !< Tracer reconstruction (right) [conc] - real, dimension(nk,2), intent(in ) :: ppoly0_E_L !< Polynomial edge values (left) [ nondim ] - real, dimension(nk,2), intent(in ) :: ppoly0_E_R !< Polynomial edge values (right) [ nondim ] - integer, intent(in ) :: method !< Method of polynomial integration [ nondim ] + !! layer (right) [H ~> m or kg m-2] + real, intent(in ) :: area_L !< Area of the horizontal grid (left) [L2 ~> m2] + real, intent(in ) :: area_R !< Area of the horizontal grid (right) [L2 ~> m2] + real, dimension(nk), intent(in ) :: phi_L !< Tracer values (left) [conc] + real, dimension(nk), intent(in ) :: phi_R !< Tracer values (right) [conc] + real, dimension(nk,deg+1), intent(in ) :: ppoly0_coefs_L !< Tracer reconstruction (left) [conc] + real, dimension(nk,deg+1), intent(in ) :: ppoly0_coefs_R !< Tracer reconstruction (right) [conc] + real, dimension(nk,2), intent(in ) :: ppoly0_E_L !< Polynomial edge values (left) [nondim] + real, dimension(nk,2), intent(in ) :: ppoly0_E_R !< Polynomial edge values (right) [nondim] + integer, intent(in ) :: method !< Method of polynomial integration [nondim] real, intent(in ) :: khtr_u !< Horizontal diffusivities times delta t !! at a velocity point [L2 ~> m2] real, dimension(nk), intent( out) :: F_layer !< Layerwise diffusive flux at U- or V-point !! [H L2 conc ~> m3 conc] - + logical, optional, intent(in ) :: linear_decay !< If True, apply a linear transition at the base of + !! the boundary layer ! Local variables - real, dimension(nk) :: h_means !< Calculate the layer-wise harmonic means [H ~> m or kg m-2] - real :: khtr_avg !< Thickness-weighted diffusivity at the u-point [m^2 s^-1] + real, dimension(nk) :: h_means !< Calculate the layer-wise harmonic means [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 :: heff !< Harmonic mean of layer thicknesses [H ~> m or kg m-2] real :: inv_heff !< Inverse of the harmonic mean of layer thicknesses !! [H-1 ~> m-1 or m2 kg-1] real :: phi_L_avg, phi_R_avg !< Bulk, thickness-weighted tracer averages (left and right column) - !! [conc m^-3 ] + !! [conc m^-3 ] real :: htot !< Total column thickness [H ~> m or kg m-2] - integer :: k, k_bot_min, k_top_max !< k-indices, min and max for top and bottom, respectively + real :: heff_tot !< Total effective column thickness in the transition layer [m] + integer :: k, k_bot_min, k_top_max !< k-indices, min and max for bottom and top, respectively + integer :: k_bot_max, k_top_min !< k-indices, max and min for bottom and top, respectively + integer :: k_bot_diff, k_top_diff !< different between left and right k-indices for bottom and top, respectively integer :: k_top_L, k_bot_L !< k-indices left integer :: k_top_R, k_bot_R !< k-indices right real :: zeta_top_L, zeta_top_R !< distance from the top of a layer to the boundary @@ -472,19 +487,30 @@ subroutine fluxes_layer_method(boundary, nk, deg, h_L, h_R, hbl_L, hbl_R, area_L real :: zeta_bot_L, zeta_bot_R !< distance from the bottom of a layer to the boundary !!layer depth [nondim] real :: h_work_L, h_work_R !< dummy variables - real :: hbl_min !< minimum BLD (left and right) [m] + real :: hbl_min !< minimum BLD (left and right) [m] + real :: wgt !< weight to be used in the linear transition to the interior [nondim] + real :: a !< coefficient to be used in the linear transition to the interior [nondim] + logical :: linear !< True if apply a linear transition F_layer(:) = 0.0 if (hbl_L == 0. .or. hbl_R == 0.) then return endif + linear = .false. + if (PRESENT(linear_decay)) then + linear = linear_decay + endif + ! Calculate vertical indices containing the boundary layer call boundary_k_range(boundary, nk, h_L, hbl_L, k_top_L, zeta_top_L, k_bot_L, zeta_bot_L) call boundary_k_range(boundary, nk, h_R, hbl_R, k_top_R, zeta_top_R, k_bot_R, zeta_bot_R) if (boundary == SURFACE) then k_bot_min = MIN(k_bot_L, k_bot_R) + k_bot_max = MAX(k_bot_L, k_bot_R) + k_bot_diff = (k_bot_max - k_bot_min) + ! make sure left and right k indices span same range if (k_bot_min .ne. k_bot_L) then k_bot_L = k_bot_min @@ -503,15 +529,37 @@ subroutine fluxes_layer_method(boundary, nk, deg, h_L, h_R, hbl_L, hbl_R, area_L heff = harmonic_mean(h_work_L, h_work_R) ! tracer flux where the minimum BLD intersets layer ! GMM, khtr_avg should be computed once khtr is 3D - F_layer(k_bot_min) = -(heff * khtr_u) * (phi_R_avg - phi_L_avg) + if ((linear) .and. (k_bot_diff .gt. 1)) then + ! apply linear decay at the base of hbl + do k = k_bot_min,1,-1 + heff = harmonic_mean(h_L(k), h_R(k)) + F_layer(k) = -(heff * khtr_u) * (phi_R(k) - phi_L(k)) + enddo + ! heff_total + heff_tot = 0.0 + do k = k_bot_min+1,k_bot_max, 1 + heff_tot = heff_tot + harmonic_mean(h_L(k), h_R(k)) + enddo - do k = k_bot_min-1,1,-1 - heff = harmonic_mean(h_L(k), h_R(k)) - F_layer(k) = -(heff * khtr_u) * (phi_R(k) - phi_L(k)) - enddo + a = -1.0/heff_tot + heff_tot = 0.0 + do k = k_bot_min+1,k_bot_max, 1 + heff = harmonic_mean(h_L(k), h_R(k)) + wgt = (a*(heff_tot + (heff * 0.5))) + 1.0 + F_layer(k) = -(heff * khtr_u) * (phi_R(k) - phi_L(k)) * wgt + heff_tot = heff_tot + heff + enddo + else + F_layer(k_bot_min) = -(heff * khtr_u) * (phi_R_avg - phi_L_avg) + do k = k_bot_min-1,1,-1 + heff = harmonic_mean(h_L(k), h_R(k)) + F_layer(k) = -(heff * khtr_u) * (phi_R(k) - phi_L(k)) + enddo + endif endif if (boundary == BOTTOM) then + ! TODO: GMM add option to apply linear decay k_top_max = MAX(k_top_L, k_top_R) ! make sure left and right k indices span same range if (k_top_max .ne. k_top_L) then @@ -544,26 +592,27 @@ end subroutine fluxes_layer_method !> Apply the lateral boundary diffusive fluxes calculated from a 'bulk model' !! See \ref section_method1 subroutine fluxes_bulk_method(boundary, nk, deg, h_L, h_R, hbl_L, hbl_R, area_L, area_R, phi_L, phi_R, ppoly0_coefs_L, & - ppoly0_coefs_R, ppoly0_E_L, ppoly0_E_R, method, khtr_u, F_bulk, F_layer, F_limit) + ppoly0_coefs_R, ppoly0_E_L, ppoly0_E_R, method, khtr_u, F_bulk, F_layer, F_limit, & + linear_decay) integer, intent(in ) :: boundary !< Which boundary layer SURFACE or BOTTOM [nondim] integer, intent(in ) :: nk !< Number of layers [nondim] integer, intent(in ) :: deg !< order of the polynomial reconstruction [nondim] - real, dimension(nk), intent(in ) :: h_L !< Layer thickness (left) [H ~> m or kg m-2] - real, dimension(nk), intent(in ) :: h_R !< Layer thickness (right) [H ~> m or kg m-2] + real, dimension(nk), intent(in ) :: h_L !< Layer thickness (left) [H ~> m or kg m-2] + real, dimension(nk), intent(in ) :: h_R !< Layer thickness (right) [H ~> m or kg m-2] real, intent(in ) :: hbl_L !< Thickness of the boundary boundary - !! layer (left) [H ~> m or kg m-2] + !! layer (left) [H ~> m or kg m-2] real, intent(in ) :: hbl_R !< Thickness of the boundary boundary - !! layer (left) [H ~> m or kg m-2] - real, intent(in ) :: area_L !< Area of the horizontal grid (left) [L2 ~> m2] - real, intent(in ) :: area_R !< Area of the horizontal grid (right) [L2 ~> m2] - real, dimension(nk), intent(in ) :: phi_L !< Tracer values (left) [conc] - real, dimension(nk), intent(in ) :: phi_R !< Tracer values (right) [conc] - real, dimension(nk,deg+1), intent(in ) :: ppoly0_coefs_L !< Tracer reconstruction (left) [conc] - real, dimension(nk,deg+1), intent(in ) :: ppoly0_coefs_R !< Tracer reconstruction (right) [conc] - real, dimension(nk,2), intent(in ) :: ppoly0_E_L !< Polynomial edge values (left) [nondim] - real, dimension(nk,2), intent(in ) :: ppoly0_E_R !< Polynomial edge values (right) [nondim] - integer, intent(in ) :: method !< Method of polynomial integration [nondim] + !! layer (left) [H ~> m or kg m-2] + real, intent(in ) :: area_L !< Area of the horizontal grid (left) [L2 ~> m2] + real, intent(in ) :: area_R !< Area of the horizontal grid (right) [L2 ~> m2] + real, dimension(nk), intent(in ) :: phi_L !< Tracer values (left) [conc] + real, dimension(nk), intent(in ) :: phi_R !< Tracer values (right) [conc] + real, dimension(nk,deg+1), intent(in ) :: ppoly0_coefs_L !< Tracer reconstruction (left) [conc] + real, dimension(nk,deg+1), intent(in ) :: ppoly0_coefs_R !< Tracer reconstruction (right) [conc] + real, dimension(nk,2), intent(in ) :: ppoly0_E_L !< Polynomial edge values (left) [nondim] + real, dimension(nk,2), intent(in ) :: ppoly0_E_R !< Polynomial edge values (right) [nondim] + integer, intent(in ) :: method !< Method of polynomial integration [nondim] real, intent(in ) :: khtr_u !< Horizontal diffusivities times delta t !! at a velocity point [L2 ~> m2] real, intent( out) :: F_bulk !< The bulk mixed layer lateral flux @@ -571,6 +620,8 @@ subroutine fluxes_bulk_method(boundary, nk, deg, h_L, h_R, hbl_L, hbl_R, area_L, real, dimension(nk), intent( out) :: F_layer !< Layerwise diffusive flux at U- or V-point !! [H L2 conc ~> m3 conc] logical, optional, intent(in ) :: F_limit !< If True, apply a limiter + logical, optional, intent(in ) :: linear_decay !< If True, apply a linear transition at the base of + !! the boundary layer ! Local variables real, dimension(nk) :: h_means !< Calculate the layer-wise harmonic means [H ~> m or kg m-2] @@ -578,12 +629,14 @@ subroutine fluxes_bulk_method(boundary, nk, deg, h_L, h_R, hbl_L, hbl_R, area_L, !! This is just to remind developers that khtr_avg should be !! computed once khtr is 3D. real :: heff !< Harmonic mean of layer thicknesses [H ~> m or kg m-2] + real :: heff_tot !< Total effective column thickness in the transition layer [m] real :: inv_heff !< Inverse of the harmonic mean of layer thicknesses !! [H-1 ~> m-1 or m2 kg-1] real :: phi_L_avg, phi_R_avg !< Bulk, thickness-weighted tracer averages (left and right column) !! [conc m^-3 ] - real :: htot !< Total column thickness [H ~> m or kg m-2] + real :: htot ! Total column thickness [H ~> m or kg m-2] integer :: k, k_min, k_max !< k-indices, min and max for top and bottom, respectively + integer :: k_diff !< difference between k_max and k_min integer :: k_top_L, k_bot_L !< k-indices left integer :: k_top_R, k_bot_R !< k-indices right real :: zeta_top_L, zeta_top_R !< distance from the top of a layer to the @@ -594,12 +647,17 @@ subroutine fluxes_bulk_method(boundary, nk, deg, h_L, h_R, hbl_L, hbl_R, area_L, real :: F_max !< The maximum amount of flux that can leave a !! cell [m^3 conc] logical :: limiter !< True if flux limiter should be applied + logical :: linear !< True if apply a linear transition real :: hfrac !< Layer fraction wrt sum of all layers [nondim] real :: dphi !< tracer gradient [conc m^-3] + real :: wgt !< weight to be used in the linear transition to the + !! interior [nondim] + real :: a !< coefficient to be used in the linear transition to the + !! interior [nondim] + F_bulk = 0. + F_layer(:) = 0. if (hbl_L == 0. .or. hbl_R == 0.) then - F_bulk = 0. - F_layer(:) = 0. return endif @@ -607,6 +665,10 @@ subroutine fluxes_bulk_method(boundary, nk, deg, h_L, h_R, hbl_L, hbl_R, area_L, if (PRESENT(F_limit)) then limiter = F_limit endif + linear = .false. + if (PRESENT(linear_decay)) then + linear = linear_decay + endif ! Calculate vertical indices containing the boundary layer call boundary_k_range(boundary, nk, h_L, hbl_L, k_top_L, zeta_top_L, k_bot_L, zeta_bot_L) @@ -617,7 +679,6 @@ subroutine fluxes_bulk_method(boundary, nk, deg, h_L, h_R, hbl_L, hbl_R, area_L, zeta_top_L, k_bot_L, zeta_bot_L) phi_R_avg = bulk_average(boundary, nk, deg, h_R, hbl_R, phi_R, ppoly0_E_R, ppoly0_coefs_R, method, k_top_R, & zeta_top_R, k_bot_R, zeta_bot_R) - ! Calculate the 'bulk' diffusive flux from the bulk averaged quantities ! GMM, khtr_avg should be computed once khtr is 3D heff = harmonic_mean(hbl_L, hbl_R) @@ -625,31 +686,53 @@ subroutine fluxes_bulk_method(boundary, nk, deg, h_L, h_R, hbl_L, hbl_R, area_L, ! Calculate the layerwise sum of the vertical effective thickness. This is different than the heff calculated ! above, but is used as a way to decompose the fluxes onto the individual layers h_means(:) = 0. - if (boundary == SURFACE) then k_min = MIN(k_bot_L, k_bot_R) + k_max = MAX(k_bot_L, k_bot_R) + k_diff = (k_max - k_min) + if ((linear) .and. (k_diff .gt. 1)) then + do k=1,k_min + h_means(k) = harmonic_mean(h_L(k),h_R(k)) + enddo + ! heff_total + heff_tot = 0.0 + do k = k_min+1,k_max, 1 + heff_tot = heff_tot + harmonic_mean(h_L(k), h_R(k)) + enddo - ! left hand side - if (k_bot_L == k_min) then - h_work_L = h_L(k_min) * zeta_bot_L + a = -1.0/heff_tot + heff_tot = 0.0 + ! fluxes will decay linearly at base of hbl + do k = k_min+1,k_max, 1 + heff = harmonic_mean(h_L(k), h_R(k)) + wgt = (a*(heff_tot + (heff * 0.5))) + 1.0 + h_means(k) = harmonic_mean(h_L(k), h_R(k)) * wgt + heff_tot = heff_tot + heff + enddo else - h_work_L = h_L(k_min) - endif + ! left hand side + if (k_bot_L == k_min) then + h_work_L = h_L(k_min) * zeta_bot_L + else + h_work_L = h_L(k_min) + endif - ! right hand side - if (k_bot_R == k_min) then - h_work_R = h_R(k_min) * zeta_bot_R - else - h_work_R = h_R(k_min) - endif + ! right hand side + if (k_bot_R == k_min) then + h_work_R = h_R(k_min) * zeta_bot_R + else + h_work_R = h_R(k_min) + endif - h_means(k_min) = harmonic_mean(h_work_L,h_work_R) + h_means(k_min) = harmonic_mean(h_work_L,h_work_R) - do k=1,k_min-1 - h_means(k) = harmonic_mean(h_L(k),h_R(k)) - enddo + do k=1,k_min-1 + h_means(k) = harmonic_mean(h_L(k),h_R(k)) + enddo + endif elseif (boundary == BOTTOM) then + !TODO, GMM linear decay is not implemented here k_max = MAX(k_top_L, k_top_R) ! left hand side if (k_top_L == k_max) then @@ -672,14 +755,14 @@ subroutine fluxes_bulk_method(boundary, nk, deg, h_L, h_R, hbl_L, hbl_R, area_L, enddo endif - if ( SUM(h_means) == 0. ) then + if ( SUM(h_means) == 0. .or. F_bulk == 0.) then return - ! Decompose the bulk flux onto the individual layers + ! Decompose the bulk flux onto the individual layers else ! Initialize remaining thickness inv_heff = 1./SUM(h_means) do k=1,nk - if (h_means(k) > 0.) then + if ((h_means(k) > 0.) .and. (phi_L(k) /= phi_R(k))) then hfrac = h_means(k)*inv_heff F_layer(k) = F_bulk * hfrac @@ -1035,10 +1118,6 @@ logical function test_layer_fluxes(verbose, nk, test_name, F_calc, F_ans) test_layer_fluxes = .true. write(stdunit,*) "MOM_lateral_boundary_diffusion, UNIT TEST FAILED: ", test_name write(stdunit,10) k, F_calc(k), F_ans(k) - ! ### Once these unit tests are passing, and failures are caught properly, - ! we will post failure notifications to both stdout and stderr. - !write(stderr,*) "MOM_lateral_boundary_diffusion, UNIT TEST FAILED: ", test_name - !write(stderr,10) k, F_calc(k), F_ans(k) elseif (verbose) then write(stdunit,10) k, F_calc(k), F_ans(k) endif From 8fdcd904813686d9250ca48a3fb788339f9d49af Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Wed, 10 Jun 2020 11:12:24 -0600 Subject: [PATCH 36/53] Improve documentation and changed default method * the default LBD method (method # 1) has been changed to the layer by layer approach since this is the recommended scheme. * improve the documentation by adding description of the linear decay option in both methods. --- src/tracer/MOM_lateral_boundary_diffusion.F90 | 125 ++++++++++-------- 1 file changed, 69 insertions(+), 56 deletions(-) diff --git a/src/tracer/MOM_lateral_boundary_diffusion.F90 b/src/tracer/MOM_lateral_boundary_diffusion.F90 index a4b4bcb567..dd2e015632 100644 --- a/src/tracer/MOM_lateral_boundary_diffusion.F90 +++ b/src/tracer/MOM_lateral_boundary_diffusion.F90 @@ -39,13 +39,13 @@ module MOM_lateral_boundary_diffusion type, public :: lateral_boundary_diffusion_CS ; private integer :: method !< Determine which of the three methods calculate !! and apply near boundary layer fluxes - !! 1. Bulk-layer approach - !! 2. Along layer + !! 1. Along layer + !! 2. Bulk-layer approach (not recommended) integer :: deg !< Degree of polynomial reconstruction integer :: surface_boundary_scheme !< Which boundary layer scheme to use !! 1. ePBL; 2. KPP logical :: limiter !< Controls wether a flux limiter is applied. - !! Only valid when method = 1. + !! Only valid when method = 2. logical :: linear !< If True, apply a linear transition at the base/top of the boundary. !! The flux will be fully applied at k=k_min and zero at k=k_max. @@ -105,12 +105,12 @@ logical function lateral_boundary_diffusion_init(Time, G, param_file, diag, diab ! Read all relevant parameters and write them to the model log. call get_param(param_file, mdl, "LATERAL_BOUNDARY_METHOD", CS%method, & "Determine how to apply boundary lateral diffusion of tracers: \n"//& - "1. Bulk layer approach \n"//& - "2. Along layer approach", default=1) - if (CS%method == 1) then + "1. Along layer approach \n"//& + "2. Bulk layer approach (this option is not recommended)", default=1) + if (CS%method == 2) then call get_param(param_file, mdl, "APPLY_LIMITER", CS%limiter, & "If True, apply a flux limiter in the LBD. This is only available \n"//& - "when LATERAL_BOUNDARY_METHOD=1.", default=.false.) + "when LATERAL_BOUNDARY_METHOD=2.", default=.false.) endif call get_param(param_file, mdl, "LBD_LINEAR_TRANSITION", CS%linear, & "If True, apply a linear transition at the base/top of the boundary. \n"//& @@ -191,56 +191,56 @@ subroutine lateral_boundary_diffusion(G, GV, US, h, Coef_x, Coef_y, dt, Reg, CS) uFlx_bulk(:,:) = 0. vFlx_bulk(:,:) = 0. - ! Method #1 - if ( CS%method == 1 ) then + ! Method #1 (layer by layer) + if (CS%method == 1) then do j=G%jsc,G%jec do i=G%isc-1,G%iec if (G%mask2dCu(I,j)>0.) then - call fluxes_bulk_method(SURFACE, GV%ke, CS%deg, h(I,j,:), h(I+1,j,:), hbl(I,j), hbl(I+1,j), & - G%areaT(I,j), G%areaT(I+1,j), tracer%t(I,j,:), tracer%t(I+1,j,:), & - ppoly0_coefs(I,j,:,:), ppoly0_coefs(I+1,j,:,:), ppoly0_E(I,j,:,:), & - ppoly0_E(I+1,j,:,:), remap_method, Coef_x(I,j), uFlx_bulk(I,j), uFlx(I,j,:), CS%limiter, & - CS%linear) + call fluxes_layer_method(SURFACE, GV%ke, CS%deg, h(I,j,:), h(I+1,j,:), hbl(I,j), hbl(I+1,j), & + G%areaT(I,j), G%areaT(I+1,j), tracer%t(I,j,:), tracer%t(I+1,j,:), ppoly0_coefs(I,j,:,:), & + ppoly0_coefs(I+1,j,:,:), ppoly0_E(I,j,:,:), ppoly0_E(I+1,j,:,:), remap_method, Coef_x(I,j), & + uFlx(I,j,:), CS%linear) endif enddo enddo do J=G%jsc-1,G%jec do i=G%isc,G%iec if (G%mask2dCv(i,J)>0.) then - call fluxes_bulk_method(SURFACE, GV%ke, CS%deg, h(i,J,:), h(i,J+1,:), hbl(i,J), hbl(i,J+1), & - G%areaT(i,J), G%areaT(i,J+1), tracer%t(i,J,:), tracer%t(i,J+1,:), & - ppoly0_coefs(i,J,:,:), ppoly0_coefs(i,J+1,:,:), ppoly0_E(i,J,:,:), & - ppoly0_E(i,J+1,:,:), remap_method, Coef_y(i,J), vFlx_bulk(i,J), vFlx(i,J,:), CS%limiter, & - CS%linear) + call fluxes_layer_method(SURFACE, GV%ke, CS%deg, h(i,J,:), h(i,J+1,:), hbl(i,J), hbl(i,J+1), & + G%areaT(i,J), G%areaT(i,J+1), tracer%t(i,J,:), tracer%t(i,J+1,:), ppoly0_coefs(i,J,:,:), & + ppoly0_coefs(i,J+1,:,:), ppoly0_E(i,J,:,:), ppoly0_E(i,J+1,:,:), remap_method, Coef_y(i,J), & + vFlx(i,J,:), CS%linear) endif enddo enddo - ! Post tracer bulk diags - if (tracer%id_lbd_bulk_dfx>0) call post_data(tracer%id_lbd_bulk_dfx, uFlx_bulk*Idt, CS%diag) - if (tracer%id_lbd_bulk_dfy>0) call post_data(tracer%id_lbd_bulk_dfy, vFlx_bulk*Idt, CS%diag) - ! Method #2 + ! Method #2 (bulk approach) elseif (CS%method == 2) then do j=G%jsc,G%jec do i=G%isc-1,G%iec if (G%mask2dCu(I,j)>0.) then - call fluxes_layer_method(SURFACE, GV%ke, CS%deg, h(I,j,:), h(I+1,j,:), hbl(I,j), hbl(I+1,j), & - G%areaT(I,j), G%areaT(I+1,j), tracer%t(I,j,:), tracer%t(I+1,j,:), ppoly0_coefs(I,j,:,:), & - ppoly0_coefs(I+1,j,:,:), ppoly0_E(I,j,:,:), ppoly0_E(I+1,j,:,:), remap_method, Coef_x(I,j), & - uFlx(I,j,:), CS%linear) + call fluxes_bulk_method(SURFACE, GV%ke, CS%deg, h(I,j,:), h(I+1,j,:), hbl(I,j), hbl(I+1,j), & + G%areaT(I,j), G%areaT(I+1,j), tracer%t(I,j,:), tracer%t(I+1,j,:), & + ppoly0_coefs(I,j,:,:), ppoly0_coefs(I+1,j,:,:), ppoly0_E(I,j,:,:), & + ppoly0_E(I+1,j,:,:), remap_method, Coef_x(I,j), uFlx_bulk(I,j), uFlx(I,j,:), CS%limiter, & + CS%linear) endif enddo enddo do J=G%jsc-1,G%jec do i=G%isc,G%iec if (G%mask2dCv(i,J)>0.) then - call fluxes_layer_method(SURFACE, GV%ke, CS%deg, h(i,J,:), h(i,J+1,:), hbl(i,J), hbl(i,J+1), & - G%areaT(i,J), G%areaT(i,J+1), tracer%t(i,J,:), tracer%t(i,J+1,:), ppoly0_coefs(i,J,:,:), & - ppoly0_coefs(i,J+1,:,:), ppoly0_E(i,J,:,:), ppoly0_E(i,J+1,:,:), remap_method, Coef_y(i,J), & - vFlx(i,J,:), CS%linear) + call fluxes_bulk_method(SURFACE, GV%ke, CS%deg, h(i,J,:), h(i,J+1,:), hbl(i,J), hbl(i,J+1), & + G%areaT(i,J), G%areaT(i,J+1), tracer%t(i,J,:), tracer%t(i,J+1,:), & + ppoly0_coefs(i,J,:,:), ppoly0_coefs(i,J+1,:,:), ppoly0_E(i,J,:,:), & + ppoly0_E(i,J+1,:,:), remap_method, Coef_y(i,J), vFlx_bulk(i,J), vFlx(i,J,:), CS%limiter, & + CS%linear) endif enddo enddo + ! Post tracer bulk diags + if (tracer%id_lbd_bulk_dfx>0) call post_data(tracer%id_lbd_bulk_dfx, uFlx_bulk*Idt, CS%diag) + if (tracer%id_lbd_bulk_dfy>0) call post_data(tracer%id_lbd_bulk_dfy, vFlx_bulk*Idt, CS%diag) endif ! Update the tracer fluxes @@ -436,7 +436,7 @@ end subroutine boundary_k_range !> Calculate the lateral boundary diffusive fluxes using the layer by layer method. -!! See \ref section_method2 +!! See \ref section_method1 subroutine fluxes_layer_method(boundary, nk, deg, h_L, h_R, hbl_L, hbl_R, area_L, area_R, phi_L, phi_R, & ppoly0_coefs_L, ppoly0_coefs_R, ppoly0_E_L, ppoly0_E_R, method, khtr_u, & F_layer, linear_decay) @@ -590,7 +590,7 @@ subroutine fluxes_layer_method(boundary, nk, deg, h_L, h_R, hbl_L, hbl_R, area_L end subroutine fluxes_layer_method !> Apply the lateral boundary diffusive fluxes calculated from a 'bulk model' -!! See \ref section_method1 +!! See \ref section_method2 subroutine fluxes_bulk_method(boundary, nk, deg, h_L, h_R, hbl_L, hbl_R, area_L, area_R, phi_L, phi_R, ppoly0_coefs_L, & ppoly0_coefs_R, ppoly0_E_L, ppoly0_E_R, method, khtr_u, F_bulk, F_layer, F_limit, & linear_decay) @@ -1175,12 +1175,37 @@ end function test_boundary_k_range !! !! Boundary lateral diffusion can be applied using one of the three methods: !! -!! * [Method #1: Bulk layer](@ref section_method1) (default); -!! * [Method #2: Along layer](@ref section_method2); +!! * [Method #1: Along layer](@ref section_method2) (default); +!! * [Method #2: Bulk layer](@ref section_method1); !! !! A brief summary of these methods is provided below. !! -!! \subsection section_method1 Bulk layer approach (Method #1) +!! \subsection section_method1 Along layer approach (Method #1) +!! +!! This is the recommended and more straight forward method where diffusion is +!! applied layer by layer using only information from neighboring cells. +!! +!! Step #1: compute vertical indices containing boundary layer (boundary_k_range). +!! For the TOP boundary layer, these are: +!! +!! k_top, k_bot, zeta_top, zeta_bot +!! +!! Step #2: calculate the diffusive flux at each layer: +!! +!! \f[ F_{k} = -KHTR \times h_{eff}(k) \times (\phi_R(k) - \phi_L(k)), \f] +!! where h_eff is the [harmonic mean](@ref section_harmonic_mean) of the layer thickness +!! in the left and right columns. This method does not require a limiter since KHTR +!! is already limted based on a diffusive CFL condition prior to the call of this +!! module. +!! +!! Step #3: option to linearly decay the flux from k_bot_min to k_bot_max: +!! +!! If LBD_LINEAR_TRANSITION = True and k_bot_diff > 1, the diffusive flux will decay +!! linearly between the top interface of the layer containing the minimum boundary +!! layer depth (k_bot_min) and the lower interface of the layer containing the +!! maximum layer depth (k_bot_max). +!! +!! \subsection section_method2 Bulk layer approach (Method #2) !! !! Apply the lateral boundary diffusive fluxes calculated from a 'bulk model'.This !! is a lower order representation (Kraus-Turner like approach) which assumes that @@ -1210,7 +1235,14 @@ end function test_boundary_k_range !! h_u is the [harmonic mean](@ref section_harmonic_mean) of thicknesses at each layer. !! Special care (layer reconstruction) must be taken at k_min = min(k_botL, k_bot_R). !! -!! Step #4: limit the tracer flux so that 1) only down-gradient fluxes are applied, +!! Step #4: option to linearly decay the flux from k_bot_min to k_bot_max: +!! +!! If LBD_LINEAR_TRANSITION = True and k_bot_diff > 1, the diffusive flux will decay +!! linearly between the top interface of the layer containing the minimum boundary +!! layer depth (k_bot_min) and the lower interface of the layer containing the +!! maximum layer depth (k_bot_max). +!! +!! Step #5: limit the tracer flux so that 1) only down-gradient fluxes are applied, !! and 2) the flux cannot be larger than F_max, which is defined using the tracer !! gradient: !! @@ -1221,25 +1253,6 @@ end function test_boundary_k_range !! 0 1 0 .2.2.2 !! 0 .2 !! -!! \subsection section_method2 Along layer approach (Method #2) -!! -!! This is a more straight forward method where diffusion is applied layer by layer using -!! only information from neighboring cells. -!! -!! Step #1: compute vertical indices containing boundary layer (boundary_k_range). -!! For the TOP boundary layer, these are: -!! -!! k_top, k_bot, zeta_top, zeta_bot -!! -!! Step #2: calculate the diffusive flux at each layer: -!! -!! \f[ F_{k} = -KHTR \times h_{eff}(k) \times (\phi_R(k) - \phi_L(k)), \f] -!! where h_eff is the [harmonic mean](@ref section_harmonic_mean) of the layer thickness -!! in the left and right columns. Special care (layer reconstruction) must be taken at -!! k_min = min(k_botL, k_bot_R). This method does not require a limiter since KHTR -!! is already limted based on a diffusive CFL condition prior to the call of this -!! module. -!! !! \subsection section_harmonic_mean Harmonic Mean !! !! The harmonic mean (HM) betwen h1 and h2 is defined as: From ca86bad5109e9c77d5512d758ec5013f8d0b4fb5 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Wed, 10 Jun 2020 14:23:27 -0600 Subject: [PATCH 37/53] Remove trailing space --- config_src/nuopc_driver/mom_cap.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index 232a97ad41..55722a3ad9 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(-) @@ -2063,7 +2063,7 @@ subroutine ModelSetRunClock(gcomp, rc) call ESMF_LogWrite(subname//" Create Stop alarm", ESMF_LOGMSG_INFO, rc=rc) 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, rc=rc) From 388b100c8b04e501e0685952cb9e4c3b7aa7299d Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Wed, 17 Jun 2020 16:06:14 -0600 Subject: [PATCH 38/53] Fix default zeta_bot values --- src/tracer/MOM_neutral_diffusion.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/tracer/MOM_neutral_diffusion.F90 b/src/tracer/MOM_neutral_diffusion.F90 index 890bae928c..d60aade72b 100644 --- a/src/tracer/MOM_neutral_diffusion.F90 +++ b/src/tracer/MOM_neutral_diffusion.F90 @@ -312,7 +312,7 @@ subroutine neutral_diffusion_calc_coeffs(G, GV, US, h, T, S, CS, p_surf) pa_to_H = 1. / (GV%H_to_RZ * GV%g_Earth) k_top(:,:) = 1 ; k_bot(:,:) = 1 - zeta_top(:,:) = 0. ; zeta_bot(:,:) = 1. + zeta_top(:,:) = 0. ; zeta_bot(:,:) = 0. ! Check if hbl needs to be extracted if (CS%interior_only) then From 2fe90f2fe60779f2036d6c921c6ef37cc58d49df Mon Sep 17 00:00:00 2001 From: alperaltuntas Date: Tue, 4 Aug 2020 15:09:59 -0600 Subject: [PATCH 39/53] retrieve num_rest_files from save_restart --- src/framework/MOM_restart.F90 | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/src/framework/MOM_restart.F90 b/src/framework/MOM_restart.F90 index c918f3a9ee..20056c15ad 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,9 @@ 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 ff27ad56068ad121ba803db80cf8d4abdbd850a0 Mon Sep 17 00:00:00 2001 From: alperaltuntas Date: Tue, 4 Aug 2020 15:11:09 -0600 Subject: [PATCH 40/53] add num_rest_files to ocean_model_restart --- config_src/nuopc_driver/mom_ocean_model_nuopc.F90 | 12 +++++++++--- 1 file changed, 9 insertions(+), 3 deletions(-) diff --git a/config_src/nuopc_driver/mom_ocean_model_nuopc.F90 b/config_src/nuopc_driver/mom_ocean_model_nuopc.F90 index aabf456ca8..cbbb2261d0 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 "//& @@ -689,8 +690,13 @@ subroutine ocean_model_restart(OS, timestamp, restartname) "restart files can only be created after the buoyancy forcing is applied.") if (present(restartname)) then - call save_restart(OS%dirs%restart_output_dir, OS%Time, OS%grid, & - OS%restart_CSp, GV=OS%GV, filename=restartname) + if (present(num_rest_files)) then + call save_restart(OS%dirs%restart_output_dir, OS%Time, OS%grid, & + OS%restart_CSp, GV=OS%GV, filename=restartname, num_rest_files=num_rest_files) + else + call save_restart(OS%dirs%restart_output_dir, OS%Time, OS%grid, & + OS%restart_CSp, GV=OS%GV, filename=restartname) + endif 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 From 4c609001073b7ae9624d9afc8f6a5ddf528ef8c1 Mon Sep 17 00:00:00 2001 From: alperaltuntas Date: Tue, 4 Aug 2020 15:15:02 -0600 Subject: [PATCH 41/53] read/write multiple restart filenames from/to rpointer files --- config_src/nuopc_driver/mom_cap.F90 | 67 +++++++++++++++++++++-------- 1 file changed, 49 insertions(+), 18 deletions(-) diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index 6ea8620621..ebb4c7f277 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -464,6 +464,8 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) integer :: iostat integer :: readunit character(len=512) :: restartfile ! Path/Name of restart file + character(len=512) :: restartfiles ! Path/Name of restart files + ! (same as restartfile if single restart file) character(len=*), parameter :: subname='(MOM_cap:InitializeAdvertise)' character(len=32) :: calendar !-------------------------------- @@ -653,10 +655,10 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) return endif - restartfile = "" + restartfile = ""; restartfiles = "" if (runtype == "initial") then - restartfile = "n" + restartfiles = "n" else if (runtype == "continue") then ! hybrid or branch or continuos runs @@ -675,16 +677,23 @@ 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 + 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) + call ESMF_VMBroadcast(vm, restartfiles, 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) @@ -693,7 +702,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) @@ -1611,10 +1620,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: ") @@ -1832,6 +1843,12 @@ subroutine ModelAdvance(gcomp, rc) 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, rc=rc) + + ! 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) @@ -1841,6 +1858,19 @@ 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=2, num_rest_files + if (num_rest_files < 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 @@ -1851,16 +1881,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, rc=rc) - ! write restart file(s) - call ocean_model_restart(ocean_state, restartname=restartname) + call ESMF_LogWrite("MOM_cap: Writing restart : "//trim(restartname), ESMF_LOGMSG_INFO, rc=rc) - if (is_root_pe()) then - write(logunit,*) subname//' writing restart file ',trim(restartname) - endif + ! write restart file(s) + call ocean_model_restart(ocean_state, restartname=restartname) + end if + + if (is_root_pe()) then + write(logunit,*) subname//' writing restart file ',trim(restartname) endif + endif !--------------- ! Write diagnostics From 7a2256c50e6b70517993952061a79498bf9cfde0 Mon Sep 17 00:00:00 2001 From: alperaltuntas Date: Tue, 4 Aug 2020 18:14:57 -0600 Subject: [PATCH 42/53] correct restart file suffix index --- config_src/nuopc_driver/mom_cap.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index ebb4c7f277..4455ce7fdc 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -1861,7 +1861,7 @@ subroutine ModelAdvance(gcomp, rc) if (num_rest_files > 1) then ! append i.th restart file name to rpointer - do i=2, num_rest_files + do i=1, num_rest_files-1 if (num_rest_files < 10) then write(suffix,'("_",I1)') i else From 4c91ae3ac2fbf2d1a1c914b919bfb1baa8d6b6e2 Mon Sep 17 00:00:00 2001 From: alperaltuntas Date: Wed, 5 Aug 2020 14:32:27 -0600 Subject: [PATCH 43/53] add filename length check --- config_src/nuopc_driver/mom_cap.F90 | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index 4455ce7fdc..312d2397e7 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -688,6 +688,10 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, 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) @@ -1862,7 +1866,7 @@ subroutine ModelAdvance(gcomp, rc) if (num_rest_files > 1) then ! append i.th restart file name to rpointer do i=1, num_rest_files-1 - if (num_rest_files < 10) then + if (i < 10) then write(suffix,'("_",I1)') i else write(suffix,'("_",I2)') i From 0a5515b3dbe647b13e28801ed70b71aa66ca0149 Mon Sep 17 00:00:00 2001 From: alperaltuntas Date: Wed, 5 Aug 2020 16:54:29 -0600 Subject: [PATCH 44/53] increase restart filename lengths --- src/framework/MOM_get_input.F90 | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/src/framework/MOM_get_input.F90 b/src/framework/MOM_get_input.F90 index ad48086543..b6b5b89be9 100644 --- a/src/framework/MOM_get_input.F90 +++ b/src/framework/MOM_get_input.F90 @@ -21,7 +21,8 @@ module MOM_get_input character(len=240) :: & restart_input_dir = ' ',& !< The directory to read restart and input files. restart_output_dir = ' ',&!< The directory into which to write restart files. - output_directory = ' ', & !< The directory to use to write the model output. + output_directory = ' ' !< The directory to use to write the model output. + character(len=2048) :: & input_filename = ' ' !< A string that indicates the input files or how !! the run segment should be started. end type directories @@ -46,7 +47,8 @@ subroutine get_MOM_input(param_file, dirs, check_params, default_input_filename, parameter_filename(npf), & ! List of files containing parameters. output_directory, & ! Directory to use to write the model output. restart_input_dir, & ! Directory for reading restart and input files. - restart_output_dir, & ! Directory into which to write restart files. + restart_output_dir ! Directory into which to write restart files. + character(len=2048) :: & input_filename ! A string that indicates the input files or how ! the run segment should be started. character(len=240) :: output_dir From bba3e91b51108b19a0fd826b044faefdf0cc4466 Mon Sep 17 00:00:00 2001 From: alperaltuntas Date: Wed, 5 Aug 2020 16:55:23 -0600 Subject: [PATCH 45/53] increase nuopc cap restart filename length --- config_src/nuopc_driver/mom_cap.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index 312d2397e7..c2a2e98838 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -464,7 +464,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) integer :: iostat integer :: readunit character(len=512) :: restartfile ! Path/Name of restart file - character(len=512) :: restartfiles ! Path/Name of restart files + 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 @@ -697,7 +697,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) close(readunit) endif ! broadcast attribute set on master task to all tasks - call ESMF_VMBroadcast(vm, restartfiles, count=ESMF_MAXSTR-1, rootPet=0, rc=rc) + call ESMF_VMBroadcast(vm, restartfiles, count=len(restartfiles), 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) From 829aadea92f5abecfe6ce647583b2d20e636cb77 Mon Sep 17 00:00:00 2001 From: alperaltuntas Date: Wed, 5 Aug 2020 17:13:06 -0600 Subject: [PATCH 46/53] make mct cap be able to write multiple restart files to rpointer --- config_src/mct_driver/ocn_comp_mct.F90 | 19 ++++++++++++++++++- 1 file changed, 18 insertions(+), 1 deletion(-) diff --git a/config_src/mct_driver/ocn_comp_mct.F90 b/config_src/mct_driver/ocn_comp_mct.F90 index b1ce9a60c0..9466159948 100644 --- a/config_src/mct_driver/ocn_comp_mct.F90 +++ b/config_src/mct_driver/ocn_comp_mct.F90 @@ -434,6 +434,9 @@ subroutine ocn_run_mct( EClock, cdata_o, x2o_o, o2x_o) integer :: ocn_cpl_dt !< one ocn coupling interval in seconds. (to be received from cesm) real (kind=8) :: mom_cpl_dt !< one ocn coupling interval in seconds. (internal) integer :: ncouple_per_day !< number of ocean coupled call in one day (non-dim) + integer :: num_rest_files !< number of restart files written + integer :: i + character(len=8) :: suffix ! reset shr logging to ocn log file: if (is_root_pe()) then @@ -534,7 +537,8 @@ subroutine ocn_run_mct( EClock, cdata_o, x2o_o, o2x_o) write(restartname,'(A,".mom6.r.",I4.4,"-",I2.2,"-",I2.2,"-",I5.5)') trim(runid), year, month, day, seconds call save_restart(glb%ocn_state%dirs%restart_output_dir, glb%ocn_state%Time, glb%grid, & - glb%ocn_state%restart_CSp, .false., filename=restartname, GV=glb%ocn_state%GV) + glb%ocn_state%restart_CSp, .false., filename=restartname, GV=glb%ocn_state%GV, & + num_rest_files=num_rest_files) ! write name of restart file in the rpointer file nu = shr_file_getUnit() @@ -542,6 +546,19 @@ subroutine ocn_run_mct( EClock, cdata_o, x2o_o, o2x_o) restart_pointer_file = trim(glb%pointer_filename) open(nu, file=restart_pointer_file, form='formatted', status='unknown') write(nu,'(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(nu,'(a)') trim(restartname) // trim(suffix) // '.nc' + enddo + endif + close(nu) write(glb%stdout,*) 'ocn restart pointer file written: ',trim(restartname) endif From 648bb1ce86f19aa3577d21865c393b0537cf5b77 Mon Sep 17 00:00:00 2001 From: alperaltuntas Date: Wed, 5 Aug 2020 17:35:55 -0600 Subject: [PATCH 47/53] make mct cap be able to read multiple restart files from rpointer --- config_src/mct_driver/ocn_comp_mct.F90 | 25 ++++++++++++++++++++----- 1 file changed, 20 insertions(+), 5 deletions(-) diff --git a/config_src/mct_driver/ocn_comp_mct.F90 b/config_src/mct_driver/ocn_comp_mct.F90 index 9466159948..741ce832e8 100644 --- a/config_src/mct_driver/ocn_comp_mct.F90 +++ b/config_src/mct_driver/ocn_comp_mct.F90 @@ -119,7 +119,9 @@ subroutine ocn_init_mct( EClock, cdata_o, x2o_o, o2x_o, NLFilename ) integer :: year, month, day, hour, minute, seconds, seconds_n, seconds_d, rc character(len=240) :: runid !< Run ID character(len=32) :: runtype !< Run type - character(len=240) :: restartfile !< Path/Name of restart file + character(len=512) :: restartfile !< Path/Name of restart file + character(len=2048) :: restartfiles !< Path/Name of restart files. + !! (same as restartfile if a single restart file is to be read in) integer :: nu !< i/o unit to read pointer file character(len=240) :: restart_pointer_file !< File name for restart pointer file character(len=240) :: restartpath !< Path of the restart file @@ -164,6 +166,7 @@ subroutine ocn_init_mct( EClock, cdata_o, x2o_o, o2x_o, NLFilename ) !logical :: lsend_precip_fact !< If T,send precip_fact to cpl for use in fw balance !! (partially-coupled option) character(len=128) :: err_msg !< Error message + integer :: iostat ! set the cdata pointers: call seq_cdata_setptrs(cdata_o, id=MOM_MCT_ID, mpicom=mpicom_ocn, & @@ -296,15 +299,27 @@ subroutine ocn_init_mct( EClock, cdata_o, x2o_o, o2x_o, NLFilename ) nu = shr_file_getUnit() restart_pointer_file = trim(glb%pointer_filename) if (is_root_pe()) write(glb%stdout,*) 'Reading ocn pointer file: ',restart_pointer_file + restartfile = ""; restartfiles = ""; open(nu, file=restart_pointer_file, form='formatted', status='unknown') - read(nu,'(a)') restartfile + do + read(nu,'(a)', iostat=iostat) restartfile + if (len(trim(restartfiles))>1 .and. iostat<0) then + exit ! done reading restart files list. + else if (iostat/=0) then + call MOM_error(FATAL, 'Error reading rpointer.ocn') + 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(nu) - !restartfile = trim(restartpath) // trim(restartfile) if (is_root_pe()) then - write(glb%stdout,*) 'Reading restart file: ',trim(restartfile) + write(glb%stdout,*) 'Reading restart file(s): ',trim(restartfiles) end if call shr_file_freeUnit(nu) - call ocean_model_init(glb%ocn_public, glb%ocn_state, time0, time_start, input_restart_file=trim(restartfile)) + call ocean_model_init(glb%ocn_public, glb%ocn_state, time0, time_start, input_restart_file=trim(restartfiles)) endif if (is_root_pe()) then write(glb%stdout,'(/12x,a/)') '======== COMPLETED MOM INITIALIZATION ========' From 6331da1029854141e9fe88e6730f48652ee928c9 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Thu, 13 Aug 2020 09:28:16 -0600 Subject: [PATCH 48/53] Remove (:,:) after 2-d variable declariation --- src/tracer/MOM_lateral_boundary_diffusion.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/tracer/MOM_lateral_boundary_diffusion.F90 b/src/tracer/MOM_lateral_boundary_diffusion.F90 index dd2e015632..73e4669734 100644 --- a/src/tracer/MOM_lateral_boundary_diffusion.F90 +++ b/src/tracer/MOM_lateral_boundary_diffusion.F90 @@ -314,9 +314,9 @@ real function bulk_average(boundary, nk, deg, h, hBLT, phi, ppoly0_E, ppoly0_coe real, dimension(nk) :: h !< Layer thicknesses [H ~> m or kg m-2] real :: hBLT !< Depth of the boundary layer [H ~> m or kg m-2] real, dimension(nk) :: phi !< Scalar quantity - real, dimension(nk,2) :: ppoly0_E(:,:) !< Edge value of polynomial - real, dimension(nk,deg+1) :: ppoly0_coefs(:,:) !< Coefficients of polynomial - integer :: method !< Remapping scheme to use + real, dimension(nk,2) :: ppoly0_E !< Edge value of polynomial + real, dimension(nk,deg+1) :: ppoly0_coefs!< Coefficients of polynomial + integer :: method !< Remapping scheme to use integer :: k_top !< Index of the first layer within the boundary real :: zeta_top !< Fraction of the layer encompassed by the bottom boundary layer From 287281cf6496ff328e208e69fc01e68cf2713c27 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Thu, 13 Aug 2020 09:33:06 -0600 Subject: [PATCH 49/53] Remove unnecessary present(num_rest_files) condition --- config_src/nuopc_driver/mom_ocean_model_nuopc.F90 | 9 ++------- 1 file changed, 2 insertions(+), 7 deletions(-) diff --git a/config_src/nuopc_driver/mom_ocean_model_nuopc.F90 b/config_src/nuopc_driver/mom_ocean_model_nuopc.F90 index cbbb2261d0..1ba3484ef9 100644 --- a/config_src/nuopc_driver/mom_ocean_model_nuopc.F90 +++ b/config_src/nuopc_driver/mom_ocean_model_nuopc.F90 @@ -690,13 +690,8 @@ subroutine ocean_model_restart(OS, timestamp, restartname, num_rest_files) "restart files can only be created after the buoyancy forcing is applied.") if (present(restartname)) then - if (present(num_rest_files)) then - call save_restart(OS%dirs%restart_output_dir, OS%Time, OS%grid, & - OS%restart_CSp, GV=OS%GV, filename=restartname, num_rest_files=num_rest_files) - else - call save_restart(OS%dirs%restart_output_dir, OS%Time, OS%grid, & - OS%restart_CSp, GV=OS%GV, filename=restartname) - endif + call save_restart(OS%dirs%restart_output_dir, OS%Time, OS%grid, & + 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 From ab9386c662dbe096c34b29bd55c184b3fafa20bc Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Thu, 13 Aug 2020 09:41:12 -0600 Subject: [PATCH 50/53] In do-loops, use uppercase K index for variables discretized on interfaces --- .../vertical/MOM_tidal_mixing.F90 | 20 +++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/src/parameterizations/vertical/MOM_tidal_mixing.F90 b/src/parameterizations/vertical/MOM_tidal_mixing.F90 index 951170c039..708d6a7f46 100644 --- a/src/parameterizations/vertical/MOM_tidal_mixing.F90 +++ b/src/parameterizations/vertical/MOM_tidal_mixing.F90 @@ -783,8 +783,8 @@ subroutine calculate_CVMix_tidal(h, j, G, GV, US, CS, N2_int, Kd_lay, Kd_int, Kv ! XXX: Temporary de-scaling of N2_int(i,:) into a temporary variable - do k=1,G%ke+1 - N2_int_i(k) = US%s_to_T**2 * N2_int(i,k) + do K=1,G%ke+1 + N2_int_i(K) = US%s_to_T**2 * N2_int(i,K) enddo call CVMix_coeffs_tidal( Mdiff_out = Kv_tidal, & @@ -803,14 +803,14 @@ subroutine calculate_CVMix_tidal(h, j, G, GV, US, CS, N2_int, Kd_lay, Kd_int, Kv Kd_lay(i,j,k) = Kd_lay(i,j,k) + 0.5 * US%m2_s_to_Z2_T * (Kd_tidal(k) + Kd_tidal(k+1)) enddo if (present(Kd_int)) then - do k=1,G%ke+1 - Kd_int(i,j,k) = Kd_int(i,j,k) + (US%m2_s_to_Z2_T * Kd_tidal(k)) + do K=1,G%ke+1 + Kd_int(i,j,K) = Kd_int(i,j,K) + (US%m2_s_to_Z2_T * Kd_tidal(K)) enddo endif ! Update viscosity with the proper unit conversion. if (associated(Kv)) then - do k=1,G%ke+1 - Kv(i,j,k) = Kv(i,j,k) + US%m2_s_to_Z2_T * Kv_tidal(k) ! Rescale from m2 s-1 to Z2 T-1. + do K=1,G%ke+1 + Kv(i,j,K) = Kv(i,j,K) + US%m2_s_to_Z2_T * Kv_tidal(K) ! Rescale from m2 s-1 to Z2 T-1. enddo endif @@ -903,15 +903,15 @@ subroutine calculate_CVMix_tidal(h, j, G, GV, US, CS, N2_int, Kd_lay, Kd_int, Kv Kd_lay(i,j,k) = Kd_lay(i,j,k) + 0.5 * US%m2_s_to_Z2_T * (Kd_tidal(k) + Kd_tidal(k+1)) enddo if (present(Kd_int)) then - do k=1,G%ke+1 - Kd_int(i,j,k) = Kd_int(i,j,k) + (US%m2_s_to_Z2_T * Kd_tidal(k)) + do K=1,G%ke+1 + Kd_int(i,j,K) = Kd_int(i,j,K) + (US%m2_s_to_Z2_T * Kd_tidal(K)) enddo endif ! Update viscosity if (associated(Kv)) then - do k=1,G%ke+1 - Kv(i,j,k) = Kv(i,j,k) + US%m2_s_to_Z2_T * Kv_tidal(k) ! Rescale from m2 s-1 to Z2 T-1. + do K=1,G%ke+1 + Kv(i,j,K) = Kv(i,j,K) + US%m2_s_to_Z2_T * Kv_tidal(K) ! Rescale from m2 s-1 to Z2 T-1. enddo endif From 17936f3fd20dbc6725b9f0992933fc31ea3a5079 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Mon, 24 Aug 2020 10:01:39 -0600 Subject: [PATCH 51/53] Add modifications suggested by Bob Hallberg * Fix grid metrics * Fix averaging expression to get the kinetic energy at a vorticity point * Fix loop ranges --- .../lateral/MOM_hor_visc.F90 | 21 ++++++++++--------- 1 file changed, 11 insertions(+), 10 deletions(-) diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index a60d60bb9d..2edafa0f27 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -515,7 +515,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, enddo ; enddo ! Components for the shearing strain - do J=js-2,Jeq+2 ; do I=is-2,Ieq+2 + do J=Jsq-2,Jeq+2 ; do I=Isq-2,Ieq+2 dvdx(I,J) = CS%DY_dxBu(I,J)*(v(i+1,J,k)*G%IdyCv(i+1,J) - v(i,J,k)*G%IdyCv(i,J)) dudy(I,J) = CS%DX_dyBu(I,J)*(u(I,j+1,k)*G%IdxCu(I,j+1) - u(I,j,k)*G%IdxCu(I,j)) enddo ; enddo @@ -694,11 +694,11 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, ! Vorticity if (CS%no_slip) then - do J=js-2,Jeq+2 ; do I=is-2,Ieq+2 + do J=Jsq-2,Jeq+2 ; do I=Isq-2,Ieq+2 vort_xy(I,J) = (2.0-G%mask2dBu(I,J)) * ( dvdx(I,J) - dudy(I,J) ) enddo ; enddo else - do J=js-2,Jeq+2 ; do I=is-2,Ieq+2 + do J=Jsq-2,Jeq+2 ; do I=Isq-2,Ieq+2 vort_xy(I,J) = G%mask2dBu(I,J) * ( dvdx(I,J) - dudy(I,J) ) enddo ; enddo endif @@ -711,22 +711,23 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, if ((CS%Leith_Kh) .or. (CS%Leith_Ah)) then ! Vorticity gradient - do J=js-2,Jeq+2 ; do i=is-1,Ieq+2 + do J=Jsq-1,Jeq+1 ; do i=Isq-1,Ieq+2 DY_dxBu = G%dyBu(I,J) * G%IdxBu(I,J) vort_xy_dx(i,J) = DY_dxBu * (vort_xy(I,J) * G%IdyCu(I,j) - vort_xy(I-1,J) * G%IdyCu(I-1,j)) enddo ; enddo - do j=js-1,Jeq+2 ; do I=is-2,Ieq+2 + do j=Jsq-1,Jeq+2 ; do I=Isq-1,Ieq+1 DX_dyBu = G%dxBu(I,J) * G%IdyBu(I,J) vort_xy_dy(I,j) = DX_dyBu * (vort_xy(I,J) * G%IdxCv(i,J) - vort_xy(I,J-1) * G%IdxCv(i,J-1)) enddo ; enddo ! Laplacian of vorticity do J=Jsq-1,Jeq+1 ; do I=Isq-1,Ieq+1 - DY_dxCv = G%dyCv(i,J) * G%IdxCv(i,J) - DX_dyCu = G%dyCu(I,j) * G%IdyCu(I,j) - Del2vort_q(I,J) = DY_dxCv * (vort_xy_dx(i+1,J) * G%IdyT(i+1,j) - vort_xy_dx(i,J) * G%IdyT(i,j)) + & - DX_dyCu * (vort_xy_dy(I,j+1) * G%IdyT(i,j+1) - vort_xy_dy(I,j) * G%IdyT(i,j)) + DY_dxBu = G%dyBu(I,J) * G%IdxBu(I,J) + DX_dyBu = G%dxBu(I,J) * G%IdyBu(I,J) + + Del2vort_q(I,J) = DY_dxBu * (vort_xy_dx(i+1,J) * G%IdyCv(i+1,J) - vort_xy_dx(i,J) * G%IdyCv(i,J)) + & + DX_dyBu * (vort_xy_dy(I,j+1) * G%IdyCu(I,j+1) - vort_xy_dy(I,j) * G%IdyCu(I,j)) enddo ; enddo do J=Jsq,Jeq+1 ; do I=Isq,Ieq+1 Del2vort_h(i,j) = 0.25*(Del2vort_q(I,J) + Del2vort_q(I-1,J) + Del2vort_q(I,J-1) + Del2vort_q(I-1,J-1)) @@ -1091,7 +1092,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, endif if (CS%Re_Ah > 0.0) then - KE = 0.125*((u(I,j,k)+u(I-1,j,k))**2 + (v(i,J,k)+v(i,J-1,k))**2) + KE = 0.125*((u(I,j,k)+u(I,j+1,k))**2 + (v(i,J,k)+v(i+1,J,k))**2) Ah = sqrt(KE) * CS%Re_Ah_const_xy(i,j) endif From e3bc47a8d99c3c40286470f7855f9755000105b8 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Wed, 26 Aug 2020 10:08:18 -0600 Subject: [PATCH 52/53] Fix letter case to follow MOM6 convention --- src/parameterizations/lateral/MOM_hor_visc.F90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index 2edafa0f27..f35c2fb398 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -636,7 +636,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, elseif (OBC%segment(n)%direction == OBC_DIRECTION_S) then if ((J >= js-1) .and. (J <= je+1)) then do I = max(Isq-1,OBC%segment(n)%HI%isd), min(Ieq+1,OBC%segment(n)%HI%ied) - h_u(I,j) = h_u(i,j+1) + h_u(I,j) = h_u(I,j+1) enddo endif elseif (OBC%segment(n)%direction == OBC_DIRECTION_E) then @@ -1087,8 +1087,8 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, endif ! Smagorinsky_Ah or Leith_Ah if (use_MEKE_Au) then ! *Add* the MEKE contribution - Ah = Ah + 0.25*( (MEKE%Au(I,J) + MEKE%Au(I+1,J+1)) + & - (MEKE%Au(I+1,J) + MEKE%Au(I,J+1)) ) + Ah = Ah + 0.25*( (MEKE%Au(i,j) + MEKE%Au(i+1,j+1)) + & + (MEKE%Au(i+1,j) + MEKE%Au(i,j+1)) ) endif if (CS%Re_Ah > 0.0) then @@ -1194,7 +1194,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, CS%dy2h(i+1,j)*str_xx(i+1,j)) + & G%IdxCu(I,j)*(CS%dx2q(I,J-1)*str_xy(I,J-1) - & CS%dx2q(I,J) *str_xy(I,J))) * & - G%IareaCu(I,j)) / (h_u(i,j) + h_neglect) + G%IareaCu(I,j)) / (h_u(I,j) + h_neglect) enddo ; enddo if (apply_OBC) then From 2946903bca2e3eb98fda1e3e6b7bea72a0c1c1e9 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Wed, 26 Aug 2020 14:43:25 -0600 Subject: [PATCH 53/53] Fix one more letter case to follow MOM6 convention --- src/parameterizations/lateral/MOM_hor_visc.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index f35c2fb398..953cc6d838 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -1923,7 +1923,7 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) endif endif if (CS%Leith_Ah) then - CS%biharm6_const_xy(i,j) = Leith_bi_const * (grid_sp_q3 * grid_sp_q3) + CS%biharm6_const_xy(I,J) = Leith_bi_const * (grid_sp_q3 * grid_sp_q3) endif CS%Ah_bg_xy(I,J) = MAX(Ah, Ah_vel_scale * grid_sp_q2 * sqrt(grid_sp_q2)) if (CS%Re_Ah > 0.0) CS%Re_Ah_const_xy(i,j) = grid_sp_q3 / CS%Re_Ah