diff --git a/model/src/CMakeLists.txt b/model/src/CMakeLists.txt index b4df91991..b929cb4f6 100644 --- a/model/src/CMakeLists.txt +++ b/model/src/CMakeLists.txt @@ -126,6 +126,7 @@ set(SRCFILES constants.F90 w3wdatmd.F90 wav_comp_nuopc.F90 wav_import_export.F90 + wav_grdout.F90 wav_kind_mod.F90 wav_shel_inp.F90 wav_shr_mod.F90) diff --git a/model/src/wav_comp_nuopc.F90 b/model/src/wav_comp_nuopc.F90 index 151ba56bc..fca322c2a 100644 --- a/model/src/wav_comp_nuopc.F90 +++ b/model/src/wav_comp_nuopc.F90 @@ -1,123 +1,30 @@ +!> @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 - !/ ------------------------------------------------------------------- / - !/ - !/ +-----------------------------------+ - !/ | WAVEWATCH III NOAA/NCEP | - !/ | H. L. Tolman | - !/ | FORTRAN 90 | - !/ | Last update : 29-May-2009 | - !/ +-----------------------------------+ - !/ - !/ Copyright 2009 National Weather Service (NWS), - !/ National Oceanic and Atmospheric Administration. All rights - !/ reserved. WAVEWATCH III is a trademark of the NWS. - !/ No unauthorized use without permission. - !/ - ! 1. Purpose : - ! - ! A generic nuopc interface for WAVEWATCH III - ! using input fields from CMEPS. - ! - ! 2. Method : - ! - ! NUOPC component for the actual wave model (W3WAVE). - ! - ! 3. Parameters : - ! - ! Local parameters. - ! ---------------------------------------------------------------- - ! TIME0 I.A. Starting time. - ! TIMEN I.A. Ending time. - ! ---------------------------------------------------------------- - ! NDS, NTRACE, ..., see W3WAVE - ! - ! 4. Subroutines used : - ! - ! Name Type Module Description - ! ---------------------------------------------------------------- - ! W3NMOD Subr. W3GDATMD Set nummber of data structures - ! W3SETG Subr. Id. Point to data structure. - ! W3NDAT Subr. W3WDATMD Set nummber of data structures - ! W3SETW Subr. Id. Point to data structure. - ! W3NMOD Subr. W3ADATMD Set nummber of data structures - ! W3NAUX Subr. Id. Point to data structure. - ! W3NOUT Subr. W3ODATMD Set nummber of data structures - ! W3SETO Subr. Id. Point to data structure. - ! W3NINP Subr. W3IDATMD Set nummber of data structures - ! W3SETI Subr. Id. Point to data structure. - ! STME21 Subr. W3TIMEMD Print date and time readable. - ! W3INIT Subr. W3INITMD Wave model initialization. - ! W3WAVE Subr. W3WAVEMD Wave model. - ! ---------------------------------------------------------------- - ! - ! 5. Called by : - ! - ! NUOPC run sequence - ! - ! 6. Error messages : - ! - ! - Checks on I-O. - ! - Check on time interval. - ! - ! 7. Remarks : - ! - ! - A rigourous input check is made in W3INIT. - ! - ! 8. Structure : - ! - ! ---------------------------------------------------------------- - ! - ! wav_comp_init - ! - ! 0. Set up data structures. ( W3NMOD, etc. ) - ! 1. I-O setup. - ! a For shell. - ! b For WAVEWATCH III. - ! c Local parameters. - ! 2. Define input fields - ! 3. Set time frame. - ! 4. Define output - ! a Loop over types, do - ! +--------------------------------------------------------+ - ! | b Process standard line | - ! | c If type 1: fields of mean wave parameters | - ! | d If type 2: point output | - ! | e If type 3: track output | - ! | f If type 4: restart files | - ! | g If type 5: boundary output | - ! | h If type 6: separated wave fields | - ! +--------------------------------------------------------+ - ! 5. Initialzations - ! - ! wav_comp_run - ! - ! 7. Run model for one time step with input from cmeps - ! Return output to cmeps - ! Do until end time is reached - ! +--------------------------------------------------------+ - ! | a Determine next time interval and input fields. | - ! | 1 Preparation | - ! | Loop over input fields | - ! | +------------------------------------------------------| - ! | | 2 Check if update is needed | - ! | | 4 Update next ending time | - ! | +------------------------------------------------------| - ! | b Run wave model. ( W3WAVE ) | - ! | d Final output if needed. ( W3WAVE ) | - ! | e Check time | - ! +--------------------------------------------------------+ - ! - ! wav_comp_fin - ! - ! ---------------------------------------------------------------- - ! - ! 9. Switches : - ! - ! 10. Source code : - ! - !/ ------------------------------------------------------------------- / - use ESMF use NUOPC , only : NUOPC_CompDerive, NUOPC_CompSetEntryPoint, NUOPC_CompSpecialize use NUOPC , only : NUOPC_CompFilterPhaseMap, NUOPC_IsUpdated, NUOPC_IsAtTime @@ -134,7 +41,7 @@ module wav_comp_nuopc use wav_import_export , only : advertise_fields, realize_fields 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 : runtype, merge_import, dbug_flag + use wav_shr_mod , only : wav_coupling_to_cice, runtype, merge_import, dbug_flag use w3odatmd , only : nds, iaproc, napout use wav_shr_mod , only : casename, multigrid, inst_suffix, inst_index use wav_shr_mod , only : time_origin, calendar_name, elapsed_secs @@ -151,7 +58,8 @@ module wav_comp_nuopc implicit none private ! except - public :: SetServices, SetVM + public :: SetServices + public :: SetVM private :: InitializeP0 private :: InitializeAdvertise private :: InitializeRealize @@ -165,30 +73,39 @@ module wav_comp_nuopc ! Private module data !-------------------------------------------------------------------------- - character(len=CL) :: flds_scalar_name = '' - integer :: flds_scalar_num = 0 - integer :: flds_scalar_index_nx = 0 - integer :: flds_scalar_index_ny = 0 - logical :: profile_memory = .false. + 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 :: histwr_is_active = .false. ! native WW3 grd output - logical :: root_task = .false. + logical :: histwr_is_active = .false. !< default logical to control use of ESMF + !! alarms for writing history files + logical :: root_task = .false. !< logical to indicate root task #ifdef CESMCOUPLED - logical :: cesmcoupled = .true. + logical :: cesmcoupled = .true. !< logical to indicate CESM use case #else - logical :: cesmcoupled = .false. - integer, allocatable :: tend(:,:) + logical :: cesmcoupled = .false. !< logical to indicate non-CESM use case + integer, allocatable :: tend(:,:) !< the ending time of ModelAdvance when + !! run with multigrid=true #endif - integer , parameter :: debug = 1 - character(*), parameter :: modName = "(wav_comp_nuopc)" - character(*), parameter :: u_FILE_u = & + 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 @@ -241,7 +158,19 @@ subroutine SetServices(gcomp, rc) 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 @@ -259,7 +188,29 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) 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) ! input/output arguments @@ -379,6 +330,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) 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 @@ -386,6 +338,14 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) 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='wavice_coupling', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) wav_coupling_to_cice=(trim(cvalue)==".true.") + 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) + call advertise_fields(importState, exportState, flds_scalar_name, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -394,7 +354,28 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) 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 @@ -408,6 +389,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) use wmunitmd , only : wmuget, wmuset #endif use wav_shel_inp , only : set_shel_io + use wav_grdout , only : wavinit_grdout ! input/output variables type(ESMF_GridComp) :: gcomp @@ -671,6 +653,12 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return #endif + !-------------------------------------------------------------------- + ! Intialize the list of requested output variables + !-------------------------------------------------------------------- + + call wavinit_grdout + ! call mpi_barrier ( mpi_comm, ierr ) !-------------------------------------------------------------------- @@ -811,7 +799,17 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) 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 @@ -861,21 +859,21 @@ subroutine DataInitialize(gcomp, rc) sw_vstokes(:) = 0. endif if (state_fldchk(exportState, 'Sw_z0')) then - call state_getfldptr(exportState, 'Sw_z0', fldptr1d=z0rlen, rc=rc) + 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, 'wav_tauice1', wav_tauice1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getfldptr(exportState, 'wav_tauice2', wav_tauice2, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getfldptr(exportState, 'wave_elevation_spectrum', fldptr2d=wave_elevation_spectrum, rc=rc) + !call state_getfldptr(exportState, 'wav_tauice1', wav_tauice1, rc=rc) + !if (ChkErr(rc,__LINE__,u_FILE_u)) return + !call state_getfldptr(exportState, 'wav_tauice2', wav_tauice2, rc=rc) + !if (ChkErr(rc,__LINE__,u_FILE_u)) return + call state_getfldptr(exportState, 'wave_elevation_spectrum', wave_elevation_spectrum, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - wav_tauice1(:) = 0. - wav_tauice2(:) = 0. + !wav_tauice1(:) = 0. + !wav_tauice2(:) = 0. wave_elevation_spectrum(:,:) = 0. endif @@ -895,7 +893,20 @@ subroutine DataInitialize(gcomp, rc) 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) !------------------------ @@ -1076,7 +1087,13 @@ subroutine ModelAdvance(gcomp, rc) 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 @@ -1195,9 +1212,9 @@ subroutine ModelSetRunClock(gcomp, rc) call ESMF_AlarmSet(stop_alarm, clock=mclock, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - !---------------- - ! History alarm - !---------------- + !---------------- + ! 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 @@ -1245,7 +1262,13 @@ subroutine ModelSetRunClock(gcomp, rc) 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 @@ -1272,7 +1295,17 @@ subroutine ModelFinalize(gcomp, rc) end subroutine ModelFinalize !=============================================================================== - +!> Initialize the wave model for the CESM use case +!! +!! @param[in] gcomp an ESMF_GridComp object +!! @param[in] ntrace unit numbers for trace +!! @param[in] mpi_comm an mpi communicator +!! @param[in] dtime_sync the coupling interval +!! @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, dtime_sync, mds, rc) ! Initialize ww3 for cesm (called from InitializeRealize) @@ -1419,7 +1452,19 @@ subroutine waveinit_cesm(gcomp, ntrace, mpi_comm, dtime_sync, mds, rc) end subroutine waveinit_cesm !=============================================================================== - +!> Initialize the wave model for the UWM use case +!! +!> @details Calls public routine read_shel_inp to read the ww3_shel.inp 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) diff --git a/model/src/wav_grdout.F90 b/model/src/wav_grdout.F90 new file mode 100644 index 000000000..4919124ae --- /dev/null +++ b/model/src/wav_grdout.F90 @@ -0,0 +1,273 @@ +module wav_grdout + + use w3odatmd , only: nogrp, ngrpp + + implicit none + + integer, parameter :: maxvars = 24 ! maximum number of variables/group + + private ! except + + public :: varatts + public :: outvars + public :: wavinit_grdout + + ! tag read from inp file and is used to set flogrd flags + ! var_name is the name of the variable + type :: varatts + character(len= 5) :: tag + character(len=10) :: var_name + character(len=48) :: long_name + character(len=10) :: unit_name + character(len= 2) :: dims + logical :: validout + end type + + type(varatts), dimension(nogrp,maxvars) :: gridoutdefs + + type(varatts), dimension(:), allocatable :: outvars + +!=============================================================================== +contains +!=============================================================================== + + !==================================================================================== + subroutine wavinit_grdout + + use w3odatmd , only: nds, iaproc, napout + use w3iogomd , only: fldout + use w3servmd , only: strsplit + + ! local variables + character(len=100) :: inptags(100) = '' + integer :: j,k,n,nout + + ! obtain all possible output variable tags and attributes + call initialize_gridout + + ! obtain the tags for the requested output variables + call strsplit(fldout,inptags) + + ! determine which variables are tagged for output + do k = 1,nogrp + do j = 1,maxvars + if (len_trim(gridoutdefs(k,j)%tag) > 0) then + do n = 1,len(inptags) + if (len_trim(inptags(n)) > 0) then + if (trim(inptags(n)) == trim(gridoutdefs(k,j)%tag)) gridoutdefs(k,j)%validout = .true. + end if + end do + end if + end do + end do + + ! determine number of output variables (not the same as the number of tags) + n = 0 + do k = 1,nogrp + do j = 1,maxvars + if (gridoutdefs(k,j)%validout) n = n+1 + end do + end do + nout = n + allocate(outvars(1:nout)) + + ! subset variables requested + n = 0 + do k = 1,nogrp + do j = 1,maxvars + if (gridoutdefs(k,j)%validout) then + n = n+1 + outvars(n) = gridoutdefs(k,j) + end if + enddo + end do + + ! check + if ( iaproc == napout ) then + write(nds(1),*) + write(nds(1),'(a)')' --------------------------------------------------' + write(nds(1),'(a)')' Requested gridded output variables : ' + write(nds(1),'(a)')' --------------------------------------------------' + write(nds(1),*) + do n = 1,nout + write(nds(1),'(i5,2a12,a50)')n,' '//trim(outvars(n)%tag), & + ' '//trim(outvars(n)%var_name), & + ' '//trim(outvars(n)%long_name) + end do + write(nds(1),*) + end if + + end subroutine wavinit_grdout + + !==================================================================================== + subroutine initialize_gridout + + gridoutdefs(:,:)%tag = "" + gridoutdefs(:,:)%var_name = "" + gridoutdefs(:,:)%long_name = "" + gridoutdefs(:,:)%unit_name = "" + gridoutdefs(:,:)%dims = "" + gridoutdefs(:,:)%validout = .false. + + ! TODO: confirm unit values + ! 1 Forcing Fields + gridoutdefs(1,1:14) = [ & + varatts( "DPT ", "DW ", "Water depth ", "m ", " ", .false.) , & + varatts( "CUR ", "CX ", "Mean current, x-component ", "m s-1 ", " ", .false.) , & + varatts( "CUR ", "CY ", "Mean current, y-component ", "m s-1 ", " ", .false.) , & + varatts( "WND ", "UAX ", "Mean wind, x-component ", "m s-1 ", " ", .false.) , & + varatts( "WND ", "UAY ", "Mean wind, y-component ", "m s-1 ", " ", .false.) , & + varatts( "AST ", "AS ", "Air-sea temperature difference ", "K ", " ", .false.) , & + varatts( "WLV ", "WLV ", "Water levels ", "m ", " ", .false.) , & + varatts( "ICE ", "ICE ", "Ice coverage ", "nd ", " ", .false.) , & + varatts( "IBG ", "BERG ", "Iceberg-induced damping ", "km-1 ", " ", .false.) , & + varatts( "TAUA ", "TAUAX ", "Atm momentum x ", "Pa ", " ", .false.) , & + varatts( "TAUA ", "TAUAY ", "Atm momentum y ", "Pa ", " ", .false.) , & + varatts( "RHO ", "RHOAIR ", "Air density ", "kg m-3 ", " ", .false.) , & + varatts( "IC1 ", "ICEH ", "Ice thickness ", "m ", " ", .false.) , & + varatts( "IC5 ", "ICEF ", "Ice floe diameter ", "m ", " ", .false.) & + ] + + ! 2 Standard mean wave Parameters + gridoutdefs(2,1:18) = [ & + varatts( "HS ", "HS ", "Significant wave height ", "m ", " ", .false.) , & + varatts( "LM ", "WLM ", "Mean wave length ", "m ", " ", .false.) , & + varatts( "T02 ", "T02 ", "Mean wave period (Tm0,2) ", "s ", " ", .false.) , & + varatts( "T0M1 ", "T0M1 ", "Mean wave period (Tm0,-1) ", "s ", " ", .false.) , & + varatts( "T01 ", "T01 ", "Mean wave period (Tm0,1) ", "s ", " ", .false.) , & + varatts( "FP ", "FP0 ", "Peak frequency ", "s-1 ", " ", .false.) , & + varatts( "DIR ", "THM ", "Mean wave direction ", "rad ", " ", .false.) , & + varatts( "SPR ", "THS ", "Mean directional spread ", "rad ", " ", .false.) , & + varatts( "DP ", "THP0 ", "Peak direction ", "rad ", " ", .false.) , & + varatts( "HIG ", "HSIG ", "Infragravity height ", "m ", " ", .false.) , & + varatts( "MXE ", "STMAXE ", "Max surface elev (STE) ", "m ", " ", .false.) , & + varatts( "MXES ", "STMAXD ", "St Dev Max surface elev (STE) ", "m ", " ", .false.) , & + varatts( "MXH ", "HMAXE ", "Max wave height (S.) ", "m ", " ", .false.) , & + varatts( "MXHC ", "HCMAXE ", "Max wave height from crest (STE) ", "m ", " ", .false.) , & + varatts( "SDMH ", "HMAXD ", "St Dev of MXC (STE) ", "m ", " ", .false.) , & + varatts( "SDMHC", "HCMAXD ", "St Dev of MXHC (STE) ", "m ", " ", .false.) , & + varatts( "WBT ", "WBT ", "Dominant wave breaking probability (b_T) ", "nd ", " ", .false.) , & + varatts( "WNM ", "WNMEAN ", "Mean wave number ", "m-1 ", " ", .false.) & + ] + + ! 3 Spectral Parameters + gridoutdefs(3,1:6) = [ & + varatts( "EF ", "EF ", "1D spectral density ", "m2 s ", "k ", .false.) , & + varatts( "TH1M ", "TH1M ", "Mean wave direction from a1,b2 ", "deg ", "k ", .false.) , & + varatts( "STH1M", "STH1M ", "Directional spreading from a1,b2 ", "deg ", "k ", .false.) , & + varatts( "TH2M ", "TH2M ", "Mean wave direction from a2,b2 ", "deg ", "k ", .false.) , & + varatts( "STH2M", "STH2M ", "Directional spreading from a2,b2 ", "deg ", "k ", .false.) , & + !TODO: has reverse indices (nk,nsea) + varatts( "WN ", "WN ", "Wavenumber array ", "m-1 ", "k ", .false.) & + ] + + ! 4 Spectral Partition Parameters + gridoutdefs(4,1:17) = [ & + varatts( "PHS ", "PHS ", "Partitioned wave heights ", "m ", "s ", .false.) , & + varatts( "PTP ", "PTP ", "Partitioned peak period ", "s ", "s ", .false.) , & + varatts( "PLP ", "PLP ", "Partitioned peak wave length ", "m ", "s ", .false.) , & + varatts( "PDIR ", "PDIR ", "Partitioned mean direction ", "deg ", "s ", .false.) , & + varatts( "PSPR ", "PSI ", "Partitioned mean directional spread ", "deg ", "s ", .false.) , & + varatts( "PWS ", "PWS ", "Partitioned wind sea fraction ", "nd ", "s ", .false.) , & + varatts( "PDP ", "PTHP0 ", "Peak wave direction of partition ", "deg ", "s ", .false.) , & + varatts( "PQP ", "PQP ", "Goda peakdedness parameter of partition ", "nd ", "s ", .false.) , & + varatts( "PPE ", "PPE ", "JONSWAP peak enhancement factor of partition ", "s-1 ", "s ", .false.) , & + varatts( "PGW ", "PGW ", "Gaussian frequency width of partition ", "nd ", "s ", .false.) , & + varatts( "PSW ", "PSW ", "Spectral width of partition ", "nd ", "s ", .false.) , & + varatts( "PTM10", "PTM1 ", "Mean wave period (m-1,0) of partition ", "s ", "s ", .false.) , & + varatts( "PT01 ", "PT1 ", "Mean wave period (m0,1) of partition ", "s ", "s ", .false.) , & + varatts( "PT02 ", "PT2 ", "Mean wave period (m0,2) of partition ", "s ", "s ", .false.) , & + varatts( "PEP ", "PEP ", "Peak spectral density of partition ", "m2 s rad-1", "s ", .false.) , & + varatts( "TWS ", "PWST ", "Total wind sea fraction ", "nd ", " ", .false.) , & + varatts( "PNR ", "PNR ", "Number of partitions ", "nd ", " ", .false.) & + ] + + ! 5 Atmosphere-waves layer + gridoutdefs(5,1:14) = [ & + varatts( "UST ", "USTX ", "Friction velocity x ", "m s-1 ", " ", .false.) , & + varatts( "UST ", "USTY ", "Friction velocity y ", "m s-1 ", " ", .false.) , & + varatts( "CHA ", "CHARN ", "Charnock parameter ", "nd ", " ", .false.) , & + varatts( "CGE ", "CGE ", "Energy flux ", "kW m-1 ", " ", .false.) , & + varatts( "FAW ", "PHIAW ", "Air-sea energy flux ", "W m-2 ", " ", .false.) , & + varatts( "TAW ", "TAUWIX ", "Net wave-supported stress x ", "m2 s-2 ", " ", .false.) , & + varatts( "TAW ", "TAUWIY ", "Net wave-supported stress y ", "m2 s-2 ", " ", .false.) , & + varatts( "TWA ", "TAUWNX ", "Negative part of the wave-supported stress x ", "m2 s-2 ", " ", .false.) , & + varatts( "TWA ", "TAUWNY ", "Negative part of the wave-supported stress y ", "m2 s-2 ", " ", .false.) , & + varatts( "WCC ", "WCC ", "Whitecap coverage ", "nd ", " ", .false.) , & + varatts( "WCF ", "WCF ", "Whitecap foam thickness ", "m ", " ", .false.) , & + varatts( "WCH ", "WCH ", "Mean breaking wave heigh ", "m ", " ", .false.) , & + varatts( "WCM ", "WCM ", "Whitecap moment ", "nd ", " ", .false.) , & + varatts( "FWS ", "TWS ", "Wind sea mean period ", "s ", " ", .false.) & + ] + + ! 6 Wave-ocean layer + gridoutdefs(6,1:24) = [ & + varatts( "SXY ", "SXX ", "Radiation stresses xx ", "N m-1 ", " ", .false.) , & + varatts( "SXY ", "SYY ", "Radiation stresses yy ", "N m-1 ", " ", .false.) , & + varatts( "SXY ", "SXY ", "Radiation stresses xy ", "N m-1 ", " ", .false.) , & + varatts( "TWO ", "TAUOX ", "Wave to ocean momentum flux x ", "m2 s-2 ", " ", .false.) , & + varatts( "TWO ", "TAUOY ", "Wave to ocean momentum flux y ", "m2 s-2 ", " ", .false.) , & + varatts( "BHD ", "BHD ", "Bernoulli head (J term) ", "m2 s-2 ", " ", .false.) , & + varatts( "FOC ", "PHIOC ", "Wave to ocean energy flux ", "W m-2 ", " ", .false.) , & + varatts( "TUS ", "TUSX ", "Stokes transport x ", "m2 s-1 ", " ", .false.) , & + varatts( "TUS ", "TUSY ", "Stokes transport y ", "m2 s-1 ", " ", .false.) , & + varatts( "USS ", "USSX ", "Surface Stokes drift x ", "m s-1 ", " ", .false.) , & + varatts( "USS ", "USSY ", "Surface Stokes drift y ", "m s-1 ", " ", .false.) , & + varatts( "P2S ", "PRMS ", "Second-order sum pressure ", "m4 ", " ", .false.) , & + varatts( "P2S ", "TPMS ", "Second-order sum pressure ", "s-1 ", " ", .false.) , & + varatts( "USF ", "US3DX ", "Spectrum of surface Stokes drift x ", "m s-1 Hz-1", "k ", .false.) , & + varatts( "USF ", "US3DY ", "Spectrum of surface Stokes drift y ", "m s-1 Hz-1", "k ", .false.) , & + varatts( "P2L ", "P2SMS ", "Micro seism source term ", "Pa2 m2 s ", "m ", .false.) , & + varatts( "TWI ", "TAUICEX ", "Wave to sea ice stress x ", "m2 s-2 ", " ", .false.) , & + varatts( "TWI ", "TAUICEY ", "Wave to sea ice stress y ", "m2 s-2 ", " ", .false.) , & + varatts( "FIC ", "PHICE ", "Wave to sea ice energy flux ", "W m-2 ", " ", .false.) , & + varatts( "USP ", "USSPX ", "Partitioned surface Stokes drift x ", "m s-1 ", "p ", .false.) , & + varatts( "USP ", "USSPY ", "Partitioned surface Stokes drift y ", "m s-1 ", "p ", .false.) , & + varatts( "TWC ", "TAUOCX ", "Total wave to ocean stress x ", "Pa ", " ", .false.) , & + varatts( "TWC ", "TAUOCY ", "Total wave to ocean stress y ", "Pa ", " ", .false.) , & + varatts( "LAN ", "LANGMT ", "Turbulent Langmuir number (La_t) ", "nd ", " ", .false.) & + ] + + ! 7 Wave-bottom layer + gridoutdefs(7,1:10) = [ & + varatts( "ABR ", "ABAX ", "Near bottom rms wave excursion amplitudes x ", "m ", " ", .false.) , & + varatts( "ABR ", "ABAY ", "Near bottom rms wave excursion amplitudes y ", "m ", " ", .false.) , & + varatts( "UBR ", "UBAX ", "Near bottom rms wave velocities x ", "m s-1 ", " ", .false.) , & + varatts( "UBR ", "UBAY ", "Near bottom rms wave velocities y ", "m s-1 ", " ", .false.) , & + varatts( "BED ", "BED ", "Bottom roughness ", "m ", " ", .false.) , & + varatts( "BED ", "RIPPLEX ", "Sea bottom ripple wavelength x ", "m ", " ", .false.) , & + varatts( "BED ", "RIPPLEY ", "Sea bottom ripple wavelength y ", "m ", " ", .false.) , & + varatts( "FBB ", "PHIBBL ", "Energy flux due to bottom friction ", "W m-2 ", " ", .false.) , & + varatts( "TBB ", "TAUBBLX ", "Momentum flux due to bottom friction x ", "m2 s-2 ", " ", .false.) , & + varatts( "TBB ", "TAUBBLY ", "Momentum flux due to bottom friction y ", "m2 s-2 ", " ", .false.) & + ] + + ! 8 Spectrum parameters + gridoutdefs(8,1:9) = [ & + varatts( "MSS ", "MSSX ", "Surface mean square slope x ", "nd ", " ", .false.) , & + varatts( "MSS ", "MSSY ", "Surface mean square slope y ", "nd ", " ", .false.) , & + varatts( "MSC ", "MSCX ", "Spectral level at high frequency tail x ", "nd ", " ", .false.) , & + varatts( "MSC ", "MSCY ", "Spectral level at high frequency tail y ", "nd ", " ", .false.) , & + varatts( "WL02 ", "WL02X ", "East/X North/Y mean wavelength component ", "nd ", " ", .false.) , & + varatts( "WL02 ", "WL02Y ", "East/X North/Y mean wavelength component ", "nd ", " ", .false.) , & + varatts( "AXT ", "ALPXT ", "Correl sea surface gradients (x,t) ", "nd ", " ", .false.) , & + varatts( "AYT ", "ALPYT ", "Correl sea surface gradients (y,t) ", "nd ", " ", .false.) , & + varatts( "AXY ", "ALPXY ", "Correl sea surface gradients (x,y) ", "nd ", " ", .false.) & + ] + + ! 9 Numerical diagnostics + gridoutdefs(9,1:5) = [ & + varatts( "DTD ", "DTDYN ", "Average time step in integration ", "min ", " ", .false.) , & + varatts( "FC ", "FCUT ", "Cut-off frequency ", "s-1 ", " ", .false.) , & + varatts( "CFX ", "CFLXYMAX ", "Max. CFL number for spatial advection ", "nd ", " ", .false.) , & + varatts( "CFD ", "CFLTHMAX ", "Max. CFL number for theta-advection ", "nd ", " ", .false.) , & + varatts( "CFK ", "CFLKMAX ", "Max. CFL number for k-advection ", "nd ", " ", .false.) & + ] + + ! 10 User defined + gridoutdefs(10,1:2) = [ & + varatts( "U1 ", "U1 ", "User defined 1 ", "nd ", " ", .false.) , & + varatts( "U2 ", "U2 ", "User defined 2 ", "nd ", " ", .false.) & + ] + end subroutine initialize_gridout +end module wav_grdout diff --git a/model/src/wav_import_export.F90 b/model/src/wav_import_export.F90 index 0a5177ef0..a6bf5eeb0 100644 --- a/model/src/wav_import_export.F90 +++ b/model/src/wav_import_export.F90 @@ -1,3 +1,13 @@ +!> @file wav_import_export +!! +!> Manage the import/export state and fields +!! +!> @details Contains the public routines to advertise and realize +!! the import and export fields and the public routines to fill +!! the import and export fields within the ESMF States. +!! +!> @author mvertens@ucar.edu, Denise.Worthen@noaa.gov +!> @date 01-05-2022 module wav_import_export use ESMF @@ -14,53 +24,67 @@ module wav_import_export implicit none private ! except - public :: advertise_fields - public :: realize_fields - public :: import_fields - public :: export_fields - public :: CalcRoughl + public :: advertise_fields !< @public create a list of fields and advertise them + public :: realize_fields !< @public realize a list of advertised fields + public :: import_fields !< @public fill WW3 fields using values in the import state + public :: export_fields !< @public fill values in the export state using WW3 fields + public :: CalcRoughl !< @public calculate the roughness length - private :: fldlist_add - private :: fldlist_realize - private :: set_importmask - private :: check_globaldata - private :: readfromfile + private :: fldlist_add !< @private add a field name to a list of field names + private :: fldlist_realize !< @private realize a field in a list of field names + private :: set_importmask !< @private set the import mask when merge_import is true + private :: check_globaldata !< @private write values in a field to a netCDF file for debugging + private :: readfromfile !< @private read values from a file interface FillGlobalInput module procedure fillglobal_with_import module procedure fillglobal_with_merge_import end interface - type fld_list_type - character(len=128) :: stdname - integer :: ungridded_lbound = 0 - integer :: ungridded_ubound = 0 + type fld_list_type !< @private a structure for the list of fields + character(len=128) :: stdname !< a standard field name + integer :: ungridded_lbound = 0 !< the ungridded dimension lower bound + integer :: ungridded_ubound = 0 !< the ugridded dimension upper bound end type fld_list_type - integer, parameter :: fldsMax = 100 - integer :: fldsToWav_num = 0 - integer :: fldsFrWav_num = 0 - type (fld_list_type) :: fldsToWav(fldsMax) - type (fld_list_type) :: fldsFrWav(fldsMax) + integer, parameter :: fldsMax = 100 !< the maximum allowed number of fields in a state + integer :: fldsToWav_num = 0 !< initial value of the number of fields sent to the wave model + integer :: fldsFrWav_num = 0 !< initial value of the number of fields sent from the wave model + type (fld_list_type) :: fldsToWav(fldsMax) !< a structure containing the list of fields to the wave model + type (fld_list_type) :: fldsFrWav(fldsMax) !< a structure containing the list of fields from the wave model - real(r4), allocatable :: import_mask(:) ! mask for valid import data - real(r8), parameter :: zero = 0.0_r8 + real(r4), allocatable :: import_mask(:) !< the mask for valid import data + real(r8), parameter :: zero = 0.0_r8 !< a named constant #ifdef CESMCOUPLED - logical :: cesmcoupled = .true. + logical :: cesmcoupled = .true. !< logical defining a CESM use case #else - logical :: cesmcoupled = .false. + logical :: cesmcoupled = .false. !< logical defining a non-CESM use case (UWM) #endif - integer, parameter :: nwav_elev_spectrum = 25 - - character(*),parameter :: u_FILE_u = & + integer, parameter :: nwav_elev_spectrum = 25 !< the size of the wave spectrum exported if coupling + !! waves to cice6 + character(*),parameter :: u_FILE_u = & !< a character string for an ESMF log message __FILE__ !=============================================================================== contains !=============================================================================== - +!> Set up the list of exchanged field to be advertised +!! +!> @details Called by InitializAdvertise, a list of standard field names to or +!! from the wave model is created and then advertised in either the import or +!! export state. A field with name set by the configuration variable ScalarFieldName +!! and size of ScalarFieldCount is added to the list of fields in the export state +!! and is used by CMEPS to write mediator history and restart fields as 2D arrays +!! +!! @param importState an ESMF_State for the import +!! @param exportState an ESMF_State for the export +!! @param[in] flds_scalar_name the name of the scalar field +!! @param[out] rc a return code +!! +!> @author mvertens@ucar.edu, Denise.Worthen@noaa.gov +!> @date 01-05-2022 subroutine advertise_fields(importState, ExportState, flds_scalar_name, rc) ! input/output variables type(ESMF_State) :: importState @@ -135,8 +159,8 @@ subroutine advertise_fields(importState, ExportState, flds_scalar_name, rc) ! also ensure compatibility with the ocean component since ocean will also receive these from the coupler. if (wav_coupling_to_cice) then - call fldlist_add(fldsFrWav_num, fldsFrWav, 'wav_tauice1') - call fldlist_add(fldsFrWav_num, fldsFrWav, 'wav_tauice2') + !call fldlist_add(fldsFrWav_num, fldsFrWav, 'wav_tauice1') + !call fldlist_add(fldsFrWav_num, fldsFrWav, 'wav_tauice2') call fldlist_add(fldsFrWav_num, fldsFrWav, 'wave_elevation_spectrum', & ungridded_lbound=1, ungridded_ubound=nwav_elev_spectrum) end if @@ -152,6 +176,19 @@ subroutine advertise_fields(importState, ExportState, flds_scalar_name, rc) end subroutine advertise_fields !=============================================================================== +!> Realize the advertised fields +!! +!> @details Called by InitializeRealize, realize the advertised fields on the mesh +!! and set all initial values to zero +!! +!! @param gcomp an ESMF_GridComp object +!! @param mesh an ESMF_Mesh object +!! @param[in] flds_scalar_name the name of the scalar field +!! @param[in] flds_scalar_num the number of scalar fields +!! @param[out] rc a return code +!! +!> @author mvertens@ucar.edu, Denise.Worthen@noaa.gov +!> @date 01-05-2022 subroutine realize_fields(gcomp, mesh, flds_scalar_name, flds_scalar_num, rc) ! input/output variables @@ -208,6 +245,21 @@ subroutine realize_fields(gcomp, mesh, flds_scalar_name, flds_scalar_num, rc) end subroutine realize_fields !=============================================================================== +!> Fill WW3 fields with values from the import state +!! +!> @details Called by ModelAdvance, a global field for each connected field is +!! created in SetGlobalInput and used to fill the internal WW3 global variables in +!! FillGlobalInput. Optionally, the WW3 field can be created by merging with a +!! provided field in cases where the WW3 model domain extends outside the source +!! domain +!! +!! @param[inout] gcomp an ESMF_GridComp object +!! @param[in] time0 the starting time of ModelAdvance +!! @param[in] timen the ending time of ModelAdvance +!! @param[out] rc return code +!! +!> @author mvertens@ucar.edu, Denise.Worthen@noaa.gov +!> @date 01-05-2022 subroutine import_fields( gcomp, time0, timen, rc ) !--------------------------------------------------------------------------- @@ -515,7 +567,16 @@ subroutine import_fields( gcomp, time0, timen, rc ) end subroutine import_fields - !==================================================================================== + !=============================================================================== +!> Fill the export state with values from WW3 fields +!! +!> @details Called by ModelAdvance, fill or compute the values in the export state. +!! +!! @param gcomp an ESMF_GridComp object +!! @param[out] rc return code +!! +!> @author mvertens@ucar.edu, Denise.Worthen@noaa.gov +!> @date 01-05-2022 subroutine export_fields (gcomp, rc) !--------------------------------------------------------------------------- @@ -595,7 +656,7 @@ subroutine export_fields (gcomp, rc) end if #else if (state_fldchk(exportState, 'Sw_lamult')) then - call state_getfldptr(exportState, 'Sw_lamult', fldptr1d=sw_lamult, rc=rc) + call state_getfldptr(exportState, 'Sw_lamult', sw_lamult, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return sw_lamult(:) = fillvalue do jsea=1, nseal @@ -613,7 +674,7 @@ subroutine export_fields (gcomp, rc) ! surface stokes drift if (state_fldchk(exportState, 'Sw_ustokes')) then - call state_getfldptr(exportState, 'Sw_ustokes', fldptr1d=sw_ustokes, rc=rc) + call state_getfldptr(exportState, 'Sw_ustokes', sw_ustokes, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return sw_ustokes(:) = fillvalue do jsea=1, nseal @@ -628,7 +689,7 @@ subroutine export_fields (gcomp, rc) enddo end if if (state_fldchk(exportState, 'Sw_vstokes')) then - call state_getfldptr(exportState, 'Sw_vstokes', fldptr1d=sw_vstokes, rc=rc) + call state_getfldptr(exportState, 'Sw_vstokes', sw_vstokes, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return sw_vstokes(:) = fillvalue do jsea=1, nseal @@ -644,13 +705,13 @@ subroutine export_fields (gcomp, rc) end if if (state_fldchk(exportState, 'Sw_ch')) then - call state_getfldptr(exportState, 'charno', fldptr1d=charno, rc=rc) + call state_getfldptr(exportState, 'charno', charno, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call CalcCharnk(charno) endif if (state_fldchk(exportState, 'Sw_z0')) then - call state_getfldptr(exportState, 'Sw_z0', fldptr1d=z0rlen, rc=rc) + call state_getfldptr(exportState, 'Sw_z0', z0rlen, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call CalcRoughl(z0rlen) endif @@ -661,9 +722,9 @@ subroutine export_fields (gcomp, rc) ! in fd_nems.yaml but this seems to be calculated a (:,:) value !if ( state_fldchk(exportState, 'uscurr') .and. & ! state_fldchk(exportState, 'vscurr')) then - ! call state_getfldptr(exportState, 'uscurr', fldptr1d=uscurr, rc=rc) + ! call state_getfldptr(exportState, 'uscurr', uscurr, rc=rc) ! if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! call state_getfldptr(exportState, 'vscurr', fldptr1d=vscurr, rc=rc) + ! call state_getfldptr(exportState, 'vscurr', vscurr, rc=rc) ! if (ChkErr(rc,__LINE__,u_FILE_u)) return ! call CalcStokes3D( va, uscurr, vscurr ) !endif @@ -671,11 +732,11 @@ subroutine export_fields (gcomp, rc) if ( state_fldchk(exportState, 'wbcuru') .and. & state_fldchk(exportState, 'wbcurv') .and. & state_fldchk(exportState, 'wbcurp')) then - call state_getfldptr(exportState, 'wbcuru', fldptr1d=wbcuru, rc=rc) + call state_getfldptr(exportState, 'wbcuru', wbcuru, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getfldptr(exportState, 'wbcurv', fldptr1d=wbcurv, rc=rc) + call state_getfldptr(exportState, 'wbcurv', wbcurv, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getfldptr(exportState, 'wbcurp', fldptr1d=wbcurp, rc=rc) + call state_getfldptr(exportState, 'wbcurp', wbcurp, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call CalcBotcur( va, wbcuru, wbcurv, wbcurp) end if @@ -683,27 +744,27 @@ subroutine export_fields (gcomp, rc) if ( state_fldchk(exportState, 'wavsuu') .and. & state_fldchk(exportState, 'wavsuv') .and. & state_fldchk(exportState, 'wavsvv')) then - call state_getfldptr(exportState, 'sxxn', fldptr1d=sxxn, rc=rc) + call state_getfldptr(exportState, 'sxxn', sxxn, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getfldptr(exportState, 'sxyn', fldptr1d=sxyn, rc=rc) + call state_getfldptr(exportState, 'sxyn', sxyn, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getfldptr(exportState, 'syyn', fldptr1d=syyn, rc=rc) + call state_getfldptr(exportState, 'syyn', syyn, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call CalcRadstr2D( va, sxxn, sxyn, syyn) end if if (wav_coupling_to_cice) then - call state_getfldptr(exportState, 'wav_tauice1', fldptr1d=wav_tauice1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getfldptr(exportState, 'wav_tauice2', fldptr1d=wav_tauice2, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getfldptr(exportState, 'wave_elevation_spectrum', fldptr2d=wave_elevation_spectrum, rc=rc) + !call state_getfldptr(exportState, 'wav_tauice1', wav_tauice1, rc=rc) + !if (ChkErr(rc,__LINE__,u_FILE_u)) return + !call state_getfldptr(exportState, 'wav_tauice2', wav_tauice2, rc=rc) + !if (ChkErr(rc,__LINE__,u_FILE_u)) return + call state_getfldptr(exportState, 'wave_elevation_spectrum', wave_elevation_spectrum, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! Initialize wave elevation spectrum - wav_tauice1(:) = fillvalue - wav_tauice2(:) = fillvalue + !wav_tauice1(:) = fillvalue + !wav_tauice2(:) = fillvalue wave_elevation_spectrum(:,:) = fillvalue do jsea=1, nseal ! jsea is local @@ -711,15 +772,15 @@ subroutine export_fields (gcomp, rc) ix = mapsf(isea,1) ! global ix iy = mapsf(isea,2) ! global iy if (mapsta(iy,ix) .eq. 1) then ! active sea point - wav_tauice1(jsea) = TAUICE(jsea,1) ! tau ice is 2D - wav_tauice2(jsea) = TAUICE(jsea,2) ! tau ice is 2D + !wav_tauice1(jsea) = TAUICE(jsea,1) ! tau ice is 2D + !wav_tauice2(jsea) = TAUICE(jsea,2) ! tau ice is 2D ! If wave_elevation_spectrum is UNDEF - needs ouput flag to be turned on ! wave_elevation_spectrum as 25 variables wave_elevation_spectrum(1:nwav_elev_spectrum,jsea) = EF(jsea,1:nwav_elev_spectrum) else - wav_tauice1(jsea) = 0. - wav_tauice2(jsea) = 0. + !wav_tauice1(jsea) = 0. + !wav_tauice2(jsea) = 0. wave_elevation_spectrum(:,jsea) = 0. endif enddo @@ -728,9 +789,9 @@ subroutine export_fields (gcomp, rc) if ( state_fldchk(exportState, 'Sw_pstokes_x') .and. & state_fldchk(exportState, 'Sw_pstokes_y') )then if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getfldptr(exportState, 'Sw_pstokes_x', fldptr2d=sw_pstokes_x, rc=rc) + call state_getfldptr(exportState, 'Sw_pstokes_x', sw_pstokes_x, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getfldptr(exportState, 'Sw_pstokes_y', fldptr2d=sw_pstokes_y, rc=rc) + call state_getfldptr(exportState, 'Sw_pstokes_y', sw_pstokes_y, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return sw_pstokes_x(:,:) = fillvalue sw_pstokes_y(:,:) = fillvalue @@ -752,17 +813,17 @@ subroutine export_fields (gcomp, rc) state_fldchk(exportState, 'Sw_vstokes2') .and. & state_fldchk(exportState, 'Sw_vstokes3') ) then - call state_getfldptr(exportState, 'Sw_ustokes1', fldptr1d=sw_ustokes1, rc=rc) + call state_getfldptr(exportState, 'Sw_ustokes1', sw_ustokes1, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getfldptr(exportState, 'Sw_ustokes2', fldptr1d=sw_ustokes2, rc=rc) + call state_getfldptr(exportState, 'Sw_ustokes2', sw_ustokes2, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getfldptr(exportState, 'Sw_ustokes3', fldptr1d=sw_ustokes3, rc=rc) + call state_getfldptr(exportState, 'Sw_ustokes3', sw_ustokes3, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getfldptr(exportState, 'Sw_vstokes1', fldptr1d=sw_vstokes1, rc=rc) + call state_getfldptr(exportState, 'Sw_vstokes1', sw_vstokes1, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getfldptr(exportState, 'Sw_vstokes2', fldptr1d=sw_vstokes2, rc=rc) + call state_getfldptr(exportState, 'Sw_vstokes2', sw_vstokes2, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getfldptr(exportState, 'Sw_vstokes3', fldptr1d=sw_vstokes3, rc=rc) + call state_getfldptr(exportState, 'Sw_vstokes3', sw_vstokes3, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return sw_ustokes1(:)= zero sw_vstokes1(:)= zero @@ -789,6 +850,16 @@ subroutine export_fields (gcomp, rc) end subroutine export_fields !=============================================================================== +!> Add a fieldname to a list of fields in a state +!! +!! @param[inout] num a counter for added fields +!! @param[inout] fldlist a structure for the standard name and ungridded dims +!! @param[in] stdname a standard field name +!! @param[in] ungridded_lbound the lower bound of an ungridded dimension +!! @param[in] ungridded_ubound the upper bound of an ungridded dimension +!! +!> @author mvertens@ucar.edu, Denise.Worthen@noaa.gov +!> @date 01-05-2022 subroutine fldlist_add(num, fldlist, stdname, ungridded_lbound, ungridded_ubound) integer, intent(inout) :: num type(fld_list_type), intent(inout) :: fldlist(:) @@ -818,15 +889,25 @@ subroutine fldlist_add(num, fldlist, stdname, ungridded_lbound, ungridded_ubound end subroutine fldlist_add !=============================================================================== +!> Realize a list of fields in a state +!! +!> @details For a connected field in a State, create an ESMF_Field object of +!! the required dimensionality on the ESMF_Mesh. Remove any unconnected fields from +!! the State. For a scalar field, create a field of dimensionality (1:flds_scalar_num) +!! +!! @param[inout] state an ESMF_State object +!! @param[in] fldlist a list of fields in the State +!! @param[in] numflds the number of fields in the state +!! @param[in] flds_scalar_name the name of the scalar field +!! @param[in] flds_scalar_num the count of scalar fields +!! @param[in] tag a character string for logging +!! @param[in] mesh an ESMF_Mesh object +!! @param[inout] rc a return code +!! +!> @author mvertens@ucar.edu, Denise.Worthen@noaa.gov +!> @date 01-05-2022 subroutine fldlist_realize(state, fldList, numflds, flds_scalar_name, flds_scalar_num, mesh, tag, rc) - use NUOPC, only : NUOPC_IsConnected, NUOPC_Realize - use ESMF , only : ESMF_MeshLoc_Element, ESMF_FieldCreate, ESMF_TYPEKIND_R8 - use ESMF , only : ESMF_MAXSTR, ESMF_Field, ESMF_State, ESMF_Mesh, ESMF_StateRemove - use ESMF , only : ESMF_LogFoundError, ESMF_LOGMSG_INFO, ESMF_SUCCESS - use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_ERROR, ESMF_LOGERR_PASSTHRU - use ESMF , only : ESMF_VM - ! input/output variables type(ESMF_State) , intent(inout) :: state type(fld_list_type) , intent(in) :: fldList(:) @@ -888,14 +969,19 @@ subroutine fldlist_realize(state, fldList, numflds, flds_scalar_name, flds_scala end do contains !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +!> Create a field with scalar data on the root pe +!! +!! @param[inout] field an ESMF_Field +!! @param[in] flds_scalar_name the scalar field name +!! @param[in[ flds_scalar_num the dimnsionality of the scalar field +!! @param[inout] rc a return code +!! +!> @author mvertens@ucar.edu, Denise.Worthen@noaa.gov +!> @date 01-05-2022 subroutine SetScalarField(field, flds_scalar_name, flds_scalar_num, rc) ! ---------------------------------------------- ! create a field with scalar data on the root pe ! ---------------------------------------------- - use ESMF, only : ESMF_Field, ESMF_DistGrid, ESMF_Grid - use ESMF, only : ESMF_DistGridCreate, ESMF_GridCreate, ESMF_LogFoundError, ESMF_LOGERR_PASSTHRU - use ESMF, only : ESMF_FieldCreate, ESMF_GridCreate, ESMF_TYPEKIND_R8 type(ESMF_Field) , intent(inout) :: field character(len=*) , intent(in) :: flds_scalar_name @@ -926,6 +1012,14 @@ end subroutine SetScalarField end subroutine fldlist_realize !=============================================================================== +!> Calculate Charnok parameter for export +!! +!> @details TODO: +!! +!! @param[inout] chkn a 1-D pointer to a field on a mesh +!! +!> @author T. J. Campbell, NRL +!> @date 09-Aug-2017 subroutine CalcCharnk ( chkn ) ! Calculate Charnok for export @@ -942,7 +1036,7 @@ subroutine CalcCharnk ( chkn ) #endif ! input/output variables - real(ESMF_KIND_R8), pointer :: chkn(:) ! 2D Charnock export field pointer + real(ESMF_KIND_R8), pointer :: chkn(:) ! 1D Charnock export field pointer ! local variables real , parameter :: zero = 0.0 @@ -983,6 +1077,14 @@ subroutine CalcCharnk ( chkn ) end subroutine CalcCharnk !=============================================================================== +!> Calculate wave roughness length for export +!! +!> @details TODO: +!! +!! @param[inout] wrln a 1-D pointer to a field on a mesh +!! +!> @author T. J. Campbell, NRL +!> @date 09-Aug-2017 subroutine CalcRoughl ( wrln) ! Calculate 2D wave roughness length for export @@ -1000,7 +1102,7 @@ subroutine CalcRoughl ( wrln) use wav_shr_mod, only : runtype ! input/output variables - real(r8), pointer :: wrln(:) ! 2D roughness length export field ponter + real(r8), pointer :: wrln(:) ! 1D roughness length export field ponter ! local variables integer :: isea, jsea, ix, iy @@ -1047,6 +1149,17 @@ subroutine CalcRoughl ( wrln) end subroutine CalcRoughl !=============================================================================== +!> Calculate wave-bottom currents for export +!! +!> @details TODO: +!! +!! @param[in] a input spectra +!! @param wbxn a 1-D pointer to a field on a mesh +!! @param wbyn a 1-D pointer to a field on a mesh +!! @param wbpn a 1-D pointer to a field on a mesh +!! +!> @author T. J. Campbell, NRL +!> @date 09-Aug-2017 subroutine CalcBotcur ( a, wbxn, wbyn, wbpn ) ! Calculate wave-bottom currents for export @@ -1119,6 +1232,17 @@ subroutine CalcBotcur ( a, wbxn, wbyn, wbpn ) end subroutine CalcBotcur !=============================================================================== +!> Calculate radiation stresses for export +!! +!> @details TODO: +!! +!! @param[in] a input spectra +!! @param sxxn a 1-D pointer to a field on a mesh +!! @param sxyn a 1-D pointer to a field on a mesh +!! @param syyn a 1-D pointer to a field on a mesh +!! +!> @author T. J. Campbell, NRL +!> @date 09-Aug-2017 subroutine CalcRadstr2D ( a, sxxn, sxyn, syyn ) ! Calculate 2D radiation stresses for export @@ -1179,6 +1303,19 @@ subroutine CalcRadstr2D ( a, sxxn, sxyn, syyn ) end subroutine CalcRadstr2D !==================================================================================== +!> Create a global field across all PEs +!! +!> @details Distributes the global values of the named import state field to all PEs +!! using a global reduce across all PEs. +!! +!! @param[in] importstate the import state +!! @param[in] fldname the field name +!! @param[in] vm the ESMF VM object +!! @param[out] global_output the global nsea values +!! @param[out] rc a return code +!! +!> @author mvertens@ucar.edu, Denise.Worthen@noaa.gov +!> @date 01-05-2022 subroutine SetGlobalInput(importState, fldname, vm, global_output, rc) use w3gdatmd, only: nsea, nseal, nx, ny @@ -1202,7 +1339,7 @@ subroutine SetGlobalInput(importState, fldname, vm, global_output, rc) rc = ESMF_SUCCESS if (dbug_flag > 5) call ESMF_LogWrite(trim(subname)//' called', ESMF_LOGMSG_INFO) - call state_getfldptr(importState, trim(fldname), fldptr1d=dataptr, rc=rc) + call state_getfldptr(importState, trim(fldname), dataptr, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return global_output(:) = 0._r4 global_input(:) = 0._r4 @@ -1216,6 +1353,15 @@ subroutine SetGlobalInput(importState, fldname, vm, global_output, rc) end subroutine SetGlobalInput !==================================================================================== +!> Fill a global field with import state values at nsea points +!! +!> @details Fills a global field on all points from the values at all sea points +!! +!! @param[in] global_data values of a global field on nsea points +!! @param[inout] globalfield values of a global field on all points +!! +!> @author mvertens@ucar.edu, Denise.Worthen@noaa.gov +!> @date 01-05-2022 subroutine fillglobal_with_import(global_data, globalfield) use w3gdatmd, only: nsea, mapsf, nx, ny @@ -1235,6 +1381,18 @@ subroutine fillglobal_with_import(global_data, globalfield) end subroutine fillglobal_with_import !==================================================================================== +!> Fill a global field by merging +!! +!> @details Merges the global import field values on sea points with values from a file +!! using a provided mask +!! +!! @param[in] global_data values of a global field on nsea points +!! @param[in] global_mask values of a global mask +!! @param[in] filedata values of a global field from a file +!! @param[inout] globalfield values of a global field on all points +!! +!> @author mvertens@ucar.edu, Denise.Worthen@noaa.gov +!> @date 01-05-2022 subroutine fillglobal_with_merge_import(global_data, global_mask, filedata, globalfield) use w3gdatmd, only: nsea, mapsf, nx, ny @@ -1256,6 +1414,27 @@ subroutine fillglobal_with_merge_import(global_data, global_mask, filedata, glob end subroutine fillglobal_with_merge_import !==================================================================================== +!> Obtain the import mask used to merge a field from the import state with values from +!! a file +!! +!! @details Set the import mask for merging an import state field with values from +!! a file. The import mask is set 0 where the field from the import state has a value +!! of fillValue due to non-overlapping model domains. The field values read from a +!! file will be used to provide the values in these regions. The values of the import +!! mask are set initially (on the first ModelAdvance) to be 0 everywhere. In this case +!! there are no valid import state values and only the values read from the file are +!! used. At the second ModelAdvance, the import state contains valid values and the +!! import mask can be set according the regions where the import state contains the +!! fillValue. The import mask is fixed in time after the second ModelAdvance. +!! +!! @param[in] importState an ESMF_State object for import fields +!! @param[in] clock an ESMF_Clock object +!! @param[in] fldname a field name +!! @param[in] vm an ESMF_VM object +!! @param[out] rc return code +!! +!> @author mvertens@ucar.edu, Denise.Worthen@noaa.gov +!> @date 01-05-2022 subroutine set_importmask(importState, clock, fldname, vm, rc) use w3gdatmd, only: nsea, nseal, nx, ny @@ -1317,7 +1496,7 @@ subroutine set_importmask(importState, clock, fldname, vm, rc) if (secondCall) then call ESMF_ClockPrint(clock, options='currTime', preString='Setting new import_mask at currTime : ', & unit=msgString, rc=rc) - call state_getfldptr(importState, trim(fldname), fldptr1d=dataptr, rc=rc) + call state_getfldptr(importState, trim(fldname), dataptr, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return import_mask(:) = 0.0_r4 @@ -1337,6 +1516,20 @@ subroutine set_importmask(importState, clock, fldname, vm, rc) end subroutine set_importmask !==================================================================================== +!> Write a netCDF file containing the global field values for debugging +!! +!! @details Write a time-stamped netCDF file containing the values of a global field, +!! where the global_field is provided on either on all points or only nsea points. In +!! either case, the field will be written to the file on the mesh. +!! +!! @param[in] gcomp an ESMF_GridComp object +!! @param[in] fldname a field name +!! @param[in] global_data a global field +!! @param[in] nvals the dimension of global_data +!! @param[out] rc return code +!! +!> @author mvertens@ucar.edu, Denise.Worthen@noaa.gov +!> @date 01-05-2022 subroutine check_globaldata(gcomp, fldname, global_data, nvals, rc) use w3gdatmd, only: nseal, nsea, mapsf, nx, ny @@ -1424,6 +1617,20 @@ subroutine check_globaldata(gcomp, fldname, global_data, nvals, rc) end subroutine check_globaldata !======================================================================== +!> Read input from a file +!! +!> @details Obtain values from a file to fill an import state within a +!! non-overlapped region of the wave domain +!! +!! @param[in] idfld a file name to read +!! @param[in] time0 the initial time +!! @param[in] timen the ending time +!! @param[out] wxdata a 1-D pointer to a zonal wind field +!! @param[out] wydata a 1-D pointer to a meridional wind field +!! @param[out] rc a return code +!! +!> @author U. Turuncoglu, NCAR +!> @date 18-May-2021 subroutine readfromfile (idfld, wxdata, wydata, time0, timen, rc) use w3gdatmd, only: nsea, mapsf, gtype, nx, ny diff --git a/model/src/wav_kind_mod.F90 b/model/src/wav_kind_mod.F90 index 53964443a..05e0a79a1 100644 --- a/model/src/wav_kind_mod.F90 +++ b/model/src/wav_kind_mod.F90 @@ -1,19 +1,27 @@ +!> @file wav_kind_mod +!! +!> Precision and kind constants +!! +!> @details Contains public definitions of variable types and constants +!! +!> @author mvertens@ucar.edu, Denise.Worthen@noaa.gov +!> @date 01-05-2022 module wav_kind_mod !---------------------------------------------------------------------------- ! precision/kind constants add data public !---------------------------------------------------------------------------- public - integer,parameter :: SHR_KIND_R8 = selected_real_kind(12) ! 8 byte real - integer,parameter :: SHR_KIND_R4 = selected_real_kind( 6) ! 4 byte real - integer,parameter :: SHR_KIND_RN = kind(1.0) ! native real - integer,parameter :: SHR_KIND_I8 = selected_int_kind (13) ! 8 byte integer - integer,parameter :: SHR_KIND_I4 = selected_int_kind ( 6) ! 4 byte integer - integer,parameter :: SHR_KIND_IN = kind(1) ! native integer - integer,parameter :: SHR_KIND_CS = 80 ! short char - integer,parameter :: SHR_KIND_CM = 160 ! mid-sized char - integer,parameter :: SHR_KIND_CL = 256 ! long char - integer,parameter :: SHR_KIND_CX = 512 ! extra-long char - integer,parameter :: SHR_KIND_CXX= 4096 ! extra-extra-long char + integer,parameter :: SHR_KIND_R8 = selected_real_kind(12) !< @public 8 byte real + integer,parameter :: SHR_KIND_R4 = selected_real_kind( 6) !< @public 4 byte real + integer,parameter :: SHR_KIND_RN = kind(1.0) !< @public native real + integer,parameter :: SHR_KIND_I8 = selected_int_kind (13) !< @public 8 byte integer + integer,parameter :: SHR_KIND_I4 = selected_int_kind ( 6) !< @public 4 byte integer + integer,parameter :: SHR_KIND_IN = kind(1) !< @public native integer + integer,parameter :: SHR_KIND_CS = 80 !< @public short char + integer,parameter :: SHR_KIND_CM = 160 !< @public mid-sized char + integer,parameter :: SHR_KIND_CL = 256 !< @public long char + integer,parameter :: SHR_KIND_CX = 512 !< @public extra-long char + integer,parameter :: SHR_KIND_CXX= 4096 !< @public extra-extra-long char end module wav_kind_mod diff --git a/model/src/wav_shel_inp.F90 b/model/src/wav_shel_inp.F90 index 02bde9405..79b3190a1 100644 --- a/model/src/wav_shel_inp.F90 +++ b/model/src/wav_shel_inp.F90 @@ -1,32 +1,51 @@ +!> @file wav_shel_inp +!! +!> Set up for running in shel mode +!! +!> @details Contains public routines to sets up IO unit numbers and to +!! either reads a shel.inp file (UWM) or set the required values directly +!! (CESM). +!! +!> @author mvertens@ucar.edu, Denise.Worthen@noaa.gov +!> @date 01-05-2022 module wav_shel_inp - use w3odatmd, only: nogrp, ngrpp + use w3odatmd , only : nogrp, ngrpp + use wav_shr_mod , only : wav_coupling_to_cice implicit none private ! except - public :: set_shel_io - public :: set_shel_inp - public :: read_shel_inp + public :: set_shel_io !< @public set the IO unit numbers + public :: set_shel_inp !< @public directly set required input variabls (CESM) + public :: read_shel_inp !< @public read ww3_shel.inp (UWM) - integer, public :: odat(40) - character(len=40), allocatable, public :: pnames(:) + integer, public :: odat(40) !< @public output dates + character(len=40), allocatable, public :: pnames(:) !< @public point names - integer, public :: npts - integer, public :: iprt(6) - logical, public :: prtfrm - logical, public :: flgrd(nogrp,ngrpp) !flags for gridded output - logical, public :: flgr2(nogrp,ngrpp) !flags for coupling output - logical, public :: flgd(nogrp) !flags for whole group - not currently used in cesm - logical, public :: flg2(nogrp) !flags for whole group - not currently used in cesm - real, allocatable, public :: x(:), y(:) + integer, public :: npts !< @public number of points for point output + integer, public :: iprt(6) !< @public partitioning grid information + logical, public :: prtfrm !< @public partitioning format flag + logical, public :: flgrd(nogrp,ngrpp) !< @public flags for gridded output + logical, public :: flgr2(nogrp,ngrpp) !< @public flags for coupling output + logical, public :: flgd(nogrp) !< @public flags for whole group - not currently used in cesm + logical, public :: flg2(nogrp) !< @public flags for whole group - not currently used in cesm + real, allocatable, public :: x(:) !< @public x locations for point output + real, allocatable, public :: y(:) !< @public y locations for point output include "mpif.h" !=============================================================================== contains !=============================================================================== - +!> Set IO unit numbers +!! +!! @param[in] stdout unit number for stdout +!! @param[out] mds an array of 13 unit numbers +!! @param[out] ntrace an array of 2 unit numbers used for trace output +!! +!> @author mvertens@ucar.edu, Denise.Worthen@noaa.gov +!> @date 01-05-2022 subroutine set_shel_io(stdout,mds,ntrace) use ESMF, only : ESMF_UtilIOUnitGet @@ -79,13 +98,17 @@ subroutine set_shel_io(stdout,mds,ntrace) ntrace(2) = 10 end subroutine set_shel_io - +!> Set up variables used in shel mode directly (CESM) +!! +!! @param[in] dtime_sync coupling interval in s +!! +!> @author mvertens@ucar.edu, Denise.Worthen@noaa.gov +!> @date 01-05-2022 subroutine set_shel_inp(dtime_sync) use w3idatmd , only : inflags1, inflags2 use w3odatmd , only : noge, idout, nds, notype, iaproc, napout use w3wdatmd , only : time - use wav_shr_mod , only : wav_coupling_to_cice ! Input parameter integer , intent(in) :: dtime_sync @@ -325,6 +348,12 @@ subroutine set_shel_inp(dtime_sync) end subroutine set_shel_inp !=============================================================================== +!> Read ww3_shel.inp (UWM) +!! +!! @param[in] mpi_comm mpi communicator +!! +!> @author mvertens@ucar.edu, Denise.Worthen@noaa.gov +!> @date 01-05-2022 subroutine read_shel_inp(mpi_comm) USE W3GDATMD, ONLY: FLAGLL @@ -437,7 +466,11 @@ subroutine read_shel_inp(mpi_comm) ! If using experimental mud or ice physics, additional lines will ! be read in from ww3_shel.inp and applied, so JFIRST is changed from ! its initialization setting "JFIRST=1" to some lower value. - JFIRST=1 + if (wav_coupling_to_cice) then + JFIRST=-7 + else + JFIRST=1 + end if ! process old ww3_shel.inp format OPEN (NDSI,FILE=TRIM(FNMPRE)//'ww3_shel.inp',STATUS='OLD',IOSTAT=IERR) diff --git a/model/src/wav_shr_mod.F90 b/model/src/wav_shr_mod.F90 index abd1789ed..08b5629f6 100644 --- a/model/src/wav_shr_mod.F90 +++ b/model/src/wav_shr_mod.F90 @@ -1,3 +1,11 @@ +!> @file wav_shr_mod +!! +!> Shared utility routines +!! +!> @details Contains public routines to execute repeated operations +!! +!> @author mvertens@ucar.edu, Denise.Worthen@noaa.gov +!> @date 01-05-2022 module wav_shr_mod use ESMF , only : operator(<), operator(/=), operator(+) @@ -25,81 +33,102 @@ module wav_shr_mod implicit none private - public :: state_getscalar - public :: state_setscalar - public :: state_reset - public :: state_getfldptr - public :: state_fldchk - public :: state_diagnose - public :: alarmInit - public :: chkerr - public :: ymd2date - private :: timeInit - private :: field_getfldptr + public :: state_getscalar !< @public obtain a scalar field from a state + public :: state_setscalar !< @public set scalar data from state for a particular name + public :: state_reset !< @public reset field values in a state + public :: state_getfldptr !< @public obtain a pointer to a field in a state + public :: state_fldchk !< @public check whether a field is in a state + public :: state_diagnose !< @public print min,max,sum and size of a field in a state + public :: alarmInit !< @public set up an alarm in a clock + public :: chkerr !< @public check if an error was returned from and ESMF call + public :: ymd2date !< @public convert year,month,day to integer + private :: timeInit !< @public create an ESMF_Time object + private :: field_getfldptr !< @private obtain a pointer to a field + + interface state_getfldptr + module procedure state_getfldptr_1d + module procedure state_getfldptr_2d + end interface state_getfldptr ! used by both CESM and UFS ! runtype is used by W3SRCE (values are startup, branch, continue) - character(len=cs) , public :: runtype - logical , public :: wav_coupling_to_cice = .false. ! TODO: generalize this - integer , public :: dbug_flag = 0 - character(len=256) , public :: casename - character(len= 36) , public :: time_origin - character(len= 36) , public :: calendar_name - integer(i8) , public :: elapsed_secs + character(len=cs) , public :: runtype !< @public the run type (startup,branch,continue) + logical , public :: wav_coupling_to_cice !< @public flag to specify additional wave export + !! fields for coupling to CICE + integer , public :: dbug_flag = 0 !< @public flag used to produce additional output + character(len=256) , public :: casename !< @public the name pre-prended to an output file + character(len= 36) , public :: time_origin !< @public the time_origin used for netCDF output + character(len= 36) , public :: calendar_name !< @public the calendar used for netCDF output + integer(i8) , public :: elapsed_secs !< @public the time in seconds from the time_origin ! Only used by cesm ! if a run is a startup or branch run, then initfile is used ! to construct the initial file and used in W3IORSMD ! if a run is a continue run, then casename is used to construct ! the restart filename in W3IORSMD - character(len=256) , public :: initfile - logical , public :: rstwr ! true => write restart - logical , public :: histwr ! true => write history file (snapshot) - integer , public :: outfreq ! output frequency in hours - integer , public :: inst_index ! number of current instance (ie. 1) - character(len=16) , public :: inst_name ! fullname of current instance (ie. "wav_0001") - character(len=16) , public :: inst_suffix ! char string associated with instance + character(len=256) , public :: initfile !< @public name of wave initial condition file + logical , public :: rstwr !< @public logical to control restart write. if true => write restart + logical , public :: histwr !< @public logical to control history write. if true => write history file (snapshot) + integer , public :: outfreq !< @public output frequency in hours (TODO: not used?) + integer , public :: inst_index !< @public number of current instance (ie 1) + character(len=16) , public :: inst_name !< @public fullname of current instance (ie "wav_0001") + character(len=16) , public :: inst_suffix !< @public char string associated with instance ! Only used by ufs - logical , public :: merge_import = .false. - logical , public :: multigrid = .false. + logical , public :: merge_import = .false. !< @public logical to specify whether import fields will + !! be merged with a field provided from a file + logical , public :: multigrid = .false. !< @public logical to control whether wave model is run + !! as multigrid interface ymd2date module procedure ymd2date_int module procedure ymd2date_long end interface ymd2date - ! Clock and alarm options + ! Clock and alarm option character(len=*), private, parameter :: & - optNONE = "none" , & - optNever = "never" , & - optNSteps = "nsteps" , & - optNStep = "nstep" , & - optNSeconds = "nseconds" , & - optNSecond = "nsecond" , & - optNMinutes = "nminutes" , & - optNMinute = "nminute" , & - optNHours = "nhours" , & - optNHour = "nhour" , & - optNDays = "ndays" , & - optNDay = "nday" , & - optNMonths = "nmonths" , & - optNMonth = "nmonth" , & - optNYears = "nyears" , & - optNYear = "nyear" , & - optMonthly = "monthly" , & - optYearly = "yearly" , & - optDate = "date" , & - optIfdays0 = "ifdays0" + optNONE = "none" , & !< alarm option none + optNever = "never" , & !< alarm option never + optNSteps = "nsteps" , & !< alarm option nsteps + optNStep = "nstep" , & !< alarm option nstep + optNSeconds = "nseconds" , & !< alarm option nseconds + optNSecond = "nsecond" , & !< alarm option nsecond + optNMinutes = "nminutes" , & !< alarm option nminutes + optNMinute = "nminute" , & !< alarm option nminute + optNHours = "nhours" , & !< alarm option nhours + optNHour = "nhour" , & !< alarm option nhour + optNDays = "ndays" , & !< alarm option ndays + optNDay = "nday" , & !< alarm option nday + optNMonths = "nmonths" , & !< alarm option nmonths + optNMonth = "nmonth" , & !< alarm option nmonth + optNYears = "nyears" , & !< alarm option nyears + optNYear = "nyear" , & !< alarm option nyear + optMonthly = "monthly" , & !< alarm option monthly + optYearly = "yearly" , & !< alarm option yearly + optDate = "date" , & !< alarm option date + optIfdays0 = "ifdays0" !< alarm option for number of days 0 ! Module data - character(len=*), parameter :: u_FILE_u = & + character(len=*), parameter :: u_FILE_u = & !< a character string for an ESMF log message __FILE__ !=============================================================================== contains !=============================================================================== - +!> Get scalar data from a state +!! +!! @details Obtain the field flds_scalar_name from a State and broadcast and +!! it to all PEs +!! +!! @param[in] State an ESMF_State +!! @param[in] scalar_value the value of the scalar +!! @param[in] scalar_id the identity of the scalar +!! @param[in] flds_scalar_name the name of the scalar +!! @param[in] flds_scalar_num the number of scalars +!! @param[out] rc a return code +!! +!> @author mvertens@ucar.edu, Denise.Worthen@noaa.gov +!> @date 01-05-2022 subroutine state_getscalar(state, scalar_id, scalar_value, flds_scalar_name, flds_scalar_num, rc) ! ---------------------------------------------- @@ -151,7 +180,23 @@ subroutine state_getscalar(state, scalar_id, scalar_value, flds_scalar_name, fld end subroutine state_getscalar !================================================================================ - +!> Set scalar data into a state +!! +!! Called by fldlist_realize to set the required scalar data into a state. The +!! scalar_value will be set into a field with name flds_scalar_name. The scalar_id +!! identifies which dimension in the scalar field is given by the scalar_value. The +!! number of scalars is used to ensure that the scalar_id is within the bounds of +!! the scalar field +!! +!! @param[inout] State an ESMF_State +!! @param[in] scalar_value the value of the scalar +!! @param[in] scalar_id the identity of the scalar +!! @param[in] flds_scalar_name the name of the scalar +!! @param[in] flds_scalar_num the number of scalars +!! @param[inout] rc a return code +!! +!> @author mvertens@ucar.edu, Denise.Worthen@noaa.gov +!> @date 01-05-2022 subroutine state_setscalar(scalar_value, scalar_id, State, flds_scalar_name, flds_scalar_num, rc) ! ---------------------------------------------- @@ -199,7 +244,14 @@ subroutine state_setscalar(scalar_value, scalar_id, State, flds_scalar_name, fld end subroutine state_setscalar !=============================================================================== - +!> Reset all fields in a state to a value +!! +!! @param[inout] State an ESMF_State +!! @param[in] reset_value the reset value +!! @param[out] rc a return code +!! +!> @author mvertens@ucar.edu, Denise.Worthen@noaa.gov +!> @date 01-05-2022 subroutine state_reset(State, reset_value, rc) ! ---------------------------------------------- @@ -256,31 +308,33 @@ subroutine state_reset(State, reset_value, rc) end subroutine state_reset !=============================================================================== - subroutine state_getfldptr(State, fldname, fldptr1d, fldptr2d, rc) +!> Obtain a 1-D pointer to a field in a state +!! +!! @param[in] State an ESMF_State +!! @param[in] fldname the name of an ESMF field +!! @param[inout] fldptr a 1-d pointer to an ESMF field +!! @param[out] rc a return code +!! +!> @author mvertens@ucar.edu, Denise.Worthen@noaa.gov +!> @date 01-05-2022 + subroutine state_getfldptr_1d(State, fldname, fldptr, rc) ! ---------------------------------------------- ! Get pointer to a state field ! ---------------------------------------------- - use ESMF , only : ESMF_State, ESMF_Field, ESMF_Mesh, ESMF_FieldStatus_Flag - use ESMF , only : ESMF_StateGet, ESMF_FieldGet, ESMF_MeshGet - use ESMF , only : ESMF_FIELDSTATUS_COMPLETE, ESMF_FAILURE ! input/output variables - type(ESMF_State), intent(in) :: State - character(len=*), intent(in) :: fldname - real(R8), pointer, optional, intent(out) :: fldptr1d(:) - real(R8), pointer, optional, intent(out) :: fldptr2d(:,:) - integer, intent(out) :: rc + type(ESMF_State) , intent(in) :: State + character(len=*) , intent(in) :: fldname + real(R8) , pointer , intent(inout) :: fldptr(:) + integer, optional , intent(out) :: rc ! local variables + type(ESMF_Field) :: lfield type(ESMF_FieldStatus_Flag) :: status - type(ESMF_Field) :: lfield - type(ESMF_Mesh) :: lmesh - integer :: nnodes, nelements - character(len=*), parameter :: subname='(wav_import_export:state_getfldptr)' + character(len=*),parameter :: subname='(wav_import_export:state_getfldptr_1d)' ! ---------------------------------------------- rc = ESMF_SUCCESS - if (dbug_flag > 5) call ESMF_LogWrite(trim(subname)//' called', ESMF_LOGMSG_INFO) call ESMF_StateGet(State, itemName=trim(fldname), field=lfield, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -293,32 +347,66 @@ subroutine state_getfldptr(State, fldname, fldptr1d, fldptr2d, rc) rc = ESMF_FAILURE return else - call ESMF_FieldGet(lfield, mesh=lmesh, rc=rc) + call ESMF_FieldGet(lfield, farrayPtr=fldptr, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if - call ESMF_MeshGet(lmesh, numOwnedNodes=nnodes, numOwnedElements=nelements, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + end subroutine state_getfldptr_1d - if (nnodes == 0 .and. nelements == 0) then - call ESMF_LogWrite(trim(subname)//": no local nodes or elements ", ESMF_LOGMSG_INFO) - rc = ESMF_FAILURE - return - end if + !=============================================================================== +!> Obtain a 2-D pointer to a field in a state +!! +!! @param[in] State an ESMF_State +!! @param[in] fldname the name of an ESMF field +!! @param[inout] fldptr a 2-d pointer to an ESMF field +!! @param[out] rc a return code +!! +!> @author mvertens@ucar.edu, Denise.Worthen@noaa.gov +!> @date 01-05-2022 + subroutine state_getfldptr_2d(State, fldname, fldptr, rc) + ! ---------------------------------------------- + ! Get pointer to a state field + ! ---------------------------------------------- - if (present(fldptr1d)) then - call ESMF_FieldGet(lfield, farrayPtr=fldptr1d, rc=rc) - else ! 2D - call ESMF_FieldGet(lfield, farrayPtr=fldptr2d, rc=rc) - endif + ! input/output variables + type(ESMF_State) , intent(in) :: State + character(len=*) , intent(in) :: fldname + real(R8) , pointer , intent(inout) :: fldptr(:,:) + integer , optional , intent(out) :: rc - if (ChkErr(rc,__LINE__,u_FILE_u)) return - endif ! status + ! local variables + type(ESMF_Field) :: lfield + type(ESMF_FieldStatus_Flag) :: status + character(len=*),parameter :: subname='(wav_import_export:state_getfldptr_2d)' + ! ---------------------------------------------- + + rc = ESMF_SUCCESS - if (dbug_flag > 5) call ESMF_LogWrite(trim(subname)//' done', ESMF_LOGMSG_INFO) + call ESMF_StateGet(State, itemName=trim(fldname), field=lfield, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return - end subroutine state_getfldptr + call ESMF_FieldGet(lfield, status=status, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + if (status /= ESMF_FIELDSTATUS_COMPLETE) then + call ESMF_LogWrite(trim(subname)//": ERROR data not allocated ", ESMF_LOGMSG_INFO, rc=rc) + rc = ESMF_FAILURE + return + else + call ESMF_FieldGet(lfield, farrayPtr=fldptr, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + end subroutine state_getfldptr_2d !=============================================================================== +!> Return true if a field is in a state +!! +!! @param[in] State an ESMF_State +!! @param[in] fldname the name of an ESMF field +!! @return state_fldchk logical indicating a field is present in a state +!! +!> @author mvertens@ucar.edu, Denise.Worthen@noaa.gov +!> @date 01-05-2022 logical function state_fldchk(State, fldname) ! ---------------------------------------------- ! Determine if field is in state @@ -338,7 +426,14 @@ logical function state_fldchk(State, fldname) end function state_fldchk !=============================================================================== - +!> Print minimum, maximum, sum and size for a field in a state +!! +!! @param[in] State an ESMF_State +!! @param[in] string a string for denoting the location of the call +!! @param[out] rc a return code +!! +!> @author mvertens@ucar.edu, Denise.Worthen@noaa.gov +!> @date 01-05-2022 subroutine state_diagnose(State, string, rc) ! ---------------------------------------------- @@ -405,7 +500,17 @@ subroutine state_diagnose(State, string, rc) end subroutine state_diagnose !=============================================================================== - +!> Obtain a 1 or 2-D pointer to a field +!! +!! @param[in] field an ESMF_Field +!! @param[inout] fldptr1 a 1-d pointer to an ESMF field +!! @param[inout] fldptr2 a 2-d pointer to an ESMF field +!! @param[out] rank the field rank +!! @param[in] abort an optional flag to override the default abort value +!! @param[out] rc a return code +!! +!> @author mvertens@ucar.edu, Denise.Worthen@noaa.gov +!> @date 01-05-2022 subroutine field_getfldptr(field, fldptr1, fldptr2, rank, abort, rc) ! ---------------------------------------------- @@ -518,7 +623,24 @@ subroutine field_getfldptr(field, fldptr1, fldptr2, rank, abort, rc) end subroutine field_getfldptr !=============================================================================== - +!> Set up an alarm in a clock +!! +!! @details Create an ESMF_Alarm according to the desired frequency, where the +!! frequency is relative to a time frequency of seconds, days, hours etc. +!! +!! @param[inout] clock an ESMF_Clock +!! @param[inout] alarm an ESMF_Alarm +!! @param[in] option the alarm option (day,hour etc) +!! @param[in] opt_n the alarm frequency +!! @param[in] opt_ymd the YMD, required for alarm_option when option is +!! date +!! @param[in] opt_tod the time-of-day in seconds +!! @param[in] Reftime initial guess of next alarm time +!! @param[in] alarmname the alarm name +!! @param[inout] rc a return code +!! +!> @author mvertens@ucar.edu, Denise.Worthen@noaa.gov +!> @date 01-05-2022 subroutine alarmInit( clock, alarm, option, & opt_n, opt_ymd, opt_tod, RefTime, alarmname, rc) @@ -555,6 +677,7 @@ subroutine alarmInit( clock, alarm, option, & type(ESMF_Time) :: NextAlarm ! Next restart alarm time type(ESMF_TimeInterval) :: AlarmInterval ! Alarm interval integer :: sec + character(len=*), parameter :: subname = ' (wav_shr_mod:set_alarmInit) ' !------------------------------------------------------------------------------- @@ -908,7 +1031,19 @@ subroutine alarmInit( clock, alarm, option, & end subroutine alarmInit !=============================================================================== - +!> Create an ESMF_Time object +!! +!> @details Create a ESMF_Time corresponding to a input time YYYYMMMDD and +!! time of day in seconds +!! +!! @param[inout] Time an ESMF_Time object +!! @param[in] ymd year, month, day YYYYMMDD +!! @param[in] cal an ESMF_Calendar +!! @param[in] tod time of day in secons +!! @param[out] rc a return code +!! +!> @author mvertens@ucar.edu, Denise.Worthen@noaa.gov +!> @date 01-05-2022 subroutine timeInit( Time, ymd, cal, tod, rc) ! Create the ESMF_Time object corresponding to the given input time, @@ -950,7 +1085,15 @@ subroutine timeInit( Time, ymd, cal, tod, rc) end subroutine timeInit !=============================================================================== - +!> Convert year, month, day to integer*4 coded-date +!! +!! @param[in] year calendar year +!! @param[in] month calendary month +!! @param[in] day calendar day +!! @param[out] date calendar date yyyymmmdd +!! +!> @author mvertens@ucar.edu, Denise.Worthen@noaa.gov +!> @date 01-05-2022 subroutine ymd2date_int(year,month,day,date) ! Converts year, month, day to coded-date @@ -964,6 +1107,16 @@ subroutine ymd2date_int(year,month,day,date) if (year < 0) date = -date end subroutine ymd2date_int + !=============================================================================== +!> Converts year, month, day to integer*8 coded-date +!! +!! @param[in] year calendar year +!! @param[in] month calendary month +!! @param[in] day calendar day +!! @param[out] date calendar date yyyymmmdd +!! +!> @author mvertens@ucar.edu, Denise.Worthen@noaa.gov +!> @date 01-05-2022 subroutine ymd2date_long(year,month,day,date) ! Converts year, month, day to coded-date @@ -978,7 +1131,15 @@ subroutine ymd2date_long(year,month,day,date) end subroutine ymd2date_long !=============================================================================== - +!> Return a logical true if ESMF_LogFoundError detects an error +!! +!! @param[in] rc return code +!! @param[in] line source code line number +!! @param[in] file user provided source file name +!! @return chkerr logical indicating an error was found +!! +!> @author mvertens@ucar.edu, Denise.Worthen@noaa.gov +!> @date 01-05-2022 logical function chkerr(rc, line, file) integer, intent(in) :: rc