Merge pull request #11 from mvertens/feature/new_flds_to_cmeps

addition of new fields for cmeps history output

model/src/wav_comp_nuopc.F90

@@ -234,6 +234,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc)
  ! local variables
  character(len=CL) :: logmsg
  logical :: isPresent, isSet
+ logical :: aux_flds_to_cmeps
  character(len=CL) :: cvalue
  character(len=*), parameter :: subname=trim(modName)//':(InitializeAdvertise) '
  !-------------------------------------------------------------------------------
@@ -369,7 +370,18 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc)
  write(logmsg,'(A,l)') trim(subname)//': Wave wav_coupling_to_cice setting is ',wav_coupling_to_cice
  call ESMF_LogWrite(trim(logmsg), ESMF_LOGMSG_INFO)
 
- call advertise_fields(importState, exportState, flds_scalar_name, rc)
+ ! Determine if auxiliary fields will be sent to cmeps for use in mediator history output
+ aux_flds_to_cmeps = .false.
+ call NUOPC_CompAttributeGet(gcomp, name='histaux_wav2med_file1_enabled', value=cvalue, isPresent=isPresent, &
+ isSet=isSet, rc=rc)
+ if (ChkErr(rc,__LINE__,u_FILE_u)) return
+ if (isPresent .and. isSet) then
+ read(cvalue,*) aux_flds_to_cmeps
+ end if
+ write(logmsg,'(A,l)') trim(subname)//': Wave aux_flds_to_cmeps is ',aux_flds_to_cmeps
+ call ESMF_LogWrite(trim(logmsg), ESMF_LOGMSG_INFO)
+
+ call advertise_fields(importState, exportState, flds_scalar_name, aux_flds_to_cmeps, rc)
  if (ChkErr(rc,__LINE__,u_FILE_u)) return
 
  call ESMF_LogWrite(trim(subname)//' done', ESMF_LOGMSG_INFO)
@@ -609,7 +621,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, 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 )
+ call ESMF_TimeGet( startTime, 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)

model/src/wav_import_export.F90

@@ -86,11 +86,12 @@ module wav_import_export
  !!
  !> @author [email protected], [email protected]
  !> @date 01-05-2022
- subroutine advertise_fields(importState, ExportState, flds_scalar_name, rc)
+ subroutine advertise_fields(importState, ExportState, flds_scalar_name, aux_flds_to_cmeps, rc)
  ! input/output variables
  type(ESMF_State) :: importState
  type(ESMF_State) :: exportState
  character(len=*) , intent(in) :: flds_scalar_name
+ logical , intent(in) :: aux_flds_to_cmeps
  integer , intent(out) :: rc
 
  ! local variables
@@ -149,6 +150,17 @@ subroutine advertise_fields(importState, ExportState, flds_scalar_name, rc)
  call fldlist_add(fldsFrWav_num, fldsFrWav, 'Sw_pstokes_x', ungridded_lbound=1, ungridded_ubound=3)
  call fldlist_add(fldsFrWav_num, fldsFrWav, 'Sw_pstokes_y', ungridded_lbound=1, ungridded_ubound=3)
 
+ if (aux_flds_to_cmeps) then
+ ! fields to mediator added only for averged time history capability in mediator history files
+ call fldlist_add(fldsFrWav_num, fldsFrWav, 'Sw_hs')
+ call fldlist_add(fldsFrWav_num, fldsFrWav, 'Sw_wlm')
+ call fldlist_add(fldsFrWav_num, fldsFrWav, 'Sw_thm')
+ call fldlist_add(fldsFrWav_num, fldsFrWav, 'Sw_thp0')
+ call fldlist_add(fldsFrWav_num, fldsFrWav, 'Sw_fp0')
+ call fldlist_add(fldsFrWav_num, fldsFrWav, 'Sw_u')
+ call fldlist_add(fldsFrWav_num, fldsFrWav, 'Sw_v')
+ end if
+
  ! AA TODO: In the above fldlist_add calls, we are passing hardcoded ungridded_ubound values (3) because, USSPF(2)
  ! is not initialized yet. It is set during w3init which gets called at a later phase (realize). A permanent solution
  ! will be implemented soon based on receiving USSP and USSPF from the coupler instead of the mod_def file. This will
@@ -580,7 +592,7 @@ subroutine export_fields (gcomp, rc)
  !---------------------------------------------------------------------------
 
  use wav_kind_mod, only : R8 => SHR_KIND_R8
