diff --git a/CMakeLists.txt b/CMakeLists.txt index dc9d41c3..aad40622 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -160,6 +160,7 @@ add_subdirectory( "ROMS/Nonlinear" ) add_subdirectory( "ROMS/Nonlinear/BBL" ) add_subdirectory( "ROMS/Nonlinear/Biology" ) add_subdirectory( "ROMS/Nonlinear/Sediment" ) +add_subdirectory( "ROMS/Nonlinear/WEC" ) add_subdirectory( "ROMS/Utility" ) include_directories( @@ -175,6 +176,7 @@ include_directories( "ROMS/Nonlinear/BBL" "ROMS/Nonlinear/Biology" "ROMS/Nonlinear/Sediment" + "ROMS/Nonlinear/WEC" "ROMS/Utility" ) @@ -193,6 +195,7 @@ list(APPEND srcs ${ROMS_Nonlinear_BBL_files} ${ROMS_Nonlinear_Biology_files} ${ROMS_Nonlinear_Sediment_files} + ${ROMS_Nonlinear_WEC_files} ${ROMS_Utility_files} ) diff --git a/ROMS/Nonlinear/WEC/CMakeLists.txt b/ROMS/Nonlinear/WEC/CMakeLists.txt new file mode 100644 index 00000000..44e507f1 --- /dev/null +++ b/ROMS/Nonlinear/WEC/CMakeLists.txt @@ -0,0 +1,28 @@ +# git $Id$ +#:::::::::::::::::::::::::::::::::::::::::::::::::::::: David Robertson ::: +# Copyright (c) 2002-2024 The ROMS/TOMS Group ::: +# Licensed under a MIT/X style license ::: +# See License_ROMS.md ::: +#:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: +# +# Source code list for sub-directory "ROMS/Nonlinear/WEC" + +list( APPEND _files + ROMS/Nonlinear/Wec/wec_dissip.F + ROMS/Nonlinear/Wec/wec_output.F + ROMS/Nonlinear/Wec/wec_roller.F + ROMS/Nonlinear/Wec/wec_stokes.F + ROMS/Nonlinear/Wec/wec_streaming.F + ROMS/Nonlinear/Wec/wec_u2dbc_im.F + ROMS/Nonlinear/Wec/wec_u3dbc_im.F + ROMS/Nonlinear/Wec/wec_v2dbc_im.F + ROMS/Nonlinear/Wec/wec_v3dbc_im.F + ROMS/Nonlinear/Wec/wec_vf.F + ROMS/Nonlinear/Wec/wec_wave_mix.F + ROMS/Nonlinear/Wec/wec_wvelocity.F +) + +set ( ROMS_Nonlinear_Wec_files + ${_files} + PARENT_SCOPE +) diff --git a/ROMS/Nonlinear/WEC/Module.mk b/ROMS/Nonlinear/WEC/Module.mk new file mode 100644 index 00000000..611ccafa --- /dev/null +++ b/ROMS/Nonlinear/WEC/Module.mk @@ -0,0 +1,15 @@ +# +# git $Id$ +#::::::::::::::::::::::::::::::::::::::::::::::::::::: Hernan G. Arango ::: +# Copyright (c) 2002-2024 The ROMS/TOMS Group Kate Hedstrom ::: +# Licensed under a MIT/X style license ::: +# See License_ROMS.md ::: +#:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: + +local_sub := ROMS/Nonlinear/WEC + +local_src := $(wildcard $(local_sub)/*.F) + +sources += $(local_src) + +$(eval $(compile-rules)) diff --git a/ROMS/Nonlinear/WEC/wec_dissip.F b/ROMS/Nonlinear/WEC/wec_dissip.F new file mode 100644 index 00000000..4d14ed6b --- /dev/null +++ b/ROMS/Nonlinear/WEC/wec_dissip.F @@ -0,0 +1,188 @@ +#include "cppdefs.h" + MODULE wec_dissip_mod + +#if defined SOLVE3D && (defined WDISS_THORGUZA || \ + defined WDISS_CHURTHOR) +! +!git $Id$ +!======================================================================= +! Copyright (c) 2002-2024 The ROMS/TOMS Group ! +! Licensed under a MIT/X style license Hernan G. Arango ! +! See License_ROMS.md Nirnimesh Kumar ! +!================================================== John C. Warner ====! +! ! +! This routine computes wave dissipation due to breaking and ! +! whitecapping using selected formulations. ! +! ! +! momentum equations. ! +! ! +! References: ! +! ! +! Thornton, E. B., and R. T. Guza, Surf zone longshore currents and ! +! random waves: field data and models, J. Phys. Oceanogr., ! +! 16,1165-1178, 1986. ! +! ! +! Church, J. C., and E. B. Thornton, Effects of breaking wave induced ! +! turbulence within a longshore current model, Coastal Eng., 20, ! +! 128, 1993. ! +! ! +!======================================================================= +! + USE mod_param +# if defined DIAGNOSTICS_UV + USE mod_diags +# endif + USE mod_forces + USE mod_grid + USE mod_ocean + + USE mod_scalars + USE exchange_2d_mod +! + USE bc_2d_mod, ONLY : bc_r2d_tile +# ifdef DISTRIBUTE + USE mp_exchange_mod, ONLY : mp_exchange2d +# endif +! + implicit none +! + PRIVATE + PUBLIC :: wec_dissip +! + CONTAINS +! +!*********************************************************************** + SUBROUTINE wec_dissip (ng, tile) +!*********************************************************************** +! + integer, intent(in) :: ng, tile +! +! Local variable declarations. +! + character (len=*), parameter :: MyFile = & + & __FILE__ +! +# include "tile.h" +! +# ifdef PROFILE + CALL wclock_on (ng, iNLM, 42, __LINE__, MyFile) +# endif + CALL wec_dissip_tile (ng, tile, LBi, UBi, LBj, UBj, N(ng), & + & IminS, ImaxS, JminS, JmaxS, & + & GRID(ng) % h, & + & OCEAN(ng) % zeta, & + & FORCES(ng) % Hwave, & + & FORCES(ng) % Pwave_top, & + & FORCES(ng) % Dissip_break, & + & FORCES(ng) % Dissip_wcap) +# ifdef PROFILE + CALL wclock_off (ng, iNLM, 42, __LINE__, MyFile) +# endif +! + RETURN + END SUBROUTINE wec_dissip +! +!*********************************************************************** + SUBROUTINE wec_dissip_tile (ng, tile, LBi, UBi, LBj, UBj, UBk, & + & IminS, ImaxS, JminS, JmaxS, & + & h, zeta, & + & Hwave, Pwave_top, & + & Dissip_break, Dissip_wcap) +!*********************************************************************** +! +! Imported variable declarations. +! + integer, intent(in) :: ng, tile + integer, intent(in) :: LBi, UBi, LBj, UBj, UBk + integer, intent(in) :: IminS, ImaxS, JminS, JmaxS +# ifdef ASSUMED_SHAPE + real(r8), intent(in) :: h(LBi:,LBj:) + real(r8), intent(in) :: zeta(LBi:,LBj:,:) + real(r8), intent(in) :: Hwave(LBi:,LBj:) + real(r8), intent(in) :: Pwave_top(LBi:,LBj:) + real(r8), intent(inout) :: Dissip_break(LBi:,LBj:) + real(r8), intent(inout) :: Dissip_wcap(LBi:,LBj:) +# else + real(r8), intent(in) :: h(LBi:UBi,LBj:UBj) + real(r8), intent(in) :: zeta(LBi:UBi,LBj:UBj,3) + real(r8), intent(in) :: Pwave_top(LBi:UBi,LBj:UBj) + real(r8), intent(inout) :: Dissip_break(LBi:UBi,LBj:UBj) + real(r8), intent(inout) :: Dissip_wcap(LBi:UBi,LBj:UBj) +# endif +! +! Local variable declarations. +! + integer :: i, j + real(r8) :: cff1, cff2 + real(r8) :: fac1, sigmat, Dstp +# if defined WDISS_CHURTHOR + real(r8) :: RB1, RB2 +# endif + real(r8), parameter :: gammaw=0.31_r8 + real(r8), parameter :: eps = 1.0E-14_r8 + +# include "set_bounds.h" +! +!----------------------------------------------------------------------- +! Calculate wave dissipation due to breaking and whitecapping. +!----------------------------------------------------------------------- +! + fac1=3.0_r8*g*SQRT(pi)/16.0_r8 + DO j=Jstr,Jend + DO i=Istr,Iend +! +! Compute total depth +! + Dstp=zeta(i,j,1)+h(i,j) + cff1=0.707_r8*Hwave(i,j) + sigmat=MIN(1.0_r8/(Pwave_top(i,j)+eps),1.0_r8) +! +# ifdef WDISS_THORGUZA +! +! Calcualate wave dissipation using empirical parameters of +! Thornton and Guza, 1986 +! + cff2=1.0_r8/((gammaw**4.0_r8)*(Dstp**5.0_r8)) + Dissip_break(i,j)=0.2621_r8*fac1*sigmat* & + & (cff1**7.0_r8)*cff2 + Dissip_wcap(i,j)=0.0_r8 +! +# elif defined WDISS_CHURTHOR +! +! Calculate wave dissipation using empirical parameters of +! Church and Thornton, 1993. +! + cff2=1.0_r8/(gammaw*Dstp) + RB1=1.0_r8+TANH(8.0_r8*((cff1*cff2)-1.0_r8)) + RB2=1.0_r8-(1.0_r8+(cff1*cff2)**2.0_r8)**(-2.5_r8) + Dissip_break(i,j)=(0.2621_r8/Dstp)*fac1*sigmat* & + & (cff1**3.0_r8)*RB1*RB2 + Dissip_wcap(i,j)=0.0_r8 +# endif + END DO + END DO + +# if defined WDISS_THORGUZA || defined WDISS_CHURTHOR +! +! Apply boundary conditions. +! + CALL bc_r2d_tile (ng, tile, & + & LBi, UBi, LBj, UBj, & + & Dissip_break) + CALL bc_r2d_tile (ng, tile, & + & LBi, UBi, LBj, UBj, & + & Dissip_wcap) +# endif +# ifdef DISTRIBUTE +! + CALL mp_exchange2d (ng, tile, iNLM, 2, & + & LBi, UBi, LBj, UBj, & + & NghostPoints, & + & EWperiodic(ng), NSperiodic(ng), & + & Dissip_break, Dissip_wcap) +# endif +! + RETURN + END SUBROUTINE wec_dissip_tile +#endif + END MODULE wec_dissip_mod diff --git a/ROMS/Nonlinear/WEC/wec_output.F b/ROMS/Nonlinear/WEC/wec_output.F new file mode 100644 index 00000000..33d9f877 --- /dev/null +++ b/ROMS/Nonlinear/WEC/wec_output.F @@ -0,0 +1,5602 @@ +#include "cppdefs.h" + MODULE wec_output_mod + +#if defined WEC || defined WEC_VF +! +!git $Id$ +!================================================== Hernan G. Arango === +! Copyright (c) 2002-2024 The ROMS/TOMS Group ! +! Licensed under a MIT/X style license ! +! See License_ROMS.md ! +!======================================================================= +! ! +! This module defines/writes Waves Effect on Currents variables into ! +! output NetCDF files. ! +! ! +!======================================================================= +! + USE mod_param + USE mod_parallel +# ifdef AVERAGES + USE mod_average +# endif + USE mod_forces + USE mod_grid + USE mod_iounits + USE mod_mixing + USE mod_ncparam + USE mod_ocean + USE mod_scalars + USE mod_stepping +! + USE def_var_mod, ONLY : def_var +# ifdef STATIONS + USE extract_sta_mod, ONLY : extract_sta2d +# ifdef SOLVE3D + USE extract_sta_mod, ONLY : extract_sta3d +# endif +# endif + USE nf_fwrite2d_mod, ONLY : nf_fwrite2d +# ifdef SOLVE3D + USE nf_fwrite3d_mod, ONLY : nf_fwrite3d + USE omega_mod, ONLY : scale_omega +# endif + USE strings_mod, ONLY : FoundError +! + implicit none +! + PUBLIC :: wec_def_nf90 +# if defined PIO_LIB && defined DISTRIBUTE + PUBLIC :: wec_def_pio +# endif +# ifdef STATIONS + PUBLIC :: wec_def_station_nf90 +# if defined PIO_LIB && defined DISTRIBUTE + PUBLIC :: wec_def_station_pio +# endif +# endif + PUBLIC :: wec_wrt_nf90 +# if defined PIO_LIB && defined DISTRIBUTE + PUBLIC :: wec_wrt_pio +# endif +# ifdef STATIONS + PUBLIC :: wec_wrt_station_nf90 +# if defined PIO_LIB && defined DISTRIBUTE + PUBLIC :: wec_wrt_station_pio +# endif +# endif +! + CONTAINS +! +!*********************************************************************** + SUBROUTINE wec_def_nf90 (ng, model, ldef, VarOut, S, & + & t2dgrd, u2dgrd, v2dgrd, & + & t3dgrd, u3dgrd, v3dgrd, w3dgrd) +!*********************************************************************** +! + USE mod_netcdf +! +! Imported variable declarations. +! + logical, intent(in) :: ldef, VarOut(NV,Ngrids) +! + integer, intent(in) :: ng, model + integer, intent(in), optional :: t2dgrd(:), u2dgrd(:), v2dgrd(:) + integer, intent(in), optional :: t3dgrd(:), u3dgrd(:), v3dgrd(:) + integer, intent(in), optional :: w3dgrd(:) +! + TYPE(T_IO), intent(inout) :: S(Ngrids) +! +! Local variable declarations. +! + logical :: got_var(NV) +! + integer, parameter :: Natt = 25 + + integer :: i, j, nvd3, nvd4, status +! + real(r8) :: Aval(6) +! +# ifdef ADJOINT + character (len=21) :: Prefix +# else + character (len=13) :: Prefix +# endif + character (len=120) :: Vinfo(Natt) + character (len=256) :: ncname +! + character (len=*), parameter :: MyFile = & + & __FILE__//", wec_def_nf90" +! + SourceFile=MyFile +! +!----------------------------------------------------------------------- +! Define Waves Effect on Currents output variables. +!----------------------------------------------------------------------- +! + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN + ncname=S(ng)%name +! + DEFINE : IF (ldef) THEN +! +! Set number of dimensions for output variables. +! +# if defined WRITE_WATER && defined MASKING + nvd3=2 + nvd4=2 +# else + nvd3=3 + nvd4=4 +# endif +! +! Set long name prefix string. +! +# ifdef ADJOINT +!! Prefix='time-averaged adjoint' + Prefix='adjoint' +# else +!! Prefix='time-averaged' + Prefix=CHAR(32) ! blank space +# endif +! +! Initialize local information variable arrays. +! + DO i=1,Natt + DO j=1,LEN(Vinfo(1)) + Vinfo(i)(j:j)=' ' + END DO + END DO + DO i=1,6 + Aval(i)=0.0_r8 + END DO + +# ifdef WEC +! +! Define 2D total Waves Effect on Currents U-stress. +! + IF (VarOut(idU2rs,ng)) THEN + Vinfo( 1)=Vname(1,idU2rs) + IF (S(ng)%ncid.eq.AVG(ng)%ncid) THEN + WRITE (Vinfo( 2),'(a,1x,a)') Prefix, TRIM(Vname(2,idU2rs)) + ELSE + Vinfo( 2)=Vname(2,idU2rs) + END IF + Vinfo( 3)=Vname(3,idU2rs) + Vinfo(14)=Vname(4,idU2rs) + Vinfo(16)=Vname(1,idtime) +# if defined WRITE_WATER && defined MASKING + Vinfo(20)='mask_u' +# endif + Vinfo(21)=Vname(6,idU2rs) + Vinfo(22)='coordinates' + Aval(5)=REAL(Iinfo(1,idU2rs,ng),r8) + status=def_var(ng, model, S(ng)%ncid, S(ng)%Vid(idU2rs), & + & NF_FOUT, nvd3, u2dgrd, Aval, Vinfo, ncname) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN + END IF +! +! Define 2D total Waves Effect on Currents V-stress. +! + IF (VarOut(idV2rs,ng)) THEN + Vinfo( 1)=Vname(1,idV2rs) + IF (S(ng)%ncid.eq.AVG(ng)%ncid) THEN + WRITE (Vinfo( 2),'(a,1x,a)') Prefix, TRIM(Vname(2,idV2rs)) + ELSE + Vinfo( 2)=Vname(2,idV2rs) + END IF + Vinfo( 3)=Vname(3,idV2rs) + Vinfo(14)=Vname(4,idV2rs) + Vinfo(16)=Vname(1,idtime) +# if defined WRITE_WATER && defined MASKING + Vinfo(20)='mask_v' +# endif + Vinfo(21)=Vname(6,idV2rs) + Vinfo(22)='coordinates' + Aval(5)=REAL(Iinfo(1,idV2rs,ng),r8) + status=def_var(ng, model, S(ng)%ncid, S(ng)%Vid(idV2rs), & + & NF_FOUT, nvd3, v2dgrd, Aval, Vinfo, ncname) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN + END IF +! +! Define 2D Stokes U-velocity. +! + IF (VarOut(idU2Sd,ng)) THEN + Vinfo( 1)=Vname(1,idU2Sd) + IF (S(ng)%ncid.eq.AVG(ng)%ncid) THEN + WRITE (Vinfo( 2),'(a,1x,a)') Prefix, TRIM(Vname(2,idU2Sd)) + ELSE + Vinfo( 2)=Vname(2,idU2Sd) + END IF + Vinfo( 3)=Vname(3,idU2Sd) + Vinfo(14)=Vname(4,idU2Sd) + Vinfo(16)=Vname(1,idtime) +# if defined WRITE_WATER && defined MASKING + Vinfo(20)='mask_u' +# endif + Vinfo(21)=Vname(6,idU2Sd) + Vinfo(22)='coordinates' + Aval(5)=REAL(Iinfo(1,idU2Sd,ng),r8) + status=def_var(ng, model, S(ng)%ncid, S(ng)%Vid(idU2Sd), & + & NF_FOUT, nvd3, u2dgrd, Aval, Vinfo, ncname) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN + END IF +! +! Define 2D Stokes V-velocity. +! + IF (VarOut(idV2Sd,ng)) THEN + Vinfo( 1)=Vname(1,idV2Sd) + IF (S(ng)%ncid.eq.AVG(ng)%ncid) THEN + WRITE (Vinfo( 2),'(a,1x,a)') Prefix, TRIM(Vname(2,idV2Sd)) + ELSE + Vinfo( 2)=Vname(2,idV2Sd) + END IF + Vinfo( 3)=Vname(3,idV2Sd) + Vinfo(14)=Vname(4,idV2Sd) + Vinfo(16)=Vname(1,idtime) +# if defined WRITE_WATER && defined MASKING + Vinfo(20)='mask_v' +# endif + Vinfo(21)=Vname(6,idV2Sd) + Vinfo(22)='coordinates' + Aval(5)=REAL(Iinfo(1,idV2Sd,ng),r8) + status=def_var(ng, model, S(ng)%ncid, S(ng)%Vid(idV2Sd), & + & NF_FOUT, nvd3, v2dgrd, Aval, Vinfo, ncname) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN + END IF + +# ifdef SOLVE3D +! +! Define 3D total Waves Effect on Currents U-stress. +! + IF (VarOut(idU3rs,ng)) THEN + Vinfo( 1)=Vname(1,idU3rs) + IF (S(ng)%ncid.eq.AVG(ng)%ncid) THEN + WRITE (Vinfo( 2),'(a,1x,a)') Prefix, TRIM(Vname(2,idU3rs)) + ELSE + Vinfo( 2)=Vname(2,idU3rs) + END IF + Vinfo( 3)=Vname(3,idU3rs) + Vinfo(14)=Vname(4,idU3rs) + Vinfo(16)=Vname(1,idtime) +# if defined WRITE_WATER && defined MASKING + Vinfo(20)='mask_u' +# endif + Vinfo(21)=Vname(6,idU3rs) + Vinfo(22)='coordinates' + Aval(5)=REAL(Iinfo(1,idU3rs,ng),r8) + status=def_var(ng, model, S(ng)%ncid, S(ng)%Vid(idU3rs), & + & NF_FOUT, nvd4, u3dgrd, Aval, Vinfo, ncname) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN + END IF +! +! Define 3D total Waves Effect on Currents V-stress. +! + IF (VarOut(idV3rs,ng)) THEN + Vinfo( 1)=Vname(1,idV3rs) + IF (S(ng)%ncid.eq.AVG(ng)%ncid) THEN + WRITE (Vinfo( 2),'(a,1x,a)') Prefix, TRIM(Vname(2,idV3rs)) + ELSE + Vinfo( 2)=Vname(2,idV3rs) + END IF + Vinfo( 3)=Vname(3,idV3rs) + Vinfo(14)=Vname(4,idV3rs) + Vinfo(16)=Vname(1,idtime) +# if defined WRITE_WATER && defined MASKING + Vinfo(20)='mask_v' +# endif + Vinfo(21)=Vname(6,idV3rs) + Vinfo(22)='coordinates' + Aval(5)=REAL(Iinfo(1,idV3rs,ng),r8) + status=def_var(ng, model, S(ng)%ncid, S(ng)%Vid(idV3rs), & + & NF_FOUT, nvd4, v3dgrd, Aval, Vinfo, ncname) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN + END IF +! +! Define 3D Stokes U-velocity. +! + IF (VarOut(idU3Sd,ng)) THEN + Vinfo( 1)=Vname(1,idU3Sd) + IF (S(ng)%ncid.eq.AVG(ng)%ncid) THEN + WRITE (Vinfo( 2),'(a,1x,a)') Prefix, TRIM(Vname(2,idU3Sd)) + ELSE + Vinfo( 2)=Vname(2,idU3Sd) + END IF + Vinfo( 3)=Vname(3,idU3Sd) + Vinfo(14)=Vname(4,idU3Sd) + Vinfo(16)=Vname(1,idtime) +# if defined WRITE_WATER && defined MASKING + Vinfo(20)='mask_u' +# endif + Vinfo(21)=Vname(6,idU3Sd) + Vinfo(22)='coordinates' + Aval(5)=REAL(Iinfo(1,idU3Sd,ng),r8) + status=def_var(ng, model, S(ng)%ncid, S(ng)%Vid(idU3Sd), & + & NF_FOUT, nvd4, u3dgrd, Aval, Vinfo, ncname) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN + END IF +! +! Define 3D Stokes V-velocity. + IF (VarOut(idV3Sd,ng)) THEN + Vinfo( 1)=Vname(1,idV3Sd) + IF (S(ng)%ncid.eq.AVG(ng)%ncid) THEN + WRITE (Vinfo( 2),'(a,1x,a)') Prefix, TRIM(Vname(2,idV3Sd)) + ELSE + Vinfo( 2)=Vname(2,idV3Sd) + END IF + Vinfo( 3)=Vname(3,idV3Sd) + Vinfo(14)=Vname(4,idV3Sd) + Vinfo(16)=Vname(1,idtime) +# if defined WRITE_WATER && defined MASKING + Vinfo(20)='mask_v' +# endif + Vinfo(21)=Vname(6,idV3Sd) + Vinfo(22)='coordinates' + Aval(5)=REAL(Iinfo(1,idV3Sd,ng),r8) + status=def_var(ng, model, S(ng)%ncid, S(ng)%Vid(idV3Sd), & + & NF_FOUT, nvd4, v3dgrd, Aval, Vinfo, ncname) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN + END IF +! +! Define 3D Stokes omega-velocity. +! + IF (VarOut(idW3Sd,ng)) THEN + Vinfo( 1)=Vname(1,idW3Sd) + IF (S(ng)%ncid.eq.AVG(ng)%ncid) THEN + WRITE (Vinfo( 2),'(a,1x,a)') Prefix, TRIM(Vname(2,idW3Sd)) + ELSE + Vinfo( 2)=Vname(2,idW3Sd) + END IF + Vinfo( 3)=Vname(3,idW3Sd) + Vinfo(14)=Vname(4,idW3Sd) + Vinfo(16)=Vname(1,idtime) +# if defined WRITE_WATER && defined MASKING + Vinfo(20)='mask_rho' +# endif + Vinfo(21)=Vname(6,idW3Sd) + Vinfo(22)='coordinates' + Aval(5)=REAL(Iinfo(1,idW3Sd,ng),r8) + status=def_var(ng, model, S(ng)%ncid, S(ng)%Vid(idW3Sd), & + & NF_FOUT, nvd4, w3dgrd, Aval, Vinfo, ncname) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN + END IF +! +! Define 3D Stokes 'true' W-velocity. +! + IF (VarOut(idW3St,ng)) THEN + Vinfo( 1)=Vname(1,idW3St) + IF (S(ng)%ncid.eq.AVG(ng)%ncid) THEN + WRITE (Vinfo( 2),'(a,1x,a)') Prefix, TRIM(Vname(2,idW3St)) + ELSE + Vinfo( 2)=Vname(2,idW3St) + END IF + Vinfo( 3)=Vname(3,idW3St) + Vinfo(14)=Vname(4,idW3St) + Vinfo(16)=Vname(1,idtime) +# if defined WRITE_WATER && defined MASKING + Vinfo(20)='mask_rho' +# endif + Vinfo(21)=Vname(6,idW3St) + Vinfo(22)='coordinates' + Aval(5)=REAL(Iinfo(1,idW3St,ng),r8) + status=def_var(ng, model, S(ng)%ncid, S(ng)%Vid(idW3St), & + & NF_FOUT, nvd4, w3dgrd, Aval, Vinfo, ncname) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN + END IF +# endif +# endif +# ifdef WEC_VF +! +! Define Waves Effect on Currents quasi-static sea level adjustment. +! + IF (VarOut(idWztw,ng)) THEN + Vinfo( 1)=Vname(1,idWztw) + IF (S(ng)%ncid.eq.AVG(ng)%ncid) THEN + WRITE (Vinfo( 2),'(a,1x,a)') Prefix, TRIM(Vname(2,idWztw)) + ELSE + Vinfo( 2)=Vname(2,idWztw) + END IF + Vinfo( 3)=Vname(3,idWztw) + Vinfo(14)=Vname(4,idWztw) + Vinfo(16)=Vname(1,idtime) +# if defined WRITE_WATER && defined MASKING + Vinfo(20)='mask_rho' +# endif + Vinfo(21)=Vname(6,idWztw) + Vinfo(22)='coordinates' + Aval(5)=REAL(Iinfo(1,idWztw,ng),r8) + status=def_var(ng, model, S(ng)%ncid, S(ng)%Vid(idWztw), & + & NF_FOUT, nvd3, t2dgrd, Aval, Vinfo, ncname) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN + END IF +! +! Define Waves Effect on Currents quasi-static pressure. +! + IF (VarOut(idWqsp,ng)) THEN + Vinfo( 1)=Vname(1,idWqsp) + IF (S(ng)%ncid.eq.AVG(ng)%ncid) THEN + WRITE (Vinfo( 2),'(a,1x,a)') Prefix, TRIM(Vname(2,idWqsp)) + ELSE + Vinfo( 2)=Vname(2,idWqsp) + END IF + Vinfo( 3)=Vname(3,idWqsp) + Vinfo(14)=Vname(4,idWqsp) + Vinfo(16)=Vname(1,idtime) +# if defined WRITE_WATER && defined MASKING + Vinfo(20)='mask_rho' +# endif + Vinfo(21)=Vname(6,idWqsp) + Vinfo(22)='coordinates' + Aval(5)=REAL(Iinfo(1,idWqsp,ng),r8) + status=def_var(ng, model, S(ng)%ncid, S(ng)%Vid(idWqsp), & + & NF_FOUT, nvd3, t2dgrd, Aval, Vinfo, ncname) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN + END IF +! +! Define Waves Effect on Currents Bernoulli head. +! + IF (VarOut(idWbeh,ng)) THEN + Vinfo( 1)=Vname(1,idWbeh) + IF (S(ng)%ncid.eq.AVG(ng)%ncid) THEN + WRITE (Vinfo( 2),'(a,1x,a)') Prefix, TRIM(Vname(2,idWbeh)) + ELSE + Vinfo( 2)=Vname(2,idWbeh) + END IF + Vinfo( 3)=Vname(3,idWbeh) + Vinfo(14)=Vname(4,idWbeh) + Vinfo(16)=Vname(1,idtime) +# if defined WRITE_WATER && defined MASKING + Vinfo(20)='mask_rho' +# endif + Vinfo(21)=Vname(6,idWbeh) + Vinfo(22)='coordinates' + Aval(5)=REAL(Iinfo(1,idWbeh,ng),r8) + status=def_var(ng, model, S(ng)%ncid, S(ng)%Vid(idWbeh), & + & NF_FOUT, nvd3, t2dgrd, Aval, Vinfo, ncname) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN + END IF +# endif +# if (defined BOTTOM_STREAMING && defined WEC_VF) || \ + defined WAV_COUPLING +! +! Define wave dissipation due to bottom friction. +! + IF (VarOut(idWdif,ng)) THEN + Vinfo( 1)=Vname(1,idWdif) + IF (S(ng)%ncid.eq.AVG(ng)%ncid) THEN + WRITE (Vinfo( 2),'(a,1x,a)') Prefix, TRIM(Vname(2,idWdif)) + ELSE + Vinfo( 2)=Vname(2,idWdif) + END IF + Vinfo( 3)=Vname(3,idWdif) + Vinfo(14)=Vname(4,idWdif) + Vinfo(16)=Vname(1,idtime) +# if defined WRITE_WATER && defined MASKING + Vinfo(20)='mask_rho' +# endif + Vinfo(21)=Vname(6,idWdif) + Vinfo(22)='coordinates' + Aval(5)=REAL(Iinfo(1,idWdif,ng),r8) + status=def_var(ng, model, S(ng)%ncid, S(ng)%Vid(idWdif), & + & NF_FOUT, nvd3, t2dgrd, Aval, Vinfo, ncname) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN + END IF +# endif +# if defined TKE_WAVEDISS || defined WAV_COUPLING || \ + defined WDISS_THORGUZA || defined WDISS_CHURTHOR || \ + defined WAVES_DISS || defined WDISS_INWAVE +! +! Define wave dissipation due to breaking. +! + IF (VarOut(idWdib,ng)) THEN + Vinfo( 1)=Vname(1,idWdib) + IF (S(ng)%ncid.eq.AVG(ng)%ncid) THEN + WRITE (Vinfo( 2),'(a,1x,a)') Prefix, TRIM(Vname(2,idWdib)) + ELSE + Vinfo( 2)=Vname(2,idWdib) + END IF + Vinfo( 3)=Vname(3,idWdib) + Vinfo(14)=Vname(4,idWdib) + Vinfo(16)=Vname(1,idtime) +# if defined WRITE_WATER && defined MASKING + Vinfo(20)='mask_rho' +# endif + Vinfo(21)=Vname(6,idWdib) + Vinfo(22)='coordinates' + Aval(5)=REAL(Iinfo(1,idWdib,ng),r8) + status=def_var(ng, model, S(ng)%ncid, S(ng)%Vid(idWdib), & + & NF_FOUT, nvd3, t2dgrd, Aval, Vinfo, ncname) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN + END IF +! +! Define wave dissipation due to whitecapping. +! + IF (VarOut(idWdiw,ng)) THEN + Vinfo( 1)=Vname(1,idWdiw) + IF (S(ng)%ncid.eq.AVG(ng)%ncid) THEN + WRITE (Vinfo( 2),'(a,1x,a)') Prefix, TRIM(Vname(2,idWdiw)) + ELSE + Vinfo( 2)=Vname(2,idWdiw) + END IF + Vinfo( 3)=Vname(3,idWdiw) + Vinfo(14)=Vname(4,idWdiw) + Vinfo(16)=Vname(1,idtime) +# if defined WRITE_WATER && defined MASKING + Vinfo(20)='mask_rho' +# endif + Vinfo(21)=Vname(6,idWdiw) + Vinfo(22)='coordinates' + Aval(5)=REAL(Iinfo(1,idWdiw,ng),r8) + status=def_var(ng, model, S(ng)%ncid, S(ng)%Vid(idWdiw), & + & NF_FOUT, nvd3, t2dgrd, Aval, Vinfo, ncname) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN + END IF +# endif +# ifdef ROLLER_SVENDSEN +! +! Define percent wave breaking. +! + IF (VarOut(idWbrk,ng)) THEN + Vinfo( 1)=Vname(1,idWbrk) + IF (S(ng)%ncid.eq.AVG(ng)%ncid) THEN + WRITE (Vinfo( 2),'(a,1x,a)') Prefix, TRIM(Vname(2,idWbrk)) + ELSE + Vinfo( 2)=Vname(2,idWbrk) + END IF + Vinfo( 3)=Vname(3,idWbrk) + Vinfo(14)=Vname(4,idWbrk) + Vinfo(16)=Vname(1,idtime) +# if defined WRITE_WATER && defined MASKING + Vinfo(20)='mask_rho' +# endif + Vinfo(21)=Vname(6,idWbrk) + Vinfo(22)='coordinates' + Aval(5)=REAL(Iinfo(1,idWbrk,ng),r8) + status=def_var(ng, model, S(ng)%ncid, S(ng)%Vid(idWbrk), & + & NF_FOUT, nvd3, t2dgrd, Aval, Vinfo, ncname) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN + END IF +# endif +# ifdef WEC_ROLLER +! +! Define wave roller dissipation. +! + IF (VarOut(idWdis,ng)) THEN + Vinfo( 1)=Vname(1,idWdis) + IF (S(ng)%ncid.eq.AVG(ng)%ncid) THEN + WRITE (Vinfo( 2),'(a,1x,a)') Prefix, TRIM(Vname(2,idWdis)) + ELSE + Vinfo( 2)=Vname(2,idWdis) + END IF + Vinfo( 3)=Vname(3,idWdis) + Vinfo(14)=Vname(4,idWdis) + Vinfo(16)=Vname(1,idtime) +# if defined WRITE_WATER && defined MASKING + Vinfo(20)='mask_rho' +# endif + Vinfo(21)=Vname(6,idWdis) + Vinfo(22)='coordinates' + Aval(5)=REAL(Iinfo(1,idWdis,ng),r8) + status=def_var(ng, model, S(ng)%ncid, S(ng)%Vid(idWdis), & + & NF_FOUT, nvd3, t2dgrd, Aval, Vinfo, ncname) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN + END IF +# endif +# ifdef ROLLER_RENIERS +! +! Define roller wave action density. +! + IF (VarOut(idWrol,ng)) THEN + Vinfo( 1)=Vname(1,idWrol) + IF (S(ng)%ncid.eq.AVG(ng)%ncid) THEN + WRITE (Vinfo( 2),'(a,1x,a)') Prefix, TRIM(Vname(2,idWrol)) + ELSE + Vinfo( 2)=Vname(2,idWrol) + END IF + Vinfo( 3)=Vname(3,idWrol) + Vinfo(14)=Vname(4,idWrol) + Vinfo(16)=Vname(1,idtime) +# if defined WRITE_WATER && defined MASKING + Vinfo(20)='mask_rho' +# endif + Vinfo(21)=Vname(6,idWrol) + Vinfo(22)='coordinates' + Aval(5)=REAL(Iinfo(1,idWrol,ng),r8) + status=def_var(ng, model, S(ng)%ncid, S(ng)%Vid(idWrol), & + & NF_FOUT, nvd3, t2dgrd, Aval, Vinfo, ncname) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN + END IF +# endif + END IF DEFINE +! +!----------------------------------------------------------------------- +! Otherwise, check existing output file and prepare for appending +! data. +!----------------------------------------------------------------------- +! + QUERY : IF (.not.ldef) THEN +! +! Initialize local logical switches. +! + DO i=1,NV + got_var(i)=.FALSE. + END DO +! +! Scan variable list from input NetCDF and activate switches for +! Waves Effect on Currents variables. Get variable IDs. +! + DO i=1,n_var + IF (TRIM(var_name(i)).eq.TRIM(Vname(1,idtime))) THEN + got_var(idtime)=.TRUE. + S(ng)%Vid(idtime)=var_id(i) +# ifdef WEC + ELSE IF (TRIM(var_name(i)).eq.TRIM(Vname(1,idU2rs))) THEN + got_var(idU2rs)=.TRUE. + S(ng)%Vid(idU2rs)=var_id(i) + ELSE IF (TRIM(var_name(i)).eq.TRIM(Vname(1,idV2rs))) THEN + got_var(idV2rs)=.TRUE. + S(ng)%Vid(idV2rs)=var_id(i) + ELSE IF (TRIM(var_name(i)).eq.TRIM(Vname(1,idU2Sd))) THEN + got_var(idU2Sd)=.TRUE. + S(ng)%Vid(idU2Sd)=var_id(i) + ELSE IF (TRIM(var_name(i)).eq.TRIM(Vname(1,idV2Sd))) THEN + got_var(idV2Sd)=.TRUE. + S(ng)%Vid(idV2Sd)=var_id(i) +# ifdef SOLVE3D + ELSE IF (TRIM(var_name(i)).eq.TRIM(Vname(1,idU3rs))) THEN + got_var(idU3rs)=.TRUE. + S(ng)%Vid(idU3rs)=var_id(i) + ELSE IF (TRIM(var_name(i)).eq.TRIM(Vname(1,idV3rs))) THEN + got_var(idV3rs)=.TRUE. + S(ng)%Vid(idV3rs)=var_id(i) + ELSE IF (TRIM(var_name(i)).eq.TRIM(Vname(1,idU3Sd))) THEN + got_var(idU3Sd)=.TRUE. + S(ng)%Vid(idU3Sd)=var_id(i) + ELSE IF (TRIM(var_name(i)).eq.TRIM(Vname(1,idV3Sd))) THEN + got_var(idV3Sd)=.TRUE. + S(ng)%Vid(idV3Sd)=var_id(i) + ELSE IF (TRIM(var_name(i)).eq.TRIM(Vname(1,idW3Sd))) THEN + got_var(idW3Sd)=.TRUE. + S(ng)%Vid(idW3Sd)=var_id(i) + ELSE IF (TRIM(var_name(i)).eq.TRIM(Vname(1,idW3St))) THEN + got_var(idW3St)=.TRUE. + S(ng)%Vid(idW3St)=var_id(i) +# endif +# endif +# ifdef WEC_VF + ELSE IF (TRIM(var_name(i)).eq.TRIM(Vname(1,idWztw))) THEN + got_var(idWztw)=.TRUE. + S(ng)%Vid(idWztw)=var_id(i) + ELSE IF (TRIM(var_name(i)).eq.TRIM(Vname(1,idWqsp))) THEN + got_var(idWqsp)=.TRUE. + S(ng)%Vid(idWqsp)=var_id(i) + ELSE IF (TRIM(var_name(i)).eq.TRIM(Vname(1,idWbeh))) THEN + got_var(idWbeh)=.TRUE. + S(ng)%Vid(idWbeh)=var_id(i) +# endif +# if (defined BOTTOM_STREAMING && defined WEC_VF) || \ + defined WAV_COUPLING + ELSE IF (TRIM(var_name(i)).eq.TRIM(Vname(1,idWdif))) THEN + got_var(idWdif)=.TRUE. + S(ng)%Vid(idWdif)=var_id(i) +# endif +# if defined TKE_WAVEDISS || defined WAV_COUPLING || \ + defined WDISS_THORGUZA || defined WDISS_CHURTHOR || \ + defined WAVES_DISS || defined WDISS_INWAVE + ELSE IF (TRIM(var_name(i)).eq.TRIM(Vname(1,idWdib))) THEN + got_var(idWdib)=.TRUE. + S(ng)%Vid(idWdib)=var_id(i) + ELSE IF (TRIM(var_name(i)).eq.TRIM(Vname(1,idWdiw))) THEN + got_var(idWdiw)=.TRUE. + S(ng)%Vid(idWdiw)=var_id(i) +# endif +# ifdef ROLLER_SVENDSEN + ELSE IF (TRIM(var_name(i)).eq.TRIM(Vname(1,idWbrk))) THEN + got_var(idWbrk)=.TRUE. + S(ng)%Vid(idWbrk)=var_id(i) +# endif +# ifdef WEC_ROLLER + ELSE IF (TRIM(var_name(i)).eq.TRIM(Vname(1,idWdis))) THEN + got_var(idWdis)=.TRUE. + S(ng)%Vid(idWdis)=var_id(i) +# endif +# ifdef ROLLER_RENIERS + ELSE IF (TRIM(var_name(i)).eq.TRIM(Vname(1,idWrol))) THEN + got_var(idWrol)=.TRUE. + S(ng)%Vid(idWrol)=var_id(i) +# endif + END IF + END DO +! +! Check if output variables are available in input NetCDF file. +! + IF (.not.got_var(idtime)) THEN + IF (Master) WRITE (stdout,10) TRIM(Vname(1,idtime)), & + & TRIM(ncname) + exit_flag=3 + RETURN + END IF +# ifdef WEC + IF (.not.got_var(idU2rs).and.VarOut(idU2rs,ng)) THEN + IF (Master) WRITE (stdout,10) TRIM(Vname(1,idU2rs)), & + & TRIM(ncname) + exit_flag=3 + RETURN + END IF + IF (.not.got_var(idV2rs).and.VarOut(idV2rs,ng)) THEN + IF (Master) WRITE (stdout,10) TRIM(Vname(1,idV2rs)), & + & TRIM(ncname) + exit_flag=3 + RETURN + END IF + IF (.not.got_var(idU2Sd).and.VarOut(idU2Sd,ng)) THEN + IF (Master) WRITE (stdout,10) TRIM(Vname(1,idU2Sd)), & + & TRIM(ncname) + exit_flag=3 + RETURN + END IF + IF (.not.got_var(idV2Sd).and.VarOut(idV2Sd,ng)) THEN + IF (Master) WRITE (stdout,10) TRIM(Vname(1,idV2Sd)), & + & TRIM(ncname) + exit_flag=3 + RETURN + END IF +# ifdef SOLVE3D + IF (.not.got_var(idU3Sd).and.VarOut(idU3rs,ng)) THEN + IF (Master) WRITE (stdout,10) TRIM(Vname(1,idU3rs)), & + & TRIM(ncname) + exit_flag=3 + RETURN + END IF + IF (.not.got_var(idV3rs).and.VarOut(idV3rs,ng)) THEN + IF (Master) WRITE (stdout,10) TRIM(Vname(1,idV3rs)), & + & TRIM(ncname) + exit_flag=3 + RETURN + END IF + IF (.not.got_var(idU3Sd).and.VarOut(idU3Sd,ng)) THEN + IF (Master) WRITE (stdout,10) TRIM(Vname(1,idU3Sd)), & + & TRIM(ncname) + exit_flag=3 + RETURN + END IF + IF (.not.got_var(idV3Sd).and.VarOut(idV3Sd,ng)) THEN + IF (Master) WRITE (stdout,10) TRIM(Vname(1,idV3Sd)), & + & TRIM(ncname) + exit_flag=3 + RETURN + END IF + IF (.not.got_var(idW3Sd).and.VarOut(idW3Sd,ng)) THEN + IF (Master) WRITE (stdout,10) TRIM(Vname(1,idW3Sd)), & + & TRIM(ncname) + exit_flag=3 + RETURN + END IF + IF (.not.got_var(idW3St).and.VarOut(idW3St,ng)) THEN + IF (Master) WRITE (stdout,10) TRIM(Vname(1,idW3St)), & + & TRIM(ncname) + exit_flag=3 + RETURN + END IF +# endif +# endif +# ifdef WEC_VF + IF (.not.got_var(idWztw).and.VarOut(idWztw,ng)) THEN + IF (Master) WRITE (stdout,10) TRIM(Vname(1,idWztw)), & + & TRIM(ncname) + exit_flag=3 + RETURN + END IF + IF (.not.got_var(idWqsp).and.VarOut(idWqsp,ng)) THEN + IF (Master) WRITE (stdout,10) TRIM(Vname(1,idWqsp)), & + & TRIM(ncname) + exit_flag=3 + RETURN + END IF + IF (.not.got_var(idWbeh).and.VarOut(idWbeh,ng)) THEN + IF (Master) WRITE (stdout,10) TRIM(Vname(1,idWbeh)), & + & TRIM(ncname) + exit_flag=3 + RETURN + END IF +# endif +# if (defined BOTTOM_STREAMING && defined WEC_VF) || \ + defined WAV_COUPLING + IF (.not.got_var(idWdif).and.VarOut(idWdif,ng)) THEN + IF (Master) WRITE (stdout,10) TRIM(Vname(1,idWdif)), & + & TRIM(ncname) + exit_flag=3 + RETURN + END IF +# endif +# if defined TKE_WAVEDISS || defined WAV_COUPLING || \ + defined WDISS_THORGUZA || defined WDISS_CHURTHOR || \ + defined WAVES_DISS || defined WDISS_INWAVE + IF (.not.got_var(idWdib).and.VarOut(idWdib,ng)) THEN + IF (Master) WRITE (stdout,10) TRIM(Vname(1,idWdib)), & + & TRIM(ncname) + exit_flag=3 + RETURN + END IF + IF (.not.got_var(idWdiw).and.VarOut(idWdiw,ng)) THEN + IF (Master) WRITE (stdout,10) TRIM(Vname(1,idWdiw)), & + & TRIM(ncname) + exit_flag=3 + RETURN + END IF +# endif +# ifdef ROLLER_SVENDSEN + IF (.not.got_var(idWbrk).and.VarOut(idWbrk,ng)) THEN + IF (Master) WRITE (stdout,10) TRIM(Vname(1,idWbrk)), & + & TRIM(ncname) + exit_flag=3 + RETURN + END IF +# endif +# ifdef WEC_ROLLER + IF (.not.got_var(idWdis).and.VarOut(idWdis,ng)) THEN + IF (Master) WRITE (stdout,10) TRIM(Vname(1,idWdis)), & + & TRIM(ncname) + exit_flag=3 + RETURN + END IF +# endif +# ifdef ROLLER_RENIERS + IF (.not.got_var(idWrol).and.VarOut(idWrol,ng)) THEN + IF (Master) WRITE (stdout,10) TRIM(Vname(1,idWrol)), & + & TRIM(ncname) + exit_flag=3 + RETURN + END IF +# endif + END IF QUERY +! + 10 FORMAT (/,' WEC_DEF_NF90 - unable to find variable: ',a,2x, & + & ' in output NetCDF file: ',a) +! + RETURN + END SUBROUTINE wec_def_nf90 + +# ifdef STATIONS +! +!*********************************************************************** + SUBROUTINE wec_def_station_nf90 (ng, model, ldef, VarOut, S, & + & pgrd, rgrd) +!*********************************************************************** +! + USE mod_netcdf +! +! Imported variable declarations. +! + logical, intent(in) :: ldef, VarOut(NV,Ngrids) +! + integer, intent(in) :: ng, model + integer, intent(in), optional :: pgrd(:), rgrd(:) +! + TYPE(T_IO), intent(inout) :: S(Ngrids) +! +! Local variable declarations. +! + logical :: got_var(NV) +! + integer, parameter :: Natt = 25 + + integer :: i, j, status +! + real(r8) :: Aval(6) +! + character (len=120) :: Vinfo(Natt) + character (len=256) :: ncname +! + character (len=*), parameter :: MyFile = & + & __FILE__//", wec_def_station_nf90" +! + SourceFile=MyFile +! +!----------------------------------------------------------------------- +! Define Waves Effect on Currents output stations variables. +!----------------------------------------------------------------------- +! + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN + ncname=S(ng)%name +! + DEFINE : IF (ldef) THEN +! +! Initialize local information variable arrays. +! + DO i=1,Natt + DO j=1,LEN(Vinfo(1)) + Vinfo(i)(j:j)=' ' + END DO + END DO + DO i=1,6 + Aval(i)=0.0_r8 + END DO + +# ifdef WEC +! +! Define 2D Stokes U-velocity. +! + IF (VarOut(idU2Sd,ng)) THEN + Vinfo( 1)=Vname(1,idU2Sd) + Vinfo( 2)=Vname(2,idU2Sd) + Vinfo( 3)=Vname(3,idU2Sd) + Vinfo(14)=Vname(4,idU2Sd) + Vinfo(16)=Vname(1,idtime) + status=def_var(ng, model, S(ng)%ncid, S(ng)%Vid(idU2Sd), & + & NF_FOUT, 2, pgrd, Aval, Vinfo, ncname, & + & SetParAccess = .TRUE.) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN + END IF +! +! Define 2D Stokes V-velocity. +! + IF (VarOut(idV2Sd,ng)) THEN + Vinfo( 1)=Vname(1,idV2Sd) + Vinfo( 2)=Vname(2,idV2Sd) + Vinfo( 3)=Vname(3,idV2Sd) + Vinfo(14)=Vname(4,idV2Sd) + Vinfo(16)=Vname(1,idtime) + status=def_var(ng, model, S(ng)%ncid, S(ng)%Vid(idV2Sd), & + & NF_FOUT, 2, pgrd, Aval, Vinfo, ncname, & + & SetParAccess = .TRUE.) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN + END IF +! +! Define 2D total Waves Effect on Currents U-stress. +! + IF (VarOut(idU2rs,ng)) THEN + Vinfo( 1)=Vname(1,idU2rs) + Vinfo( 2)=Vname(2,idU2rs) + Vinfo( 3)=Vname(3,idU2rs) + Vinfo(14)=Vname(4,idU2rs) + Vinfo(16)=Vname(1,idtime) + status=def_var(ng, model, S(ng)%ncid, S(ng)%Vid(idU2rs), & + & NF_FOUT, 2, pgrd, Aval, Vinfo, ncname, & + & SetParAccess = .TRUE.) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN + END IF +! +! Define 2D total Waves Effect on Currents V-stress. +! + IF (VarOut(idV2rs,ng)) THEN + Vinfo( 1)=Vname(1,idV2rs) + Vinfo( 2)=Vname(2,idV2rs) + Vinfo( 3)=Vname(3,idV2rs) + Vinfo(14)=Vname(4,idV2rs) + Vinfo(16)=Vname(1,idtime) + status=def_var(ng, model, S(ng)%ncid, S(ng)%Vid(idV2rs), & + & NF_FOUT, 2, pgrd, Aval, Vinfo, ncname, & + & SetParAccess = .TRUE.) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN + END IF + +# ifdef SOLVE3D +! +! Define 3D Stokes U-velocity. +! + IF (VarOut(idU3Sd,ng)) THEN + Vinfo( 1)=Vname(1,idU3Sd) + Vinfo( 2)=Vname(2,idU3Sd) + Vinfo( 3)=Vname(3,idU3Sd) + Vinfo(14)=Vname(4,idU3Sd) + Vinfo(16)=Vname(1,idtime) + status=def_var(ng, model, S(ng)%ncid, S(ng)%Vid(idU3Sd), & + & NF_FOUT, 3, rgrd, Aval, Vinfo, ncname, & + & SetFillVal = .TRUE., & + & SetParAccess = .TRUE.) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN + END IF +! +! Define 3D Stokes V-velocity. +! + IF (VarOut(idV3Sd,ng)) THEN + Vinfo( 1)=Vname(1,idV3Sd) + Vinfo( 2)=Vname(2,idV3Sd) + Vinfo( 3)=Vname(3,idV3Sd) + Vinfo(14)=Vname(4,idV3Sd) + Vinfo(16)=Vname(1,idtime) + status=def_var(ng, model, S(ng)%ncid, S(ng)%Vid(idV3Sd), & + & NF_FOUT, 3, rgrd, Aval, Vinfo, ncname, & + & SetFillVal = .TRUE., & + & SetParAccess = .TRUE.) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN + END IF +! +! Define 3D Stokes omega-velocity. +! + IF (VarOut(idW3Sd,ng)) THEN + Vinfo( 1)=Vname(1,idW3Sd) + Vinfo( 2)=Vname(2,idW3Sd) + Vinfo( 3)=Vname(3,idW3Sd) + Vinfo(14)=Vname(4,idW3Sd) + Vinfo(16)=Vname(1,idtime) + status=def_var(ng, model, S(ng)%ncid, S(ng)%Vid(idW3Sd), & + & NF_FOUT, 3, rgrd, Aval, Vinfo, ncname, & + & SetFillVal = .TRUE., & + & SetParAccess = .TRUE.) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN + END IF +! +! Define 3D "true" Stokes W-velocity. +! + IF (VarOut(idW3St,ng)) THEN + Vinfo( 1)=Vname(1,idW3St) + Vinfo( 2)=Vname(2,idW3St) + Vinfo( 3)=Vname(3,idW3St) + Vinfo(14)=Vname(4,idW3St) + Vinfo(16)=Vname(1,idtime) + status=def_var(ng, model, S(ng)%ncid, S(ng)%Vid(idW3St), & + & NF_FOUT, 3, rgrd, Aval, Vinfo, ncname, & + & SetFillVal = .TRUE., & + & SetParAccess = .TRUE.) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN + END IF +! +! Define 3D total Waves Effect on Currents U-stress. +! + IF (VarOut(idU3rs,ng)) THEN + Vinfo( 1)=Vname(1,idU3rs) + Vinfo( 2)=Vname(2,idU3rs) + Vinfo( 3)=Vname(3,idU3rs) + Vinfo(14)=Vname(4,idU3rs) + Vinfo(16)=Vname(1,idtime) + status=def_var(ng, model, S(ng)%ncid, S(ng)%Vid(idU3rs), & + & NF_FOUT, 3, rgrd, Aval, Vinfo, ncname, & + & SetFillVal = .TRUE., & + & SetParAccess = .TRUE.) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN + END IF +! +! Define 3D total Waves Effect on Current V-stress. +! + IF (VarOut(idV3rs,ng)) THEN + Vinfo( 1)=Vname(1,idV3rs) + Vinfo( 2)=Vname(2,idV3rs) + Vinfo( 3)=Vname(3,idV3rs) + Vinfo(14)=Vname(4,idV3rs) + Vinfo(16)=Vname(1,idtime) + status=def_var(ng, model, S(ng)%ncid, S(ng)%Vid(idV3rs), & + & NF_FOUT, 3, rgrd, Aval, Vinfo, ncname, & + & SetFillVal = .TRUE., & + & SetParAccess = .TRUE.) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN + END IF +# endif +# endif +# ifdef WEC_VF +! +! Define Waves Effect on Currents quasi-static sea level adjustment. +! + IF (VarOut(idWztw,ng)) THEN + Vinfo( 1)=Vname(1,idWztw) + Vinfo( 2)=Vname(2,idWztw) + Vinfo( 3)=Vname(3,idWztw) + Vinfo(14)=Vname(4,idWztw) + Vinfo(16)=Vname(1,idtime) + status=def_var(ng, model, S(ng)%ncid, S(ng)%Vid(idWztw), & + & NF_FOUT, 2, pgrd, Aval, Vinfo, ncname, & + & SetFillVal = .TRUE., & + & SetParAccess = .TRUE.) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN + END IF +! +! Define Waves Effect on Currents quasi-static pressure. +! + IF (VarOut(idWqsp,ng)) THEN + Vinfo( 1)=Vname(1,idWqsp) + Vinfo( 2)=Vname(2,idWqsp) + Vinfo( 3)=Vname(3,idWqsp) + Vinfo(14)=Vname(4,idWqsp) + Vinfo(16)=Vname(1,idtime) + status=def_var(ng, model, S(ng)%ncid, S(ng)%Vid(idWqsp), & + & NF_FOUT, 2, pgrd, Aval, Vinfo, ncname, & + & SetFillVal = .TRUE., & + & SetParAccess = .TRUE.) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN + END IF +! +! Define Waves Effect on Currents Bernoulli head. +! + IF (VarOut(idWbeh,ng)) THEN + Vinfo( 1)=Vname(1,idWbeh) + Vinfo( 2)=Vname(2,idWbeh) + Vinfo( 3)=Vname(3,idWbeh) + Vinfo(14)=Vname(4,idWbeh) + Vinfo(16)=Vname(1,idtime) + status=def_var(ng, model, S(ng)%ncid, S(ng)%Vid(idWbeh), & + & NF_FOUT, 2, pgrd, Aval, Vinfo, ncname, & + & SetFillVal = .TRUE., & + & SetParAccess = .TRUE.) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN + END IF +# endif +# if (defined BOTTOM_STREAMING && defined WEC_VF) || \ + defined WAV_COUPLING +! +! Define wave dissipation due to bottom friction. +! + IF (VarOut(idWdif,ng)) THEN + Vinfo( 1)=Vname(1,idWdif) + Vinfo( 2)=Vname(2,idWdif) + Vinfo( 3)=Vname(3,idWdif) + Vinfo(14)=Vname(4,idWdif) + Vinfo(16)=Vname(1,idtime) + status=def_var(ng, model, S(ng)%ncid, S(ng)%Vid(idWdif), & + & NF_FOUT, 2, pgrd, Aval, Vinfo, ncname, & + & SetFillVal = .TRUE., & + & SetParAccess = .TRUE.) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN + END IF +# endif +# if defined TKE_WAVEDISS || defined WAV_COUPLING || \ + defined WDISS_THORGUZA || defined WDISS_CHURTHOR || \ + defined WAVES_DISS || defined WDISS_INWAVE +! +! Define wave dissipation due to breaking. +! + IF (VarOut(idWdib,ng)) THEN + Vinfo( 1)=Vname(1,idWdib) + Vinfo( 2)=Vname(2,idWdib) + Vinfo( 3)=Vname(3,idWdib) + Vinfo(14)=Vname(4,idWdib) + Vinfo(16)=Vname(1,idtime) + status=def_var(ng, model, S(ng)%ncid, S(ng)%Vid(idWdib), & + & NF_FOUT, 2, pgrd, Aval, Vinfo, ncname, & + & SetFillVal = .TRUE., & + & SetParAccess = .TRUE.) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN + END IF +! +! Define wave dissipation due to whitecapping. +! + IF (VarOut(idWdiw,ng)) THEN + Vinfo( 1)=Vname(1,idWdiw) + Vinfo( 2)=Vname(2,idWdiw) + Vinfo( 3)=Vname(3,idWdiw) + Vinfo(14)=Vname(4,idWdiw) + Vinfo(16)=Vname(1,idtime) + status=def_var(ng, model, S(ng)%ncid, S(ng)%Vid(idWdiw), & + & NF_FOUT, 2, pgrd, Aval, Vinfo, ncname, & + & SetFillVal = .TRUE., & + & SetParAccess = .TRUE.) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN + END IF +# endif +# ifdef ROLLER_SVENDSEN +! +! Define percent wave breaking. +! + IF (VarOut(idWbrk,ng)) THEN + Vinfo( 1)=Vname(1,idWbrk) + Vinfo( 2)=Vname(2,idWbrk) + Vinfo( 3)=Vname(3,idWbrk) + Vinfo(14)=Vname(4,idWbrk) + Vinfo(16)=Vname(1,idtime) + status=def_var(ng, model, S(ng)%ncid, S(ng)%Vid(idWbrk), & + & NF_FOUT, 2, pgrd, Aval, Vinfo, ncname, & + & SetFillVal = .TRUE., & + & SetParAccess = .TRUE.) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN + END IF +# endif +# ifdef WEC_ROLLER +! +! Define wave roller dissipation. +! + IF (VarOut(idWdis,ng)) THEN + Vinfo( 1)=Vname(1,idWdis) + Vinfo( 2)=Vname(2,idWdis) + Vinfo( 3)=Vname(3,idWdis) + Vinfo(14)=Vname(4,idWdis) + Vinfo(16)=Vname(1,idtime) + status=def_var(ng, model, S(ng)%ncid, S(ng)%Vid(idWdis), & + & NF_FOUT, 2, pgrd, Aval, Vinfo, ncname, & + & SetFillVal = .TRUE., & + & SetParAccess = .TRUE.) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN + END IF +# endif +# ifdef ROLLER_RENIERS +! +! Define wave roller action density. +! + IF (VarOut(idWrol,ng)) THEN + Vinfo( 1)=Vname(1,idWrol) + Vinfo( 2)=Vname(2,idWrol) + Vinfo( 3)=Vname(3,idWrol) + Vinfo(14)=Vname(4,idWrol) + Vinfo(16)=Vname(1,idtime) + status=def_var(ng, model, S(ng)%ncid, S(ng)%Vid(idWrol), & + & NF_FOUT, 2, pgrd, Aval, Vinfo, ncname, & + & SetFillVal = .TRUE., & + & SetParAccess = .TRUE.) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN + END IF +# endif + END IF DEFINE +! +!----------------------------------------------------------------------- +! Otherwise, check existing output file and prepare for appending +! data. +!----------------------------------------------------------------------- +! + QUERY : IF (.not.ldef) THEN +! +! Initialize locallogical switches. +! + DO i=1,NV + got_var(i)=.FALSE. + END DO +! +! Scan variable list from input NetCDF and activate switches for +! Waves Effect on Currents variables. Get variable IDs. +! + DO i=1,n_var + IF (TRIM(var_name(i)).eq.TRIM(Vname(1,idtime))) THEN + got_var(idtime)=.TRUE. + S(ng)%Vid(idtime)=var_id(i) +# ifdef WEC + ELSE IF (TRIM(var_name(i)).eq.TRIM(Vname(1,idU2Sd))) THEN + got_var(idU2Sd)=.TRUE. + S(ng)%Vid(idU2Sd)=var_id(i) + ELSE IF (TRIM(var_name(i)).eq.TRIM(Vname(1,idV2Sd))) THEN + got_var(idV2Sd)=.TRUE. + S(ng)%Vid(idV2Sd)=var_id(i) + ELSE IF (TRIM(var_name(i)).eq.TRIM(Vname(1,idU2rs))) THEN + got_var(idU2rs)=.TRUE. + S(ng)%Vid(idU2rs)=var_id(i) + ELSE IF (TRIM(var_name(i)).eq.TRIM(Vname(1,idV2rs))) THEN + got_var(idV2rs)=.TRUE. + S(ng)%Vid(idV2rs)=var_id(i) +# ifdef SOLVE3D + ELSE IF (TRIM(var_name(i)).eq.TRIM(Vname(1,idU3Sd))) THEN + got_var(idU3Sd)=.TRUE. + S(ng)%Vid(idU3Sd)=var_id(i) + ELSE IF (TRIM(var_name(i)).eq.TRIM(Vname(1,idV3Sd))) THEN + got_var(idV3Sd)=.TRUE. + S(ng)%Vid(idV3Sd)=var_id(i) + ELSE IF (TRIM(var_name(i)).eq.TRIM(Vname(1,idW3Sd))) THEN + got_var(idW3Sd)=.TRUE. + S(ng)%Vid(idW3Sd)=var_id(i) + ELSE IF (TRIM(var_name(i)).eq.TRIM(Vname(1,idW3St))) THEN + got_var(idW3St)=.TRUE. + S(ng)%Vid(idW3St)=var_id(i) + ELSE IF (TRIM(var_name(i)).eq.TRIM(Vname(1,idU3rs))) THEN + got_var(idU3rs)=.TRUE. + S(ng)%Vid(idU3rs)=var_id(i) + ELSE IF (TRIM(var_name(i)).eq.TRIM(Vname(1,idV3rs))) THEN + got_var(idV3rs)=.TRUE. + S(ng)%Vid(idV3rs)=var_id(i) +# endif +# endif +# ifdef WEC_VF + ELSE IF (TRIM(var_name(i)).eq.TRIM(Vname(1,idWztw))) THEN + got_var(idWztw)=.TRUE. + S(ng)%Vid(idWztw)=var_id(i) + ELSE IF (TRIM(var_name(i)).eq.TRIM(Vname(1,idWqsp))) THEN + got_var(idWqsp)=.TRUE. + S(ng)%Vid(idWqsp)=var_id(i) + ELSE IF (TRIM(var_name(i)).eq.TRIM(Vname(1,idWbeh))) THEN + got_var(idWbeh)=.TRUE. + S(ng)%Vid(idWbeh)=var_id(i) +# endif +# if (defined BOTTOM_STREAMING && defined WEC_VF) || \ + defined WAV_COUPLING + ELSE IF (TRIM(var_name(i)).eq.TRIM(Vname(1,idWdif))) THEN + got_var(idWdif)=.TRUE. + S(ng)%Vid(idWdif)=var_id(i) +# endif +# if defined TKE_WAVEDISS || defined WAV_COUPLING || \ + defined WDISS_THORGUZA || defined WDISS_CHURTHOR || \ + defined WAVES_DISS || defined WDISS_INWAVE + ELSE IF (TRIM(var_name(i)).eq.TRIM(Vname(1,idWdib))) THEN + got_var(idWdib)=.TRUE. + S(ng)%Vid(idWdib)=var_id(i) + ELSE IF (TRIM(var_name(i)).eq.TRIM(Vname(1,idWdiw))) THEN + got_var(idWdiw)=.TRUE. + S(ng)%Vid(idWdiw)=var_id(i) +# endif +# ifdef ROLLER_SVENDSEN + ELSE IF (TRIM(var_name(i)).eq.TRIM(Vname(1,idWbrk))) THEN + got_var(idWbrk)=.TRUE. + S(ng)%Vid(idWbrk)=var_id(i) +# endif +# ifdef WEC_ROLLER + ELSE IF (TRIM(var_name(i)).eq.TRIM(Vname(1,idWdis))) THEN + got_var(idWdis)=.TRUE. + S(ng)%Vid(idWdis)=var_id(i) +# endif +# ifdef ROLLER_RENIERS + ELSE IF (TRIM(var_name(i)).eq.TRIM(Vname(1,idWrol))) THEN + got_var(idWrol)=.TRUE. + S(ng)%Vid(idWrol)=var_id(i) +# endif + END IF + END DO +! +! Check if output variables are available in input NetCDF file. +! + IF (.not.got_var(idtime)) THEN + IF (Master) WRITE (stdout,10) TRIM(Vname(1,idtime)), & + & TRIM(ncname) + exit_flag=3 + RETURN + END IF +# ifdef WEC + IF (.not.got_var(idU2Sd).and.Sout(idU2Sd,ng)) THEN + IF (Master) WRITE (stdout,10) TRIM(Vname(1,idU2Sd)), & + & TRIM(ncname) + exit_flag=3 + RETURN + END IF + IF (.not.got_var(idV2Sd).and.Sout(idV2Sd,ng)) THEN + IF (Master) WRITE (stdout,10) TRIM(Vname(1,idV2Sd)), & + & TRIM(ncname) + exit_flag=3 + RETURN + END IF + IF (.not.got_var(idU2rs).and.Sout(idU2rs,ng)) THEN + IF (Master) WRITE (stdout,10) TRIM(Vname(1,idU2rs)), & + & TRIM(ncname) + exit_flag=3 + RETURN + END IF + IF (.not.got_var(idV2rs).and.Sout(idV2rs,ng)) THEN + IF (Master) WRITE (stdout,10) TRIM(Vname(1,idV2rs)), & + & TRIM(ncname) + exit_flag=3 + RETURN + END IF +# ifdef SOLVE3D + IF (.not.got_var(idU3Sd).and.Sout(idU3Sd,ng)) THEN + IF (Master) WRITE (stdout,10) TRIM(Vname(1,idU3Sd)), & + & TRIM(ncname) + exit_flag=3 + RETURN + END IF + IF (.not.got_var(idV3Sd).and.Sout(idV3Sd,ng)) THEN + IF (Master) WRITE (stdout,10) TRIM(Vname(1,idV3Sd)), & + & TRIM(ncname) + exit_flag=3 + RETURN + END IF + IF (.not.got_var(idW3Sd).and.Sout(idW3Sd,ng)) THEN + IF (Master) WRITE (stdout,10) TRIM(Vname(1,idW3Sd)), & + & TRIM(ncname) + exit_flag=3 + RETURN + END IF + IF (.not.got_var(idW3St).and.Sout(idW3St,ng)) THEN + IF (Master) WRITE (stdout,10) TRIM(Vname(1,idW3St)), & + & TRIM(ncname) + exit_flag=3 + RETURN + END IF + IF (.not.got_var(idU3Sd).and.Sout(idU3rs,ng)) THEN + IF (Master) WRITE (stdout,10) TRIM(Vname(1,idU3rs)), & + & TRIM(ncname) + exit_flag=3 + RETURN + END IF + IF (.not.got_var(idV3rs).and.Sout(idV3rs,ng)) THEN + IF (Master) WRITE (stdout,10) TRIM(Vname(1,idV3rs)), & + & TRIM(ncname) + exit_flag=3 + RETURN + END IF +# endif +# endif +# ifdef WEC_VF + IF (.not.got_var(idWztw).and.Sout(idWztw,ng)) THEN + IF (Master) WRITE (stdout,10) TRIM(Vname(1,idWztw)), & + & TRIM(ncname) + exit_flag=3 + RETURN + END IF + IF (.not.got_var(idWqsp).and.Sout(idWqsp,ng)) THEN + IF (Master) WRITE (stdout,10) TRIM(Vname(1,idWqsp)), & + & TRIM(ncname) + exit_flag=3 + RETURN + END IF + IF (.not.got_var(idWbeh).and.Sout(idWbeh,ng)) THEN + IF (Master) WRITE (stdout,10) TRIM(Vname(1,idWbeh)), & + & TRIM(ncname) + exit_flag=3 + RETURN + END IF +# endif +# if (defined BOTTOM_STREAMING && defined WEC_VF) || \ + defined WAV_COUPLING + IF (.not.got_var(idWdif).and.Sout(idWdif,ng)) THEN + IF (Master) WRITE (stdout,10) TRIM(Vname(1,idWdif)), & + & TRIM(ncname) + exit_flag=3 + RETURN + END IF +# endif +# if defined TKE_WAVEDISS || defined WAV_COUPLING || \ + defined WDISS_THORGUZA || defined WDISS_CHURTHOR || \ + defined WAVES_DISS || defined WDISS_INWAVE + IF (.not.got_var(idWdib).and.Sout(idWdib,ng)) THEN + IF (Master) WRITE (stdout,10) TRIM(Vname(1,idWdib)), & + & TRIM(ncname) + exit_flag=3 + RETURN + END IF + IF (.not.got_var(idWdiw).and.Sout(idWdiw,ng)) THEN + IF (Master) WRITE (stdout,10) TRIM(Vname(1,idWdiw)), & + & TRIM(ncname) + exit_flag=3 + RETURN + END IF +# endif +# ifdef ROLLER_SVENDSEN + IF (.not.got_var(idWbrk).and.Sout(idWbrk,ng)) THEN + IF (Master) WRITE (stdout,10) TRIM(Vname(1,idWbrk)), & + & TRIM(ncname) + exit_flag=3 + RETURN + END IF +# endif +# ifdef WEC_ROLLER + IF (.not.got_var(idWdis).and.Sout(idWdis,ng)) THEN + IF (Master) WRITE (stdout,10) TRIM(Vname(1,idWdis)), & + & TRIM(ncname) + exit_flag=3 + RETURN + END IF +# endif +# ifdef ROLLER_RENIERS + IF (.not.got_var(idWrol).and.Sout(idWrol,ng)) THEN + IF (Master) WRITE (stdout,10) TRIM(Vname(1,idWrol)), & + & TRIM(ncname) + exit_flag=3 + RETURN + END IF +# endif + END IF QUERY +! + 10 FORMAT (/,' WEC_DEF_STATION_NF90 - unable to find variable: ', & + & a,2x,' in output NetCDF file: ',a) +! + RETURN + END SUBROUTINE wec_def_station_nf90 +# endif +! +!*********************************************************************** + SUBROUTINE wec_wrt_nf90 (ng, model, tile, & + & LBi, UBi, LBj, UBj, & + & VarOut, S) +!*********************************************************************** +! + USE mod_netcdf +! +! Imported variable declarations. +! + logical, intent(in) :: VarOut(NV,Ngrids) +! + integer, intent(in) :: ng, model, tile + integer, intent(in) :: LBi, UBi, LBj, UBj +! + TYPE(T_IO), intent(inout) :: S(Ngrids) +! +! Local variable declarations. +! + logical :: Linstataneous +! + integer :: gfactor, gtype, status +! + real(dp) :: scale + +# ifdef SOLVE3D +! + real(r8), allocatable :: Wr3d(:,:,:) +# endif +! + character (len=*), parameter :: MyFile = & + & __FILE__//", wec_wrt_nf90" +! + SourceFile=MyFile +! +!----------------------------------------------------------------------- +! Write out Waves Effect on Currents output variables into specified +! output NetCDF file. +!----------------------------------------------------------------------- +! + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN +! +! Set grid type factor to write full (gfactor=1) fields or water +! points (gfactor=-1) fields only. +! +# if defined WRITE_WATER && defined MASKING + gfactor=-1 +# else + gfactor=1 +# endif +! +! Set instantaneous fields. +! + IF ((S(ng)%ncid.eq.HIS(ng)%ncid).or. & + & (S(ng)%ncid.eq.QCK(ng)%ncid)) THEN + Linstataneous=.TRUE. + ELSE + Linstataneous=.FALSE. ! time-averged fiels + END IF + +# ifdef WEC +! +! Write out 2D total Waves Effect on Currents U-stress. +! + IF (VarOut(idU2rs,ng)) THEN + scale=rho0 + gtype=gfactor*u2dvar + IF (Linstataneous) THEN + status=nf_fwrite2d(ng, model, S(ng)%ncid, idU2rs, & + & S(ng)%Vid(idU2rs), & + & S(ng)%Rindex, gtype, & + & LBi, UBi, LBj, UBj, scale, & +# ifdef MASKING + & GRID(ng) % umask, & +# endif + & MIXING(ng) % rustr2d) +# ifdef AVERAGES + ELSE + status=nf_fwrite2d(ng, model, S(ng)%ncid, idU2rs, & + & S(ng)%Vid(idU2rs), & + & S(ng)%Rindex, gtype, & + & LBi, UBi, LBj, UBj, scale, & +# ifdef MASKING + & GRID(ng) % umask, & +# endif + & AVERAGE(ng) % avgu2rs) +# endif + END IF + IF (FoundError(status, nf90_noerr, __LINE__, MyFile)) THEN + IF (Master) THEN + WRITE (stdout,10) TRIM(Vname(1,idU2rs)), S(ng)%Rindex + END IF + exit_flag=3 + ioerror=status + RETURN + END IF + END IF +! +! Write out 2D total Waves Effect on Currents V-stress. +! + IF (VarOut(idV2rs,ng)) THEN + scale=rho0 + gtype=gfactor*v2dvar + IF (Linstataneous) THEN + status=nf_fwrite2d(ng, model, S(ng)%ncid, idV2rs, & + & S(ng)%Vid(idV2rs), & + & S(ng)%Rindex, gtype, & + & LBi, UBi, LBj, UBj, scale, & +# ifdef MASKING + & GRID(ng) % vmask, & +# endif + & MIXING(ng) % rvstr2d) +# ifdef AVERAGES + ELSE + status=nf_fwrite2d(ng, model, S(ng)%ncid, idV2rs, & + & S(ng)%Vid(idV2rs), & + & S(ng)%Rindex, gtype, & + & LBi, UBi, LBj, UBj, scale, & +# ifdef MASKING + & GRID(ng) % vmask, & +# endif + & AVERAGE(ng) % avgv2rs) +# endif + END IF + IF (FoundError(status, nf90_noerr, __LINE__, MyFile)) THEN + IF (Master) THEN + WRITE (stdout,10) TRIM(Vname(1,idV2rs)), S(ng)%Rindex + END IF + exit_flag=3 + ioerror=status + RETURN + END IF + END IF +! +! Write out 2D Stokes U-velocity. +! + IF (VarOut(idU2Sd,ng)) THEN + scale=1.0_dp + gtype=gfactor*u2dvar + IF (Linstataneous) THEN + status=nf_fwrite2d(ng, model, S(ng)%ncid, idU2sd, & + & S(ng)%Vid(idU2sd), & + & S(ng)%Rindex, gtype, & + & LBi, UBi, LBj, UBj, scale, & +# ifdef MASKING + & GRID(ng) % umask, & +# endif + & OCEAN(ng) % ubar_stokes) +# ifdef AVERAGES + ELSE + status=nf_fwrite2d(ng, model, S(ng)%ncid, idU2sd, & + & S(ng)%Vid(idU2sd), & + & S(ng)%Rindex, gtype, & + & LBi, UBi, LBj, UBj, scale, & +# ifdef MASKING + & GRID(ng) % umask, & +# endif + & AVERAGE(ng) % avgu2Sd) +# endif + END IF + IF (FoundError(status, nf90_noerr, __LINE__, MyFile)) THEN + IF (Master) THEN + WRITE (stdout,10) TRIM(Vname(1,idU2Sd)), S(ng)%Rindex + END IF + exit_flag=3 + ioerror=status + RETURN + END IF + END IF +! +! Write out 2D Stokes V-velocity. +! + IF (VarOut(idV2Sd,ng)) THEN + scale=1.0_dp + gtype=gfactor*v2dvar + IF (Linstataneous) THEN + status=nf_fwrite2d(ng, model, S(ng)%ncid, idV2sd, & + & S(ng)%Vid(idV2sd), & + & S(ng)%Rindex, gtype, & + & LBi, UBi, LBj, UBj, scale, & +# ifdef MASKING + & GRID(ng) % vmask, & +# endif + & OCEAN(ng) % vbar_stokes) +# ifdef AVERAGES + ELSE + status=nf_fwrite2d(ng, model, S(ng)%ncid, idV2sd, & + & S(ng)%Vid(idV2sd), & + & S(ng)%Rindex, gtype, & + & LBi, UBi, LBj, UBj, scale, & +# ifdef MASKING + & GRID(ng) % vmask, & +# endif + & AVERAGE(ng) % avgv2Sd) +# endif + END IF + IF (FoundError(status, nf90_noerr, __LINE__, MyFile)) THEN + IF (Master) THEN + WRITE (stdout,10) TRIM(Vname(1,idV2Sd)), S(ng)%Rindex + END IF + exit_flag=3 + ioerror=status + RETURN + END IF + END IF + +# ifdef SOLVE3D +! +! Write out 3D total Waves Effect on Currents U-stress. +! + IF (VarOut(idU3rs,ng)) THEN + scale=rho0 + gtype=gfactor*u3dvar + IF (Linstataneous) THEN + status=nf_fwrite3d(ng, model, S(ng)%ncid, idU3rs, & + & S(ng)%Vid(idU3rs), & + & S(ng)%Rindex, gtype, & + & LBi, UBi, LBj, UBj, 1, N(ng), scale, & +# ifdef MASKING + & GRID(ng) % umask, & +# endif + & MIXING(ng) % rustr3d) +# ifdef AVERAGES + ELSE + status=nf_fwrite3d(ng, model, S(ng)%ncid, idU3rs, & + & S(ng)%Vid(idU3rs), & + & S(ng)%Rindex, gtype, & + & LBi, UBi, LBj, UBj, 1, N(ng), scale, & +# ifdef MASKING + & GRID(ng) % umask, & +# endif + & AVERAGE(ng) % avgu3rs) +# endif + END IF + IF (FoundError(status, nf90_noerr, __LINE__, MyFile)) THEN + IF (Master) THEN + WRITE (stdout,10) TRIM(Vname(1,idU3rs)), S(ng)%Rindex + END IF + exit_flag=3 + ioerror=status + RETURN + END IF + END IF +! +! Write out 3D total Waves Effect on Currents V-stress. +! + IF (VarOut(idV3rs,ng)) THEN + scale=rho0 + gtype=gfactor*v3dvar + IF (Linstataneous) THEN + status=nf_fwrite3d(ng, model, S(ng)%ncid, idV3rs, & + & S(ng)%Vid(idV3rs), & + & S(ng)%Rindex, gtype, & + & LBi, UBi, LBj, UBj, 1, N(ng), scale, & +# ifdef MASKING + & GRID(ng) % vmask, & +# endif + & MIXING(ng) % rvstr3d) +# ifdef AVERAGES + ELSE + status=nf_fwrite3d(ng, model, S(ng)%ncid, idV3rs, & + & S(ng)%Vid(idV3rs), & + & S(ng)%Rindex, gtype, & + & LBi, UBi, LBj, UBj, 1, N(ng), scale, & +# ifdef MASKING + & GRID(ng) % vmask, & +# endif + & AVERAGE(ng) % avgv3rs) +# endif + END IF + IF (FoundError(status, nf90_noerr, __LINE__, MyFile)) THEN + IF (Master) THEN + WRITE (stdout,10) TRIM(Vname(1,idV3rs)), S(ng)%Rindex + END IF + exit_flag=3 + ioerror=status + RETURN + END IF + END IF +! +! Write out 3D Stokes U-velocity. +! + IF (VarOut(idU3Sd,ng)) THEN + scale=1.0_dp + gtype=gfactor*u3dvar + IF (Linstataneous) THEN + status=nf_fwrite3d(ng, model, S(ng)%ncid, idU3Sd, & + & S(ng)%Vid(idU3Sd), & + & S(ng)%Rindex, gtype, & + & LBi, UBi, LBj, UBj, 1, N(ng), scale, & +# ifdef MASKING + & GRID(ng) % umask, & +# endif + & OCEAN(ng) % u_stokes) +# ifdef AVERAGES + ELSE + status=nf_fwrite3d(ng, model, S(ng)%ncid, idU3Sd, & + & S(ng)%Vid(idU3Sd), & + & S(ng)%Rindex, gtype, & + & LBi, UBi, LBj, UBj, 1, N(ng), scale, & +# ifdef MASKING + & GRID(ng) % umask, & +# endif + & AVERAGE(ng) % avgu3Sd) +# endif + END IF + IF (FoundError(status, nf90_noerr, __LINE__, MyFile)) THEN + IF (Master) THEN + WRITE (stdout,10) TRIM(Vname(1,idU3Sd)), S(ng)%Rindex + END IF + exit_flag=3 + ioerror=status + RETURN + END IF + END IF +! +! Write out 3D Stokes V-velocity. +! + IF (VarOut(idV3Sd,ng)) THEN + scale=1.0_dp + gtype=gfactor*v3dvar + IF (Linstataneous) THEN + status=nf_fwrite3d(ng, model, S(ng)%ncid, idV3Sd, & + & S(ng)%Vid(idV3Sd), & + & S(ng)%Rindex, gtype, & + & LBi, UBi, LBj, UBj, 1, N(ng), scale, & +# ifdef MASKING + & GRID(ng) % vmask, & +# endif + & OCEAN(ng) % v_stokes) +# ifdef AVERAGES + ELSE + status=nf_fwrite3d(ng, model, S(ng)%ncid, idV3Sd, & + & S(ng)%Vid(idV3Sd), & + & S(ng)%Rindex, gtype, & + & LBi, UBi, LBj, UBj, 1, N(ng), scale, & +# ifdef MASKING + & GRID(ng) % vmask, & +# endif + & AVERAGE(ng) % avgv3Sd) +# endif + END IF + IF (FoundError(status, nf90_noerr, __LINE__, MyFile)) THEN + IF (Master) THEN + WRITE (stdout,10) TRIM(Vname(1,idV3Sd)), S(ng)%Rindex + END IF + exit_flag=3 + ioerror=status + RETURN + END IF + END IF +! +! Write out 3D Stokes omega-velocity. +! + IF (VarOut(idW3Sd,ng)) THEN + scale=1.0_dp + gtype=gfactor*w3dvar + IF (Linstataneous) THEN + IF (.not.allocated(Wr3d)) THEN + allocate (Wr3d(LBi:UBi,LBj:UBj,0:N(ng))) + Wr3d(LBi:UBi,LBj:UBj,0:N(ng))=0.0_r8 + END IF + CALL scale_omega (ng, tile, LBi, UBi, LBj, UBj, 0, N(ng), & + & GRID(ng) % pm, & + & GRID(ng) % pn, & + & OCEAN(ng) % W_stokes, & + & Wr3d) + status=nf_fwrite3d(ng, model, S(ng)%ncid, idW3Sd, & + & S(ng)%Vid(idW3Sd), & + & S(ng)%Rindex, gtype, & + & LBi, UBi, LBj, UBj, 0, N(ng), scale, & +# ifdef MASKING + & GRID(ng) % rmask, & +# endif + & Wr3d) + deallocate (Wr3d) +# ifdef AVERAGES + ELSE + status=nf_fwrite3d(ng, model, S(ng)%ncid, idW3Sd, & + & S(ng)%Vid(idW3Sd), & + & S(ng)%Rindex, gtype, & + & LBi, UBi, LBj, UBj, 0, N(ng), scale, & +# ifdef MASKING + & GRID(ng) % rmask, & +# endif + & AVERAGE(ng) % avgw3d) +# endif + END IF + IF (FoundError(status, nf90_noerr, __LINE__, MyFile)) THEN + IF (Master) THEN + WRITE (stdout,10) TRIM(Vname(1,idW3Sd)), S(ng)%Rindex + END IF + exit_flag=3 + ioerror=status + RETURN + END IF + END IF +! +! Write out 3D Stokes 'true' W-velocity (m/s) +! + IF (VarOut(idW3St,ng)) THEN + scale=1.0_dp + gtype=gfactor*w3dvar + IF (Linstataneous) THEN + status=nf_fwrite3d(ng, model, S(ng)%ncid, idW3St, & + & S(ng)%Vid(idW3St), & + & S(ng)%Rindex, gtype, & + & LBi, UBi, LBj, UBj, 0, N(ng), scale, & +# ifdef MASKING + & GRID(ng) % rmask, & +# endif + & OCEAN(ng) % wstvel) +# ifdef AVERAGES + ELSE + status=nf_fwrite3d(ng, model, S(ng)%ncid, idW3St, & + & S(ng)%Vid(idW3St), & + & S(ng)%Rindex, gtype, & + & LBi, UBi, LBj, UBj, 0, N(ng), scale, & +# ifdef MASKING + & GRID(ng) % rmask, & +# endif + & AVERAGE(ng) % avgW3St) +# endif + END IF + IF (FoundError(status, nf90_noerr, __LINE__, MyFile)) THEN + IF (Master) THEN + WRITE (stdout,10) TRIM(Vname(1,idW3St)), S(ng)%Rindex + END IF + exit_flag=3 + ioerror=status + RETURN + END IF + END IF +# endif +# endif +# ifdef WEC_VF +! +! Write out Waves Effect on Currents quasi-static sea level adjustment. +! + IF (VarOut(idWztw,ng)) THEN + scale=1.0_dp + gtype=gfactor*r2dvar + IF (Linstataneous) THEN + status=nf_fwrite2d(ng, model, S(ng)%ncid, idWztw, & + & S(ng)%Vid(idWztw), & + & S(ng)%Rindex, gtype, & + & LBi, UBi, LBj, UBj, scale, & +# ifdef MASKING + & GRID(ng) % rmask, & +# endif + & OCEAN(ng) % zetaw) +# ifdef AVERAGES + ELSE + status=nf_fwrite2d(ng, model, S(ng)%ncid, idWztw, & + & S(ng)%Vid(idWztw), & + & S(ng)%Rindex, gtype, & + & LBi, UBi, LBj, UBj, scale, & +# ifdef MASKING + & GRID(ng) % rmask, & +# endif + & AVERAGE(ng) % avgWztw) +# endif + END IF + IF (FoundError(status, nf90_noerr, __LINE__, MyFile)) THEN + IF (Master) THEN + WRITE (stdout,10) TRIM(Vname(1,idWztw)), S(ng)%Rindex + END IF + exit_flag=3 + ioerror=status + RETURN + END IF + END IF +! +! Write out Waves Effect on Currents quasi-static pressure. +! + IF (VarOut(idWqsp,ng)) THEN + scale=1.0_dp + gtype=gfactor*r2dvar + IF (Linstataneous) THEN + status=nf_fwrite2d(ng, model, S(ng)%ncid, idWqsp, & + & S(ng)%Vid(idWqsp), & + & S(ng)%Rindex, gtype, & + & LBi, UBi, LBj, UBj, scale, & +# ifdef MASKING + & GRID(ng) % rmask, & +# endif + & OCEAN(ng) % qsp) +# ifdef AVERAGES + ELSE + status=nf_fwrite2d(ng, model, S(ng)%ncid, idWqsp, & + & S(ng)%Vid(idWqsp), & + & S(ng)%Rindex, gtype, & + & LBi, UBi, LBj, UBj, scale, & +# ifdef MASKING + & GRID(ng) % rmask, & +# endif + & AVERAGE(ng) % avgWqsp) +# endif + END IF + IF (FoundError(status, nf90_noerr, __LINE__, MyFile)) THEN + IF (Master) THEN + WRITE (stdout,10) TRIM(Vname(1,idWqsp)), S(ng)%Rindex + END IF + exit_flag=3 + ioerror=status + RETURN + END IF + END IF +! +! Write out Waves Effect on Currents Bernoulli head. +! + IF (VarOut(idWbeh,ng)) THEN + scale=1.0_dp + gtype=gfactor*r2dvar + IF (Linstataneous) THEN + status=nf_fwrite2d(ng, model, S(ng)%ncid, idWbeh, & + & S(ng)%Vid(idWbeh), & + & S(ng)%Rindex, gtype, & + & LBi, UBi, LBj, UBj, scale, & +# ifdef MASKING + & GRID(ng) % rmask, & +# endif + & OCEAN(ng) % bh) +# ifdef AVERAGES + ELSE + status=nf_fwrite2d(ng, model, S(ng)%ncid, idWbeh, & + & S(ng)%Vid(idWbeh), & + & S(ng)%Rindex, gtype, & + & LBi, UBi, LBj, UBj, scale, & +# ifdef MASKING + & GRID(ng) % rmask, & +# endif + & AVERAGE(ng) % avgWbeh) +# endif + END IF + IF (FoundError(status, nf90_noerr, __LINE__, MyFile)) THEN + IF (Master) THEN + WRITE (stdout,10) TRIM(Vname(1,idWbeh)), S(ng)%Rindex + END IF + exit_flag=3 + ioerror=status + RETURN + END IF + END IF +# endif +# if (defined BOTTOM_STREAMING && defined WEC_VF) || \ + defined WAV_COUPLING +! +! Write out wave dissipation due to bottom friction. +! + IF (VarOut(idWdif,ng)) THEN + scale=rho0 ! W m /kg to W/m2 + gtype=gfactor*r2dvar + IF (Linstataneous) THEN + status=nf_fwrite2d(ng, model, S(ng)%ncid, idWdif, & + & S(ng)%Vid(idWdif), & + & S(ng)%Rindex, gtype, & + & LBi, UBi, LBj, UBj, scale, & +# ifdef MASKING + & GRID(ng) % rmask, & +# endif + & FORCES(ng) % Dissip_fric) +# ifdef AVERAGES + ELSE + status=nf_fwrite2d(ng, model, S(ng)%ncid, idWdif, & + & S(ng)%Vid(idWdif), & + & S(ng)%Rindex, gtype, & + & LBi, UBi, LBj, UBj, scale, & +# ifdef MASKING + & GRID(ng) % rmask, & +# endif + & AVERAGE(ng) % avgWdif) +# endif + END IF + IF (FoundError(status, nf90_noerr, __LINE__, MyFile)) THEN + IF (Master) THEN + WRITE (stdout,10) TRIM(Vname(1,idWdif)), S(ng)%Rindex + END IF + exit_flag=3 + ioerror=status + RETURN + END IF + END IF +# endif +# if defined TKE_WAVEDISS || defined WAV_COUPLING || \ + defined WDISS_THORGUZA || defined WDISS_CHURTHOR || \ + defined WAVES_DISS || defined WDISS_INWAVE +! +! Write out wave dissipation due to breaking. +! + IF (VarOut(idWdib,ng)) THEN + scale=rho0 ! W m /kg to W/m2 + gtype=gfactor*r2dvar + IF (Linstataneous) THEN + status=nf_fwrite2d(ng, model, S(ng)%ncid, idWdib, & + & S(ng)%Vid(idWdib), & + & S(ng)%Rindex, gtype, & + & LBi, UBi, LBj, UBj, scale, & +# ifdef MASKING + & GRID(ng) % rmask, & +# endif + & FORCES(ng) % Dissip_break) +# ifdef AVERAGES + ELSE + status=nf_fwrite2d(ng, model, S(ng)%ncid, idWdib, & + & S(ng)%Vid(idWdib), & + & S(ng)%Rindex, gtype, & + & LBi, UBi, LBj, UBj, scale, & +# ifdef MASKING + & GRID(ng) % rmask, & +# endif + & AVERAGE(ng) % avgWdib) +# endif + END IF + IF (FoundError(status, nf90_noerr, __LINE__, MyFile)) THEN + IF (Master) THEN + WRITE (stdout,10) TRIM(Vname(1,idWdib)), S(ng)%Rindex + END IF + exit_flag=3 + ioerror=status + RETURN + END IF + END IF +! +! Write out wave dissipation due to whitecapping. +! + IF (VarOut(idWdiw,ng)) THEN + scale=rho0 ! W m /kg to W/m2 + gtype=gfactor*r2dvar + IF (Linstataneous) THEN + status=nf_fwrite2d(ng, model, S(ng)%ncid, idWdiw, & + & S(ng)%Vid(idWdiw), & + & S(ng)%Rindex, gtype, & + & LBi, UBi, LBj, UBj, scale, & +# ifdef MASKING + & GRID(ng) % rmask, & +# endif + & FORCES(ng) % Dissip_wcap) +# ifdef AVERAGES + ELSE + status=nf_fwrite2d(ng, model, S(ng)%ncid, idWdiw, & + & S(ng)%Vid(idWdiw), & + & S(ng)%Rindex, gtype, & + & LBi, UBi, LBj, UBj, scale, & +# ifdef MASKING + & GRID(ng) % rmask, & +# endif + & AVERAGE(ng) % avgWdiw) +# endif + END IF + IF (FoundError(status, nf90_noerr, __LINE__, MyFile)) THEN + IF (Master) THEN + WRITE (stdout,10) TRIM(Vname(1,idWdiw)), S(ng)%Rindex + END IF + exit_flag=3 + ioerror=status + RETURN + END IF + END IF +# endif +# ifdef ROLLER_SVENDSEN +! +! Write out percent wave breaking. +! + IF (VarOut(idWbrk,ng)) THEN + scale=1.0_dp + gtype=gfactor*r2dvar + IF (Linstataneous) THEN + status=nf_fwrite2d(ng, model, S(ng)%ncid, idWbrk, & + & S(ng)%Vid(idWbrk), & + & S(ng)%Rindex, gtype, & + & LBi, UBi, LBj, UBj, scale, & +# ifdef MASKING + & GRID(ng) % rmask, & +# endif + & FORCES(ng) % Wave_break) +# ifdef AVERAGES + ELSE + status=nf_fwrite2d(ng, model, S(ng)%ncid, idWbrk, & + & S(ng)%Vid(idWbrk), & + & S(ng)%Rindex, gtype, & + & LBi, UBi, LBj, UBj, scale, & +# ifdef MASKING + & GRID(ng) % rmask, & +# endif + & AVERAGE(ng) % avgWbrk) +# endif + END IF + IF (FoundError(status, nf90_noerr, __LINE__, MyFile)) THEN + IF (Master) THEN + WRITE (stdout,10) TRIM(Vname(1,idWbrk)), S(ng)%Rindex + END IF + exit_flag=3 + ioerror=status + RETURN + END IF + END IF +# endif +# ifdef WEC_ROLLER +! +! Write out wave roller dissipation. +! + IF (VarOut(idWdis,ng)) THEN + scale=1.0_dp + gtype=gfactor*r2dvar + IF (Linstataneous) THEN + status=nf_fwrite2d(ng, model, S(ng)%ncid, idWdis, & + & S(ng)%Vid(idWdis), & + & S(ng)%Rindex, gtype, & + & LBi, UBi, LBj, UBj, scale, & +# ifdef MASKING + & GRID(ng) % rmask, & +# endif + & FORCES(ng) % Dissip_roller) +# ifdef AVERAGES + ELSE + status=nf_fwrite2d(ng, model, S(ng)%ncid, idWdis, & + & S(ng)%Vid(idWdis), & + & S(ng)%Rindex, gtype, & + & LBi, UBi, LBj, UBj, scale, & +# ifdef MASKING + & GRID(ng) % rmask, & +# endif + & AVERAGE(ng) % avgWdis) +# endif + END IF + IF (FoundError(status, nf90_noerr, __LINE__, MyFile)) THEN + IF (Master) THEN + WRITE (stdout,10) TRIM(Vname(1,idWdis)), S(ng)%Rindex + END IF + exit_flag=3 + ioerror=status + RETURN + END IF + END IF +# endif +# ifdef ROLLER_RENIERS +! +! Write out roller wave action density. +! + IF (VarOut(idWrol,ng)) THEN + scale=1.0_dp + gtype=gfactor*r2dvar + IF (Linstataneous) THEN + status=nf_fwrite2d(ng, model, S(ng)%ncid, idWrol, & + & S(ng)%Vid(idWrol), & + & S(ng)%Rindex, gtype, & + & LBi, UBi, LBj, UBj, scale, & +# ifdef MASKING + & GRID(ng) % rmask, & +# endif + & FORCES(ng) % rollA) +# ifdef AVERAGES + ELSE + status=nf_fwrite2d(ng, model, S(ng)%ncid, idWrol, & + & S(ng)%Vid(idWrol), & + & S(ng)%Rindex, gtype, & + & LBi, UBi, LBj, UBj, scale, & +# ifdef MASKING + & GRID(ng) % rmask, & +# endif + & AVERAGE(ng) % avgWrol) +# endif + END IF + IF (FoundError(status, nf90_noerr, __LINE__, MyFile)) THEN + IF (Master) THEN + WRITE (stdout,10) TRIM(Vname(1,idWrol)), S(ng)%Rindex + END IF + exit_flag=3 + ioerror=status + RETURN + END IF + END IF +# endif +! + 10 FORMAT (/," WEC_WRT_NF90 - error while writing variable '",a, & + & "', time record = ",i0,/,11x,'into file: ',a) +! + RETURN + END SUBROUTINE wec_wrt_nf90 + +# ifdef STATIONS +! +!*********************************************************************** + SUBROUTINE wec_wrt_station_nf90 (ng, model, tile, & + & LBi, UBi, LBj, UBj, & + & VarOut, S) +!*********************************************************************** +! + USE mod_netcdf +! +! Imported variable declarations. +! + logical, intent(in) :: VarOut(NV,Ngrids) +! + integer, intent(in) :: ng, model, tile + integer, intent(in) :: LBi, UBi, LBj, UBj +! + TYPE(T_IO), intent(inout) :: S(Ngrids) +! +! Local variable declarations. +! + logical :: Cgrid +! + integer :: NposR, NposW + integer :: i, k, np, status +! + real(dp) :: scale +! + real(r8), dimension(Nstation(ng)) :: Xpos, Ypos, Zpos, psta +# ifdef SOLVE3D + real(r8), dimension(Nstation(ng)*(N(ng))) :: XposR, YposR, ZposR + real(r8), dimension(Nstation(ng)*(N(ng)+1)) :: XposW, YposW, ZposW + real(r8), dimension(Nstation(ng)*(N(ng)+1)) :: rsta +# endif +! + character (len=*), parameter :: MyFile = & + & __FILE__//", wec_wrt_station_nf90" +! + SourceFile=MyFile +! +!----------------------------------------------------------------------- +! Write out Waves Effect on Currents output variables into specified +! stations output NetCDF file. +!----------------------------------------------------------------------- +! + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN +! +! Set switch to extract station data at native C-grid position (TRUE) +! or at RHO-points (FALSE). +! +# ifdef STATIONS_CGRID + Cgrid=.TRUE. +# else + Cgrid=.FALSE. +# endif +! +! Set positions for generic extraction routine. +! + NposR=Nstation(ng)*N(ng) + NposW=Nstation(ng)*(N(ng)+1) + DO i=1,Nstation(ng) + Xpos(i)=SCALARS(ng)%SposX(i) + Ypos(i)=SCALARS(ng)%SposY(i) + Zpos(i)=1.0_r8 +# ifdef SOLVE3D + DO k=1,N(ng) + np=k+(i-1)*N(ng) + XposR(np)=SCALARS(ng)%SposX(i) + YposR(np)=SCALARS(ng)%SposY(i) + ZposR(np)=REAL(k,r8) + END DO + DO k=0,N(ng) + np=k+1+(i-1)*(N(ng)+1) + XposW(np)=SCALARS(ng)%SposX(i) + YposW(np)=SCALARS(ng)%SposY(i) + ZposW(np)=REAL(k,r8) + END DO +# endif + END DO + +# ifdef WEC +! +! Write out 2D Stokes U-velocity. +! + IF (VarOut(idU2Sd,ng)) THEN + scale=1.0_dp + CALL extract_sta2d (ng, model, Cgrid, idU2Sd, u2dvar, & + & LBi, UBi, LBj, UBj, & + & scale, OCEAN(ng) % ubar_stokes, & + & Nstation(ng), Xpos, Ypos, psta) + CALL netcdf_put_fvar (ng, model, S(ng)%name, & + & TRIM(Vname(1,idU2Sd)), psta, & + & (/1,S(ng)%Rindex/), (/Nstation(ng),1/), & + & ncid = S(ng)%ncid, & + & varid = S(ng)%Vid(idU2Sd)) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN + END IF +! +! Write out 2D Stokes V-velocity. +! + IF (VarOut(idV2Sd,ng)) THEN + scale=1.0_dp + CALL extract_sta2d (ng, model, Cgrid, idV2Sd, v2dvar, & + & LBi, UBi, LBj, UBj, & + & scale, OCEAN(ng) % vbar_stokes, & + & Nstation(ng), Xpos, Ypos, psta) + CALL netcdf_put_fvar (ng, model, S(ng)%name, & + & TRIM(Vname(1,idV2Sd)), psta, & + & (/1,S(ng)%Rindex/), (/Nstation(ng),1/), & + & ncid = S(ng)%ncid, & + & varid = S(ng)%Vid(idV2Sd)) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN + END IF +! +! Write out 2D total Waves Effect on Currents U-stress. +! + IF (VarOut(idU2rs,ng)) THEN + scale=rho0 + CALL extract_sta2d (ng, model, Cgrid, idU2rs, u2dvar, & + & LBi, UBi, LBj, UBj, & + & scale, MIXING(ng) % rustr2d, & + & Nstation(ng), Xpos, Ypos, psta) + CALL netcdf_put_fvar (ng, model, S(ng)%name, & + & TRIM(Vname(1,idU2rs)), psta, & + & (/1,S(ng)%Rindex/), (/Nstation(ng),1/), & + & ncid = S(ng)%ncid, & + & varid = S(ng)%Vid(idU2rs)) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN + END IF +! +! Write out 2D total Waves Effect on Currents V-stress. +! + IF (VarOut(idV2rs,ng)) THEN + scale=rho0 + CALL extract_sta2d (ng, model, Cgrid, idV2rs, v2dvar, & + & LBi, UBi, LBj, UBj, & + & scale, MIXING(ng) % rvstr2d, & + & Nstation(ng), Xpos, Ypos, psta) + CALL netcdf_put_fvar (ng, model, S(ng)%name, & + & TRIM(Vname(1,idV2rs)), psta, & + & (/1,S(ng)%Rindex/), (/Nstation(ng),1/), & + & ncid = S(ng)%ncid, & + & varid = S(ng)%Vid(idV2rs)) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN + END IF + +# ifdef SOLVE3D +! +! Write out 3D Stokes U-velocity. +! + IF (VarOut(idU3Sd,ng)) THEN + scale=1.0_dp + CALL extract_sta3d (ng, model, Cgrid, idU3Sd, u3dvar, & + & LBi, UBi, LBj, UBj, 1, N(ng), & + & scale, OCEAN(ng) % u_stokes, & + & NposR, XposR, YposR, ZposR, rsta) + CALL netcdf_put_fvar (ng, model, S(ng)%name, & + & TRIM(Vname(1,idU3Sd)), rsta, & + & (/1,1,S(ng)%Rindex/), & + & (/N(ng),Nstation(ng),1/), & + & ncid = S(ng)%ncid, & + & varid = S(ng)%Vid(idU3Sd)) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN + END IF +! +! Write out 3D Stokes V-velocity. +! + IF (VarOut(idV3Sd,ng)) THEN + scale=1.0_dp + CALL extract_sta3d (ng, model, Cgrid, idV3Sd, v3dvar, & + & LBi, UBi, LBj, UBj, 1, N(ng), & + & scale, OCEAN(ng) % v_stokes, & + & NposR, XposR, YposR, ZposR, rsta) + CALL netcdf_put_fvar (ng, model, S(ng)%name, & + & TRIM(Vname(1,idV3Sd)), rsta, & + & (/1,1,S(ng)%Rindex/), & + & (/N(ng),Nstation(ng),1/), & + & ncid = S(ng)%ncid, & + & varid = S(ng)%Vid(idV3Sd)) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN + END IF +! +! Write out 3D Stokes omega-velocity. +! + IF (VarOut(idW3Sd,ng)) THEN + scale=1.0_dp + CALL extract_sta3d (ng, model, Cgrid, idW3Sd, w3dvar, & + & LBi, UBi, LBj, UBj, 0, N(ng), & + & scale, OCEAN(ng) % W_stokes, & + & NposR, XposR, YposR, ZposR, rsta) + CALL netcdf_put_fvar (ng, model, S(ng)%name, & + & TRIM(Vname(1,idW3Sd)), rsta, & + & (/1,1,S(ng)%Rindex/), & + & (/N(ng),Nstation(ng),1/), & + & ncid = S(ng)%ncid, & + & varid = S(ng)%Vid(idW3Sd)) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN + END IF +! +! Write out 3D "true" Stokes W-velocity. +! + IF (VarOut(idW3St,ng)) THEN + scale=1.0_dp + CALL extract_sta3d (ng, model, Cgrid, idW3St, w3dvar, & + & LBi, UBi, LBj, UBj, 0, N(ng), & + & scale, OCEAN(ng) % wstvel, & + & NposR, XposR, YposR, ZposR, rsta) + CALL netcdf_put_fvar (ng, model, S(ng)%name, & + & TRIM(Vname(1,idW3St)), rsta, & + & (/1,1,S(ng)%Rindex/), & + & (/N(ng),Nstation(ng),1/), & + & ncid = S(ng)%ncid, & + & varid = S(ng)%Vid(idW3St)) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN + END IF +! +! Write out 3D total Waves Effect on Currents U-stress. +! + IF (VarOut(idU3rs,ng)) THEN + scale=rho0 + CALL extract_sta3d (ng, model, Cgrid, idU3rs, u3dvar, & + & LBi, UBi, LBj, UBj, 1, N(ng), & + & scale, MIXING(ng) % rustr3d, & + & NposR, XposR, YposR, ZposR, rsta) + CALL netcdf_put_fvar (ng, model, S(ng)%name, & + & TRIM(Vname(1,idU3rs)), rsta, & + & (/1,1,S(ng)%Rindex/), & + & (/N(ng),Nstation(ng),1/), & + & ncid = S(ng)%ncid, & + & varid = S(ng)%Vid(idU3rs)) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN + END IF +! +! Write out 3D total Waves Effect on Current V-stress. +! + IF (VarOut(idV3rs,ng)) THEN + scale=rho0 + CALL extract_sta3d (ng, model, Cgrid, idV3rs, v3dvar, & + & LBi, UBi, LBj, UBj, 1, N(ng), & + & scale, MIXING(ng) % rvstr3d, & + & NposR, XposR, YposR, ZposR, rsta) + CALL netcdf_put_fvar (ng, model, S(ng)%name, & + & TRIM(Vname(1,idV3rs)), rsta, & + & (/1,1,S(ng)%Rindex/), & + & (/N(ng),Nstation(ng),1/), & + & ncid = S(ng)%ncid, & + & varid = S(ng)%Vid(idV3rs)) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN + END IF +# endif +# endif +# ifdef WEC_VF +! +! Write out Waves Effect on Currents quasi-static sea level adjustment. +! + IF (VarOut(idWztw,ng)) THEN + scale=1.0_dp + CALL extract_sta2d (ng, model, Cgrid, idWztw, r2dvar, & + & LBi, UBi, LBj, UBj, & + & scale, OCEAN(ng) % zeta(:,:,KOUT), & + & Nstation(ng), Xpos, Ypos, psta) + CALL netcdf_put_fvar (ng, model, S(ng)%name, & + & TRIM(Vname(1,idWztw)), psta, & + & (/1,S(ng)%Rindex/), (/Nstation(ng),1/), & + & ncid = S(ng)%ncid, & + & varid = S(ng)%Vid(idWztw)) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN + END IF +! +! Write out Waves Effect on Currents quasi-static pressure. +! + IF (VarOut(idWqsp,ng)) THEN + scale=1.0_dp + CALL extract_sta2d (ng, model, Cgrid, idWqsp, r2dvar, & + & LBi, UBi, LBj, UBj, & + & scale, OCEAN(ng) % qsp, & + & Nstation(ng), Xpos, Ypos, psta) + CALL netcdf_put_fvar (ng, model, S(ng)%name, & + & TRIM(Vname(1,idWqsp)), psta, & + & (/1,S(ng)%Rindex/), (/Nstation(ng),1/), & + & ncid = S(ng)%ncid, & + & varid = S(ng)%Vid(idWqsp)) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN + END IF +! +! Write out Waves Effect on Currents Bernoulli head. +! + IF (VarOut(idWbeh,ng)) THEN + scale=1.0_dp + CALL extract_sta2d (ng, model, Cgrid, idWbeh, r2dvar, & + & LBi, UBi, LBj, UBj, & + & scale, OCEAN(ng) % bh, & + & Nstation(ng), Xpos, Ypos, psta) + CALL netcdf_put_fvar (ng, model, S(ng)%name, & + & TRIM(Vname(1,idWbeh)), psta, & + & (/1,S(ng)%Rindex/), (/Nstation(ng),1/), & + & ncid = S(ng)%ncid, & + & varid = S(ng)%Vid(idWbeh)) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN + END IF +# endif +# if (defined BOTTOM_STREAMING && defined WEC_VF) || \ + defined WAV_COUPLING +! +! Write out wave dissipation due to bottom friction. +! + IF (VarOut(idWdif,ng)) THEN + scale=1.0_dp + CALL extract_sta2d (ng, model, Cgrid, idWdif, r2dvar, & + & LBi, UBi, LBj, UBj, & + & scale, FORCES(ng) % Dissip_fric, & + & Nstation(ng), Xpos, Ypos, psta) + CALL netcdf_put_fvar (ng, model, S(ng)%name, & + & TRIM(Vname(1,idWdif)), psta, & + & (/1,S(ng)%Rindex/), (/Nstation(ng),1/), & + & ncid = S(ng)%ncid, & + & varid = S(ng)%Vid(idWdif)) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN + END IF +# endif +# if defined TKE_WAVEDISS || defined WAV_COUPLING || \ + defined WDISS_THORGUZA || defined WDISS_CHURTHOR || \ + defined WAVES_DISS || defined WDISS_INWAVE +! +! Write out wave dissipation due to breaking. +! + IF (VarOut(idWdib,ng)) THEN + scale=1.0_dp + CALL extract_sta2d (ng, model, Cgrid, idWdib, r2dvar, & + & LBi, UBi, LBj, UBj, & + & scale, FORCES(ng) % Dissip_break, & + & Nstation(ng), Xpos, Ypos, psta) + CALL netcdf_put_fvar (ng, model, S(ng)%name, & + & TRIM(Vname(1,idWdib)), psta, & + & (/1,S(ng)%Rindex/), (/Nstation(ng),1/), & + & ncid = S(ng)%ncid, & + & varid = S(ng)%Vid(idWdib)) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN + END IF +! +! Write out wave dissipation due to whitecapping. +! + IF (VarOut(idWdiw,ng)) THEN + scale=1.0_dp + CALL extract_sta2d (ng, model, Cgrid, idWdiw, r2dvar, & + & LBi, UBi, LBj, UBj, & + & scale, FORCES(ng) % Dissip_wcap, & + & Nstation(ng), Xpos, Ypos, psta) + CALL netcdf_put_fvar (ng, model, S(ng)%name, & + & TRIM(Vname(1,idWdiw)), psta, & + & (/1,S(ng)%Rindex/), (/Nstation(ng),1/), & + & ncid = S(ng)%ncid, & + & varid = S(ng)%Vid(idWdiw)) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN + END IF +# endif +# ifdef ROLLER_SVENDSEN +! +! Write out percent wave breaking. +! + IF (VarOut(idWbrk,ng)) THEN + scale=1.0_dp + CALL extract_sta2d (ng, model, Cgrid, idWbrk, r2dvar, & + & LBi, UBi, LBj, UBj, & + & scale, FORCES(ng) % Wave_break, & + & Nstation(ng), Xpos, Ypos, psta) + CALL netcdf_put_fvar (ng, model, S(ng)%name, & + & TRIM(Vname(1,idWbrk)), psta, & + & (/1,S(ng)%Rindex/), (/Nstation(ng),1/), & + & ncid = S(ng)%ncid, & + & varid = S(ng)%Vid(idWbrk)) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN + END IF +# endif +# ifdef WEC_ROLLER +! +! Write out wave roller dissipation. +! + IF (VarOut(idWdis,ng)) THEN + scale=1.0_dp + CALL extract_sta2d (ng, model, Cgrid, idWdis, r2dvar, & + & LBi, UBi, LBj, UBj, & + & scale, FORCES(ng) % Dissip_roller, & + & Nstation(ng), Xpos, Ypos, psta) + CALL netcdf_put_fvar (ng, model, S(ng)%name, & + & TRIM(Vname(1,idWdis)), psta, & + & (/1,S(ng)%Rindex/), (/Nstation(ng),1/), & + & ncid = S(ng)%ncid, & + & varid = S(ng)%Vid(idWdis)) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN + END IF +# endif +# ifdef ROLLER_RENIERS +! +! Write out wave roller action density. +! + IF (VarOut(idWrol,ng)) THEN + scale=1.0_dp + CALL extract_sta2d (ng, model, Cgrid, idWrol, r2dvar, & + & LBi, UBi, LBj, UBj, & + & scale, FORCES(ng) % rollA, & + & Nstation(ng), Xpos, Ypos, psta) + CALL netcdf_put_fvar (ng, model, S(ng)%name, & + & TRIM(Vname(1,idWrol)), psta, & + & (/1,S(ng)%Rindex/), (/Nstation(ng),1/), & + & ncid = S(ng)%ncid, & + & varid = S(ng)%Vid(idWrol)) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN + END IF +# endif +! + RETURN + END SUBROUTINE wec_wrt_station_nf90 +# endif + +# if defined PIO_LIB && defined DISTRIBUTE +! +!*********************************************************************** + SUBROUTINE wec_def_pio (ng, model, ldef, VarOut, S, & + & t2dgrd, u2dgrd, v2dgrd, & + & t3dgrd, u3dgrd, v3dgrd, w3dgrd) +!*********************************************************************** +! + USE mod_pio_netcdf +! +! Imported variable declarations. +! + logical, intent(in) :: ldef, VarOut(NV,Ngrids) +! + integer, intent(in) :: ng, model + integer, intent(in), optional :: t2dgrd(:), u2dgrd(:), v2dgrd(:) + integer, intent(in), optional :: t3dgrd(:), u3dgrd(:), v3dgrd(:) + integer, intent(in), optional :: w3dgrd(:) +! + TYPE(T_IO), intent(inout) :: S(Ngrids) +! +! Local variable declarations. +! + logical :: got_var(NV) +! + integer, parameter :: Natt = 25 + + integer :: i, j, nvd3, nvd4, status +! + real(r8) :: Aval(6) +! +# ifdef ADJOINT + character (len=21) :: Prefix +# else + character (len=13) :: Prefix +# endif + character (len=120) :: Vinfo(Natt) + character (len=256) :: ncname +! + character (len=*), parameter :: MyFile = & + & __FILE__//", wec_def_pio" +! + SourceFile=MyFile +! +!----------------------------------------------------------------------- +! Define Waves Effect on Currents output variables. +!----------------------------------------------------------------------- +! + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN + ncname=S(ng)%name +! + DEFINE : IF (ldef) THEN +! +! Set number of dimensions for output variables. +! +# if defined WRITE_WATER && defined MASKING + nvd3=2 + nvd4=2 +# else + nvd3=3 + nvd4=4 +# endif +! +! Set long name prefix string. +! +# ifdef ADJOINT +!! Prefix='time-averaged adjoint' + Prefix='adjoint' +# else +!! Prefix='time-averaged' + Prefix=CHAR(32) ! blank space +# endif +! +! Initialize local information variable arrays. +! + DO i=1,Natt + DO j=1,LEN(Vinfo(1)) + Vinfo(i)(j:j)=' ' + END DO + END DO + DO i=1,6 + Aval(i)=0.0_r8 + END DO + +# ifdef WEC +! +! Define 2D total Waves Effect on Currents U-stress. +! + IF (VarOut(idU2rs,ng)) THEN + Vinfo( 1)=Vname(1,idU2rs) + IF (S(ng)%ncid.eq.AVG(ng)%ncid) THEN + WRITE (Vinfo( 2),'(a,1x,a)') Prefix, TRIM(Vname(2,idU2rs)) + ELSE + Vinfo( 2)=Vname(2,idU2rs) + END IF + Vinfo( 3)=Vname(3,idU2rs) + Vinfo(14)=Vname(4,idU2rs) + Vinfo(16)=Vname(1,idtime) +# if defined WRITE_WATER && defined MASKING + Vinfo(20)='mask_u' +# endif + Vinfo(21)=Vname(6,idU2rs) + Vinfo(22)='coordinates' + Aval(5)=REAL(Iinfo(1,idU2rs,ng),r8) + S(ng)%pioVar(idU2rs)%dkind=PIO_FOUT + S(ng)%pioVar(idU2rs)%gtype=u2dvar +! + status=def_var(ng, model, S(ng)%pioFile, & + & S(ng)%pioVar(idU2rs)%vd, & + & PIO_FOUT, nvd3, u2dgrd, Aval, Vinfo, ncname) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN + END IF +! +! Define 2D total Waves Effect on Currents V-stress. +! + IF (VarOut(idV2rs,ng)) THEN + Vinfo( 1)=Vname(1,idV2rs) + IF (S(ng)%ncid.eq.AVG(ng)%ncid) THEN + WRITE (Vinfo( 2),'(a,1x,a)') Prefix, TRIM(Vname(2,idV2rs)) + ELSE + Vinfo( 2)=Vname(2,idV2rs) + END IF + Vinfo( 3)=Vname(3,idV2rs) + Vinfo(14)=Vname(4,idV2rs) + Vinfo(16)=Vname(1,idtime) +# if defined WRITE_WATER && defined MASKING + Vinfo(20)='mask_v' +# endif + Vinfo(21)=Vname(6,idV2rs) + Vinfo(22)='coordinates' + Aval(5)=REAL(Iinfo(1,idV2rs,ng),r8) + S(ng)%pioVar(idV2rs)%dkind=PIO_FOUT + S(ng)%pioVar(idV2rs)%gtype=v2dvar +! + status=def_var(ng, model, S(ng)%pioFile, & + & S(ng)%pioVar(idV2rs)%vd, & + & PIO_FOUT, nvd3, v2dgrd, Aval, Vinfo, ncname) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN + END IF +! +! Define 2D Stokes U-velocity. +! + IF (VarOut(idU2Sd,ng)) THEN + Vinfo( 1)=Vname(1,idU2Sd) + IF (S(ng)%ncid.eq.AVG(ng)%ncid) THEN + WRITE (Vinfo( 2),'(a,1x,a)') Prefix, TRIM(Vname(2,idU2Sd)) + ELSE + Vinfo( 2)=Vname(2,idU2Sd) + END IF + Vinfo( 3)=Vname(3,idU2Sd) + Vinfo(14)=Vname(4,idU2Sd) + Vinfo(16)=Vname(1,idtime) +# if defined WRITE_WATER && defined MASKING + Vinfo(20)='mask_u' +# endif + Vinfo(21)=Vname(6,idU2Sd) + Vinfo(22)='coordinates' + Aval(5)=REAL(Iinfo(1,idU2Sd,ng),r8) + S(ng)%pioVar(idU2Sd)%dkind=PIO_FOUT + S(ng)%pioVar(idU2Sd)%gtype=u2dvar +! + status=def_var(ng, model, S(ng)%pioFile, & + & S(ng)%pioVar(idU2Sd)%vd, & + & PIO_FOUT, nvd3, u2dgrd, Aval, Vinfo, ncname) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN + END IF +! +! Define 2D Stokes V-velocity. +! + IF (VarOut(idV2Sd,ng)) THEN + Vinfo( 1)=Vname(1,idV2Sd) + IF (S(ng)%ncid.eq.AVG(ng)%ncid) THEN + WRITE (Vinfo( 2),'(a,1x,a)') Prefix, TRIM(Vname(2,idV2Sd)) + ELSE + Vinfo( 2)=Vname(2,idV2Sd) + END IF + Vinfo( 3)=Vname(3,idV2Sd) + Vinfo(14)=Vname(4,idV2Sd) + Vinfo(16)=Vname(1,idtime) +# if defined WRITE_WATER && defined MASKING + Vinfo(20)='mask_v' +# endif + Vinfo(21)=Vname(6,idV2Sd) + Vinfo(22)='coordinates' + Aval(5)=REAL(Iinfo(1,idV2Sd,ng),r8) + S(ng)%pioVar(idV2Sd)%dkind=PIO_FOUT + S(ng)%pioVar(idV2Sd)%gtype=v2dvar +! + status=def_var(ng, model, S(ng)%pioFile, & + & S(ng)%pioVar(idV2Sd)%vd, & + & PIO_FOUT, nvd3, v2dgrd, Aval, Vinfo, ncname) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN + END IF + +# ifdef SOLVE3D +! +! Define 3D total Waves Effect on Currents U-stress. +! + IF (VarOut(idU3rs,ng)) THEN + Vinfo( 1)=Vname(1,idU3rs) + IF (S(ng)%ncid.eq.AVG(ng)%ncid) THEN + WRITE (Vinfo( 2),'(a,1x,a)') Prefix, TRIM(Vname(2,idU3rs)) + ELSE + Vinfo( 2)=Vname(2,idU3rs) + END IF + Vinfo( 3)=Vname(3,idU3rs) + Vinfo(14)=Vname(4,idU3rs) + Vinfo(16)=Vname(1,idtime) +# if defined WRITE_WATER && defined MASKING + Vinfo(20)='mask_u' +# endif + Vinfo(21)=Vname(6,idU3rs) + Vinfo(22)='coordinates' + Aval(5)=REAL(Iinfo(1,idU3rs,ng),r8) + S(ng)%pioVar(idU3rs)%dkind=PIO_FOUT + S(ng)%pioVar(idU3rs)%gtype=u3dvar +! + status=def_var(ng, model, S(ng)%pioFile, & + & S(ng)%pioVar(idU3rs)%vd, & + & PIO_FOUT, nvd4, u3dgrd, Aval, Vinfo, ncname) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN + END IF +! +! Define 3D total Waves Effect on Currents V-stress. +! + IF (VarOut(idV3rs,ng)) THEN + Vinfo( 1)=Vname(1,idV3rs) + IF (S(ng)%ncid.eq.AVG(ng)%ncid) THEN + WRITE (Vinfo( 2),'(a,1x,a)') Prefix, TRIM(Vname(2,idV3rs)) + ELSE + Vinfo( 2)=Vname(2,idV3rs) + END IF + Vinfo( 3)=Vname(3,idV3rs) + Vinfo(14)=Vname(4,idV3rs) + Vinfo(16)=Vname(1,idtime) +# if defined WRITE_WATER && defined MASKING + Vinfo(20)='mask_v' +# endif + Vinfo(21)=Vname(6,idV3rs) + Vinfo(22)='coordinates' + Aval(5)=REAL(Iinfo(1,idV3rs,ng),r8) + S(ng)%pioVar(idV3rs)%dkind=PIO_FOUT + S(ng)%pioVar(idV3rs)%gtype=v3dvar +! + status=def_var(ng, model, S(ng)%pioFile, & + & S(ng)%pioVar(idV3rs)%vd, & + & PIO_FOUT, nvd4, v3dgrd, Aval, Vinfo, ncname) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN + END IF +! +! Define 3D Stokes U-velocity. +! + IF (VarOut(idU3Sd,ng)) THEN + Vinfo( 1)=Vname(1,idU3Sd) + IF (S(ng)%ncid.eq.AVG(ng)%ncid) THEN + WRITE (Vinfo( 2),'(a,1x,a)') Prefix, TRIM(Vname(2,idU3Sd)) + ELSE + Vinfo( 2)=Vname(2,idU3Sd) + END IF + Vinfo( 3)=Vname(3,idU3Sd) + Vinfo(14)=Vname(4,idU3Sd) + Vinfo(16)=Vname(1,idtime) +# if defined WRITE_WATER && defined MASKING + Vinfo(20)='mask_u' +# endif + Vinfo(21)=Vname(6,idU3Sd) + Vinfo(22)='coordinates' + Aval(5)=REAL(Iinfo(1,idU3Sd,ng),r8) + S(ng)%pioVar(idU3Sd)%dkind=PIO_FOUT + S(ng)%pioVar(idU3Sd)%gtype=u3dvar +! + status=def_var(ng, model, S(ng)%pioFile, & + & S(ng)%pioVar(idU3Sd)%vd, & + & PIO_FOUT, nvd4, u3dgrd, Aval, Vinfo, ncname) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN + END IF +! +! Define 3D Stokes V-velocity. +! + IF (VarOut(idV3Sd,ng)) THEN + Vinfo( 1)=Vname(1,idV3Sd) + IF (S(ng)%ncid.eq.AVG(ng)%ncid) THEN + WRITE (Vinfo( 2),'(a,1x,a)') Prefix, TRIM(Vname(2,idV3Sd)) + ELSE + Vinfo( 2)=Vname(2,idV3Sd) + END IF + Vinfo( 3)=Vname(3,idV3Sd) + Vinfo(14)=Vname(4,idV3Sd) + Vinfo(16)=Vname(1,idtime) +# if defined WRITE_WATER && defined MASKING + Vinfo(20)='mask_v' +# endif + Vinfo(21)=Vname(6,idV3Sd) + Vinfo(22)='coordinates' + Aval(5)=REAL(Iinfo(1,idV3Sd,ng),r8) + S(ng)%pioVar(idV3Sd)%dkind=PIO_FOUT + S(ng)%pioVar(idV3Sd)%gtype=v3dvar +! + status=def_var(ng, model, S(ng)%pioFile, & + & S(ng)%pioVar(idV3Sd)%vd, & + & PIO_FOUT, nvd4, v3dgrd, Aval, Vinfo, ncname) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN + END IF +! +! Define 3D Stokes omega-velocity. +! + IF (VarOut(idW3Sd,ng)) THEN + Vinfo( 1)=Vname(1,idW3Sd) + IF (S(ng)%ncid.eq.AVG(ng)%ncid) THEN + WRITE (Vinfo( 2),'(a,1x,a)') Prefix, TRIM(Vname(2,idW3Sd)) + ELSE + Vinfo( 2)=Vname(2,idW3Sd) + END IF + Vinfo( 3)=Vname(3,idW3Sd) + Vinfo(14)=Vname(4,idW3Sd) + Vinfo(16)=Vname(1,idtime) +# if defined WRITE_WATER && defined MASKING + Vinfo(20)='mask_rho' +# endif + Vinfo(21)=Vname(6,idW3Sd) + Vinfo(22)='coordinates' + Aval(5)=REAL(Iinfo(1,idW3Sd,ng),r8) + S(ng)%pioVar(idW3Sd)%dkind=PIO_FOUT + S(ng)%pioVar(idW3Sd)%gtype=w3dvar +! + status=def_var(ng, model, S(ng)%pioFile, & + & S(ng)%pioVar(idW3Sd)%vd, & + & PIO_FOUT, nvd4, w3dgrd, Aval, Vinfo, ncname) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN + END IF +! +! Define 3D Stokes W-velocity. +! + IF (VarOut(idW3St,ng)) THEN + Vinfo( 1)=Vname(1,idW3St) + IF (S(ng)%ncid.eq.AVG(ng)%ncid) THEN + WRITE (Vinfo( 2),'(a,1x,a)') Prefix, TRIM(Vname(2,idW3St)) + ELSE + Vinfo( 2)=Vname(2,idW3St) + END IF + Vinfo( 3)=Vname(3,idW3St) + Vinfo(14)=Vname(4,idW3St) + Vinfo(16)=Vname(1,idtime) +# if defined WRITE_WATER && defined MASKING + Vinfo(20)='mask_rho' +# endif + Vinfo(21)=Vname(6,idW3St) + Vinfo(22)='coordinates' + Aval(5)=REAL(Iinfo(1,idW3St,ng),r8) + S(ng)%pioVar(idW3St)%dkind=PIO_FOUT + S(ng)%pioVar(idW3St)%gtype=w3dvar +! + status=def_var(ng, model, S(ng)%pioFile, & + & S(ng)%pioVar(idW3St)%vd, & + & PIO_FOUT, nvd4, w3dgrd, Aval, Vinfo, ncname) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN + END IF +# endif +# endif +# ifdef WEC_VF +! +! Define Waves Effect on Currents quasi-static sea level adjustment. +! + IF (VarOut(idWztw,ng)) THEN + Vinfo( 1)=Vname(1,idWztw) + IF (S(ng)%ncid.eq.AVG(ng)%ncid) THEN + WRITE (Vinfo( 2),'(a,1x,a)') Prefix, TRIM(Vname(2,idWztw)) + ELSE + Vinfo( 2)=Vname(2,idWztw) + END IF + Vinfo( 3)=Vname(3,idWztw) + Vinfo(14)=Vname(4,idWztw) + Vinfo(16)=Vname(1,idtime) +# if defined WRITE_WATER && defined MASKING + Vinfo(20)='mask_rho' +# endif + Vinfo(21)=Vname(6,idWztw) + Vinfo(22)='coordinates' + Aval(5)=REAL(Iinfo(1,idWztw,ng),r8) + S(ng)%pioVar(idWztw)%dkind=PIO_FOUT + S(ng)%pioVar(idWztw)%gtype=r2dvar +! + status=def_var(ng, model, S(ng)%pioFile, & + & S(ng)%pioVar(idWztw)%vd, & + & PIO_FOUT, nvd3, t2dgrd, Aval, Vinfo, ncname) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN + END IF +! +! Define Waves Effect on Currents quasi-static pressure. +! + IF (VarOut(idWqsp,ng)) THEN + Vinfo( 1)=Vname(1,idWqsp) + IF (S(ng)%ncid.eq.AVG(ng)%ncid) THEN + WRITE (Vinfo( 2),'(a,1x,a)') Prefix, TRIM(Vname(2,idWqsp)) + ELSE + Vinfo( 2)=Vname(2,idWqsp) + END IF + Vinfo( 3)=Vname(3,idWqsp) + Vinfo(14)=Vname(4,idWqsp) + Vinfo(16)=Vname(1,idtime) +# if defined WRITE_WATER && defined MASKING + Vinfo(20)='mask_rho' +# endif + Vinfo(21)=Vname(6,idWqsp) + Vinfo(22)='coordinates' + Aval(5)=REAL(Iinfo(1,idWqsp,ng),r8) + S(ng)%pioVar(idWqsp)%dkind=PIO_FOUT + S(ng)%pioVar(idWqsp)%gtype=r2dvar +! + status=def_var(ng, model, S(ng)%pioFile, & + & S(ng)%pioVar(idWqsp)%vd, & + & PIO_FOUT, nvd3, t2dgrd, Aval, Vinfo, ncname) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN + END IF +! +! Define Waves Effect on Currents Bernoulli head. +! + IF (VarOut(idWbeh,ng)) THEN + Vinfo( 1)=Vname(1,idWbeh) + IF (S(ng)%ncid.eq.AVG(ng)%ncid) THEN + WRITE (Vinfo( 2),'(a,1x,a)') Prefix, TRIM(Vname(2,idWbeh)) + ELSE + Vinfo( 2)=Vname(2,idWbeh) + END IF + Vinfo( 3)=Vname(3,idWbeh) + Vinfo(14)=Vname(4,idWbeh) + Vinfo(16)=Vname(1,idtime) +# if defined WRITE_WATER && defined MASKING + Vinfo(20)='mask_rho' +# endif + Vinfo(21)=Vname(6,idWbeh) + Vinfo(22)='coordinates' + Aval(5)=REAL(Iinfo(1,idWbeh,ng),r8) + S(ng)%pioVar(idWbeh)%dkind=PIO_FOUT + S(ng)%pioVar(idWbeh)%gtype=r2dvar +! + status=def_var(ng, model, S(ng)%pioFile, & + & S(ng)%pioVar(idWbeh)%vd, & + & PIO_FOUT, nvd3, t2dgrd, Aval, Vinfo, ncname) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN + END IF +# endif +# if (defined BOTTOM_STREAMING && defined WEC_VF) || \ + defined WAV_COUPLING +! +! Define wave dissipation due to bottom friction. +! + IF (VarOut(idWdif,ng)) THEN + Vinfo( 1)=Vname(1,idWdif) + IF (S(ng)%ncid.eq.AVG(ng)%ncid) THEN + WRITE (Vinfo( 2),'(a,1x,a)') Prefix, TRIM(Vname(2,idWdif)) + ELSE + Vinfo( 2)=Vname(2,idWdif) + END IF + Vinfo( 3)=Vname(3,idWdif) + Vinfo(14)=Vname(4,idWdif) + Vinfo(16)=Vname(1,idtime) +# if defined WRITE_WATER && defined MASKING + Vinfo(20)='mask_rho' +# endif + Vinfo(21)=Vname(6,idWdif) + Vinfo(22)='coordinates' + Aval(5)=REAL(Iinfo(1,idWdif,ng),r8) + S(ng)%pioVar(idWdif)%dkind=PIO_FOUT + S(ng)%pioVar(idWdif)%gtype=r2dvar +! + status=def_var(ng, model, S(ng)%pioFile, & + & S(ng)%pioVar(idWdif)%vd, & + & PIO_FOUT, nvd3, t2dgrd, Aval, Vinfo, ncname) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN + END IF +# endif +# if defined TKE_WAVEDISS || defined WAV_COUPLING || \ + defined WDISS_THORGUZA || defined WDISS_CHURTHOR || \ + defined WAVES_DISS || defined WDISS_INWAVE +! +! Define wave dissipation due to breaking. +! + IF (VarOut(idWdib,ng)) THEN + Vinfo( 1)=Vname(1,idWdib) + IF (S(ng)%ncid.eq.AVG(ng)%ncid) THEN + WRITE (Vinfo( 2),'(a,1x,a)') Prefix, TRIM(Vname(2,idWdib)) + ELSE + Vinfo( 2)=Vname(2,idWdib) + END IF + Vinfo( 3)=Vname(3,idWdib) + Vinfo(14)=Vname(4,idWdib) + Vinfo(16)=Vname(1,idtime) +# if defined WRITE_WATER && defined MASKING + Vinfo(20)='mask_rho' +# endif + Vinfo(21)=Vname(6,idWdib) + Vinfo(22)='coordinates' + Aval(5)=REAL(Iinfo(1,idWdib,ng),r8) + S(ng)%pioVar(idWdib)%dkind=PIO_FOUT + S(ng)%pioVar(idWdib)%gtype=r2dvar +! + status=def_var(ng, model, S(ng)%pioFile, & + & S(ng)%pioVar(idWdib)%vd, & + & PIO_FOUT, nvd3, t2dgrd, Aval, Vinfo, ncname) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN + END IF +! +! Define wave dissipation due to whitecapping. +! + IF (VarOut(idWdiw,ng)) THEN + Vinfo( 1)=Vname(1,idWdiw) + IF (S(ng)%ncid.eq.AVG(ng)%ncid) THEN + WRITE (Vinfo( 2),'(a,1x,a)') Prefix, TRIM(Vname(2,idWdiw)) + ELSE + Vinfo( 2)=Vname(2,idWdiw) + END IF + Vinfo( 3)=Vname(3,idWdiw) + Vinfo(14)=Vname(4,idWdiw) + Vinfo(16)=Vname(1,idtime) +# if defined WRITE_WATER && defined MASKING + Vinfo(20)='mask_rho' +# endif + Vinfo(21)=Vname(6,idWdiw) + Vinfo(22)='coordinates' + Aval(5)=REAL(Iinfo(1,idWdiw,ng),r8) + S(ng)%pioVar(idWdiw)%dkind=PIO_FOUT + S(ng)%pioVar(idWdiw)%gtype=r2dvar +! + status=def_var(ng, model, S(ng)%pioFile, & + & S(ng)%pioVar(idWdiw)%vd, & + & PIO_FOUT, nvd3, t2dgrd, Aval, Vinfo, ncname) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN + END IF +# endif +# ifdef ROLLER_SVENDSEN +! +! Define percent wave breaking. +! + IF (VarOut(idWbrk,ng)) THEN + Vinfo( 1)=Vname(1,idWbrk) + IF (S(ng)%ncid.eq.AVG(ng)%ncid) THEN + WRITE (Vinfo( 2),'(a,1x,a)') Prefix, TRIM(Vname(2,idWbrk)) + ELSE + Vinfo( 2)=Vname(2,idWbrk) + END IF + Vinfo( 3)=Vname(3,idWbrk) + Vinfo(14)=Vname(4,idWbrk) + Vinfo(16)=Vname(1,idtime) +# if defined WRITE_WATER && defined MASKING + Vinfo(20)='mask_rho' +# endif + Vinfo(21)=Vname(6,idWbrk) + Vinfo(22)='coordinates' + Aval(5)=REAL(Iinfo(1,idWbrk,ng),r8) + S(ng)%pioVar(idWbrk)%dkind=PIO_FOUT + S(ng)%pioVar(idWbrk)%gtype=r2dvar +! + status=def_var(ng, model, S(ng)%pioFile, & + & S(ng)%pioVar(idWbrk)%vd, & + & PIO_FOUT, nvd3, t2dgrd, Aval, Vinfo, ncname) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN + END IF +# endif +# ifdef WEC_ROLLER +! +! Define wave roller dissipation. +! + IF (VarOut(idWdis,ng)) THEN + Vinfo( 1)=Vname(1,idWdis) + IF (S(ng)%ncid.eq.AVG(ng)%ncid) THEN + WRITE (Vinfo( 2),'(a,1x,a)') Prefix, TRIM(Vname(2,idWdis)) + ELSE + Vinfo( 2)=Vname(2,idWdis) + END IF + Vinfo( 3)=Vname(3,idWdis) + Vinfo(14)=Vname(4,idWdis) + Vinfo(16)=Vname(1,idtime) +# if defined WRITE_WATER && defined MASKING + Vinfo(20)='mask_rho' +# endif + Vinfo(21)=Vname(6,idWdis) + Vinfo(22)='coordinates' + Aval(5)=REAL(Iinfo(1,idWdis,ng),r8) + S(ng)%pioVar(idWdis)%dkind=PIO_FOUT + S(ng)%pioVar(idWdis)%gtype=r2dvar +! + status=def_var(ng, model, S(ng)%pioFile, & + & S(ng)%pioVar(idWdis)%vd, & + & PIO_FOUT, nvd3, t2dgrd, Aval, Vinfo, ncname) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN + END IF +# endif +# ifdef ROLLER_RENIERS +! +! Define roller wave action density. +! + IF (VarOut(idWrol,ng)) THEN + Vinfo( 1)=Vname(1,idWrol) + IF (S(ng)%ncid.eq.AVG(ng)%ncid) THEN + WRITE (Vinfo( 2),'(a,1x,a)') Prefix, TRIM(Vname(2,idWrol)) + ELSE + Vinfo( 2)=Vname(2,idWrol) + END IF + Vinfo( 3)=Vname(3,idWrol) + Vinfo(14)=Vname(4,idWrol) + Vinfo(16)=Vname(1,idtime) +# if defined WRITE_WATER && defined MASKING + Vinfo(20)='mask_rho' +# endif + Vinfo(21)=Vname(6,idWrol) + Vinfo(22)='coordinates' + Aval(5)=REAL(Iinfo(1,idWrol,ng),r8) + S(ng)%pioVar(idWrol)%dkind=PIO_FOUT + S(ng)%pioVar(idWrol)%gtype=r2dvar +! + status=def_var(ng, model, S(ng)%pioFile, & + & S(ng)%pioVar(idWrol)%vd, & + & PIO_FOUT, nvd3, t2dgrd, Aval, Vinfo, ncname) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN + END IF +# endif + END IF DEFINE +! +!----------------------------------------------------------------------- +! Otherwise, check existing output file and prepare for appending +! data. +!----------------------------------------------------------------------- +! + QUERY : IF (.not.ldef) THEN +! +! Initialize locallogical switches. +! + DO i=1,NV + got_var(i)=.FALSE. + END DO +! +! Scan variable list from input NetCDF and activate switches for +! Waves Effect on Currents variables. Get variable IDs. +! + DO i=1,n_var + IF (TRIM(var_name(i)).eq.TRIM(Vname(1,idtime))) THEN + got_var(idtime)=.TRUE. + S(ng)%pioVar(idtime)%vd=var_desc(i) + S(ng)%pioVar(idtime)%dkind=PIO_TOUT + S(ng)%pioVar(idtime)%gtype=0 +# ifdef WEC + ELSE IF (TRIM(var_name(i)).eq.TRIM(Vname(1,idU2rs))) THEN + got_var(idU2rs)=.TRUE. + S(ng)%pioVar(idU2rs)%vd=var_desc(i) + S(ng)%pioVar(idU2rs)%dkind=PIO_FOUT + S(ng)%pioVar(idU2rs)%gtype=u2dvar + ELSE IF (TRIM(var_name(i)).eq.TRIM(Vname(1,idV2rs))) THEN + got_var(idV2rs)=.TRUE. + S(ng)%pioVar(idV2rs)%vd=var_desc(i) + S(ng)%pioVar(idV2rs)%dkind=PIO_FOUT + S(ng)%pioVar(idV2rs)%gtype=v2dvar + ELSE IF (TRIM(var_name(i)).eq.TRIM(Vname(1,idU2Sd))) THEN + got_var(idU2Sd)=.TRUE. + S(ng)%pioVar(idU2Sd)%vd=var_desc(i) + S(ng)%pioVar(idU2Sd)%dkind=PIO_FOUT + S(ng)%pioVar(idU2Sd)%gtype=u2dvar + ELSE IF (TRIM(var_name(i)).eq.TRIM(Vname(1,idV2Sd))) THEN + got_var(idV2Sd)=.TRUE. + S(ng)%pioVar(idV2Sd)%vd=var_desc(i) + S(ng)%pioVar(idV2Sd)%dkind=PIO_FOUT + S(ng)%pioVar(idV2Sd)%gtype=r2dvar +# ifdef SOLVE3D + ELSE IF (TRIM(var_name(i)).eq.TRIM(Vname(1,idU3rs))) THEN + got_var(idU3rs)=.TRUE. + S(ng)%pioVar(idU3rs)%vd=var_desc(i) + S(ng)%pioVar(idU3rs)%dkind=PIO_FOUT + S(ng)%pioVar(idU3rs)%gtype=u3dvar + ELSE IF (TRIM(var_name(i)).eq.TRIM(Vname(1,idV3rs))) THEN + got_var(idV3rs)=.TRUE. + S(ng)%pioVar(idV3rs)%vd=var_desc(i) + S(ng)%pioVar(idV3rs)%dkind=PIO_FOUT + S(ng)%pioVar(idV3rs)%gtype=v3dvar + ELSE IF (TRIM(var_name(i)).eq.TRIM(Vname(1,idU3Sd))) THEN + got_var(idU3Sd)=.TRUE. + S(ng)%pioVar(idU3Sd)%vd=var_desc(i) + S(ng)%pioVar(idU3Sd)%dkind=PIO_FOUT + S(ng)%pioVar(idU3Sd)%gtype=u3dvar + ELSE IF (TRIM(var_name(i)).eq.TRIM(Vname(1,idV3Sd))) THEN + got_var(idV3Sd)=.TRUE. + S(ng)%pioVar(idV3Sd)%vd=var_desc(i) + S(ng)%pioVar(idV3Sd)%dkind=PIO_FOUT + S(ng)%pioVar(idV3Sd)%gtype=v3dvar + ELSE IF (TRIM(var_name(i)).eq.TRIM(Vname(1,idW3Sd))) THEN + got_var(idW3Sd)=.TRUE. + S(ng)%pioVar(idW3Sd)%vd=var_desc(i) + S(ng)%pioVar(idW3Sd)%dkind=PIO_FOUT + S(ng)%pioVar(idW3Sd)%gtype=w3dvar + ELSE IF (TRIM(var_name(i)).eq.TRIM(Vname(1,idW3St))) THEN + got_var(idW3St)=.TRUE. + S(ng)%pioVar(idW3St)%vd=var_desc(i) + S(ng)%pioVar(idW3St)%dkind=PIO_FOUT + S(ng)%pioVar(idW3St)%gtype=r2dvar +# endif +# endif +# ifdef WEC_VF + ELSE IF (TRIM(var_name(i)).eq.TRIM(Vname(1,idWztw))) THEN + got_var(idWztw)=.TRUE. + S(ng)%pioVar(idWztw)%vd=var_desc(i) + S(ng)%pioVar(idWztw)%dkind=PIO_FOUT + S(ng)%pioVar(idWztw)%gtype=r2dvar + ELSE IF (TRIM(var_name(i)).eq.TRIM(Vname(1,idWqsp))) THEN + got_var(idWqsp)=.TRUE. + S(ng)%pioVar(idWqsp)%vd=var_desc(i) + S(ng)%pioVar(idWqsp)%dkind=PIO_FOUT + S(ng)%pioVar(idWqsp)%gtype=r2dvar + ELSE IF (TRIM(var_name(i)).eq.TRIM(Vname(1,idWbeh))) THEN + got_var(idWbeh)=.TRUE. + S(ng)%pioVar(idWbeh)%vd=var_desc(i) + S(ng)%pioVar(idWbeh)%dkind=PIO_FOUT + S(ng)%pioVar(idWbeh)%gtype=r2dvar +# endif +# if (defined BOTTOM_STREAMING && defined WEC_VF) || \ + defined WAV_COUPLING + ELSE IF (TRIM(var_name(i)).eq.TRIM(Vname(1,idWdif))) THEN + got_var(idWdif)=.TRUE. + S(ng)%pioVar(idWdif)%vd=var_desc(i) + S(ng)%pioVar(idWdif)%dkind=PIO_FOUT + S(ng)%pioVar(idWdif)%gtype=r2dvar +# endif +# if defined TKE_WAVEDISS || defined WAV_COUPLING || \ + defined WDISS_THORGUZA || defined WDISS_CHURTHOR || \ + defined WAVES_DISS || defined WDISS_INWAVE + ELSE IF (TRIM(var_name(i)).eq.TRIM(Vname(1,idWdib))) THEN + got_var(idWdib)=.TRUE. + S(ng)%pioVar(idWdib)%vd=var_desc(i) + S(ng)%pioVar(idWdib)%dkind=PIO_FOUT + S(ng)%pioVar(idWdib)%gtype=r2dvar + ELSE IF (TRIM(var_name(i)).eq.TRIM(Vname(1,idWdiw))) THEN + got_var(idWdiw)=.TRUE. + S(ng)%pioVar(idWdiw)%vd=var_desc(i) + S(ng)%pioVar(idWdiw)%dkind=PIO_FOUT + S(ng)%pioVar(idWdiw)%gtype=r2dvar +# endif +# ifdef ROLLER_SVENDSEN + ELSE IF (TRIM(var_name(i)).eq.TRIM(Vname(1,idWbrk))) THEN + got_var(idWbrk)=.TRUE. + S(ng)%pioVar(idWbrk)%vd=var_desc(i) + S(ng)%pioVar(idWbrk)%dkind=PIO_FOUT + S(ng)%pioVar(idWbrk)%gtype=r2dvar +# endif +# ifdef WEC_ROLLER + ELSE IF (TRIM(var_name(i)).eq.TRIM(Vname(1,idWdis))) THEN + got_var(idWdis)=.TRUE. + S(ng)%pioVar(idWdis)%vd=var_desc(i) + S(ng)%pioVar(idWdis)%dkind=PIO_FOUT + S(ng)%pioVar(idWdis)%gtype=r2dvar +# endif +# ifdef ROLLER_RENIERS + ELSE IF (TRIM(var_name(i)).eq.TRIM(Vname(1,idWrol))) THEN + got_var(idWrol)=.TRUE. + S(ng)%pioVar(idWrol)%vd=var_desc(i) + S(ng)%pioVar(idWrol)%dkind=PIO_FOUT + S(ng)%pioVar(idWrol)%gtype=r2dvar +# endif + END IF + END DO +! +! Check if output variables are available in input NetCDF file. +! + IF (.not.got_var(idtime)) THEN + IF (Master) WRITE (stdout,10) TRIM(Vname(1,idtime)), & + & TRIM(ncname) + exit_flag=3 + RETURN + END IF +# ifdef WEC + IF (.not.got_var(idU2rs).and.VarOut(idU2rs,ng)) THEN + IF (Master) WRITE (stdout,10) TRIM(Vname(1,idU2rs)), & + & TRIM(ncname) + exit_flag=3 + RETURN + END IF + IF (.not.got_var(idV2rs).and.VarOut(idV2rs,ng)) THEN + IF (Master) WRITE (stdout,10) TRIM(Vname(1,idV2rs)), & + & TRIM(ncname) + exit_flag=3 + RETURN + END IF + IF (.not.got_var(idU2Sd).and.VarOut(idU2Sd,ng)) THEN + IF (Master) WRITE (stdout,10) TRIM(Vname(1,idU2Sd)), & + & TRIM(ncname) + exit_flag=3 + RETURN + END IF + IF (.not.got_var(idV2Sd).and.VarOut(idV2Sd,ng)) THEN + IF (Master) WRITE (stdout,10) TRIM(Vname(1,idV2Sd)), & + & TRIM(ncname) + exit_flag=3 + RETURN + END IF +# ifdef SOLVE3D + IF (.not.got_var(idU3Sd).and.VarOut(idU3rs,ng)) THEN + IF (Master) WRITE (stdout,10) TRIM(Vname(1,idU3rs)), & + & TRIM(ncname) + exit_flag=3 + RETURN + END IF + IF (.not.got_var(idV3rs).and.VarOut(idV3rs,ng)) THEN + IF (Master) WRITE (stdout,10) TRIM(Vname(1,idV3rs)), & + & TRIM(ncname) + exit_flag=3 + RETURN + END IF + IF (.not.got_var(idU3Sd).and.VarOut(idU3Sd,ng)) THEN + IF (Master) WRITE (stdout,10) TRIM(Vname(1,idU3Sd)), & + & TRIM(ncname) + exit_flag=3 + RETURN + END IF + IF (.not.got_var(idV3Sd).and.VarOut(idV3Sd,ng)) THEN + IF (Master) WRITE (stdout,10) TRIM(Vname(1,idV3Sd)), & + & TRIM(ncname) + exit_flag=3 + RETURN + END IF + IF (.not.got_var(idW3Sd).and.VarOut(idW3Sd,ng)) THEN + IF (Master) WRITE (stdout,10) TRIM(Vname(1,idW3Sd)), & + & TRIM(ncname) + exit_flag=3 + RETURN + END IF + IF (.not.got_var(idW3St).and.VarOut(idW3St,ng)) THEN + IF (Master) WRITE (stdout,10) TRIM(Vname(1,idW3St)), & + & TRIM(ncname) + exit_flag=3 + RETURN + END IF +# endif +# endif +# ifdef WEC_VF + IF (.not.got_var(idWztw).and.VarOut(idWztw,ng)) THEN + IF (Master) WRITE (stdout,10) TRIM(Vname(1,idWztw)), & + & TRIM(ncname) + exit_flag=3 + RETURN + END IF + IF (.not.got_var(idWqsp).and.VarOut(idWqsp,ng)) THEN + IF (Master) WRITE (stdout,10) TRIM(Vname(1,idWqsp)), & + & TRIM(ncname) + exit_flag=3 + RETURN + END IF + IF (.not.got_var(idWbeh).and.VarOut(idWbeh,ng)) THEN + IF (Master) WRITE (stdout,10) TRIM(Vname(1,idWbeh)), & + & TRIM(ncname) + exit_flag=3 + RETURN + END IF +# endif +# if (defined BOTTOM_STREAMING && defined WEC_VF) || \ + defined WAV_COUPLING + IF (.not.got_var(idWdif).and.VarOut(idWdif,ng)) THEN + IF (Master) WRITE (stdout,10) TRIM(Vname(1,idWdif)), & + & TRIM(ncname) + exit_flag=3 + RETURN + END IF +# endif +# if defined TKE_WAVEDISS || defined WAV_COUPLING || \ + defined WDISS_THORGUZA || defined WDISS_CHURTHOR || \ + defined WAVES_DISS || defined WDISS_INWAVE + IF (.not.got_var(idWdib).and.VarOut(idWdib,ng)) THEN + IF (Master) WRITE (stdout,10) TRIM(Vname(1,idWdib)), & + & TRIM(ncname) + exit_flag=3 + RETURN + END IF + IF (.not.got_var(idWdiw).and.VarOut(idWdiw,ng)) THEN + IF (Master) WRITE (stdout,10) TRIM(Vname(1,idWdiw)), & + & TRIM(ncname) + exit_flag=3 + RETURN + END IF +# endif +# ifdef ROLLER_SVENDSEN + IF (.not.got_var(idWbrk).and.VarOut(idWbrk,ng)) THEN + IF (Master) WRITE (stdout,10) TRIM(Vname(1,idWbrk)), & + & TRIM(ncname) + exit_flag=3 + RETURN + END IF +# endif +# ifdef WEC_ROLLER + IF (.not.got_var(idWdis).and.VarOut(idWdis,ng)) THEN + IF (Master) WRITE (stdout,10) TRIM(Vname(1,idWdis)), & + & TRIM(ncname) + exit_flag=3 + RETURN + END IF +# endif +# ifdef ROLLER_RENIERS + IF (.not.got_var(idWrol).and.VarOut(idWrol,ng)) THEN + IF (Master) WRITE (stdout,10) TRIM(Vname(1,idWrol)), & + & TRIM(ncname) + exit_flag=3 + RETURN + END IF +# endif + END IF QUERY +! + 10 FORMAT (/,' WEC_DEF_PIO - unable to find variable: ',a,2x, & + & ' in output NetCDF file: ',a) +! + RETURN + END SUBROUTINE wec_def_pio +! +!*********************************************************************** + SUBROUTINE wec_wrt_pio (ng, model, tile, & + & LBi, UBi, LBj, UBj, & + & VarOut, S) +!*********************************************************************** +! + USE mod_pio_netcdf +! +! Imported variable declarations. +! + logical, intent(in) :: VarOut(NV,Ngrids) +! + integer, intent(in) :: ng, model, tile + integer, intent(in) :: LBi, UBi, LBj, UBj +! + TYPE(T_IO), intent(inout) :: S(Ngrids) +! +! Local variable declarations. +! + logical :: Linstataneous +! + integer :: status +! + real(dp) :: scale +! +# ifdef SOLVE3D +! + real(r8), allocatable :: Wr3d(:,:,:) +# endif +! + character (len=*), parameter :: MyFile = & + & __FILE__//", wec_wrt_pio" +! + TYPE (IO_desc_t), pointer :: ioDesc +! + SourceFile=MyFile +! +!----------------------------------------------------------------------- +! Write out Waves Effect on Currents output variables into specified +! output NetCDF file. +!----------------------------------------------------------------------- +! + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN +! +! Set instantaneous fields. +! + IF ((S(ng)%ncid.eq.HIS(ng)%ncid).or. & + & (S(ng)%ncid.eq.QCK(ng)%ncid)) THEN + Linstataneous=.TRUE. + ELSE + Linstataneous=.FALSE. ! time-averged fiels + END IF + +# ifdef WEC +! +! Write out 2D total Waves Effect on Currents U-stress. +! + IF (Aout(idU2rs,ng)) THEN + scale=1.0_dp + IF (S(ng)%pioVar(idU2rs)%dkind.eq.PIO_double) THEN + ioDesc => ioDesc_dp_u2dvar(ng) + ELSE + ioDesc => ioDesc_sp_u2dvar(ng) + END IF + IF (Linstataneous) THEN + status=nf_fwrite2d(ng, model, S(ng)%pioFile, idU2rs, & + & S(ng)%pioVar(idU2rs), & + & S(ng)%Rindex, & + & ioDesc, & + & LBi, UBi, LBj, UBj, scale, & +# ifdef MASKING + & GRID(ng) % umask, & +# endif + & MIXING(ng) % rustr2d +# ifdef AVERAGES + ELSE + status=nf_fwrite2d(ng, model, S(ng)%pioFile, idU2rs, & + & S(ng)%pioVar(idU2rs), & + & S(ng)%Rindex, & + & ioDesc, & + & LBi, UBi, LBj, UBj, scale, & +# ifdef MASKING + & GRID(ng) % umask, & +# endif + & AVERAGE(ng) % avgu2rs) +# endif + END IF + IF (FoundError(status, nf90_noerr, __LINE__, MyFile)) THEN + IF (Master) THEN + WRITE (stdout,10) TRIM(Vname(1,idU2rs)), S(ng)%Rindex + END IF + exit_flag=3 + ioerror=status + RETURN + END IF + END IF +! +! Write out 2D total Waves Effect on Currents V-stress. +! + IF (Aout(idV2rs,ng)) THEN + scale=1.0_dp + IF (S(ng)%pioVar(idV2rs)%dkind.eq.PIO_double) THEN + ioDesc => ioDesc_dp_v2dvar(ng) + ELSE + ioDesc => ioDesc_sp_v2dvar(ng) + END IF + IF (Linstataneous) THEN + status=nf_fwrite2d(ng, model, S(ng)%pioFile, idV2rs, & + & S(ng)%pioVar(idV2rs), & + & S(ng)%Rindex, & + & ioDesc, & + & LBi, UBi, LBj, UBj, scale, & +# ifdef MASKING + & GRID(ng) % vmask, & +# endif + & MIXING(ng) % rvstr2d) +# ifdef AVERAGES + ELSE + status=nf_fwrite2d(ng, model, S(ng)%pioFile, idV2rs, & + & S(ng)%pioVar(idV2rs), & + & S(ng)%Rindex, & + & ioDesc, & + & LBi, UBi, LBj, UBj, scale, & +# ifdef MASKING + & GRID(ng) % vmask, & +# endif + & AVERAGE(ng) % avgv2rs) +# endif + END IF + IF (FoundError(status, nf90_noerr, __LINE__, MyFile)) THEN + IF (Master) THEN + WRITE (stdout,10) TRIM(Vname(1,idV2rs)), S(ng)%Rindex + END IF + exit_flag=3 + ioerror=status + RETURN + END IF + END IF +! +! Write out 2D Stokes U-velocity. +! + IF (Aout(idU2Sd,ng)) THEN + scale=1.0_dp + IF (S(ng)%pioVar(idU2Sd)%dkind.eq.PIO_double) THEN + ioDesc => ioDesc_dp_u2dvar(ng) + ELSE + ioDesc => ioDesc_sp_u2dvar(ng) + END IF + IF (Linstataneous) THEN + status=nf_fwrite2d(ng, model, S(ng)%pioFile, idU2Sd, & + & S(ng)%pioVar(idU2Sd), & + & S(ng)%Rindex, & + & ioDesc, & + & LBi, UBi, LBj, UBj, scale, & +# ifdef MASKING + & GRID(ng) % umask, & +# endif + & OCEAN(ng) % ubar_stokes) +# ifdef AVERAGES + ELSE + status=nf_fwrite2d(ng, model, S(ng)%pioFile, idU2Sd, & + & S(ng)%pioVar(idU2Sd), & + & S(ng)%Rindex, & + & ioDesc, & + & LBi, UBi, LBj, UBj, scale, & +# ifdef MASKING + & GRID(ng) % umask, & +# endif + & AVERAGE(ng) % avgu2Sd) +# endif + END IF + IF (FoundError(status, nf90_noerr, __LINE__, MyFile)) THEN + IF (Master) THEN + WRITE (stdout,10) TRIM(Vname(1,idU2Sd)), S(ng)%Rindex + END IF + exit_flag=3 + ioerror=status + RETURN + END IF + END IF +! +! Write out 2D Stokes V-velocity. +! + IF (Aout(idV2Sd,ng)) THEN + scale=1.0_dp + IF (S(ng)%pioVar(idV2Sd)%dkind.eq.PIO_double) THEN + ioDesc => ioDesc_dp_v2dvar(ng) + ELSE + ioDesc => ioDesc_sp_v2dvar(ng) + END IF + IF (Linstataneous) THEN + status=nf_fwrite2d(ng, model, S(ng)%pioFile, idV2Sd, & + & S(ng)%pioVar(idV2Sd), & + & S(ng)%Rindex, & + & ioDesc, & + & LBi, UBi, LBj, UBj, scale, & +# ifdef MASKING + & GRID(ng) % vmask, & +# endif + & OCEAN(ng) % vbar_stokes) +# ifdef AVERAGES + ELSE + status=nf_fwrite2d(ng, model, S(ng)%pioFile, idV2Sd, & + & S(ng)%pioVar(idV2Sd), & + & S(ng)%Rindex, & + & ioDesc, & + & LBi, UBi, LBj, UBj, scale, & +# ifdef MASKING + & GRID(ng) % vmask, & +# endif + & AVERAGE(ng) % avgv2Sd) +# endif + END IF + IF (FoundError(status, nf90_noerr, __LINE__, MyFile)) THEN + IF (Master) THEN + WRITE (stdout,10) TRIM(Vname(1,idV2Sd)), S(ng)%Rindex + END IF + exit_flag=3 + ioerror=status + RETURN + END IF + END IF + +# ifdef SOLVE3D +! +! Write out 3D total Waves Effect on Currents U-stress. +! + IF (VarOut(idU3rs,ng)) THEN + scale=1.0_dp + IF (S(ng)%pioVar(idU3rs)%dkind.eq.PIO_double) THEN + ioDesc => ioDesc_dp_u3dvar(ng) + ELSE + ioDesc => ioDesc_sp_u3dvar(ng) + END IF + IF (Linstataneous) THEN + status=nf_fwrite3d(ng, model, S(ng)%pioFile, idU3rs, & + & S(ng)%pioVar(idU3rs), & + & S(ng)%Rindex, & + & ioDesc, & + & LBi, UBi, LBj, UBj, 1, N(ng), scale, & +# ifdef MASKING + & GRID(ng) % umask, & +# endif + & MIXING(ng) % rustr3d) +# ifdef AVERAGES + ELSE + status=nf_fwrite3d(ng, model, S(ng)%pioFile, idU3rs, & + & S(ng)%pioVar(idU3rs), & + & S(ng)%Rindex, & + & ioDesc, & + & LBi, UBi, LBj, UBj, 1, N(ng), scale, & +# ifdef MASKING + & GRID(ng) % umask, & +# endif + & AVERAGE(ng) % avgu3rs) +# endif + END IF + IF (FoundError(status, nf90_noerr, __LINE__, MyFile)) THEN + IF (Master) THEN + WRITE (stdout,10) TRIM(Vname(1,idU3rs)), S(ng)%Rindex + END IF + exit_flag=3 + ioerror=status + RETURN + END IF + END IF +! +! Write out 3D total Waves Effect on Currents V-stress. +! + IF (VarOut(idV3rs,ng)) THEN + scale=1.0_dp + IF (S(ng)%pioVar(idV3rs)%dkind.eq.PIO_double) THEN + ioDesc => ioDesc_dp_v3dvar(ng) + ELSE + ioDesc => ioDesc_sp_v3dvar(ng) + END IF + IF (Linstataneous) THEN + status=nf_fwrite3d(ng, model, S(ng)%pioFile, idV3rs, & + & S(ng)%pioVar(idV3rs), & + & S(ng)%Rindex, & + & ioDesc, & + & LBi, UBi, LBj, UBj, 1, N(ng), scale, & +# ifdef MASKING + & GRID(ng) % vmask, & +# endif + & MIXING(ng) % rvstr3d) +# ifdef AVERAGES + ELSE + status=nf_fwrite3d(ng, model, S(ng)%pioFile, idV3rs, & + & S(ng)%pioVar(idV3rs), & + & S(ng)%Rindex, & + & ioDesc, & + & LBi, UBi, LBj, UBj, 1, N(ng), scale, & +# ifdef MASKING + & GRID(ng) % vmask, & +# endif + & AVERAGE(ng) % avgv3rs) +# endif + END IF + IF (FoundError(status, nf90_noerr, __LINE__, MyFile)) THEN + IF (Master) THEN + WRITE (stdout,10) TRIM(Vname(1,idV3rs)), S(ng)%Rindex + END IF + exit_flag=3 + ioerror=status + RETURN + END IF + END IF +! +! Write out 3D Stokes U-velocity. +! + IF (VarOut(idU3Sd,ng)) THEN + scale=1.0_dp + IF (S(ng)%pioVar(idU3Sd)%dkind.eq.PIO_double) THEN + ioDesc => ioDesc_dp_u3dvar(ng) + ELSE + ioDesc => ioDesc_sp_u3dvar(ng) + END IF + IF (Linstataneous) THEN + status=nf_fwrite3d(ng, model, S(ng)%pioFile, idU3Sd, & + & S(ng)%pioVar(idU3Sd), & + & S(ng)%Rindex, & + & ioDesc, & + & LBi, UBi, LBj, UBj, 1, N(ng), scale, & +# ifdef MASKING + & GRID(ng) % umask, & +# endif + & OCEAN(ng) % u_stokes) +# ifdef AVERAGES + ELSE + status=nf_fwrite3d(ng, model, S(ng)%pioFile, idU3Sd, & + & S(ng)%pioVar(idU3Sd), & + & S(ng)%Rindex, & + & ioDesc, & + & LBi, UBi, LBj, UBj, 1, N(ng), scale, & +# ifdef MASKING + & GRID(ng) % umask, & +# endif + & AVERAGE(ng) % avgu3Sd) +# endif + END IF + IF (FoundError(status, nf90_noerr, __LINE__, MyFile)) THEN + IF (Master) THEN + WRITE (stdout,10) TRIM(Vname(1,idU3Sd)), S(ng)%Rindex + END IF + exit_flag=3 + ioerror=status + RETURN + END IF + END IF +! +! Write out 3D Stokes V-velocity. +! + IF (VarOut(idV3Sd,ng)) THEN + scale=1.0_dp + IF (S(ng)%pioVar(idV3Sd)%dkind.eq.PIO_double) THEN + ioDesc => ioDesc_dp_v3dvar(ng) + ELSE + ioDesc => ioDesc_sp_v3dvar(ng) + END IF + IF (Linstataneous) THEN + status=nf_fwrite2d(ng, model, S(ng)%pioFile, idV3Sd, & + & S(ng)%pioVar(idV3Sd), & + & S(ng)%Rindex, & + & ioDesc, & + & LBi, UBi, LBj, UBj, 1, N(ng), scale, & +# ifdef MASKING + & GRID(ng) % vmask, & +# endif + & OCEAN(ng) % v_stokes) +# ifdef AVERAGES + ELSE + status=nf_fwrite2d(ng, model, S(ng)%pioFile, idV3Sd, & + & S(ng)%pioVar(idV3Sd), & + & S(ng)%Rindex, & + & ioDesc, & + & LBi, UBi, LBj, UBj, 1, N(ng), scale, & +# ifdef MASKING + & GRID(ng) % vmask, & +# endif + & AVERAGE(ng) % avgv3Sd) +# endif + END IF + IF (FoundError(status, nf90_noerr, __LINE__, MyFile)) THEN + IF (Master) THEN + WRITE (stdout,10) TRIM(Vname(1,idV3Sd)), S(ng)%Rindex + END IF + exit_flag=3 + ioerror=status + RETURN + END IF + END IF +! +! Write out 3D Stokes omega-velocity. +! + IF (VarOut(idW3Sd,ng)) THEN + scale=1.0_dp + IF (S(ng)%pioVar(idW3Sd)%dkind.eq.PIO_double) THEN + ioDesc => ioDesc_dp_w3dvar(ng) + ELSE + ioDesc => ioDesc_sp_w3dvar(ng) + END IF + IF (Linstataneous) THEN + IF (.not.allocated(Wr3d)) THEN + allocate (Wr3d(LBi:UBi,LBj:UBj,0:N(ng))) + Wr3d(LBi:UBi,LBj:UBj,0:N(ng))=0.0_r8 + END IF + CALL scale_omega (ng, tile, LBi, UBi, LBj, UBj, 0, N(ng), & + & GRID(ng) % pm, & + & GRID(ng) % pn, & + & OCEAN(ng) % W_stokes, & + & Wr3d) + status=nf_fwrite3d(ng, model, S(ng)%pioFile, idW3Sd, & + & S(ng)%pioVar(idW3Sd), & + & S(ng)%Rindex, & + & ioDesc, & + & LBi, UBi, LBj, UBj, 0, N(ng), scale, & +# ifdef MASKING + & GRID(ng) % rmask, & +# endif + & Wr3d) + deallocate (Wr3d) +# ifdef AVERAGES + ELSE + status=nf_fwrite3d(ng, model, S(ng)%pioFile, idW3Sd, & + & S(ng)%pioVar(idW3Sd), & + & S(ng)%Rindex, & + & ioDesc, & + & LBi, UBi, LBj, UBj, 0, N(ng), scale, & +# ifdef MASKING + & GRID(ng) % rmask, & +# endif + & AVERAGE(ng) % avgw3d) +# endif + END IF + IF (FoundError(status, nf90_noerr, __LINE__, MyFile)) THEN + IF (Master) THEN + WRITE (stdout,10) TRIM(Vname(1,idW3Sd)), S(ng)%Rindex + END IF + exit_flag=3 + ioerror=status + RETURN + END IF + END IF +! +! Write out 3D Stokes 'true' W-velocity (m/s). +! + IF (VarOut(idW3St,ng)) THEN + scale=1.0_dp + IF (S(ng)%pioVar(idW3St)%dkind.eq.PIO_double) THEN + ioDesc => ioDesc_dp_w3dvar(ng) + ELSE + ioDesc => ioDesc_sp_w3dvar(ng) + END IF + IF (Linstataneous) THEN + status=nf_fwrite3d(ng, model, S(ng)%pioFile, idW3St, & + & S(ng)%pioVar(idW3St), & + & S(ng)%Rindex, & + & ioDesc, & + & LBi, UBi, LBj, UBj, 0, N(ng), scale, & +# ifdef MASKING + & GRID(ng) % rmask, & +# endif + & OCEAN(ng) % wstvel) +# ifdef AVERAGES + ELSE + status=nf_fwrite3d(ng, model, S(ng)%pioFile, idW3St, & + & S(ng)%pioVar(idW3St), & + & S(ng)%Rindex, & + & ioDesc, & + & LBi, UBi, LBj, UBj, 0, N(ng), scale, & +# ifdef MASKING + & GRID(ng) % rmask, & +# endif + & AVERAGE(ng) % avgW3St) +# endif + END IF + IF (FoundError(status, nf90_noerr, __LINE__, MyFile)) THEN + IF (Master) THEN + WRITE (stdout,10) TRIM(Vname(1,idW3St)), S(ng)%Rindex + END IF + exit_flag=3 + ioerror=status + RETURN + END IF + END IF +# endif +# ifdef WEC_VF +! +! Write out Waves Effect on Currents quasi-static sea level adjustment. +! + IF (VarOut(idWztw,ng)) THEN + scale=1.0_dp + IF (S(ng)%pioVar(idWztw)%dkind.eq.PIO_double) THEN + ioDesc => ioDesc_dp_r2dvar(ng) + ELSE + ioDesc => ioDesc_sp_r2dvar(ng) + END IF + IF (Linstataneous) THEN + status=nf_fwrite2d(ng, model, S(ng)%pioFile, idWztw, & + & S(ng)%pioVar(idWztw), & + & S(ng)%Rindex, & + & ioDesc, & + & LBi, UBi, LBj, UBj, scale, & +# ifdef MASKING + & GRID(ng) % rmask, & +# endif + & OCEAN(ng) % zetaw) +# ifdef AVERAGES + ELSE + status=nf_fwrite2d(ng, model, S(ng)%pioFile, idWztw, & + & S(ng)%pioVar(idWztw), & + & S(ng)%Rindex, & + & ioDesc, & + & LBi, UBi, LBj, UBj, scale, & +# ifdef MASKING + & GRID(ng) % rmask, & +# endif + & AVERAGE(ng) % avgWztw) +# endif + END IF + IF (FoundError(status, nf90_noerr, __LINE__, MyFile)) THEN + IF (Master) THEN + WRITE (stdout,10) TRIM(Vname(1,idWztw)), S(ng)%Rindex + END IF + exit_flag=3 + ioerror=status + RETURN + END IF + END IF +! +! Write out Waves Effect on Currents quasi-static pressure. +! + IF (VarOut(idWqsp,ng)) THEN + scale=1.0_dp + IF (S(ng)%pioVar(idWqsp)%dkind.eq.PIO_double) THEN + ioDesc => ioDesc_dp_r2dvar(ng) + ELSE + ioDesc => ioDesc_sp_r2dvar(ng) + END IF + IF (Linstataneous) THEN + status=nf_fwrite2d(ng, model, S(ng)%pioFile, idWqsp, & + & S(ng)%pioVar(idWqsp), & + & S(ng)%Rindex, & + & ioDesc, & + + & LBi, UBi, LBj, UBj, scale, & +# ifdef MASKING + & GRID(ng) % rmask, & +# endif + & OCEAN(ng) % qsp) +# ifdef AVERAGES + ELSE + status=nf_fwrite2d(ng, model, S(ng)%pioFile, idWqsp, & + & S(ng)%pioVar(idWqsp), & + & S(ng)%Rindex, & + & ioDesc, & + + & LBi, UBi, LBj, UBj, scale, & +# ifdef MASKING + & GRID(ng) % rmask, & +# endif + & AVERAGE(ng) % avgWqsp) +# endif + END IF + IF (FoundError(status, nf90_noerr, __LINE__, MyFile)) THEN + IF (Master) THEN + WRITE (stdout,10) TRIM(Vname(1,idWqsp)), S(ng)%Rindex + END IF + exit_flag=3 + ioerror=status + RETURN + END IF + END IF +! +! Write out Waves Effect on Currents Bernoulli head. +! + IF (VarOut(idWbeh,ng)) THEN + scale=1.0_dp + IF (S(ng)%pioVar(idWbeh)%dkind.eq.PIO_double) THEN + ioDesc => ioDesc_dp_r2dvar(ng) + ELSE + ioDesc => ioDesc_sp_r2dvar(ng) + END IF + IF (Linstataneous) THEN + status=nf_fwrite2d(ng, model, S(ng)%pioFile, idWbeh, & + & S(ng)%pioVar(idWbeh), & + & S(ng)%Rindex, & + & ioDesc, & + & LBi, UBi, LBj, UBj, scale, & +# ifdef MASKING + & GRID(ng) % rmask, & +# endif + & OCEAN(ng) % bh) +# ifdef AVERAGES + ELSE + status=nf_fwrite2d(ng, model, S(ng)%pioFile, idWbeh, & + & S(ng)%pioVar(idWbeh), & + & S(ng)%Rindex, & + & ioDesc, & + & LBi, UBi, LBj, UBj, scale, & +# ifdef MASKING + & GRID(ng) % rmask, & +# endif + & AVERAGE(ng) % avgWbeh) +# endif + END IF + IF (FoundError(status, nf90_noerr, __LINE__, MyFile)) THEN + IF (Master) THEN + WRITE (stdout,10) TRIM(Vname(1,idWbeh)), S(ng)%Rindex + END IF + exit_flag=3 + ioerror=status + RETURN + END IF + END IF +# endif +# endif +# if (defined BOTTOM_STREAMING && defined WEC_VF) || \ + defined WAV_COUPLING +! +! Write out wave dissipation due to bottom friction. +! + IF (VarOut(idWdif,ng)) THEN + scale=rho0 ! W m /kg to W/m2 + IF (S(ng)%pioVar(idWdif)%dkind.eq.PIO_double) THEN + ioDesc => ioDesc_dp_r2dvar(ng) + ELSE + ioDesc => ioDesc_sp_r2dvar(ng) + END IF + IF (Linstataneous) THEN + status=nf_fwrite2d(ng, model, S(ng)%pioFile, idWdif, & + & S(ng)%pioVar(idWdif), & + & S(ng)%Rindex, & + & ioDesc, & + & LBi, UBi, LBj, UBj, scale, & +# ifdef MASKING + & GRID(ng) % rmask, & +# endif + & FORCES(ng) % Dissip_fric) +# ifdef AVERAGES + ELSE + status=nf_fwrite2d(ng, model, S(ng)%pioFile, idWdif, & + & S(ng)%pioVar(idWdif), & + & S(ng)%Rindex, & + & ioDesc, & + & LBi, UBi, LBj, UBj, scale, & +# ifdef MASKING + & GRID(ng) % rmask, & +# endif + & AVERAGE(ng) % avgWdif) +# endif + END IF + IF (FoundError(status, nf90_noerr, __LINE__, MyFile)) THEN + IF (Master) THEN + WRITE (stdout,10) TRIM(Vname(1,idWdif)), S(ng)%Rindex + END IF + exit_flag=3 + ioerror=status + RETURN + END IF + END IF +# endif +# if defined TKE_WAVEDISS || defined WAV_COUPLING || \ + defined WDISS_THORGUZA || defined WDISS_CHURTHOR || \ + defined WAVES_DISS || defined WDISS_INWAVE +! +! Write out wave dissipation due to breaking. +! + IF (VarOut(idWdib,ng)) THEN + scale=1.0_dp + IF (S(ng)%pioVar(idWdib)%dkind.eq.PIO_double) THEN + ioDesc => ioDesc_dp_r2dvar(ng) + ELSE + ioDesc => ioDesc_sp_r2dvar(ng) + END IF + IF (Linstataneous) THEN + status=nf_fwrite2d(ng, model, S(ng)%pioFile, idWdib, & + & S(ng)%pioVar(idWdib), & + & S(ng)%Rindex, & + & ioDesc, & + & LBi, UBi, LBj, UBj, scale, & +# ifdef MASKING + & GRID(ng) % rmask, & +# endif + & FORCES(ng) % Dissip_break) +# ifdef AVERAGES + ELSE + status=nf_fwrite2d(ng, model, S(ng)%pioFile, idWdib, & + & S(ng)%pioVar(idWdib), & + & S(ng)%Rindex, & + & ioDesc, & + & LBi, UBi, LBj, UBj, scale, & +# ifdef MASKING + & GRID(ng) % rmask, & +# endif + & AVERAGE(ng) % avgWdib) +# endif + END IF + IF (FoundError(status, nf90_noerr, __LINE__, MyFile)) THEN + IF (Master) THEN + WRITE (stdout,10) TRIM(Vname(1,idWdib)), S(ng)%Rindex + END IF + exit_flag=3 + ioerror=status + RETURN + END IF + END IF +! +! Write out wave dissipation due to whitecapping. +! + IF (VarOut(idWdiw,ng)) THEN + scale=1.0_dp + IF (S(ng)%pioVar(idWdiw)%dkind.eq.PIO_double) THEN + ioDesc => ioDesc_dp_r2dvar(ng) + ELSE + ioDesc => ioDesc_sp_r2dvar(ng) + END IF + IF (Linstataneous) THEN + status=nf_fwrite2d(ng, model, S(ng)%pioFile, idWdiw, & + & S(ng)%pioVar(idWdiw), & + & S(ng)%Rindex, & + & ioDesc, & + & LBi, UBi, LBj, UBj, scale, & +# ifdef MASKING + & GRID(ng) % rmask, & +# endif + & FORCES(ng) % Dissip_wcap) +# ifdef AVERAGES + ELSE + status=nf_fwrite2d(ng, model, S(ng)%pioFile, idWdiw, & + & S(ng)%pioVar(idWdiw), & + & S(ng)%Rindex, & + & ioDesc, & + & LBi, UBi, LBj, UBj, scale, & +# ifdef MASKING + & GRID(ng) % rmask, & +# endif + & AVERAGE(ng) % avgWdiw) +# endif + END IF + IF (FoundError(status, nf90_noerr, __LINE__, MyFile)) THEN + IF (Master) THEN + WRITE (stdout,10) TRIM(Vname(1,idWdiw)), S(ng)%Rindex + END IF + exit_flag=3 + ioerror=status + RETURN + END IF + END IF +# endif +# ifdef ROLLER_SVENDSEN +! +! Write out percent wave breaking. +! + IF (VarOut(idWbrk,ng)) THEN + scale=1.0_dp + IF (S(ng)%pioVar(idWbrk)%dkind.eq.PIO_double) THEN + ioDesc => ioDesc_dp_r2dvar(ng) + ELSE + ioDesc => ioDesc_sp_r2dvar(ng) + END IF + IF (Linstataneous) THEN + status=nf_fwrite2d(ng, model, S(ng)%pioFile, idWbrk, & + & S(ng)%pioVar(idWbrk), & + & S(ng)%Rindex, & + & ioDesc, & + & LBi, UBi, LBj, UBj, scale, & +# ifdef MASKING + & GRID(ng) % rmask, & +# endif + & FORCES(ng) % Wave_break) +# ifdef AVERAGES + ELSE + status=nf_fwrite2d(ng, model, S(ng)%pioFile, idWbrk, & + & S(ng)%pioVar(idWbrk), & + & S(ng)%Rindex, & + & ioDesc, & + & LBi, UBi, LBj, UBj, scale, & +# ifdef MASKING + & GRID(ng) % rmask, & +# endif + & AVERAGE(ng) % avgWbrk) +# endif + END IF + IF (FoundError(status, nf90_noerr, __LINE__, MyFile)) THEN + IF (Master) THEN + WRITE (stdout,10) TRIM(Vname(1,idWbrk)), S(ng)%Rindex + END IF + exit_flag=3 + ioerror=status + RETURN + END IF + END IF +# endif +# ifdef WEC_ROLLER +! +! Write out wave roller dissipation. +! + IF (VarOut(idWdis,ng)) THEN + scale=1.0_dp + IF (S(ng)%pioVar(idWdis)%dkind.eq.PIO_double) THEN + ioDesc => ioDesc_dp_r2dvar(ng) + ELSE + ioDesc => ioDesc_sp_r2dvar(ng) + END IF + IF (Linstataneous) THEN + status=nf_fwrite2d(ng, model, S(ng)%pioFile, idWdis, & + & S(ng)%pioVar(idWdis), & + & S(ng)%Rindex, & + & ioDesc, & + & LBi, UBi, LBj, UBj, scale, & +# ifdef MASKING + & GRID(ng) % rmask, & +# endif + & FORCES(ng) % Dissip_roller) +# ifdef AVERAGES + ELSE + status=nf_fwrite2d(ng, model, S(ng)%pioFile, idWdis, & + & S(ng)%pioVar(idWdis), & + & S(ng)%Rindex, & + & ioDesc, & + & LBi, UBi, LBj, UBj, scale, & +# ifdef MASKING + & GRID(ng) % rmask, & +# endif + & AVERAGE(ng) % avgWdis) +# endif + END IF + IF (FoundError(status, nf90_noerr, __LINE__, MyFile)) THEN + IF (Master) THEN + WRITE (stdout,10) TRIM(Vname(1,idWdis)), S(ng)%Rindex + END IF + exit_flag=3 + ioerror=status + RETURN + END IF + END IF +# endif +# ifdef ROLLER_RENIERS +! +! Write out roller wave action density. +! + IF (VarOut(idWrol,ng)) THEN + scale=1.0_dp + IF (S(ng)%pioVar(idWrol)%dkind.eq.PIO_double) THEN + ioDesc => ioDesc_dp_r2dvar(ng) + ELSE + ioDesc => ioDesc_sp_r2dvar(ng) + END IF + IF (Linstataneous) THEN + status=nf_fwrite2d(ng, model, S(ng)%pioFile, idWrol, & + & S(ng)%pioVar(idWrol), & + & S(ng)%Rindex, & + & ioDesc, & + & LBi, UBi, LBj, UBj, scale, & +# ifdef MASKING + & GRID(ng) % rmask, & +# endif + & AVERAGE(ng) % avgWrol) +# ifdef AVERAGES + ELSE + status=nf_fwrite2d(ng, model, S(ng)%pioFile, idWrol, & + & S(ng)%pioVar(idWrol), & + & S(ng)%Rindex, & + & ioDesc, & + & LBi, UBi, LBj, UBj, scale, & +# ifdef MASKING + & GRID(ng) % rmask, & +# endif + & AVERAGE(ng) % avgWrol) +# endif + END IF + IF (FoundError(status, nf90_noerr, __LINE__, MyFile)) THEN + IF (Master) THEN + WRITE (stdout,10) TRIM(Vname(1,idWrol)), S(ng)%Rindex + END IF + exit_flag=3 + ioerror=status + RETURN + END IF + END IF +# endif +! + 10 FORMAT (/," WEC_WRT_PIO - error while writing variable '",a, & + & "', time record = ",i0,/,11x,'into file: ',a) +! + RETURN + END SUBROUTINE wec_wrt_pio + +# ifdef STATIONS +! +!*********************************************************************** + SUBROUTINE wec_def_station_pio (ng, model, ldef, VarOut, S, & + & pgrd, rgrd) +!*********************************************************************** +! + USE mod_netcdf +! +! Imported variable declarations. +! + logical, intent(in) :: ldef, VarOut(NV,Ngrids) +! + integer, intent(in) :: ng, model + integer, intent(in), optional :: pgrd(:), rgrd(:) +! + TYPE(T_IO), intent(inout) :: S(Ngrids) +! +! Local variable declarations. +! + logical :: got_var(NV) +! + integer, parameter :: Natt = 25 + + integer :: i, j, status +! + real(r8) :: Aval(6) +! + character (len=120) :: Vinfo(Natt) + character (len=256) :: ncname +! + character (len=*), parameter :: MyFile = & + & __FILE__//", wec_def_station_nf90" +! + SourceFile=MyFile +! +!----------------------------------------------------------------------- +! Define Waves Effect on Currents output stations variables. +!----------------------------------------------------------------------- +! + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN + ncname=S(ng)%name +! + DEFINE : IF (ldef) THEN +! +! Initialize local information variable arrays. +! + DO i=1,Natt + DO j=1,LEN(Vinfo(1)) + Vinfo(i)(j:j)=' ' + END DO + END DO + DO i=1,6 + Aval(i)=0.0_r8 + END DO + +# ifdef WEC +! +! Define 2D Stokes U-velocity. +! + IF (Sout(idU2Sd,ng)) THEN + Vinfo( 1)=Vname(1,idU2Sd) + Vinfo( 2)=Vname(2,idU2Sd) + Vinfo( 3)=Vname(3,idU2Sd) + Vinfo(14)=Vname(4,idU2Sd) + Vinfo(16)=Vname(1,idtime) + STA(ng)%pioVar(idU2Sd)%dkind=PIO_FOUT + STA(ng)%pioVar(idU2Sd)%gtype=0 +! + status=def_var(ng, iNLM, STA(ng)%pioFile, & + & STA(ng)%pioVar(idU2Sd)%vd, & + & PIO_FOUT, 2, pgrd, Aval, Vinfo, ncname, & + & SetParAccess = .TRUE.) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN + END IF +! +! Define 2D Stokes V-velocity. +! + IF (Sout(idV2Sd,ng)) THEN + Vinfo( 1)=Vname(1,idV2Sd) + Vinfo( 2)=Vname(2,idV2Sd) + Vinfo( 3)=Vname(3,idV2Sd) + Vinfo(14)=Vname(4,idV2Sd) + Vinfo(16)=Vname(1,idtime) + STA(ng)%pioVar(idV2Sd)%dkind=PIO_FOUT + STA(ng)%pioVar(idV2Sd)%gtype=0 +! + status=def_var(ng, iNLM, STA(ng)%pioFile, & + & STA(ng)%pioVar(idV2Sd)%vd, & + & PIO_FOUT, 2, pgrd, Aval, Vinfo, ncname, & + & SetParAccess = .TRUE.) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN + END IF +! +! Define 2D total Waves Effect on Currents U-stress. +! + IF (Sout(idU2rs,ng)) THEN + Vinfo( 1)=Vname(1,idU2rs) + Vinfo( 2)=Vname(2,idU2rs) + Vinfo( 3)=Vname(3,idU2rs) + Vinfo(14)=Vname(4,idU2rs) + Vinfo(16)=Vname(1,idtime) + STA(ng)%pioVar(idU2rs)%dkind=PIO_FOUT + STA(ng)%pioVar(idU2rs)%gtype=0 +! + status=def_var(ng, iNLM, STA(ng)%pioFile, & + & STA(ng)%pioVar(idU2rs)%vd, & + & PIO_FOUT, 2, pgrd, Aval, Vinfo, ncname, & + & SetParAccess = .TRUE.) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN + END IF +! +! Define 2D total Waves Effect on Currents V-stress. +! + IF (Sout(idV2rs,ng)) THEN + Vinfo( 1)=Vname(1,idV2rs) + Vinfo( 2)=Vname(2,idV2rs) + Vinfo( 3)=Vname(3,idV2rs) + Vinfo(14)=Vname(4,idV2rs) + Vinfo(16)=Vname(1,idtime) + STA(ng)%pioVar(idV2rs)%dkind=PIO_FOUT + STA(ng)%pioVar(idV2rs)%gtype=0 +! + status=def_var(ng, iNLM, STA(ng)%pioFile, & + & STA(ng)%pioVar(idV2rs)%vd, & + & PIO_FOUT, 2, pgrd, Aval, Vinfo, ncname, & + & SetParAccess = .TRUE.) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN + END IF + +# ifdef SOLVE3D +! +! Define 3D Stokes U-velocity. +! + IF (Sout(idU3Sd,ng)) THEN + Vinfo( 1)=Vname(1,idU3Sd) + Vinfo( 2)=Vname(2,idU3Sd) + Vinfo( 3)=Vname(3,idU3Sd) + Vinfo(14)=Vname(4,idU3Sd) + Vinfo(16)=Vname(1,idtime) + STA(ng)%pioVar(idU3Sd)%dkind=PIO_FOUT + STA(ng)%pioVar(idU3Sd)%gtype=0 +! + status=def_var(ng, iNLM, STA(ng)%pioFile, & + & STA(ng)%pioVar(idU3Sd)%vd, & + & PIO_FOUT, 3, rgrd, Aval, Vinfo, ncname, & + & SetFillVal = .TRUE., & + & SetParAccess = .TRUE.) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN + END IF +! +! Define 3D Stokes V-velocity. +! + IF (Sout(idV3Sd,ng)) THEN + Vinfo( 1)=Vname(1,idV3Sd) + Vinfo( 2)=Vname(2,idV3Sd) + Vinfo( 3)=Vname(3,idV3Sd) + Vinfo(14)=Vname(4,idV3Sd) + Vinfo(16)=Vname(1,idtime) + STA(ng)%pioVar(idV3Sd)%dkind=PIO_FOUT + STA(ng)%pioVar(idV3Sd)%gtype=0 +! + status=def_var(ng, iNLM, STA(ng)%pioFile, & + & STA(ng)%pioVar(idV3Sd)%vd, & + & PIO_FOUT, 3, rgrd, Aval, Vinfo, ncname, & + & SetFillVal = .TRUE., & + & SetParAccess = .TRUE.) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN + END IF +! +! Define 3D Stokes omega-velocity. +! + IF (Sout(idW3Sd,ng)) THEN + Vinfo( 1)=Vname(1,idW3Sd) + Vinfo( 2)=Vname(2,idW3Sd) + Vinfo( 3)=Vname(3,idW3Sd) + Vinfo(14)=Vname(4,idW3Sd) + Vinfo(16)=Vname(1,idtime) + STA(ng)%pioVar(idW3Sd)%dkind=PIO_FOUT + STA(ng)%pioVar(idW3Sd)%gtype=0 +! + status=def_var(ng, iNLM, STA(ng)%pioFile, & + & STA(ng)%pioVar(idW3Sd)%vd, & + & PIO_FOUT, 3, rgrd, Aval, Vinfo, ncname, & + & SetFillVal = .TRUE., & + & SetParAccess = .TRUE.) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN + END IF +! +! Define 3D 'true' Stokes W-velocity. +! + IF (Sout(idW3St,ng)) THEN + Vinfo( 1)=Vname(1,idW3St) + Vinfo( 2)=Vname(2,idW3St) + Vinfo( 3)=Vname(3,idW3St) + Vinfo(14)=Vname(4,idW3St) + Vinfo(16)=Vname(1,idtime) + STA(ng)%pioVar(idW3St)%dkind=PIO_FOUT + STA(ng)%pioVar(idW3St)%gtype=0 +! + status=def_var(ng, iNLM, STA(ng)%pioFile, & + & STA(ng)%pioVar(idW3St)%vd, & + & PIO_FOUT, 3, rgrd, Aval, Vinfo, ncname, & + & SetFillVal = .TRUE., & + & SetParAccess = .TRUE.) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN + END IF +! +! Define 3D total Waves Effect on Currents U-stress. +! + IF (Sout(idU3rs,ng)) THEN + Vinfo( 1)=Vname(1,idU3rs) + Vinfo( 2)=Vname(2,idU3rs) + Vinfo( 3)=Vname(3,idU3rs) + Vinfo(14)=Vname(4,idU3rs) + Vinfo(16)=Vname(1,idtime) + STA(ng)%pioVar(idU3rs)%dkind=PIO_FOUT + STA(ng)%pioVar(idU3rs)%gtype=0 +! + status=def_var(ng, iNLM, STA(ng)%pioFile, & + & STA(ng)%pioVar(idU3rs)%vd, & + & PIO_FOUT, 3, rgrd, Aval, Vinfo, ncname, & + & SetFillVal = .TRUE., & + & SetParAccess = .TRUE.) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN + END IF +! +! Define 3D total Waves Effect on Current V-stress. +! + IF (Sout(idV3rs,ng)) THEN + Vinfo( 1)=Vname(1,idV3rs) + Vinfo( 2)=Vname(2,idV3rs) + Vinfo( 3)=Vname(3,idV3rs) + Vinfo(14)=Vname(4,idV3rs) + Vinfo(16)=Vname(1,idtime) + STA(ng)%pioVar(idV3rs)%dkind=PIO_FOUT + STA(ng)%pioVar(idV3rs)%gtype=0 +! + status=def_var(ng, iNLM, STA(ng)%pioFile, & + & STA(ng)%pioVar(idV3rs)%vd, & + & PIO_FOUT, 3, rgrd, Aval, Vinfo, ncname, & + & SetFillVal = .TRUE., & + & SetParAccess = .TRUE.) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN + END IF +# endif +# endif +# ifdef WEC_VF +! +! Define Waves Effect on Currents quasi-static sea level adjustment. +! + IF (Sout(idWztw,ng)) THEN + Vinfo( 1)=Vname(1,idWztw) + Vinfo( 2)=Vname(2,idWztw) + Vinfo( 3)=Vname(3,idWztw) + Vinfo(14)=Vname(4,idWztw) + Vinfo(16)=Vname(1,idtime) + STA(ng)%pioVar(idWztw)%dkind=PIO_FOUT + STA(ng)%pioVar(idWztw)%gtype=0 +! + status=def_var(ng, iNLM, STA(ng)%pioFile, & + & STA(ng)%pioVar(idWztw)%vd, & + & PIO_FOUT, 2, pgrd, Aval, Vinfo, ncname, & + & SetFillVal = .TRUE., & + & SetParAccess = .TRUE.) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN + END IF +! +! Define Waves Effect on Currents quasi-static pressure. +! + IF (Sout(idWqsp,ng)) THEN + Vinfo( 1)=Vname(1,idWqsp) + Vinfo( 2)=Vname(2,idWqsp) + Vinfo( 3)=Vname(3,idWqsp) + Vinfo(14)=Vname(4,idWqsp) + Vinfo(16)=Vname(1,idtime) + STA(ng)%pioVar(idWqsp)%dkind=PIO_FOUT + STA(ng)%pioVar(idWqsp)%gtype=0 +! + status=def_var(ng, iNLM, STA(ng)%pioFile, & + & STA(ng)%pioVar(idWqsp)%vd, & + & PIO_FOUT, 2, pgrd, Aval, Vinfo, ncname, & + & SetFillVal = .TRUE., & + & SetParAccess = .TRUE.) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN + END IF +! +! Define Waves Effect on Currents Bernoulli head. +! + IF (Sout(idWbeh,ng)) THEN + Vinfo( 1)=Vname(1,idWbeh) + Vinfo( 2)=Vname(2,idWbeh) + Vinfo( 3)=Vname(3,idWbeh) + Vinfo(14)=Vname(4,idWbeh) + Vinfo(16)=Vname(1,idtime) + STA(ng)%pioVar(idWbeh)%dkind=PIO_FOUT + STA(ng)%pioVar(idWbeh)%gtype=0 +! + status=def_var(ng, iNLM, STA(ng)%pioFile, & + & STA(ng)%pioVar(idWbeh)%vd, & + & PIO_FOUT, 2, pgrd, Aval, Vinfo, ncname, & + & SetFillVal = .TRUE., & + & SetParAccess = .TRUE.) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN + END IF +# endif +# if (defined BOTTOM_STREAMING && defined WEC_VF) || \ + defined WAV_COUPLING +! +! Define wave dissipation due to bottom friction. +! + IF (Sout(idWdif,ng)) THEN + Vinfo( 1)=Vname(1,idWdif) + Vinfo( 2)=Vname(2,idWdif) + Vinfo( 3)=Vname(3,idWdif) + Vinfo(14)=Vname(4,idWdif) + Vinfo(16)=Vname(1,idtime) + STA(ng)%pioVar(idWdif)%dkind=PIO_FOUT + STA(ng)%pioVar(idWdif)%gtype=0 +! + status=def_var(ng, iNLM, STA(ng)%pioFile, & + & STA(ng)%pioVar(idWdif)%vd, & + & PIO_FOUT, 2, pgrd, Aval, Vinfo, ncname, & + & SetFillVal = .TRUE., & + & SetParAccess = .TRUE.) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN + END IF +# endif +# if defined TKE_WAVEDISS || defined WAV_COUPLING || \ + defined WDISS_THORGUZA || defined WDISS_CHURTHOR || \ + defined WAVES_DISS || defined WDISS_INWAVE +! +! Define wave dissipation due to breaking. +! + IF (Sout(idWdis,ng)) THEN + Vinfo( 1)=Vname(1,idWdis) + Vinfo( 2)=Vname(2,idWdis) + Vinfo( 3)=Vname(3,idWdis) + Vinfo(14)=Vname(4,idWdis) + Vinfo(16)=Vname(1,idtime) + STA(ng)%pioVar(idWdis)%dkind=PIO_FOUT + STA(ng)%pioVar(idWdis)%gtype=0 +! + status=def_var(ng, iNLM, STA(ng)%pioFile, & + & STA(ng)%pioVar(idWdis)%vd, & + & PIO_FOUT, 2, pgrd, Aval, Vinfo, ncname, & + & SetFillVal = .TRUE., & + & SetParAccess = .TRUE.) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN + END IF +! +! Define wave dissipation due to whitecapping. +! + IF (Sout(idWdiw,ng)) THEN + Vinfo( 1)=Vname(1,idWdiw) + Vinfo( 2)=Vname(2,idWdiw) + Vinfo( 3)=Vname(3,idWdiw) + Vinfo(14)=Vname(4,idWdiw) + Vinfo(16)=Vname(1,idtime) + STA(ng)%pioVar(idWdiw)%dkind=PIO_FOUT + STA(ng)%pioVar(idWdiw)%gtype=0 +! + status=def_var(ng, iNLM, STA(ng)%pioFile, & + & STA(ng)%pioVar(idWdiw)%vd, & + & PIO_FOUT, 2, pgrd, Aval, Vinfo, ncname, & + & SetFillVal = .TRUE., & + & SetParAccess = .TRUE.) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN + END IF +# endif +# ifdef ROLLER_SVENDSEN +! +! Define percent wave breaking. +! + IF (Sout(idWbrk,ng)) THEN + Vinfo( 1)=Vname(1,idWbrk) + Vinfo( 2)=Vname(2,idWbrk) + Vinfo( 3)=Vname(3,idWbrk) + Vinfo(14)=Vname(4,idWbrk) + Vinfo(16)=Vname(1,idtime) + STA(ng)%pioVar(idWbrk)%dkind=PIO_FOUT + STA(ng)%pioVar(idWbrk)%gtype=0 +! + status=def_var(ng, iNLM, STA(ng)%pioFile, & + & STA(ng)%pioVar(idWbrk)%vd, & + & PIO_FOUT, 2, pgrd, Aval, Vinfo, ncname, & + & SetFillVal = .TRUE., & + & SetParAccess = .TRUE.) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN + END IF +# endif +# ifdef WEC_ROLLER +! +! Define wave roller dissipation. +! + IF (Sout(idWdis,ng)) THEN + Vinfo( 1)=Vname(1,idWdis) + Vinfo( 2)=Vname(2,idWdis) + Vinfo( 3)=Vname(3,idWdis) + Vinfo(14)=Vname(4,idWdis) + Vinfo(16)=Vname(1,idtime) + STA(ng)%pioVar(idWdis)%dkind=PIO_FOUT + STA(ng)%pioVar(idWdis)%gtype=0 +! + status=def_var(ng, iNLM, STA(ng)%pioFile, & + & STA(ng)%pioVar(idWdis)%vd, & + & PIO_FOUT, 2, pgrd, Aval, Vinfo, ncname, & + & SetFillVal = .TRUE., & + & SetParAccess = .TRUE.) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN + END IF +# endif +# ifdef ROLLER_RENIERS +! +! Define wave roller action density. +! + IF (Sout(idWrol,ng)) THEN + Vinfo( 1)=Vname(1,idWrol) + Vinfo( 2)=Vname(2,idWrol) + Vinfo( 3)=Vname(3,idWrol) + Vinfo(14)=Vname(4,idWrol) + Vinfo(16)=Vname(1,idtime) + STA(ng)%pioVar(idWrol)%dkind=PIO_FOUT + STA(ng)%pioVar(idWrol)%gtype=0 +! + status=def_var(ng, iNLM, STA(ng)%pioFile, & + & STA(ng)%pioVar(idWrol)%vd, & + & PIO_FOUT, 2, pgrd, Aval, Vinfo, ncname, & + & SetFillVal = .TRUE., & + & SetParAccess = .TRUE.) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN + END IF +# endif + END IF DEFINE +! +!----------------------------------------------------------------------- +! Open an existing stations file, check its contents, and prepare for +! appending data. +!----------------------------------------------------------------------- +! + QUERY : IF (.not.ldef) THEN +! +! Initialize logical switches. +! + DO i=1,NV + got_var(i)=.FALSE. + END DO +! +! Scan variable list from input NetCDF and activate switches for +! stations variables. Get variable IDs. +! + DO i=1,n_var + IF (TRIM(var_name(i)).eq.TRIM(Vname(1,idtime))) THEN + got_var(idtime)=.TRUE. + S(ng)%pioVar(idtime)%vd=var_desc(i) + S(ng)%pioVar(idtime)%dkind=PIO_TOUT + S(ng)%pioVar(idtime)%gtype=0 +# ifdef WEC + ELSE IF (TRIM(var_name(i)).eq.TRIM(Vname(1,idU2Sd))) THEN + got_var(idU2Sd)=.TRUE. + S(ng)%pioVar(idU2Sd)%vd=var_desc(i) + S(ng)%pioVar(idU2Sd)%dkind=PIO_FOUT + S(ng)%pioVar(idU2Sd)%gtype=0 + ELSE IF (TRIM(var_name(i)).eq.TRIM(Vname(1,idV2Sd))) THEN + got_var(idV2Sd)=.TRUE. + S(ng)%pioVar(idV2Sd)%vd=var_desc(i) + S(ng)%pioVar(idV2Sd)%dkind=PIO_FOUT + S(ng)%pioVar(idV2Sd)%gtype=0 + ELSE IF (TRIM(var_name(i)).eq.TRIM(Vname(1,idU2rs))) THEN + got_var(idU2rs)=.TRUE. + S(ng)%pioVar(idU2rs)%vd=var_desc(i) + S(ng)%pioVar(idU2rs)%dkind=PIO_FOUT + S(ng)%pioVar(idU2rs)%gtype=0 + ELSE IF (TRIM(var_name(i)).eq.TRIM(Vname(1,idV2rs))) THEN + got_var(idV2rs)=.TRUE. + S(ng)%pioVar(idV2rs)%vd=var_desc(i) + S(ng)%pioVar(idV2rs)%dkind=PIO_FOUT + S(ng)%pioVar(idV2rs)%gtype=0 +# ifdef SOLVE3D + ELSE IF (TRIM(var_name(i)).eq.TRIM(Vname(1,idU3Sd))) THEN + got_var(idU3Sd)=.TRUE. + S(ng)%pioVar(idU3Sd)%vd=var_desc(i) + S(ng)%pioVar(idU3Sd)%dkind=PIO_FOUT + S(ng)%pioVar(idU3Sd)%gtype=0 + ELSE IF (TRIM(var_name(i)).eq.TRIM(Vname(1,idV3Sd))) THEN + got_var(idV3Sd)=.TRUE. + S(ng)%pioVar(idV3Sd)%vd=var_desc(i) + S(ng)%pioVar(idV3Sd)%dkind=PIO_FOUT + S(ng)%pioVar(idV3Sd)%gtype=0 + ELSE IF (TRIM(var_name(i)).eq.TRIM(Vname(1,idW3Sd))) THEN + got_var(idW3Sd)=.TRUE. + S(ng)%pioVar(idW3Sd)%vd=var_desc(i) + S(ng)%pioVar(idW3Sd)%dkind=PIO_FOUT + S(ng)%pioVar(idW3Sd)%gtype=0 + ELSE IF (TRIM(var_name(i)).eq.TRIM(Vname(1,idW3St))) THEN + got_var(idW3St)=.TRUE. + S(ng)%pioVar(idW3St)%vd=var_desc(i) + S(ng)%pioVar(idW3St)%dkind=PIO_FOUT + S(ng)%pioVar(idW3St)%gtype=0 + ELSE IF (TRIM(var_name(i)).eq.TRIM(Vname(1,idU3rs))) THEN + got_var(idU3rs)=.TRUE. + S(ng)%pioVar(idU3rs)%vd=var_desc(i) + S(ng)%pioVar(idU3rs)%dkind=PIO_FOUT + S(ng)%pioVar(idU3rs)%gtype=0 + ELSE IF (TRIM(var_name(i)).eq.TRIM(Vname(1,idV3rs))) THEN + got_var(idV3rs)=.TRUE. + S(ng)%pioVar(idV3rs)%vd=var_desc(i) + S(ng)%pioVar(idV3rs)%dkind=PIO_FOUT + S(ng)%pioVar(idV3rs)%gtype=0 +# endif +# endif +# ifdef WEC_VF + ELSE IF (TRIM(var_name(i)).eq.TRIM(Vname(1,idWztw))) THEN + got_var(idWztw)=.TRUE. + S(ng)%pioVar(idWztw)%vd=var_desc(i) + S(ng)%pioVar(idWztw)%dkind=PIO_FOUT + S(ng)%pioVar(idWztw)%gtype=0 + ELSE IF (TRIM(var_name(i)).eq.TRIM(Vname(1,idWqsp))) THEN + got_var(idWqsp)=.TRUE. + S(ng)%pioVar(idWqsp)%vd=var_desc(i) + S(ng)%pioVar(idWqsp)%dkind=PIO_FOUT + S(ng)%pioVar(idWqsp)%gtype=0 + ELSE IF (TRIM(var_name(i)).eq.TRIM(Vname(1,idWbeh))) THEN + got_var(idWbeh)=.TRUE. + S(ng)%pioVar(idWbeh)%vd=var_desc(i) + S(ng)%pioVar(idWbeh)%dkind=PIO_FOUT + S(ng)%pioVar(idWbeh)%gtype=0 +# endif +# if (defined BOTTOM_STREAMING && defined WEC_VF) || \ + defined WAV_COUPLING + ELSE IF (TRIM(var_name(i)).eq.TRIM(Vname(1,idWdif))) THEN + got_var(idWdif)=.TRUE. + S(ng)%pioVar(idWdif)%vd=var_desc(i) + S(ng)%pioVar(idWdif)%dkind=PIO_FOUT + S(ng)%pioVar(idWdif)%gtype=0 +# endif +# if defined TKE_WAVEDISS || defined WAV_COUPLING || \ + defined WDISS_THORGUZA || defined WDISS_CHURTHOR || \ + defined WAVES_DISS || defined WDISS_INWAVE + ELSE IF (TRIM(var_name(i)).eq.TRIM(Vname(1,idWdib))) THEN + got_var(idWdib)=.TRUE. + S(ng)%pioVar(idWdib)%vd=var_desc(i) + S(ng)%pioVar(idWdib)%dkind=PIO_FOUT + S(ng)%pioVar(idWdib)%gtype=0 + ELSE IF (TRIM(var_name(i)).eq.TRIM(Vname(1,idWdiw))) THEN + got_var(idWdiw)=.TRUE. + S(ng)%pioVar(idWdiw)%vd=var_desc(i) + S(ng)%pioVar(idWdiw)%dkind=PIO_FOUT + S(ng)%pioVar(idWdiw)%gtype=0 +# endif +# ifdef ROLLER_SVENDSEN + ELSE IF (TRIM(var_name(i)).eq.TRIM(Vname(1,idWbrk))) THEN + got_var(idWbrk)=.TRUE. + S(ng)%pioVar(idWbrk)%vd=var_desc(i) + S(ng)%pioVar(idWbrk)%dkind=PIO_FOUT + S(ng)%pioVar(idWbrk)%gtype=0 +# endif +# ifdef WEC_ROLLER + ELSE IF (TRIM(var_name(i)).eq.TRIM(Vname(1,idWdis))) THEN + got_var(idWdis)=.TRUE. + S(ng)%pioVar(idWdis)%vd=var_desc(i) + S(ng)%pioVar(idWdis)%dkind=PIO_FOUT + S(ng)%pioVar(idWdis)%gtype=0 +# endif +# ifdef ROLLER_RENIERS + ELSE IF (TRIM(var_name(i)).eq.TRIM(Vname(1,idWrol))) THEN + got_var(idWrol)=.TRUE. + S(ng)%pioVar(idWrol)%vd=var_desc(i) + S(ng)%pioVar(idWrol)%dkind=PIO_FOUT + S(ng)%pioVar(idWrol)%gtype=0 +# endif +! +! Check if station variables are available in input NetCDF file. +! +# ifdef WEC + IF (.not.got_var(idU2Sd).and.Sout(idU2Sd,ng)) THEN + IF (Master) WRITE (stdout,10) TRIM(Vname(1,idU2Sd)), & + & TRIM(ncname) + exit_flag=3 + RETURN + END IF + IF (.not.got_var(idV2Sd).and.Sout(idV2Sd,ng)) THEN + IF (Master) WRITE (stdout,10) TRIM(Vname(1,idV2Sd)), & + & TRIM(ncname) + exit_flag=3 + RETURN + END IF + IF (.not.got_var(idU2rs).and.Sout(idU2rs,ng)) THEN + IF (Master) WRITE (stdout,10) TRIM(Vname(1,idU2rs)), & + & TRIM(ncname) + exit_flag=3 + RETURN + END IF + IF (.not.got_var(idV2rs).and.Sout(idV2rs,ng)) THEN + IF (Master) WRITE (stdout,10) TRIM(Vname(1,idV2rs)), & + & TRIM(ncname) + exit_flag=3 + RETURN + END IF +# ifdef SOLVE3D + IF (.not.got_var(idU3Sd).and.Sout(idU3Sd,ng)) THEN + IF (Master) WRITE (stdout,10) TRIM(Vname(1,idU3Sd)), & + & TRIM(ncname) + exit_flag=3 + RETURN + END IF + IF (.not.got_var(idV3Sd).and.Sout(idV3Sd,ng)) THEN + IF (Master) WRITE (stdout,10) TRIM(Vname(1,idV3Sd)), & + & TRIM(ncname) + exit_flag=3 + RETURN + END IF + IF (.not.got_var(idW3Sd).and.Sout(idW3Sd,ng)) THEN + IF (Master) WRITE (stdout,10) TRIM(Vname(1,idW3Sd)), & + & TRIM(ncname) + exit_flag=3 + RETURN + END IF + IF (.not.got_var(idW3St).and.Sout(idW3St,ng)) THEN + IF (Master) WRITE (stdout,10) TRIM(Vname(1,idW3St)), & + & TRIM(ncname) + exit_flag=3 + RETURN + END IF + IF (.not.got_var(idU3Sd).and.Sout(idU3rs,ng)) THEN + IF (Master) WRITE (stdout,10) TRIM(Vname(1,idU3rs)), & + & TRIM(ncname) + exit_flag=3 + RETURN + END IF + IF (.not.got_var(idV3rs).and.Sout(idV3rs,ng)) THEN + IF (Master) WRITE (stdout,10) TRIM(Vname(1,idV3rs)), & + & TRIM(ncname) + exit_flag=3 + RETURN + END IF +# endif +# endif +# ifdef WEC_VF + IF (.not.got_var(idWztw).and.Sout(idWztw,ng)) THEN + IF (Master) WRITE (stdout,10) TRIM(Vname(1,idWztw)), & + & TRIM(ncname) + exit_flag=3 + RETURN + END IF + IF (.not.got_var(idWqsp).and.Sout(idWqsp,ng)) THEN + IF (Master) WRITE (stdout,10) TRIM(Vname(1,idWqsp)), & + & TRIM(ncname) + exit_flag=3 + RETURN + END IF + IF (.not.got_var(idWbeh).and.Sout(idWbeh,ng)) THEN + IF (Master) WRITE (stdout,10) TRIM(Vname(1,idWbeh)), & + & TRIM(ncname) + exit_flag=3 + RETURN + END IF +# endif +# if (defined BOTTOM_STREAMING && defined WEC_VF) || \ + defined WAV_COUPLING + IF (.not.got_var(idWdif).and.Sout(idWdif,ng)) THEN + IF (Master) WRITE (stdout,10) TRIM(Vname(1,idWdif)), & + & TRIM(ncname) + exit_flag=3 + RETURN + END IF +# endif +# if defined TKE_WAVEDISS || defined WAV_COUPLING || \ + defined WDISS_THORGUZA || defined WDISS_CHURTHOR || \ + defined WAVES_DISS || defined WDISS_INWAVE + IF (.not.got_var(idWdib).and.Sout(idWdib,ng)) THEN + IF (Master) WRITE (stdout,10) TRIM(Vname(1,idWdib)), & + & TRIM(ncname) + exit_flag=3 + RETURN + END IF + IF (.not.got_var(idWdiw).and.Sout(idWdiw,ng)) THEN + IF (Master) WRITE (stdout,10) TRIM(Vname(1,idWdiw)), & + & TRIM(ncname) + exit_flag=3 + RETURN + END IF +# endif +# ifdef ROLLER_SVENDSEN + IF (.not.got_var(idWbrk).and.Sout(idWbrk,ng)) THEN + IF (Master) WRITE (stdout,10) TRIM(Vname(1,idWbrk)), & + & TRIM(ncname) + exit_flag=3 + RETURN + END IF +# endif +# ifdef WEC_ROLLER + IF (.not.got_var(idWdis).and.Sout(idWdis,ng)) THEN + IF (Master) WRITE (stdout,10) TRIM(Vname(1,idWdis)), & + & TRIM(ncname) + exit_flag=3 + RETURN + END IF +# endif +# ifdef ROLLER_RENIERS + IF (.not.got_var(idWrol).and.Sout(idWrol,ng)) THEN + IF (Master) WRITE (stdout,10) TRIM(Vname(1,idWrol)), & + & TRIM(ncname) + exit_flag=3 + RETURN + END IF +# endif +! + 10 FORMAT (/,' WEC_DEF_STATION_PIO - unable to find variable: ', & + & a,2x,' in stations NetCDF file: ',a) +! + RETURN + END SUBROUTINE wec_def_station_pio +! +!*********************************************************************** + SUBROUTINE wec_wrt_station_pio (ng, model, tile, & + & LBi, UBi, LBj, UBj, & + & VarOut, S) +!*********************************************************************** +! + USE mod_pio_netcdf +! +! Imported variable declarations. +! + logical, intent(in) :: VarOut(NV,Ngrids) +! + integer, intent(in) :: ng, model, tile + integer, intent(in) :: LBi, UBi, LBj, UBj +! + TYPE(T_IO), intent(inout) :: S(Ngrids) +! +! Local variable declarations. +! + logical :: Cgrid +! + integer :: NposR, NposW + integer :: i, k, np, status +! + real(dp) :: scale +! + real(r8), dimension(Nstation(ng)) :: Xpos, Ypos, Zpos, psta +# ifdef SOLVE3D + real(r8), dimension(Nstation(ng)*(N(ng))) :: XposR, YposR, ZposR + real(r8), dimension(Nstation(ng)*(N(ng)+1)) :: XposW, YposW, ZposW + real(r8), dimension(Nstation(ng)*(N(ng)+1)) :: rsta +# endif +! + character (len=*), parameter :: MyFile = & + & __FILE__//", wec_wrt_station_pio" +! + SourceFile=MyFile +! +!----------------------------------------------------------------------- +! Write out Waves Effect on Currents output variables into specified +! stations output NetCDF file. +!----------------------------------------------------------------------- +! + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN +! +! Set switch to extract station data at native C-grid position (TRUE) +! or at RHO-points (FALSE). +! +# ifdef STATIONS_CGRID + Cgrid=.TRUE. +# else + Cgrid=.FALSE. +# endif +! +! Set positions for generic extraction routine. +! + NposR=Nstation(ng)*N(ng) + NposW=Nstation(ng)*(N(ng)+1) + DO i=1,Nstation(ng) + Xpos(i)=SCALARS(ng)%SposX(i) + Ypos(i)=SCALARS(ng)%SposY(i) + Zpos(i)=1.0_r8 +# ifdef SOLVE3D + DO k=1,N(ng) + np=k+(i-1)*N(ng) + XposR(np)=SCALARS(ng)%SposX(i) + YposR(np)=SCALARS(ng)%SposY(i) + ZposR(np)=REAL(k,r8) + END DO + DO k=0,N(ng) + np=k+1+(i-1)*(N(ng)+1) + XposW(np)=SCALARS(ng)%SposX(i) + YposW(np)=SCALARS(ng)%SposY(i) + ZposW(np)=REAL(k,r8) + END DO +# endif + END DO + +# ifdef WEC +! +! Write out 2D Stokes U-velocity. +! + IF (VarOut(idU2Sd,ng)) THEN + scale=1.0_dp + CALL extract_sta2d (ng, model, Cgrid, idU2Sd, u2dvar, & + & LBi, UBi, LBj, UBj, & + & scale, OCEAN(ng) % ubar_stokes, & + & Nstation(ng), Xpos, Ypos, psta) + CALL pio_netcdf_put_fvar (ng, model, S(ng)%name, & + & TRIM(Vname(1,idU2Sd)), psta, & + & (/1,S(ng)%Rindex/), & + & (/Nstation(ng),1/), & + & pioFile = S(ng)%pioFile, & + & pioVar = S(ng)%pioVar(idU2Sd)%vd) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN + END IF +! +! Write out 2D Stokes V-velocity. +! + IF (VarOut(idV2Sd,ng)) THEN + scale=1.0_dp + CALL extract_sta2d (ng, model, Cgrid, idV2Sd, v2dvar, & + & LBi, UBi, LBj, UBj, & + & scale, OCEAN(ng) % vbar_stokes, & + & Nstation(ng), Xpos, Ypos, psta) + CALL pio_netcdf_put_fvar (ng, model, S(ng)%name, & + & TRIM(Vname(1,idV2Sd)), psta, & + & (/1,S(ng)%Rindex/), & + & (/Nstation(ng),1/), & + & pioFile = S(ng)%pioFile, & + & pioVar = S(ng)%pioVar(idV2Sd)%vd) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN + END IF +! +! Write out 2D total Waves Effect on Currents U-stress. +! + IF (VarOut(idU2rs,ng)) THEN + scale=rho0 + CALL extract_sta2d (ng, model, Cgrid, idU2rs, u2dvar, & + & LBi, UBi, LBj, UBj, & + & scale, MIXING(ng) % rustr2d, & + & Nstation(ng), Xpos, Ypos, psta) + CALL pio_netcdf_put_fvar (ng, model, S(ng)%name, & + & TRIM(Vname(1,idU2rs)), psta, & + & (/1,S(ng)%Rindex/), & + & (/Nstation(ng),1/), & + & pioFile = S(ng)%pioFile, & + & pioVar = S(ng)%pioVar(idU2rs)%vd) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN + END IF +! +! Write out 2D total Waves Effect on Currents V-stress. +! + IF (VarOut(idV2rs,ng)) THEN + scale=rho0 + CALL extract_sta2d (ng, model, Cgrid, idV2rs, v2dvar, & + & LBi, UBi, LBj, UBj, & + & scale, MIXING(ng) % rvstr2d, & + & Nstation(ng), Xpos, Ypos, psta) + CALL pio_netcdf_put_fvar (ng, model, S(ng)%name, & + & TRIM(Vname(1,idV2rs)), psta, & + & (/1,S(ng)%Rindex/), & + & (/Nstation(ng),1/), & + & pioFile = S(ng)%pioFile, & + & pioVar = S(ng)%pioVar(idV2rs)%vd) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN + END IF + +# ifdef SOLVE3D +! +! Write out 3D Stokes U-velocity. +! + IF (VarOut(idU3Sd,ng)) THEN + scale=1.0_dp + CALL extract_sta3d (ng, model, Cgrid, idU3Sd, u3dvar, & + & LBi, UBi, LBj, UBj, 1, N(ng), & + & scale, OCEAN(ng) % u_stokes, & + & NposR, XposR, YposR, ZposR, rsta) + CALL pio_netcdf_put_fvar (ng, model, S(ng)%name, & + & TRIM(Vname(1,idU3Sd)), rsta, & + & (/1,1,S(ng)%Rindex/), & + & (/N(ng),Nstation(ng),1/), & + & pioFile = S(ng)%pioFile, & + & pioVar = S(ng)%pioVar(idU3Sd)%vd) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN + END IF +! +! Write out 3D Stokes V-velocity. +! + IF (VarOut(idV3Sd,ng)) THEN + scale=1.0_dp + CALL extract_sta3d (ng, model, Cgrid, idV3Sd, v3dvar, & + & LBi, UBi, LBj, UBj, 1, N(ng), & + & scale, OCEAN(ng) % v_stokes, & + & NposR, XposR, YposR, ZposR, rsta) + CALL pio_netcdf_put_fvar (ng, model, S(ng)%name, & + & TRIM(Vname(1,idV3Sd)), rsta, & + & (/1,1,S(ng)%Rindex/), & + & (/N(ng),Nstation(ng),1/), & + & pioFile = S(ng)%pioFile, & + & pioVar = S(ng)%pioVar(idV3Sd)%vd) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN + END IF +! +! Write out 3D Stokes omega-velocity. +! + IF (VarOut(idW3Sd,ng)) THEN + scale=1.0_dp + CALL extract_sta3d (ng, model, Cgrid, idW3Sd, w3dvar, & + & LBi, UBi, LBj, UBj, 0, N(ng), & + & scale, OCEAN(ng) % W_stokes, & + & NposR, XposR, YposR, ZposR, rsta) + CALL pio_netcdf_put_fvar (ng, model, S(ng)%name, & + & TRIM(Vname(1,idW3Sd)), rsta, & + & (/1,1,S(ng)%Rindex/), & + & (/N(ng),Nstation(ng),1/), & + & pioFile = S(ng)%pioFile, & + & pioVar = S(ng)%pioVar(idW3Sd)%vd) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN + END IF +! +! Write out 3D "true" Stokes W-velocity. +! + IF (VarOut(idW3St,ng)) THEN + scale=1.0_dp + CALL extract_sta3d (ng, model, Cgrid, idW3St, w3dvar, & + & LBi, UBi, LBj, UBj, 0, N(ng), & + & scale, OCEAN(ng) % wstvel, & + & NposR, XposR, YposR, ZposR, rsta) + CALL pio_netcdf_put_fvar (ng, model, S(ng)%name, & + & TRIM(Vname(1,idW3St)), rsta, & + & (/1,1,S(ng)%Rindex/), & + & (/N(ng),Nstation(ng),1/), & + & pioFile = S(ng)%pioFile, & + & pioVar = S(ng)%pioVar(idW3St)%vd) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN + END IF +! +! Write out 3D total Waves Effect on Currents U-stress. +! + IF (VarOut(idU3rs,ng)) THEN + scale=rho0 + CALL extract_sta3d (ng, model, Cgrid, idU3rs, u3dvar, & + & LBi, UBi, LBj, UBj, 1, N(ng), & + & scale, MIXING(ng) % rustr3d, & + & NposR, XposR, YposR, ZposR, rsta) + CALL pio_netcdf_put_fvar (ng, model, S(ng)%name, & + & TRIM(Vname(1,idU3rs)), rsta, & + & (/1,1,S(ng)%Rindex/), & + & (/N(ng),Nstation(ng),1/), & + & pioFile = S(ng)%pioFile, & + & pioVar = S(ng)%pioVar(idU3rs)%vd) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN + END IF +! +! Write out 3D total Waves Effect on Current V-stress. +! + IF (VarOut(idV3rs,ng)) THEN + scale=rho0 + CALL extract_sta3d (ng, model, Cgrid, idV3rs, v3dvar, & + & LBi, UBi, LBj, UBj, 1, N(ng), & + & scale, MIXING(ng) % rvstr3d, & + & NposR, XposR, YposR, ZposR, rsta) + CALL pio_netcdf_put_fvar (ng, model, S(ng)%name, & + & TRIM(Vname(1,idV3rs)), rsta, & + & (/1,1,S(ng)%Rindex/), & + & (/N(ng),Nstation(ng),1/), & + & pioFile = S(ng)%pioFile, & + & pioVar = S(ng)%pioVar(idV3rs)%vd) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN + END IF +# endif +# endif +# ifdef WEC_VF +! +! Write out Waves Effect on Currents quasi-static sea level adjustment. +! + IF (VarOut(idWztw,ng)) THEN + scale=1.0_dp + CALL extract_sta2d (ng, model, Cgrid, idWztw, r2dvar, & + & LBi, UBi, LBj, UBj, & + & scale, OCEAN(ng) % zeta(:,:,KOUT), & + & Nstation(ng), Xpos, Ypos, psta) + CALL pio_netcdf_put_fvar (ng, model, S(ng)%name, & + & TRIM(Vname(1,idWztw)), psta, & + & (/1,S(ng)%Rindex/), & + & (/Nstation(ng),1/), & + & pioFile = S(ng)%pioFile, & + & pioVar = S(ng)%pioVar(idWztw)%vd) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN + END IF +! +! Write out Waves Effect on Currents quasi-static pressure. +! + IF (VarOut(idWqsp,ng)) THEN + scale=1.0_dp + CALL extract_sta2d (ng, model, Cgrid, idWqsp, r2dvar, & + & LBi, UBi, LBj, UBj, & + & scale, OCEAN(ng) % qsp, & + & Nstation(ng), Xpos, Ypos, psta) + CALL pio_netcdf_put_fvar (ng, model, S(ng)%name, & + & TRIM(Vname(1,idWqsp)), psta, & + & (/1,S(ng)%Rindex/), & + & (/Nstation(ng),1/), & + & pioFile = S(ng)%pioFile, & + & pioVar = S(ng)%pioVar(idWqsp)%vd) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN + END IF +! +! Write out Waves Effect on Currents Bernoulli head. +! + IF (VarOut(idWbeh,ng)) THEN + scale=1.0_dp + CALL extract_sta2d (ng, model, Cgrid, idWbeh, r2dvar, & + & LBi, UBi, LBj, UBj, & + & scale, OCEAN(ng) % bh, & + & Nstation(ng), Xpos, Ypos, psta) + CALL pio_netcdf_put_fvar (ng, model, S(ng)%name, & + & TRIM(Vname(1,idWbeh)), psta, & + & (/1,S(ng)%Rindex/), & + & (/Nstation(ng),1/), & + & pioFile = S(ng)%pioFile, & + & pioVar = S(ng)%pioVar(idWbeh)%vd) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN + END IF +# endif +# if (defined BOTTOM_STREAMING && defined WEC_VF) || \ + defined WAV_COUPLING +! +! Write out wave dissipation due to bottom friction. +! + IF (VarOut(idWdif,ng)) THEN + scale=1.0_dp + CALL extract_sta2d (ng, model, Cgrid, idWdif, r2dvar, & + & LBi, UBi, LBj, UBj, & + & scale, FORCES(ng) % Dissip_fric, & + & Nstation(ng), Xpos, Ypos, psta) + CALL pio_netcdf_put_fvar (ng, model, S(ng)%name, & + & TRIM(Vname(1,idWdif)), psta, & + & (/1,S(ng)%Rindex/), & + & (/Nstation(ng),1/), & + & pioFile = S(ng)%pioFile, & + & pioVar = S(ng)%pioVar(idWdif)%vd) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN + END IF +# endif +# if defined TKE_WAVEDISS || defined WAV_COUPLING || \ + defined WDISS_THORGUZA || defined WDISS_CHURTHOR || \ + defined WAVES_DISS || defined WDISS_INWAVE +! +! Write out wave dissipation due to breaking. +! + IF (VarOut(idWdib,ng)) THEN + scale=1.0_dp + CALL extract_sta2d (ng, model, Cgrid, idWdib, r2dvar, & + & LBi, UBi, LBj, UBj, & + & scale, FORCES(ng) % Dissip_break, & + & Nstation(ng), Xpos, Ypos, psta) + CALL pio_netcdf_put_fvar (ng, model, S(ng)%name, & + & TRIM(Vname(1,idWdib)), psta, & + & (/1,S(ng)%Rindex/), & + & (/Nstation(ng),1/), & + & pioFile = S(ng)%pioFile, & + & pioVar = S(ng)%pioVar(idWdib)%vd) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN + END IF +! +! Write out wave dissipation due to whitecapping. +! + IF (VarOut(idWdiw,ng)) THEN + scale=1.0_dp + CALL extract_sta2d (ng, model, Cgrid, idWdiw, r2dvar, & + & LBi, UBi, LBj, UBj, & + & scale, FORCES(ng) % Dissip_wcap, & + & Nstation(ng), Xpos, Ypos, psta) + CALL pio_netcdf_put_fvar (ng, model, S(ng)%name, & + & TRIM(Vname(1,idWdiw)), psta, & + & (/1,S(ng)%Rindex/), & + & (/Nstation(ng),1/), & + & pioFile = S(ng)%pioFile, & + & pioVar = S(ng)%pioVar(idWdiw)%vd) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN + END IF +# endif +# ifdef ROLLER_SVENDSEN +! +! Write out percent wave breaking. +! + IF (VarOut(idWbrk,ng)) THEN + scale=1.0_dp + CALL extract_sta2d (ng, model, Cgrid, idWbrk, r2dvar, & + & LBi, UBi, LBj, UBj, & + & scale, FORCES(ng) % Wave_break, & + & Nstation(ng), Xpos, Ypos, psta) + CALL pio_netcdf_put_fvar (ng, model, S(ng)%name, & + & TRIM(Vname(1,idWbrk)), psta, & + & (/1,S(ng)%Rindex/), & + & (/Nstation(ng),1/), & + & pioFile = S(ng)%pioFile, & + & pioVar = S(ng)%pioVar(idWbrk)%vd) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN + END IF +# endif +# ifdef WEC_ROLLER +! +! Write out wave roller dissipation. +! + IF (VarOut(idWdis,ng)) THEN + scale=1.0_dp + CALL extract_sta2d (ng, model, Cgrid, idWdis, r2dvar, & + & LBi, UBi, LBj, UBj, & + & scale, FORCES(ng) % Dissip_roller, & + & Nstation(ng), Xpos, Ypos, psta) + CALL pio_netcdf_put_fvar (ng, model, S(ng)%name, & + & TRIM(Vname(1,idWdis)), psta, & + & (/1,S(ng)%Rindex/), & + & (/Nstation(ng),1/), & + & pioFile = S(ng)%pioFile, & + & pioVar = S(ng)%pioVar(idWdis)%vd) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN + END IF +# endif +# ifdef ROLLER_RENIERS +! +! Write out wave roller action density. +! + IF (VarOut(idWrol,ng)) THEN + scale=1.0_dp + CALL extract_sta2d (ng, model, Cgrid, idWrol, r2dvar, & + & LBi, UBi, LBj, UBj, & + & scale, FORCES(ng) % rollA, & + & Nstation(ng), Xpos, Ypos, psta) + CALL pio_netcdf_put_fvar (ng, model, S(ng)%name, & + & TRIM(Vname(1,idWrol)), psta, & + & (/1,S(ng)%Rindex/), & + & (/Nstation(ng),1/), & + & pioFile = S(ng)%pioFile, & + & pioVar = S(ng)%pioVar(idWrol)%vd) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN + END IF +# endif +! + RETURN + END SUBROUTINE wec_wrt_station_pio +# endif +# endif +#endif +! + END MODULE wec_output_mod diff --git a/ROMS/Nonlinear/WEC/wec_roller.F b/ROMS/Nonlinear/WEC/wec_roller.F new file mode 100644 index 00000000..c6f87a6b --- /dev/null +++ b/ROMS/Nonlinear/WEC/wec_roller.F @@ -0,0 +1,334 @@ +#include "cppdefs.h" + MODULE wec_roller_mod +#if defined SOLVE3D && defined WEC_ROLLER +! +!git $Id$ +!======================================================================= +! Copyright (c) 2002-2024 The ROMS/TOMS Group ! +! Licensed under a MIT/X style license Hernan G. Arango ! +! See License_ROMS.md Nirnimesh Kumar ! +!================================================== John C. Warner ====! +! ! +! This routine computes dissipation modification/transfer due to wave ! +! rollers. ! +! ! +! References: ! +! ! +! Svendsen, I.A., 1984. Mass flux and undertow in a surf zone. ! +! Coastal Engineering 8, pp. 347-365. ! +! ! +! Reniers, A.J.M.H., Roelvink, J.A., and Thornton, E.B., 2004. ! +! Morphodynamic modeling of an embayed beach under wave group forcing.! +! J. Geophys. Res., 109: C01030, doi:10.1029/2002JC001586. ! +! ! +!======================================================================= +! + USE mod_param +# if defined DIAGNOSTICS_UV + USE mod_diags +# endif + USE mod_forces + USE mod_grid + USE mod_ocean + USE mod_scalars + USE mod_stepping +! + USE bc_2d_mod, ONLY : bc_r2d_tile +# ifdef DISTRIBUTE + USE mp_exchange_mod, ONLY : mp_exchange2d +# endif +! + implicit none +! + PRIVATE + PUBLIC :: wec_roller +! + CONTAINS +! +!*********************************************************************** + SUBROUTINE wec_roller (ng, tile) +!*********************************************************************** +! + integer, intent(in) :: ng, tile +! +! Local variable declarations. +! + character (len=*), parameter :: MyFile = & + & __FILE__ +! +# include "tile.h" +! +# ifdef PROFILE + CALL wclock_on (ng, iNLM, 42, __LINE__, MyFile) +# endif + CALL wec_roller_tile (ng, tile, LBi, UBi, LBj, UBj, N(ng), & + & IminS, ImaxS, JminS, JmaxS, & + & nrhs(ng), & + & GRID(ng) % angler, & + & GRID(ng) % h, & + & GRID(ng) % Hz, & +# ifdef ROLLER_RENIERS + & GRID(ng) % on_u, & + & GRID(ng) % om_v, & + & GRID(ng) % pm, & + & GRID(ng) % pn, & +# endif + & OCEAN(ng) % ubar, & + & OCEAN(ng) % vbar, & + & OCEAN(ng) % zeta, & + & FORCES(ng) % Hwave, & + & FORCES(ng) % Dwave, & + & FORCES(ng) % Lwave, & + & FORCES(ng) % Dissip_break, & +# if defined ROLLER_SVENDSEN || ROLLER_MONO + & FORCES(ng) % Wave_break, & +# endif + & FORCES(ng) % Dissip_roller, & + & FORCES(ng) % rollA) +# ifdef PROFILE + CALL wclock_off (ng, iNLM, 42, __LINE__, MyFile) +# endif +! + RETURN + END SUBROUTINE wec_roller +! +!*********************************************************************** + SUBROUTINE wec_roller_tile (ng, tile, LBi, UBi, LBj, UBj, UBk, & + & IminS, ImaxS, JminS, JmaxS, & + & nrhs, & + & angler, h, Hz, & +# ifdef ROLLER_RENIERS + & on_u, om_v, pm, pn, & +# endif + & ubar, vbar, zeta, & + & Hwave, Dwave, Lwave, & + & Dissip_break, & +# if defined ROLLER_SVENDSEN || ROLLER_MONO + & Wave_break, & +# endif + & Dissip_roller, & + & rollA) +!*********************************************************************** +! +! Imported variable declarations. +! + integer, intent(in) :: ng, tile + integer, intent(in) :: LBi, UBi, LBj, UBj, UBk + integer, intent(in) :: IminS, ImaxS, JminS, JmaxS + integer, intent(in) :: nrhs +# ifdef ASSUMED_SHAPE + real(r8), intent(in) :: angler(LBi:,LBj:) + real(r8), intent(in) :: h(LBi:,LBj:) + real(r8), intent(in) :: Hz(LBi:,LBj:,:) +# ifdef ROLLER_RENIERS + real(r8), intent(in) :: on_u(LBi:,LBj:) + real(r8), intent(in) :: om_v(LBi:,LBj:) + real(r8), intent(in) :: pm(LBi:,LBj:) + real(r8), intent(in) :: pn(LBi:,LBj:) +# endif + real(r8), intent(in) :: ubar(LBi:,LBj:,:) + real(r8), intent(in) :: vbar(LBi:,LBj:,:) + real(r8), intent(in) :: zeta(LBi:,LBj:,:) + real(r8), intent(in) :: Hwave(LBi:,LBj:) + real(r8), intent(in) :: Dwave(LBi:,LBj:) + real(r8), intent(in) :: Lwave(LBi:,LBj:) + real(r8), intent(in) :: Dissip_break(LBi:,LBj:) +# if defined ROLLER_SVENDSEN || ROLLER_MONO + real(r8), intent(in) :: Wave_break(LBi:,LBj:) +# endif + real(r8), intent(inout) :: Dissip_roller(LBi:,LBj:) + real(r8), intent(inout) :: rollA(LBi:,LBj:) +# else + real(r8), intent(in) :: angler(LBi:UBi,LBj:UBj) + real(r8), intent(in) :: h(LBi:UBi,LBj:UBj) + real(r8), intent(in) :: Hz(LBi:UBi,LBj:UBj,UBk) +# ifdef ROLLER_RENIERS + real(r8), intent(in) :: on_u(LBi:UBi,LBj:UBj) + real(r8), intent(in) :: om_v(LBi:UBi,LBj:UBj) + real(r8), intent(in) :: pm(LBi:UBi,LBj:UBj) + real(r8), intent(in) :: pn(LBi:UBi,LBj:UBj) +# endif + real(r8), intent(in) :: ubar(LBi:UBi,LBj:UBj,3) + real(r8), intent(in) :: vbar(LBi:UBi,LBj:UBj,3) + real(r8), intent(in) :: zeta(LBi:UBi,LBj:UBj,3) + real(r8), intent(in) :: Hwave(LBi:UBi,LBj:UBj) + real(r8), intent(in) :: Dwave(LBi:UBi,LBj:UBj) + real(r8), intent(in) :: Lwave(LBi:UBi,LBj:UBj) + real(r8), intent(in) :: Dissip_break(LBi:UBi,LBj:UBj) +# if defined ROLLER_SVENDSEN || ROLLER_MONO + real(r8), intent(in) :: Wave_break(LBi:UBi,LBj:UBj) +# endif + real(r8), intent(inout) :: Dissip_roller(LBi:UBi,LBj:UBj) + real(r8), intent(inout) :: rollA(LBi:UBi,LBj:UBj) +# endif +! +! Local variable declarations. +! + integer :: i, j, k, numits, it + real(r8) :: cff, cff1, cff2, cff3 + real(r8), parameter :: sinb=0.1_r8 + real(r8), parameter :: eps = 1.0E-14_r8 + real(r8), parameter :: kDmax = 5.0_r8 + real(r8), parameter :: Lwave_min = 1.0_r8 + real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: Dstp + real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: kD + real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: wavec + real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: waven + real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: owaven + real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: wavenx + real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: waveny + real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: sigma + real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: osigma + real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: gamr + real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: FX + real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: FE + +# include "set_bounds.h" +! +!----------------------------------------------------------------------- +! Compute dissipation modification/transfer due to wave rollers. +!----------------------------------------------------------------------- +! + DO j=Jstr,Jend+1 + DO i=Istr,Iend+1 +! +! Compute total depth. +! + Dstp(i,j)=zeta(i,j,1)+h(i,j) +! +! Compute wave amplitude (0.5*Hrms), wave number, intrinsic frequency. +! + waven(i,j)=2.0_r8*pi/MAX(Lwave(i,j),Lwave_min) + owaven(i,j)=1.0_r8/waven(i,j) + cff=1.5_r8*pi-Dwave(i,j)-angler(i,j) + wavenx(i,j)=waven(i,j)*COS(cff) + waveny(i,j)=waven(i,j)*SIN(cff) + sigma(i,j)=SQRT(MAX(g*waven(i,j)*TANH(waven(i,j)*Dstp(i,j)), & + & eps)) + osigma(i,j)=1.0_r8/sigma(i,j) +! +! Compute wave celerity and nonlinear water depth. +! + kD(i,j)=MIN(waven(i,j)*Dstp(i,j)+eps,kDmax) + wavec(i,j)=SQRT(MAX(g*owaven(i,j)*TANH(kD(i,j)),eps)) + END DO + END DO + +# if defined ROLLER_SVENDSEN +! +! Check if the calculation of Dissip Roller is consistent. +! + DO j=Jstr,Jend + DO i=Istr,Iend + cff1=0.0424_r8*Hwave(i,j)*Wave_break(i,j) + rollA(i,j)=cff1*wavec(i,j)*wavec(i,j)*osigma(i,j) + Dissip_roller(i,j)=g*sinb*rollA(i,j)*sigma(i,j)/wavec(i,j) + END DO + END DO + +# elif defined ROLLER_MONO +! +! Check if the calculation of Dissip Roller is consistent. +! Here Wave_break is really Breaking Area. +! + DO j=Jstr,Jend + DO i=Istr,Iend + cff1=Wave_break(i,j)/MAX(Lwave(i,j),Lwave_min) + rollA(i,j)=cff1*wavec(i,j)*wavec(i,j)*osigma(i,j) + Dissip_roller(i,j)=g*sinb*rollA(i,j)*sigma(i,j)/wavec(i,j) + END DO + END DO + +# elif defined ROLLER_RENIERS +! +! Solve roller evolution equation for rollA. +! +! numits=30 + numits=1 +! + DO it=1,numits +! +! Compute roller breaking source term (Eqn 40) and +! roller disspation sink term (Eqn 41). +! + DO j=Jstr,Jend + DO i=Istr,Iend+1 + cff3=(ubar(i,j,nrhs)+wavenx(i,j)*owaven(i,j)* & + & wavec(i,j))*on_u(i,j) + cff1=MAX(cff3,0.0_r8) + cff2=MIN(cff3,0.0_r8) + FX(i,j)=cff1*rollA(i-1,j)+cff2*rollA(i,j) + END DO + END DO + DO j=Jstr,Jend+1 + DO i=Istr,Iend + cff3=(vbar(i,j,nrhs)+waveny(i,j)*owaven(i,j)* & + & wavec(i,j))*om_v(i,j) + cff1=MAX(cff3,0.0_r8) + cff2=MIN(cff3,0.0_r8) + FE(i,j)=cff1*rollA(i,j-1)+cff2*rollA(i,j) + END DO + END DO + DO j=Jstr,Jend + DO i=Istr,Iend + cff=dt(ng)*pm(i,j)*pn(i,j)/REAL(numits,r8) + cff1=cff*(FX(i+1,j)-FX(i,j)+FE(i,j+1)-FE(i,j)) + rollA(i,j)=rollA(i,j)-cff1 + END DO + END DO +! + DO j=Jstr,Jend + DO i=Istr,Iend + Dissip_roller(i,j)=g*sinb*rollA(i,j)*sigma(i,j)/wavec(i,j) + END DO + END DO +! +! Add roller source / sink term. +! + DO j=Jstr,Jend + DO i=Istr,Iend + cff=dt(ng)/REAL(numits,r8) + rollA(i,j)=rollA(i,j)+cff*osigma(i,j)* & + & (wec_alpha(ng)*Dissip_break(i,j)- & + & Dissip_roller(i,j)) + END DO + END DO +# endif +! +! Exchange lateral boundary data. +! + CALL bc_r2d_tile (ng, tile, & + & LBi, UBi, LBj, UBj, & + & rollA) + +# ifdef DISTRIBUTE +! + CALL mp_exchange2d (ng, tile, iNLM, 1, & + & LBi, UBi, LBj, UBj, & + & NghostPoints, & + & EWperiodic(ng), NSperiodic(ng), & + & rollA) +# endif +# if defined ROLLER_RENIERS + END DO +# endif +! +! Apply roller dissipationboundary conditions. +! + CALL bc_r2d_tile (ng, tile, & + & LBi, UBi, LBj, UBj, & + & Dissip_roller) + +# ifdef DISTRIBUTE +! + CALL mp_exchange2d (ng, tile, iNLM, 1, & + & LBi, UBi, LBj, UBj, & + & NghostPoints, & + & EWperiodic(ng), NSperiodic(ng), & + & Dissip_roller) +# endif +! + RETURN + END SUBROUTINE wec_roller_tile +#endif + END MODULE wec_roller_mod diff --git a/ROMS/Nonlinear/WEC/wec_stokes.F b/ROMS/Nonlinear/WEC/wec_stokes.F new file mode 100644 index 00000000..acfdadbb --- /dev/null +++ b/ROMS/Nonlinear/WEC/wec_stokes.F @@ -0,0 +1,764 @@ +#include "cppdefs.h" + MODULE wec_stokes_mod +#if defined SOLVE3D && defined WEC +! +!git $Id$ +!======================================================================= +! Copyright (c) 2002-2024 The ROMS/TOMS Group ! +! Licensed under a MIT/X style license Hernan G. Arango ! +! See License_ROMS.md Nirnimesh Kumar ! +!================================================== John C. Warner ====! +! ! +! This routine computes the Stokes transport terms based on two ! +! methods: ! +! ! +! (1) Bulk formulation from: ! +! ! +! Kumar, N., Voulgaris, G., Warner, J.C., and M., Olabarrieta (2012). ! +! Implementation of a vortex force formalism in the coupled ! +! ocean-atmosphere-wave-sediment transport (COAWST) modeling system ! +! for inner-shelf and surf-zone applications. ! +! Ocean Modeling 47, pp 65-95. ! +! ! +! (2) Spectrum Stokes formulation from: ! +! ! +! Liu, G., Kumar, N., Harcourt, R., & Perrie, W. (2021). ! +! Bulk, spectral and deep water approximations for Stokes drift: ! +! Implications for coupled ocean circulation and surface wave models. ! +! Journal of Advances in Modeling Earth Systems, e2020MS002172. 13, ! +! https://doi.org/10.1029/2020MS002172 ! +! ! +!======================================================================= +! + USE mod_param +# if defined DIAGNOSTICS_UV + USE mod_diags +# endif + USE mod_forces + USE mod_grid +# if defined DOPPLER && defined INWAVE_MODEL + USE mod_inwave_vars +# endif + USE mod_ocean + USE mod_scalars +! + USE bc_3d_mod, ONLY : bc_w3d_tile + USE exchange_2d_mod, ONLY : exchange_u2d_tile, exchange_v2d_tile + USE exchange_3d_mod, ONLY : exchange_u3d_tile, exchange_v3d_tile +# ifdef DISTRIBUTE + USE mp_exchange_mod, ONLY : mp_exchange2d, mp_exchange3d +# endif + USE wec_u2dbc_mod, ONLY : wec_u2dbc_tile + USE wec_v2dbc_mod, ONLY : wec_v2dbc_tile +# ifdef SOLVE3D + USE wec_u3dbc_mod, ONLY : wec_u3dbc_tile + USE wec_v3dbc_mod, ONLY : wec_v3dbc_tile +# endif +! + implicit none +! + PRIVATE + PUBLIC :: wec_stokes +! + CONTAINS +! +!*********************************************************************** + SUBROUTINE wec_stokes (ng, tile) +!*********************************************************************** +! +! Imported variable declarations. +! + integer, intent(in) :: ng, tile +! +! Local variable declarations. +! + character (len=*), parameter :: MyFile = & + & __FILE__ +! +# include "tile.h" +! +# ifdef PROFILE + CALL wclock_on (ng, iNLM, 42, __LINE__, MyFile) +# endif + CALL wec_stokes_tile (ng, tile, LBi, UBi, LBj, UBj, N(ng), & + & IminS, ImaxS, JminS, JmaxS, & + & GRID(ng) % angler, & + & GRID(ng) % h, & +# ifdef MASKING + & GRID(ng) % rmask, & + & GRID(ng) % umask, & + & GRID(ng) % vmask, & +# endif +# ifdef WET_DRY + & GRID(ng) % umask_wet, & + & GRID(ng) % vmask_wet, & +# endif + & GRID(ng) % on_u, & + & GRID(ng) % on_v, & + & GRID(ng) % om_u, & + & GRID(ng) % om_v, & + & GRID(ng) % Hz, & + & GRID(ng) % z_r, & + & GRID(ng) % z_w, & +# ifdef BULK_STOKES + & FORCES(ng) % Hwave, & + & FORCES(ng) % Dwave, & + & FORCES(ng) % Lwave, & +# endif +# ifdef SPECTRUM_STOKES + & FORCES(ng) % spec_wn, & + & FORCES(ng) % spec_us, & + & FORCES(ng) % spec_vs, & +# endif +# if defined WEC_ROLLER + & FORCES(ng) % rollA, & +# endif +# if defined DOPPLER && defined INWAVE_MODEL + & WAVEP(ng) % u_rho, & + & WAVEP(ng) % v_rho, & +# endif + & OCEAN(ng) % zeta, & + & OCEAN(ng) % ubar_stokes, & + & OCEAN(ng) % vbar_stokes, & + & OCEAN(ng) % u_stokes, & + & OCEAN(ng) % v_stokes, & + & OCEAN(ng) % W_stokes) +# ifdef PROFILE + CALL wclock_off (ng, iNLM, 42, __LINE__, MyFile) +# endif +! + RETURN + END SUBROUTINE wec_stokes +! +!*********************************************************************** + SUBROUTINE wec_stokes_tile (ng, tile, LBi, UBi, LBj, UBj, UBk, & + & IminS, ImaxS, JminS, JmaxS, & + & angler, h, & +# ifdef MASKING + & rmask, umask, vmask, & +# endif +# ifdef WET_DRY + & umask_wet, vmask_wet, & +# endif + & on_u, on_v, om_u, om_v, & + & Hz, z_r, z_w, & +# ifdef BULK_STOKES + & Hwave, Dwave, Lwave, & +# endif +# ifdef SPECTRUM_STOKES + & spec_wn, spec_us, spec_vs, & +# endif +# if defined WEC_ROLLER + & rollA, & +# endif +# if defined DOPPLER && defined INWAVE_MODEL + & u_rho, v_rho, & +# endif + & zeta, & + & ubar_stokes, vbar_stokes, & + & u_stokes, v_stokes, W_stokes) +!*********************************************************************** +! +! Imported variable declarations. +! + integer, intent(in) :: ng, tile + integer, intent(in) :: LBi, UBi, LBj, UBj, UBk + integer, intent(in) :: IminS, ImaxS, JminS, JmaxS +# ifdef ASSUMED_SHAPE + real(r8), intent(in) :: h(LBi:,LBj:) + real(r8), intent(in) :: angler(LBi:,LBj:) +# ifdef MASKING + real(r8), intent(in) :: rmask(LBi:,LBj:) + real(r8), intent(in) :: umask(LBi:,LBj:) + real(r8), intent(in) :: vmask(LBi:,LBj:) +# endif +# ifdef WET_DRY + real(r8), intent(in) :: umask_wet(LBi:,LBj:) + real(r8), intent(in) :: vmask_wet(LBi:,LBj:) +# endif + real(r8), intent(in) :: on_u(LBi:,LBj:) + real(r8), intent(in) :: on_v(LBi:,LBj:) + real(r8), intent(in) :: om_u(LBi:,LBj:) + real(r8), intent(in) :: om_v(LBi:,LBj:) + real(r8), intent(in) :: Hz(LBi:,LBj:,:) + real(r8), intent(in) :: z_r(LBi:,LBj:,:) + real(r8), intent(in) :: z_w(LBi:,LBj:,0:) +# ifdef BULK_STOKES + real(r8), intent(in) :: Hwave(LBi:,LBj:) + real(r8), intent(in) :: Dwave(LBi:,LBj:) + real(r8), intent(in) :: Lwave(LBi:,LBj:) +# endif +# ifdef SPECTRUM_STOKES + real(r8), intent(in) :: spec_wn(LBi:,LBj:,:) + real(r8), intent(in) :: spec_us(LBi:,LBj:,:) + real(r8), intent(in) :: spec_vs(LBi:,LBj:,:) +# endif +# if defined WEC_ROLLER + real(r8), intent(in) :: rollA(LBi:,LBj:) +# endif +# if defined DOPPLER && defined INWAVE_MODEL + real(r8), intent(in) :: u_rho(LBi:,LBj:) + real(r8), intent(in) :: v_rho(LBi:,LBj:) +# endif + real(r8), intent(in) :: zeta(LBi:,LBj:,:) + real(r8), intent(inout) :: ubar_stokes(LBi:,LBj:) + real(r8), intent(inout) :: vbar_stokes(LBi:,LBj:) + real(r8), intent(inout) :: u_stokes(LBi:,LBj:,:) + real(r8), intent(inout) :: v_stokes(LBi:,LBj:,:) + real(r8), intent(inout) :: W_stokes(LBi:,LBj:,0:) +# else + real(r8), intent(in) :: angler(LBi:UBi,LBj:UBj) +# ifdef MASKING + real(r8), intent(in) :: rmask(LBi:UBi,LBj:UBj) + real(r8), intent(in) :: umask(LBi:UBi,LBj:UBj) + real(r8), intent(in) :: vmask(LBi:UBi,LBj:UBj) +# endif +# ifdef WET_DRY + real(r8), intent(in) :: umask_wet(LBi:UBi,LBj:UBj) + real(r8), intent(in) :: vmask_wet(LBi:UBi,LBj:UBj) +# endif + real(r8), intent(in) :: on_u(LBi:UBi,LBj:UBj) + real(r8), intent(in) :: on_v(LBi:UBi,LBj:UBj) + real(r8), intent(in) :: om_u(LBi:UBi,LBj:UBj) + real(r8), intent(in) :: om_v(LBi:UBi,LBj:UBj) + real(r8), intent(in) :: Hz(LBi:UBi,LBj:UBj,UBk) + real(r8), intent(in) :: z_r(LBi:UBi,LBj:UBj,UBk) + real(r8), intent(in) :: z_w(LBi:UBi,LBj:UBj,0:UBk) +# ifdef BULK_STOKES + real(r8), intent(in) :: Hwave(LBi:UBi,LBj:UBj) + real(r8), intent(in) :: Dwave(LBi:UBi,LBj:UBj) + real(r8), intent(in) :: Lwave(LBi:UBi,LBj:UBj) +# endif +# ifdef SPECTRUM_STOKES + real(r8), intent(in) :: spec_wn(LBi:UBi,LBj:UBj,MSCs) + real(r8), intent(in) :: spec_us(LBi:UBi,LBj:UBj,MSCs) + real(r8), intent(in) :: spec_vs(LBi:UBi,LBj:UBj,MSCs) +# endif +# if defined WEC_ROLLER + real(r8), intent(in) :: rollA(LBi:UBi,LBj:UBj) +# endif +# if defined DOPPLER && defined INWAVE_MODEL + real(r8), intent(in) :: u_rho(LBi:UBi,LBj:UBj) + real(r8), intent(in) :: v_rho(LBi:UBi,LBj:UBj) +# endif + real(r8), intent(in) :: zeta(LBi:UBi,LBj:UBj,3) + real(r8), intent(inout) :: ubar_stokes(LBi:UBi,LBj:UBj) + real(r8), intent(inout) :: vbar_stokes(LBi:UBi,LBj:UBj) + real(r8), intent(inout) :: u_stokes(LBi:UBi,LBj:UBj,N(ng)) + real(r8), intent(inout) :: v_stokes(LBi:UBi,LBj:UBj,N(ng)) + real(r8), intent(inout) :: W_stokes(LBi:UBi,LBj:UBj,0:N(ng)) +# endif +! +! Local variable declarations. +! + integer :: i, j, k + real(dp) :: cff, cff2, cff3, cff4, cff5, cff6, cff7, cff8 + real(r8) :: fac1, fac2, fac3, ofac3 +# if defined DOPPLER && defined INWAVE_MODEL + real(r8) :: wdl, theta_cur +# endif + real(r8), parameter :: eps = 1.0E-14_r8 + real(dp), parameter :: kDmax = 200.0_dp + real(r8), parameter :: kD2deep = 36.0_r8 + real(r8), parameter :: Lwave_min = 1.0_r8 + real(r8), dimension(IminS:ImaxS) :: wrk + real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: Dstp + real(dp), dimension(IminS:ImaxS,JminS:JmaxS) :: kD + real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: wavec + real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: waven + real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: owaven + real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: wavenx + real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: waveny + real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: waveE + real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: sigma + real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: Huons + real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: Hvoms +# if defined DOPPLER && defined INWAVE_MODEL + real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: u_dir +# endif +# ifdef SPECTRUM_STOKES + integer :: is + real(r8) :: facto1, facto2 + real(r8) :: sdrx, sdry +# endif + +# include "set_bounds.h" +! +!----------------------------------------------------------------------- +! Compute wave fields. +!----------------------------------------------------------------------- +! + fac1=1.0_r8/dt(ng) + fac2=1.0_r8/g + + DO j=Jstr-1,Jend+1 + DO i=Istr-1,Iend+1 +! +! Compute total depth +! + Dstp(i,j)=z_w(i,j,N(ng))-z_w(i,j,0) +! +! Compute wave amplitude (0.5*Hrms), wave number, intrinsic frequency. +! +# ifdef BULK_STOKES + waven(i,j)=2.0_r8*pi/MAX(Lwave(i,j),Lwave_min) + owaven(i,j)=1.0_r8/waven(i,j) + cff=1.5_r8*pi-Dwave(i,j)-angler(i,j) + wavenx(i,j)=waven(i,j)*COS(cff) + waveny(i,j)=waven(i,j)*SIN(cff) + sigma(i,j)=SQRT(MAX(g*waven(i,j)*TANH(waven(i,j)*Dstp(i,j)), & + & eps)) +# if defined DOPPLER && defined INWAVE_MODEL +! +! Wave direction. +! + wdl=(1.5_r8*pi-Dwave(i,j))-angler(i,j) + IF (u_rho(i,j).eq.0.0_r8) THEN + theta_cur=0.5_r8*pi*SIGN(1.0_r8,v_rho(i,j)) + ELSE + theta_cur=ATAN2(v_rho(i,j),u_rho(i,j)) + ENDIF + u_dir(i,j)=SQRT(u_rho(i,j)**2+v_rho(i,j)**2)* & + & COS(wdl-theta_cur) + sigma(i,j)=sigma(i,j)+u_dir(i,j)*waven(i,j) +# endif + waveE(i,j)=0.0625_r8*g*Hwave(i,j)*Hwave(i,j) +! +! Compute wave celerity and kD. +! + kD(i,j)=MIN(waven(i,j)*Dstp(i,j),kDmax) + wavec(i,j)=SQRT(MAX(g*owaven(i,j)*TANH(kD(i,j)),eps)) +# if defined DOPPLER && defined INWAVE_MODEL + wavec(i,j)=wavec(i,j)+u_dir(i,j) +# endif +# endif + END DO + END DO +! +!--------------------------------------------------------------------------- +! Stokes velocities. +!--------------------------------------------------------------------------- +! +! Compute u-stokes velocities +! +# ifdef BULK_STOKES + DO j=Jstr,Jend + DO i=IstrU,Iend + cff2=(waveE(i-1,j)+waveE(i,j)) +# if defined WEC_ROLLER + cff2=cff2+(rollA(i-1,j)*sigma(i-1,j)+ & + & rollA(i,j)*sigma(i,j)) +# endif + cff3=(kD(i-1,j)+kD(i,j)) +! cff3=(waven(i-1,j)+waven(i,j))*(Dstp(i-1,j)+Dstp(i,j)) + cff4=wavenx(i-1,j)+wavenx(i,j) + cff5=wavec(i-1,j)+wavec(i,j) + fac3=Dstp(i-1,j)+Dstp(i,j) + ofac3=1.0_r8/fac3 + + DO k=1,N(ng) + cff6=-1.0_r8+((z_w(i-1,j,k)+z_w(i,j,k))- & + & (z_w(i-1,j,0)+z_w(i,j,0)))*ofac3 + cff7=-1.0_r8+((z_w(i-1,j,k-1)+z_w(i,j,k-1))- & + & (z_w(i-1,j,0)+z_w(i,j,0)))*ofac3 +! + u_stokes(i,j,k)=0.25_r8*cff2*cff4*cff5*fac2/ & + & (fac3*(cff6-cff7))/ & + & (DSINH(0.5_r8*cff3)**2.0_r8)* & + & DSINH(0.5_r8*cff3*(cff6-cff7))* & + & DCOSH(0.5_r8*cff3*(cff6+cff7+2.0_r8)) +# ifdef MASKING + u_stokes(i,j,k)=u_stokes(i,j,k)*umask(i,j) +# endif +# ifdef WET_DRY + u_stokes(i,j,k)=u_stokes(i,j,k)*umask_wet(i,j) +# endif + END DO + END DO + END DO +# endif +# ifdef SPECTRUM_STOKES +! +! Overwrite kDmin for deep-shallow transition and reducing computational +! cost 1-tanh(kDmax) ~ 1e-16 is the point to switch to deep form because +! at that point Stokes at bottom is negligible. We use similar criterion +! to eliminate unneccessary EXP,COSH,SINH calls at depths where +! Stokes drift is negligible +! + DO j=Jstr,Jend + DO i=IstrU,Iend + fac3=Dstp(i-1,j)+Dstp(i,j) + ofac3=1.0_r8/fac3 +! + DO k=1,N(ng) + cff6=-1.0_r8+((z_w(i-1,j,k)+z_w(i,j,k))- & + & (z_w(i-1,j,0)+z_w(i,j,0)))*ofac3 + cff7=-1.0_r8+((z_w(i-1,j,k-1)+z_w(i,j,k-1))- & + & (z_w(i-1,j,0)+z_w(i,j,0)))*ofac3 +! +! Compute the Stokes drift using trapezoidal rule +! + sdrx=0.0_r8 +! +! Compute u_stokes at the i-1/2 values of cff6, cff7, cff3 +! using the formulation appropriate at that location for each wavenumber +! + is=1 +! +! Store -2k(z_w-Dstp) for elseif in cff2, not used for Energy with +! Spectral Stokes +! + cff3=0.5_r8*fac3*(spec_wn(i-1,j,is)+spec_wn(i,j,is)) + cff2=-0.5_r8*cff3*(cff6+cff7) +! +! Compute Stokes drift when significant: with -2k(z_w-Dstp)<36. We do not add +! an else statement below for cff2.ge.kD2deep as that would just add ~0 to sdrx. +! Exception is always compute at top grid layer k=N(ng), where layer-average +! may still be significant when central point Stokes is not. +! + DO WHILE ((is.lt.MSCs).and. & + & ((cff2.lt.kDmax).or.(k.eq.N(ng)))) + cff4 = 0.5_r8*cff3*(cff6-cff7) + cff5 = (2.0_r8*cff4*SINH(0.5_r8*cff3)**2.0_r8) +! + IF (cff3.lt.kD2deep) THEN +! +! Shallow water formulation when kD<18; cff3-cff2 < cff3 < 18, so +! cosh & sinh^2 will be within r8 precision. +! Also, since cff4=18. Use more accurate expression +! to handle cff2>>kD2deep when k=N(ng) & cff2-cff4=0 +! facto2=EXP(-cff2)*SINH(cff4)/cff4 + facto2=0.5_r8*(EXP(-cff2+cff4)-EXP(-cff2-cff4))/ & + & (cff4+eps) + END IF +! + sdrx=sdrx+0.5*(spec_us(i-1,j,is)+spec_us(i,j,is))*facto2 + is=is+1 +! + cff3=0.5_r8*fac3*(spec_wn(i-1,j,is)+spec_wn(i,j,is)) + cff2=-0.5_r8*cff3*(cff6+cff7) +! + END DO +! + IF (is.eq.MSCs) THEN +! +! Either this is top grid layer or dStokes(msc) still significant at +! this depth, so add tail contribution to profile. For now, this always +! uses deep water formulation from Harcourt & D'Asaro (2008), Appendix B, +! significance determined by same cff2=18. Use more accurate expression +! to handle cff2>>kD2deep when k=N(ng) +! + facto2=0.5_r8*(EXP(-cff2+cff4)- & + EXP(-cff2-cff4))/(cff4+eps) + END IF +! + sdry=sdry+0.5*(spec_vs(i,j-1,is)+spec_vs(i,j,is))*facto2 + is=is+1 + cff3 = 0.5_r8*fac3*(spec_wn(i,j-1,is)+spec_wn(i,j,is)) + cff2 = -0.5_r8*cff3*(cff6+cff7) + END DO +! + IF (is.eq.MSCs) THEN +! +! Either this is top grid layer or dStokes(msc) still significant at +! this depth, so add tail contribution to profile. For now, this always +! uses deep water formulation from Harcourt & D'Asaro (2008), Appendix B, +! significance determined by same cff2