From 7441c25280faad608c846a60bfd78c1475043af5 Mon Sep 17 00:00:00 2001 From: Denise Worthen Date: Fri, 19 Jan 2024 13:25:20 -0500 Subject: [PATCH 1/4] 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 From 3840eaeafb755d6c2d01074282dc43b8d78ce108 Mon Sep 17 00:00:00 2001 From: Matthew Masarik Date: Wed, 7 Feb 2024 22:31:34 +0000 Subject: [PATCH 2/4] src_list.cmake: remove cap-related source files --- model/src/cmake/src_list.cmake | 15 --------------- 1 file changed, 15 deletions(-) diff --git a/model/src/cmake/src_list.cmake b/model/src/cmake/src_list.cmake index dcab88a09..84cf022ef 100644 --- a/model/src/cmake/src_list.cmake +++ b/model/src/cmake/src_list.cmake @@ -55,23 +55,8 @@ 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 set(pdlib_src From 44cdd354e7c505d2129fc06914eba896ca55987b Mon Sep 17 00:00:00 2001 From: Matthew Masarik Date: Thu, 8 Feb 2024 18:35:40 +0000 Subject: [PATCH 3/4] src_list.cmake: remove 1-line accidental add whitespace --- model/src/cmake/src_list.cmake | 1 - 1 file changed, 1 deletion(-) diff --git a/model/src/cmake/src_list.cmake b/model/src/cmake/src_list.cmake index 84cf022ef..d745be388 100644 --- a/model/src/cmake/src_list.cmake +++ b/model/src/cmake/src_list.cmake @@ -57,7 +57,6 @@ set(ftn_src w3tidemd.F90 ) - # Built when PDLIB is enabled set(pdlib_src ${CMAKE_CURRENT_SOURCE_DIR}/pdlib_field_vec.F90 From 199eb4124d8d9341946b1a39290ba44266eecb86 Mon Sep 17 00:00:00 2001 From: Matthew Masarik Date: Thu, 8 Feb 2024 18:50:53 +0000 Subject: [PATCH 4/4] remove added wav* cap files (wav_comp_nuopc.F90,wav_wrapper_mod.F90) not needed for fix at hand --- model/src/wav_comp_nuopc.F90 | 1680 --------------------------------- model/src/wav_wrapper_mod.F90 | 119 --- 2 files changed, 1799 deletions(-) delete mode 100644 model/src/wav_comp_nuopc.F90 delete mode 100644 model/src/wav_wrapper_mod.F90 diff --git a/model/src/wav_comp_nuopc.F90 b/model/src/wav_comp_nuopc.F90 deleted file mode 100644 index 6f3eeef5a..000000000 --- a/model/src/wav_comp_nuopc.F90 +++ /dev/null @@ -1,1680 +0,0 @@ -!> @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 deleted file mode 100644 index dd2465829..000000000 --- a/model/src/wav_wrapper_mod.F90 +++ /dev/null @@ -1,119 +0,0 @@ -!> @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