- use w3adatmd , only : USSX, USSY, USSP
+ use w3adatmd , only : USSX, USSY, USSP, HS, WLM, THM, THP0, FP0, TUSX, TUSY
  use w3adatmd , only : w3seta
  use w3idatmd , only : w3seti
  use w3wdatmd , only : va, w3setw
@@ -604,6 +616,7 @@ subroutine export_fields (gcomp, rc)
  real(R8) :: fillvalue = zero ! special missing value
 #endif
  type(ESMF_State) :: exportState
+ type(ESMF_State) :: importState ! needed if aux history is output by cmeps
  integer :: n, jsea, isea, ix, iy, ib
 
  real(r8), pointer :: z0rlen(:)
@@ -620,6 +633,18 @@ subroutine export_fields (gcomp, rc)
  real(r8), pointer :: sw_vstokes(:)
  real(r8), pointer :: sw_hstokes(:)
 
+ real(r8), pointer :: sw_hs(:)
+ real(r8), pointer :: sw_wlm(:)
+ real(r8), pointer :: sw_thm(:)
+ real(r8), pointer :: sw_thp0(:)
+ real(r8), pointer :: sw_fp0(:)
+ real(r8), pointer :: sw_u(:)
+ real(r8), pointer :: sw_v(:)
+ real(r8), pointer :: sw_tusx(:)
+ real(r8), pointer :: sw_tusy(:)
+ real(r8), pointer :: sa_u(:)
+ real(r8), pointer :: sa_v(:)
+
  ! d2 is location, d1 is frequency - nwav_elev_spectrum frequencies will be used
  real(r8), pointer :: wave_elevation_spectrum(:,:)
 
