From 7441c25280faad608c846a60bfd78c1475043af5 Mon Sep 17 00:00:00 2001 From: Denise Worthen Date: Fri, 19 Jan 2024 13:25:20 -0500 Subject: [PATCH] cherry-pick from dev/ufs-weather-model: 4ffc47e10e3d3f3bbee50251aacb28b7e0165b92 --- model/src/cmake/src_list.cmake | 18 +- model/src/w3fld1md.F90 | 18 +- model/src/wav_comp_nuopc.F90 | 1680 ++++++++++++++++++++++++++++++++ model/src/wav_wrapper_mod.F90 | 119 +++ 4 files changed, 1830 insertions(+), 5 deletions(-) create mode 100644 model/src/wav_comp_nuopc.F90 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 a73f3b72b..dcab88a09 100644 --- a/model/src/cmake/src_list.cmake +++ b/model/src/cmake/src_list.cmake @@ -55,6 +55,22 @@ set(ftn_src wmupdtmd.F90 wmwavemd.F90 w3tidemd.F90 + wav_grdout.F90 + w3iogoncdmd.F90 + wav_shr_flags.F90 + ) + +set(nuopc_mesh_cap_src + wav_kind_mod.F90 + wav_shr_mod.F90 + wav_shel_inp.F90 + wav_comp_nuopc.F90 + wav_import_export.F90 + wav_wrapper_mod.F90 + ) + +set(esmf_multi_cap_src + wmesmfmd.F90 ) # Built when PDLIB is enabled @@ -92,5 +108,3 @@ set(scripnc_src ${CMAKE_CURRENT_SOURCE_DIR}/SCRIP/scrip_remap_write.f ${CMAKE_CURRENT_SOURCE_DIR}/SCRIP/scrip_remap_read.f ) - - diff --git a/model/src/w3fld1md.F90 b/model/src/w3fld1md.F90 index 10b2fce08..fdd5ad230 100644 --- a/model/src/w3fld1md.F90 +++ b/model/src/w3fld1md.F90 @@ -1120,7 +1120,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 !----------------------------------------------------------- @@ -1138,7 +1142,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 @@ -1152,7 +1160,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 new file mode 100644 index 000000000..6f3eeef5a --- /dev/null +++ b/model/src/wav_comp_nuopc.F90 @@ -0,0 +1,1680 @@ +!> @file wav_comp_nuopc +!! +!> A NUOPC interface for WAVEWATCH III using the CMEPS mediator +!! +!> @details This module contains the base functionality of a mesh-based +!! NUOPC cap for WW3. It contains the only public entry point, SetServices +!! which registers all of the user-provided subroutines accessed by the NUOPC +!! layer. These include the user-routines to advertise the standard names of the +!! import and export fields (InitializeAdvertise), initialize the Wave model and +!! and realize the required fields within the import and export States on an +!! ESMF Mesh (InitializeRealize), fill the export State with initial values +!! (DataInitialize), advance the model one timestep (ModelAdvance), manage the +!! component clock (ModelSetRunClock), and finalize the component model at the +!! (ModelFinalize). +!! +!! The module wav_import_export includes the public routines to advertise and +!! realize the import and export fields called during the InitializeAdvertise and +!! InitializRealize phases, respectively and to fill the import and export states +!! during the ModelAdvance phase. +!! +!! The module wav_shr_mod contains public routines to access basic ESMF functions +!! and reduce code duplication. +!! +!> @author mvertens@ucar.edu, Denise.Worthen@noaa.gov +!> @date 01-05-2022 +module wav_comp_nuopc + + use ESMF + use NUOPC , only : NUOPC_CompDerive, NUOPC_CompSetEntryPoint, NUOPC_CompSpecialize + use NUOPC , only : NUOPC_CompFilterPhaseMap, NUOPC_IsUpdated, NUOPC_IsAtTime + use NUOPC , only : NUOPC_CompAttributeGet, NUOPC_Advertise + use NUOPC , only : NUOPC_SetAttribute, NUOPC_CompAttributeGet, NUOPC_CompAttributeSet + 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 : NUOPC_ModelGet, SetVM + use wav_kind_mod , only : r8=>shr_kind_r8, i8=>shr_kind_i8, i4=>shr_kind_i4 + use wav_kind_mod , only : cl=>shr_kind_cl, cs=>shr_kind_cs + use wav_import_export , only : advertise_fields, realize_fields, nseal_cpl + use wav_shr_mod , only : state_diagnose, state_getfldptr, state_fldchk + use wav_shr_mod , only : chkerr, state_setscalar, state_getscalar, alarmInit, ymd2date + use wav_shr_mod , only : wav_coupling_to_cice, nwav_elev_spectrum + use wav_shr_mod , only : merge_import, dbug_flag + use w3odatmd , only : nds, iaproc, napout + use w3odatmd , only : runtype, use_user_histname, user_histfname, use_user_restname, user_restfname + 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 + use wmmdatmd , only : mdse, mdst, nrgrd, improc, nmproc, wmsetm, stime, etime + use wmmdatmd , only : nmpscr + use w3updtmd , only : w3uini + use w3adatmd , only : flcold, fliwnd +#endif + use constants , only : is_esmf_component + + implicit none + private ! except + + public :: SetServices + public :: SetVM + private :: InitializeP0 + private :: InitializeAdvertise + private :: InitializeRealize + private :: ModelSetRunClock + private :: ModelAdvance + private :: ModelFinalize + + include "mpif.h" + + !-------------------------------------------------------------------------- + ! Private module data + !-------------------------------------------------------------------------- + + character(len=CL) :: flds_scalar_name = '' !< the default scalar field name + integer :: flds_scalar_num = 0 !< the default number of scalar fields + integer :: flds_scalar_index_nx = 0 !< the default size of the scalar field nx + integer :: flds_scalar_index_ny = 0 !< the default size of the scalar field ny + logical :: profile_memory = .false. !< default logical to control use of ESMF + !! memory profiling + + logical :: root_task = .false. !< logical to indicate root task +#ifdef W3_CESMCOUPLED + logical :: cesmcoupled = .true. !< logical to indicate CESM use case +#else + logical :: cesmcoupled = .false. !< logical to indicate non-CESM use case +#endif + integer, allocatable :: tend(:,:) !< the ending time of ModelAdvance when + !! run with multigrid=true + logical :: user_histalarm = .false. !< logical flag for user to set history alarms + !! using ESMF. If history_option is present as config + !! option, user_histalarm will be true and will be + !! set using history_option, history_n and history_ymd + logical :: user_restalarm = .false. !< logical flag for user to set restart alarms + !! 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 :: 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__ + + !=============================================================================== +contains + !=============================================================================== + !> The public entry point. The NUOPC SetService method registers all of the + !! user-provided subroutines in the module with the NUOPC layer + !! + !! @param[in] gcomp an ESMF_GridComp object + !! @param[out] rc return code + !! + !> @author mvertens@ucar.edu, Denise.Worthen@noaa.gov + !> @date 01-05-2022 + subroutine SetServices(gcomp, rc) + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + + character(len=*),parameter :: subname=trim(modName)//':(SetServices) ' + + rc = ESMF_SUCCESS + call ESMF_LogWrite(trim(subname)//' called', ESMF_LOGMSG_INFO) + + ! the NUOPC gcomp component will register the generic methods + call NUOPC_CompDerive(gcomp, model_routine_SS, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! switching to IPD versions + call ESMF_GridCompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, & + userRoutine=InitializeP0, phase=0, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! set entry point for methods that require specific implementation + call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, & + phaseLabelList=(/"IPDv01p1"/), userRoutine=InitializeAdvertise, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, & + phaseLabelList=(/"IPDv01p3"/), userRoutine=InitializeRealize, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! attach specializing method(s) + + call NUOPC_CompSpecialize(gcomp, specLabel=model_label_DataInitialize, & + specRoutine=DataInitialize, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call NUOPC_CompSpecialize(gcomp, specLabel=model_label_Advance, & + specRoutine=ModelAdvance, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_MethodRemove(gcomp, label=model_label_SetRunClock, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompSpecialize(gcomp, specLabel=model_label_SetRunClock, & + specRoutine=ModelSetRunClock, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call NUOPC_CompSpecialize(gcomp, specLabel=model_label_Finalize, & + specRoutine=ModelFinalize, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_LogWrite(trim(subname)//' done', ESMF_LOGMSG_INFO) + + end subroutine SetServices + + !=============================================================================== + !> Switch to IPDv01 by filtering all other phaseMap entries + !! + !> @details Called by NUOPC to set the version of the Initialize Phase Definition + !! (IPD) to use. + !! + !! @param[in] gcomp an ESMF_GridComp object + !! @param[in] importState an ESMF_State object for import fields + !! @param[in] exportState an ESMF_State object for export fields + !! @param[in] clock an ESMF_Clock object + !! @param[out] rc return code + !! + !> @author mvertens@ucar.edu, Denise.Worthen@noaa.gov + !> @date 01-05-2022 + subroutine InitializeP0(gcomp, importState, exportState, clock, rc) + type(ESMF_GridComp) :: gcomp + type(ESMF_State) :: importState, exportState + type(ESMF_Clock) :: clock + integer, intent(out) :: rc + !------------------------------------------------------------------------------- + + rc = ESMF_SUCCESS + + ! Switch to IPDv01 by filtering all other phaseMap entries + + call NUOPC_CompFilterPhaseMap(gcomp, ESMF_METHOD_INITIALIZE, acceptStringList=(/"IPDv01p"/), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + end subroutine InitializeP0 + + !=============================================================================== + !> Read configuration attributes and advertise the import/export fields + + !> @details Called by NUOPC to read configuration attributes and to advertise the + !! import and export fields. The configuration attributes are used to control run + !! time settings, such as ESMF memory profiling, additional debug logging, multigrid + !! mode and character strings for specific use cases. A set of configuration attributes + !! is also read to describe any scalar fields to be added to a state. For coupling + !! with the wave model, only a scalar field for the dimensions of the wave model + !! is required. The scalar field is added to the export state to communicate to the + !! CMEPS mediator the domain dimensions of the wave model in order to write + !! mediator history and restart files. The attribute ScalarFieldName sets the name + !! of the scalar field in the export state, the ScalarFieldCount sets the + !! dimensionality of the scalar field and the ScalarFieldIdxGridNX (NY) set the + !! index of the NX or NY dimension in the scalar field. + !! + !! @param[in] gcomp an ESMF_GridComp object + !! @param[in] importState an ESMF_State object for import fields + !! @param[in] exportState an ESMF_State object for export fields + !! @param[in] clock an ESMF_Clock object + !! @param[out] rc return code + !! + !> @author mvertens@ucar.edu, Denise.Worthen@noaa.gov + !> @date 01-05-2022 + subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) + + use wav_shr_flags, only : w3_pdlib_flag + ! input/output arguments + type(ESMF_GridComp) :: gcomp + type(ESMF_State) :: importState, exportState + type(ESMF_Clock) :: clock + integer, intent(out) :: rc + + ! local variables + character(len=CL) :: logmsg + logical :: isPresent, isSet + character(len=CL) :: cvalue + character(len=*), parameter :: subname=trim(modName)//':(InitializeAdvertise) ' + !------------------------------------------------------------------------------- + + call ufs_settimer(wtime) + rc = ESMF_SUCCESS + call ESMF_LogWrite(trim(subname)//' called', ESMF_LOGMSG_INFO) + + !---------------------------------------------------------------------------- + ! advertise fields + !---------------------------------------------------------------------------- + + call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldName", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + flds_scalar_name = trim(cvalue) + call ESMF_LogWrite(trim(subname)//' flds_scalar_name = '//trim(flds_scalar_name), ESMF_LOGMSG_INFO) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + call ESMF_LogWrite(trim(subname)//'Need to set attribute ScalarFieldName',& + ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) + rc = ESMF_FAILURE + return + endif + + call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldCount", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + read(cvalue, *) flds_scalar_num + write(logmsg,*) flds_scalar_num + call ESMF_LogWrite(trim(subname)//' flds_scalar_num = '//trim(logmsg), ESMF_LOGMSG_INFO) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + call ESMF_LogWrite(trim(subname)//'Need to set attribute ScalarFieldCount',& + ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) + rc = ESMF_FAILURE + return + endif + + call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldIdxGridNX", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + read(cvalue,*) flds_scalar_index_nx + write(logmsg,*) flds_scalar_index_nx + call ESMF_LogWrite(trim(subname)//' : flds_scalar_index_nx = '//trim(logmsg), ESMF_LOGMSG_INFO) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + call ESMF_LogWrite(trim(subname)//'Need to set attribute ScalarFieldIdxGridNX',& + ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) + rc = ESMF_FAILURE + return + endif + + call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldIdxGridNY", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + read(cvalue,*) flds_scalar_index_ny + write(logmsg,*) flds_scalar_index_ny + call ESMF_LogWrite(trim(subname)//' : flds_scalar_index_ny = '//trim(logmsg), ESMF_LOGMSG_INFO) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + call ESMF_LogWrite(trim(subname)//'Need to set attribute ScalarFieldIdxGridNY',& + ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) + rc = ESMF_FAILURE + return + endif + + call NUOPC_CompAttributeGet(gcomp, name="ProfileMemory", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + read(cvalue,*) profile_memory + call ESMF_LogWrite(trim(subname)//': profile_memory = '//trim(cvalue), ESMF_LOGMSG_INFO) + end if + + call NUOPC_CompAttributeGet(gcomp, name="merge_import", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + if (trim(cvalue) == '.true.') then + merge_import = .true. + end if + end if + if (merge_import) then + if (w3_pdlib_flag) then + call ESMF_LogWrite('Merge_import is not valid with PDLIB', ESMF_LOGMSG_INFO) + call ESMF_Finalize(endflag=ESMF_END_ABORT) + end if + end if + + call NUOPC_CompAttributeGet(gcomp, name='dbug_flag', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + read(cvalue,*) dbug_flag + end if + write(logmsg,'(A,i6)') trim(subname)//': Wave cap dbug_flag is ',dbug_flag + call ESMF_LogWrite(trim(logmsg), ESMF_LOGMSG_INFO) + + ! Get casename + call NUOPC_CompAttributeGet(gcomp, name="case_name", value=casename, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + write(logmsg,'(A)') trim(subname)//': Wave casename setting : '//trim(casename) + call ESMF_LogWrite(trim(logmsg), ESMF_LOGMSG_INFO) + + ! Get component instance + call NUOPC_CompAttributeGet(gcomp, name="inst_suffix", isPresent=isPresent, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (isPresent) then + call NUOPC_CompAttributeGet(gcomp, name="inst_suffix", value=inst_suffix, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + cvalue = inst_suffix(2:) + read(cvalue, *) inst_index + else + inst_suffix = "" + inst_index=1 + endif + + ! Get Multigrid setting + multigrid = .false. + call NUOPC_CompAttributeGet(gcomp, name='multigrid', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + multigrid=(trim(cvalue)=="true") + end if + write(logmsg,'(A,l)') trim(subname)//': Wave multigrid setting is ',multigrid + call ESMF_LogWrite(trim(logmsg), ESMF_LOGMSG_INFO) + + ! Determine wave-ice coupling + wav_coupling_to_cice = .false. + call NUOPC_CompAttributeGet(gcomp, name='wav_coupling_to_cice', value=cvalue, isPresent=isPresent, & + isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + wav_coupling_to_cice=(trim(cvalue)=="true") + end if + 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 + + call ESMF_LogWrite(trim(subname)//' done', ESMF_LOGMSG_INFO) + + end subroutine InitializeAdvertise + + !======================================================================== + !> Realize the import and export fields. + + !> @details Called by NUOPC to realize the import and export fields + !! for the wave model. After the wave model initializes, the global index + !! for all sea points is retrieved using the WW3 mapsf array. A global index + !! array is then constructed which contains both land and sea points, with + !! the land points at the end of the array. An ESMF Distgrid object is created + !! using this global index array. The distgrid is then transfered to the ESMF + !! Mesh provided for the wave model domain. If the provided Mesh does not contain + !! a grid mask, then the internal WW3 mask is transfered to the Mesh, otherwise + !! the mask provided with the mesh file will be used. This mask is used by + !! CMEPS to map to and from the wave model. Once the mesh has been created, the + !! advertised fields are realized on the mesh. + !! + !! @param[in] gcomp an ESMF_GridComp object + !! @param[in] importState an ESMF_State object for import fields + !! @param[in] exportState an ESMF_State object for export fields + !! @param[in] clock an ESMF_Clock object + !! @param[out] rc return code + !! + !> @author mvertens@ucar.edu, Denise.Worthen@noaa.gov + !> @date 01-05-2022 + subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) + + use w3odatmd , only : w3nout, w3seto, naproc, iaproc, naperr, napout + use w3timemd , only : stme21 + use w3adatmd , only : w3naux, w3seta + use w3idatmd , only : w3seti, w3ninp + use w3gdatmd , only : nk, nseal, nsea, nx, ny, mapsf, w3nmod, w3setg + use w3gdatmd , only : rlgtype, ungtype, gtype + use w3wdatmd , only : va, time, w3ndat, w3dimw, w3setw + use w3parall , only : init_get_isea +#ifndef W3_CESMCOUPLED + use wminitmd , only : wminit, wminitnml + use wmunitmd , only : wmuget, wmuset +#endif + use wav_shel_inp , only : set_shel_io + use wav_grdout , only : wavinit_grdout + use wav_shr_mod , only : diagnose_mesh, write_meshdecomp +#ifdef W3_PDLIB + use yowNodepool , only : ng +#endif + + ! input/output variables + type(ESMF_GridComp) :: gcomp + type(ESMF_State) :: importState + type(ESMF_State) :: exportState + type(ESMF_Clock) :: clock + integer, intent(out) :: rc + + ! local variables + type(ESMF_DistGrid) :: distGrid + type(ESMF_Mesh) :: Emesh + type(ESMF_Array) :: elemMaskArray + type(ESMF_VM) :: vm + type(ESMF_Time) :: esmfTime, startTime, currTime, stopTime + type(ESMF_TimeInterval) :: TimeOffset + type(ESMF_TimeInterval) :: TimeStep + type(ESMF_Calendar) :: calendar + character(CL) :: cvalue + integer :: shrlogunit + integer :: yy,mm,dd,hh,ss + integer :: start_ymd ! start date (yyyymmdd) + integer :: start_tod ! start time of day (sec) + integer :: stop_ymd ! stop date (yyyymmdd) + integer :: stop_tod ! stop time of day (sec) + integer :: ix, iy + character(CL) :: starttype + integer :: ntrace(2) + integer :: n, jsea,isea, ncnt + integer :: nlnd, nlnd_global, nlnd_local + integer :: my_lnd_start, my_lnd_end + integer, allocatable, target :: mask_global(:) + integer, allocatable, target :: mask_local(:) + integer, allocatable :: gindex_lnd(:) + integer, allocatable :: gindex_sea(:) + integer, allocatable :: gindex(:) + integer(i4) :: maskmin + integer(i4), pointer :: meshmask(:) + character(23) :: dtme21 + integer :: iam, mpi_comm + character(ESMF_MAXSTR) :: msgString + character(ESMF_MAXSTR) :: diro + character(CL) :: logfile + logical :: local + integer :: imod, idsi, idso, idss, idst, idse + integer :: mds(13) ! Note that nds is set to this in w3initmod + integer :: stdout + integer :: petcount + real(r8) :: toff + character(ESMF_MAXSTR) :: preamb = './' + character(ESMF_MAXSTR) :: ifname = 'ww3_multi.inp' + character(len=*), parameter :: subname = '(wav_comp_nuopc:InitializeRealize)' + ! ------------------------------------------------------------------- + + rc = ESMF_SUCCESS + if (dbug_flag > 5) call ESMF_LogWrite(trim(subname)//' called', ESMF_LOGMSG_INFO) + + call ufs_settimer(wtime) + !-------------------------------------------------------------------- + ! Set up data structures + !-------------------------------------------------------------------- + + if (.not. multigrid) then + call w3nmod ( 1, 6, 6 ) + call w3ndat ( 6, 6 ) + call w3naux ( 6, 6 ) + call w3nout ( 6, 6 ) + call w3ninp ( 6, 6 ) + + call w3setg ( 1, 6, 6 ) + call w3setw ( 1, 6, 6 ) + call w3seta ( 1, 6, 6 ) + call w3seto ( 1, 6, 6 ) + call w3seti ( 1, 6, 6 ) + end if + + !---------------------------------------------------------------------------- + ! Generate local mpi comm + !---------------------------------------------------------------------------- + + call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_VMGet(vm, mpiCommunicator=mpi_comm, peCount=petcount, localPet=iam, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return +#ifndef W3_CESMCOUPLED + nmproc = petcount +#else + naproc = petcount +#endif + + ! naproc,iproc, napout, naperr are not available until after wminit +#ifndef W3_CESMCOUPLED + improc = iam + 1 + if (multigrid) then + nmpscr = 1 + is_esmf_component = .true. + else + iaproc = iam + 1 + naproc = nmproc + napout = 1 + naperr = 1 + end if + if (improc == 1) root_task = .true. +#else + iaproc = iam + 1 + napout = 1 + naperr = 1 + if (iaproc == napout) root_task = .true. +#endif + + !-------------------------------------------------------------------- + ! IO set-up + !-------------------------------------------------------------------- + + if (cesmcoupled) then + shrlogunit = 6 + if ( root_task ) then + call NUOPC_CompAttributeGet(gcomp, name="diro", value=diro, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompAttributeGet(gcomp, name="logfile", value=logfile, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + open (newunit=stdout, file=trim(diro)//"/"//trim(logfile)) + else + stdout = 6 + endif + else + stdout = 6 + end if + + if (.not. multigrid) call set_shel_io(stdout,mds,ntrace) + + if ( root_task ) then + write(stdout,'(a)')' *** WAVEWATCH III Program shell *** ' + write(stdout,'(a)')'===============================================' + end if + + !-------------------------------------------------------------------- + ! Initialize run type + !-------------------------------------------------------------------- + + call NUOPC_CompAttributeGet(gcomp, name='start_type', value=starttype, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if ( trim(starttype) == trim('startup')) then + runtype = "initial" + else if (trim(starttype) == trim('continue') ) then + runtype = "continue" + else if (trim(starttype) == trim('branch')) then + runtype = "branch" + end if + if ( root_task ) then + write(stdout,*) 'WW3 runtype is '//trim(runtype) + end if + call ESMF_LogWrite('WW3 runtype is '//trim(runtype), ESMF_LOGMSG_INFO) + + !-------------------------------------------------------------------- + ! Time initialization + !-------------------------------------------------------------------- + + ! TIME0 = from ESMF clock + ! NOTE - are not setting TIMEN here + + if ( root_task ) then + write(stdout,'(a)')' Time interval : ' + write(stdout,'(a)')'--------------------------------------------------' + end if + + call ESMF_ClockPrint(clock, options="startTime", preString="Model Start Time: ", & + unit=msgString, rc=rc) + call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) + call ESMF_ClockPrint(clock, options="currTime", preString="Model Current Time: ", & + unit=msgString, rc=rc) + call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) + call ESMF_ClockGet( clock, startTime=startTime, currTime=currTime, rc=rc) + TimeOffset = currTime - startTime + call ESMF_TimeIntervalGet(TimeOffset, h_r8=toff, rc=rc) + write(msgstring,'(a,g14.7)')'TimeOffset: CurrTime - StartTime = ',toff + call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) + ! Initial run or restart run + if ( runtype == "initial") then + call ESMF_ClockGet( clock, startTime=esmfTime, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return +#ifndef W3_CESMCOUPLED + esmfTime = esmfTime + TimeOffset +#endif + else + call ESMF_ClockGet( clock, currTime=esmfTime, rc=rc ) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + endif + ! Determine time attributes for history output + call ESMF_TimeGet( esmfTime, timeString=time_origin, calendar=calendar, rc=rc ) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + time_origin = 'seconds since '//time_origin(1:10)//' '//time_origin(12:19) + !call ESMF_ClockGet(clock, calendar=calendar) + if (calendar == ESMF_CALKIND_GREGORIAN) then + calendar_name = 'standard' + else if (calendar == ESMF_CALKIND_NOLEAP) then + calendar_name = 'noleap' + end if + call ESMF_TimeGet( esmfTime, yy=yy, mm=mm, dd=dd, s=start_tod, rc=rc ) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ymd2date(yy, mm, dd, start_ymd) + + hh = start_tod/3600 + mm = (start_tod - (hh * 3600))/60 + ss = start_tod - (hh*3600) - (mm*60) + + time0(1) = start_ymd + time0(2) = hh*10000 + mm*100 + ss + + call ESMF_ClockGet( clock, stopTime=stopTime, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_TimeGet( stopTime, yy=yy, mm=mm, dd=dd, s=stop_tod, rc=rc ) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ymd2date(yy, mm, dd, stop_ymd) + + hh = stop_tod/3600 + mm = (stop_tod - (hh * 3600))/60 + ss = stop_tod - (hh*3600) - (mm*60) + + timen(1) = stop_ymd + timen(2) = hh*10000 + mm*100 + ss + + call stme21 ( time0 , dtme21 ) + if ( root_task ) then + write (stdout,'(a)')' Starting time : '//trim(dtme21) + write (stdout,'(a,i8,2x,i8)') 'start_ymd, stop_ymd = ',start_ymd, stop_ymd + end if +#ifndef W3_CESMCOUPLED + stime = time0 + etime = timen +#endif + + !-------------------------------------------------------------------- + ! Wave model initialization + !-------------------------------------------------------------------- + +#ifndef W3_CESMCOUPLED + if (multigrid) then + call ESMF_UtilIOUnitGet(idsi); open(unit=idsi, status='scratch') + call ESMF_UtilIOUnitGet(idso); open(unit=idso, status='scratch') + call ESMF_UtilIOUnitGet(idss); open(unit=idss, status='scratch') + call ESMF_UtilIOUnitGet(idst); open(unit=idst, status='scratch') + call ESMF_UtilIOUnitGet(idse); open(unit=idse, status='scratch') + close(idsi); close(idso); close(idss); close(idst); close(idse) + + if ( trim(ifname) == 'ww3_multi.nml' ) then + call wminitnml ( idsi, idso, idss, idst, idse, trim(ifname), & + mpi_comm, preamb=preamb ) + else + call wminit ( idsi, idso, idss, idst, idse, trim(ifname), & + mpi_comm, preamb=preamb ) + endif + + allocate(tend(2,nrgrd)) + do imod = 1,nrgrd + tend(1,imod) = etime(1) + tend(2,imod) = etime(2) + end do + call ESMF_LogWrite(trim(subname)//' done = wminit', ESMF_LOGMSG_INFO) + else + call waveinit_ufs(gcomp, ntrace, mpi_comm, mds, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if +#else + time = time0 + call ESMF_ClockGet( clock, timeStep=timeStep, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call waveinit_cesm(gcomp, ntrace, mpi_comm, mds, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return +#endif + + ! call mpi_barrier ( mpi_comm, ierr ) + if ( root_task ) then + inquire(unit=nds(1), name=logfile) + print *,'WW3 log written to '//trim(logfile) + end if + + if (wav_coupling_to_cice) then + if (nwav_elev_spectrum .gt. nk) then + call ESMF_LogWrite('nwav_elev_spectrum is greater than nk ', ESMF_LOGMSG_INFO) + call ESMF_Finalize(endflag=ESMF_END_ABORT) + end if + end if + + !-------------------------------------------------------------------- + ! Intialize the list of requested output variables for netCDF output + !-------------------------------------------------------------------- + + if (user_netcdf_grdout) then + call wavinit_grdout + end if + + !-------------------------------------------------------------------- + ! Mesh initialization + !-------------------------------------------------------------------- + + if (gtype .eq. ungtype) then + unstr_mesh = .true. + else + unstr_mesh = .false. + end if + + ! Create a global index array for sea points. + ! + ! Note that nsea is the global number of sea points - and nseal is the local + ! number of sea points. For the unstr mesh, the nsea points are on mesh nodes. + ! We will use the gindex to set the element distgrid of a dual mesh. A dual mesh + ! contains the mesh nodes at the center of each element. For the domain decomposition + ! case (PDLIB), set a value of the local sea points on this processor minus the + ! ghost points. +#ifdef W3_PDLIB + nseal_cpl = nseal - ng +#else + nseal_cpl = nseal +#endif + allocate(gindex_sea(nseal_cpl)) + do jsea=1, nseal_cpl + call init_get_isea(isea, jsea) + ix = mapsf(isea,1) + iy = mapsf(isea,2) + gindex_sea(jsea) = ix + (iy-1)*nx + end do + + if (unstr_mesh) then + ! create distGrid from global index array of sea points with no ghost points + DistGrid = ESMF_DistGridCreate(arbSeqIndexList=gindex_sea, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + deallocate(gindex_sea) + else + ! create a global index array for non-sea (i.e. land points) + allocate(mask_global(nx*ny), mask_local(nx*ny)) + mask_local(:) = 0 + mask_global(:) = 0 + do jsea=1, nseal_cpl + call init_get_isea(isea, jsea) + ix = mapsf(isea,1) + iy = mapsf(isea,2) + mask_local(ix + (iy-1)*nx) = 1 + end do + call ESMF_VMAllReduce(vm, sendData=mask_local, recvData=mask_global, count=nx*ny, & + reduceflag=ESMF_REDUCE_MAX, rc=rc) + + nlnd_global = nx*ny - nsea + nlnd_local = nlnd_global / naproc + my_lnd_start = nlnd_local*iam + min(iam, mod(nlnd_global, naproc)) + 1 + if (iam < mod(nlnd_global, naproc)) then + nlnd_local = nlnd_local + 1 + end if + my_lnd_end = my_lnd_start + nlnd_local - 1 + + allocate(gindex_lnd(my_lnd_end - my_lnd_start + 1)) + ncnt = 0 + do n = 1,nx*ny + if (mask_global(n) == 0) then ! this is a land point + ncnt = ncnt + 1 + if (ncnt >= my_lnd_start .and. ncnt <= my_lnd_end) then + gindex_lnd(ncnt - my_lnd_start + 1) = n + end if + end if + end do + deallocate(mask_global) + deallocate(mask_local) + + ! create a global index that includes both sea and land - but put land at the end + nlnd = (my_lnd_end - my_lnd_start + 1) + allocate(gindex(nlnd + nseal_cpl)) + do ncnt = 1,nlnd + nseal + if (ncnt <= nseal_cpl) then + gindex(ncnt) = gindex_sea(ncnt) + else + gindex(ncnt) = gindex_lnd(ncnt-nseal_cpl) + end if + end do + deallocate(gindex_sea) + deallocate(gindex_lnd) + + ! create distGrid from global index array + DistGrid = ESMF_DistGridCreate(arbSeqIndexList=gindex, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + + ! get the mesh file name + call NUOPC_CompAttributeGet(gcomp, name='mesh_wav', value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! read in the mesh with the above DistGrid + EMesh = ESMF_MeshCreate(filename=trim(cvalue), fileformat=ESMF_FILEFORMAT_ESMFMESH, & + elementDistgrid=Distgrid,rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (dbug_flag > 5) then + call diagnose_mesh(EMesh, size(gindex), 'EMesh', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + + if (.not. unstr_mesh) then + ! obtain the mesh mask and find the minimum value across all PEs + call ESMF_MeshGet(EMesh, elementDistgrid=Distgrid, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_DistGridGet(Distgrid, localDe=0, elementCount=ncnt, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + allocate(meshmask(ncnt)) + elemMaskArray = ESMF_ArrayCreate(Distgrid, farrayPtr=meshmask, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_MeshGet(Emesh, elemMaskArray=elemMaskArray, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_VMAllFullReduce(vm, sendData=meshmask, recvData=maskmin, count=ncnt, & + reduceflag=ESMF_REDUCE_MIN, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + if (maskmin == 1) then + ! replace mesh mask with internal mask + meshmask(:) = 0 + meshmask(1:nseal_cpl) = 1 + call ESMF_MeshSet(mesh=EMesh, elementMask=meshmask, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end if + + if (dbug_flag > 5) then + call ESMF_ArrayWrite(elemMaskArray, 'meshmask.nc', variableName = 'mask', & + overwrite=.true., rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + deallocate(meshmask) + deallocate(gindex) + end if + + if (dbug_flag > 5) then + call write_meshdecomp(Emesh, 'emesh', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + + !-------------------------------------------------------------------- + ! Realize the actively coupled fields + !-------------------------------------------------------------------- + call realize_fields(gcomp, mesh=Emesh, flds_scalar_name=flds_scalar_name, & + flds_scalar_num=flds_scalar_num, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + +#ifndef W3_CESMCOUPLED + !TODO: when is this required? + if (multigrid) then + do imod = 1,nrgrd + call w3setg ( imod, mdse, mdst ) + call w3setw ( imod, mdse, mdst ) + call w3seta ( imod, mdse, mdst ) + call w3seti ( imod, mdse, mdst ) + call w3seto ( imod, mdse, mdst ) + call wmsetm ( imod, mdse, mdst ) + local = iaproc .gt. 0 .and. iaproc .le. naproc + if ( local .and. flcold .and. fliwnd ) call w3uini( va ) + 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) + + end subroutine InitializeRealize + + !=============================================================================== + !> Initialize the field values in the export state + !! + !> @details Called by NUOPC to initialize the field values in the export state and + !! the values for the scalar field which describes the wave model global domain + !! size. + !! + !! @param gcomp an ESMF_GridComp object + !! @param[out] rc return code + !! + !> @author mvertens@ucar.edu, Denise.Worthen@noaa.gov + !> @date 01-05-2022 + subroutine DataInitialize(gcomp, rc) + + use wav_import_export, only : calcRoughl + use w3gdatmd , only : nx, ny + + ! input/output variables + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + + ! local variables + type(ESMF_State) :: exportState + real(r8), pointer :: z0rlen(:) + real(r8), pointer :: sw_lamult(:) + real(r8), pointer :: sw_ustokes(:) + real(r8), pointer :: sw_vstokes(:) + real(r8), pointer :: wave_elevation_spectrum(:,:) + character(len=*),parameter :: subname = '(wav_comp_nuopc:DataInitialize)' + ! ------------------------------------------------------------------- + + !-------------------------------------------------------------------- + ! Create export state + !-------------------------------------------------------------------- + + rc = ESMF_SUCCESS + if (dbug_flag > 5) call ESMF_LogWrite(trim(subname)//' called', ESMF_LOGMSG_INFO) + + call NUOPC_ModelGet(gcomp, exportState=exportState, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + if (state_fldchk(exportState, 'Sw_lamult')) then + call state_getfldptr(exportState, 'Sw_lamult', sw_lamult, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + sw_lamult (:) = 1. + endif + if (state_fldchk(exportState, 'Sw_ustokes')) then + call state_getfldptr(exportState, 'Sw_ustokes', sw_ustokes, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + sw_ustokes(:) = 0. + endif + if (state_fldchk(exportState, 'Sw_vstokes')) then + call state_getfldptr(exportState, 'Sw_vstokes', sw_vstokes, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + sw_vstokes(:) = 0. + endif + if (state_fldchk(exportState, 'Sw_z0')) then + call state_getfldptr(exportState, 'Sw_z0', z0rlen, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call CalcRoughl(z0rlen) + endif + if (wav_coupling_to_cice) then + call state_getfldptr(exportState, 'wave_elevation_spectrum', wave_elevation_spectrum, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + wave_elevation_spectrum(:,:) = 0. + endif + + if (.not. unstr_mesh) then + ! Set global grid size scalars in export state + call State_SetScalar(dble(nx), flds_scalar_index_nx, exportState, flds_scalar_name, flds_scalar_num, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call State_SetScalar(dble(ny), flds_scalar_index_ny, exportState, flds_scalar_name, flds_scalar_num, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + + if ( dbug_flag > 5) then + call state_diagnose(exportState, 'at DataInitialize ', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + + if (dbug_flag > 5) call ESMF_LogWrite(trim(subname)//' done', ESMF_LOGMSG_INFO) + + end subroutine DataInitialize + + !===================================================================== + !> Called by NUOPC to advance the model a single timestep + !! + !> @details At each model advance, the call to import_fields fills the + !! import state with the updated values. If a history alarm is present + !! and ringing, a logical to write a wave history file is set true. The + !! wave model itself is then advanced during which a history file will + !! be written via a call to w3iogonc in place of w3iogo. The export + !! fields at the current model Advance are filled in export_fields + !! + !! @param gcomp an ESMF_GridComp object + !! @param[out] rc return code + !! + !> @author mvertens@ucar.edu, Denise.Worthen@noaa.gov + !> @date 01-05-2022 + subroutine ModelAdvance(gcomp, rc) + + !------------------------ + ! Run WW3 + !------------------------ + + use w3wavemd , only : w3wave + use w3wdatmd , only : time, w3setw + use wav_import_export , only : import_fields, export_fields + use wav_shel_inp , only : odat + use w3odatmd , only : rstwr, histwr + + ! arguments: + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + + ! local variables + type(ESMF_State) :: importState + type(ESMF_State) :: exportState + type(ESMF_Clock) :: clock + type(ESMF_Alarm) :: alarm + type(ESMF_TimeInterval) :: timeStep, elapsedTime + type(ESMF_Time) :: currTime, nextTime, startTime, stopTime + integer :: yy,mm,dd,hh,ss + integer :: imod + integer :: shrlogunit ! original log unit and level + character(ESMF_MAXSTR) :: msgString + character(len=*),parameter :: subname = '(wav_comp_nuopc:ModelAdvance) ' + !------------------------------------------------------- + + rc = ESMF_SUCCESS + if (dbug_flag > 5) call ESMF_LogWrite(trim(subname)//' called', ESMF_LOGMSG_INFO) + + !------------ + ! query the Component for its importState, exportState and clock + !------------ + call ESMF_GridCompGet(gcomp, importState=importState, exportState=exportState, clock=clock, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_ClockPrint(clock, options="currTime", preString="------>Advancing WAV from: ", & + unit=msgString, rc=rc) + call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) + call ESMF_ClockGet(clock, startTime=startTime, currTime=currTime, timeStep=timeStep, rc=rc) + call ESMF_TimePrint(currTime + timeStep, preString="--------------------------------> to: ", & + unit=msgString, rc=rc) + call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) + + !------------ + ! Determine time info + !------------ + call ESMF_ClockGet( clock, currTime=currTime, rc=rc ) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_TimeGet( currTime, yy=yy, mm=mm, dd=dd, s=tod, rc=rc ) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call ymd2date(yy, mm, dd, ymd) + hh = tod/3600 + mm = (tod - (hh * 3600))/60 + ss = tod - (hh*3600) - (mm*60) + time0(1) = ymd + time0(2) = hh*10000 + mm*100 + ss + 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 + call ESMF_ClockGetNextTime(clock, nextTime=nextTime, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_TimeGet( nextTime, yy=yy, mm=mm, dd=dd, s=tod, rc=rc ) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + elapsedTime = nextTime - startTime + call ESMF_TimeIntervalGet(elapsedTime, s_i8=elapsed_secs,rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call ymd2date(yy, mm, dd, ymd) + hh = tod/3600 + mm = (tod - (hh * 3600))/60 + ss = tod - (hh*3600) - (mm*60) + + timen(1) = ymd + timen(2) = hh*10000 + mm*100 + ss + + time = time0 +#ifndef W3_CESMCOUPLED + if (multigrid) then + do imod = 1,nrgrd + tend(1,imod) = timen(1) + tend(2,imod) = timen(2) + end do + end if +#endif + + !------------ + ! Obtain import data from import state + !------------ + call import_fields(gcomp, time0, timen, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + !------------ + ! Run the wave model for the given interval + !------------ + if(profile_memory) call ESMF_VMLogMemInfo("Entering WW3 Run : ") + + if (user_restalarm) then + ! Determine if time to write ww3 restart files + call ESMF_ClockGetAlarm(clock, alarmname='alarm_restart', alarm=alarm, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (ESMF_AlarmIsRinging(alarm, rc=rc)) then + if (ChkErr(rc,__LINE__,u_FILE_u)) return + rstwr = .true. + call ESMF_AlarmRingerOff( alarm, rc=rc ) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + rstwr = .false. + endif + else + rstwr = .false. + end if + + if (user_histalarm) then + ! Determine if time to write ww3 history files + call ESMF_ClockGetAlarm(clock, alarmname='alarm_history', alarm=alarm, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (ESMF_AlarmIsRinging(alarm, rc=rc)) then + if (ChkErr(rc,__LINE__,u_FILE_u)) return + histwr = .true. + call ESMF_AlarmRingerOff( alarm, rc=rc ) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + histwr = .false. + endif + else + histwr = .false. + end if + if ( root_task ) then + ! write(nds(1),*) 'wav_comp_nuopc time', time, timen + ! write(nds(1),*) 'ww3 hist flag ', histwr, hh + end if + + ! Advance the wave model +#ifndef W3_CESMCOUPLED + if (multigrid) then + call wmwave ( tend ) + else + call w3wave ( 1, odat, timen ) + end if +#else + call w3wave ( 1, odat, timen ) +#endif + if(profile_memory) call ESMF_VMLogMemInfo("Exiting WW3 Run : ") + + !------------ + ! Create export state + !------------ + + call export_fields(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 + + !=============================================================================== + !> Called by NUOPC to manage the model clock + !! + !! @param[in] gcomp an ESMF_GridComp object + !! @param[out] rc return code + !! + !> @author mvertens@ucar.edu, Denise.Worthen@noaa.gov + !> @date 01-05-2022 + subroutine ModelSetRunClock(gcomp, rc) + + ! input/output variables + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + + ! local variables + type(ESMF_Clock) :: mclock, dclock + type(ESMF_Time) :: mcurrtime, dcurrtime + type(ESMF_Time) :: mstoptime + type(ESMF_Time) :: mstarttime + type(ESMF_TimeInterval) :: mtimestep, dtimestep + logical :: isPresent + logical :: isSet + 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 + character(len=256) :: stop_option ! Stop option units + integer :: stop_n ! Number until stop interval + integer :: stop_ymd ! Stop date (YYYYMMDD) + type(ESMF_ALARM) :: stop_alarm + character(len=256) :: history_option ! History option units + integer :: history_n ! Number until history interval + integer :: history_ymd ! History date (YYYYMMDD) + type(ESMF_ALARM) :: history_alarm + character(len=128) :: name + integer :: alarmcount + character(len=*),parameter :: subname=trim(modName)//':(ModelSetRunClock) ' + + !------------------------------------------------------------------------------- + + rc = ESMF_SUCCESS + call ESMF_LogWrite(trim(subname)//' called', ESMF_LOGMSG_INFO) + + ! query the Component for its clocks + call NUOPC_ModelGet(gcomp, driverClock=dclock, modelClock=mclock, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_ClockGet(dclock, currTime=dcurrtime, timeStep=dtimestep, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_ClockGet(mclock, currTime=mcurrtime, timeStep=mtimestep, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + !-------------------------------- + ! force model clock currtime and timestep to match driver and set stoptime + !-------------------------------- + + mstoptime = mcurrtime + dtimestep + call ESMF_ClockSet(mclock, currTime=dcurrtime, timeStep=dtimestep, stopTime=mstoptime, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + !-------------------------------- + ! set restart, stop and history alarms + !-------------------------------- + + call ESMF_ClockGetAlarmList(mclock, alarmlistflag=ESMF_ALARMLIST_ALL, alarmCount=alarmCount, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + if (alarmCount == 0) then + + call ESMF_ClockGet(mclock, startTime=mStartTime, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_GridCompGet(gcomp, name=name, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_LogWrite(trim(subname)//'setting alarms for ' // trim(name), ESMF_LOGMSG_INFO) + + !---------------- + ! Restart alarm + !---------------- + call NUOPC_CompAttributeGet(gcomp, name="restart_option", isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + call NUOPC_CompAttributeGet(gcomp, name="restart_option", value=restart_option, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call NUOPC_CompAttributeGet(gcomp, name="restart_n", value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) restart_n + + call NUOPC_CompAttributeGet(gcomp, name="restart_ymd", value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) restart_ymd + + call alarmInit(mclock, restart_alarm, restart_option, & + opt_n = restart_n, & + opt_ymd = restart_ymd, & + RefTime = mCurrTime, & + alarmname = 'alarm_restart', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_AlarmSet(restart_alarm, clock=mclock, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + user_restalarm = .true. + else + ! If attribute is not present - write restarts at native WW3 freq + restart_option = 'none' + restart_n = -999 + user_restalarm = .false. + end if + + !---------------- + ! Stop alarm + !---------------- + call NUOPC_CompAttributeGet(gcomp, name="stop_option", value=stop_option, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call NUOPC_CompAttributeGet(gcomp, name="stop_n", value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) stop_n + + call NUOPC_CompAttributeGet(gcomp, name="stop_ymd", value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) stop_ymd + + call alarmInit(mclock, stop_alarm, stop_option, & + opt_n = stop_n, & + opt_ymd = stop_ymd, & + RefTime = mCurrTime, & + alarmname = 'alarm_stop', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_AlarmSet(stop_alarm, clock=mclock, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + !---------------- + ! History alarm + !---------------- + call NUOPC_CompAttributeGet(gcomp, name="history_option", isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + call NUOPC_CompAttributeGet(gcomp, name='history_option', value=history_option, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call NUOPC_CompAttributeGet(gcomp, name="history_n", value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) history_n + + call NUOPC_CompAttributeGet(gcomp, name="history_ymd", value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) history_ymd + + call alarmInit(mclock, history_alarm, history_option, & + opt_n = history_n, & + opt_ymd = history_ymd, & + RefTime = mStartTime, & + alarmname = 'alarm_history', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_AlarmSet(history_alarm, clock=mclock, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + user_histalarm = .true. + else + ! If attribute is not present - write history output at native WW3 frequency + history_option = 'none' + history_n = -999 + user_histalarm = .false. + end if + + end if + + !-------------------------------- + ! Advance model clock to trigger alarms then reset model clock back to currtime + !-------------------------------- + + call ESMF_ClockAdvance(mclock,rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_ClockSet(mclock, currTime=dcurrtime, timeStep=dtimestep, stopTime=mstoptime, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_LogWrite(trim(subname)//' done', ESMF_LOGMSG_INFO) + + end subroutine ModelSetRunClock + + !=============================================================================== + !> Called by NUOPC at the end of the run to clean up. + !! + !! @param[in] gcomp an ESMF_GridComp object + !! @param[out] rc return code + !! + !> @author mvertens@ucar.edu, Denise.Worthen@noaa.gov + !> @date 01-05-2022 + subroutine ModelFinalize(gcomp, rc) + + ! input/output variables + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + + ! local variables + character(*), parameter :: F00 = "('(ww3_comp_nuopc) ',8a)" + character(*), parameter :: F91 = "('(ww3_comp_nuopc) ',73('-'))" + character(len=*),parameter :: subname=trim(modName)//':(ModelFinalize) ' + !------------------------------------------------------------------------------- + + rc = ESMF_SUCCESS + call ESMF_LogWrite(trim(subname)//' called', ESMF_LOGMSG_INFO) + + if ( root_task ) then + write(nds(1),F91) + write(nds(1),F00) 'WW3: end of main integration loop' + write(nds(1),F91) + 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 + + !=============================================================================== + !> Initialize the wave model for the CESM use case + !! + !> @details Calls public routine read_shel_config to read the ww3_shel.inp or + !! ww3_shel.nml file. Calls w3init to initialize the wave model + !! + !! @param[in] gcomp an ESMF_GridComp object + !! @param[in] ntrace unit numbers for trace + !! @param[in] mpi_comm an mpi communicator + !! @param[in] mds unit numbers + !! @param[out] rc return code + !! + !> @author mvertens@ucar.edu, Denise.Worthen@noaa.gov + !> @date 01-05-2022 + subroutine waveinit_cesm(gcomp, ntrace, mpi_comm, mds, rc) + + ! Initialize ww3 for cesm (called from InitializeRealize) + + use w3initmd , only : w3init + use w3gdatmd , only : dtcfl, dtcfli, dtmax, dtmin + use w3idatmd , only : inflags1, inflags2 + use w3odatmd , only : initfile + use wav_shr_mod , only : casename + use wav_shr_mod , only : inst_index, inst_name, inst_suffix + use wav_shr_mod , only : wav_coupling_to_cice + use wav_shel_inp , only : read_shel_config + use wav_shel_inp , only : npts, odat, iprt, x, y, pnames, prtfrm + use wav_shel_inp , only : flgrd, flgd, flgr2, flg2 + + ! input/output variables + type(ESMF_GridComp) :: gcomp + integer , intent(in) :: ntrace(:) + integer , intent(in) :: mpi_comm + integer , intent(in) :: mds(:) + integer , intent(out) :: rc + + ! local variables + integer :: ierr + integer :: unitn ! namelist unit number + integer :: shrlogunit + logical :: isPresent, isSet + real(r8) :: dtmax_in ! Maximum overall time step. + real(r8) :: dtmin_in ! Minimum dynamic time step for source + real(r8) :: dtcfl_in ! Maximum CFL time step X-Y propagation. + real(r8) :: dtcfli_in ! Maximum CFL time step X-Y propagation intra-spectral + integer :: stdout + character(len=*), parameter :: subname = '(wav_comp_nuopc:wavinit_cesm)' + ! ------------------------------------------------------------------- + + namelist /ww3_inparm/ initfile, dtcfl, dtcfli, dtmax, dtmin + + rc = ESMF_SUCCESS + if (dbug_flag > 5) call ESMF_LogWrite(trim(subname)//' called', ESMF_LOGMSG_INFO) + + inst_name = "WAV"//trim(inst_suffix) + ! Read namelist (set initfile in w3odatmd) + if ( root_task ) then + open (newunit=unitn, file='wav_in'//trim(inst_suffix), status='old') + read (unitn, ww3_inparm, iostat=ierr) + if (ierr /= 0) then + call ESMF_LogWrite(trim(subname)//' problem reading ww3_inparm namelist',& + ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) + rc = ESMF_FAILURE + return + end if + close (unitn) + + ! Write out input + stdout = mds(1) + write(stdout,*) + write(stdout,'(a)')' --------------------------------------------------' + write(stdout,'(a)')' Initializations : ' + write(stdout,'(a)')' --------------------------------------------------' + write(stdout,'(a)')' Case Name is '//trim(casename) + write(stdout,'(a)') trim(subname)//' inst_name = '//trim(inst_name) + write(stdout,'(a)') trim(subname)//' inst_suffix = '//trim(inst_suffix) + write(stdout,'(a,i4)') trim(subname)//' inst_index = ',inst_index + write(stdout,'(a)')' Read in ww3_inparm namelist from wav_in'//trim(inst_suffix) + write(stdout,'(a)')' initfile = '//trim(initfile) + write(stdout,'(a, 2x, f10.3)')' dtcfl = ',dtcfl + write(stdout,'(a, 2x, f10.3)')' dtcfli = ',dtcfli + write(stdout,'(a, 2x, f10.3)')' dtmax = ',dtmax + write(stdout,'(a, 2x, f10.3)')' dtmin = ',dtmin + write(stdout,*) + end if + + ! ESMF does not have a broadcast for chars + call mpi_bcast(initfile, len(initfile), MPI_CHARACTER, 0, mpi_comm, ierr) + if (ierr /= MPI_SUCCESS) then + call ESMF_LogWrite(trim(subname)//' error in mpi broadcast for initfile ', & + ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) + rc = ESMF_FAILURE + return + end if + call mpi_bcast(dtcfl, 1, MPI_INTEGER, 0, mpi_comm, ierr) + if (ierr /= MPI_SUCCESS) then + call ESMF_LogWrite(trim(subname)//' error in mpi broadcast for dtcfl ',& + ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) + rc = ESMF_FAILURE + return + end if + call mpi_bcast(dtcfli, 1, MPI_INTEGER, 0, mpi_comm, ierr) + if (ierr /= MPI_SUCCESS) then + call ESMF_LogWrite(trim(subname)//' error in mpi broadcast for dtcfli ',& + ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) + rc = ESMF_FAILURE + return + end if + call mpi_bcast(dtmax, 1, MPI_INTEGER, 0, mpi_comm, ierr) + if (ierr /= MPI_SUCCESS) then + call ESMF_LogWrite(trim(subname)//' error in mpi broadcast for dtmax ',& + ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) + rc = ESMF_FAILURE + return + end if + call mpi_bcast(dtmin, 1, MPI_INTEGER, 0, mpi_comm, ierr) + if (ierr /= MPI_SUCCESS) then + call ESMF_LogWrite(trim(subname)//' error in mpi broadcast for dtmax ',& + ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) + rc = ESMF_FAILURE + return + end if + dtmax_in = dtmax + dtcfl_in = dtcfl + dtcfli_in = dtcfli + dtmin_in = dtmin + + ! Read the namelist settings in ww3_shel.nml + call ESMF_LogWrite(trim(subname)//' call read_shel_config', ESMF_LOGMSG_INFO) + call read_shel_config(mpi_comm, mds, time0_overwrite=time0, timen_overwrite=timen) + + ! NOTE: that wavice_coupling must be set BEFORE the call to advertise_fields + ! So the current mechanism is to force the inflags1(-7) and inflags1(-3) be set to true + ! if wavice coupling is active + ! NOTE: + ! inflags1(-7) = nml_input%forcing%ice_param1 + ! inflags1(-3) = nml_input%forcing%ice_param5 + + ! Force inflags2 to be false - otherwise inflags2 will be set to inflags1 and answers will change + ! Need to set this to .false. to avoid scaling of ice in section 4. of w3srcemed. + ! inflags2(4) is true if ice concentration was ever read during this simulation + ! Currently IC4 is used in cesm + inflags2(:) = .false. + if (wav_coupling_to_cice) then + inflags2(4) = .true. ! inflags2(4) is true if ice concentration was read during initialization + inflags1(-7) = .true. ! ice thickness + inflags2(-7) = .true. ! ice thickness + inflags1(-3) = .true. ! ice floe size + inflags2(-3) = .true. ! ice floe size + else + inflags1(-7) = .false. ! ice thickness + inflags2(-7) = .false. ! ice thickness + inflags1(-3) = .false. ! ice floe size + inflags2(-3) = .false. ! ice floe size + end if + + ! custom restart and history file names are used for CESM + use_user_histname = .true. + use_user_restname = .true. + + ! if runtype=initial, the initfile will be read in w3iorsmd + if (len_trim(inst_suffix) > 0) then + user_restfname = trim(casename)//'.ww3'//trim(inst_suffix)//'.r.' + user_histfname = trim(casename)//'.ww3'//trim(inst_suffix)//'.hi.' + else + user_restfname = trim(casename)//'.ww3.r.' + user_histfname = trim(casename)//'.ww3.hi.' + endif + + ! netcdf gridded output is used for CESM + user_netcdf_grdout = .true. + ! restart and history alarms are set for CESM by default through config + + ! Read in initial/restart data and initialize the model + ! ww3 read initialization occurs in w3iors (which is called by initmd in module w3initmd) + ! ww3 always starts up from a 'restart' file type + ! For a startup (including hybrid) or branch run the restart file is obtained from 'initfile' + ! For a continue run, the restart filename upon read is created from the time(1:2) array + ! flgr2 is flags for coupling output, not ready yet so keep .false. + ! 1 is model number + ! IsMulti does not appear to be used, setting to .false. + + call ESMF_LogWrite(trim(subname)//' call w3init', ESMF_LOGMSG_INFO) + call w3init ( 1, .false., 'ww3', mds, ntrace, odat, flgrd, flgr2, flgd, flg2, & + npts, x, y, pnames, iprt, prtfrm, mpi_comm ) + + ! NOTE: these need to be set again AFTER w3init is run - since these values will be overwritten + ! by the read of mod_def.ww3 + dtmax = dtmax_in + dtcfl = dtcfl_in + dtcfli = dtcfli_in + dtmin = dtmin_in + + if (dbug_flag > 5) call ESMF_LogWrite(trim(subname)//' done', ESMF_LOGMSG_INFO) + end subroutine waveinit_cesm + + !=============================================================================== + !> Initialize the wave model for the UWM use case + !! + !> @details Calls public routine read_shel_config to read the ww3_shel.inp or + !! ww3_shel.nml file. Calls w3init to initialize the wave model + !! + !! @param[in] gcomp an ESMF_GridComp object + !! @param[in] ntrace unit numbers for trace + !! @param[in] mpi_comm an mpi communicator + !! @param[in] mds unit numbers + !! @param[out] rc return code + !! + !> @author mvertens@ucar.edu, Denise.Worthen@noaa.gov + !> @date 01-05-2022 + 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 + use wav_shel_inp , only : flgrd, flgd, flgr2, flg2 + + ! input/output variables + type(ESMF_GridComp) :: gcomp + integer, intent(in) :: ntrace(:) + integer, intent(in) :: mpi_comm + integer, intent(in) :: mds(:) + integer, intent(out) :: rc + + ! local variables + character(len=CL) :: logmsg + logical :: isPresent, isSet + character(len=CL) :: cvalue + integer :: dt_in(4) + character(len=*), parameter :: subname = '(wav_comp_nuopc:wavinit_ufs)' + ! ------------------------------------------------------------------- + + rc = ESMF_SUCCESS + if (dbug_flag > 5) call ESMF_LogWrite(trim(subname)//' called', ESMF_LOGMSG_INFO) + + ! restart and history alarms are optional for UFS and used via allcomp config settings + call NUOPC_CompAttributeGet(gcomp, name='user_sets_histname', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + use_user_histname=(trim(cvalue)=="true") + end if + write(logmsg,'(A,l)') trim(subname)//': Custom history names in use ',use_user_histname + call ESMF_LogWrite(trim(logmsg), ESMF_LOGMSG_INFO) + + call NUOPC_CompAttributeGet(gcomp, name='user_sets_restname', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + use_user_restname=(trim(cvalue)=="true") + end if + write(logmsg,'(A,l)') trim(subname)//': Custom restart names in use ',use_user_restname + call ESMF_LogWrite(trim(logmsg), ESMF_LOGMSG_INFO) + + call NUOPC_CompAttributeGet(gcomp, name='gridded_netcdfout', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + user_netcdf_grdout=(trim(cvalue)=="true") + end if + write(logmsg,'(A,l)') trim(subname)//': Gridded netcdf output is requested ',user_netcdf_grdout + call ESMF_LogWrite(trim(logmsg), ESMF_LOGMSG_INFO) + + if (use_user_histname) then + user_histfname = trim(casename)//'.ww3.hi.' + end if + if (use_user_restname) then + user_restfname = trim(casename)//'.ww3.r.' + end if + + fnmpre = './' + + call ESMF_LogWrite(trim(subname)//' call read_shel_config', ESMF_LOGMSG_INFO) + call read_shel_config(mpi_comm, mds, time0_overwrite=time0, timen_overwrite=timen) + + call ESMF_LogWrite(trim(subname)//' call w3init', ESMF_LOGMSG_INFO) + 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 + +end module wav_comp_nuopc 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