From 4ffc47e10e3d3f3bbee50251aacb28b7e0165b92 Mon Sep 17 00:00:00 2001 From: Denise Worthen Date: Fri, 19 Jan 2024 13:25:20 -0500 Subject: [PATCH] prevent division by 0 in appendtail and add timers to meshcap (#1163) --- model/src/cmake/src_list.cmake | 1 + model/src/w3fld1md.F90 | 18 ++++- model/src/wav_comp_nuopc.F90 | 46 +++++++++++-- model/src/wav_wrapper_mod.F90 | 119 +++++++++++++++++++++++++++++++++ 4 files changed, 176 insertions(+), 8 deletions(-) create mode 100644 model/src/wav_wrapper_mod.F90 diff --git a/model/src/cmake/src_list.cmake b/model/src/cmake/src_list.cmake index 2152b697e..dcab88a09 100644 --- a/model/src/cmake/src_list.cmake +++ b/model/src/cmake/src_list.cmake @@ -66,6 +66,7 @@ set(nuopc_mesh_cap_src wav_shel_inp.F90 wav_comp_nuopc.F90 wav_import_export.F90 + wav_wrapper_mod.F90 ) set(esmf_multi_cap_src diff --git a/model/src/w3fld1md.F90 b/model/src/w3fld1md.F90 index 960fd185a..ad94a12ea 100644 --- a/model/src/w3fld1md.F90 +++ b/model/src/w3fld1md.F90 @@ -1116,7 +1116,11 @@ SUBROUTINE APPENDTAIL(INSPC, WN2, NKT, KA1, KA2, KA3, WNDDIR,SAT) DO K=KA1, KA2-1 AVG=SUM(INSPC(K,:))/MAX(REAL(NTH),1.) DO T=1,NTH - INSPC(K,T)=BT(K)*INSPC(K,T)/TPI/(WN2(K)**3.0)/AVG + if (avg /= 0.0) then + INSPC(K,T)=BT(K)*INSPC(K,T)/TPI/(WN2(K)**3.0)/AVG + else + inspc(k,t) = 0.0 + end if ENDDO ENDDO !----------------------------------------------------------- @@ -1134,7 +1138,11 @@ SUBROUTINE APPENDTAIL(INSPC, WN2, NKT, KA1, KA2, KA3, WNDDIR,SAT) ENDDO AVG=SUM(NORMSPC)/MAX(REAL(NTH),1.) DO T=1, NTH - INSPC(K,T) = SAT * NORMSPC(T)/TPI/(WN2(K)**3.0)/AVG + if (avg /= 0.0) then + INSPC(K,T) = SAT * NORMSPC(T)/TPI/(WN2(K)**3.0)/AVG + else + inspc(k,t) = 0.0 + end if ENDDO ENDDO DO T=1, NTH @@ -1148,7 +1156,11 @@ SUBROUTINE APPENDTAIL(INSPC, WN2, NKT, KA1, KA2, KA3, WNDDIR,SAT) AVG=SUM(NORMSPC)/MAX(REAL(NTH),1.)!1./4. DO K=KA3+1, NKT DO T=1, NTH - INSPC(K,T)=NORMSPC(T)*(SAT)/TPI/(WN2(K)**3.0)/AVG + if (avg /= 0.0) then + INSPC(K,T)=NORMSPC(T)*(SAT)/TPI/(WN2(K)**3.0)/AVG + else + inspc(k,t) = 0.0 + end if ENDDO ENDDO DEALLOCATE(ANGLE1) diff --git a/model/src/wav_comp_nuopc.F90 b/model/src/wav_comp_nuopc.F90 index cec62b55d..6f3eeef5a 100644 --- a/model/src/wav_comp_nuopc.F90 +++ b/model/src/wav_comp_nuopc.F90 @@ -48,6 +48,7 @@ module wav_comp_nuopc use w3odatmd , only : user_netcdf_grdout use w3odatmd , only : time_origin, calendar_name, elapsed_secs use wav_shr_mod , only : casename, multigrid, inst_suffix, inst_index, unstr_mesh + use wav_wrapper_mod , only : ufs_settimer, ufs_logtimer, ufs_file_setlogunit, wtime #ifndef W3_CESMCOUPLED use wmwavemd , only : wmwave use wmupdtmd , only : wmupd2 @@ -99,9 +100,12 @@ module wav_comp_nuopc !! using ESMF. If restart_option is present as config !! option, user_restalarm will be true and will be !! set using restart_option, restart_n and restart_ymd - integer :: time0(2) - integer :: timen(2) - + integer :: ymd !< current year-month-day + integer :: tod !< current time of day (sec) + integer :: time0(2) !< start time stored as yyyymmdd,hhmmss + integer :: timen(2) !< end time stored as yyyymmdd,hhmmss + integer :: nu_timer !< simple timer log, unused except by UFS + logical :: runtimelog = .false. !< logical flag for writing runtime log files character(*), parameter :: modName = "(wav_comp_nuopc)" !< the name of this module character(*), parameter :: u_FILE_u = & !< a character string for an ESMF log message __FILE__ @@ -238,6 +242,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) character(len=*), parameter :: subname=trim(modName)//':(InitializeAdvertise) ' !------------------------------------------------------------------------------- + call ufs_settimer(wtime) rc = ESMF_SUCCESS call ESMF_LogWrite(trim(subname)//' called', ESMF_LOGMSG_INFO) @@ -369,6 +374,15 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) write(logmsg,'(A,l)') trim(subname)//': Wave wav_coupling_to_cice setting is ',wav_coupling_to_cice call ESMF_LogWrite(trim(logmsg), ESMF_LOGMSG_INFO) + ! Determine Runtime logging + call NUOPC_CompAttributeGet(gcomp, name="RunTimeLog", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) runtimelog=(trim(cvalue)=="true") + write(logmsg,*) runtimelog + call ESMF_LogWrite('WW3_cap:RunTimeLog = '//trim(logmsg), ESMF_LOGMSG_INFO) + if (runtimelog) then + call ufs_file_setLogUnit('./log.ww3.timer',nu_timer,runtimelog) + end if call advertise_fields(importState, exportState, flds_scalar_name, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -475,6 +489,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) rc = ESMF_SUCCESS if (dbug_flag > 5) call ESMF_LogWrite(trim(subname)//' called', ESMF_LOGMSG_INFO) + call ufs_settimer(wtime) !-------------------------------------------------------------------- ! Set up data structures !-------------------------------------------------------------------- @@ -871,6 +886,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) enddo end if #endif + if (root_task) call ufs_logtimer(nu_timer,time,start_tod,'InitializeRealize time: ',runtimelog,wtime) if (dbug_flag > 5) call ESMF_LogWrite(trim(subname)//' done', ESMF_LOGMSG_INFO) @@ -1000,8 +1016,6 @@ subroutine ModelAdvance(gcomp, rc) type(ESMF_Time) :: currTime, nextTime, startTime, stopTime integer :: yy,mm,dd,hh,ss integer :: imod - integer :: ymd ! current year-month-day - integer :: tod ! current time of day (sec) integer :: shrlogunit ! original log unit and level character(ESMF_MAXSTR) :: msgString character(len=*),parameter :: subname = '(wav_comp_nuopc:ModelAdvance) ' @@ -1041,6 +1055,8 @@ subroutine ModelAdvance(gcomp, rc) if ( root_task ) then write(nds(1),'(a,3i4,i10)') 'ymd2date currTime wav_comp_nuopc hh,mm,ss,ymd', hh,mm,ss,ymd end if + if (root_task) call ufs_logtimer(nu_timer,time,tod,'ModelAdvance time since last step: ',runtimelog,wtime) + call ufs_settimer(wtime) ! use next time; the NUOPC clock is not updated ! until the end of the time interval @@ -1138,6 +1154,8 @@ subroutine ModelAdvance(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (dbug_flag > 5) call ESMF_LogWrite(trim(subname)//' done', ESMF_LOGMSG_INFO) + if (root_task) call ufs_logtimer(nu_timer,time,tod,'ModelAdvance time: ',runtimelog,wtime) + call ufs_settimer(wtime) end subroutine ModelAdvance @@ -1357,6 +1375,7 @@ subroutine ModelFinalize(gcomp, rc) end if call ESMF_LogWrite(trim(subname)//' done', ESMF_LOGMSG_INFO) + if(root_task) call ufs_logtimer(nu_timer,timen,tod,'ModelFinalize time: ',runtimelog,wtime) end subroutine ModelFinalize @@ -1575,6 +1594,7 @@ subroutine waveinit_ufs( gcomp, ntrace, mpi_comm, mds, rc) ! Initialize ww3 for ufs (called from InitializeRealize) use w3odatmd , only : fnmpre + use w3gdatmd , only : dtcfl, dtcfli, dtmax, dtmin use w3initmd , only : w3init use wav_shel_inp , only : read_shel_config use wav_shel_inp , only : npts, odat, iprt, x, y, pnames, prtfrm @@ -1591,6 +1611,7 @@ subroutine waveinit_ufs( gcomp, ntrace, mpi_comm, mds, rc) character(len=CL) :: logmsg logical :: isPresent, isSet character(len=CL) :: cvalue + integer :: dt_in(4) character(len=*), parameter :: subname = '(wav_comp_nuopc:wavinit_ufs)' ! ------------------------------------------------------------------- @@ -1638,6 +1659,21 @@ subroutine waveinit_ufs( gcomp, ntrace, mpi_comm, mds, rc) call w3init ( 1, .false., 'ww3', mds, ntrace, odat, flgrd, flgr2, flgd, flg2, & npts, x, y, pnames, iprt, prtfrm, mpi_comm ) + write(logmsg,'(A,4f10.2)') trim(subname)//': mod_def timesteps file ',dtmax,dtcfl,dtcfli,dtmin + call ESMF_LogWrite(trim(logmsg), ESMF_LOGMSG_INFO) + call NUOPC_CompAttributeGet(gcomp, name='dt_in', isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + call NUOPC_CompAttributeGet(gcomp, name='dt_in', value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*)dt_in + dtmax = real(dt_in(1),4) + dtcfl = real(dt_in(2),4) + dtcfli = real(dt_in(3),4) + dtmin = real(dt_in(4),4) + write(logmsg,'(A,4f10.2)') trim(subname)//': mod_def timesteps reset ',dtmax,dtcfl,dtcfli,dtmin + call ESMF_LogWrite(trim(logmsg), ESMF_LOGMSG_INFO) + end if if (dbug_flag > 5) call ESMF_LogWrite(trim(subname)//' done', ESMF_LOGMSG_INFO) end subroutine waveinit_ufs diff --git a/model/src/wav_wrapper_mod.F90 b/model/src/wav_wrapper_mod.F90 new file mode 100644 index 000000000..dd2465829 --- /dev/null +++ b/model/src/wav_wrapper_mod.F90 @@ -0,0 +1,119 @@ +!> @file wav_wrapper_mod +!! +!> A wrapper module for log functionality in UFS +!! +!> @details Contains public logging routines for UFS and +!! stub routines for CESM +!! +!> Denise.Worthen@noaa.gov +!> @date 01-08-2024 +module wav_wrapper_mod + + use wav_kind_mod , only : r8 => shr_kind_r8, r4 => shr_kind_r4, i4 => shr_kind_i4 + use wav_kind_mod , only : CL => shr_kind_cl, CS => shr_kind_cs + + implicit none + + real(r8) :: wtime = 0.0 + +#ifdef CESMCOUPLED +contains + ! Define stub routines that do nothing - they are just here to avoid + ! having cppdefs in the main program + subroutine ufs_settimer(timevalue) + real(r8), intent(inout) :: timevalue + end subroutine ufs_settimer + subroutine ufs_logtimer(nunit,times,tod,string,runtimelog,wtime0) + integer, intent(in) :: nunit + integer(i4), intent(in) :: times(2), tod + character(len=*), intent(in) :: string + logical, intent(in) :: runtimelog + real(r8), intent(in) :: wtime0 + end subroutine ufs_logtimer + subroutine ufs_file_setLogUnit(filename,nunit,runtimelog) + character(len=*), intent(in) :: filename + logical, intent(in) :: runtimelog + integer, intent(out) :: nunit + end subroutine ufs_file_setLogUnit + subroutine ufs_logfhour(msg,hour) + character(len=*), intent(in) :: msg + real(r8), intent(in) :: hour + end subroutine ufs_logfhour +#else +contains + subroutine ufs_settimer(timevalue) + !> Set a time value + !! @param[inout] timevalue a MPI time value + !! + !> Denise.Worthen@noaa.gov + !> @date 01-08-2024 + + real(r8), intent(inout) :: timevalue + real(r8) :: MPI_Wtime + timevalue = MPI_Wtime() + end subroutine ufs_settimer + + subroutine ufs_logtimer(nunit,times,tod,string,runtimelog,wtime0) + !> Log a time interval + !! @param[in] nunit the log file unit + !! @param[in] times the ymd,hms time values + !! @param[in] tod the elapsed seconds in the day + !! @param[in] string a message string to log + !! @param[in] runtimelog a logical to control the log function + !! @param[in] wtime0 an initial MPI time + !! + !> Denise.Worthen@noaa.gov + !> @date 01-08-2024 + integer, intent(in) :: nunit + integer(i4), intent(in) :: times(2),tod + character(len=*), intent(in) :: string + logical, intent(in) :: runtimelog + real(r8), intent(in) :: wtime0 + real(r8) :: MPI_Wtime, timevalue + if (.not. runtimelog) return + if (wtime0 > 0.) then + timevalue = MPI_Wtime()-wtime0 + write(nunit,'(3i8,a,g14.7)')times,tod,' WW3 '//trim(string),timevalue + end if + end subroutine ufs_logtimer + + subroutine ufs_file_setLogUnit(filename,nunit,runtimelog) + !> Create a log unit + !! @param[in] filename the log filename + !! @param[in] runtimelog a logical to control the log function + !! @param[out] nunit the log file unit + !! + !> Denise.Worthen@noaa.gov + !> @date 01-08-2024 + + character(len=*), intent(in) :: filename + logical, intent(in) :: runtimelog + integer, intent(out) :: nunit + if (.not. runtimelog) return + open (newunit=nunit, file=trim(filename)) + end subroutine ufs_file_setLogUnit + + subroutine ufs_logfhour(msg,hour) + !> Log the completion of model output + !! @param[in] msg the log message + !! @param[in] hour the forecast hour + !! + !> Denise.Worthen@noaa.gov + !> @date 01-08-2024 + + character(len=*), intent(in) :: msg + real(r8), intent(in) :: hour + + character(len=CS) :: filename + integer(r4) :: nunit + + write(filename,'(a,i3.3)')'log.ww3.f',int(hour) + open(newunit=nunit,file=trim(filename)) + write(nunit,'(a)')'completed: ww3' + write(nunit,'(a,f10.3)')'forecast hour:',hour + write(nunit,'(a)')'valid time: '//trim(msg) + close(nunit) + end subroutine ufs_logfhour +#endif + +end module wav_wrapper_mod