From 25511a668ef3e5c2bd66ebe63be5c9ef9b11493c Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sun, 3 Dec 2023 22:15:14 +0100 Subject: [PATCH 1/5] removed -999 values from mediator history files --- model/src/wav_comp_nuopc.F90 | 14 +-- model/src/wav_import_export.F90 | 176 +++++++++++++++++++++++++++++--- 2 files changed, 162 insertions(+), 28 deletions(-) diff --git a/model/src/wav_comp_nuopc.F90 b/model/src/wav_comp_nuopc.F90 index fbf9450b0..2d1c62ca2 100644 --- a/model/src/wav_comp_nuopc.F90 +++ b/model/src/wav_comp_nuopc.F90 @@ -234,7 +234,6 @@ 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) ' !------------------------------------------------------------------------------- @@ -370,18 +369,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) write(logmsg,'(A,l)') trim(subname)//': Wave wav_coupling_to_cice setting is ',wav_coupling_to_cice call ESMF_LogWrite(trim(logmsg), ESMF_LOGMSG_INFO) - ! Determine 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) + call advertise_fields(importState, exportState, flds_scalar_name, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_LogWrite(trim(subname)//' done', ESMF_LOGMSG_INFO) diff --git a/model/src/wav_import_export.F90 b/model/src/wav_import_export.F90 index c8e27b9fa..9a6b97df0 100644 --- a/model/src/wav_import_export.F90 +++ b/model/src/wav_import_export.F90 @@ -86,17 +86,17 @@ module wav_import_export !! !> @author mvertens@ucar.edu, Denise.Worthen@noaa.gov !> @date 01-05-2022 - subroutine advertise_fields(importState, ExportState, flds_scalar_name, aux_flds_to_cmeps, rc) + subroutine advertise_fields(importState, ExportState, flds_scalar_name, 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 integer :: n, num character(len=2) :: fvalue + logical :: aux_flds_to_cmeps = .true. character(len=*), parameter :: subname='(wav_import_export:advertise_fields)' !------------------------------------------------------------------------------- @@ -153,12 +153,20 @@ subroutine advertise_fields(importState, ExportState, flds_scalar_name, aux_flds 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_phs0') + call fldlist_add(fldsFrWav_num, fldsFrWav, 'Sw_phs1') + call fldlist_add(fldsFrWav_num, fldsFrWav, 'Sw_pdir0') + call fldlist_add(fldsFrWav_num, fldsFrWav, 'Sw_pdir1') + call fldlist_add(fldsFrWav_num, fldsFrWav, 'Sw_pTm10') + call fldlist_add(fldsFrWav_num, fldsFrWav, 'Sw_pTm11') + call fldlist_add(fldsFrWav_num, fldsFrWav, 'Sw_Tm1') 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') + call fldlist_add(fldsFrWav_num, fldsFrWav, 'Sw_tusx') + call fldlist_add(fldsFrWav_num, fldsFrWav, 'Sw_tusy') end if ! AA TODO: In the above fldlist_add calls, we are passing hardcoded ungridded_ubound values (3) because, USSPF(2) @@ -592,11 +600,12 @@ subroutine export_fields (gcomp, rc) !--------------------------------------------------------------------------- use wav_kind_mod, only : R8 => SHR_KIND_R8 - use w3adatmd , only : USSX, USSY, USSP, HS, WLM, THM, THP0, FP0, TUSX, TUSY + use w3adatmd , only : USSX, USSY, USSP, HS, THM, FP0, THP0, TUSX, TUSY + use w3adatmd , only : PHS, PDIR, T01, PT1 use w3adatmd , only : w3seta use w3idatmd , only : w3seti use w3wdatmd , only : va, w3setw - use w3odatmd , only : w3seto, naproc, iaproc + use w3odatmd , only : w3seto, naproc, iaproc, NOSWLL use w3gdatmd , only : nseal, mapsf, MAPSTA, USSPF, NK, w3setg use w3iogomd , only : CALC_U3STOKES #ifdef W3_CESMCOUPLED @@ -604,6 +613,7 @@ subroutine export_fields (gcomp, rc) #else use wmmdatmd , only : mdse, mdst, wmsetm #endif + use constants , only : UNDEF ! input/output/variables type(ESMF_GridComp) :: gcomp @@ -617,7 +627,7 @@ subroutine export_fields (gcomp, rc) #endif type(ESMF_State) :: exportState type(ESMF_State) :: importState ! needed if aux history is output by cmeps - integer :: n, jsea, isea, ix, iy, ib + integer :: n, jsea, isea, ix, iy, ib, ik real(r8), pointer :: z0rlen(:) real(r8), pointer :: charno(:) @@ -634,7 +644,13 @@ subroutine export_fields (gcomp, rc) real(r8), pointer :: sw_hstokes(:) real(r8), pointer :: sw_hs(:) - real(r8), pointer :: sw_wlm(:) + real(r8), pointer :: sw_phs0(:) + real(r8), pointer :: sw_phs1(:) + real(r8), pointer :: sw_pdir0(:) + real(r8), pointer :: sw_pdir1(:) + real(r8), pointer :: sw_pTm10(:) + real(r8), pointer :: sw_pTm11(:) + real(r8), pointer :: sw_Tm1(:) real(r8), pointer :: sw_thm(:) real(r8), pointer :: sw_thp0(:) real(r8), pointer :: sw_fp0(:) @@ -651,6 +667,12 @@ subroutine export_fields (gcomp, rc) ! Partitioned stokes drift real(r8), pointer :: sw_pstokes_x(:,:) real(r8), pointer :: sw_pstokes_y(:,:) + + type(ESMF_Clock) :: clock + type(ESMF_Time) :: currtime, nexttime + integer :: yr,mon,day,sec ! time units + integer :: yr_next,mon_next,day_next,sec_next ! time units + character(len=*), parameter :: subname='(wav_import_export:export_fields)' !--------------------------------------------------------------------------- @@ -661,6 +683,19 @@ subroutine export_fields (gcomp, rc) call NUOPC_ModelGet(gcomp, exportState=exportState, importState=importState, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_GridCompGet(gcomp, exportState=exportstate, clock=clock, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_ClockGet(clock, currtime=currtime, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_TimeGet(currtime, yy=yr, mm=mon, dd=day, s=sec, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_ClockGetNextTime(clock, nextTime=nexttime, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_TimeGet(nexttime, yy=yr_next, mm=mon_next, dd=day_next, s=sec_next, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + write(6,*)'DEBUG: mon_next,day_next,sec_next = ',mon_next,day_next,sec_next + #ifndef W3_CESMCOUPLED call w3setg ( 1, mdse, mdst ) call w3setw ( 1, mdse, mdst ) @@ -821,19 +856,129 @@ subroutine export_fields (gcomp, rc) enddo end if - ! Mean wave length - if (state_fldchk(exportState, 'Sw_wlm')) then - call state_getfldptr(exportState, 'Sw_wlm', sw_wlm, rc=rc) + ! Wind Sea siginificant wave height = Partition 0 of HS + if (state_fldchk(exportState, 'Sw_phs0')) then + call state_getfldptr(exportState, 'Sw_phs0', sw_phs0, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - sw_wlm(:) = fillvalue + sw_phs0(:) = 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) + if (PHS(jsea,0) /= UNDEF) then + sw_phs0(jsea) = PHS(jsea,0) + end if else - sw_wlm(jsea) = 0. + sw_phs0(jsea) = 0. + endif + enddo + end if + ! Swell siginificant wave height = Partition 1 of HS if NOSWLL=1 + if (state_fldchk(exportState, 'Sw_phs1')) then + call state_getfldptr(exportState, 'Sw_phs1', sw_phs1, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + sw_phs1(:) = 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 + if (PHS(jsea,NOSWLL) /= UNDEF) then + sw_phs1(jsea) = PHS(jsea,NOSWLL) + end if + else + sw_phs1(jsea) = 0. + endif + enddo + end if + + ! Wind sea mean direction = Partition 0 of DIR + if (state_fldchk(exportState, 'Sw_pdir0')) then + call state_getfldptr(exportState, 'Sw_pdir0', sw_pdir0, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + sw_pdir0(:) = 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 + if (PDIR(jsea,0) /= UNDEF) then + sw_pdir0(jsea) = PDIR(jsea,0) + end if + else + sw_pdir0(jsea) = 0. + endif + enddo + end if + ! Swell mean direction = Partition 1 of DIR if NOSWLL=1 + if (state_fldchk(exportState, 'Sw_pdir1')) then + call state_getfldptr(exportState, 'Sw_pdir1', sw_pdir1, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + sw_pdir1(:) = 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 + if (PDIR(jsea,NOSWLL) /= UNDEF) then + sw_pdir1(jsea) = PDIR(jsea,NOSWLL) + end if + else + sw_pdir1(jsea) = 0. + endif + enddo + end if + + ! Wind sea first moment period + if (state_fldchk(exportState, 'Sw_pTm10')) then + call state_getfldptr(exportState, 'Sw_pTm10', sw_pTm10, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + sw_pTm10(:) = 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 + if (PT1(jsea,0) /= UNDEF) then + sw_pTm10(jsea) = PT1(jsea,0) + end if + else + sw_pTm10(jsea) = 0. + endif + enddo + end if + ! Swell first moment period, if NOSWLL=1 + if (state_fldchk(exportState, 'Sw_pTm11')) then + call state_getfldptr(exportState, 'Sw_pTm11', sw_pTm11, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + sw_pTm11(:) = 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 + if (PT1(jsea,NOSWLL) /= UNDEF) then + sw_pTm11(jsea) = PT1(jsea,NOSWLL) + end if + else + sw_pTm11(jsea) = 0. + endif + enddo + end if + ! Mean first moment period + if (state_fldchk(exportState, 'Sw_Tm1')) then + call state_getfldptr(exportState, 'Sw_Tm1', sw_Tm1, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + sw_Tm1(:) = 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_Tm1(jsea) = T01(jsea) + else + sw_Tm1(jsea) = 0. endif enddo end if @@ -907,7 +1052,7 @@ subroutine export_fields (gcomp, rc) sw_v(:) = sa_v(:) end if - ! Stokes transfer vector zonal + ! Stokes transport u component 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 @@ -924,7 +1069,7 @@ subroutine export_fields (gcomp, rc) enddo end if - ! Stokes transfer vector meridional + ! Stokes transport v component 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 @@ -1854,4 +1999,5 @@ subroutine readfromfile (idfld, wxdata, wydata, time0, timen, rc) if (dbug_flag > 5) call ESMF_LogWrite(trim(subname)//' done', ESMF_LOGMSG_INFO) end subroutine readfromfile + end module wav_import_export From f4bb2a0e5387be804682a7c7d86c5318e581baa4 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Mon, 4 Dec 2023 15:53:17 +0100 Subject: [PATCH 2/5] updates to average over partitions where the UNDEF values can change over time --- model/src/wav_import_export.F90 | 178 +++++++++++++++++++++++++------- 1 file changed, 143 insertions(+), 35 deletions(-) diff --git a/model/src/wav_import_export.F90 b/model/src/wav_import_export.F90 index 9a6b97df0..4c7ea3ab1 100644 --- a/model/src/wav_import_export.F90 +++ b/model/src/wav_import_export.F90 @@ -68,6 +68,21 @@ module wav_import_export character(*),parameter :: u_FILE_u = & !< a character string for an ESMF log message __FILE__ + real(r8), allocatable :: accum_sw_phs0(:) + integer , allocatable :: counter_sw_phs0(:) + real(r8), allocatable :: accum_sw_phs1(:) + integer , allocatable :: counter_sw_phs1(:) + + real(r8), allocatable :: accum_sw_pdir0(:) + integer , allocatable :: counter_sw_pdir0(:) + real(r8), allocatable :: accum_sw_pdir1(:) + integer , allocatable :: counter_sw_pdir1(:) + + real(r8), allocatable :: accum_sw_pTm10(:) + integer , allocatable :: counter_sw_pTm10(:) + real(r8), allocatable :: accum_sw_pTm11(:) + integer , allocatable :: counter_sw_pTm11(:) + !=============================================================================== contains !=============================================================================== @@ -694,8 +709,6 @@ subroutine export_fields (gcomp, rc) call ESMF_TimeGet(nexttime, yy=yr_next, mm=mon_next, dd=day_next, s=sec_next, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - write(6,*)'DEBUG: mon_next,day_next,sec_next = ',mon_next,day_next,sec_next - #ifndef W3_CESMCOUPLED call w3setg ( 1, mdse, mdst ) call w3setw ( 1, mdse, mdst ) @@ -858,6 +871,13 @@ subroutine export_fields (gcomp, rc) ! Wind Sea siginificant wave height = Partition 0 of HS if (state_fldchk(exportState, 'Sw_phs0')) then + if (.not. allocated(counter_sw_phs0)) then + allocate(counter_sw_phs0(nseal_cpl)) + counter_sw_phs0(:) = 0 + allocate(accum_sw_phs0(nseal_cpl)) + accum_sw_phs0(:) = 0._r8 + end if + call state_getfldptr(exportState, 'Sw_phs0', sw_phs0, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return sw_phs0(:) = fillvalue @@ -866,16 +886,33 @@ subroutine export_fields (gcomp, rc) ix = mapsf(isea,1) iy = mapsf(isea,2) if (mapsta(iy,ix) == 1) then + ! Note that UNDEF is -999.9 if (PHS(jsea,0) /= UNDEF) then - sw_phs0(jsea) = PHS(jsea,0) + counter_sw_phs0(jsea) = counter_sw_phs0(jsea) + 1 + accum_sw_phs0(jsea) = accum_sw_phs0(jsea) + PHS(jsea,0) + end if + if (sec_next == 0) then + if (counter_sw_phs0(jsea) /= 0) then + sw_phs0(jsea) = accum_sw_phs0(jsea) / counter_sw_phs0(jsea) + end if + counter_sw_phs0(jsea) = 0 + accum_sw_phs0(jsea) = 0._r8 end if else sw_phs0(jsea) = 0. endif enddo end if + ! Swell siginificant wave height = Partition 1 of HS if NOSWLL=1 if (state_fldchk(exportState, 'Sw_phs1')) then + if (.not. allocated(counter_sw_phs1)) then + allocate(counter_sw_phs1(nseal_cpl)) + counter_sw_phs1(:) = 0 + allocate(accum_sw_phs1(nseal_cpl)) + accum_sw_phs1(:) = 0._r8 + end if + call state_getfldptr(exportState, 'Sw_phs1', sw_phs1, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return sw_phs1(:) = fillvalue @@ -885,7 +922,15 @@ subroutine export_fields (gcomp, rc) iy = mapsf(isea,2) if (mapsta(iy,ix) == 1) then if (PHS(jsea,NOSWLL) /= UNDEF) then - sw_phs1(jsea) = PHS(jsea,NOSWLL) + counter_sw_phs1(jsea) = counter_sw_phs1(jsea) + 1 + accum_sw_phs1(jsea) = accum_sw_phs1(jsea) + PHS(jsea,NOSWLL) + end if + if (sec_next == 0) then + if (counter_sw_phs1(jsea) /= 0) then + sw_phs1(jsea) = accum_sw_phs1(jsea) / counter_sw_phs1(jsea) + end if + counter_sw_phs1(jsea) = 0 + accum_sw_phs1(jsea) = 0._r8 end if else sw_phs1(jsea) = 0. @@ -895,6 +940,13 @@ subroutine export_fields (gcomp, rc) ! Wind sea mean direction = Partition 0 of DIR if (state_fldchk(exportState, 'Sw_pdir0')) then + if (.not. allocated(counter_sw_pdir0)) then + allocate(counter_sw_pdir0(nseal_cpl)) + counter_sw_pdir0(:) = 0 + allocate(accum_sw_pdir0(nseal_cpl)) + accum_sw_pdir0(:) = 0._r8 + end if + call state_getfldptr(exportState, 'Sw_pdir0', sw_pdir0, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return sw_pdir0(:) = fillvalue @@ -904,15 +956,31 @@ subroutine export_fields (gcomp, rc) iy = mapsf(isea,2) if (mapsta(iy,ix) == 1) then if (PDIR(jsea,0) /= UNDEF) then - sw_pdir0(jsea) = PDIR(jsea,0) + counter_sw_pdir0(jsea) = counter_sw_pdir0(jsea) + 1 + accum_sw_pdir0(jsea) = accum_sw_pdir0(jsea) + PDIR(jsea,0) + end if + if (sec_next == 0) then + if (counter_sw_pdir0(jsea) /= 0) then + sw_pdir0(jsea) = accum_sw_pdir0(jsea) / counter_sw_pdir0(jsea) + end if + counter_sw_pdir0(jsea) = 0 + accum_sw_pdir0(jsea) = 0._r8 end if else sw_pdir0(jsea) = 0. endif enddo end if + ! Swell mean direction = Partition 1 of DIR if NOSWLL=1 if (state_fldchk(exportState, 'Sw_pdir1')) then + if (.not. allocated(counter_sw_pdir1)) then + allocate(counter_sw_pdir1(nseal_cpl)) + counter_sw_pdir1(:) = 0 + allocate(accum_sw_pdir1(nseal_cpl)) + accum_sw_pdir1(:) = 0._r8 + end if + call state_getfldptr(exportState, 'Sw_pdir1', sw_pdir1, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return sw_pdir1(:) = fillvalue @@ -922,7 +990,15 @@ subroutine export_fields (gcomp, rc) iy = mapsf(isea,2) if (mapsta(iy,ix) == 1) then if (PDIR(jsea,NOSWLL) /= UNDEF) then - sw_pdir1(jsea) = PDIR(jsea,NOSWLL) + counter_sw_pdir1(jsea) = counter_sw_pdir1(jsea) + 1 + accum_sw_pdir1(jsea) = accum_sw_pdir1(jsea) + PDIR(jsea,NOSWLL) + end if + if (sec_next == 0) then + if (counter_sw_pdir1(jsea) /= 0) then + sw_pdir1(jsea) = accum_sw_pdir1(jsea) / counter_sw_pdir1(jsea) + end if + counter_sw_pdir1(jsea) = 0 + accum_sw_pdir1(jsea) = 0._r8 end if else sw_pdir1(jsea) = 0. @@ -932,40 +1008,72 @@ subroutine export_fields (gcomp, rc) ! Wind sea first moment period if (state_fldchk(exportState, 'Sw_pTm10')) then - call state_getfldptr(exportState, 'Sw_pTm10', sw_pTm10, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - sw_pTm10(:) = 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 - if (PT1(jsea,0) /= UNDEF) then - sw_pTm10(jsea) = PT1(jsea,0) - end if - else - sw_pTm10(jsea) = 0. - endif - enddo + if (.not. allocated(counter_sw_pTm10)) then + allocate(counter_sw_pTm10(nseal_cpl)) + counter_sw_pTm10(:) = 0 + allocate(accum_sw_pTm10(nseal_cpl)) + accum_sw_pTm10(:) = 0._r8 + end if + + call state_getfldptr(exportState, 'Sw_pTm10', sw_pTm10, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + sw_pTm10(:) = 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 + if (PT1(jsea,0) /= UNDEF) then + counter_sw_pTm10(jsea) = counter_sw_pTm10(jsea) + 1 + accum_sw_pTm10(jsea) = accum_sw_pTm10(jsea) + PT1(jsea,0) + end if + if (sec_next == 0) then + if (counter_sw_pTm10(jsea) /= 0) then + sw_pTm10(jsea) = accum_sw_pTm10(jsea) / counter_sw_pTm10(jsea) + end if + counter_sw_pTm10(jsea) = 0 + accum_sw_pTm10(jsea) = 0._r8 + end if + else + sw_pTm10(jsea) = 0. + endif + enddo end if + ! Swell first moment period, if NOSWLL=1 if (state_fldchk(exportState, 'Sw_pTm11')) then - call state_getfldptr(exportState, 'Sw_pTm11', sw_pTm11, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - sw_pTm11(:) = 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 - if (PT1(jsea,NOSWLL) /= UNDEF) then - sw_pTm11(jsea) = PT1(jsea,NOSWLL) + if (.not. allocated(counter_sw_pTm11)) then + allocate(counter_sw_pTm11(nseal_cpl)) + counter_sw_pTm11(:) = 0 + allocate(accum_sw_pTm11(nseal_cpl)) + accum_sw_pTm11(:) = 0._r8 + end if + + call state_getfldptr(exportState, 'Sw_pTm11', sw_pTm11, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + sw_pTm11(:) = 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 + if (PT1(jsea,NOSWLL) /= UNDEF) then + counter_sw_pTM11(jsea) = counter_sw_pTm11(jsea) + 1 + accum_sw_pTm11(jsea) = accum_sw_pTm11(jsea) + PT1(jsea,NOSWLL) + end if + if (sec_next == 0) then + if (counter_sw_pTm11(jsea) /= 0) then + sw_pTm11(jsea) = accum_sw_pTm11(jsea) / counter_sw_pTm11(jsea) end if - else - sw_pTm11(jsea) = 0. - endif - enddo + counter_sw_pTm11(jsea) = 0 + accum_sw_pTm11(jsea) = 0._r8 + end if + else + sw_pTm11(jsea) = 0. + endif + enddo end if + ! Mean first moment period if (state_fldchk(exportState, 'Sw_Tm1')) then call state_getfldptr(exportState, 'Sw_Tm1', sw_Tm1, rc=rc) From da6f509e3d01cf4bb7534db3baa5d7a3ac08fde3 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Mon, 4 Dec 2023 19:28:29 +0100 Subject: [PATCH 3/5] changes for new swell cmeps auxiliary file --- model/src/wav_comp_nuopc.F90 | 14 +++++++++++++- model/src/wav_import_export.F90 | 6 +++--- 2 files changed, 16 insertions(+), 4 deletions(-) diff --git a/model/src/wav_comp_nuopc.F90 b/model/src/wav_comp_nuopc.F90 index 2d1c62ca2..fbf9450b0 100644 --- a/model/src/wav_comp_nuopc.F90 +++ b/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) diff --git a/model/src/wav_import_export.F90 b/model/src/wav_import_export.F90 index 4c7ea3ab1..66135d555 100644 --- a/model/src/wav_import_export.F90 +++ b/model/src/wav_import_export.F90 @@ -101,17 +101,17 @@ module wav_import_export !! !> @author mvertens@ucar.edu, Denise.Worthen@noaa.gov !> @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 + logical , intent(in) :: aux_flds_to_cmeps character(len=*) , intent(in) :: flds_scalar_name integer , intent(out) :: rc ! local variables integer :: n, num character(len=2) :: fvalue - logical :: aux_flds_to_cmeps = .true. character(len=*), parameter :: subname='(wav_import_export:advertise_fields)' !------------------------------------------------------------------------------- @@ -122,7 +122,7 @@ subroutine advertise_fields(importState, ExportState, flds_scalar_name, rc) ! Advertise import fields !-------------------------------- - !call fldlist_add(fldsToWav_num, fldsToWav, 'So_h' ) + !call fldlist_add(fldsToWav_num, fldsToWav, 'So_h' ) call fldlist_add(fldsToWav_num, fldsToWav, 'Si_ifrac' ) call fldlist_add(fldsToWav_num, fldsToWav, 'So_u' ) call fldlist_add(fldsToWav_num, fldsToWav, 'So_v' ) From f2ca3d3cb2efd535d9bb197785497251ce7b3c6c Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Tue, 5 Dec 2023 15:41:13 +0100 Subject: [PATCH 4/5] refactored how averaging is done for fields sent to mediator for auxiliary file output --- model/src/wav_import_export.F90 | 721 +++++++++++++++++++++----------- 1 file changed, 486 insertions(+), 235 deletions(-) diff --git a/model/src/wav_import_export.F90 b/model/src/wav_import_export.F90 index 66135d555..a308d3fc7 100644 --- a/model/src/wav_import_export.F90 +++ b/model/src/wav_import_export.F90 @@ -68,20 +68,40 @@ module wav_import_export character(*),parameter :: u_FILE_u = & !< a character string for an ESMF log message __FILE__ - real(r8), allocatable :: accum_sw_phs0(:) - integer , allocatable :: counter_sw_phs0(:) - real(r8), allocatable :: accum_sw_phs1(:) - integer , allocatable :: counter_sw_phs1(:) - - real(r8), allocatable :: accum_sw_pdir0(:) - integer , allocatable :: counter_sw_pdir0(:) - real(r8), allocatable :: accum_sw_pdir1(:) - integer , allocatable :: counter_sw_pdir1(:) - - real(r8), allocatable :: accum_sw_pTm10(:) - integer , allocatable :: counter_sw_pTm10(:) - real(r8), allocatable :: accum_sw_pTm11(:) - integer , allocatable :: counter_sw_pTm11(:) + real(r8), allocatable :: accum_ustokes_avg(:) + integer , allocatable :: counter_ustokes_avg(:) + real(r8), allocatable :: accum_vstokes_avg(:) + integer , allocatable :: counter_vstokes_avg(:) + real(r8), allocatable :: accum_hs_avg(:) + integer , allocatable :: counter_hs_avg(:) + real(r8), allocatable :: accum_phs0_avg(:) + integer , allocatable :: counter_phs0_avg(:) + real(r8), allocatable :: accum_phs1_avg(:) + integer , allocatable :: counter_phs1_avg(:) + real(r8), allocatable :: accum_pdir0_avg(:) + integer , allocatable :: counter_pdir0_avg(:) + real(r8), allocatable :: accum_pdir1_avg(:) + integer , allocatable :: counter_pdir1_avg(:) + real(r8), allocatable :: accum_pTm10_avg(:) + integer , allocatable :: counter_pTm10_avg(:) + real(r8), allocatable :: accum_pTm11_avg(:) + integer , allocatable :: counter_pTm11_avg(:) + real(r8), allocatable :: accum_tm1_avg(:) + integer , allocatable :: counter_tm1_avg(:) + real(r8), allocatable :: accum_thm_avg(:) + integer , allocatable :: counter_thm_avg(:) + real(r8), allocatable :: accum_thp0_avg(:) + integer , allocatable :: counter_thp0_avg(:) + real(r8), allocatable :: accum_fp0_avg(:) + integer , allocatable :: counter_fp0_avg(:) + real(r8), allocatable :: accum_u_avg(:) + integer , allocatable :: counter_u_avg(:) + real(r8), allocatable :: accum_v_avg(:) + integer , allocatable :: counter_v_avg(:) + real(r8), allocatable :: accum_tusx_avg(:) + integer , allocatable :: counter_tusx_avg(:) + real(r8), allocatable :: accum_tusy_avg(:) + integer , allocatable :: counter_tusy_avg(:) !=============================================================================== contains @@ -166,22 +186,26 @@ subroutine advertise_fields(importState, ExportState, flds_scalar_name, aux_flds 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_phs0') - call fldlist_add(fldsFrWav_num, fldsFrWav, 'Sw_phs1') - call fldlist_add(fldsFrWav_num, fldsFrWav, 'Sw_pdir0') - call fldlist_add(fldsFrWav_num, fldsFrWav, 'Sw_pdir1') - call fldlist_add(fldsFrWav_num, fldsFrWav, 'Sw_pTm10') - call fldlist_add(fldsFrWav_num, fldsFrWav, 'Sw_pTm11') - call fldlist_add(fldsFrWav_num, fldsFrWav, 'Sw_Tm1') - 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') - call fldlist_add(fldsFrWav_num, fldsFrWav, 'Sw_tusx') - call fldlist_add(fldsFrWav_num, fldsFrWav, 'Sw_tusy') + ! fields to mediator added only for outputting daily time averged time wave fields in mediator + ! auxilary file + ! NOTE: that assumption of daily is used here and is hard-wired into the code + call fldlist_add(fldsFrWav_num, fldsFrWav, 'Sw_ustokes_avg') + call fldlist_add(fldsFrWav_num, fldsFrWav, 'Sw_vstokes_avg') + call fldlist_add(fldsFrWav_num, fldsFrWav, 'Sw_hs_avg') + call fldlist_add(fldsFrWav_num, fldsFrWav, 'Sw_phs0_avg') + call fldlist_add(fldsFrWav_num, fldsFrWav, 'Sw_phs1_avg') + call fldlist_add(fldsFrWav_num, fldsFrWav, 'Sw_pdir0_avg') + call fldlist_add(fldsFrWav_num, fldsFrWav, 'Sw_pdir1_avg') + call fldlist_add(fldsFrWav_num, fldsFrWav, 'Sw_pTm10_avg') + call fldlist_add(fldsFrWav_num, fldsFrWav, 'Sw_pTm11_avg') + call fldlist_add(fldsFrWav_num, fldsFrWav, 'Sw_Tm1_avg') + call fldlist_add(fldsFrWav_num, fldsFrWav, 'Sw_thm_avg') + call fldlist_add(fldsFrWav_num, fldsFrWav, 'Sw_thp0_avg') + call fldlist_add(fldsFrWav_num, fldsFrWav, 'Sw_fp0_avg') + call fldlist_add(fldsFrWav_num, fldsFrWav, 'Sw_u_avg') + call fldlist_add(fldsFrWav_num, fldsFrWav, 'Sw_v_avg') + call fldlist_add(fldsFrWav_num, fldsFrWav, 'Sw_tusx_avg') + call fldlist_add(fldsFrWav_num, fldsFrWav, 'Sw_tusy_avg') end if ! AA TODO: In the above fldlist_add calls, we are passing hardcoded ungridded_ubound values (3) because, USSPF(2) @@ -658,21 +682,24 @@ subroutine export_fields (gcomp, rc) real(r8), pointer :: sw_vstokes(:) real(r8), pointer :: sw_hstokes(:) - real(r8), pointer :: sw_hs(:) - real(r8), pointer :: sw_phs0(:) - real(r8), pointer :: sw_phs1(:) - real(r8), pointer :: sw_pdir0(:) - real(r8), pointer :: sw_pdir1(:) - real(r8), pointer :: sw_pTm10(:) - real(r8), pointer :: sw_pTm11(:) - real(r8), pointer :: sw_Tm1(:) - 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 :: sw_ustokes_avg(:) + real(r8), pointer :: sw_vstokes_avg(:) + real(r8), pointer :: sw_hs_avg(:) + real(r8), pointer :: sw_phs0_avg(:) + real(r8), pointer :: sw_phs1_avg(:) + real(r8), pointer :: sw_pdir0_avg(:) + real(r8), pointer :: sw_pdir1_avg(:) + real(r8), pointer :: sw_pTm10_avg(:) + real(r8), pointer :: sw_pTm11_avg(:) + real(r8), pointer :: sw_Tm1_avg(:) + real(r8), pointer :: sw_thm_avg(:) + real(r8), pointer :: sw_thp0_avg(:) + real(r8), pointer :: sw_fp0_avg(:) + real(r8), pointer :: sw_tusx_avg(:) + real(r8), pointer :: sw_tusy_avg(:) + real(r8), pointer :: sw_u_avg(:) + real(r8), pointer :: sw_v_avg(:) + real(r8), pointer :: sa_u(:) real(r8), pointer :: sa_v(:) @@ -751,6 +778,7 @@ subroutine export_fields (gcomp, rc) endif enddo end if + if (state_fldchk(exportState, 'Sw_vstokes')) then call state_getfldptr(exportState, 'Sw_vstokes', sw_vstokes, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -851,355 +879,578 @@ subroutine export_fields (gcomp, rc) ! ----------------------------------------------- ! for time averaged otuput to CMEPS auxiliary history file(s) ! ----------------------------------------------- + ! Note that UNDEF is -999.9 - ! Significant wave height - if (state_fldchk(exportState, 'Sw_hs')) then - call state_getfldptr(exportState, 'Sw_hs', sw_hs, rc=rc) + ! surface stokes drift + if (state_fldchk(exportState, 'Sw_ustokes_avg')) then + if (.not. allocated(counter_ustokes_avg)) then + allocate(counter_ustokes_avg(nseal_cpl)) + counter_ustokes_avg(:) = 0 + allocate(accum_ustokes_avg(nseal_cpl)) + accum_ustokes_avg(:) = 0._r8 + end if + call state_getfldptr(exportState, 'Sw_ustokes_avg', sw_ustokes_avg, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - sw_hs(:) = fillvalue + sw_ustokes_avg(:) = fillvalue do jsea=1, nseal_cpl call init_get_isea(isea, jsea) - ix = mapsf(isea,1) - iy = mapsf(isea,2) + ix = mapsf(isea,1) + iy = mapsf(isea,2) if (mapsta(iy,ix) == 1) then - sw_hs(jsea) = HS(jsea) + if (USSX(jsea) /= UNDEF) then + counter_ustokes_avg(jsea) = counter_ustokes_avg(jsea) + 1 + accum_ustokes_avg(jsea) = accum_ustokes_avg(jsea) + USSX(jsea) + end if + if (sec_next == 0) then + if (counter_ustokes_avg(jsea) /= 0) then + sw_ustokes_avg(jsea) = accum_ustokes_avg(jsea) / counter_ustokes_avg(jsea) + end if + counter_ustokes_avg(jsea) = 0 + accum_ustokes_avg(jsea) = 0._r8 + end if else - sw_hs(jsea) = 0. + sw_ustokes_avg(jsea) = 0. endif enddo end if - ! Wind Sea siginificant wave height = Partition 0 of HS - if (state_fldchk(exportState, 'Sw_phs0')) then - if (.not. allocated(counter_sw_phs0)) then - allocate(counter_sw_phs0(nseal_cpl)) - counter_sw_phs0(:) = 0 - allocate(accum_sw_phs0(nseal_cpl)) - accum_sw_phs0(:) = 0._r8 + if (state_fldchk(exportState, 'Sw_vstokes_avg')) then + if (.not. allocated(counter_vstokes_avg)) then + allocate(counter_vstokes_avg(nseal_cpl)) + counter_vstokes_avg(:) = 0 + allocate(accum_vstokes_avg(nseal_cpl)) + accum_vstokes_avg(:) = 0._r8 end if + call state_getfldptr(exportState, 'Sw_vstokes_avg', sw_vstokes_avg, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + sw_vstokes_avg(:) = 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 + if (USSY(jsea) /= UNDEF) then + counter_vstokes_avg(jsea) = counter_vstokes_avg(jsea) + 1 + accum_vstokes_avg(jsea) = accum_vstokes_avg(jsea) + USSY(jsea) + end if + if (sec_next == 0) then + if (counter_vstokes_avg(jsea) /= 0) then + sw_vstokes_avg(jsea) = accum_vstokes_avg(jsea) / counter_vstokes_avg(jsea) + end if + counter_vstokes_avg(jsea) = 0 + accum_vstokes_avg(jsea) = 0._r8 + end if + else + sw_vstokes_avg(jsea) = 0. + endif + enddo + end if - call state_getfldptr(exportState, 'Sw_phs0', sw_phs0, rc=rc) + ! Significant wave height + if (state_fldchk(exportState, 'Sw_hs_avg')) then + if (.not. allocated(counter_hs_avg)) then + allocate(counter_hs_avg(nseal_cpl)) + counter_hs_avg(:) = 0 + allocate(accum_hs_avg(nseal_cpl)) + accum_hs_avg(:) = 0._r8 + end if + call state_getfldptr(exportState, 'Sw_hs_avg', sw_hs_avg, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + sw_hs_avg(:) = 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 + if (HS(jsea) /= UNDEF) then + counter_hs_avg(jsea) = counter_hs_avg(jsea) + 1 + accum_hs_avg(jsea) = accum_hs_avg(jsea) + HS(jsea) + end if + if (sec_next == 0) then + if (counter_hs_avg(jsea) /= 0) then + sw_hs_avg(jsea) = accum_hs_avg(jsea) / counter_hs_avg(jsea) + end if + counter_hs_avg(jsea) = 0 + accum_hs_avg(jsea) = 0._r8 + end if + else + sw_hs_avg(jsea) = 0. + endif + enddo + end if + + ! Wind Sea siginificant wave height = Partition 0 of HS + if (state_fldchk(exportState, 'Sw_phs0_avg')) then + if (.not. allocated(counter_phs0_avg)) then + allocate(counter_phs0_avg(nseal_cpl)) + counter_phs0_avg(:) = 0 + allocate(accum_phs0_avg(nseal_cpl)) + accum_phs0_avg(:) = 0._r8 + end if + call state_getfldptr(exportState, 'Sw_phs0_avg', sw_phs0_avg, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - sw_phs0(:) = fillvalue + sw_phs0_avg(:) = 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 - ! Note that UNDEF is -999.9 - if (PHS(jsea,0) /= UNDEF) then - counter_sw_phs0(jsea) = counter_sw_phs0(jsea) + 1 - accum_sw_phs0(jsea) = accum_sw_phs0(jsea) + PHS(jsea,0) - end if - if (sec_next == 0) then - if (counter_sw_phs0(jsea) /= 0) then - sw_phs0(jsea) = accum_sw_phs0(jsea) / counter_sw_phs0(jsea) - end if - counter_sw_phs0(jsea) = 0 - accum_sw_phs0(jsea) = 0._r8 - end if + if (PHS(jsea,0) /= UNDEF) then + counter_phs0_avg(jsea) = counter_phs0_avg(jsea) + 1 + accum_phs0_avg(jsea) = accum_phs0_avg(jsea) + PHS(jsea,0) + end if + if (sec_next == 0) then + if (counter_phs0_avg(jsea) /= 0) then + sw_phs0_avg(jsea) = accum_phs0_avg(jsea) / counter_phs0_avg(jsea) + end if + counter_phs0_avg(jsea) = 0 + accum_phs0_avg(jsea) = 0._r8 + end if else - sw_phs0(jsea) = 0. + sw_phs0_avg(jsea) = 0. endif enddo end if ! Swell siginificant wave height = Partition 1 of HS if NOSWLL=1 - if (state_fldchk(exportState, 'Sw_phs1')) then - if (.not. allocated(counter_sw_phs1)) then - allocate(counter_sw_phs1(nseal_cpl)) - counter_sw_phs1(:) = 0 - allocate(accum_sw_phs1(nseal_cpl)) - accum_sw_phs1(:) = 0._r8 + if (state_fldchk(exportState, 'Sw_phs1_avg')) then + if (.not. allocated(counter_phs1_avg)) then + allocate(counter_phs1_avg(nseal_cpl)) + counter_phs1_avg(:) = 0 + allocate(accum_phs1_avg(nseal_cpl)) + accum_phs1_avg(:) = 0._r8 end if - - call state_getfldptr(exportState, 'Sw_phs1', sw_phs1, rc=rc) + call state_getfldptr(exportState, 'Sw_phs1_avg', sw_phs1_avg, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - sw_phs1(:) = fillvalue + sw_phs1_avg(:) = 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 - if (PHS(jsea,NOSWLL) /= UNDEF) then - counter_sw_phs1(jsea) = counter_sw_phs1(jsea) + 1 - accum_sw_phs1(jsea) = accum_sw_phs1(jsea) + PHS(jsea,NOSWLL) - end if - if (sec_next == 0) then - if (counter_sw_phs1(jsea) /= 0) then - sw_phs1(jsea) = accum_sw_phs1(jsea) / counter_sw_phs1(jsea) - end if - counter_sw_phs1(jsea) = 0 - accum_sw_phs1(jsea) = 0._r8 - end if + if (PHS(jsea,NOSWLL) /= UNDEF) then + counter_phs1_avg(jsea) = counter_phs1_avg(jsea) + 1 + accum_phs1_avg(jsea) = accum_phs1_avg(jsea) + PHS(jsea,NOSWLL) + end if + if (sec_next == 0) then + if (counter_phs1_avg(jsea) /= 0) then + sw_phs1_avg(jsea) = accum_phs1_avg(jsea) / counter_phs1_avg(jsea) + end if + counter_phs1_avg(jsea) = 0 + accum_phs1_avg(jsea) = 0._r8 + end if else - sw_phs1(jsea) = 0. + sw_phs1_avg(jsea) = 0. endif enddo end if ! Wind sea mean direction = Partition 0 of DIR - if (state_fldchk(exportState, 'Sw_pdir0')) then - if (.not. allocated(counter_sw_pdir0)) then - allocate(counter_sw_pdir0(nseal_cpl)) - counter_sw_pdir0(:) = 0 - allocate(accum_sw_pdir0(nseal_cpl)) - accum_sw_pdir0(:) = 0._r8 + if (state_fldchk(exportState, 'Sw_pdir0_avg')) then + if (.not. allocated(counter_pdir0_avg)) then + allocate(counter_pdir0_avg(nseal_cpl)) + counter_pdir0_avg(:) = 0 + allocate(accum_pdir0_avg(nseal_cpl)) + accum_pdir0_avg(:) = 0._r8 end if - - call state_getfldptr(exportState, 'Sw_pdir0', sw_pdir0, rc=rc) + call state_getfldptr(exportState, 'Sw_pdir0_avg', sw_pdir0_avg, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - sw_pdir0(:) = fillvalue + sw_pdir0_avg(:) = 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 - if (PDIR(jsea,0) /= UNDEF) then - counter_sw_pdir0(jsea) = counter_sw_pdir0(jsea) + 1 - accum_sw_pdir0(jsea) = accum_sw_pdir0(jsea) + PDIR(jsea,0) - end if - if (sec_next == 0) then - if (counter_sw_pdir0(jsea) /= 0) then - sw_pdir0(jsea) = accum_sw_pdir0(jsea) / counter_sw_pdir0(jsea) - end if - counter_sw_pdir0(jsea) = 0 - accum_sw_pdir0(jsea) = 0._r8 - end if + if (PDIR(jsea,0) /= UNDEF) then + counter_pdir0_avg(jsea) = counter_pdir0_avg(jsea) + 1 + accum_pdir0_avg(jsea) = accum_pdir0_avg(jsea) + PDIR(jsea,0) + end if + if (sec_next == 0) then + if (counter_pdir0_avg(jsea) /= 0) then + sw_pdir0_avg(jsea) = accum_pdir0_avg(jsea) / counter_pdir0_avg(jsea) + end if + counter_pdir0_avg(jsea) = 0 + accum_pdir0_avg(jsea) = 0._r8 + end if else - sw_pdir0(jsea) = 0. + sw_pdir0_avg(jsea) = 0. endif enddo end if ! Swell mean direction = Partition 1 of DIR if NOSWLL=1 - if (state_fldchk(exportState, 'Sw_pdir1')) then - if (.not. allocated(counter_sw_pdir1)) then - allocate(counter_sw_pdir1(nseal_cpl)) - counter_sw_pdir1(:) = 0 - allocate(accum_sw_pdir1(nseal_cpl)) - accum_sw_pdir1(:) = 0._r8 + if (state_fldchk(exportState, 'Sw_pdir1_avg')) then + if (.not. allocated(counter_pdir1_avg)) then + allocate(counter_pdir1_avg(nseal_cpl)) + counter_pdir1_avg(:) = 0 + allocate(accum_pdir1_avg(nseal_cpl)) + accum_pdir1_avg(:) = 0._r8 end if - - call state_getfldptr(exportState, 'Sw_pdir1', sw_pdir1, rc=rc) + call state_getfldptr(exportState, 'Sw_pdir1_avg', sw_pdir1_avg, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - sw_pdir1(:) = fillvalue + sw_pdir1_avg(:) = 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 if (PDIR(jsea,NOSWLL) /= UNDEF) then - counter_sw_pdir1(jsea) = counter_sw_pdir1(jsea) + 1 - accum_sw_pdir1(jsea) = accum_sw_pdir1(jsea) + PDIR(jsea,NOSWLL) + counter_pdir1_avg(jsea) = counter_pdir1_avg(jsea) + 1 + accum_pdir1_avg(jsea) = accum_pdir1_avg(jsea) + PDIR(jsea,NOSWLL) end if if (sec_next == 0) then - if (counter_sw_pdir1(jsea) /= 0) then - sw_pdir1(jsea) = accum_sw_pdir1(jsea) / counter_sw_pdir1(jsea) - end if - counter_sw_pdir1(jsea) = 0 - accum_sw_pdir1(jsea) = 0._r8 + if (counter_pdir1_avg(jsea) /= 0) then + sw_pdir1_avg(jsea) = accum_pdir1_avg(jsea) / counter_pdir1_avg(jsea) + end if + counter_pdir1_avg(jsea) = 0 + accum_pdir1_avg(jsea) = 0._r8 end if else - sw_pdir1(jsea) = 0. + sw_pdir1_avg(jsea) = 0. endif enddo end if ! Wind sea first moment period - if (state_fldchk(exportState, 'Sw_pTm10')) then - if (.not. allocated(counter_sw_pTm10)) then - allocate(counter_sw_pTm10(nseal_cpl)) - counter_sw_pTm10(:) = 0 - allocate(accum_sw_pTm10(nseal_cpl)) - accum_sw_pTm10(:) = 0._r8 - end if - - call state_getfldptr(exportState, 'Sw_pTm10', sw_pTm10, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - sw_pTm10(:) = 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 - if (PT1(jsea,0) /= UNDEF) then - counter_sw_pTm10(jsea) = counter_sw_pTm10(jsea) + 1 - accum_sw_pTm10(jsea) = accum_sw_pTm10(jsea) + PT1(jsea,0) - end if - if (sec_next == 0) then - if (counter_sw_pTm10(jsea) /= 0) then - sw_pTm10(jsea) = accum_sw_pTm10(jsea) / counter_sw_pTm10(jsea) - end if - counter_sw_pTm10(jsea) = 0 - accum_sw_pTm10(jsea) = 0._r8 - end if - else - sw_pTm10(jsea) = 0. - endif - enddo + if (state_fldchk(exportState, 'Sw_pTm10_avg')) then + if (.not. allocated(counter_pTm10_avg)) then + allocate(counter_pTm10_avg(nseal_cpl)) + counter_pTm10_avg(:) = 0 + allocate(accum_pTm10_avg(nseal_cpl)) + accum_pTm10_avg(:) = 0._r8 + end if + call state_getfldptr(exportState, 'Sw_pTm10_avg', sw_pTm10_avg, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + sw_pTm10_avg(:) = 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 + if (PT1(jsea,0) /= UNDEF) then + counter_pTm10_avg(jsea) = counter_pTm10_avg(jsea) + 1 + accum_pTm10_avg(jsea) = accum_pTm10_avg(jsea) + PT1(jsea,0) + end if + if (sec_next == 0) then + if (counter_pTm10_avg(jsea) /= 0) then + sw_pTm10_avg(jsea) = accum_pTm10_avg(jsea) / counter_pTm10_avg(jsea) + end if + counter_pTm10_avg(jsea) = 0 + accum_pTm10_avg(jsea) = 0._r8 + end if + else + sw_pTm10_avg(jsea) = 0. + endif + enddo end if ! Swell first moment period, if NOSWLL=1 - if (state_fldchk(exportState, 'Sw_pTm11')) then - if (.not. allocated(counter_sw_pTm11)) then - allocate(counter_sw_pTm11(nseal_cpl)) - counter_sw_pTm11(:) = 0 - allocate(accum_sw_pTm11(nseal_cpl)) - accum_sw_pTm11(:) = 0._r8 - end if - - call state_getfldptr(exportState, 'Sw_pTm11', sw_pTm11, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - sw_pTm11(:) = 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 - if (PT1(jsea,NOSWLL) /= UNDEF) then - counter_sw_pTM11(jsea) = counter_sw_pTm11(jsea) + 1 - accum_sw_pTm11(jsea) = accum_sw_pTm11(jsea) + PT1(jsea,NOSWLL) - end if - if (sec_next == 0) then - if (counter_sw_pTm11(jsea) /= 0) then - sw_pTm11(jsea) = accum_sw_pTm11(jsea) / counter_sw_pTm11(jsea) - end if - counter_sw_pTm11(jsea) = 0 - accum_sw_pTm11(jsea) = 0._r8 - end if - else - sw_pTm11(jsea) = 0. - endif - enddo + if (state_fldchk(exportState, 'Sw_pTm11_avg')) then + if (.not. allocated(counter_pTm11_avg)) then + allocate(counter_pTm11_avg(nseal_cpl)) + counter_pTm11_avg(:) = 0 + allocate(accum_pTm11_avg(nseal_cpl)) + accum_pTm11_avg(:) = 0._r8 + end if + call state_getfldptr(exportState, 'Sw_pTm11_avg', sw_pTm11_avg, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + sw_pTm11_avg(:) = 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 + if (PT1(jsea,NOSWLL) /= UNDEF) then + counter_pTm11_avg(jsea) = counter_pTm11_avg(jsea) + 1 + accum_pTm11_avg(jsea) = accum_pTm11_avg(jsea) + PT1(jsea,NOSWLL) + end if + if (sec_next == 0) then + if (counter_pTm11_avg(jsea) /= 0) then + sw_pTm11_avg(jsea) = accum_pTm11_avg(jsea) / counter_pTm11_avg(jsea) + end if + counter_pTm11_avg(jsea) = 0 + accum_pTm11_avg(jsea) = 0._r8 + end if + else + sw_pTm11_avg(jsea) = 0. + endif + enddo end if ! Mean first moment period - if (state_fldchk(exportState, 'Sw_Tm1')) then - call state_getfldptr(exportState, 'Sw_Tm1', sw_Tm1, rc=rc) + if (state_fldchk(exportState, 'Sw_Tm1_avg')) then + if (.not. allocated(counter_Tm1_avg)) then + allocate(counter_Tm1_avg(nseal_cpl)) + counter_Tm1_avg(:) = 0 + allocate(accum_Tm1_avg(nseal_cpl)) + accum_Tm1_avg(:) = 0._r8 + end if + call state_getfldptr(exportState, 'Sw_Tm1_avg', sw_Tm1_avg, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - sw_Tm1(:) = fillvalue + sw_Tm1_avg(:) = 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_Tm1(jsea) = T01(jsea) + if (T01(jsea) /= UNDEF) then + counter_Tm1_avg(jsea) = counter_Tm1_avg(jsea) + 1 + accum_Tm1_avg(jsea) = accum_Tm1_avg(jsea) + T01(jsea) + end if + if (sec_next == 0) then + if (counter_Tm1_avg(jsea) /= 0) then + sw_Tm1_avg(jsea) = accum_Tm1_avg(jsea) / counter_Tm1_avg(jsea) + end if + counter_Tm1_avg(jsea) = 0 + accum_Tm1_avg(jsea) = 0._r8 + end if else - sw_Tm1(jsea) = 0. + sw_Tm1_avg(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 (state_fldchk(exportState, 'Sw_thm_avg')) then + if (.not. allocated(counter_thm_avg)) then + allocate(counter_thm_avg(nseal_cpl)) + counter_thm_avg(:) = 0 + allocate(accum_thm_avg(nseal_cpl)) + accum_thm_avg(:) = 0._r8 + end if + call state_getfldptr(exportState, 'Sw_thm_avg', sw_thm_avg, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - sw_thm(:) = fillvalue + sw_thm_avg(:) = 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) + if (THM(jsea) /= UNDEF) then + counter_thm_avg(jsea) = counter_thm_avg(jsea) + 1 + accum_thm_avg(jsea) = accum_thm_avg(jsea) + THM(jsea) + end if + if (sec_next == 0) then + if (counter_thm_avg(jsea) /= 0) then + sw_thm_avg(jsea) = accum_thm_avg(jsea) / counter_thm_avg(jsea) + end if + counter_thm_avg(jsea) = 0 + accum_thm_avg(jsea) = 0._r8 + end if else - sw_thm(jsea) = 0. + sw_thm_avg(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 (state_fldchk(exportState, 'Sw_thp0_avg')) then + if (.not. allocated(counter_thp0_avg)) then + allocate(counter_thp0_avg(nseal_cpl)) + counter_thp0_avg(:) = 0 + allocate(accum_thp0_avg(nseal_cpl)) + accum_thp0_avg(:) = 0._r8 + end if + call state_getfldptr(exportState, 'Sw_thp0_avg', sw_thp0_avg, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - sw_thp0(:) = fillvalue + sw_thp0_avg(:) = 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) + if (THP0(jsea) /= UNDEF) then + counter_thp0_avg(jsea) = counter_thp0_avg(jsea) + 1 + accum_thp0_avg(jsea) = accum_thp0_avg(jsea) + THP0(jsea) + end if + if (sec_next == 0) then + if (counter_thp0_avg(jsea) /= 0) then + sw_thp0_avg(jsea) = accum_thp0_avg(jsea) / counter_thp0_avg(jsea) + end if + counter_thp0_avg(jsea) = 0 + accum_thp0_avg(jsea) = 0._r8 + end if else - sw_thp0(jsea) = 0. + sw_thp0_avg(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 (state_fldchk(exportState, 'Sw_fp0_avg')) then + if (.not. allocated(counter_fp0_avg)) then + allocate(counter_fp0_avg(nseal_cpl)) + counter_fp0_avg(:) = 0 + allocate(accum_fp0_avg(nseal_cpl)) + accum_fp0_avg(:) = 0._r8 + end if + call state_getfldptr(exportState, 'Sw_fp0_avg', sw_fp0_avg, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - sw_fp0(:) = fillvalue + sw_fp0_avg(:) = 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) + if (FP0(jsea) /= UNDEF) then + counter_fp0_avg(jsea) = counter_fp0_avg(jsea) + 1 + accum_fp0_avg(jsea) = accum_fp0_avg(jsea) + FP0(jsea) + end if + if (sec_next == 0) then + if (counter_fp0_avg(jsea) /= 0) then + sw_fp0_avg(jsea) = accum_fp0_avg(jsea) / counter_fp0_avg(jsea) + end if + counter_fp0_avg(jsea) = 0 + accum_fp0_avg(jsea) = 0._r8 + end if else - sw_fp0(jsea) = 0. + sw_fp0_avg(jsea) = 0. endif enddo end if ! Input zonal wind - if (state_fldchk(exportState, 'Sw_u') .and. state_fldchk(importState, 'Sa_u')) then + if (state_fldchk(exportState, 'Sw_u_avg') .and. state_fldchk(importState, 'Sa_u')) then + if (.not. allocated(counter_u_avg)) then + allocate(counter_u_avg(nseal_cpl)) + counter_u_avg(:) = 0 + allocate(accum_u_avg(nseal_cpl)) + accum_u_avg(:) = 0._r8 + end if 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) + call state_getfldptr(exportState, 'Sw_u_avg', sw_u_avg, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - sw_u(:) = sa_u(:) + sw_u_avg(:) = 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 + if (sa_u(jsea) /= UNDEF) then + counter_u_avg(jsea) = counter_u_avg(jsea) + 1 + accum_u_avg(jsea) = accum_u_avg(jsea) + sa_u(jsea) + end if + if (sec_next == 0) then + if (counter_u_avg(jsea) /= 0) then + sw_u_avg(jsea) = accum_u_avg(jsea) / counter_u_avg(jsea) + end if + counter_u_avg(jsea) = 0 + accum_u_avg(jsea) = 0._r8 + end if + else + sw_u_avg(:) = sa_u(:) + end if + end do end if ! Input meridional wind - if (state_fldchk(exportState, 'Sw_v') .and. state_fldchk(importState, 'Sa_v')) then + if (state_fldchk(exportState, 'Sw_v_avg') .and. state_fldchk(importState, 'Sa_v')) then + if (.not. allocated(counter_v_avg)) then + allocate(counter_v_avg(nseal_cpl)) + counter_v_avg(:) = 0 + allocate(accum_v_avg(nseal_cpl)) + accum_v_avg(:) = 0._r8 + end if 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) + call state_getfldptr(exportState, 'Sw_v_avg', sw_v_avg, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - sw_v(:) = sa_v(:) + sw_v_avg(:) = 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 + if (sa_v(jsea) /= UNDEF) then + counter_v_avg(jsea) = counter_v_avg(jsea) + 1 + accum_v_avg(jsea) = accum_v_avg(jsea) + sa_v(jsea) + end if + if (sec_next == 0) then + if (counter_v_avg(jsea) /= 0) then + sw_v_avg(jsea) = accum_v_avg(jsea) / counter_v_avg(jsea) + end if + counter_v_avg(jsea) = 0 + accum_v_avg(jsea) = 0._r8 + end if + else + sw_v_avg(:) = sa_v(:) + end if + end do end if ! Stokes transport u component - if (state_fldchk(exportState, 'Sw_tusx')) then - call state_getfldptr(exportState, 'Sw_tusx', sw_tusx, rc=rc) + if (state_fldchk(exportState, 'Sw_tusx_avg')) then + if (.not. allocated(counter_tusx_avg)) then + allocate(counter_tusx_avg(nseal_cpl)) + counter_tusx_avg(:) = 0 + allocate(accum_tusx_avg(nseal_cpl)) + accum_tusx_avg(:) = 0._r8 + end if + call state_getfldptr(exportState, 'Sw_tusx_avg', sw_tusx_avg, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - sw_tusx(:) = fillvalue + sw_tusx_avg(:) = 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) + if (TUSX(jsea) /= UNDEF) then + counter_tusx_avg(jsea) = counter_tusx_avg(jsea) + 1 + accum_tusx_avg(jsea) = accum_tusx_avg(jsea) + TUSX(jsea) + end if + if (sec_next == 0) then + if (counter_tusx_avg(jsea) /= 0) then + sw_tusx_avg(jsea) = accum_tusx_avg(jsea) / counter_tusx_avg(jsea) + end if + counter_tusx_avg(jsea) = 0 + accum_tusx_avg(jsea) = 0._r8 + end if else - sw_tusx(jsea) = 0. + sw_tusx_avg(jsea) = 0. endif enddo end if ! Stokes transport v component - if (state_fldchk(exportState, 'Sw_tusy')) then - call state_getfldptr(exportState, 'Sw_tusy', sw_tusy, rc=rc) + if (state_fldchk(exportState, 'Sw_tusy_avg')) then + if (.not. allocated(counter_tusy_avg)) then + allocate(counter_tusy_avg(nseal_cpl)) + counter_tusy_avg(:) = 0 + allocate(accum_tusy_avg(nseal_cpl)) + accum_tusy_avg(:) = 0._r8 + end if + call state_getfldptr(exportState, 'Sw_tusy_avg', sw_tusy_avg, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - sw_tusy(:) = fillvalue + sw_tusy_avg(:) = 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) + if (TUSY(jsea) /= UNDEF) then + counter_tusy_avg(jsea) = counter_tusy_avg(jsea) + 1 + accum_tusy_avg(jsea) = accum_tusy_avg(jsea) + TUSY(jsea) + end if + if (sec_next == 0) then + if (counter_tusy_avg(jsea) /= 0) then + sw_tusy_avg(jsea) = accum_tusy_avg(jsea) / counter_tusy_avg(jsea) + end if + counter_tusy_avg(jsea) = 0 + accum_tusy_avg(jsea) = 0._r8 + end if else - sw_tusy(jsea) = 0. + sw_tusy_avg(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 + call state_diagnose(exportState, 'at export ', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return end if - end subroutine export_fields + end subroutine export_fields !=============================================================================== !> Add a fieldname to a list of fields in a state From 489562616dd1702ccc9565f209f0b0b0ec06da7b Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Thu, 7 Dec 2023 22:41:26 +0100 Subject: [PATCH 5/5] addressed comments in PR review --- model/src/wav_import_export.F90 | 590 +++++--------------------------- 1 file changed, 94 insertions(+), 496 deletions(-) diff --git a/model/src/wav_import_export.F90 b/model/src/wav_import_export.F90 index a308d3fc7..a8786f1ee 100644 --- a/model/src/wav_import_export.F90 +++ b/model/src/wav_import_export.F90 @@ -103,6 +103,8 @@ module wav_import_export real(r8), allocatable :: accum_tusy_avg(:) integer , allocatable :: counter_tusy_avg(:) + private :: accumulate + !=============================================================================== contains !=============================================================================== @@ -682,24 +684,6 @@ subroutine export_fields (gcomp, rc) real(r8), pointer :: sw_vstokes(:) real(r8), pointer :: sw_hstokes(:) - real(r8), pointer :: sw_ustokes_avg(:) - real(r8), pointer :: sw_vstokes_avg(:) - real(r8), pointer :: sw_hs_avg(:) - real(r8), pointer :: sw_phs0_avg(:) - real(r8), pointer :: sw_phs1_avg(:) - real(r8), pointer :: sw_pdir0_avg(:) - real(r8), pointer :: sw_pdir1_avg(:) - real(r8), pointer :: sw_pTm10_avg(:) - real(r8), pointer :: sw_pTm11_avg(:) - real(r8), pointer :: sw_Tm1_avg(:) - real(r8), pointer :: sw_thm_avg(:) - real(r8), pointer :: sw_thp0_avg(:) - real(r8), pointer :: sw_fp0_avg(:) - real(r8), pointer :: sw_tusx_avg(:) - real(r8), pointer :: sw_tusy_avg(:) - real(r8), pointer :: sw_u_avg(:) - real(r8), pointer :: sw_v_avg(:) - real(r8), pointer :: sa_u(:) real(r8), pointer :: sa_v(:) @@ -710,11 +694,11 @@ subroutine export_fields (gcomp, rc) real(r8), pointer :: sw_pstokes_x(:,:) real(r8), pointer :: sw_pstokes_y(:,:) - type(ESMF_Clock) :: clock - type(ESMF_Time) :: currtime, nexttime - integer :: yr,mon,day,sec ! time units - integer :: yr_next,mon_next,day_next,sec_next ! time units - + type(ESMF_Clock) :: clock + type(ESMF_Time) :: currtime, nexttime + integer :: yr,mon,day,sec ! time units + integer :: yr_next,mon_next,day_next,sec_next ! time units + real(r8), pointer :: dataptr(:) character(len=*), parameter :: subname='(wav_import_export:export_fields)' !--------------------------------------------------------------------------- @@ -883,500 +867,110 @@ subroutine export_fields (gcomp, rc) ! surface stokes drift if (state_fldchk(exportState, 'Sw_ustokes_avg')) then - if (.not. allocated(counter_ustokes_avg)) then - allocate(counter_ustokes_avg(nseal_cpl)) - counter_ustokes_avg(:) = 0 - allocate(accum_ustokes_avg(nseal_cpl)) - accum_ustokes_avg(:) = 0._r8 - end if - call state_getfldptr(exportState, 'Sw_ustokes_avg', sw_ustokes_avg, rc=rc) + call state_getfldptr(exportState, 'Sw_ustokes_avg', dataptr, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - sw_ustokes_avg(:) = 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 - if (USSX(jsea) /= UNDEF) then - counter_ustokes_avg(jsea) = counter_ustokes_avg(jsea) + 1 - accum_ustokes_avg(jsea) = accum_ustokes_avg(jsea) + USSX(jsea) - end if - if (sec_next == 0) then - if (counter_ustokes_avg(jsea) /= 0) then - sw_ustokes_avg(jsea) = accum_ustokes_avg(jsea) / counter_ustokes_avg(jsea) - end if - counter_ustokes_avg(jsea) = 0 - accum_ustokes_avg(jsea) = 0._r8 - end if - else - sw_ustokes_avg(jsea) = 0. - endif - enddo + call accumulate(dataptr, counter_ustokes_avg, accum_ustokes_avg, sec_next, fillvalue, USSX) end if if (state_fldchk(exportState, 'Sw_vstokes_avg')) then - if (.not. allocated(counter_vstokes_avg)) then - allocate(counter_vstokes_avg(nseal_cpl)) - counter_vstokes_avg(:) = 0 - allocate(accum_vstokes_avg(nseal_cpl)) - accum_vstokes_avg(:) = 0._r8 - end if - call state_getfldptr(exportState, 'Sw_vstokes_avg', sw_vstokes_avg, rc=rc) + call state_getfldptr(exportState, 'Sw_vstokes_avg', dataptr, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - sw_vstokes_avg(:) = 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 - if (USSY(jsea) /= UNDEF) then - counter_vstokes_avg(jsea) = counter_vstokes_avg(jsea) + 1 - accum_vstokes_avg(jsea) = accum_vstokes_avg(jsea) + USSY(jsea) - end if - if (sec_next == 0) then - if (counter_vstokes_avg(jsea) /= 0) then - sw_vstokes_avg(jsea) = accum_vstokes_avg(jsea) / counter_vstokes_avg(jsea) - end if - counter_vstokes_avg(jsea) = 0 - accum_vstokes_avg(jsea) = 0._r8 - end if - else - sw_vstokes_avg(jsea) = 0. - endif - enddo + call accumulate(dataptr, counter_vstokes_avg, accum_vstokes_avg, sec_next, fillvalue, USSY) end if ! Significant wave height if (state_fldchk(exportState, 'Sw_hs_avg')) then - if (.not. allocated(counter_hs_avg)) then - allocate(counter_hs_avg(nseal_cpl)) - counter_hs_avg(:) = 0 - allocate(accum_hs_avg(nseal_cpl)) - accum_hs_avg(:) = 0._r8 - end if - call state_getfldptr(exportState, 'Sw_hs_avg', sw_hs_avg, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - sw_hs_avg(:) = 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 - if (HS(jsea) /= UNDEF) then - counter_hs_avg(jsea) = counter_hs_avg(jsea) + 1 - accum_hs_avg(jsea) = accum_hs_avg(jsea) + HS(jsea) - end if - if (sec_next == 0) then - if (counter_hs_avg(jsea) /= 0) then - sw_hs_avg(jsea) = accum_hs_avg(jsea) / counter_hs_avg(jsea) - end if - counter_hs_avg(jsea) = 0 - accum_hs_avg(jsea) = 0._r8 - end if - else - sw_hs_avg(jsea) = 0. - endif - enddo + call state_getfldptr(exportState, 'Sw_hs_avg', dataptr, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call accumulate(dataptr, counter_hs_avg, accum_hs_avg, sec_next, fillvalue, HS) end if ! Wind Sea siginificant wave height = Partition 0 of HS if (state_fldchk(exportState, 'Sw_phs0_avg')) then - if (.not. allocated(counter_phs0_avg)) then - allocate(counter_phs0_avg(nseal_cpl)) - counter_phs0_avg(:) = 0 - allocate(accum_phs0_avg(nseal_cpl)) - accum_phs0_avg(:) = 0._r8 - end if - call state_getfldptr(exportState, 'Sw_phs0_avg', sw_phs0_avg, rc=rc) + call state_getfldptr(exportState, 'Sw_phs0_avg', dataptr, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - sw_phs0_avg(:) = 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 - if (PHS(jsea,0) /= UNDEF) then - counter_phs0_avg(jsea) = counter_phs0_avg(jsea) + 1 - accum_phs0_avg(jsea) = accum_phs0_avg(jsea) + PHS(jsea,0) - end if - if (sec_next == 0) then - if (counter_phs0_avg(jsea) /= 0) then - sw_phs0_avg(jsea) = accum_phs0_avg(jsea) / counter_phs0_avg(jsea) - end if - counter_phs0_avg(jsea) = 0 - accum_phs0_avg(jsea) = 0._r8 - end if - else - sw_phs0_avg(jsea) = 0. - endif - enddo + call accumulate(dataptr, counter_phs0_avg, accum_phs0_avg, sec_next, fillvalue, PHS(:,0)) end if ! Swell siginificant wave height = Partition 1 of HS if NOSWLL=1 if (state_fldchk(exportState, 'Sw_phs1_avg')) then - if (.not. allocated(counter_phs1_avg)) then - allocate(counter_phs1_avg(nseal_cpl)) - counter_phs1_avg(:) = 0 - allocate(accum_phs1_avg(nseal_cpl)) - accum_phs1_avg(:) = 0._r8 - end if - call state_getfldptr(exportState, 'Sw_phs1_avg', sw_phs1_avg, rc=rc) + call state_getfldptr(exportState, 'Sw_phs1_avg', dataptr, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - sw_phs1_avg(:) = 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 - if (PHS(jsea,NOSWLL) /= UNDEF) then - counter_phs1_avg(jsea) = counter_phs1_avg(jsea) + 1 - accum_phs1_avg(jsea) = accum_phs1_avg(jsea) + PHS(jsea,NOSWLL) - end if - if (sec_next == 0) then - if (counter_phs1_avg(jsea) /= 0) then - sw_phs1_avg(jsea) = accum_phs1_avg(jsea) / counter_phs1_avg(jsea) - end if - counter_phs1_avg(jsea) = 0 - accum_phs1_avg(jsea) = 0._r8 - end if - else - sw_phs1_avg(jsea) = 0. - endif - enddo + call accumulate(dataptr, counter_phs1_avg, accum_phs1_avg, sec_next, fillvalue, PHS(:,NOSWLL)) end if ! Wind sea mean direction = Partition 0 of DIR if (state_fldchk(exportState, 'Sw_pdir0_avg')) then - if (.not. allocated(counter_pdir0_avg)) then - allocate(counter_pdir0_avg(nseal_cpl)) - counter_pdir0_avg(:) = 0 - allocate(accum_pdir0_avg(nseal_cpl)) - accum_pdir0_avg(:) = 0._r8 - end if - call state_getfldptr(exportState, 'Sw_pdir0_avg', sw_pdir0_avg, rc=rc) + call state_getfldptr(exportState, 'Sw_pdir0_avg', dataptr, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - sw_pdir0_avg(:) = 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 - if (PDIR(jsea,0) /= UNDEF) then - counter_pdir0_avg(jsea) = counter_pdir0_avg(jsea) + 1 - accum_pdir0_avg(jsea) = accum_pdir0_avg(jsea) + PDIR(jsea,0) - end if - if (sec_next == 0) then - if (counter_pdir0_avg(jsea) /= 0) then - sw_pdir0_avg(jsea) = accum_pdir0_avg(jsea) / counter_pdir0_avg(jsea) - end if - counter_pdir0_avg(jsea) = 0 - accum_pdir0_avg(jsea) = 0._r8 - end if - else - sw_pdir0_avg(jsea) = 0. - endif - enddo + call accumulate(dataptr, counter_pdir0_avg, accum_pdir0_avg, sec_next, fillvalue, PDIR(:,0)) end if ! Swell mean direction = Partition 1 of DIR if NOSWLL=1 if (state_fldchk(exportState, 'Sw_pdir1_avg')) then - if (.not. allocated(counter_pdir1_avg)) then - allocate(counter_pdir1_avg(nseal_cpl)) - counter_pdir1_avg(:) = 0 - allocate(accum_pdir1_avg(nseal_cpl)) - accum_pdir1_avg(:) = 0._r8 - end if - call state_getfldptr(exportState, 'Sw_pdir1_avg', sw_pdir1_avg, rc=rc) + call state_getfldptr(exportState, 'Sw_pdir1_avg', dataptr, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - sw_pdir1_avg(:) = 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 - if (PDIR(jsea,NOSWLL) /= UNDEF) then - counter_pdir1_avg(jsea) = counter_pdir1_avg(jsea) + 1 - accum_pdir1_avg(jsea) = accum_pdir1_avg(jsea) + PDIR(jsea,NOSWLL) - end if - if (sec_next == 0) then - if (counter_pdir1_avg(jsea) /= 0) then - sw_pdir1_avg(jsea) = accum_pdir1_avg(jsea) / counter_pdir1_avg(jsea) - end if - counter_pdir1_avg(jsea) = 0 - accum_pdir1_avg(jsea) = 0._r8 - end if - else - sw_pdir1_avg(jsea) = 0. - endif - enddo + call accumulate(dataptr, counter_pdir1_avg, accum_pdir1_avg, sec_next, fillvalue, PDIR(:,NOSWLL)) end if ! Wind sea first moment period if (state_fldchk(exportState, 'Sw_pTm10_avg')) then - if (.not. allocated(counter_pTm10_avg)) then - allocate(counter_pTm10_avg(nseal_cpl)) - counter_pTm10_avg(:) = 0 - allocate(accum_pTm10_avg(nseal_cpl)) - accum_pTm10_avg(:) = 0._r8 - end if - call state_getfldptr(exportState, 'Sw_pTm10_avg', sw_pTm10_avg, rc=rc) + call state_getfldptr(exportState, 'Sw_pTm10_avg', dataptr, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - sw_pTm10_avg(:) = 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 - if (PT1(jsea,0) /= UNDEF) then - counter_pTm10_avg(jsea) = counter_pTm10_avg(jsea) + 1 - accum_pTm10_avg(jsea) = accum_pTm10_avg(jsea) + PT1(jsea,0) - end if - if (sec_next == 0) then - if (counter_pTm10_avg(jsea) /= 0) then - sw_pTm10_avg(jsea) = accum_pTm10_avg(jsea) / counter_pTm10_avg(jsea) - end if - counter_pTm10_avg(jsea) = 0 - accum_pTm10_avg(jsea) = 0._r8 - end if - else - sw_pTm10_avg(jsea) = 0. - endif - enddo + call accumulate(dataptr, counter_pTm10_avg, accum_pTm10_avg, sec_next, fillvalue, PT1(:,0)) end if ! Swell first moment period, if NOSWLL=1 if (state_fldchk(exportState, 'Sw_pTm11_avg')) then - if (.not. allocated(counter_pTm11_avg)) then - allocate(counter_pTm11_avg(nseal_cpl)) - counter_pTm11_avg(:) = 0 - allocate(accum_pTm11_avg(nseal_cpl)) - accum_pTm11_avg(:) = 0._r8 - end if - call state_getfldptr(exportState, 'Sw_pTm11_avg', sw_pTm11_avg, rc=rc) + call state_getfldptr(exportState, 'Sw_pTm11_avg', dataptr, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - sw_pTm11_avg(:) = 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 - if (PT1(jsea,NOSWLL) /= UNDEF) then - counter_pTm11_avg(jsea) = counter_pTm11_avg(jsea) + 1 - accum_pTm11_avg(jsea) = accum_pTm11_avg(jsea) + PT1(jsea,NOSWLL) - end if - if (sec_next == 0) then - if (counter_pTm11_avg(jsea) /= 0) then - sw_pTm11_avg(jsea) = accum_pTm11_avg(jsea) / counter_pTm11_avg(jsea) - end if - counter_pTm11_avg(jsea) = 0 - accum_pTm11_avg(jsea) = 0._r8 - end if - else - sw_pTm11_avg(jsea) = 0. - endif - enddo + call accumulate(dataptr, counter_pTm11_avg, accum_pTm11_avg, sec_next, fillvalue, PT1(:,NOSWLL)) end if ! Mean first moment period if (state_fldchk(exportState, 'Sw_Tm1_avg')) then - if (.not. allocated(counter_Tm1_avg)) then - allocate(counter_Tm1_avg(nseal_cpl)) - counter_Tm1_avg(:) = 0 - allocate(accum_Tm1_avg(nseal_cpl)) - accum_Tm1_avg(:) = 0._r8 - end if - call state_getfldptr(exportState, 'Sw_Tm1_avg', sw_Tm1_avg, rc=rc) + call state_getfldptr(exportState, 'Sw_Tm1_avg', dataptr, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - sw_Tm1_avg(:) = 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 - if (T01(jsea) /= UNDEF) then - counter_Tm1_avg(jsea) = counter_Tm1_avg(jsea) + 1 - accum_Tm1_avg(jsea) = accum_Tm1_avg(jsea) + T01(jsea) - end if - if (sec_next == 0) then - if (counter_Tm1_avg(jsea) /= 0) then - sw_Tm1_avg(jsea) = accum_Tm1_avg(jsea) / counter_Tm1_avg(jsea) - end if - counter_Tm1_avg(jsea) = 0 - accum_Tm1_avg(jsea) = 0._r8 - end if - else - sw_Tm1_avg(jsea) = 0. - endif - enddo + call accumulate(dataptr, counter_Tm1_avg, accum_Tm1_avg, sec_next, fillvalue, T01) end if ! Mean wave direction if (state_fldchk(exportState, 'Sw_thm_avg')) then - if (.not. allocated(counter_thm_avg)) then - allocate(counter_thm_avg(nseal_cpl)) - counter_thm_avg(:) = 0 - allocate(accum_thm_avg(nseal_cpl)) - accum_thm_avg(:) = 0._r8 - end if - call state_getfldptr(exportState, 'Sw_thm_avg', sw_thm_avg, rc=rc) + call state_getfldptr(exportState, 'Sw_thm_avg', dataptr, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - sw_thm_avg(:) = 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 - if (THM(jsea) /= UNDEF) then - counter_thm_avg(jsea) = counter_thm_avg(jsea) + 1 - accum_thm_avg(jsea) = accum_thm_avg(jsea) + THM(jsea) - end if - if (sec_next == 0) then - if (counter_thm_avg(jsea) /= 0) then - sw_thm_avg(jsea) = accum_thm_avg(jsea) / counter_thm_avg(jsea) - end if - counter_thm_avg(jsea) = 0 - accum_thm_avg(jsea) = 0._r8 - end if - else - sw_thm_avg(jsea) = 0. - endif - enddo + call accumulate(dataptr, counter_Thm_avg, accum_Thm_avg, sec_next, fillvalue, THM) end if ! Peak direction if (state_fldchk(exportState, 'Sw_thp0_avg')) then - if (.not. allocated(counter_thp0_avg)) then - allocate(counter_thp0_avg(nseal_cpl)) - counter_thp0_avg(:) = 0 - allocate(accum_thp0_avg(nseal_cpl)) - accum_thp0_avg(:) = 0._r8 - end if - call state_getfldptr(exportState, 'Sw_thp0_avg', sw_thp0_avg, rc=rc) + call state_getfldptr(exportState, 'Sw_thp0_avg', dataptr, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - sw_thp0_avg(:) = 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 - if (THP0(jsea) /= UNDEF) then - counter_thp0_avg(jsea) = counter_thp0_avg(jsea) + 1 - accum_thp0_avg(jsea) = accum_thp0_avg(jsea) + THP0(jsea) - end if - if (sec_next == 0) then - if (counter_thp0_avg(jsea) /= 0) then - sw_thp0_avg(jsea) = accum_thp0_avg(jsea) / counter_thp0_avg(jsea) - end if - counter_thp0_avg(jsea) = 0 - accum_thp0_avg(jsea) = 0._r8 - end if - else - sw_thp0_avg(jsea) = 0. - endif - enddo + call accumulate(dataptr, counter_thp0_avg, accum_thp0_avg, sec_next, fillvalue, THP0) end if ! Peak frequency if (state_fldchk(exportState, 'Sw_fp0_avg')) then - if (.not. allocated(counter_fp0_avg)) then - allocate(counter_fp0_avg(nseal_cpl)) - counter_fp0_avg(:) = 0 - allocate(accum_fp0_avg(nseal_cpl)) - accum_fp0_avg(:) = 0._r8 - end if - call state_getfldptr(exportState, 'Sw_fp0_avg', sw_fp0_avg, rc=rc) + call state_getfldptr(exportState, 'Sw_fp0_avg', dataptr, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - sw_fp0_avg(:) = 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 - if (FP0(jsea) /= UNDEF) then - counter_fp0_avg(jsea) = counter_fp0_avg(jsea) + 1 - accum_fp0_avg(jsea) = accum_fp0_avg(jsea) + FP0(jsea) - end if - if (sec_next == 0) then - if (counter_fp0_avg(jsea) /= 0) then - sw_fp0_avg(jsea) = accum_fp0_avg(jsea) / counter_fp0_avg(jsea) - end if - counter_fp0_avg(jsea) = 0 - accum_fp0_avg(jsea) = 0._r8 - end if - else - sw_fp0_avg(jsea) = 0. - endif - enddo + call accumulate(dataptr, counter_fp0_avg, accum_fp0_avg, sec_next, fillvalue, FP0) end if ! Input zonal wind if (state_fldchk(exportState, 'Sw_u_avg') .and. state_fldchk(importState, 'Sa_u')) then - if (.not. allocated(counter_u_avg)) then - allocate(counter_u_avg(nseal_cpl)) - counter_u_avg(:) = 0 - allocate(accum_u_avg(nseal_cpl)) - accum_u_avg(:) = 0._r8 - end if - call state_getfldptr(importState, 'Sa_u', sa_u, rc=rc) + call state_getfldptr(exportState, 'Sw_u_avg', dataptr, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getfldptr(exportState, 'Sw_u_avg', sw_u_avg, rc=rc) + call state_getfldptr(importState, 'Sa_u', sa_u, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - sw_u_avg(:) = 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 - if (sa_u(jsea) /= UNDEF) then - counter_u_avg(jsea) = counter_u_avg(jsea) + 1 - accum_u_avg(jsea) = accum_u_avg(jsea) + sa_u(jsea) - end if - if (sec_next == 0) then - if (counter_u_avg(jsea) /= 0) then - sw_u_avg(jsea) = accum_u_avg(jsea) / counter_u_avg(jsea) - end if - counter_u_avg(jsea) = 0 - accum_u_avg(jsea) = 0._r8 - end if - else - sw_u_avg(:) = sa_u(:) - end if - end do + call accumulate(dataptr, counter_u_avg, accum_u_avg, sec_next, fillvalue, real(sa_u)) end if ! Input meridional wind if (state_fldchk(exportState, 'Sw_v_avg') .and. state_fldchk(importState, 'Sa_v')) then - if (.not. allocated(counter_v_avg)) then - allocate(counter_v_avg(nseal_cpl)) - counter_v_avg(:) = 0 - allocate(accum_v_avg(nseal_cpl)) - accum_v_avg(:) = 0._r8 - end if - call state_getfldptr(importState, 'Sa_v', sa_v, rc=rc) + call state_getfldptr(exportState, 'Sw_v_avg', dataptr, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getfldptr(exportState, 'Sw_v_avg', sw_v_avg, rc=rc) + call state_getfldptr(importState, 'Sa_v', sa_v, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - sw_v_avg(:) = 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 - if (sa_v(jsea) /= UNDEF) then - counter_v_avg(jsea) = counter_v_avg(jsea) + 1 - accum_v_avg(jsea) = accum_v_avg(jsea) + sa_v(jsea) - end if - if (sec_next == 0) then - if (counter_v_avg(jsea) /= 0) then - sw_v_avg(jsea) = accum_v_avg(jsea) / counter_v_avg(jsea) - end if - counter_v_avg(jsea) = 0 - accum_v_avg(jsea) = 0._r8 - end if - else - sw_v_avg(:) = sa_v(:) - end if - end do + call accumulate(dataptr, counter_v_avg, accum_v_avg, sec_next, fillvalue, real(sa_v)) end if ! Stokes transport u component @@ -1387,62 +981,16 @@ subroutine export_fields (gcomp, rc) allocate(accum_tusx_avg(nseal_cpl)) accum_tusx_avg(:) = 0._r8 end if - call state_getfldptr(exportState, 'Sw_tusx_avg', sw_tusx_avg, rc=rc) + call state_getfldptr(exportState, 'Sw_tusx_avg', dataptr, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - sw_tusx_avg(:) = 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 - if (TUSX(jsea) /= UNDEF) then - counter_tusx_avg(jsea) = counter_tusx_avg(jsea) + 1 - accum_tusx_avg(jsea) = accum_tusx_avg(jsea) + TUSX(jsea) - end if - if (sec_next == 0) then - if (counter_tusx_avg(jsea) /= 0) then - sw_tusx_avg(jsea) = accum_tusx_avg(jsea) / counter_tusx_avg(jsea) - end if - counter_tusx_avg(jsea) = 0 - accum_tusx_avg(jsea) = 0._r8 - end if - else - sw_tusx_avg(jsea) = 0. - endif - enddo + call accumulate(dataptr, counter_tusx_avg, accum_tusx_avg, sec_next, fillvalue, TUSX) end if ! Stokes transport v component if (state_fldchk(exportState, 'Sw_tusy_avg')) then - if (.not. allocated(counter_tusy_avg)) then - allocate(counter_tusy_avg(nseal_cpl)) - counter_tusy_avg(:) = 0 - allocate(accum_tusy_avg(nseal_cpl)) - accum_tusy_avg(:) = 0._r8 - end if - call state_getfldptr(exportState, 'Sw_tusy_avg', sw_tusy_avg, rc=rc) + call state_getfldptr(exportState, 'Sw_tusy_avg', dataptr, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - sw_tusy_avg(:) = 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 - if (TUSY(jsea) /= UNDEF) then - counter_tusy_avg(jsea) = counter_tusy_avg(jsea) + 1 - accum_tusy_avg(jsea) = accum_tusy_avg(jsea) + TUSY(jsea) - end if - if (sec_next == 0) then - if (counter_tusy_avg(jsea) /= 0) then - sw_tusy_avg(jsea) = accum_tusy_avg(jsea) / counter_tusy_avg(jsea) - end if - counter_tusy_avg(jsea) = 0 - accum_tusy_avg(jsea) = 0._r8 - end if - else - sw_tusy_avg(jsea) = 0. - endif - enddo + call accumulate(dataptr, counter_tusy_avg, accum_tusy_avg, sec_next, fillvalue, TUSY) end if if (dbug_flag > 5) then @@ -2359,4 +1907,54 @@ subroutine readfromfile (idfld, wxdata, wydata, time0, timen, rc) end subroutine readfromfile + !======================================================================== + subroutine accumulate(dataptr, counter, accum, sec_next, fillvalue, ww3data) + + use w3gdatmd , only : mapsf + use w3gdatmd , only : mapsta + use constants , only : UNDEF + + ! input/output variables + real(r8) , intent(inout) :: dataptr(:) + integer , allocatable , intent(inout) :: counter(:) + real(r8), allocatable , intent(inout) :: accum(:) + integer , intent(in) :: sec_next + real(r8) , intent(in) :: fillvalue + real , intent(in) :: ww3data(:) + + ! local variables + integer :: isea, jsea + integer :: ix, iy + !--------------------------------------------------------------------------- + + if (.not. allocated(counter)) then + allocate(counter(nseal_cpl)) + counter(:) = 0 + allocate(accum(nseal_cpl)) + accum(:) = 0._r8 + end if + + dataptr(:) = 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 + if (ww3data(jsea) /= UNDEF) then + counter(jsea) = counter(jsea) + 1 + accum(jsea) = accum(jsea) + ww3data(jsea) + end if + if (sec_next == 0) then + if (counter(jsea) /= 0) then + dataptr(jsea) = accum(jsea) / counter(jsea) + end if + counter(jsea) = 0 + accum(jsea) = 0._r8 + end if + else + dataptr(jsea) = 0. + endif + enddo + end subroutine accumulate + end module wav_import_export