@@ -633,7 +658,7 @@ subroutine export_fields (gcomp, rc)
  if (dbug_flag > 5) call ESMF_LogWrite(trim(subname)//' called', ESMF_LOGMSG_INFO)
 
  ! Get export state
- call NUOPC_ModelGet(gcomp, exportState=exportState, rc=rc)
+ call NUOPC_ModelGet(gcomp, exportState=exportState, importState=importState, rc=rc)
  if (ChkErr(rc,__LINE__,u_FILE_u)) return
 
 #ifndef W3_CESMCOUPLED
@@ -775,6 +800,147 @@ subroutine export_fields (gcomp, rc)
  end if
  endif
 
+ ! -----------------------------------------------
+ ! for time averaged otuput to CMEPS auxiliary history file(s)
+ ! -----------------------------------------------
+
+ ! Significant wave height
+ if (state_fldchk(exportState, 'Sw_hs')) then
+ call state_getfldptr(exportState, 'Sw_hs', sw_hs, rc=rc)
+ if (ChkErr(rc,__LINE__,u_FILE_u)) return
+ sw_hs(:) = fillvalue
+ do jsea=1, nseal_cpl
+ call init_get_isea(isea, jsea)
+ ix = mapsf(isea,1)
+ iy = mapsf(isea,2)
+ if (mapsta(iy,ix) == 1) then
+ sw_hs(jsea) = HS(jsea)
+ else
+ sw_hs(jsea) = 0.
+ endif
+ enddo
+ end if
+
+ ! Mean wave length
+ if (state_fldchk(exportState, 'Sw_wlm')) then
+ call state_getfldptr(exportState, 'Sw_wlm', sw_wlm, rc=rc)
+ if (ChkErr(rc,__LINE__,u_FILE_u)) return
+ sw_wlm(:) = fillvalue
+ do jsea=1, nseal_cpl
+ call init_get_isea(isea, jsea)
+ ix = mapsf(isea,1)
+ iy = mapsf(isea,2)
+ if (mapsta(iy,ix) == 1) then
+ sw_wlm(jsea) = WLM(jsea)
+ else
+ sw_wlm(jsea) = 0.
+ endif
+ enddo
+ end if
+
+ ! Mean wave direction
+ if (state_fldchk(exportState, 'Sw_thm')) then
+ call state_getfldptr(exportState, 'Sw_thm', sw_thm, rc=rc)
+ if (ChkErr(rc,__LINE__,u_FILE_u)) return
+ sw_thm(:) = fillvalue
+ do jsea=1, nseal_cpl
+ call init_get_isea(isea, jsea)
+ ix = mapsf(isea,1)
+ iy = mapsf(isea,2)
+ if (mapsta(iy,ix) == 1) then
+ sw_thm(jsea) = THM(jsea)
+ else
+ sw_thm(jsea) = 0.
+ endif
+ enddo
+ end if
+
+ ! Peak direction
+ if (state_fldchk(exportState, 'Sw_thp0')) then
+ call state_getfldptr(exportState, 'Sw_thp0', sw_thp0, rc=rc)
+ if (ChkErr(rc,__LINE__,u_FILE_u)) return
+ sw_thp0(:) = fillvalue
+ do jsea=1, nseal_cpl
+ call init_get_isea(isea, jsea)
+ ix = mapsf(isea,1)
+ iy = mapsf(isea,2)
+ if (mapsta(iy,ix) == 1) then
+ sw_thp0(jsea) = THP0(jsea)
+ else
+ sw_thp0(jsea) = 0.
+ endif
+ enddo
+ end if
+
+ ! Peak frequency
+ if (state_fldchk(exportState, 'Sw_fp0')) then
+ call state_getfldptr(exportState, 'Sw_fp0', sw_fp0, rc=rc)
+ if (ChkErr(rc,__LINE__,u_FILE_u)) return
+ sw_fp0(:) = fillvalue
+ do jsea=1, nseal_cpl
+ call init_get_isea(isea, jsea)
+ ix = mapsf(isea,1)
+ iy = mapsf(isea,2)
+ if (mapsta(iy,ix) == 1) then
+ sw_fp0(jsea) = FP0(jsea)
+ else
+ sw_fp0(jsea) = 0.
+ endif
+ enddo
+ end if
+
+ ! Input zonal wind
+ if (state_fldchk(exportState, 'Sw_u') .and. state_fldchk(importState, 'Sa_u')) then
+ call state_getfldptr(importState, 'Sa_u', sa_u, rc=rc)
+ if (ChkErr(rc,__LINE__,u_FILE_u)) return
+ call state_getfldptr(exportState, 'Sw_u', sw_u, rc=rc)
+ if (ChkErr(rc,__LINE__,u_FILE_u)) return
+ sw_u(:) = sa_u(:)
+ end if
+
+ ! Input meridional wind
+ if (state_fldchk(exportState, 'Sw_v') .and. state_fldchk(importState, 'Sa_v')) then
+ call state_getfldptr(importState, 'Sa_v', sa_v, rc=rc)
+ if (ChkErr(rc,__LINE__,u_FILE_u)) return
+ call state_getfldptr(exportState, 'Sw_v', sw_v, rc=rc)
+ if (ChkErr(rc,__LINE__,u_FILE_u)) return
+ sw_v(:) = sa_v(:)
+ end if
+
+ ! Stokes transfer vector zonal
+ if (state_fldchk(exportState, 'Sw_tusx')) then
+ call state_getfldptr(exportState, 'Sw_tusx', sw_tusx, rc=rc)
+ if (ChkErr(rc,__LINE__,u_FILE_u)) return
+ sw_tusx(:) = fillvalue
+ do jsea=1, nseal_cpl
+ call init_get_isea(isea, jsea)
+ ix = mapsf(isea,1)
+ iy = mapsf(isea,2)
+ if (mapsta(iy,ix) == 1) then
+ sw_tusx(jsea) = TUSX(jsea)
+ else
+ sw_tusx(jsea) = 0.
+ endif
+ enddo
+ end if
+
+ ! Stokes transfer vector meridional
+ if (state_fldchk(exportState, 'Sw_tusy')) then
+ call state_getfldptr(exportState, 'Sw_tusy', sw_tusy, rc=rc)
+ if (ChkErr(rc,__LINE__,u_FILE_u)) return
+ sw_tusy(:) = fillvalue
+ do jsea=1, nseal_cpl
+ call init_get_isea(isea, jsea)
+ ix = mapsf(isea,1)
+ iy = mapsf(isea,2)
+ if (mapsta(iy,ix) == 1) then
+ sw_tusy(jsea) = TUSY(jsea)
+ else
+ sw_tusy(jsea) = 0.
+ endif
+ enddo
+ end if
+
  if (dbug_flag > 5) then
  call state_diagnose(exportState, 'at export ', rc=rc)
  if (ChkErr(rc,__LINE__,u_FILE_u)) return
@@ -1046,8 +1212,8 @@ subroutine CalcRoughl ( wrln)
  ix = mapsf(isea,1)
  iy = mapsf(isea,2)
  if ( firstCall ) then
- if(( runtype == 'initial' .and. mapsta(iy,ix) == 1 ) .or. &
-  ( runtype == 'continue' .and. abs(mapsta(iy,ix)) == 1 )) then
+ if (( runtype == 'initial' .and. mapsta(iy,ix) == 1 ) .or. &
+ ( runtype == 'continue' .and. abs(mapsta(iy,ix)) == 1 )) then
  charn(jsea) = zero
  llws(:) = .true.
  ustar = zero