diff --git a/LICENSE b/LICENSE index 8dada3edaf..3b43f8bbe7 100644 --- a/LICENSE +++ b/LICENSE @@ -186,7 +186,7 @@ same "printed page" as the copyright notice for easier identification within third-party archives. - Copyright {yyyy} {name of copyright owner} + Copyright 2025 NREL Licensed under the Apache License, Version 2.0 (the "License"); you may not use this file except in compliance with the License. diff --git a/docs/source/user/seastate/appendix.rst b/docs/source/user/seastate/appendix.rst index 27e93d3da1..1e4734306c 100644 --- a/docs/source/user/seastate/appendix.rst +++ b/docs/source/user/seastate/appendix.rst @@ -21,6 +21,9 @@ structure:: 10 NX – Number of nodes in half of the X-direction domain (-) [>=2] 10 NY – Number of nodes in half of the Y-direction domain (-) [>=2] 10 NZ – Number of nodes in the Z direction (-) [>=2] + 0 WvKinBlockMod - Wave kinematics volume-data mode {0: precompute full domain, 1: on-demand block partitioning} (switch) + "DEFAULT" WvKinBlockSize - Target edge length of an on-demand cube block (m) [used only when WvKinBlockMod=1; DEFAULT=100] + "DEFAULT" WvKinBlockFreeT - Free a block after this much simulation time without an access (s) [used only when WvKinBlockMod=1; <=0 disables freeing; DEFAULT=600] ---------------------- WAVES --------------------------------------------------- 2 WaveMod - Incident wave kinematics model {0: none=still water, 1: regular (periodic), 1P#: regular with user-specified phase, 2: JONSWAP/Pierson-Moskowitz spectrum (irregular), 3: White noise spectrum (irregular), 4: user-defined spectrum from routine UserWaveSpctrm (irregular), 5: Externally generated wave-elevation time series, 6: Externally generated full wave-kinematics time series [option 6 is invalid for PotMod/=0], 7: User-defined wave frequency components} (switch) 1 WaveStMod - Model for stretching incident wave kinematics to instantaneous free surface {0: none=no stretching, 1: vertical stretching, 2: extrapolation stretching, 3: Wheeler stretching} (switch) [unused when WaveMod=0 or when PotMod/=0] diff --git a/docs/source/user/seastate/input_files.rst b/docs/source/user/seastate/input_files.rst index d84ff00d8e..78ad79ae38 100644 --- a/docs/source/user/seastate/input_files.rst +++ b/docs/source/user/seastate/input_files.rst @@ -103,6 +103,109 @@ Currently, the SeaState wave grid is always centered at the global origin and sy **NZ** sets the number of grid points in the vertical *Z*-direction from *Z* = (\ **MSL2SWL** − **Z_Depth**\ ) to *Z* = **MSL2SWL**\ . The distribution of grid points in the *Z*-direction is not uniform. It instead follows a cosine distribution: *Z*\ [\ *n*\ ] = **Z_Depth**\ (cos(\ *n*\ ·d\ *θ*\ )–1), where *n* = 0,1,…,\ **NZ**\ -1 and d\ *θ* = *π*\ /(2(\ **NZ**\ -1)). This distribution places more grid points near the free surface. **NZ** must be greater than or equal to 2. +**WvKinBlockMod** selects whether the wave-kinematics volume-data grid is precomputed over its full domain (**WvKinBlockMod** = 0, the default/current behavior) or partitioned into on-demand cube blocks (**WvKinBlockMod** = 1). When on-demand block partitioning is enabled, the wave-kinematics grid is divided into blocks partitioned in *X*, *Y*, and *Z*; each block is computed and stored only once wave kinematics are first requested at a point inside it. This reduces initialization time and memory use for domains that are much larger than the region actually queried during the simulation. Results with **WvKinBlockMod** = 1 are identical to those with **WvKinBlockMod** = 0 to within solver precision. + +**WvKinBlockSize** sets (in m) the target edge length of an on-demand cube block, applied to all three of *X*, *Y*, and *Z*; it is used only when **WvKinBlockMod** = 1. The requested size is snapped to whole grid cells, with a minimum of 8 cells per side. Because the *Z* grid is cosine-distributed (non-uniform), the *Z* edge length is snapped using the mean *Z* spacing, so coarse-*Z* grids may remain a single *Z* block even at small **WvKinBlockSize**. A block size on the order of the platform footprint is recommended (DEFAULT = 100 m). See :ref:`sea-block-sizing` below for measured sizing guidance. + +**WvKinBlockFreeT** sets (in s) the amount of simulation time a block may go without being accessed before it is freed; it is used only when **WvKinBlockMod** = 1. A freed block is transparently recomputed if it is revisited later in the simulation. **WvKinBlockFreeT** should be set larger than the platform's slow-drift (surge) period to avoid repeatedly freeing and recomputing blocks that are still in active use. Setting **WvKinBlockFreeT** less than or equal to zero disables freeing, so all populated blocks remain resident in memory (DEFAULT = 600 s). + +.. _sea-block-sizing: + +Choosing WvKinBlockSize and WvKinBlockFreeT ++++++++++++++++++++++++++++++++++++++++++++ + +On-demand block partitioning (**WvKinBlockMod** = 1) pays off when the wave +grid is much larger than the region a structure actually visits during the +simulation: only the blocks touched by a query are ever computed and stored. +For a typical station-keeping floating platform the queried footprint is +established early and stays essentially static, so the memory saving comes +from the resident block **size**, not from freeing blocks over time. + +Two behaviors are worth understanding before tuning these inputs: + +- **Blocks carry a halo.** Each block stores three extra grid planes per side + to satisfy the 4-point interpolation stencil. Several small blocks + therefore duplicate more grid points than one large block covering the same + footprint, and can use *more* memory than the full-domain default. In a + measured MHK case, **WvKinBlockSize** = 50 m split the footprint across + three blocks and consumed ~17% *more* peak memory than **WvKinBlockMod** = 0, + whereas **WvKinBlockSize** = 100–200 m used a single block at parity with + the full domain. + +- **Eviction only helps a moving query.** **WvKinBlockFreeT** frees blocks + that have gone untouched; for a station-keeping platform whose footprint is + fixed, no block is ever idle and eviction never fires. In the sweeps below, + **WvKinBlockFreeT** = -1 (disabled) and 600 s produced effectively unchanged + peak memory (within ~1%); wall time varied by up to ~8%, consistent with + run-to-run measurement noise. Eviction matters only for large horizontal drift or prescribed + translation that carries the query across the grid over time — set + **WvKinBlockFreeT** larger than the slow-drift (surge) period so blocks + still in active use are not repeatedly freed and recomputed. + +Measured peak resident memory (single-turbine glue-code cases, ~600 s): + +.. list-table:: + :header-rows: 1 + :widths: 30 18 18 18 16 + + * - Configuration + - Peak mem + - Blocks + - Evictions + - vs. mode 0 + * - **WvKinBlockMod** = 0 (full domain) + - 1216 MB + - — + - — + - baseline + * - size 50 m + - 1165 MB + - 1 + - 0 + - −4% + * - size 100 m (default) + - 1157 MB + - 1 + - 0 + - −5% + * - size 200 m + - 1204 MB + - 1 + - 0 + - −1% + +(5MW OC4-Semi, moored; **WvKinBlockFreeT** had no measurable effect.) + +Practical guidance: + +- Start with the default **WvKinBlockSize** = 100 m. Increase it toward the + platform footprint plus expected drift; avoid values so small that the + footprint spans several blocks, which the halo makes counterproductive. +- The largest savings appear when the wave grid is deliberately oversized + relative to the structure (e.g. a fine grid sized for a rare large-drift + event). If your grid is already sized tightly to the footprint, expect + block partitioning to break even rather than save memory. +- Leave **WvKinBlockFreeT** at its default (600 s) for station-keeping + platforms; raise it above the surge period, or set it ≤ 0 to keep all + blocks resident, only when the query migrates across the grid. +- To reduce memory further, first shrink the grid itself (**WaveTMax**, + **WaveDT**, **NX**/**NY**) as described below — those act on the full + domain regardless of **WvKinBlockMod**. + +Visualizing the block partition +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +When ``WvKinBlockMod = 1`` and OpenFAST is run with ``WrVTK = 2``, a +``.SeaSt.WaveBlocks..vtk`` series is written alongside the other +VTK animation output: a rectilinear grid with one cell per block whose +``BlockLife`` cell scalar encodes the block state — ``-1`` never populated, +``0`` evicted, and values in ``(0, 1]`` for resident blocks (the normalized +time remaining before eviction, pinned at ``1`` when ``WvKinBlockFreeT <= 0``). +Load the series in ParaView with a fixed color range of ``[-1, 1]`` and the +"Surface With Edges" representation: the cell edges are the block boundaries. +The standalone SeaState driver writes the same series when the optional +trailing driver-file input ``WrBlockVTK`` is set to a positive step interval. + When setting up the wave grid, it is necessary to make sure the wave grid is large enough in all three directions, so that no part of the structure defined in HydroDyn moves out of the wave grid during the simulation. At the same time, the grid should also be fine enough to resolve the shortest wave of interest. OpenFAST precomputes and saves the wave-field velocity, acceleration, dynamic pressure, and wave elevation at the start of the simulation. Generating and maintaining the wave grid can be memory intensive for long simulations. Users should set the wave grid to be no larger or finer than necessary to reduce memory use. Reducing **WaveTMax** or increasing **WaveDT** (see WAVES section below) also reduces memory use. For long crested waves (no directional spreading) aligned with the *X*-direction (or *Y*-direction), **NY** (or **NX**) can be reduced to the minimum allowed value of 2 to save memory. diff --git a/modules/openfast-library/src/FAST_Subs.f90 b/modules/openfast-library/src/FAST_Subs.f90 index e78026054c..24a408e021 100644 --- a/modules/openfast-library/src/FAST_Subs.f90 +++ b/modules/openfast-library/src/FAST_Subs.f90 @@ -6239,6 +6239,7 @@ END SUBROUTINE WrVTK_BasicMeshes !! returning an error code. SUBROUTINE WrVTK_Surfaces(t_global, p_FAST, y_FAST, ED, SED, BD, AD, IfW, ExtInfw, SeaSt, HD, SD, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD, SlD) use FVW_IO, only: WrVTK_FVW + use SeaSt_WaveField, only: WaveField_WriteBlockVTK REAL(DbKi), INTENT(IN ) :: t_global !< Current global time TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code @@ -6274,6 +6275,12 @@ SUBROUTINE WrVTK_Surfaces(t_global, p_FAST, y_FAST, ED, SED, BD, AD, IfW, ExtInf ! Wave elevation if (allocated(p_FAST%VTK_Surface%WaveElevVisGrid)) call WrVTK_WaveElevVisGrid(t_global, p_FAST, y_FAST, SeaSt) + ! SeaState on-demand wave-kinematics block partition (no-op unless WvKinBlockMod=1) + if (associated(SeaSt%p%WaveField)) then + call WaveField_WriteBlockVTK( t_global, SeaSt%p%WaveField, p_FAST%VTK_OutFileRoot, & + y_FAST%VTK_count, p_FAST%VTK_tWidth, ErrStat2, ErrMsg2 ) + end if + if (allocated(ED%Input)) then do iRot = 1, p_FAST%NRotors ! Nacelle diff --git a/modules/seastate/src/SeaSt_WaveField.f90 b/modules/seastate/src/SeaSt_WaveField.f90 index a01e2bd89e..1b99f5a5ec 100644 --- a/modules/seastate/src/SeaSt_WaveField.f90 +++ b/modules/seastate/src/SeaSt_WaveField.f90 @@ -4,6 +4,10 @@ MODULE SeaSt_WaveField USE SeaSt_WaveField_Types USE IfW_FlowField, only: IfW_FlowField_GetVelAcc USE GridInterp_Types +USE Waves, ONLY: WaveKinKernel_ComputeColumns ! shared first-order per-column generation kernel (on-demand block population) +USE Waves2, ONLY: WaveKinKernel_AddSecondOrderColumns ! shared second-order per-column kernel (on-demand block population) +USE VTK, ONLY: VTK_Misc, vtk_misc_init, vtk_new_ascii_file, vtk_dataset_rectilinear, & + vtk_cell_data_init, vtk_cell_data_scalar, vtk_close_file ! block VTK export IMPLICIT NONE @@ -20,6 +24,8 @@ MODULE SeaSt_WaveField PUBLIC WaveField_GetWaveVelAcc_AD PUBLIC WaveField_GetMeanDynSurfCurr PUBLIC WaveField_GetDynP +PUBLIC WaveField_BlockStore_Init +PUBLIC WaveField_WriteBlockVTK CONTAINS @@ -184,12 +190,7 @@ SUBROUTINE WaveField_GetNodeWaveKin( WaveField, WaveField_m, Time, pos, forceNod nodeInWater = 1_IntKi ! Use location to obtain interpolated values of kinematics CALL WaveField_Interp_Setup4D( Time+WaveField%WaveTimeShift, pos, WaveField%GridDepth, WaveField%VolGridParams, WaveField_m, ErrStat2, ErrMsg2 ); if (Failed()) return; - FV(:) = GridInterp4DVec( WaveField%WaveVel, WaveField_m ) - FA(:) = GridInterp4DVec( WaveField%WaveAcc, WaveField_m ) - FDynP = GridInterp4D ( WaveField%WaveDynP, WaveField_m ) - IF ( ALLOCATED(WaveField%WaveAccMCF) ) THEN - FAMCF(:) = GridInterp4DVec( WaveField%WaveAccMCF, WaveField_m ) - END IF + CALL WaveField_InterpVol( WaveField, WaveField_m, Time, ErrStat2, ErrMsg2, FDynP=FDynP, FV=FV, FA=FA, FAMCF=FAMCF ); if (Failed()) return; ELSE ! Node is above the SWL nodeInWater = 0_IntKi FV(:) = 0.0_SiKi @@ -210,23 +211,13 @@ SUBROUTINE WaveField_GetNodeWaveKin( WaveField, WaveField_m, Time, pos, forceNod ! Use location to obtain interpolated values of kinematics CALL WaveField_Interp_Setup4D( Time+WaveField%WaveTimeShift, pos, WaveField%GridDepth, WaveField%VolGridParams, WaveField_m, ErrStat2, ErrMsg2 ); if (Failed()) return; - FV(:) = GridInterp4DVec( WaveField%WaveVel, WaveField_m ) - FA(:) = GridInterp4DVec( WaveField%WaveAcc, WaveField_m ) - FDynP = GridInterp4D ( WaveField%WaveDynP, WaveField_m ) - IF ( ALLOCATED(WaveField%WaveAccMCF) ) THEN - FAMCF(:) = GridInterp4DVec( WaveField%WaveAccMCF, WaveField_m ) - END IF + CALL WaveField_InterpVol( WaveField, WaveField_m, Time, ErrStat2, ErrMsg2, FDynP=FDynP, FV=FV, FA=FA, FAMCF=FAMCF ); if (Failed()) return; ELSE ! Node is above SWL - need wave stretching ! Vertical wave stretching CALL WaveField_Interp_Setup4D( Time+WaveField%WaveTimeShift, posXY0, WaveField%GridDepth, WaveField%VolGridParams, WaveField_m, ErrStat2, ErrMsg2 ); if (Failed()) return; - FV(:) = GridInterp4DVec( WaveField%WaveVel, WaveField_m ) - FA(:) = GridInterp4DVec( WaveField%WaveAcc, WaveField_m ) - FDynP = GridInterp4D ( WaveField%WaveDynP, WaveField_m ) - IF ( ALLOCATED(WaveField%WaveAccMCF) ) THEN - FAMCF(:) = GridInterp4DVec( WaveField%WaveAccMCF, WaveField_m ) - END IF + CALL WaveField_InterpVol( WaveField, WaveField_m, Time, ErrStat2, ErrMsg2, FDynP=FDynP, FV=FV, FA=FA, FAMCF=FAMCF ); if (Failed()) return; ! Extrapolated wave stretching IF (WaveField%WaveStMod == 2) THEN @@ -234,7 +225,7 @@ SUBROUTINE WaveField_GetNodeWaveKin( WaveField, WaveField_m, Time, pos, forceNod FV(:) = FV(:) + GridInterp3DVec( WaveField%PWaveVel0, WaveField_m ) * pos(3) FA(:) = FA(:) + GridInterp3DVec( WaveField%PWaveAcc0, WaveField_m ) * pos(3) FDynP = FDynP + GridInterp3D ( WaveField%PWaveDynP0, WaveField_m ) * pos(3) - IF ( ALLOCATED(WaveField%WaveAccMCF) ) THEN + IF ( WaveField_HasMCF(WaveField) ) THEN FAMCF(:) = FAMCF(:) + GridInterp3DVec( WaveField%PWaveAccMCF0, WaveField_m ) * pos(3) END IF END IF @@ -250,12 +241,7 @@ SUBROUTINE WaveField_GetNodeWaveKin( WaveField, WaveField_m, Time, pos, forceNod ! Obtain the wave-field variables by interpolation with the mapped position. CALL WaveField_Interp_Setup4D( Time+WaveField%WaveTimeShift, posPrime, WaveField%GridDepth, WaveField%VolGridParams, WaveField_m, ErrStat2, ErrMsg2 ); if (Failed()) return; - FV(:) = GridInterp4DVec( WaveField%WaveVel, WaveField_m ) - FA(:) = GridInterp4DVec( WaveField%WaveAcc, WaveField_m ) - FDynP = GridInterp4D ( WaveField%WaveDynP, WaveField_m ) - IF ( ALLOCATED(WaveField%WaveAccMCF) ) THEN - FAMCF(:) = GridInterp4DVec( WaveField%WaveAccMCF, WaveField_m ) - END IF + CALL WaveField_InterpVol( WaveField, WaveField_m, Time, ErrStat2, ErrMsg2, FDynP=FDynP, FV=FV, FA=FA, FAMCF=FAMCF ); if (Failed()) return; END IF ELSE ! Node is out of water - zero-out all wave dynamics @@ -338,7 +324,7 @@ SUBROUTINE WaveField_GetDynP( WaveField, WaveField_m, Time, pos, forceNodeInWate nodeInWater = 1_IntKi ! Use location to obtain interpolated values of kinematics CALL WaveField_Interp_Setup4D( Time+WaveField%WaveTimeShift, pos, WaveField%GridDepth, WaveField%VolGridParams, WaveField_m, ErrStat2, ErrMsg2 ); if (Failed()) return; - FDynP = GridInterp4D ( WaveField%WaveDynP, WaveField_m ) + CALL WaveField_InterpVol( WaveField, WaveField_m, Time, ErrStat2, ErrMsg2, FDynP=FDynP ); if (Failed()) return; ELSE ! Node is above the SWL nodeInWater = 0_IntKi FDynP = 0.0_SiKi @@ -352,12 +338,12 @@ SUBROUTINE WaveField_GetDynP( WaveField, WaveField_m, Time, pos, forceNodeInWate IF ( pos(3) <= 0.0_SiKi) THEN ! Node is below the SWL - evaluate wave dynamics as usual ! Use location to obtain interpolated values of kinematics CALL WaveField_Interp_Setup4D( Time+WaveField%WaveTimeShift, pos, WaveField%GridDepth, WaveField%VolGridParams, WaveField_m, ErrStat2, ErrMsg2 ); if (Failed()) return; - FDynP = GridInterp4D ( WaveField%WaveDynP, WaveField_m ) + CALL WaveField_InterpVol( WaveField, WaveField_m, Time, ErrStat2, ErrMsg2, FDynP=FDynP ); if (Failed()) return; ELSE ! Node is above SWL - need wave stretching ! Vertical wave stretching CALL WaveField_Interp_Setup4D( Time+WaveField%WaveTimeShift, posXY0, WaveField%GridDepth, WaveField%VolGridParams, WaveField_m, ErrStat2, ErrMsg2 ); if (Failed()) return; - FDynP = GridInterp4D ( WaveField%WaveDynP, WaveField_m ) + CALL WaveField_InterpVol( WaveField, WaveField_m, Time, ErrStat2, ErrMsg2, FDynP=FDynP ); if (Failed()) return; ! Extrapoled wave stretching IF (WaveField%WaveStMod == 2) THEN @@ -376,7 +362,7 @@ SUBROUTINE WaveField_GetDynP( WaveField, WaveField_m, Time, pos, forceNodeInWate ! Obtain the wave-field variables by interpolation with the mapped position. CALL WaveField_Interp_Setup4D( Time+WaveField%WaveTimeShift, posPrime, WaveField%GridDepth, WaveField%VolGridParams, WaveField_m, ErrStat2, ErrMsg2 ); if (Failed()) return; - FDynP = GridInterp4D ( WaveField%WaveDynP, WaveField_m ) + CALL WaveField_InterpVol( WaveField, WaveField_m, Time, ErrStat2, ErrMsg2, FDynP=FDynP ); if (Failed()) return; END IF ELSE ! Node is out of water - zero-out all wave dynamics @@ -437,7 +423,7 @@ SUBROUTINE WaveField_GetNodeWaveVel( WaveField, WaveField_m, Time, pos, forceNod nodeInWater = 1_IntKi ! Use location to obtain interpolated values of kinematics CALL WaveField_Interp_Setup4D( Time+WaveField%WaveTimeShift, pos, WaveField%GridDepth, WaveField%VolGridParams, WaveField_m, ErrStat2, ErrMsg2 ); if (Failed()) return; - FV(:) = GridInterp4DVec( WaveField%WaveVel, WaveField_m ) + CALL WaveField_InterpVol( WaveField, WaveField_m, Time, ErrStat2, ErrMsg2, FV=FV ); if (Failed()) return; ELSE ! Node is above the SWL nodeInWater = 0_IntKi FV(:) = 0.0_SiKi @@ -455,13 +441,13 @@ SUBROUTINE WaveField_GetNodeWaveVel( WaveField, WaveField_m, Time, pos, forceNod ! Use location to obtain interpolated values of kinematics CALL WaveField_Interp_Setup4D( Time+WaveField%WaveTimeShift, pos, WaveField%GridDepth, WaveField%VolGridParams, WaveField_m, ErrStat2, ErrMsg2 ); if (Failed()) return; - FV(:) = GridInterp4DVec( WaveField%WaveVel, WaveField_m ) + CALL WaveField_InterpVol( WaveField, WaveField_m, Time, ErrStat2, ErrMsg2, FV=FV ); if (Failed()) return; ELSE ! Node is above SWL - need wave stretching ! Vertical wave stretching CALL WaveField_Interp_Setup4D( Time, posXY0, WaveField%GridDepth, WaveField%VolGridParams, WaveField_m, ErrStat2, ErrMsg2 ); if (Failed()) return; - FV(:) = GridInterp4DVec( WaveField%WaveVel, WaveField_m ) + CALL WaveField_InterpVol( WaveField, WaveField_m, Time, ErrStat2, ErrMsg2, FV=FV ); if (Failed()) return; ! Extrapolated wave stretching IF (WaveField%WaveStMod == 2) THEN @@ -480,7 +466,7 @@ SUBROUTINE WaveField_GetNodeWaveVel( WaveField, WaveField_m, Time, pos, forceNod ! Obtain the wave-field variables by interpolation with the mapped position. CALL WaveField_Interp_Setup4D( Time+WaveField%WaveTimeShift, posPrime, WaveField%GridDepth, WaveField%VolGridParams, WaveField_m, ErrStat2, ErrMsg2 ); if (Failed()) return; - FV(:) = GridInterp4DVec( WaveField%WaveVel, WaveField_m ) + CALL WaveField_InterpVol( WaveField, WaveField_m, Time, ErrStat2, ErrMsg2, FV=FV ); if (Failed()) return; END IF @@ -559,8 +545,7 @@ SUBROUTINE WaveField_GetNodeWaveVelAcc( WaveField, WaveField_m, Time, pos, force nodeInWater = 1_IntKi ! Use location to obtain interpolated values of kinematics CALL WaveField_Interp_Setup4D( Time+WaveField%WaveTimeShift, pos, WaveField%GridDepth, WaveField%VolGridParams, WaveField_m, ErrStat2, ErrMsg2 ); if (Failed()) return; - FV(:) = GridInterp4DVec( WaveField%WaveVel, WaveField_m ) - FA(:) = GridInterp4DVec( WaveField%WaveAcc, WaveField_m ) + CALL WaveField_InterpVol( WaveField, WaveField_m, Time, ErrStat2, ErrMsg2, FV=FV, FA=FA ); if (Failed()) return; ELSE ! Node is above the SWL nodeInWater = 0_IntKi FV(:) = 0.0_SiKi @@ -579,15 +564,13 @@ SUBROUTINE WaveField_GetNodeWaveVelAcc( WaveField, WaveField_m, Time, pos, force ! Use location to obtain interpolated values of kinematics CALL WaveField_Interp_Setup4D( Time+WaveField%WaveTimeShift, pos, WaveField%GridDepth, WaveField%VolGridParams, WaveField_m, ErrStat2, ErrMsg2 ); if (Failed()) return; - FV(:) = GridInterp4DVec( WaveField%WaveVel, WaveField_m ) - FA(:) = GridInterp4DVec( WaveField%WaveAcc, WaveField_m ) + CALL WaveField_InterpVol( WaveField, WaveField_m, Time, ErrStat2, ErrMsg2, FV=FV, FA=FA ); if (Failed()) return; ELSE ! Node is above SWL - need wave stretching ! Vertical wave stretching CALL WaveField_Interp_Setup4D( Time, posXY0, WaveField%GridDepth, WaveField%VolGridParams, WaveField_m, ErrStat2, ErrMsg2 ); if (Failed()) return; - FV(:) = GridInterp4DVec( WaveField%WaveVel, WaveField_m ) - FA(:) = GridInterp4DVec( WaveField%WaveAcc, WaveField_m ) + CALL WaveField_InterpVol( WaveField, WaveField_m, Time, ErrStat2, ErrMsg2, FV=FV, FA=FA ); if (Failed()) return; ! Extrapolated wave stretching IF (WaveField%WaveStMod == 2) THEN @@ -607,8 +590,7 @@ SUBROUTINE WaveField_GetNodeWaveVelAcc( WaveField, WaveField_m, Time, pos, force ! Obtain the wave-field variables by interpolation with the mapped position. CALL WaveField_Interp_Setup4D( Time+WaveField%WaveTimeShift, posPrime, WaveField%GridDepth, WaveField%VolGridParams, WaveField_m, ErrStat2, ErrMsg2 ); if (Failed()) return; - FV(:) = GridInterp4DVec( WaveField%WaveVel, WaveField_m ) - FA(:) = GridInterp4DVec( WaveField%WaveAcc, WaveField_m ) + CALL WaveField_InterpVol( WaveField, WaveField_m, Time, ErrStat2, ErrMsg2, FV=FV, FA=FA ); if (Failed()) return; END IF ELSE ! Node is out of water - zero-out all wave dynamics @@ -681,7 +663,7 @@ SUBROUTINE WaveField_GetWaveKin( WaveField, WaveField_m, Time, pos, forceNodeInW FDynP(i) = REAL(FDynP_node,ReKi) FV(:, i) = REAL(FV_node, ReKi) FA(:, i) = REAL(FA_node, ReKi) - IF (ALLOCATED(WaveField%WaveAccMCF)) THEN + IF ( WaveField_HasMCF(WaveField) ) THEN FAMCF(:,i) = REAL(FAMCF_node,ReKi) END IF END DO @@ -857,6 +839,462 @@ logical function FailedMsg(ErrMsg2) end function END SUBROUTINE WaveField_GetMeanDynSurfCurr +!---------------------------------------------------------------------------------------------------- +! On-demand wave-kinematics block partitioning (WvKinBlockMod=1) +!---------------------------------------------------------------------------------------------------- + +!> True when a MacCamy-Fuchs scaled acceleration field exists — either the eager full-domain array +!! (WvKinBlockMod=0) or per-block MCF data (WvKinBlockMod=1 with MCFD>0, where the full-domain array +!! is never allocated). +LOGICAL FUNCTION WaveField_HasMCF( WaveField ) + type(SeaSt_WaveFieldType), intent(in ) :: WaveField + WaveField_HasMCF = ALLOCATED(WaveField%WaveAccMCF) .OR. & + ( WaveField%WvKinBlockMod == 1_IntKi .AND. WaveField%MCFD > 0.0_SiKi ) +END FUNCTION WaveField_HasMCF + + +!> Set up the XY block layout of the wave-kinematics volume grid (WvKinBlockMod=1). Blocks partition the +!! grid CELLS; each block additionally stores the grid-point planes its interpolation stencils reach into +!! (the volume interpolation uses a 4-point stencil per dimension, base cell c touching points c-1..c+2), +!! so any query whose base cell lies in a block is served entirely from that block. No block data is +!! allocated here — population happens on first access. +SUBROUTINE WaveField_BlockStore_Init( WaveField, ErrStat, ErrMsg ) + type(SeaSt_WaveFieldType), intent(in ) :: WaveField ! block store reached through the pointer component (mutable) + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + + integer(IntKi) :: NX, NY, NZ, ib, jb, kb, k, c0, c1, iP0, iP1 + real(ReKi) :: mean_dz + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'WaveField_BlockStore_Init' + + ErrStat = ErrID_None + ErrMsg = "" + + IF ( .NOT. ASSOCIATED(WaveField%BlockStore) ) THEN + CALL SetErrStat( ErrID_Fatal, 'The wave-kinematics block store has not been wired up.', ErrStat, ErrMsg, RoutineName ) + RETURN + END IF + + ASSOCIATE ( Store => WaveField%BlockStore ) + + NX = WaveField%VolGridParams%n(2) + NY = WaveField%VolGridParams%n(3) + NZ = WaveField%VolGridParams%n(4) + + ! Target edge length snapped to whole grid cells, at least 8 cells (overlap economy), at most the whole grid + IF ( NX > 1_IntKi ) THEN + Store%BlkCellsX = MIN( MAX( 8_IntKi, NINT( WaveField%WvKinBlockSize / WaveField%VolGridParams%delta(2) ) ), NX-1_IntKi ) + Store%nBlkX = ( (NX-1_IntKi) + Store%BlkCellsX - 1_IntKi ) / Store%BlkCellsX + ELSE + Store%BlkCellsX = 1_IntKi + Store%nBlkX = 1_IntKi + END IF + IF ( NY > 1_IntKi ) THEN + Store%BlkCellsY = MIN( MAX( 8_IntKi, NINT( WaveField%WvKinBlockSize / WaveField%VolGridParams%delta(3) ) ), NY-1_IntKi ) + Store%nBlkY = ( (NY-1_IntKi) + Store%BlkCellsY - 1_IntKi ) / Store%BlkCellsY + ELSE + Store%BlkCellsY = 1_IntKi + Store%nBlkY = 1_IntKi + END IF + ! z: the grid is cosine-distributed (non-uniform), so snap using the mean spacing; this keeps + ! z blocks as cubes only in the mean-spacing sense (exact metre-cubes where spacing is uniform). + IF ( NZ > 1_IntKi ) THEN + mean_dz = ABS( Store%zGrid(SIZE(Store%zGrid)) - Store%zGrid(1) ) / REAL( MAX(1_IntKi,NZ-1_IntKi), ReKi ) + IF ( mean_dz > 0.0_ReKi ) THEN + Store%BlkCellsZ = MIN( MAX( 8_IntKi, NINT( WaveField%WvKinBlockSize / mean_dz ) ), NZ-1_IntKi ) + Store%nBlkZ = ( (NZ-1_IntKi) + Store%BlkCellsZ - 1_IntKi ) / Store%BlkCellsZ + ELSE + Store%BlkCellsZ = NZ-1_IntKi + Store%nBlkZ = 1_IntKi + END IF + ELSE + Store%BlkCellsZ = 1_IntKi + Store%nBlkZ = 1_IntKi + END IF + + ALLOCATE ( Store%Blocks( Store%nBlkX * Store%nBlkY * Store%nBlkZ ), STAT=ErrStat2 ) + IF ( ErrStat2 /= 0 ) THEN + CALL SetErrStat( ErrID_Fatal, 'Error allocating the wave-kinematics block array.', ErrStat, ErrMsg, RoutineName ) + RETURN + END IF + + DO kb = 1, Store%nBlkZ + DO jb = 1, Store%nBlkY + DO ib = 1, Store%nBlkX + k = ((kb-1)*Store%nBlkY + (jb-1))*Store%nBlkX + ib + ! x extent: cells [c0..c1] (0-based), stored points [c0-1 .. c1+2] clamped to the grid + IF ( NX > 1_IntKi ) THEN + c0 = (ib-1_IntKi)*Store%BlkCellsX + c1 = MIN( ib*Store%BlkCellsX - 1_IntKi, NX - 2_IntKi ) + iP0 = MAX( 0_IntKi, c0 - 1_IntKi ) + iP1 = MIN( NX - 1_IntKi, c1 + 2_IntKi ) + ELSE + iP0 = 0_IntKi + iP1 = 0_IntKi + END IF + Store%Blocks(k)%iPtX0 = iP0 + 1_IntKi ! stored 1-based + Store%Blocks(k)%nPtX = iP1 - iP0 + 1_IntKi + ! y extent + IF ( NY > 1_IntKi ) THEN + c0 = (jb-1_IntKi)*Store%BlkCellsY + c1 = MIN( jb*Store%BlkCellsY - 1_IntKi, NY - 2_IntKi ) + iP0 = MAX( 0_IntKi, c0 - 1_IntKi ) + iP1 = MIN( NY - 1_IntKi, c1 + 2_IntKi ) + ELSE + iP0 = 0_IntKi + iP1 = 0_IntKi + END IF + Store%Blocks(k)%iPtY0 = iP0 + 1_IntKi + Store%Blocks(k)%nPtY = iP1 - iP0 + 1_IntKi + ! z extent + IF ( NZ > 1_IntKi ) THEN + c0 = (kb-1_IntKi)*Store%BlkCellsZ + c1 = MIN( kb*Store%BlkCellsZ - 1_IntKi, NZ - 2_IntKi ) + iP0 = MAX( 0_IntKi, c0 - 1_IntKi ) + iP1 = MIN( NZ - 1_IntKi, c1 + 2_IntKi ) + ELSE + iP0 = 0_IntKi + iP1 = 0_IntKi + END IF + Store%Blocks(k)%iPtZ0 = iP0 + 1_IntKi + Store%Blocks(k)%nPtZ = iP1 - iP0 + 1_IntKi + END DO + END DO + END DO + + CALL WrScr ( ' SeaState wave-kinematics on-demand blocks: '//TRIM(Num2LStr(Store%nBlkX))//' x '// & + TRIM(Num2LStr(Store%nBlkY))//' x '//TRIM(Num2LStr(Store%nBlkZ))//' blocks of '// & + TRIM(Num2LStr(Store%BlkCellsX))//' x '//TRIM(Num2LStr(Store%BlkCellsY))//' x '// & + TRIM(Num2LStr(Store%BlkCellsZ))//' grid cells (+stencil overlap); populated on first access.' ) + + END ASSOCIATE + +END SUBROUTINE WaveField_BlockStore_Init + + +!> Locate the wave block containing the interpolation stencil last set up in WaveField_m, populate it on +!! first access (first- and, if enabled, second-order kinematics via the shared column kernels — the same +!! code path as the full-domain fill, so block contents are bit-identical to the mode-0 arrays), and stamp +!! its last-access time. The check-allocate-fill-publish sequence is serialized for thread safety +!! (FAST.Farm shares turbine 1's wave field with farm-level MoorDyn). +SUBROUTINE WaveField_EnsureBlock( WaveField, WaveField_m, Time, iBlk, ErrStat, ErrMsg ) + type(SeaSt_WaveFieldType), intent(in ) :: WaveField + type(GridInterp_MiscVarType), intent(in ) :: WaveField_m + real(DbKi), intent(in ) :: Time + integer(IntKi), intent( out) :: iBlk + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + + integer(IntKi) :: ib, jb, kb, nResident + real(ReKi) :: MBytes + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'WaveField_EnsureBlock' + + ErrStat = ErrID_None + ErrMsg = "" + + ASSOCIATE ( Store => WaveField%BlockStore ) + + ! Locate the block from the stencil's base cell: Indx(2,dim) is the 0-based lower cell index of the + ! query, already clamped in range by GridInterpSetup4D. All four stencil points per dimension are + ! then guaranteed to lie within the block's stored point range (see WaveField_BlockStore_Init). + ib = MIN( WaveField_m%Indx(2,2) / Store%BlkCellsX, Store%nBlkX - 1_IntKi ) + 1_IntKi + jb = MIN( WaveField_m%Indx(2,3) / Store%BlkCellsY, Store%nBlkY - 1_IntKi ) + 1_IntKi + kb = MIN( WaveField_m%Indx(2,4) / Store%BlkCellsZ, Store%nBlkZ - 1_IntKi ) + 1_IntKi + iBlk = ((kb-1_IntKi)*Store%nBlkY + (jb-1_IntKi))*Store%nBlkX + ib + + IF ( .NOT. Store%Blocks(iBlk)%Populated ) THEN + !$OMP CRITICAL(SeaSt_BlockPop) + IF ( .NOT. Store%Blocks(iBlk)%Populated ) THEN + + ASSOCIATE ( Blk => Store%Blocks(iBlk) ) + + ALLOCATE ( Blk%WaveDynP(0:WaveField%NStepWave, Blk%nPtX, Blk%nPtY, Blk%nPtZ ), & + Blk%WaveVel (0:WaveField%NStepWave, Blk%nPtX, Blk%nPtY, Blk%nPtZ, 3), & + Blk%WaveAcc (0:WaveField%NStepWave, Blk%nPtX, Blk%nPtY, Blk%nPtZ, 3), STAT=ErrStat2 ) + IF ( ErrStat2 == 0 .AND. WaveField%MCFD > 0.0_SiKi ) & + ALLOCATE ( Blk%WaveAccMCF(0:WaveField%NStepWave, Blk%nPtX, Blk%nPtY, Blk%nPtZ, 3), STAT=ErrStat2 ) + IF ( ErrStat2 /= 0 ) THEN + CALL SetErrStat( ErrID_Fatal, 'Error allocating the arrays of wave block ('// & + TRIM(Num2LStr(ib))//','//TRIM(Num2LStr(jb))//').', ErrStat, ErrMsg, RoutineName ) + END IF + + IF ( ErrStat < AbortErrLev ) THEN + IF ( WaveField%MCFD > 0.0_SiKi ) THEN + CALL WaveKinKernel_ComputeColumns ( WaveField, Store, Blk%iPtX0, Blk%nPtX, Blk%iPtY0, Blk%nPtY, & + Blk%iPtZ0, Blk%nPtZ, & + Blk%WaveDynP, Blk%WaveVel, Blk%WaveAcc, ErrStat2, ErrMsg2, & + WaveAccMCF=Blk%WaveAccMCF ) + ELSE + CALL WaveKinKernel_ComputeColumns ( WaveField, Store, Blk%iPtX0, Blk%nPtX, Blk%iPtY0, Blk%nPtY, & + Blk%iPtZ0, Blk%nPtZ, & + Blk%WaveDynP, Blk%WaveVel, Blk%WaveAcc, ErrStat2, ErrMsg2 ) + END IF + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END IF + + IF ( ErrStat < AbortErrLev .AND. ( Store%SecondOrderDiff .OR. Store%SecondOrderSum ) ) THEN + CALL WaveKinKernel_AddSecondOrderColumns ( WaveField, Store, Blk%iPtX0, Blk%nPtX, Blk%iPtY0, Blk%nPtY, & + Blk%iPtZ0, Blk%nPtZ, & + Blk%WaveDynP, Blk%WaveVel, Blk%WaveAcc, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END IF + + IF ( ErrStat < AbortErrLev ) THEN + Store%nPopulated = Store%nPopulated + 1_IntKi + nResident = Store%nPopulated - Store%nEvicted + Store%nPeakResident = MAX( Store%nPeakResident, nResident ) + MBytes = REAL(WaveField%NStepWave+1,ReKi) * Blk%nPtX * Blk%nPtY * Blk%nPtZ * 4.0_ReKi * & + MERGE( 10.0_ReKi, 7.0_ReKi, WaveField%MCFD > 0.0_SiKi ) / 1.0E6_ReKi + CALL WrScr ( ' SeaState: populated wave block ('//TRIM(Num2LStr(ib))//','//TRIM(Num2LStr(jb))//','// & + TRIM(Num2LStr(kb))// & + ') covering x('//TRIM(Num2LStr(Blk%iPtX0))//':'//TRIM(Num2LStr(Blk%iPtX0+Blk%nPtX-1))// & + '), y('//TRIM(Num2LStr(Blk%iPtY0))//':'//TRIM(Num2LStr(Blk%iPtY0+Blk%nPtY-1))// & + '), z('//TRIM(Num2LStr(Blk%iPtZ0))//':'//TRIM(Num2LStr(Blk%iPtZ0+Blk%nPtZ-1))// & + ') of the volume grid at t='//TRIM(Num2LStr(REAL(Time,ReKi)))//' s ('// & + TRIM(Num2LStr(MBytes))//' MB; '//TRIM(Num2LStr(nResident))//' block(s) resident).' ) + Blk%LastAccess = Time ! stamp before any sweep so the fresh block is never a victim + Blk%EverPopulated = .TRUE. + Blk%Populated = .TRUE. ! publish last + ! This population raised resident memory — free any now-idle blocks while the lock is held. + IF ( WaveField%WvKinBlockFreeT > 0.0_DbKi ) CALL WaveField_SweepBlocks( WaveField, Time ) + END IF + + END ASSOCIATE + + END IF + !$OMP END CRITICAL(SeaSt_BlockPop) + IF ( ErrStat >= AbortErrLev ) RETURN + END IF + + Store%Blocks(iBlk)%LastAccess = MAX( Store%Blocks(iBlk)%LastAccess, Time ) + + ! Throttled idle-block eviction on any access (the population path above already sweeps under the + ! lock). The unlocked read of LastSweep is a benign race — re-checked inside the critical section. + IF ( WaveField%WvKinBlockFreeT > 0.0_DbKi .AND. & + Time - Store%LastSweep > MAX( WaveField%WvKinBlockFreeT, 60.0_DbKi ) ) THEN + !$OMP CRITICAL(SeaSt_BlockPop) + IF ( Time - Store%LastSweep > MAX( WaveField%WvKinBlockFreeT, 60.0_DbKi ) ) THEN + CALL WaveField_SweepBlocks( WaveField, Time ) + END IF + !$OMP END CRITICAL(SeaSt_BlockPop) + END IF + + END ASSOCIATE + +END SUBROUTINE WaveField_EnsureBlock + + +!> Free the arrays of every populated block that has gone longer than WvKinBlockFreeT seconds of +!! simulation time without an access, so its memory is reclaimed until the query returns. Blocks are +!! deterministically regenerated by the shared kernels on the next access, so eviction never changes +!! results. The caller MUST hold the SeaSt_BlockPop critical section — this routine mutates the shared +!! block store and must not race population; it therefore contains no critical region of its own. +!! Stamps Store%LastSweep, counts evictions, and logs one line per freed block. Callers pass only when +!! WvKinBlockFreeT > 0 (a non-positive value disables freeing entirely). +!! +!! Serial-access assumption: today every wave-field query is serial (single-turbine runs are +!! single-threaded and FAST.Farm steps the shared field serially — there is no !$OMP PARALLEL region +!! around the accessors), and WaveField_EnsureBlock never evicts the block it just ensured (its own +!! LastAccess is stamped to the current Time first), so the unlocked block-array reads in +!! WaveField_InterpVol that follow an EnsureBlock call always see live arrays. If accessors are ever +!! driven from a genuinely concurrent (OMP-parallel) region over a shared field, those reads would +!! need to pin their block against eviction (e.g. a per-block reader count checked here) before this +!! sweep could run concurrently with them. +SUBROUTINE WaveField_SweepBlocks( WaveField, Time ) + type(SeaSt_WaveFieldType), intent(in ) :: WaveField + real(DbKi), intent(in ) :: Time + + integer(IntKi) :: iBlk, nResident + + ASSOCIATE ( Store => WaveField%BlockStore ) + + DO iBlk = 1, SIZE(Store%Blocks) + ASSOCIATE ( Blk => Store%Blocks(iBlk) ) + IF ( Blk%Populated .AND. ( Time - Blk%LastAccess > WaveField%WvKinBlockFreeT ) ) THEN + Blk%Populated = .FALSE. ! unpublish first, before freeing the arrays + IF ( ALLOCATED(Blk%WaveDynP) ) DEALLOCATE( Blk%WaveDynP ) + IF ( ALLOCATED(Blk%WaveVel) ) DEALLOCATE( Blk%WaveVel ) + IF ( ALLOCATED(Blk%WaveAcc) ) DEALLOCATE( Blk%WaveAcc ) + IF ( ALLOCATED(Blk%WaveAccMCF) ) DEALLOCATE( Blk%WaveAccMCF ) + Store%nEvicted = Store%nEvicted + 1_IntKi + nResident = Store%nPopulated - Store%nEvicted + CALL WrScr ( ' SeaState: freed idle wave block '//TRIM(Num2LStr(iBlk))//' (idle '// & + TRIM(Num2LStr(REAL(Time - Blk%LastAccess,ReKi)))//' s > WvKinBlockFreeT='// & + TRIM(Num2LStr(REAL(WaveField%WvKinBlockFreeT,ReKi)))//' s) at t='// & + TRIM(Num2LStr(REAL(Time,ReKi)))//' s ('//TRIM(Num2LStr(nResident))//' block(s) resident).' ) + END IF + END ASSOCIATE + END DO + + Store%LastSweep = Time + + END ASSOCIATE + +END SUBROUTINE WaveField_SweepBlocks + + +!---------------------------------------------------------------------------------------------------------------------------------- +!> Write the on-demand block partition as a legacy-VTK rectilinear grid: one cell per block, +!> one CELL_DATA scalar "BlockLife" (-1 = never populated, 0 = evicted, (0,1] = active, +!> normalized time remaining before eviction; pinned at 1 when eviction is disabled). +!> Silent no-op unless WvKinBlockMod=1 with an allocated block store. Errors are warnings only. +SUBROUTINE WaveField_WriteBlockVTK ( Time, WaveField, OutRootName, FrameNo, TWidth, ErrStat, ErrMsg ) + REAL(DbKi), INTENT(IN ) :: Time + TYPE(SeaSt_WaveFieldType), INTENT(IN ) :: WaveField + CHARACTER(*), INTENT(IN ) :: OutRootName + INTEGER(IntKi), INTENT(IN ) :: FrameNo + INTEGER(IntKi), INTENT(IN ) :: TWidth + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + + TYPE(SeaSt_WaveBlockStoreType), POINTER :: Store + TYPE(VTK_Misc) :: mvtk + REAL(ReKi), ALLOCATABLE :: xE(:), yE(:), zE(:), Life(:) + INTEGER(IntKi) :: k, nBlk, ErrStatTmp + CHARACTER(64) :: Tstr + CHARACTER(1024) :: FileName + CHARACTER(64) :: Descr + CHARACTER(*), PARAMETER :: RoutineName = 'WaveField_WriteBlockVTK' + + ErrStat = ErrID_None + ErrMsg = '' + + IF ( WaveField%WvKinBlockMod /= 1_IntKi ) RETURN + IF ( .NOT. ASSOCIATED(WaveField%BlockStore) ) RETURN + Store => WaveField%BlockStore + IF ( .NOT. ALLOCATED(Store%Blocks) ) RETURN + + nBlk = Store%nBlkX * Store%nBlkY * Store%nBlkZ + + ALLOCATE ( xE(Store%nBlkX+1), yE(Store%nBlkY+1), zE(Store%nBlkZ+1), Life(nBlk), STAT=ErrStatTmp ) + IF ( ErrStatTmp /= 0 ) THEN + CALL SetErrStat( ErrID_Warn, 'Could not allocate block VTK work arrays.', ErrStat, ErrMsg, RoutineName ) + RETURN + END IF + + CALL BlockEdgeCoords( Store%xGrid, Store%nBlkX, Store%BlkCellsX, xE ) + CALL BlockEdgeCoords( Store%yGrid, Store%nBlkY, Store%BlkCellsY, yE ) + CALL BlockEdgeCoords( Store%zGrid, Store%nBlkZ, Store%BlkCellsZ, zE ) + + ! Blocks(k) ordering (x fastest, then y, then z) matches VTK rectilinear cell ordering. + DO k = 1, nBlk + IF ( .NOT. Store%Blocks(k)%EverPopulated ) THEN + Life(k) = -1.0_ReKi + ELSE IF ( .NOT. Store%Blocks(k)%Populated ) THEN + Life(k) = 0.0_ReKi + ELSE IF ( WaveField%WvKinBlockFreeT > 0.0_DbKi ) THEN + ! floor keeps an overdue-but-unswept active block from displaying as evicted + Life(k) = REAL( MAX( ( WaveField%WvKinBlockFreeT - (Time - Store%Blocks(k)%LastAccess) ) & + / WaveField%WvKinBlockFreeT, 0.001_DbKi ), ReKi ) + ELSE + Life(k) = 1.0_ReKi ! eviction disabled: alive forever + END IF + END DO + + WRITE (Tstr,'(I'//TRIM(Num2LStr(TWidth))//'.'//TRIM(Num2LStr(TWidth))//')') FrameNo + FileName = TRIM(OutRootName)//'.SeaSt.WaveBlocks.'//TRIM(Tstr)//'.vtk' + WRITE (Descr,'(A,F0.4,A)') 'SeaState wave-kinematics blocks, t=', Time, ' s' + + CALL vtk_misc_init( mvtk ) + IF ( .NOT. vtk_new_ascii_file( TRIM(FileName), TRIM(Descr), mvtk ) ) THEN + CALL SetErrStat( ErrID_Warn, 'Could not open block VTK file "'//TRIM(FileName)//'".', ErrStat, ErrMsg, RoutineName ) + RETURN + END IF + CALL vtk_dataset_rectilinear( xE, yE, zE, mvtk ) + mvtk%nData = nBlk ! the VTK module never sets nData for rectilinear datasets; CELL_DATA needs the cell count + CALL vtk_cell_data_init( mvtk ) + CALL vtk_cell_data_scalar( Life, 'BlockLife', mvtk ) + CALL vtk_close_file( mvtk ) + +CONTAINS + + !> Physical coordinates of the nBlkAxis+1 block-boundary planes along one axis. + !> Boundary i (0-based) sits at grid point i*BlkCells+1 (1-based), clamped to the last point. + !> A degenerate axis (a single grid point) gets an arbitrary 1 m slab so cells stay renderable. + SUBROUTINE BlockEdgeCoords ( Grid, nBlkAxis, BlkCells, Edges ) + REAL(SiKi), INTENT(IN ) :: Grid(:) + INTEGER(IntKi), INTENT(IN ) :: nBlkAxis + INTEGER(IntKi), INTENT(IN ) :: BlkCells + REAL(ReKi), INTENT( OUT) :: Edges(:) + INTEGER(IntKi) :: i, nPt + nPt = SIZE(Grid) + IF ( nPt <= 1_IntKi ) THEN + Edges(1) = REAL(Grid(1),ReKi) - 0.5_ReKi + Edges(2) = REAL(Grid(1),ReKi) + 0.5_ReKi + RETURN + END IF + DO i = 0, nBlkAxis + Edges(i+1) = REAL( Grid( MIN( i*BlkCells + 1_IntKi, nPt ) ), ReKi ) + END DO + END SUBROUTINE BlockEdgeCoords + +END SUBROUTINE WaveField_WriteBlockVTK + + +!> Interpolate the wave-kinematics volume quantities for the point/time previously set up through +!! WaveField_Interp_Setup4D. This is the only place the volume data is read: in full-domain mode +!! (WvKinBlockMod=0) it reads the eager WaveField arrays; in on-demand mode (WvKinBlockMod=1) it +!! locates (and if needed populates) the wave block containing the interpolation stencil and reads +!! the block-local arrays — same values by construction, since blocks are filled by the same kernels +!! as the full-domain arrays. FAMCF is only written when a MacCamy-Fuchs field exists. +SUBROUTINE WaveField_InterpVol( WaveField, WaveField_m, Time, ErrStat, ErrMsg, FDynP, FV, FA, FAMCF ) + type(SeaSt_WaveFieldType), intent(in ) :: WaveField + type(GridInterp_MiscVarType), intent(inout) :: WaveField_m + real(DbKi), intent(in ) :: Time !< Simulation time, for block bookkeeping + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + real(SiKi), optional, intent( out) :: FDynP + real(SiKi), optional, intent( out) :: FV(3) + real(SiKi), optional, intent( out) :: FA(3) + real(SiKi), optional, intent( out) :: FAMCF(3) + + type(GridInterp_MiscVarType) :: m_blk + integer(IntKi) :: iBlk + character(*), parameter :: RoutineName = 'WaveField_InterpVol' + + ErrStat = ErrID_None + ErrMsg = "" + + IF ( WaveField%WvKinBlockMod == 1_IntKi ) THEN + + CALL WaveField_EnsureBlock( WaveField, WaveField_m, Time, iBlk, ErrStat, ErrMsg ) + IF ( ErrStat >= AbortErrLev ) RETURN + + ASSOCIATE ( Blk => WaveField%BlockStore%Blocks(iBlk) ) + ! Shift the stencil indices from global to block-local (both are 0-based inside GridInterp) + m_blk = WaveField_m + m_blk%Indx(:,2) = WaveField_m%Indx(:,2) - ( Blk%iPtX0 - 1_IntKi ) + m_blk%Indx(:,3) = WaveField_m%Indx(:,3) - ( Blk%iPtY0 - 1_IntKi ) + m_blk%Indx(:,4) = WaveField_m%Indx(:,4) - ( Blk%iPtZ0 - 1_IntKi ) + IF ( PRESENT(FV) ) FV(:) = GridInterp4DVec( Blk%WaveVel, m_blk ) + IF ( PRESENT(FA) ) FA(:) = GridInterp4DVec( Blk%WaveAcc, m_blk ) + IF ( PRESENT(FDynP) ) FDynP = GridInterp4D ( Blk%WaveDynP, m_blk ) + IF ( PRESENT(FAMCF) ) THEN + IF ( ALLOCATED(Blk%WaveAccMCF) ) THEN + FAMCF(:) = GridInterp4DVec( Blk%WaveAccMCF, m_blk ) + END IF + END IF + END ASSOCIATE + + ELSE + + IF ( PRESENT(FV) ) FV(:) = GridInterp4DVec( WaveField%WaveVel, WaveField_m ) + IF ( PRESENT(FA) ) FA(:) = GridInterp4DVec( WaveField%WaveAcc, WaveField_m ) + IF ( PRESENT(FDynP) ) FDynP = GridInterp4D ( WaveField%WaveDynP, WaveField_m ) + IF ( PRESENT(FAMCF) ) THEN + IF ( ALLOCATED(WaveField%WaveAccMCF) ) THEN + FAMCF(:) = GridInterp4DVec( WaveField%WaveAccMCF, WaveField_m ) + END IF + END IF + + END IF + +END SUBROUTINE WaveField_InterpVol + + !---------------------------------------------------------------------------------------------------- ! Interpolation related functions !---------------------------------------------------------------------------------------------------- diff --git a/modules/seastate/src/SeaSt_WaveField.txt b/modules/seastate/src/SeaSt_WaveField.txt index c1327b8f6e..108b972680 100644 --- a/modules/seastate/src/SeaSt_WaveField.txt +++ b/modules/seastate/src/SeaSt_WaveField.txt @@ -38,6 +38,49 @@ typedef ^ MiscVarType integer Indx_Hi typedef ^ MiscVarType logical FirstWarn_Clamp - .true. - "used to avoid too many 'Position has been clamped to the grid boundary' warning messages " - +# On-demand wave-kinematics block partitioning (WvKinBlockMod=1): one cube block of the volume grid (partitioned in x, y, z; full time extent) +typedef ^ SeaSt_WaveBlockType SiKi WaveDynP {:}{:}{:}{:} - - "Block-local incident wave dynamic pressure [0:NStepWave,nPtX,nPtY,nPtZ]" (N/m^2) +typedef ^ ^ SiKi WaveVel {:}{:}{:}{:}{:} - - "Block-local incident wave velocity [0:NStepWave,nPtX,nPtY,nPtZ,3]" (m/s) +typedef ^ ^ SiKi WaveAcc {:}{:}{:}{:}{:} - - "Block-local incident wave acceleration [0:NStepWave,nPtX,nPtY,nPtZ,3]" (m/s^2) +typedef ^ ^ SiKi WaveAccMCF {:}{:}{:}{:}{:} - - "Block-local scaled acceleration for MacCamy-Fuchs members [0:NStepWave,nPtX,nPtY,nPtZ,3]" (m/s^2) +typedef ^ ^ DbKi LastAccess - 0 - "Simulation time of the most recent access to this block" (s) +typedef ^ ^ LOGICAL Populated - .false. - "True when the block arrays are allocated and filled" - +typedef ^ ^ LOGICAL EverPopulated - .false. - "True if this block has ever been populated (never cleared by eviction)" - +typedef ^ ^ INTEGER iPtX0 - 0 - "Global x-index of this block's first grid point" - +typedef ^ ^ INTEGER iPtY0 - 0 - "Global y-index of this block's first grid point" - +typedef ^ ^ INTEGER iPtZ0 - 0 - "Global z-index of this block's first grid point" - +typedef ^ ^ INTEGER nPtX - 0 - "Number of grid points this block covers in x" - +typedef ^ ^ INTEGER nPtY - 0 - "Number of grid points this block covers in y" - +typedef ^ ^ INTEGER nPtZ - 0 - "Number of grid points this block covers in z" - + +# Block store: block-grid layout, per-frequency/per-level generation seeds, and bookkeeping (owned by SeaState MiscVarType) +typedef ^ SeaSt_WaveBlockStoreType SeaSt_WaveBlockType Blocks {:} - - "Wave-kinematics blocks, index = ((kb-1)*nBlkY + (jb-1))*nBlkX + ib" - +typedef ^ ^ INTEGER nBlkX - 0 - "Number of blocks in x" - +typedef ^ ^ INTEGER nBlkY - 0 - "Number of blocks in y" - +typedef ^ ^ INTEGER nBlkZ - 0 - "Number of blocks in z" - +typedef ^ ^ INTEGER BlkCellsX - 0 - "Grid cells per block in x (interior blocks)" - +typedef ^ ^ INTEGER BlkCellsY - 0 - "Grid cells per block in y (interior blocks)" - +typedef ^ ^ INTEGER BlkCellsZ - 0 - "Grid cells per block in z (interior blocks)" - +typedef ^ ^ SiKi WaveNmbrArr {:} - - "Wave number of each non-negative frequency component (0:NStepWave2)" (1/m) +typedef ^ ^ SiKi OmegaIArr {:} - - "Intrinsic (Doppler-corrected) angular frequency of each component; <0 marks components beyond the critical frequency (0:NStepWave2)" (rad/s) +typedef ^ ^ SiKi MCFCArr {:} - - "MacCamy-Fuchs acceleration scaling coefficient of each component (0:NStepWave2)" - +typedef ^ ^ SiKi CurrVxi {:} - - "Steady current xi-velocity at each grid z level (NZ)" (m/s) +typedef ^ ^ SiKi CurrVyi {:} - - "Steady current yi-velocity at each grid z level (NZ)" (m/s) +typedef ^ ^ SiKi zGrid {:} - - "Grid z coordinates relative to SWL, <=0 (NZ)" (m) +typedef ^ ^ SiKi xGrid {:} - - "Grid x coordinates (NX)" (m) +typedef ^ ^ SiKi yGrid {:} - - "Grid y coordinates (NY)" (m) +typedef ^ ^ SiKi CosWaveDirArr {:} - - "COS(D2R*WaveDirArr), captured from VariousWaves_Init (0:NStepWave2)" - +typedef ^ ^ SiKi SinWaveDirArr {:} - - "SIN(D2R*WaveDirArr), captured from VariousWaves_Init (0:NStepWave2)" - +typedef ^ ^ LOGICAL HasCurr - .false. - "True if a current profile was available to add to the wave velocities" - +typedef ^ ^ ReKi Gravity - 0 - "Gravitational acceleration, needed by the second-order kernel's per-pair dispersion solves" (m/s^2) +typedef ^ ^ LOGICAL SecondOrderDiff - .false. - "Add difference-QTF second-order kinematics during block population" - +typedef ^ ^ LOGICAL SecondOrderSum - .false. - "Add sum-QTF second-order kinematics during block population" - +typedef ^ ^ DbKi LastSweep - 0 - "Simulation time of the last idle-block eviction sweep" (s) +typedef ^ ^ INTEGER nPopulated - 0 - "Total number of block population events" - +typedef ^ ^ INTEGER nEvicted - 0 - "Total number of block eviction events" - +typedef ^ ^ INTEGER nPeakResident - 0 - "Peak number of simultaneously populated blocks" - + + typedef SeaSt_WaveField SeaSt_WaveFieldType SiKi WaveTime {:} - - "Time array" (s) typedef ^ ^ SiKi WaveDynP {:}{:}{:}{:} - - "Incident wave dynamic pressure" (N/m^2) typedef ^ ^ SiKi WaveAcc {:}{:}{:}{:}{:} - - "Incident wave acceleration" (m/s^2) @@ -83,4 +126,8 @@ typedef ^ ^ INTEGER NStepWave typedef ^ ^ INTEGER NStepWave2 - - - "NStepWave / 2" - typedef ^ ^ SiKi GridDepth - - - "Depth (>0) of wave grid below SWL" m typedef ^ ^ DbKi WaveTimeShift - 0 - "Add this to the time to effectively phase shift the wave (useful for hybrid tank testing). Positive value only (advance time)" (s) +typedef ^ ^ INTEGER WvKinBlockMod - 0 - "Wave kinematics volume-data mode {0: full-domain precompute, 1: on-demand blocks}" - +typedef ^ ^ ReKi WvKinBlockSize - - - "Target edge length of an on-demand cube block" (m) +typedef ^ ^ DbKi WvKinBlockFreeT - - - "Idle simulation time after which a block is freed; <=0 never" (s) +typedef ^ ^ SeaSt_WaveBlockStoreType *BlockStore - - - "Non-owning pointer to the on-demand wave-kinematics block store (owned by SeaState MiscVarType) [associated only when WvKinBlockMod=1]" - typedef ^ ^ Current_InitInputType Current_InitInput - - - "InitInputs in the Current Module. For coupling with MD." - diff --git a/modules/seastate/src/SeaSt_WaveField_Types.f90 b/modules/seastate/src/SeaSt_WaveField_Types.f90 index cba2c94b4c..b9ad940abe 100644 --- a/modules/seastate/src/SeaSt_WaveField_Types.f90 +++ b/modules/seastate/src/SeaSt_WaveField_Types.f90 @@ -62,6 +62,52 @@ MODULE SeaSt_WaveField_Types LOGICAL :: FirstWarn_Clamp = .true. !< used to avoid too many 'Position has been clamped to the grid boundary' warning messages [-] END TYPE SeaSt_WaveField_MiscVarType ! ======================= +! ========= SeaSt_WaveBlockType ======= + TYPE, PUBLIC :: SeaSt_WaveBlockType + REAL(SiKi) , DIMENSION(:,:,:,:), ALLOCATABLE :: WaveDynP !< Block-local incident wave dynamic pressure [0:NStepWave,nPtX,nPtY,nPtZ] [(N/m^2)] + REAL(SiKi) , DIMENSION(:,:,:,:,:), ALLOCATABLE :: WaveVel !< Block-local incident wave velocity [0:NStepWave,nPtX,nPtY,nPtZ,3] [(m/s)] + REAL(SiKi) , DIMENSION(:,:,:,:,:), ALLOCATABLE :: WaveAcc !< Block-local incident wave acceleration [0:NStepWave,nPtX,nPtY,nPtZ,3] [(m/s^2)] + REAL(SiKi) , DIMENSION(:,:,:,:,:), ALLOCATABLE :: WaveAccMCF !< Block-local scaled acceleration for MacCamy-Fuchs members [0:NStepWave,nPtX,nPtY,nPtZ,3] [(m/s^2)] + REAL(DbKi) :: LastAccess = 0 !< Simulation time of the most recent access to this block [(s)] + LOGICAL :: Populated = .false. !< True when the block arrays are allocated and filled [-] + LOGICAL :: EverPopulated = .false. !< True if this block has ever been populated (never cleared by eviction) [-] + INTEGER(IntKi) :: iPtX0 = 0 !< Global x-index of this block's first grid point [-] + INTEGER(IntKi) :: iPtY0 = 0 !< Global y-index of this block's first grid point [-] + INTEGER(IntKi) :: iPtZ0 = 0 !< Global z-index of this block's first grid point [-] + INTEGER(IntKi) :: nPtX = 0 !< Number of grid points this block covers in x [-] + INTEGER(IntKi) :: nPtY = 0 !< Number of grid points this block covers in y [-] + INTEGER(IntKi) :: nPtZ = 0 !< Number of grid points this block covers in z [-] + END TYPE SeaSt_WaveBlockType +! ======================= +! ========= SeaSt_WaveBlockStoreType ======= + TYPE, PUBLIC :: SeaSt_WaveBlockStoreType + TYPE(SeaSt_WaveBlockType) , DIMENSION(:), ALLOCATABLE :: Blocks !< Wave-kinematics blocks, index = ((kb-1)*nBlkY + (jb-1))*nBlkX + ib [-] + INTEGER(IntKi) :: nBlkX = 0 !< Number of blocks in x [-] + INTEGER(IntKi) :: nBlkY = 0 !< Number of blocks in y [-] + INTEGER(IntKi) :: nBlkZ = 0 !< Number of blocks in z [-] + INTEGER(IntKi) :: BlkCellsX = 0 !< Grid cells per block in x (interior blocks) [-] + INTEGER(IntKi) :: BlkCellsY = 0 !< Grid cells per block in y (interior blocks) [-] + INTEGER(IntKi) :: BlkCellsZ = 0 !< Grid cells per block in z (interior blocks) [-] + REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveNmbrArr !< Wave number of each non-negative frequency component (0:NStepWave2) [(1/m)] + REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: OmegaIArr !< Intrinsic (Doppler-corrected) angular frequency of each component; <0 marks components beyond the critical frequency (0:NStepWave2) [(rad/s)] + REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: MCFCArr !< MacCamy-Fuchs acceleration scaling coefficient of each component (0:NStepWave2) [-] + REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: CurrVxi !< Steady current xi-velocity at each grid z level (NZ) [(m/s)] + REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: CurrVyi !< Steady current yi-velocity at each grid z level (NZ) [(m/s)] + REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: zGrid !< Grid z coordinates relative to SWL, <=0 (NZ) [(m)] + REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: xGrid !< Grid x coordinates (NX) [(m)] + REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: yGrid !< Grid y coordinates (NY) [(m)] + REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: CosWaveDirArr !< COS(D2R*WaveDirArr), captured from VariousWaves_Init (0:NStepWave2) [-] + REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: SinWaveDirArr !< SIN(D2R*WaveDirArr), captured from VariousWaves_Init (0:NStepWave2) [-] + LOGICAL :: HasCurr = .false. !< True if a current profile was available to add to the wave velocities [-] + REAL(ReKi) :: Gravity = 0 !< Gravitational acceleration, needed by the second-order kernel's per-pair dispersion solves [(m/s^2)] + LOGICAL :: SecondOrderDiff = .false. !< Add difference-QTF second-order kinematics during block population [-] + LOGICAL :: SecondOrderSum = .false. !< Add sum-QTF second-order kinematics during block population [-] + REAL(DbKi) :: LastSweep = 0 !< Simulation time of the last idle-block eviction sweep [(s)] + INTEGER(IntKi) :: nPopulated = 0 !< Total number of block population events [-] + INTEGER(IntKi) :: nEvicted = 0 !< Total number of block eviction events [-] + INTEGER(IntKi) :: nPeakResident = 0 !< Peak number of simultaneously populated blocks [-] + END TYPE SeaSt_WaveBlockStoreType +! ======================= ! ========= SeaSt_WaveFieldType ======= TYPE, PUBLIC :: SeaSt_WaveFieldType REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveTime !< Time array [(s)] @@ -107,6 +153,10 @@ MODULE SeaSt_WaveField_Types INTEGER(IntKi) :: NStepWave2 = 0_IntKi !< NStepWave / 2 [-] REAL(SiKi) :: GridDepth = 0.0_R4Ki !< Depth (>0) of wave grid below SWL [m] REAL(DbKi) :: WaveTimeShift = 0 !< Add this to the time to effectively phase shift the wave (useful for hybrid tank testing). Positive value only (advance time) [(s)] + INTEGER(IntKi) :: WvKinBlockMod = 0 !< Wave kinematics volume-data mode {0: full-domain precompute, 1: on-demand blocks} [-] + REAL(ReKi) :: WvKinBlockSize = 0.0_ReKi !< Target edge length of an on-demand cube block [(m)] + REAL(DbKi) :: WvKinBlockFreeT = 0.0_R8Ki !< Idle simulation time after which a block is freed; <=0 never [(s)] + TYPE(SeaSt_WaveBlockStoreType) , POINTER :: BlockStore => NULL() !< Non-owning pointer to the on-demand wave-kinematics block store (owned by SeaState MiscVarType) [associated only when WvKinBlockMod=1] [-] TYPE(Current_InitInputType) :: Current_InitInput !< InitInputs in the Current Module. For coupling with MD. [-] END TYPE SeaSt_WaveFieldType ! ======================= @@ -163,6 +213,449 @@ subroutine SeaSt_WaveField_UnPackMisc(RF, OutData) call RegUnpack(RF, OutData%FirstWarn_Clamp); if (RegCheckErr(RF, RoutineName)) return end subroutine +subroutine SeaSt_WaveField_CopySeaSt_WaveBlockType(SrcSeaSt_WaveBlockTypeData, DstSeaSt_WaveBlockTypeData, CtrlCode, ErrStat, ErrMsg) + type(SeaSt_WaveBlockType), intent(in) :: SrcSeaSt_WaveBlockTypeData + type(SeaSt_WaveBlockType), intent(inout) :: DstSeaSt_WaveBlockTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(5), UB(5) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'SeaSt_WaveField_CopySeaSt_WaveBlockType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcSeaSt_WaveBlockTypeData%WaveDynP)) then + LB(1:4) = lbound(SrcSeaSt_WaveBlockTypeData%WaveDynP) + UB(1:4) = ubound(SrcSeaSt_WaveBlockTypeData%WaveDynP) + if (.not. allocated(DstSeaSt_WaveBlockTypeData%WaveDynP)) then + allocate(DstSeaSt_WaveBlockTypeData%WaveDynP(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstSeaSt_WaveBlockTypeData%WaveDynP.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstSeaSt_WaveBlockTypeData%WaveDynP = SrcSeaSt_WaveBlockTypeData%WaveDynP + end if + if (allocated(SrcSeaSt_WaveBlockTypeData%WaveVel)) then + LB(1:5) = lbound(SrcSeaSt_WaveBlockTypeData%WaveVel) + UB(1:5) = ubound(SrcSeaSt_WaveBlockTypeData%WaveVel) + if (.not. allocated(DstSeaSt_WaveBlockTypeData%WaveVel)) then + allocate(DstSeaSt_WaveBlockTypeData%WaveVel(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstSeaSt_WaveBlockTypeData%WaveVel.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstSeaSt_WaveBlockTypeData%WaveVel = SrcSeaSt_WaveBlockTypeData%WaveVel + end if + if (allocated(SrcSeaSt_WaveBlockTypeData%WaveAcc)) then + LB(1:5) = lbound(SrcSeaSt_WaveBlockTypeData%WaveAcc) + UB(1:5) = ubound(SrcSeaSt_WaveBlockTypeData%WaveAcc) + if (.not. allocated(DstSeaSt_WaveBlockTypeData%WaveAcc)) then + allocate(DstSeaSt_WaveBlockTypeData%WaveAcc(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstSeaSt_WaveBlockTypeData%WaveAcc.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstSeaSt_WaveBlockTypeData%WaveAcc = SrcSeaSt_WaveBlockTypeData%WaveAcc + end if + if (allocated(SrcSeaSt_WaveBlockTypeData%WaveAccMCF)) then + LB(1:5) = lbound(SrcSeaSt_WaveBlockTypeData%WaveAccMCF) + UB(1:5) = ubound(SrcSeaSt_WaveBlockTypeData%WaveAccMCF) + if (.not. allocated(DstSeaSt_WaveBlockTypeData%WaveAccMCF)) then + allocate(DstSeaSt_WaveBlockTypeData%WaveAccMCF(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstSeaSt_WaveBlockTypeData%WaveAccMCF.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstSeaSt_WaveBlockTypeData%WaveAccMCF = SrcSeaSt_WaveBlockTypeData%WaveAccMCF + end if + DstSeaSt_WaveBlockTypeData%LastAccess = SrcSeaSt_WaveBlockTypeData%LastAccess + DstSeaSt_WaveBlockTypeData%Populated = SrcSeaSt_WaveBlockTypeData%Populated + DstSeaSt_WaveBlockTypeData%EverPopulated = SrcSeaSt_WaveBlockTypeData%EverPopulated + DstSeaSt_WaveBlockTypeData%iPtX0 = SrcSeaSt_WaveBlockTypeData%iPtX0 + DstSeaSt_WaveBlockTypeData%iPtY0 = SrcSeaSt_WaveBlockTypeData%iPtY0 + DstSeaSt_WaveBlockTypeData%iPtZ0 = SrcSeaSt_WaveBlockTypeData%iPtZ0 + DstSeaSt_WaveBlockTypeData%nPtX = SrcSeaSt_WaveBlockTypeData%nPtX + DstSeaSt_WaveBlockTypeData%nPtY = SrcSeaSt_WaveBlockTypeData%nPtY + DstSeaSt_WaveBlockTypeData%nPtZ = SrcSeaSt_WaveBlockTypeData%nPtZ +end subroutine + +subroutine SeaSt_WaveField_DestroySeaSt_WaveBlockType(SeaSt_WaveBlockTypeData, ErrStat, ErrMsg) + type(SeaSt_WaveBlockType), intent(inout) :: SeaSt_WaveBlockTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SeaSt_WaveField_DestroySeaSt_WaveBlockType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SeaSt_WaveBlockTypeData%WaveDynP)) then + deallocate(SeaSt_WaveBlockTypeData%WaveDynP) + end if + if (allocated(SeaSt_WaveBlockTypeData%WaveVel)) then + deallocate(SeaSt_WaveBlockTypeData%WaveVel) + end if + if (allocated(SeaSt_WaveBlockTypeData%WaveAcc)) then + deallocate(SeaSt_WaveBlockTypeData%WaveAcc) + end if + if (allocated(SeaSt_WaveBlockTypeData%WaveAccMCF)) then + deallocate(SeaSt_WaveBlockTypeData%WaveAccMCF) + end if +end subroutine + +subroutine SeaSt_WaveField_PackSeaSt_WaveBlockType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(SeaSt_WaveBlockType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SeaSt_WaveField_PackSeaSt_WaveBlockType' + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%WaveDynP) + call RegPackAlloc(RF, InData%WaveVel) + call RegPackAlloc(RF, InData%WaveAcc) + call RegPackAlloc(RF, InData%WaveAccMCF) + call RegPack(RF, InData%LastAccess) + call RegPack(RF, InData%Populated) + call RegPack(RF, InData%EverPopulated) + call RegPack(RF, InData%iPtX0) + call RegPack(RF, InData%iPtY0) + call RegPack(RF, InData%iPtZ0) + call RegPack(RF, InData%nPtX) + call RegPack(RF, InData%nPtY) + call RegPack(RF, InData%nPtZ) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SeaSt_WaveField_UnPackSeaSt_WaveBlockType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(SeaSt_WaveBlockType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SeaSt_WaveField_UnPackSeaSt_WaveBlockType' + integer(B4Ki) :: LB(5), UB(5) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%WaveDynP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WaveVel); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WaveAcc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WaveAccMCF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LastAccess); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Populated); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%EverPopulated); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iPtX0); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iPtY0); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iPtZ0); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nPtX); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nPtY); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nPtZ); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SeaSt_WaveField_CopySeaSt_WaveBlockStoreType(SrcSeaSt_WaveBlockStoreTypeData, DstSeaSt_WaveBlockStoreTypeData, CtrlCode, ErrStat, ErrMsg) + type(SeaSt_WaveBlockStoreType), intent(in) :: SrcSeaSt_WaveBlockStoreTypeData + type(SeaSt_WaveBlockStoreType), intent(inout) :: DstSeaSt_WaveBlockStoreTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SeaSt_WaveField_CopySeaSt_WaveBlockStoreType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcSeaSt_WaveBlockStoreTypeData%Blocks)) then + LB(1:1) = lbound(SrcSeaSt_WaveBlockStoreTypeData%Blocks) + UB(1:1) = ubound(SrcSeaSt_WaveBlockStoreTypeData%Blocks) + if (.not. allocated(DstSeaSt_WaveBlockStoreTypeData%Blocks)) then + allocate(DstSeaSt_WaveBlockStoreTypeData%Blocks(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstSeaSt_WaveBlockStoreTypeData%Blocks.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call SeaSt_WaveField_CopySeaSt_WaveBlockType(SrcSeaSt_WaveBlockStoreTypeData%Blocks(i1), DstSeaSt_WaveBlockStoreTypeData%Blocks(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + DstSeaSt_WaveBlockStoreTypeData%nBlkX = SrcSeaSt_WaveBlockStoreTypeData%nBlkX + DstSeaSt_WaveBlockStoreTypeData%nBlkY = SrcSeaSt_WaveBlockStoreTypeData%nBlkY + DstSeaSt_WaveBlockStoreTypeData%nBlkZ = SrcSeaSt_WaveBlockStoreTypeData%nBlkZ + DstSeaSt_WaveBlockStoreTypeData%BlkCellsX = SrcSeaSt_WaveBlockStoreTypeData%BlkCellsX + DstSeaSt_WaveBlockStoreTypeData%BlkCellsY = SrcSeaSt_WaveBlockStoreTypeData%BlkCellsY + DstSeaSt_WaveBlockStoreTypeData%BlkCellsZ = SrcSeaSt_WaveBlockStoreTypeData%BlkCellsZ + if (allocated(SrcSeaSt_WaveBlockStoreTypeData%WaveNmbrArr)) then + LB(1:1) = lbound(SrcSeaSt_WaveBlockStoreTypeData%WaveNmbrArr) + UB(1:1) = ubound(SrcSeaSt_WaveBlockStoreTypeData%WaveNmbrArr) + if (.not. allocated(DstSeaSt_WaveBlockStoreTypeData%WaveNmbrArr)) then + allocate(DstSeaSt_WaveBlockStoreTypeData%WaveNmbrArr(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstSeaSt_WaveBlockStoreTypeData%WaveNmbrArr.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstSeaSt_WaveBlockStoreTypeData%WaveNmbrArr = SrcSeaSt_WaveBlockStoreTypeData%WaveNmbrArr + end if + if (allocated(SrcSeaSt_WaveBlockStoreTypeData%OmegaIArr)) then + LB(1:1) = lbound(SrcSeaSt_WaveBlockStoreTypeData%OmegaIArr) + UB(1:1) = ubound(SrcSeaSt_WaveBlockStoreTypeData%OmegaIArr) + if (.not. allocated(DstSeaSt_WaveBlockStoreTypeData%OmegaIArr)) then + allocate(DstSeaSt_WaveBlockStoreTypeData%OmegaIArr(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstSeaSt_WaveBlockStoreTypeData%OmegaIArr.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstSeaSt_WaveBlockStoreTypeData%OmegaIArr = SrcSeaSt_WaveBlockStoreTypeData%OmegaIArr + end if + if (allocated(SrcSeaSt_WaveBlockStoreTypeData%MCFCArr)) then + LB(1:1) = lbound(SrcSeaSt_WaveBlockStoreTypeData%MCFCArr) + UB(1:1) = ubound(SrcSeaSt_WaveBlockStoreTypeData%MCFCArr) + if (.not. allocated(DstSeaSt_WaveBlockStoreTypeData%MCFCArr)) then + allocate(DstSeaSt_WaveBlockStoreTypeData%MCFCArr(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstSeaSt_WaveBlockStoreTypeData%MCFCArr.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstSeaSt_WaveBlockStoreTypeData%MCFCArr = SrcSeaSt_WaveBlockStoreTypeData%MCFCArr + end if + if (allocated(SrcSeaSt_WaveBlockStoreTypeData%CurrVxi)) then + LB(1:1) = lbound(SrcSeaSt_WaveBlockStoreTypeData%CurrVxi) + UB(1:1) = ubound(SrcSeaSt_WaveBlockStoreTypeData%CurrVxi) + if (.not. allocated(DstSeaSt_WaveBlockStoreTypeData%CurrVxi)) then + allocate(DstSeaSt_WaveBlockStoreTypeData%CurrVxi(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstSeaSt_WaveBlockStoreTypeData%CurrVxi.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstSeaSt_WaveBlockStoreTypeData%CurrVxi = SrcSeaSt_WaveBlockStoreTypeData%CurrVxi + end if + if (allocated(SrcSeaSt_WaveBlockStoreTypeData%CurrVyi)) then + LB(1:1) = lbound(SrcSeaSt_WaveBlockStoreTypeData%CurrVyi) + UB(1:1) = ubound(SrcSeaSt_WaveBlockStoreTypeData%CurrVyi) + if (.not. allocated(DstSeaSt_WaveBlockStoreTypeData%CurrVyi)) then + allocate(DstSeaSt_WaveBlockStoreTypeData%CurrVyi(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstSeaSt_WaveBlockStoreTypeData%CurrVyi.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstSeaSt_WaveBlockStoreTypeData%CurrVyi = SrcSeaSt_WaveBlockStoreTypeData%CurrVyi + end if + if (allocated(SrcSeaSt_WaveBlockStoreTypeData%zGrid)) then + LB(1:1) = lbound(SrcSeaSt_WaveBlockStoreTypeData%zGrid) + UB(1:1) = ubound(SrcSeaSt_WaveBlockStoreTypeData%zGrid) + if (.not. allocated(DstSeaSt_WaveBlockStoreTypeData%zGrid)) then + allocate(DstSeaSt_WaveBlockStoreTypeData%zGrid(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstSeaSt_WaveBlockStoreTypeData%zGrid.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstSeaSt_WaveBlockStoreTypeData%zGrid = SrcSeaSt_WaveBlockStoreTypeData%zGrid + end if + if (allocated(SrcSeaSt_WaveBlockStoreTypeData%xGrid)) then + LB(1:1) = lbound(SrcSeaSt_WaveBlockStoreTypeData%xGrid) + UB(1:1) = ubound(SrcSeaSt_WaveBlockStoreTypeData%xGrid) + if (.not. allocated(DstSeaSt_WaveBlockStoreTypeData%xGrid)) then + allocate(DstSeaSt_WaveBlockStoreTypeData%xGrid(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstSeaSt_WaveBlockStoreTypeData%xGrid.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstSeaSt_WaveBlockStoreTypeData%xGrid = SrcSeaSt_WaveBlockStoreTypeData%xGrid + end if + if (allocated(SrcSeaSt_WaveBlockStoreTypeData%yGrid)) then + LB(1:1) = lbound(SrcSeaSt_WaveBlockStoreTypeData%yGrid) + UB(1:1) = ubound(SrcSeaSt_WaveBlockStoreTypeData%yGrid) + if (.not. allocated(DstSeaSt_WaveBlockStoreTypeData%yGrid)) then + allocate(DstSeaSt_WaveBlockStoreTypeData%yGrid(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstSeaSt_WaveBlockStoreTypeData%yGrid.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstSeaSt_WaveBlockStoreTypeData%yGrid = SrcSeaSt_WaveBlockStoreTypeData%yGrid + end if + if (allocated(SrcSeaSt_WaveBlockStoreTypeData%CosWaveDirArr)) then + LB(1:1) = lbound(SrcSeaSt_WaveBlockStoreTypeData%CosWaveDirArr) + UB(1:1) = ubound(SrcSeaSt_WaveBlockStoreTypeData%CosWaveDirArr) + if (.not. allocated(DstSeaSt_WaveBlockStoreTypeData%CosWaveDirArr)) then + allocate(DstSeaSt_WaveBlockStoreTypeData%CosWaveDirArr(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstSeaSt_WaveBlockStoreTypeData%CosWaveDirArr.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstSeaSt_WaveBlockStoreTypeData%CosWaveDirArr = SrcSeaSt_WaveBlockStoreTypeData%CosWaveDirArr + end if + if (allocated(SrcSeaSt_WaveBlockStoreTypeData%SinWaveDirArr)) then + LB(1:1) = lbound(SrcSeaSt_WaveBlockStoreTypeData%SinWaveDirArr) + UB(1:1) = ubound(SrcSeaSt_WaveBlockStoreTypeData%SinWaveDirArr) + if (.not. allocated(DstSeaSt_WaveBlockStoreTypeData%SinWaveDirArr)) then + allocate(DstSeaSt_WaveBlockStoreTypeData%SinWaveDirArr(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstSeaSt_WaveBlockStoreTypeData%SinWaveDirArr.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstSeaSt_WaveBlockStoreTypeData%SinWaveDirArr = SrcSeaSt_WaveBlockStoreTypeData%SinWaveDirArr + end if + DstSeaSt_WaveBlockStoreTypeData%HasCurr = SrcSeaSt_WaveBlockStoreTypeData%HasCurr + DstSeaSt_WaveBlockStoreTypeData%Gravity = SrcSeaSt_WaveBlockStoreTypeData%Gravity + DstSeaSt_WaveBlockStoreTypeData%SecondOrderDiff = SrcSeaSt_WaveBlockStoreTypeData%SecondOrderDiff + DstSeaSt_WaveBlockStoreTypeData%SecondOrderSum = SrcSeaSt_WaveBlockStoreTypeData%SecondOrderSum + DstSeaSt_WaveBlockStoreTypeData%LastSweep = SrcSeaSt_WaveBlockStoreTypeData%LastSweep + DstSeaSt_WaveBlockStoreTypeData%nPopulated = SrcSeaSt_WaveBlockStoreTypeData%nPopulated + DstSeaSt_WaveBlockStoreTypeData%nEvicted = SrcSeaSt_WaveBlockStoreTypeData%nEvicted + DstSeaSt_WaveBlockStoreTypeData%nPeakResident = SrcSeaSt_WaveBlockStoreTypeData%nPeakResident +end subroutine + +subroutine SeaSt_WaveField_DestroySeaSt_WaveBlockStoreType(SeaSt_WaveBlockStoreTypeData, ErrStat, ErrMsg) + type(SeaSt_WaveBlockStoreType), intent(inout) :: SeaSt_WaveBlockStoreTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SeaSt_WaveField_DestroySeaSt_WaveBlockStoreType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SeaSt_WaveBlockStoreTypeData%Blocks)) then + LB(1:1) = lbound(SeaSt_WaveBlockStoreTypeData%Blocks) + UB(1:1) = ubound(SeaSt_WaveBlockStoreTypeData%Blocks) + do i1 = LB(1), UB(1) + call SeaSt_WaveField_DestroySeaSt_WaveBlockType(SeaSt_WaveBlockStoreTypeData%Blocks(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(SeaSt_WaveBlockStoreTypeData%Blocks) + end if + if (allocated(SeaSt_WaveBlockStoreTypeData%WaveNmbrArr)) then + deallocate(SeaSt_WaveBlockStoreTypeData%WaveNmbrArr) + end if + if (allocated(SeaSt_WaveBlockStoreTypeData%OmegaIArr)) then + deallocate(SeaSt_WaveBlockStoreTypeData%OmegaIArr) + end if + if (allocated(SeaSt_WaveBlockStoreTypeData%MCFCArr)) then + deallocate(SeaSt_WaveBlockStoreTypeData%MCFCArr) + end if + if (allocated(SeaSt_WaveBlockStoreTypeData%CurrVxi)) then + deallocate(SeaSt_WaveBlockStoreTypeData%CurrVxi) + end if + if (allocated(SeaSt_WaveBlockStoreTypeData%CurrVyi)) then + deallocate(SeaSt_WaveBlockStoreTypeData%CurrVyi) + end if + if (allocated(SeaSt_WaveBlockStoreTypeData%zGrid)) then + deallocate(SeaSt_WaveBlockStoreTypeData%zGrid) + end if + if (allocated(SeaSt_WaveBlockStoreTypeData%xGrid)) then + deallocate(SeaSt_WaveBlockStoreTypeData%xGrid) + end if + if (allocated(SeaSt_WaveBlockStoreTypeData%yGrid)) then + deallocate(SeaSt_WaveBlockStoreTypeData%yGrid) + end if + if (allocated(SeaSt_WaveBlockStoreTypeData%CosWaveDirArr)) then + deallocate(SeaSt_WaveBlockStoreTypeData%CosWaveDirArr) + end if + if (allocated(SeaSt_WaveBlockStoreTypeData%SinWaveDirArr)) then + deallocate(SeaSt_WaveBlockStoreTypeData%SinWaveDirArr) + end if +end subroutine + +subroutine SeaSt_WaveField_PackSeaSt_WaveBlockStoreType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(SeaSt_WaveBlockStoreType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SeaSt_WaveField_PackSeaSt_WaveBlockStoreType' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, allocated(InData%Blocks)) + if (allocated(InData%Blocks)) then + call RegPackBounds(RF, 1, lbound(InData%Blocks), ubound(InData%Blocks)) + LB(1:1) = lbound(InData%Blocks) + UB(1:1) = ubound(InData%Blocks) + do i1 = LB(1), UB(1) + call SeaSt_WaveField_PackSeaSt_WaveBlockType(RF, InData%Blocks(i1)) + end do + end if + call RegPack(RF, InData%nBlkX) + call RegPack(RF, InData%nBlkY) + call RegPack(RF, InData%nBlkZ) + call RegPack(RF, InData%BlkCellsX) + call RegPack(RF, InData%BlkCellsY) + call RegPack(RF, InData%BlkCellsZ) + call RegPackAlloc(RF, InData%WaveNmbrArr) + call RegPackAlloc(RF, InData%OmegaIArr) + call RegPackAlloc(RF, InData%MCFCArr) + call RegPackAlloc(RF, InData%CurrVxi) + call RegPackAlloc(RF, InData%CurrVyi) + call RegPackAlloc(RF, InData%zGrid) + call RegPackAlloc(RF, InData%xGrid) + call RegPackAlloc(RF, InData%yGrid) + call RegPackAlloc(RF, InData%CosWaveDirArr) + call RegPackAlloc(RF, InData%SinWaveDirArr) + call RegPack(RF, InData%HasCurr) + call RegPack(RF, InData%Gravity) + call RegPack(RF, InData%SecondOrderDiff) + call RegPack(RF, InData%SecondOrderSum) + call RegPack(RF, InData%LastSweep) + call RegPack(RF, InData%nPopulated) + call RegPack(RF, InData%nEvicted) + call RegPack(RF, InData%nPeakResident) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SeaSt_WaveField_UnPackSeaSt_WaveBlockStoreType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(SeaSt_WaveBlockStoreType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SeaSt_WaveField_UnPackSeaSt_WaveBlockStoreType' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + if (allocated(OutData%Blocks)) deallocate(OutData%Blocks) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%Blocks(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Blocks.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call SeaSt_WaveField_UnpackSeaSt_WaveBlockType(RF, OutData%Blocks(i1)) ! Blocks + end do + end if + call RegUnpack(RF, OutData%nBlkX); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nBlkY); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nBlkZ); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BlkCellsX); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BlkCellsY); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BlkCellsZ); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WaveNmbrArr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%OmegaIArr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%MCFCArr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%CurrVxi); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%CurrVyi); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%zGrid); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%xGrid); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%yGrid); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%CosWaveDirArr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%SinWaveDirArr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HasCurr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Gravity); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SecondOrderDiff); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SecondOrderSum); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LastSweep); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nPopulated); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nEvicted); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nPeakResident); if (RegCheckErr(RF, RoutineName)) return +end subroutine + subroutine SeaSt_WaveField_CopySeaSt_WaveFieldType(SrcSeaSt_WaveFieldTypeData, DstSeaSt_WaveFieldTypeData, CtrlCode, ErrStat, ErrMsg) type(SeaSt_WaveFieldType), intent(in) :: SrcSeaSt_WaveFieldTypeData type(SeaSt_WaveFieldType), intent(inout) :: DstSeaSt_WaveFieldTypeData @@ -387,6 +880,10 @@ subroutine SeaSt_WaveField_CopySeaSt_WaveFieldType(SrcSeaSt_WaveFieldTypeData, D DstSeaSt_WaveFieldTypeData%NStepWave2 = SrcSeaSt_WaveFieldTypeData%NStepWave2 DstSeaSt_WaveFieldTypeData%GridDepth = SrcSeaSt_WaveFieldTypeData%GridDepth DstSeaSt_WaveFieldTypeData%WaveTimeShift = SrcSeaSt_WaveFieldTypeData%WaveTimeShift + DstSeaSt_WaveFieldTypeData%WvKinBlockMod = SrcSeaSt_WaveFieldTypeData%WvKinBlockMod + DstSeaSt_WaveFieldTypeData%WvKinBlockSize = SrcSeaSt_WaveFieldTypeData%WvKinBlockSize + DstSeaSt_WaveFieldTypeData%WvKinBlockFreeT = SrcSeaSt_WaveFieldTypeData%WvKinBlockFreeT + DstSeaSt_WaveFieldTypeData%BlockStore => SrcSeaSt_WaveFieldTypeData%BlockStore call Current_CopyInitInput(SrcSeaSt_WaveFieldTypeData%Current_InitInput, DstSeaSt_WaveFieldTypeData%Current_InitInput, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return @@ -451,6 +948,7 @@ subroutine SeaSt_WaveField_DestroySeaSt_WaveFieldType(SeaSt_WaveFieldTypeData, E deallocate(SeaSt_WaveFieldTypeData%WaveDirArr) end if nullify(SeaSt_WaveFieldTypeData%CurrField) + nullify(SeaSt_WaveFieldTypeData%BlockStore) call Current_DestroyInitInput(SeaSt_WaveFieldTypeData%Current_InitInput, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine @@ -510,6 +1008,16 @@ subroutine SeaSt_WaveField_PackSeaSt_WaveFieldType(RF, Indata) call RegPack(RF, InData%NStepWave2) call RegPack(RF, InData%GridDepth) call RegPack(RF, InData%WaveTimeShift) + call RegPack(RF, InData%WvKinBlockMod) + call RegPack(RF, InData%WvKinBlockSize) + call RegPack(RF, InData%WvKinBlockFreeT) + call RegPack(RF, associated(InData%BlockStore)) + if (associated(InData%BlockStore)) then + call RegPackPointer(RF, c_loc(InData%BlockStore), PtrInIndex) + if (.not. PtrInIndex) then + call SeaSt_WaveField_PackSeaSt_WaveBlockStoreType(RF, InData%BlockStore) + end if + end if call Current_PackInitInput(RF, InData%Current_InitInput) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -584,6 +1092,27 @@ subroutine SeaSt_WaveField_UnPackSeaSt_WaveFieldType(RF, OutData) call RegUnpack(RF, OutData%NStepWave2); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%GridDepth); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%WaveTimeShift); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WvKinBlockMod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WvKinBlockSize); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WvKinBlockFreeT); if (RegCheckErr(RF, RoutineName)) return + if (associated(OutData%BlockStore)) deallocate(OutData%BlockStore) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackPointer(RF, Ptr, PtrIdx); if (RegCheckErr(RF, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%BlockStore) + else + allocate(OutData%BlockStore,stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlockStore.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + RF%Pointers(PtrIdx) = c_loc(OutData%BlockStore) + call SeaSt_WaveField_UnpackSeaSt_WaveBlockStoreType(RF, OutData%BlockStore) ! BlockStore + end if + else + OutData%BlockStore => null() + end if call Current_UnpackInitInput(RF, OutData%Current_InitInput) ! Current_InitInput end subroutine diff --git a/modules/seastate/src/SeaState.f90 b/modules/seastate/src/SeaState.f90 index f57de4396e..80e6c5e1d0 100644 --- a/modules/seastate/src/SeaState.f90 +++ b/modules/seastate/src/SeaState.f90 @@ -91,8 +91,9 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init TYPE(SeaSt_InputFile) :: InputFileData !< Data from input file TYPE(FileInfoType) :: InFileInfo !< The derived type for holding the full input file for parsing -- we may pass this in the future TYPE(Waves_InitOutputType) :: Waves_InitOut ! Initialization Outputs from the Waves submodule initialization - TYPE(Waves2_InitOutputType) :: Waves2_InitOut ! Initialization Outputs from the Waves2 submodule initialization TYPE(Current_InitOutputType) :: Current_InitOut ! Initialization Outputs from the Current module initialization + TYPE(SeaSt_WaveBlockStoreType), TARGET :: W2LocalSeeds ! Mode-0 local store for the second-order kernel seeds (grid coordinates, gravity, mode flags) + TYPE(SeaSt_WaveBlockStoreType), POINTER:: W2Seeds ! Seeds for the second-order kernel: the block store (WvKinBlockMod=1) or the local store above INTEGER :: I ! Generic counters INTEGER :: it ! Generic counters REAL(ReKi) :: TmpElev ! temporary wave elevation @@ -182,9 +183,32 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init InputFileData%Waves%PtfmLocationX = InitInp%PtfmLocationX InputFileData%Waves%PtfmLocationY = InitInp%PtfmLocationY - ! Initialize Waves module (Note that this may change InputFileData%Waves%WaveDT) + ! Set up the on-demand wave-kinematics block store (WvKinBlockMod=1): owned by the misc vars and exposed to the + ! wave-field accessors through a non-owning pointer. Must be wired before Waves_Init so that VariousWaves_Init + ! can capture the per-frequency generation seeds as it computes them. + if ( p%WaveField%WvKinBlockMod == 1_IntKi ) then + if ( InputFileData%WaveMod == WaveMod_None ) then + call WrScr ( ' WvKinBlockMod=1 has no benefit in still water (WaveMod=0); using full-domain arrays.' ) + p%WaveField%WvKinBlockMod = 0_IntKi + else if ( InitInp%WrWvKinMod == 2 ) then + call WrScr ( ' WvKinBlockMod=1 cannot be used with full-field wave-kinematics file output (WrWvKinMod=2); using full-domain arrays.' ) + p%WaveField%WvKinBlockMod = 0_IntKi + end if + end if + if ( p%WaveField%WvKinBlockMod == 1_IntKi ) then + allocate( m%WaveBlockStore, STAT=ErrStat2 ) + if ( ErrStat2 /= 0 ) then + call SetErrStat( ErrID_Fatal, 'Error allocating m%WaveBlockStore.', ErrStat, ErrMsg, RoutineName ) + return + end if + p%WaveField%BlockStore => m%WaveBlockStore + end if + + ! Initialize Waves module, which also captures the block-store generation seeds when WvKinBlockMod=1 + ! (Note that this may change InputFileData%Waves%WaveDT) CALL Waves_Init(InputFileData%Waves, Waves_InitOut, p%WaveField, ErrStat2, ErrMsg2 ); if(Failed()) return; - + + ! Store the WaveTimeShift p%WaveField%WaveTimeShift = InitInp%WaveTimeShift if (p%WaveField%WaveTimeShift < 0.0_DbKi) then @@ -233,34 +257,27 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init ! Initialize Waves2 module !---------------------------------- IF (InputFileData%Waves2%WvDiffQTFF .OR. InputFileData%Waves2%WvSumQTFF ) THEN - CALL Waves2_Init(InputFileData%Waves2, Waves2_InitOut, p%WaveField, ErrStat2, ErrMsg2 ); if(Failed()) return; - - ! The acceleration, velocity, and dynamic pressures will get added to the parts passed to the morrison module later... - ! Difference frequency results - IF ( InputFileData%Waves2%WvDiffQTFF ) THEN - ! Dynamic pressure -- difference frequency terms ! WaveDynP = WaveDynP + WaveDynP2D - CALL AddArrays_4D(p%WaveField%WaveDynP, Waves2_InitOut%WaveDynP2D,'WaveDynP_D', ErrStat2, ErrMsg2); if(Failed()) return; - - ! Particle velocity -- difference frequency terms ! WaveVel = WaveVel + WaveVel2D - CALL AddArrays_5D(p%WaveField%WaveVel, Waves2_InitOut%WaveVel2D,'WaveVel_D', ErrStat2, ErrMsg2); if(Failed()) return; - - ! Particle acceleration -- difference frequency terms ! WaveAcc = WaveAcc + WaveAcc2D - CALL AddArrays_5D(p%WaveField%WaveAcc, Waves2_InitOut%WaveAcc2D,'WaveAcc_D', ErrStat2, ErrMsg2); if(Failed()) return; - ENDIF ! second order wave kinematics difference frequency results - - ! Sum frequency results - IF ( InputFileData%Waves2%WvSumQTFF ) THEN - ! Dynamic pressure -- sum frequency terms ! WaveDynP = WaveDynP + WaveDynP2S - CALL AddArrays_4D(p%WaveField%WaveDynP, Waves2_InitOut%WaveDynP2S,'WaveDynP_S', ErrStat2, ErrMsg2); if(Failed()) return; - - ! Particle velocity -- sum frequency terms ! WaveVel = WaveVel + WaveVel2S - CALL AddArrays_5D(p%WaveField%WaveVel, Waves2_InitOut%WaveVel2S,'WaveVel_S', ErrStat2, ErrMsg2); if(Failed()) return; - - ! Particle acceleration -- sum frequency terms ! WaveAcc = WaveAcc + WaveAcc2S - ! Note: MacCamy-Fuchs scaled accleration should not contain second-order contributions - CALL AddArrays_5D(p%WaveField%WaveAcc, Waves2_InitOut%WaveAcc2S,'WaveAcc_S', ErrStat2, ErrMsg2); if(Failed()) return; - ENDIF ! second order wave kinematics sum frequency results - + ! Input checks + the WaveElev2 surface correction (the second-order volume kinematics are added below) + CALL Waves2_Init(InputFileData%Waves2, p%WaveField, ErrStat2, ErrMsg2 ); if(Failed()) return; + + ! Add the second-order velocity, acceleration, and dynamic-pressure corrections into the volume arrays via + ! the shared per-column kernel (values identical per element to the former full-size InitOut temporaries + + ! AddArrays_4D/5D sequence, without the ~1x-field init memory spike). In mode 1 the seeds persist in the + ! block store so on-demand block population (which must include the second-order terms) can reuse them. + ! Note: the MacCamy-Fuchs scaled acceleration deliberately carries no second-order contributions. + IF ( ASSOCIATED(p%WaveField%BlockStore) ) THEN + W2Seeds => p%WaveField%BlockStore + ELSE + W2Seeds => W2LocalSeeds + END IF + CALL Waves2_CaptureKernelSeeds( InputFileData%Waves2, W2Seeds, ErrStat2, ErrMsg2 ); if(Failed()) return; + IF ( .NOT. ASSOCIATED(p%WaveField%BlockStore) ) THEN + CALL WaveKinKernel_AddSecondOrderColumns( p%WaveField, W2Seeds, 1, p%nGrid(1), 1, p%nGrid(2), & + 1, p%nGrid(3), & + p%WaveField%WaveDynP, p%WaveField%WaveVel, p%WaveField%WaveAcc, & + ErrStat2, ErrMsg2 ); if(Failed()) return; + END IF + ELSE ! these need to be set to zero since we don't have a UseWaves2 flag: InputFileData%Waves2%NWaveElevGrid = 0 @@ -304,6 +321,58 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init p%WaveField%VolGridParams, ErrStat2, ErrMsg2 ) if(Failed()) return; + ! Set up the XY block layout for on-demand wave-kinematics population (WvKinBlockMod=1) + IF ( ASSOCIATED(p%WaveField%BlockStore) ) THEN + CALL WaveField_BlockStore_Init( p%WaveField, ErrStat2, ErrMsg2 ); if(Failed()) return; + END IF + + ! Report the wave-kinematics memory footprint (both modes): what the full domain would cost, + ! what the eager surface arrays cost, and — in on-demand mode — the block layout that replaces + ! the full-domain volume arrays (populated lazily, so nothing is resident at init). + BLOCK + real(ReKi) :: VolGB, SurfB, BlkGB + integer(IntKi) :: nComp, nPtXt, nPtYt, nPtZt + character(16) :: sVol, sSurf, sBlk + real(ReKi), parameter :: B2GB = 1.0_ReKi / 1.0E9_ReKi + nComp = MERGE( 10_IntKi, 7_IntKi, p%WaveField%MCFD > 0.0_SiKi ) ! DynP(1)+Vel(3)+Acc(3)[+MCF(3)] + VolGB = REAL(p%WaveField%NStepWave+1,ReKi) * p%nGrid(1) * p%nGrid(2) * p%nGrid(3) * 4.0_ReKi * nComp * B2GB + SurfB = 0.0_ReKi + if (ALLOCATED(p%WaveField%WaveTime )) SurfB = SurfB + REAL(storage_size(p%WaveField%WaveTime )/8,ReKi)*size(p%WaveField%WaveTime ) + if (ALLOCATED(p%WaveField%WaveElev0 )) SurfB = SurfB + REAL(storage_size(p%WaveField%WaveElev0 )/8,ReKi)*size(p%WaveField%WaveElev0 ) + if (ALLOCATED(p%WaveField%WaveElev1 )) SurfB = SurfB + REAL(storage_size(p%WaveField%WaveElev1 )/8,ReKi)*size(p%WaveField%WaveElev1 ) + if (ALLOCATED(p%WaveField%WaveElev2 )) SurfB = SurfB + REAL(storage_size(p%WaveField%WaveElev2 )/8,ReKi)*size(p%WaveField%WaveElev2 ) + if (ALLOCATED(p%WaveField%WaveElevC )) SurfB = SurfB + REAL(storage_size(p%WaveField%WaveElevC )/8,ReKi)*size(p%WaveField%WaveElevC ) + if (ALLOCATED(p%WaveField%WaveElevC0)) SurfB = SurfB + REAL(storage_size(p%WaveField%WaveElevC0)/8,ReKi)*size(p%WaveField%WaveElevC0) + if (ALLOCATED(p%WaveField%WaveDirArr)) SurfB = SurfB + REAL(storage_size(p%WaveField%WaveDirArr)/8,ReKi)*size(p%WaveField%WaveDirArr) + if (ALLOCATED(p%WaveField%PWaveDynP0)) SurfB = SurfB + REAL(storage_size(p%WaveField%PWaveDynP0)/8,ReKi)*size(p%WaveField%PWaveDynP0) + if (ALLOCATED(p%WaveField%PWaveVel0 )) SurfB = SurfB + REAL(storage_size(p%WaveField%PWaveVel0 )/8,ReKi)*size(p%WaveField%PWaveVel0 ) + if (ALLOCATED(p%WaveField%PWaveAcc0 )) SurfB = SurfB + REAL(storage_size(p%WaveField%PWaveAcc0 )/8,ReKi)*size(p%WaveField%PWaveAcc0 ) + if (ALLOCATED(p%WaveField%PWaveAccMCF0)) SurfB = SurfB + REAL(storage_size(p%WaveField%PWaveAccMCF0)/8,ReKi)*size(p%WaveField%PWaveAccMCF0) + write(sVol ,'(F13.3)') VolGB + write(sSurf,'(F13.3)') SurfB*B2GB + call WrScr ( ' SeaState wave-kinematics memory:' ) + call WrScr ( ' Grid '//TRIM(Num2LStr(p%nGrid(1)))//' x '//TRIM(Num2LStr(p%nGrid(2)))//' x '// & + TRIM(Num2LStr(p%nGrid(3)))//' points, '//TRIM(Num2LStr(p%WaveField%NStepWave+1))// & + ' time steps, '//TRIM(Num2LStr(nComp))//' volume components' ) + call WrScr ( ' Full-domain volume data: '//TRIM(ADJUSTL(sVol))//' GB ('// & + MERGE('mode 0: allocated','mode 1: on demand',p%WaveField%WvKinBlockMod==0_IntKi)//')' ) + call WrScr ( ' Surface (eager) data: '//TRIM(ADJUSTL(sSurf))//' GB' ) + IF ( ASSOCIATED(p%WaveField%BlockStore) ) THEN + ASSOCIATE ( Store => p%WaveField%BlockStore ) + nPtXt = MIN( Store%BlkCellsX+3_IntKi, p%nGrid(1) ) ! typical interior block: BlkCells+3 stored planes + nPtYt = MIN( Store%BlkCellsY+3_IntKi, p%nGrid(2) ) + nPtZt = MIN( Store%BlkCellsZ+3_IntKi, p%nGrid(3) ) + BlkGB = REAL(p%WaveField%NStepWave+1,ReKi) * nPtXt * nPtYt * nPtZt * 4.0_ReKi * nComp * B2GB + write(sBlk,'(F13.3)') BlkGB + call WrScr ( ' [mode 1] Block layout '//TRIM(Num2LStr(Store%nBlkX))//' x '//TRIM(Num2LStr(Store%nBlkY))// & + ' x '//TRIM(Num2LStr(Store%nBlkZ))// & + ' ('//TRIM(Num2LStr(Store%BlkCellsX))//'x'//TRIM(Num2LStr(Store%BlkCellsY))// & + 'x'//TRIM(Num2LStr(Store%BlkCellsZ))// & + ' cells/block), per full block ~'//TRIM(ADJUSTL(sBlk))//' GB, populated at init: 0' ) + END ASSOCIATE + END IF + END BLOCK + IF ( p%OutSwtch == 1 ) THEN ! Only SeaSt-level output writing ! HACK WE can tell FAST not to write any SeaState outputs by simply deallocating the WriteOutputHdr array! @@ -394,7 +463,6 @@ SUBROUTINE CleanUp() ! Note: all pointers possibly allocated in Waves_init and Waves2_init are transferred to SeaSt parameters before deallocating them: CALL Waves_DestroyInitOutput( Waves_InitOut, ErrStat2, ErrMsg2 ); CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - CALL Waves2_DestroyInitOutput( Waves2_InitOut, ErrStat2, ErrMsg2 ); CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) CALL Current_DestroyInitOutput( Current_InitOut, ErrStat2, ErrMsg2);CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) @@ -558,70 +626,6 @@ logical function Failed() end function Failed end subroutine !---------------------------------------------------------------------------------------------------------------------------------- -SUBROUTINE AddArrays_4D(Array1, Array2, ArrayName, ErrStat, ErrMsg) - REAL(SiKi), INTENT(INOUT) :: Array1(:,:,:,:) - REAL(SiKi), INTENT(IN ) :: Array2(:,:,:,:) - CHARACTER(*), INTENT(IN ) :: ArrayName - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - ErrStat = ErrID_None - ErrMsg = "" - - IF ( SIZE(Array1,DIM=1) /= SIZE(Array2,DIM=1) .OR. & - SIZE(Array1,DIM=2) /= SIZE(Array2,DIM=2) .OR. & - SIZE(Array1,DIM=3) /= SIZE(Array2,DIM=3) .OR. & - SIZE(Array1,DIM=4) /= SIZE(Array2,DIM=4)) THEN - - ErrStat = ErrID_Fatal - ErrMsg = TRIM(ArrayName)//' arrays for first and second order wave elevations are of different sizes: '//NewLine// & - 'Waves: '// TRIM(Num2LStr(SIZE(Array1,DIM=1)))//'x'// & - TRIM(Num2LStr(SIZE(Array1,DIM=2)))//'x'// & - TRIM(Num2LStr(SIZE(Array1,DIM=3)))//'x'// & - TRIM(Num2LStr(SIZE(Array1,DIM=4)))//NewLine// & - 'Waves2: '// TRIM(Num2LStr(SIZE(Array2,DIM=1)))//'x'// & - TRIM(Num2LStr(SIZE(Array2,DIM=2)))//'x'// & - TRIM(Num2LStr(SIZE(Array2,DIM=3)))//'x'// & - TRIM(Num2LStr(SIZE(Array2,DIM=4))) - ELSE - Array1 = Array1 + Array2 - ENDIF - -END SUBROUTINE AddArrays_4D -!---------------------------------------------------------------------------------------------------------------------------------- -SUBROUTINE AddArrays_5D(Array1, Array2, ArrayName, ErrStat, ErrMsg) - REAL(SiKi), INTENT(INOUT) :: Array1(:,:,:,:,:) - REAL(SiKi), INTENT(IN ) :: Array2(:,:,:,:,:) - CHARACTER(*), INTENT(IN ) :: ArrayName - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - - IF ( SIZE(Array1,DIM=1) /= SIZE(Array2,DIM=1) .OR. & - SIZE(Array1,DIM=2) /= SIZE(Array2,DIM=2) .OR. & - SIZE(Array1,DIM=3) /= SIZE(Array2,DIM=3) .OR. & - SIZE(Array1,DIM=4) /= SIZE(Array2,DIM=4) .OR. & - SIZE(Array1,DIM=5) /= SIZE(Array2,DIM=5)) THEN - - ErrStat = ErrID_Fatal - ErrMsg = TRIM(ArrayName)//' arrays for first and second order wave elevations are of different sizes: '//NewLine// & - 'Waves: '// TRIM(Num2LStr(SIZE(Array1,DIM=1)))//'x'// & - TRIM(Num2LStr(SIZE(Array1,DIM=2)))//'x'// & - TRIM(Num2LStr(SIZE(Array1,DIM=3)))//'x'// & - TRIM(Num2LStr(SIZE(Array1,DIM=4)))//'x'// & - TRIM(Num2LStr(SIZE(Array1,DIM=5)))//NewLine// & - 'Waves2: '// TRIM(Num2LStr(SIZE(Array2,DIM=1)))//'x'// & - TRIM(Num2LStr(SIZE(Array2,DIM=2)))//'x'// & - TRIM(Num2LStr(SIZE(Array2,DIM=3)))//'x'// & - TRIM(Num2LStr(SIZE(Array2,DIM=4)))//'x'// & - TRIM(Num2LStr(SIZE(Array2,DIM=5))) - ELSE - ErrStat = ErrID_None - ErrMsg = "" - Array1 = Array1 + Array2 - ENDIF - -END SUBROUTINE AddArrays_5D !---------------------------------------------------------------------------------------------------------------------------------- !> This routine is called at the end of the simulation. SUBROUTINE SeaSt_End( u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) diff --git a/modules/seastate/src/SeaState.txt b/modules/seastate/src/SeaState.txt index 10da071ba5..51fe9b5d6e 100644 --- a/modules/seastate/src/SeaState.txt +++ b/modules/seastate/src/SeaState.txt @@ -31,6 +31,9 @@ typedef ^ ^ ReKi Z_Depth typedef ^ ^ INTEGER NX - - - "Number of nodes in half of the X-direction domain" typedef ^ ^ INTEGER NY - - - "Number of nodes in half of the Y-direction domain" typedef ^ ^ INTEGER NZ - - - "Number of nodes in half of the Z-direction domain" +typedef ^ ^ INTEGER WvKinBlockMod - - - "Wave kinematics volume-data mode {0: precompute full domain, 1: on-demand block partitioning} (switch)" - +typedef ^ ^ ReKi WvKinBlockSize - - - "Target edge length of an on-demand cube block, snapped to whole grid cells [used only when WvKinBlockMod=1]" (m) +typedef ^ ^ DbKi WvKinBlockFreeT - - - "Free a block after this much simulation time without an access; <=0 disables freeing [used only when WvKinBlockMod=1]" (s) typedef ^ ^ Waves_InitInputType Waves - - - "Initialization data for Waves module" - typedef ^ ^ Waves2_InitInputType Waves2 - - - "Initialization data for Waves2 module" - typedef ^ ^ Current_InitInputType Current - - - "Initialization data for Current module" - @@ -169,6 +172,7 @@ typedef ^ MiscVarType INTEGER typedef ^ ^ DbKi LastOutTime - - - "Last time step which was written to the output file (sec)" - typedef ^ ^ INTEGER LastIndWave - - - "The last index used in the wave kinematics arrays, used to optimize interpolation" - typedef ^ ^ GridInterp_MiscVarType WaveField_m - - - "misc var information from the SeaState Interpolation module" - +typedef ^ ^ SeaSt_WaveBlockStoreType &WaveBlockStore - - - "On-demand wave-kinematics block store (allocated only when WvKinBlockMod=1; WaveField%BlockStore points here)" - # .... Linearization ....................................................................................................... typedef ^ ^ ModJacType Jac - - - "Values corresponding to module variables" - diff --git a/modules/seastate/src/SeaState_DriverCode.f90 b/modules/seastate/src/SeaState_DriverCode.f90 index f1ae3fb7a0..d2be2aaaf3 100644 --- a/modules/seastate/src/SeaState_DriverCode.f90 +++ b/modules/seastate/src/SeaState_DriverCode.f90 @@ -28,6 +28,7 @@ program SeaStateDriver use SeaState_Output use ModMesh_Types use VersionInfo + USE SeaSt_WaveField, ONLY: WaveField_WriteBlockVTK implicit none @@ -45,6 +46,7 @@ program SeaStateDriver logical :: WaveElevVis !< Should we put together a wave elevation series and save it to file? integer(IntKi) :: WaveElevVisNx !< Number of points in the X direction for the wave elevation series (-) integer(IntKi) :: WaveElevVisNy !< Number of points in the X direction for the wave elevation series (-) + integer(IntKi) :: WrBlockVTK !< Write wave-block VTK every N steps; 0=off (optional trailing input) end type SeaSt_Drvr_InitInput ! ----------------------------------------------------------------------------------- @@ -88,7 +90,9 @@ program SeaStateDriver real(R8Ki) :: dcm (3,3) ! The resulting transformation matrix from X to x, (-). character(1024) :: drvrFilename ! Filename and path for the driver input file. This is passed in as a command line argument when running the Driver exe. type(SeaSt_Drvr_InitInput) :: drvrInitInp ! Initialization data for the driver program - + integer(IntKi) :: BlkVTKFrame = 0 ! Frame counter for wave-block VTK series + integer(IntKi) :: BlkVTKtWidth ! Width of the zero-padded frame number in wave-block VTK filenames + integer :: StrtTime (8) ! Start time of simulation (including initialization) integer :: SimStrtTime (8) ! Start time of simulation (after initialization) real(ReKi) :: PrevClockTime ! Clock time at start of simulation in seconds @@ -231,7 +235,8 @@ program SeaStateDriver ! loop through time steps - + BlkVTKtWidth = MAX( 4_IntKi, CEILING( LOG10( REAL(drvrInitInp%NSteps,ReKi) + 1.0_ReKi ) ) ) + do n = 1, drvrInitInp%NSteps Time = (n-1) * drvrInitInp%TimeInterval @@ -244,8 +249,17 @@ program SeaStateDriver ! Clean up and exit call SeaSt_DvrCleanup() end if - - + + if ( drvrInitInp%WrBlockVTK > 0 ) then + if ( mod( n-1, drvrInitInp%WrBlockVTK ) == 0 ) then + call WaveField_WriteBlockVTK ( Time, p%WaveField, trim(drvrInitInp%OutRootName), & + BlkVTKFrame, BlkVTKtWidth, ErrStat, ErrMsg ) + if (ErrStat /= ErrID_None) call WrScr( trim(ErrMsg) ) + BlkVTKFrame = BlkVTKFrame + 1 + end if + end if + + if ( MOD( n + 1, n_SttsTime ) == 0 ) then call SimStatus( TiLstPrn, PrevClockTime, time, InitInData%TMax ) @@ -330,7 +344,10 @@ SUBROUTINE ReadDriverInputFile( inputFile, InitInp, ErrStat, ErrMsg ) real(ReKi) :: TmpRealVar2(2) !< Temporary real array size 2 integer(IntKi) :: TmpIntVar2(2) !< Temporary integer array size 2 - + integer(IntKi) :: ErrStatTmp !< Local error status for optional trailing inputs + character(ErrMsgLen) :: ErrMsgTmp !< Local error message for optional trailing inputs + + ! Initialize the echo file unit to -1 which is the default to prevent echoing, we will alter this based on user input UnEchoLocal = -1 @@ -598,6 +615,11 @@ SUBROUTINE ReadDriverInputFile( inputFile, InitInp, ErrStat, ErrMsg ) ! return ! end if + !> WrBlockVTK -- optional trailing input: write wave-block VTK every N steps (0=off). + ! Old driver files end before this line; treat any read failure as "absent" => 0. + InitInp%WrBlockVTK = 0 + call ReadVar ( UnIn, FileName, InitInp%WrBlockVTK, 'WrBlockVTK', 'Wave-block VTK interval', ErrStatTmp, ErrMsgTmp, UnEchoLocal ) + if ( ErrStatTmp /= ErrID_None ) InitInp%WrBlockVTK = 0 if (InitInp%Echo .and. UnEchoLocal>0) close(UnEchoLocal) close( UnIn ) diff --git a/modules/seastate/src/SeaState_Input.f90 b/modules/seastate/src/SeaState_Input.f90 index c5c5147582..1ba49ea511 100644 --- a/modules/seastate/src/SeaState_Input.f90 +++ b/modules/seastate/src/SeaState_Input.f90 @@ -137,6 +137,18 @@ subroutine SeaSt_ParseInput( InputFileName, OutRootName, defWtrDens, defWtrDpth, call ParseVar( FileInfo_In, CurLine, 'NZ', InputFileData%NZ, ErrStat2, ErrMsg2, UnEc ) if (Failed()) return; + ! WvKinBlockMod - Wave kinematics volume-data mode. + call ParseVar( FileInfo_In, CurLine, 'WvKinBlockMod', InputFileData%WvKinBlockMod, ErrStat2, ErrMsg2, UnEc ) + if (Failed()) return; + + ! WvKinBlockSize - Target edge length of an on-demand cube block. + call ParseVarWDefault ( FileInfo_In, CurLine, 'WvKinBlockSize', InputFileData%WvKinBlockSize, 100.0_ReKi, ErrStat2, ErrMsg2, UnEc ) + if (Failed()) return; + + ! WvKinBlockFreeT - Idle simulation time after which an on-demand block is freed. + call ParseVarWDefault ( FileInfo_In, CurLine, 'WvKinBlockFreeT', InputFileData%WvKinBlockFreeT, 600.0_DbKi, ErrStat2, ErrMsg2, UnEc ) + if (Failed()) return; + !------------------------------------------------------------------------------------------------- ! Data section for waves !------------------------------------------------------------------------------------------------- @@ -584,6 +596,22 @@ subroutine SeaStateInput_ProcessInitData( InitInp, p, InputFileData, ErrStat, Er return end if + ! WvKinBlockMod - Wave kinematics volume-data mode + if ( InputFileData%WvKinBlockMod /= 0_IntKi .and. InputFileData%WvKinBlockMod /= 1_IntKi ) then + call SetErrStat( ErrID_Fatal,'WvKinBlockMod must be 0 (precompute full domain) or 1 (on-demand block partitioning).',ErrStat,ErrMsg,RoutineName) + return + end if + if ( InputFileData%WvKinBlockMod == 1_IntKi ) then + if ( InputFileData%WvKinBlockSize <= 0.0_ReKi ) then + call SetErrStat( ErrID_Fatal,'WvKinBlockSize must be greater than zero when WvKinBlockMod=1.',ErrStat,ErrMsg,RoutineName) + return + end if + if ( InputFileData%WaveMod == WaveMod_ExtFull ) then + call SetErrStat( ErrID_Fatal,'WvKinBlockMod=1 cannot be used with WaveMod=6 (externally generated full wave-kinematics data).',ErrStat,ErrMsg,RoutineName) + return + end if + end if + ! WaveMod - Wave kinematics model switch. SELECT CASE(InputFileData%WaveMod) @@ -1178,6 +1206,10 @@ subroutine SeaStateInput_ProcessInitData( InitInp, p, InputFileData, ErrStat, Er p%WaveField%WaveMultiDir = InputFileData%WaveMultiDir p%WaveField%MCFD = InputFileData%MCFD + p%WaveField%WvKinBlockMod = InputFileData%WvKinBlockMod + p%WaveField%WvKinBlockSize = InputFileData%WvKinBlockSize + p%WaveField%WvKinBlockFreeT = InputFileData%WvKinBlockFreeT + p%WaveField%WvLowCOff = InputFileData%WvLowCOff p%WaveField%WvHiCOff = InputFileData%WvHiCOff p%WaveField%WvLowCOffD = InputFileData%WvLowCOffD diff --git a/modules/seastate/src/SeaState_Types.f90 b/modules/seastate/src/SeaState_Types.f90 index b15181ef0c..43a220c123 100644 --- a/modules/seastate/src/SeaState_Types.f90 +++ b/modules/seastate/src/SeaState_Types.f90 @@ -49,6 +49,9 @@ MODULE SeaState_Types INTEGER(IntKi) :: NX = 0_IntKi !< Number of nodes in half of the X-direction domain [-] INTEGER(IntKi) :: NY = 0_IntKi !< Number of nodes in half of the Y-direction domain [-] INTEGER(IntKi) :: NZ = 0_IntKi !< Number of nodes in half of the Z-direction domain [-] + INTEGER(IntKi) :: WvKinBlockMod = 0_IntKi !< Wave kinematics volume-data mode {0: precompute full domain, 1: on-demand block partitioning} (switch) [-] + REAL(ReKi) :: WvKinBlockSize = 0.0_ReKi !< Target edge length of an on-demand cube block, snapped to whole grid cells [used only when WvKinBlockMod=1] [(m)] + REAL(DbKi) :: WvKinBlockFreeT = 0.0_R8Ki !< Free a block after this much simulation time without an access; <=0 disables freeing [used only when WvKinBlockMod=1] [(s)] TYPE(Waves_InitInputType) :: Waves !< Initialization data for Waves module [-] TYPE(Waves2_InitInputType) :: Waves2 !< Initialization data for Waves2 module [-] TYPE(Current_InitInputType) :: Current !< Initialization data for Current module [-] @@ -185,6 +188,7 @@ MODULE SeaState_Types REAL(DbKi) :: LastOutTime = 0.0_R8Ki !< Last time step which was written to the output file (sec) [-] INTEGER(IntKi) :: LastIndWave = 0_IntKi !< The last index used in the wave kinematics arrays, used to optimize interpolation [-] TYPE(GridInterp_MiscVarType) :: WaveField_m !< misc var information from the SeaState Interpolation module [-] + TYPE(SeaSt_WaveBlockStoreType) , POINTER :: WaveBlockStore => NULL() !< On-demand wave-kinematics block store (allocated only when WvKinBlockMod=1; WaveField%BlockStore points here) [-] TYPE(ModJacType) :: Jac !< Values corresponding to module variables [-] TYPE(SeaSt_InputType) :: u_perturb !< Input type for linearization perturbation [-] TYPE(SeaSt_OutputType) :: y_lin !< Output type for linearization perturbation [-] @@ -216,6 +220,9 @@ subroutine SeaSt_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, Err DstInputFileData%NX = SrcInputFileData%NX DstInputFileData%NY = SrcInputFileData%NY DstInputFileData%NZ = SrcInputFileData%NZ + DstInputFileData%WvKinBlockMod = SrcInputFileData%WvKinBlockMod + DstInputFileData%WvKinBlockSize = SrcInputFileData%WvKinBlockSize + DstInputFileData%WvKinBlockFreeT = SrcInputFileData%WvKinBlockFreeT call Waves_CopyInitInput(SrcInputFileData%Waves, DstInputFileData%Waves, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return @@ -372,6 +379,9 @@ subroutine SeaSt_PackInputFile(RF, Indata) call RegPack(RF, InData%NX) call RegPack(RF, InData%NY) call RegPack(RF, InData%NZ) + call RegPack(RF, InData%WvKinBlockMod) + call RegPack(RF, InData%WvKinBlockSize) + call RegPack(RF, InData%WvKinBlockFreeT) call Waves_PackInitInput(RF, InData%Waves) call Waves2_PackInitInput(RF, InData%Waves2) call Current_PackInitInput(RF, InData%Current) @@ -425,6 +435,9 @@ subroutine SeaSt_UnPackInputFile(RF, OutData) call RegUnpack(RF, OutData%NX); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%NY); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%NZ); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WvKinBlockMod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WvKinBlockSize); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WvKinBlockFreeT); if (RegCheckErr(RF, RoutineName)) return call Waves_UnpackInitInput(RF, OutData%Waves) ! Waves call Waves2_UnpackInitInput(RF, OutData%Waves2) ! Waves2 call Current_UnpackInitInput(RF, OutData%Current) ! Current @@ -1298,6 +1311,7 @@ subroutine SeaSt_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(0), UB(0) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SeaSt_CopyMisc' @@ -1309,6 +1323,18 @@ subroutine SeaSt_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) call GridInterp_CopyMisc(SrcMiscData%WaveField_m, DstMiscData%WaveField_m, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return + if (associated(SrcMiscData%WaveBlockStore)) then + if (.not. associated(DstMiscData%WaveBlockStore)) then + allocate(DstMiscData%WaveBlockStore, stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%WaveBlockStore.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + call SeaSt_WaveField_CopySeaSt_WaveBlockStoreType(SrcMiscData%WaveBlockStore, DstMiscData%WaveBlockStore, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end if call NWTC_Library_CopyModJacType(SrcMiscData%Jac, DstMiscData%Jac, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return @@ -1331,6 +1357,12 @@ subroutine SeaSt_DestroyMisc(MiscData, ErrStat, ErrMsg) ErrMsg = '' call GridInterp_DestroyMisc(MiscData%WaveField_m, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (associated(MiscData%WaveBlockStore)) then + call SeaSt_WaveField_DestroySeaSt_WaveBlockStoreType(MiscData%WaveBlockStore, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + deallocate(MiscData%WaveBlockStore) + MiscData%WaveBlockStore => null() + end if call NWTC_Library_DestroyModJacType(MiscData%Jac, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call SeaSt_DestroyInput(MiscData%u_perturb, ErrStat2, ErrMsg2) @@ -1343,11 +1375,19 @@ subroutine SeaSt_PackMisc(RF, Indata) type(RegFile), intent(inout) :: RF type(SeaSt_MiscVarType), intent(in) :: InData character(*), parameter :: RoutineName = 'SeaSt_PackMisc' + logical :: PtrInIndex if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, InData%Decimate) call RegPack(RF, InData%LastOutTime) call RegPack(RF, InData%LastIndWave) call GridInterp_PackMisc(RF, InData%WaveField_m) + call RegPack(RF, associated(InData%WaveBlockStore)) + if (associated(InData%WaveBlockStore)) then + call RegPackPointer(RF, c_loc(InData%WaveBlockStore), PtrInIndex) + if (.not. PtrInIndex) then + call SeaSt_WaveField_PackSeaSt_WaveBlockStoreType(RF, InData%WaveBlockStore) + end if + end if call NWTC_Library_PackModJacType(RF, InData%Jac) call SeaSt_PackInput(RF, InData%u_perturb) call SeaSt_PackOutput(RF, InData%y_lin) @@ -1358,11 +1398,34 @@ subroutine SeaSt_UnPackMisc(RF, OutData) type(RegFile), intent(inout) :: RF type(SeaSt_MiscVarType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SeaSt_UnPackMisc' + integer(B4Ki) :: LB(0), UB(0) + integer(IntKi) :: stat + logical :: IsAllocAssoc + integer(B8Ki) :: PtrIdx + type(c_ptr) :: Ptr if (RF%ErrStat /= ErrID_None) return call RegUnpack(RF, OutData%Decimate); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%LastOutTime); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%LastIndWave); if (RegCheckErr(RF, RoutineName)) return call GridInterp_UnpackMisc(RF, OutData%WaveField_m) ! WaveField_m + if (associated(OutData%WaveBlockStore)) deallocate(OutData%WaveBlockStore) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackPointer(RF, Ptr, PtrIdx); if (RegCheckErr(RF, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%WaveBlockStore) + else + allocate(OutData%WaveBlockStore,stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveBlockStore.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + RF%Pointers(PtrIdx) = c_loc(OutData%WaveBlockStore) + call SeaSt_WaveField_UnpackSeaSt_WaveBlockStoreType(RF, OutData%WaveBlockStore) ! WaveBlockStore + end if + else + OutData%WaveBlockStore => null() + end if call NWTC_Library_UnpackModJacType(RF, OutData%Jac) ! Jac call SeaSt_UnpackInput(RF, OutData%u_perturb) ! u_perturb call SeaSt_UnpackOutput(RF, OutData%y_lin) ! y_lin diff --git a/modules/seastate/src/UserWaves.f90 b/modules/seastate/src/UserWaves.f90 index 454ad5ca7c..5c5aa0bcdb 100644 --- a/modules/seastate/src/UserWaves.f90 +++ b/modules/seastate/src/UserWaves.f90 @@ -65,9 +65,13 @@ SUBROUTINE Initial_InitOut_Arrays(InitOut, WaveField, InitInp, WaveDT, ErrStat, ALLOCATE ( WaveField%WaveDirArr ( 0:WaveField%NStepWave2 ) , STAT=ErrStat2 ); IF (ErrStat2 /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveField%WaveDirArr.',ErrStat, ErrMsg, RoutineName) ALLOCATE ( WaveField%WaveElev1(0:WaveField%NStepWave,InitInp%NGrid(1),InitInp%NGrid(2) ), STAT=ErrStat2 ); IF (ErrStat2 /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveField%WaveElev1.', ErrStat,ErrMsg,RoutineName) + IF ( .NOT. ASSOCIATED(WaveField%BlockStore) ) THEN + ! Full-domain volume arrays. With on-demand block partitioning (WvKinBlockMod=1) these stay + ! unallocated -- the kinematics live in per-block arrays populated on first access. ALLOCATE ( WaveField%WaveDynP (0:WaveField%NStepWave,InitInp%NGrid(1),InitInp%NGrid(2),InitInp%NGrid(3) ), STAT=ErrStat2 ); IF (ErrStat2 /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveField%WaveDynP.', ErrStat,ErrMsg,RoutineName) ALLOCATE ( WaveField%WaveVel (0:WaveField%NStepWave,InitInp%NGrid(1),InitInp%NGrid(2),InitInp%NGrid(3),3), STAT=ErrStat2 ); IF (ErrStat2 /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveField%WaveVel.', ErrStat,ErrMsg,RoutineName) ALLOCATE ( WaveField%WaveAcc (0:WaveField%NStepWave,InitInp%NGrid(1),InitInp%NGrid(2),InitInp%NGrid(3),3), STAT=ErrStat2 ); IF (ErrStat2 /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveField%WaveAcc.', ErrStat,ErrMsg,RoutineName) + END IF if (ErrStat >= AbortErrLev) return @@ -87,9 +91,11 @@ SUBROUTINE Initial_InitOut_Arrays(InitOut, WaveField, InitInp, WaveDT, ErrStat, WaveField%WaveElevC = 0.0 WaveField%WaveElevC0 = 0.0 WaveField%WaveElev1 = 0.0 - WaveField%WaveDynP = 0.0 - WaveField%WaveVel = 0.0 - WaveField%WaveAcc = 0.0 + IF ( .NOT. ASSOCIATED(WaveField%BlockStore) ) THEN + WaveField%WaveDynP = 0.0 + WaveField%WaveVel = 0.0 + WaveField%WaveAcc = 0.0 + END IF WaveField%WaveDirArr = 0.0 ! scalars (adjusted later, if necessary) diff --git a/modules/seastate/src/Waves.f90 b/modules/seastate/src/Waves.f90 index a965549971..280d2bc408 100644 --- a/modules/seastate/src/Waves.f90 +++ b/modules/seastate/src/Waves.f90 @@ -47,6 +47,7 @@ MODULE Waves PRIVATE:: BoxMuller PRIVATE:: JONSWAP PUBLIC :: WaveNumber + PUBLIC :: WaveKinKernel_ComputeColumns ! Shared per-column wave-kinematics generation kernel (mode 0 full-domain fill + mode 1 block population) PRIVATE:: UserWaveSpctrm PRIVATE:: StillWaterWaves_Init PRIVATE:: VariousWaves_Init @@ -710,14 +711,6 @@ SUBROUTINE VariousWaves_Init ( InitInp, InitOut, WaveField, ErrStat, ErrMsg ) COMPLEX(SiKi), ALLOCATABLE :: PWaveVelC0HxiPz0(:,:) ! Partial derivative of WaveVelC0Hxi(:) with respect to zi at zi = 0 (1/s ) COMPLEX(SiKi), ALLOCATABLE :: PWaveVelC0HyiPz0(:,:) ! Partial derivative of WaveVelC0Hyi(:) with respect to zi at zi = 0 (1/s ) COMPLEX(SiKi), ALLOCATABLE :: PWaveVelC0VPz0(:,:) ! Partial derivative of WaveVelC0V (:) with respect to zi at zi = 0 (1/s ) - COMPLEX(SiKi), ALLOCATABLE :: WaveAccC0Hxi(:,:) ! Discrete Fourier transform of the instantaneous horizontal acceleration in x-direction of incident waves before applying stretching at the zi-coordinates for points (m/s^2) - COMPLEX(SiKi), ALLOCATABLE :: WaveAccC0Hyi(:,:) ! Discrete Fourier transform of the instantaneous horizontal acceleration in y-direction of incident waves before applying stretching at the zi-coordinates for points (m/s^2) - COMPLEX(SiKi), ALLOCATABLE :: WaveAccC0V(:,:) ! Discrete Fourier transform of the instantaneous vertical acceleration of incident waves before applying stretching at the zi-coordinates for points (m/s^2) - COMPLEX(SiKi), ALLOCATABLE :: WaveDynPC0(:,:) ! Discrete Fourier transform of the instantaneous dynamic pressure of incident waves before applying stretching at the zi-coordinates for points (N/m^2) - COMPLEX(SiKi), ALLOCATABLE :: WaveVelC0Hxi(:,:) ! Discrete Fourier transform of the instantaneous horizontal velocity of incident waves before applying stretching at the zi-coordinates for points (m/s) - COMPLEX(SiKi), ALLOCATABLE :: WaveVelC0Hyi(:,:) ! Discrete Fourier transform of the instantaneous horizontal velocity in x-direction of incident waves before applying stretching at the zi-coordinates for points (m/s) - COMPLEX(SiKi), ALLOCATABLE :: WaveVelC0V(:,:) ! Discrete Fourier transform of the instantaneous vertical velocity in y-direction of incident waves before applying stretching at the zi-coordinates for points (m/s) - REAL(SiKi), ALLOCATABLE :: CosWaveDir(:) ! COS( WaveDirArr(I) ) -- Each wave frequency has a unique wave direction. REAL(SiKi), ALLOCATABLE :: GHWaveAcc (:,:) ! Instantaneous acceleration of incident waves in the xi-(1), yi-(2), and zi-(3) directions, respectively, at each of the GHNWvDpth vertical locations in GH Bladed wave data files (m/s^2) REAL(SiKi), ALLOCATABLE :: GHWaveDynP(: ) ! Instantaneous dynamic pressure of incident waves at each of the GHNWvDpth vertical locations in GH Bladed wave data files (N/m^2) @@ -733,22 +726,17 @@ SUBROUTINE VariousWaves_Init ( InitInp, InitOut, WaveField, ErrStat, ErrMsg ) REAL(SiKi), ALLOCATABLE :: PWaveVel0VPz0 (:,:) ! Partial derivative of WaveVel0V (:) with respect to zi at zi = 0 (1/s ) REAL(SiKi), ALLOCATABLE :: SinWaveDir (:) ! SIN( WaveDirArr(I) ) - REAL(SiKi), ALLOCATABLE :: WaveAcc0Hxi (:,:) ! Instantaneous horizontal acceleration in x-direction of incident waves before applying stretching at the zi-coordinates for points (m/s^2) - REAL(SiKi), ALLOCATABLE :: WaveAcc0Hyi (:,:) ! Instantaneous horizontal acceleration in y-direction of incident waves before applying stretching at the zi-coordinates for points (m/s^2) - REAL(SiKi), ALLOCATABLE :: WaveAcc0V (:,:) ! Instantaneous vertical acceleration of incident waves before applying stretching at the zi-coordinates for points (m/s^2) - REAL(SiKi), ALLOCATABLE :: WaveDynP0B(:,:) ! Instantaneous dynamic pressure of incident waves before applying stretching at the zi-coordinates for points (N/m^2) COMPLEX(SiKi) :: WaveElevxiPrime0 - REAL(SiKi), ALLOCATABLE :: WaveKinzi0Prime(:) ! zi-coordinates for points where the incident wave kinematics will be computed before applying stretching; these are relative to the mean see level (meters) - INTEGER , ALLOCATABLE :: WaveKinPrimeMap(:) REAL(SiKi) :: OmegaI ! Wave intrinsic frequency (rad/sec) REAL(SiKi) :: WaveNmbr ! Wavenumber of the current frequency component (1/meter) - REAL(SiKi), ALLOCATABLE :: WaveVel0Hxi (:,:) ! Instantaneous xi-direction velocity of incident waves before applying stretching at the zi-coordinates for points (m/s ) - REAL(SiKi), ALLOCATABLE :: WaveVel0Hyi (:,:) ! Instantaneous yi-direction velocity of incident waves before applying stretching at the zi-coordinates for points (m/s ) - REAL(SiKi), ALLOCATABLE :: WaveVel0V (:,:) ! Instantaneous vertical velocity of incident waves before applying stretching at the zi-coordinates for points (m/s ) INTEGER :: I,J,K,count ! Generic index - INTEGER :: NWaveKin0Prime ! Number of points where the incident wave kinematics will be computed before applying stretching to the instantaneous free surface (-) integer :: primeCount ! Counter for locations before applying stretching + + ! Generation seeds for the wave-kinematics volume kernel (see SeaSt_WaveKinKernel). In mode 1 they persist in the + ! block store (WaveField%BlockStore); in mode 0 they live in a local store for the duration of this routine. + TYPE(SeaSt_WaveBlockStoreType), TARGET :: LocalSeeds + TYPE(SeaSt_WaveBlockStoreType), POINTER :: Seeds COMPLEX(SiKi) :: tmpComplex ! A temporary varible to hold the complex value of the wave elevation before storing it into a REAL array COMPLEX(SiKi),ALLOCATABLE :: tmpComplexArr(:) ! A temporary array (0:NStepWave2-1) for FFT use. TYPE(FFT_DataType) :: FFT_Data ! the instance of the FFT module we're using @@ -762,15 +750,9 @@ SUBROUTINE VariousWaves_Init ( InitInp, InitOut, WaveField, ErrStat, ErrMsg ) REAL(SiKi) :: YPrime REAL(SiKi) :: HPrime REAL(SiKi) :: MCFC - COMPLEX(SiKi), ALLOCATABLE :: WaveAccC0HxiMCF(:,:) ! Discrete Fourier transform of the instantaneous horizontal acceleration in x-direction of incident waves before applying stretching at the zi-coordinates for points (m/s^2) - COMPLEX(SiKi), ALLOCATABLE :: WaveAccC0HyiMCF(:,:) ! Discrete Fourier transform of the instantaneous horizontal acceleration in y-direction of incident waves before applying stretching at the zi-coordinates for points (m/s^2) - COMPLEX(SiKi), ALLOCATABLE :: WaveAccC0VMCF(:,:) ! Discrete Fourier transform of the instantaneous vertical acceleration of incident waves before applying stretching at the zi-coordinates for points (m/s^2) COMPLEX(SiKi), ALLOCATABLE :: PWaveAccC0HxiMCFPz0(:,:) ! Discrete Fourier transform of the instantaneous horizontal acceleration in x-direction of incident waves before applying stretching at the zi-coordinates for points (m/s^2) COMPLEX(SiKi), ALLOCATABLE :: PWaveAccC0HyiMCFPz0(:,:) ! Discrete Fourier transform of the instantaneous horizontal acceleration in y-direction of incident waves before applying stretching at the zi-coordinates for points (m/s^2) COMPLEX(SiKi), ALLOCATABLE :: PWaveAccC0VMCFPz0(:,:) ! Discrete Fourier transform of the instantaneous vertical acceleration of incident waves before applying stretching at the zi-coordinates for points (m/s^2) - REAL(SiKi), ALLOCATABLE :: WaveAcc0HxiMCF(:,:) ! Discrete Fourier transform of the instantaneous horizontal acceleration in x-direction of incident waves before applying stretching at the zi-coordinates for points (m/s^2) - REAL(SiKi), ALLOCATABLE :: WaveAcc0HyiMCF(:,:) ! Discrete Fourier transform of the instantaneous horizontal acceleration in y-direction of incident waves before applying stretching at the zi-coordinates for points (m/s^2) - REAL(SiKi), ALLOCATABLE :: WaveAcc0VMCF(:,:) ! Discrete Fourier transform of the instantaneous vertical acceleration of incident waves before applying stretching at the zi-coordinates for points (m/s^2) REAL(SiKi), ALLOCATABLE :: PWaveAcc0HxiMCFPz0(:,:) ! Discrete Fourier transform of the instantaneous horizontal acceleration in x-direction of incident waves before applying stretching at the zi-coordinates for points (m/s^2) REAL(SiKi), ALLOCATABLE :: PWaveAcc0HyiMCFPz0(:,:) ! Discrete Fourier transform of the instantaneous horizontal acceleration in y-direction of incident waves before applying stretching at the zi-coordinates for points (m/s^2) REAL(SiKi), ALLOCATABLE :: PWaveAcc0VMCFPz0(:,:) ! Discrete Fourier transform of the instantaneous vertical acceleration of incident waves before applying stretching at the zi-coordinates for points (m/s^2) @@ -796,48 +778,15 @@ SUBROUTINE VariousWaves_Init ( InitInp, InitOut, WaveField, ErrStat, ErrMsg ) - ! Determine the number of, NWaveKin0Prime, and the zi-coordinates for, - ! WaveKinzi0Prime(:), points where the incident wave kinematics will be - ! computed before applying stretching to the instantaneous free surface. - ! The locations are relative to the mean see level. - - NWaveKin0Prime = 0 - DO J = 1,InitInp%NWaveKinGrid ! Loop through all mesh points where the incident wave kinematics will be computed - ! NOTE: We test to 0 instead of MSL2SWL because the locations of WaveKinGridzi and EffWtrDpth have already been adjusted using MSL2SWL - IF ( InitInp%WaveKinGridzi(J) >= -WaveField%EffWtrDpth .AND. InitInp%WaveKinGridzi(J) <= 0 ) THEN - NWaveKin0Prime = NWaveKin0Prime + 1 - END IF - END DO ! J - All Morison nodes where the incident wave kinematics will be computed - - - - ! ALLOCATE the WaveKinzi0Prime(:) array and compute its elements here: - - ALLOCATE ( WaveKinzi0Prime(NWaveKin0Prime) , STAT=ErrStatTmp ); if (Failed0('WaveKinzi0Prime')) return; - ALLOCATE ( WaveKinPrimeMap(NWaveKin0Prime) , STAT=ErrStatTmp ); if (Failed0('WaveKinPrimeMap')) return; - - IF ( ErrStat >= AbortErrLev ) THEN - CALL CleanUp() - RETURN + ! Point the generation-seed store for the wave-kinematics volume kernel at the block store when on-demand block + ! partitioning is active (WvKinBlockMod=1, seeds must persist beyond init), or at a routine-local store otherwise. + IF ( ASSOCIATED(WaveField%BlockStore) ) THEN + Seeds => WaveField%BlockStore + ELSE + Seeds => LocalSeeds END IF - I = 1 - - DO J = 1,InitInp%NWaveKinGrid ! Loop through all points where the incident wave kinematics will be computed without stretching - ! NOTE: We test to 0 instead of MSL2SWL because the locations of WaveKinGridzi and EffWtrDpth have already been adjusted using MSL2SWL - IF ( InitInp%WaveKinGridzi(J) >= -WaveField%EffWtrDpth .AND. InitInp%WaveKinGridzi(J) <= 0 ) THEN - - WaveKinzi0Prime(I) = InitInp%WaveKinGridzi(J) - WaveKinPrimeMap(I) = J - I = I + 1 - - END IF - - END DO ! J - All points where the incident wave kinematics will be computed without stretching - - - ! Perform some initialization computations including calculating the total number of frequency ! components = total number of time steps in the incident wave, ! calculating the frequency step, calculating the index of the frequency @@ -926,29 +875,8 @@ SUBROUTINE VariousWaves_Init ( InitInp, InitOut, WaveField, ErrStat, ErrMsg ) ! Allocate all the arrays we need. ALLOCATE ( tmpComplexArr(0:WaveField%NStepWave2 ), STAT=ErrStatTmp ); if (Failed0('tmpComplexArr')) return; - ALLOCATE ( WaveDynPC0 (0:WaveField%NStepWave2 ,NWaveKin0Prime ), STAT=ErrStatTmp ); if (Failed0('WaveDynPC0 ')) return; - ALLOCATE ( WaveVelC0Hxi (0:WaveField%NStepWave2 ,NWaveKin0Prime ), STAT=ErrStatTmp ); if (Failed0('WaveVelC0Hxi')) return; - ALLOCATE ( WaveVelC0Hyi (0:WaveField%NStepWave2 ,NWaveKin0Prime ), STAT=ErrStatTmp ); if (Failed0('WaveVelC0Hyi')) return; - ALLOCATE ( WaveVelC0V (0:WaveField%NStepWave2 ,NWaveKin0Prime ), STAT=ErrStatTmp ); if (Failed0('WaveVelC0V ')) return; - ALLOCATE ( WaveAccC0Hxi (0:WaveField%NStepWave2 ,NWaveKin0Prime ), STAT=ErrStatTmp ); if (Failed0('WaveAccC0Hxi')) return; - ALLOCATE ( WaveAccC0Hyi (0:WaveField%NStepWave2 ,NWaveKin0Prime ), STAT=ErrStatTmp ); if (Failed0('WaveAccC0Hyi')) return; - ALLOCATE ( WaveAccC0V (0:WaveField%NStepWave2 ,NWaveKin0Prime ), STAT=ErrStatTmp ); if (Failed0('WaveAccC0V ')) return; - - ALLOCATE ( WaveDynP0B (0:WaveField%NStepWave-1,NWaveKin0Prime ), STAT=ErrStatTmp ); if (Failed0('WaveDynP0B ')) return; - ALLOCATE ( WaveVel0Hxi (0:WaveField%NStepWave-1,NWaveKin0Prime ), STAT=ErrStatTmp ); if (Failed0('WaveVel0Hxi ')) return; - ALLOCATE ( WaveVel0Hyi (0:WaveField%NStepWave-1,NWaveKin0Prime ), STAT=ErrStatTmp ); if (Failed0('WaveVel0Hyi ')) return; - ALLOCATE ( WaveVel0V (0:WaveField%NStepWave-1,NWaveKin0Prime ), STAT=ErrStatTmp ); if (Failed0('WaveVel0V ')) return; - ALLOCATE ( WaveAcc0Hxi (0:WaveField%NStepWave-1,NWaveKin0Prime ), STAT=ErrStatTmp ); if (Failed0('WaveAcc0Hxi ')) return; - ALLOCATE ( WaveAcc0Hyi (0:WaveField%NStepWave-1,NWaveKin0Prime ), STAT=ErrStatTmp ); if (Failed0('WaveAcc0Hyi ')) return; - ALLOCATE ( WaveAcc0V (0:WaveField%NStepWave-1,NWaveKin0Prime ), STAT=ErrStatTmp ); if (Failed0('WaveAcc0V ')) return; - - IF (WaveField%MCFD > 0.0_SiKi) THEN ! MacCamy-Fuchs model - ALLOCATE ( WaveAccC0HxiMCF(0:WaveField%NStepWave2 ,NWaveKin0Prime ), STAT=ErrStatTmp ); if (Failed0('WaveAccC0HxiMCF')) return; - ALLOCATE ( WaveAccC0HyiMCF(0:WaveField%NStepWave2 ,NWaveKin0Prime ), STAT=ErrStatTmp ); if (Failed0('WaveAccC0HyiMCF')) return; - ALLOCATE ( WaveAccC0VMCF (0:WaveField%NStepWave2 ,NWaveKin0Prime ), STAT=ErrStatTmp ); if (Failed0('WaveAccC0VMCF ')) return; - ALLOCATE ( WaveAcc0HxiMCF (0:WaveField%NStepWave-1,NWaveKin0Prime ), STAT=ErrStatTmp ); if (Failed0('WaveAcc0HxiMCF ')) return; - ALLOCATE ( WaveAcc0HyiMCF (0:WaveField%NStepWave-1,NWaveKin0Prime ), STAT=ErrStatTmp ); if (Failed0('WaveAcc0HyiMCF ')) return; - ALLOCATE ( WaveAcc0VMCF (0:WaveField%NStepWave-1,NWaveKin0Prime ), STAT=ErrStatTmp ); if (Failed0('WaveAcc0VMCF ')) return; + + IF (WaveField%MCFD > 0.0_SiKi .AND. .NOT. ASSOCIATED(WaveField%BlockStore)) THEN ! MacCamy-Fuchs model (full-domain array; per-block in mode 1) ALLOCATE ( WaveField%WaveAccMCF (0:WaveField%NStepWave,InitInp%NGrid(1),InitInp%NGrid(2),InitInp%NGrid(3),3), STAT=ErrStatTmp ); if (Failed0('WaveField%WaveAccMCF')) return; END IF @@ -1089,6 +1017,20 @@ SUBROUTINE VariousWaves_Init ( InitInp, InitOut, WaveField, ErrStat, ErrMsg ) !! incident waves at each desired point on the still water level plane !! where it can be output: + ! Capture the per-frequency generation seeds for the wave-kinematics volume kernel from the exact values computed + ! in the loop below (recomputing them in another compilation unit is not bit-identical). + ALLOCATE ( Seeds%WaveNmbrArr(0:WaveField%NStepWave2), & + Seeds%OmegaIArr (0:WaveField%NStepWave2), & + Seeds%MCFCArr (0:WaveField%NStepWave2), STAT=ErrStatTmp ) + IF ( ErrStatTmp /= 0 ) THEN + CALL SetErrStat(ErrID_Fatal,'Error allocating the per-frequency seed arrays.',ErrStat,ErrMsg,RoutineName) + CALL CleanUp() + RETURN + END IF + Seeds%WaveNmbrArr = 0.0_SiKi + Seeds%OmegaIArr = -1.0_SiKi ! <0 marks components at/beyond the critical frequency (see the EXIT below) + Seeds%MCFCArr = 0.0_SiKi + DO I = 0,WaveField%NStepWave2 ! Loop through the positive frequency components (including zero) of the discrete Fourier transforms ! Set tmpComplex to the Ith element of the WAveElevC0 array tmpComplex = CMPLX( WaveField%WaveElevC0(1,I), WaveField%WaveElevC0(2,I)) @@ -1100,6 +1042,7 @@ SUBROUTINE VariousWaves_Init ( InitInp, InitOut, WaveField, ErrStat, ErrMsg ) CALL CleanUp() RETURN END IF + Seeds%OmegaIArr(I) = OmegaI ! seed capture IF (OmegaI < 0.0_SiKi) EXIT ! Compute the frequency of this component and its imaginary value: @@ -1115,32 +1058,11 @@ SUBROUTINE VariousWaves_Init ( InitInp, InitOut, WaveField, ErrStat, ErrMsg ) MCFC = 4.0_ReKi/( PI * ka * ka * HPrime ) END IF - ! Compute the discrete Fourier transform of the incident wave kinematics - ! before applying stretching at the zi-coordinates for the WAMIT reference point, and all - ! points where are Morison loads will be calculated. + Seeds%WaveNmbrArr(I) = WaveNmbr ! seed capture + Seeds%MCFCArr(I) = MCFC - DO J = 1,NWaveKin0Prime ! Loop through all points where the incident wave kinematics will be computed without stretching - - WaveElevxiPrime0 = EXP( -ImagNmbr*WaveNmbr*( InitInp%WaveKinGridxi(WaveKinPrimeMap(J))*CosWaveDir(I) + & - InitInp%WaveKinGridyi(WaveKinPrimeMap(J))*SinWaveDir(I) )) - - WaveDynPC0 (I,J) = WaveField%RhoXg*tmpComplex*WaveElevxiPrime0 * COSHNumOvrCOSHDen ( WaveNmbr, WaveField%EffWtrDpth, WaveKinzi0Prime(J) ) - - WaveVelC0Hxi (I,J) = CosWaveDir(I)*OmegaI*tmpComplex* WaveElevxiPrime0 * COSHNumOvrSINHDen ( WaveNmbr, WaveField%EffWtrDpth, WaveKinzi0Prime(J) ) - WaveVelC0Hyi (I,J) = SinWaveDir(I)*OmegaI*tmpComplex* WaveElevxiPrime0 * COSHNumOvrSINHDen ( WaveNmbr, WaveField%EffWtrDpth, WaveKinzi0Prime(J) ) - - WaveVelC0V (I,J) = ImagOmegaI*tmpComplex* WaveElevxiPrime0 * SINHNumOvrSINHDen ( WaveNmbr, WaveField%EffWtrDpth, WaveKinzi0Prime(J) ) - WaveAccC0Hxi (I,J) = ImagOmegaI* WaveVelC0Hxi (I,J) - - WaveAccC0Hyi (I,J) = ImagOmegaI* WaveVelC0Hyi (I,J) - WaveAccC0V (I,J) = ImagOmegaI* WaveVelC0V (I,J) - - IF (WaveField%MCFD > 0.0_SiKi) THEN - WaveAccC0HxiMCF(I,J) = WaveAccC0Hxi(I,J) * MCFC - WaveAccC0HyiMCF(I,J) = WaveAccC0Hyi(I,J) * MCFC - WaveAccC0VMCF(I,J) = WaveAccC0V(I,J) * MCFC - END IF - END DO ! J - All points where the incident wave kinematics will be computed without stretching + ! NOTE: the per-point discrete Fourier transforms of the incident wave kinematics (and their IFFTs) are computed + ! by WaveKinKernel_ComputeColumns after this loop, driven by the seeds captured here. IF (WaveField%WaveStMod .EQ. 2_IntKi) THEN ! Extrapolation wave stretching DO J = 1,InitInp%NWaveElevGrid ! Loop through all points on the SWL @@ -1204,25 +1126,6 @@ SUBROUTINE VariousWaves_Init ( InitInp, InitOut, WaveField, ErrStat, ErrMsg ) - ! User requested data points -- Do all the FFT calls first, then return if something failed. - DO J = 1,NWaveKin0Prime ! Loop through all points where the incident wave kinematics will be computed without stretching - CALL ApplyFFT_cx ( WaveDynP0B (:,J), WaveDynPC0 (:,J), FFT_Data, ErrStatTmp ); if (FailedFFT('WaveDynPC0 ')) return; - CALL ApplyFFT_cx ( WaveVel0Hxi (:,J), WaveVelC0Hxi (:,J), FFT_Data, ErrStatTmp ); if (FailedFFT('WaveVelC0Hxi')) return; - CALL ApplyFFT_cx ( WaveVel0Hyi (:,J), WaveVelC0Hyi (:,J), FFT_Data, ErrStatTmp ); if (FailedFFT('WaveVelC0Hyi')) return; - CALL ApplyFFT_cx ( WaveVel0V (:,J), WaveVelC0V (:,J), FFT_Data, ErrStatTmp ); if (FailedFFT('WaveVelC0V ')) return; - CALL ApplyFFT_cx ( WaveAcc0Hxi (:,J), WaveAccC0Hxi (:,J), FFT_Data, ErrStatTmp ); if (FailedFFT('WaveAccC0Hxi')) return; - CALL ApplyFFT_cx ( WaveAcc0Hyi (:,J), WaveAccC0Hyi (:,J), FFT_Data, ErrStatTmp ); if (FailedFFT('WaveAccC0Hyi')) return; - CALL ApplyFFT_cx ( WaveAcc0V (:,J), WaveAccC0V (:,J), FFT_Data, ErrStatTmp ); if (FailedFFT('WaveAccC0V ')) return; - END DO ! J - All points where the incident wave kinematics will be computed without stretching - - IF (WaveField%MCFD > 0.0_SiKi) THEN - DO J = 1,NWaveKin0Prime ! Loop through all points where the incident wave kinematics will be computed without stretching - CALL ApplyFFT_cx ( WaveAcc0HxiMCF (:,J), WaveAccC0HxiMCF (:,J), FFT_Data, ErrStatTmp ); if (FailedFFT('WaveAcc0HxiMCF')) return; - CALL ApplyFFT_cx ( WaveAcc0HyiMCF (:,J), WaveAccC0HyiMCF (:,J), FFT_Data, ErrStatTmp ); if (FailedFFT('WaveAcc0HyiMCF')) return; - CALL ApplyFFT_cx ( WaveAcc0VMCF (:,J), WaveAccC0VMCF (:,J), FFT_Data, ErrStatTmp ); if (FailedFFT('WaveAcc0VMCF ')) return; - END DO - END IF - IF (WaveField%WaveStMod .EQ. 2_IntKi) THEN ! Extrapolation Wave Stretching DO J = 1,InitInp%NWaveElevGrid ! Loop through all points on the SWL where z-partial derivatives will be computed for extrapolated stretching ! FFT's of the partial derivatives @@ -1254,112 +1157,63 @@ SUBROUTINE VariousWaves_Init ( InitInp, InitOut, WaveField, ErrStat, ErrMsg ) - ! Add the current velocities to the wave velocities: - ! NOTE: Both the horizontal velocities and the partial derivative of the - ! horizontal velocities with respect to zi at zi = 0 are found here. - ! - ! NOTE: The current module must be called prior to the waves module. If that was not done, then we - ! don't have a current to add to the wave velocity. So, check if the current velocity components - ! exist. - - - ! If there is a current, we need to add that (the current module was called prior to calling this module - - IF(ALLOCATED(InitInp%CurrVxi)) THEN - - DO J = 1,NWaveKin0Prime ! Loop through all points where the incident wave kinematics will be computed without stretching - - WaveVel0Hxi (:,J) = WaveVel0Hxi (:,J) + InitInp%CurrVxi(WaveKinPrimeMap(J)) ! xi-direction - WaveVel0Hyi (:,J) = WaveVel0Hyi (:,J) + InitInp%CurrVyi(WaveKinPrimeMap(J)) ! yi-direction - - END DO ! J - All points where the incident wave kinematics will be computed without stretching - - ! Commented out - We do not extrapolate the current profile with extrapolated wave stretching - !PWaveVel0HxiPz0(: ) = PWaveVel0HxiPz0(: ) + InitInp%PCurrVxiPz0 ! xi-direction - !PWaveVel0HyiPz0(: ) = PWaveVel0HyiPz0(: ) + InitInp%PCurrVyiPz0 ! yi-direction - - ENDIF - - - ! Apply stretching to obtain the wave kinematics, WaveDynP0, WaveVel0, and - ! WaveAcc0, at the desired locations from the wave kinematics at - ! alternative locations, WaveDynP0B, WaveVel0Hxi, WaveVel0Hyi, WaveVel0V, - ! WaveAcc0Hxi, WaveAcc0Hyi, WaveAcc0V, if the elevation of the point defined by - ! WaveKinGridzi(J) lies between the seabed and the instantaneous free - ! surface, else set WaveDynP0, WaveVel0, and WaveAcc0 to zero. This - ! depends on which incident wave kinematics stretching method is being - ! used: - - ! SELECT CASE ( InitInp%WaveStMod ) ! Which model are we using to extrapolate the incident wave kinematics to the instantaneous free surface? - ! CASE ( 0 ) ! None=no stretching. - - - ! Since we have no stretching, the wave kinematics between the seabed and - ! the mean sea level are left unchanged; below the seabed or above the - ! mean sea level, the wave kinematics are zero: - - ! InitOut%PWaveDynP0(:,:,:,:) = 0.0 - - primeCount = 1 - count = 1 - !DO J = 1,InitInp%NWaveKinGrid ! Loop through all points where the incident wave kinematics will be computed - do k = 1, InitInp%NGrid(3) - do j = 1, InitInp%NGrid(2) - do i = 1, InitInp%NGrid(1) - - ! ii = mod(count-1, InitInp%NGrid(1)) + 1 - ! jj = mod( (count-1) /InitInp%NGrid(1), InitInp%NGrid(2) ) + 1 - ! kk = (count-1) / (InitInp%NGrid(1)*InitInp%NGrid(2)) + 1 - - IF ( ( InitInp%WaveKinGridzi(count) < -WaveField%EffWtrDpth ) .OR. ( InitInp%WaveKinGridzi(count) > 0.0 ) ) THEN - ! .TRUE. if the elevation of the point defined by WaveKinGridzi(J) lies below the seabed or above mean sea level (exclusive) - ! NOTE: We test to 0 instead of MSL2SWL because the locations of WaveKinGridzi and EffWtrDpth have already been adjusted using MSL2SWL - - WaveField%WaveDynP(:,i,j,k ) = 0.0 - WaveField%WaveVel (:,i,j,k,:) = 0.0 - WaveField%WaveAcc (:,i,j,k,:) = 0.0 - - ELSE - ! The elevation of the point defined by WaveKinGridzi(J) must lie between the seabed and the mean sea level (inclusive) - - WaveField%WaveDynP(0:WaveField%NStepWave-1,i,j,k ) = WaveDynP0B( 0:WaveField%NStepWave-1,primeCount) - WaveField%WaveVel (0:WaveField%NStepWave-1,i,j,k,1) = WaveVel0Hxi(0:WaveField%NStepWave-1,primeCount) - WaveField%WaveVel (0:WaveField%NStepWave-1,i,j,k,2) = WaveVel0Hyi(0:WaveField%NStepWave-1,primeCount) - WaveField%WaveVel (0:WaveField%NStepWave-1,i,j,k,3) = WaveVel0V( 0:WaveField%NStepWave-1,primeCount) - WaveField%WaveAcc (0:WaveField%NStepWave-1,i,j,k,1) = WaveAcc0Hxi(0:WaveField%NStepWave-1,primeCount) - WaveField%WaveAcc (0:WaveField%NStepWave-1,i,j,k,2) = WaveAcc0Hyi(0:WaveField%NStepWave-1,primeCount) - WaveField%WaveAcc (0:WaveField%NStepWave-1,i,j,k,3) = WaveAcc0V( 0:WaveField%NStepWave-1,primeCount) - primeCount = primeCount + 1 - END IF - count = count + 1 - end do - end do - end do + ! Finalize the generation seeds for the wave-kinematics volume kernel: the wave-direction cosines and the grid / + ! steady-current profile. All pure copies of the exact values used in this routine (see SeaSt_WaveKinKernel). + ! The flat index of grid point (i,j,k) is i + (j-1)*NX + (k-1)*NX*NY (x fastest, z slowest). + ALLOCATE ( Seeds%CosWaveDirArr(0:WaveField%NStepWave2), Seeds%SinWaveDirArr(0:WaveField%NStepWave2), & + Seeds%xGrid(InitInp%NGrid(1)), Seeds%yGrid(InitInp%NGrid(2)), Seeds%zGrid(InitInp%NGrid(3)), & + Seeds%CurrVxi(InitInp%NGrid(3)), Seeds%CurrVyi(InitInp%NGrid(3)), STAT=ErrStatTmp ) + IF ( ErrStatTmp /= 0 ) THEN + CALL SetErrStat(ErrID_Fatal,'Error allocating the grid seed arrays.',ErrStat,ErrMsg,RoutineName) + CALL CleanUp() + RETURN + END IF + Seeds%CosWaveDirArr = CosWaveDir + Seeds%SinWaveDirArr = SinWaveDir + DO I = 1, InitInp%NGrid(1) + Seeds%xGrid(I) = InitInp%WaveKinGridxi(I) + END DO + DO I = 1, InitInp%NGrid(2) + Seeds%yGrid(I) = InitInp%WaveKinGridyi(1 + (I-1)*InitInp%NGrid(1)) + END DO + ! NOTE: The current module must be called prior to the waves module, else there is no current profile to add. + Seeds%HasCurr = ALLOCATED(InitInp%CurrVxi) + DO K = 1, InitInp%NGrid(3) + I = 1 + (K-1)*InitInp%NGrid(1)*InitInp%NGrid(2) + Seeds%zGrid(K) = InitInp%WaveKinGridzi(I) + IF ( Seeds%HasCurr ) THEN + Seeds%CurrVxi(K) = InitInp%CurrVxi(I) + Seeds%CurrVyi(K) = InitInp%CurrVyi(I) + ELSE + Seeds%CurrVxi(K) = 0.0_SiKi + Seeds%CurrVyi(K) = 0.0_SiKi + END IF + END DO - ! MacCamy-Fuchs scaled fluid acceleration - IF (WaveField%MCFD > 0.0_SiKi) THEN - primeCount = 1 - count = 1 - do k = 1, InitInp%NGrid(3) - do j = 1, InitInp%NGrid(2) - do i = 1, InitInp%NGrid(1) - IF ( ( InitInp%WaveKinGridzi(count) < -WaveField%EffWtrDpth ) .OR. ( InitInp%WaveKinGridzi(count) > 0.0 ) ) THEN - ! .TRUE. if the elevation of the point defined by WaveKinGridzi(J) lies below the seabed or above mean sea level (exclusive) - ! NOTE: We test to 0 instead of MSL2SWL because the locations of WaveKinGridzi and EffWtrDpth have already been adjusted using MSL2SWL - WaveField%WaveAccMCF(:,i,j,k,:) = 0.0 - ELSE - ! The elevation of the point defined by WaveKinGridzi(J) must lie between the seabed and the mean sea level (inclusive) - WaveField%WaveAccMCF (0:WaveField%NStepWave-1,i,j,k,1) = WaveAcc0HxiMCF(0:WaveField%NStepWave-1,primeCount) - WaveField%WaveAccMCF (0:WaveField%NStepWave-1,i,j,k,2) = WaveAcc0HyiMCF(0:WaveField%NStepWave-1,primeCount) - WaveField%WaveAccMCF (0:WaveField%NStepWave-1,i,j,k,3) = WaveAcc0VMCF( 0:WaveField%NStepWave-1,primeCount) - primeCount = primeCount + 1 - END IF - count = count + 1 - end do - end do - end do + ! Compute the wave-kinematics volume arrays (first-order kinematics + steady current, with above-SWL/below-seabed + ! zeroing and the periodic last-step wrap) via the shared per-column kernel over the full grid. With on-demand + ! block partitioning (WvKinBlockMod=1) the full-domain fill is skipped entirely -- the same kernel populates + ! individual blocks on first access, driven by the seeds captured above. + IF ( ASSOCIATED(WaveField%BlockStore) ) THEN + ! on-demand blocks: nothing to fill at init + ELSE IF (WaveField%MCFD > 0.0_SiKi) THEN + CALL WaveKinKernel_ComputeColumns ( WaveField, Seeds, 1, InitInp%NGrid(1), 1, InitInp%NGrid(2), & + 1, InitInp%NGrid(3), & + WaveField%WaveDynP, WaveField%WaveVel, WaveField%WaveAcc, & + ErrStatTmp, ErrMsgTmp, WaveAccMCF=WaveField%WaveAccMCF ) + ELSE + CALL WaveKinKernel_ComputeColumns ( WaveField, Seeds, 1, InitInp%NGrid(1), 1, InitInp%NGrid(2), & + 1, InitInp%NGrid(3), & + WaveField%WaveDynP, WaveField%WaveVel, WaveField%WaveAcc, & + ErrStatTmp, ErrMsgTmp ) + END IF + CALL SetErrStat(ErrStatTmp,ErrMsgTmp,ErrStat,ErrMsg,RoutineName) + IF ( ErrStat >= AbortErrLev ) THEN + CALL CleanUp() + RETURN END IF + IF (WaveField%WaveStMod .EQ. 2_IntKi) THEN ! Extrapolation Wave Stretching primeCount = 1 @@ -1422,14 +1276,9 @@ SUBROUTINE VariousWaves_Init ( InitInp, InitOut, WaveField, ErrStat, ErrMsg ) ! ENDSELECT ! Set the ending timestep to the same as the first timestep + ! (the volume arrays WaveDynP/WaveVel/WaveAcc/WaveAccMCF are wrapped per column by WaveKinKernel_ComputeColumns) WaveField%WaveElev0 (WaveField%NStepWave) = WaveField%WaveElev0 (0 ) - WaveField%WaveDynP (WaveField%NStepWave,:,:,: ) = WaveField%WaveDynP (0,:,:,: ) - WaveField%WaveVel (WaveField%NStepWave,:,:,:,:) = WaveField%WaveVel (0,:,:,:,:) - WaveField%WaveAcc (WaveField%NStepWave,:,:,:,:) = WaveField%WaveAcc (0,:,:,:,:) - IF (WaveField%MCFD > 0.0_SiKi) THEN - WaveField%WaveAccMCF (WaveField%NStepWave,:,:,:,:) = WaveField%WaveAccMCF(0,:,:,:,:) - END IF - + IF (WaveField%WaveStMod .EQ. 2_IntKi) THEN ! Extrapolation Wave Stretching WaveField%PWaveDynP0(WaveField%NStepWave,:,: ) = WaveField%PWaveDynP0(0,:,: ) WaveField%PWaveVel0 (WaveField%NStepWave,:,:,:) = WaveField%PWaveVel0 (0,:,:,:) @@ -1580,8 +1429,6 @@ END SUBROUTINE GetOmegaCritical !-------------------------------------------------------------------------------- SUBROUTINE CleanUp( ) - IF (ALLOCATED( WaveKinPrimeMap )) DEALLOCATE( WaveKinPrimeMap, STAT=ErrStatTmp) - IF (ALLOCATED( WaveKinzi0Prime )) DEALLOCATE( WaveKinzi0Prime, STAT=ErrStatTmp) IF (ALLOCATED( GHWaveAcc )) DEALLOCATE( GHWaveAcc, STAT=ErrStatTmp) IF (ALLOCATED( GHWaveDynP )) DEALLOCATE( GHWaveDynP, STAT=ErrStatTmp) IF (ALLOCATED( GHWaveVel )) DEALLOCATE( GHWaveVel, STAT=ErrStatTmp) @@ -1600,31 +1447,11 @@ SUBROUTINE CleanUp( ) IF (ALLOCATED( PWaveVelC0HxiPz0 )) DEALLOCATE( PWaveVelC0HxiPz0, STAT=ErrStatTmp) IF (ALLOCATED( PWaveVelC0HyiPz0 )) DEALLOCATE( PWaveVelC0HyiPz0, STAT=ErrStatTmp) IF (ALLOCATED( PWaveVelC0VPz0 )) DEALLOCATE( PWaveVelC0VPz0, STAT=ErrStatTmp) - IF (ALLOCATED( WaveAcc0Hxi )) DEALLOCATE( WaveAcc0Hxi, STAT=ErrStatTmp) - IF (ALLOCATED( WaveAcc0Hyi )) DEALLOCATE( WaveAcc0Hyi, STAT=ErrStatTmp) - IF (ALLOCATED( WaveAcc0V )) DEALLOCATE( WaveAcc0V, STAT=ErrStatTmp) - IF (ALLOCATED( WaveAccC0Hxi )) DEALLOCATE( WaveAccC0Hxi, STAT=ErrStatTmp) - IF (ALLOCATED( WaveAccC0Hyi )) DEALLOCATE( WaveAccC0Hyi, STAT=ErrStatTmp) - IF (ALLOCATED( WaveAccC0V )) DEALLOCATE( WaveAccC0V, STAT=ErrStatTmp) - IF (ALLOCATED( WaveDynP0B )) DEALLOCATE( WaveDynP0B, STAT=ErrStatTmp) - IF (ALLOCATED( WaveDynPC0 )) DEALLOCATE( WaveDynPC0, STAT=ErrStatTmp) - IF (ALLOCATED( WaveVel0Hxi )) DEALLOCATE( WaveVel0Hxi, STAT=ErrStatTmp) - IF (ALLOCATED( WaveVel0Hyi )) DEALLOCATE( WaveVel0Hyi, STAT=ErrStatTmp) - IF (ALLOCATED( WaveVel0V )) DEALLOCATE( WaveVel0V, STAT=ErrStatTmp) - IF (ALLOCATED( WaveVelC0Hxi )) DEALLOCATE( WaveVelC0Hxi, STAT=ErrStatTmp) - IF (ALLOCATED( WaveVelC0Hyi )) DEALLOCATE( WaveVelC0Hyi, STAT=ErrStatTmp) - IF (ALLOCATED( WaveVelC0V )) DEALLOCATE( WaveVelC0V, STAT=ErrStatTmp) IF (ALLOCATED( tmpComplexArr )) DEALLOCATE( tmpComplexArr, STAT=ErrStatTmp) IF (ALLOCATED( WaveS1SddArr )) DEALLOCATE( WaveS1SddArr, STAT=ErrStatTmp) IF (ALLOCATED( OmegaArr )) DEALLOCATE( OmegaArr, STAT=ErrStatTmp) - IF (ALLOCATED( WaveAccC0HxiMCF )) DEALLOCATE( WaveAccC0HxiMCF, STAT=ErrStatTmp) - IF (ALLOCATED( WaveAccC0HyiMCF )) DEALLOCATE( WaveAccC0HyiMCF, STAT=ErrStatTmp) - IF (ALLOCATED( WaveAccC0VMCF )) DEALLOCATE( WaveAccC0VMCF, STAT=ErrStatTmp) - IF (ALLOCATED( WaveAcc0HxiMCF )) DEALLOCATE( WaveAcc0HxiMCF, STAT=ErrStatTmp) - IF (ALLOCATED( WaveAcc0HyiMCF )) DEALLOCATE( WaveAcc0HyiMCF, STAT=ErrStatTmp) - IF (ALLOCATED( WaveAcc0VMCF )) DEALLOCATE( WaveAcc0VMCF, STAT=ErrStatTmp) IF (ALLOCATED( PWaveAccC0HxiMCFPz0 )) DEALLOCATE( PWaveAccC0HxiMCFPz0, STAT=ErrStatTmp) IF (ALLOCATED( PWaveAccC0HyiMCFPz0 )) DEALLOCATE( PWaveAccC0HyiMCFPz0, STAT=ErrStatTmp) IF (ALLOCATED( PWaveAccC0VMCFPz0 )) DEALLOCATE( PWaveAccC0VMCFPz0, STAT=ErrStatTmp) @@ -1640,6 +1467,239 @@ END SUBROUTINE CleanUp END SUBROUTINE VariousWaves_Init +!---------------------------------------------------------------------------------------------------------------------------------- +!> Compute the first-order wave kinematics (dynamic pressure, velocity, acceleration, and optionally the MacCamy-Fuchs +!! scaled acceleration), plus the steady current contribution, for the grid-point columns x-index iPtX0..iPtX0+nPtX-1, +!! y-index iPtY0..iPtY0+nPtY-1, over all grid z levels and the full wave time series (including the periodic wrap of the +!! last time step). The output arrays are column-local: dimensioned (0:NStepWave, nPtX, nPtY, NZ[, 3]). +!! +!! Every arithmetic expression here is copied verbatim from the frequency/point loops of VariousWaves_Init (Waves.f90), +!! driven by the generation seeds captured there, so per-element results are bit-identical to the full-domain precompute. +SUBROUTINE WaveKinKernel_ComputeColumns( WaveField, Store, iPtX0, nPtX, iPtY0, nPtY, iPtZ0, nPtZ, & + WaveDynP, WaveVel, WaveAcc, ErrStat, ErrMsg, WaveAccMCF ) + + TYPE(SeaSt_WaveFieldType), INTENT(IN ) :: WaveField !< Initialized wave field (WaveElevC0 must be final) + TYPE(SeaSt_WaveBlockStoreType), INTENT(IN ) :: Store !< Generation seeds captured by VariousWaves_Init + INTEGER(IntKi), INTENT(IN ) :: iPtX0 !< Global x-index of the first column to compute + INTEGER(IntKi), INTENT(IN ) :: nPtX !< Number of columns to compute in x + INTEGER(IntKi), INTENT(IN ) :: iPtY0 !< Global y-index of the first column to compute + INTEGER(IntKi), INTENT(IN ) :: nPtY !< Number of columns to compute in y + INTEGER(IntKi), INTENT(IN ) :: iPtZ0 !< Global z-index of the first grid level to compute + INTEGER(IntKi), INTENT(IN ) :: nPtZ !< Number of grid levels to compute in z + REAL(SiKi), INTENT(INOUT) :: WaveDynP(0:,1:,1:,1:) !< (0:NStepWave,nPtX,nPtY,nPtZ) + REAL(SiKi), INTENT(INOUT) :: WaveVel (0:,1:,1:,1:,1:) !< (0:NStepWave,nPtX,nPtY,nPtZ,3) + REAL(SiKi), INTENT(INOUT) :: WaveAcc (0:,1:,1:,1:,1:) !< (0:NStepWave,nPtX,nPtY,nPtZ,3) + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + REAL(SiKi), OPTIONAL, INTENT(INOUT) :: WaveAccMCF(0:,1:,1:,1:,1:) !< (0:NStepWave,nPtX,nPtY,nPtZ,3) [only when MCFD>0] + + ! Local Variables: + COMPLEX(SiKi), ALLOCATABLE :: WaveDynPC0(:) ! Discrete Fourier transform of the instantaneous dynamic pressure at this point (N/m^2) + COMPLEX(SiKi), ALLOCATABLE :: WaveVelC0Hxi(:) ! Discrete Fourier transform of the instantaneous horizontal velocity in x-direction (m/s) + COMPLEX(SiKi), ALLOCATABLE :: WaveVelC0Hyi(:) ! Discrete Fourier transform of the instantaneous horizontal velocity in y-direction (m/s) + COMPLEX(SiKi), ALLOCATABLE :: WaveVelC0V(:) ! Discrete Fourier transform of the instantaneous vertical velocity (m/s) + COMPLEX(SiKi), ALLOCATABLE :: WaveAccC0Hxi(:) ! Discrete Fourier transform of the instantaneous horizontal acceleration in x-direction (m/s^2) + COMPLEX(SiKi), ALLOCATABLE :: WaveAccC0Hyi(:) ! Discrete Fourier transform of the instantaneous horizontal acceleration in y-direction (m/s^2) + COMPLEX(SiKi), ALLOCATABLE :: WaveAccC0V(:) ! Discrete Fourier transform of the instantaneous vertical acceleration (m/s^2) + COMPLEX(SiKi), ALLOCATABLE :: WaveAccC0HxiMCF(:) ! MacCamy-Fuchs scaled version of WaveAccC0Hxi (m/s^2) + COMPLEX(SiKi), ALLOCATABLE :: WaveAccC0HyiMCF(:) ! MacCamy-Fuchs scaled version of WaveAccC0Hyi (m/s^2) + COMPLEX(SiKi), ALLOCATABLE :: WaveAccC0VMCF(:) ! MacCamy-Fuchs scaled version of WaveAccC0V (m/s^2) + REAL(SiKi), ALLOCATABLE :: WaveDynP0B(:) ! Instantaneous dynamic pressure at this point (N/m^2) + REAL(SiKi), ALLOCATABLE :: WaveVel0Hxi(:) ! Instantaneous horizontal velocity in x-direction (m/s) + REAL(SiKi), ALLOCATABLE :: WaveVel0Hyi(:) ! Instantaneous horizontal velocity in y-direction (m/s) + REAL(SiKi), ALLOCATABLE :: WaveVel0V(:) ! Instantaneous vertical velocity (m/s) + REAL(SiKi), ALLOCATABLE :: WaveAcc0Hxi(:) ! Instantaneous horizontal acceleration in x-direction (m/s^2) + REAL(SiKi), ALLOCATABLE :: WaveAcc0Hyi(:) ! Instantaneous horizontal acceleration in y-direction (m/s^2) + REAL(SiKi), ALLOCATABLE :: WaveAcc0V(:) ! Instantaneous vertical acceleration (m/s^2) + REAL(SiKi), ALLOCATABLE :: WaveAcc0HxiMCF(:) ! MacCamy-Fuchs scaled version of WaveAcc0Hxi (m/s^2) + REAL(SiKi), ALLOCATABLE :: WaveAcc0HyiMCF(:) ! MacCamy-Fuchs scaled version of WaveAcc0Hyi (m/s^2) + REAL(SiKi), ALLOCATABLE :: WaveAcc0VMCF(:) ! MacCamy-Fuchs scaled version of WaveAcc0V (m/s^2) + + COMPLEX(SiKi) :: WaveElevxiPrime0 ! Phase factor for this point and frequency + COMPLEX(SiKi) :: tmpComplex ! Complex wave elevation amplitude of this frequency component + COMPLEX(SiKi) :: ImagOmegaI ! ImagNmbr*OmegaI + REAL(SiKi) :: OmegaI ! Intrinsic frequency of this component (from seeds) + REAL(SiKi) :: WaveNmbr ! Wavenumber of this component (from seeds) + REAL(SiKi) :: MCFC ! MacCamy-Fuchs scaling coefficient of this component (from seeds) + REAL(SiKi) :: xi ! x coordinate of this column + REAL(SiKi) :: yi ! y coordinate of this column + REAL(SiKi) :: zi ! z coordinate of this grid level + + TYPE(FFT_DataType) :: FFT_Data ! the instance of the FFT module we're using + LOGICAL :: doMCF ! Compute the MacCamy-Fuchs scaled acceleration field? + INTEGER(IntKi) :: I ! Frequency-component index + INTEGER(IntKi) :: jx, jy ! Column-local x/y indices + INTEGER(IntKi) :: ixG, iyG ! Global grid x/y indices + INTEGER(IntKi) :: kz ! Block-local grid z-level index + INTEGER(IntKi) :: kzG ! Global grid z-level index + INTEGER(IntKi) :: NZgrid ! Number of grid z levels to compute + + INTEGER(IntKi) :: ErrStatTmp ! Temporary error status + CHARACTER(*), PARAMETER :: RoutineName = 'WaveKinKernel_ComputeColumns' + + ErrStat = ErrID_None + ErrMsg = "" + + doMCF = ( WaveField%MCFD > 0.0_SiKi .AND. PRESENT(WaveAccMCF) ) + NZgrid = nPtZ + + CALL InitFFT ( WaveField%NStepWave, FFT_Data, .TRUE., ErrStatTmp ) + CALL SetErrStat(ErrStatTmp,'Error occurred while initializing the FFT.',ErrStat,ErrMsg,RoutineName) + IF ( ErrStat >= AbortErrLev ) RETURN + + ALLOCATE ( WaveDynPC0 (0:WaveField%NStepWave2), WaveVelC0Hxi(0:WaveField%NStepWave2), & + WaveVelC0Hyi(0:WaveField%NStepWave2), WaveVelC0V (0:WaveField%NStepWave2), & + WaveAccC0Hxi(0:WaveField%NStepWave2), WaveAccC0Hyi(0:WaveField%NStepWave2), & + WaveAccC0V (0:WaveField%NStepWave2), & + WaveDynP0B (0:WaveField%NStepWave-1), WaveVel0Hxi (0:WaveField%NStepWave-1), & + WaveVel0Hyi (0:WaveField%NStepWave-1), WaveVel0V (0:WaveField%NStepWave-1), & + WaveAcc0Hxi (0:WaveField%NStepWave-1), WaveAcc0Hyi (0:WaveField%NStepWave-1), & + WaveAcc0V (0:WaveField%NStepWave-1), STAT=ErrStatTmp ) + IF ( ErrStatTmp /= 0 ) THEN + CALL SetErrStat(ErrID_Fatal,'Error allocating the per-column work arrays.',ErrStat,ErrMsg,RoutineName) + RETURN + END IF + IF ( doMCF ) THEN + ALLOCATE ( WaveAccC0HxiMCF(0:WaveField%NStepWave2), WaveAccC0HyiMCF(0:WaveField%NStepWave2), & + WaveAccC0VMCF (0:WaveField%NStepWave2), & + WaveAcc0HxiMCF (0:WaveField%NStepWave-1), WaveAcc0HyiMCF (0:WaveField%NStepWave-1), & + WaveAcc0VMCF (0:WaveField%NStepWave-1), STAT=ErrStatTmp ) + IF ( ErrStatTmp /= 0 ) THEN + CALL SetErrStat(ErrID_Fatal,'Error allocating the per-column MacCamy-Fuchs work arrays.',ErrStat,ErrMsg,RoutineName) + RETURN + END IF + END IF + + DO jy = 1, nPtY + iyG = iPtY0 + jy - 1 + yi = Store%yGrid(iyG) + DO jx = 1, nPtX + ixG = iPtX0 + jx - 1 + xi = Store%xGrid(ixG) + DO kz = 1, NZgrid + kzG = iPtZ0 + kz - 1 + zi = Store%zGrid(kzG) + + IF ( ( zi < -WaveField%EffWtrDpth ) .OR. ( zi > 0.0 ) ) THEN + ! The point lies below the seabed or above mean sea level (exclusive) — no wave kinematics + ! (same test as the grid copy loops of VariousWaves_Init) + WaveDynP(:,jx,jy,kz ) = 0.0 + WaveVel (:,jx,jy,kz,:) = 0.0 + WaveAcc (:,jx,jy,kz,:) = 0.0 + IF ( doMCF ) WaveAccMCF(:,jx,jy,kz,:) = 0.0 + + ELSE + ! Frequency-domain assembly for this point: verbatim expressions from VariousWaves_Init, driven by the + ! captured seeds. Components at/beyond the critical frequency stay zero (the seeds mark them OmegaI<0, + ! mirroring the EXIT in VariousWaves_Init). + WaveDynPC0 = CMPLX(0.0_SiKi, 0.0_SiKi) + WaveVelC0Hxi = CMPLX(0.0_SiKi, 0.0_SiKi) + WaveVelC0Hyi = CMPLX(0.0_SiKi, 0.0_SiKi) + WaveVelC0V = CMPLX(0.0_SiKi, 0.0_SiKi) + WaveAccC0Hxi = CMPLX(0.0_SiKi, 0.0_SiKi) + WaveAccC0Hyi = CMPLX(0.0_SiKi, 0.0_SiKi) + WaveAccC0V = CMPLX(0.0_SiKi, 0.0_SiKi) + IF ( doMCF ) THEN + WaveAccC0HxiMCF = CMPLX(0.0_SiKi, 0.0_SiKi) + WaveAccC0HyiMCF = CMPLX(0.0_SiKi, 0.0_SiKi) + WaveAccC0VMCF = CMPLX(0.0_SiKi, 0.0_SiKi) + END IF + + DO I = 0, WaveField%NStepWave2 ! Loop through the positive frequency components (including zero) + + OmegaI = Store%OmegaIArr(I) + IF (OmegaI < 0.0_SiKi) EXIT ! No wave energy at/beyond the critical frequency (same as VariousWaves_Init) + + WaveNmbr = Store%WaveNmbrArr(I) + MCFC = Store%MCFCArr(I) + tmpComplex = CMPLX( WaveField%WaveElevC0(1,I), WaveField%WaveElevC0(2,I)) + ImagOmegaI = ImagNmbr*OmegaI + + WaveElevxiPrime0 = EXP( -ImagNmbr*WaveNmbr*( xi*Store%CosWaveDirArr(I) + & + yi*Store%SinWaveDirArr(I) )) + + WaveDynPC0 (I) = WaveField%RhoXg*tmpComplex*WaveElevxiPrime0 * COSHNumOvrCOSHDen ( WaveNmbr, WaveField%EffWtrDpth, zi ) + + WaveVelC0Hxi (I) = Store%CosWaveDirArr(I)*OmegaI*tmpComplex* WaveElevxiPrime0 * COSHNumOvrSINHDen ( WaveNmbr, WaveField%EffWtrDpth, zi ) + WaveVelC0Hyi (I) = Store%SinWaveDirArr(I)*OmegaI*tmpComplex* WaveElevxiPrime0 * COSHNumOvrSINHDen ( WaveNmbr, WaveField%EffWtrDpth, zi ) + + WaveVelC0V (I) = ImagOmegaI*tmpComplex* WaveElevxiPrime0 * SINHNumOvrSINHDen ( WaveNmbr, WaveField%EffWtrDpth, zi ) + WaveAccC0Hxi (I) = ImagOmegaI* WaveVelC0Hxi (I) + + WaveAccC0Hyi (I) = ImagOmegaI* WaveVelC0Hyi (I) + WaveAccC0V (I) = ImagOmegaI* WaveVelC0V (I) + + IF ( doMCF ) THEN + WaveAccC0HxiMCF(I) = WaveAccC0Hxi(I) * MCFC + WaveAccC0HyiMCF(I) = WaveAccC0Hyi(I) * MCFC + WaveAccC0VMCF(I) = WaveAccC0V(I) * MCFC + END IF + + END DO ! I - frequency components + + ! Compute the inverse discrete Fourier transforms to find the time-domain representations + CALL ApplyFFT_cx ( WaveDynP0B , WaveDynPC0 , FFT_Data, ErrStatTmp ); IF (FailedFFT('WaveDynPC0 ')) RETURN; + CALL ApplyFFT_cx ( WaveVel0Hxi, WaveVelC0Hxi, FFT_Data, ErrStatTmp ); IF (FailedFFT('WaveVelC0Hxi')) RETURN; + CALL ApplyFFT_cx ( WaveVel0Hyi, WaveVelC0Hyi, FFT_Data, ErrStatTmp ); IF (FailedFFT('WaveVelC0Hyi')) RETURN; + CALL ApplyFFT_cx ( WaveVel0V , WaveVelC0V , FFT_Data, ErrStatTmp ); IF (FailedFFT('WaveVelC0V ')) RETURN; + CALL ApplyFFT_cx ( WaveAcc0Hxi, WaveAccC0Hxi, FFT_Data, ErrStatTmp ); IF (FailedFFT('WaveAccC0Hxi')) RETURN; + CALL ApplyFFT_cx ( WaveAcc0Hyi, WaveAccC0Hyi, FFT_Data, ErrStatTmp ); IF (FailedFFT('WaveAccC0Hyi')) RETURN; + CALL ApplyFFT_cx ( WaveAcc0V , WaveAccC0V , FFT_Data, ErrStatTmp ); IF (FailedFFT('WaveAccC0V ')) RETURN; + IF ( doMCF ) THEN + CALL ApplyFFT_cx ( WaveAcc0HxiMCF, WaveAccC0HxiMCF, FFT_Data, ErrStatTmp ); IF (FailedFFT('WaveAcc0HxiMCF')) RETURN; + CALL ApplyFFT_cx ( WaveAcc0HyiMCF, WaveAccC0HyiMCF, FFT_Data, ErrStatTmp ); IF (FailedFFT('WaveAcc0HyiMCF')) RETURN; + CALL ApplyFFT_cx ( WaveAcc0VMCF , WaveAccC0VMCF , FFT_Data, ErrStatTmp ); IF (FailedFFT('WaveAcc0VMCF ')) RETURN; + END IF + + ! Add the steady current velocity to the wave velocity (same expression as VariousWaves_Init; skipped + ! entirely when no current profile exists so that -0.0 values are preserved exactly) + IF ( Store%HasCurr ) THEN + WaveVel0Hxi (:) = WaveVel0Hxi (:) + Store%CurrVxi(kzG) ! xi-direction + WaveVel0Hyi (:) = WaveVel0Hyi (:) + Store%CurrVyi(kzG) ! yi-direction + END IF + + ! Copy into the output arrays and wrap the last time step (periodic, = time step 0) + WaveDynP(0:WaveField%NStepWave-1,jx,jy,kz ) = WaveDynP0B (0:WaveField%NStepWave-1) + WaveVel (0:WaveField%NStepWave-1,jx,jy,kz,1) = WaveVel0Hxi(0:WaveField%NStepWave-1) + WaveVel (0:WaveField%NStepWave-1,jx,jy,kz,2) = WaveVel0Hyi(0:WaveField%NStepWave-1) + WaveVel (0:WaveField%NStepWave-1,jx,jy,kz,3) = WaveVel0V (0:WaveField%NStepWave-1) + WaveAcc (0:WaveField%NStepWave-1,jx,jy,kz,1) = WaveAcc0Hxi(0:WaveField%NStepWave-1) + WaveAcc (0:WaveField%NStepWave-1,jx,jy,kz,2) = WaveAcc0Hyi(0:WaveField%NStepWave-1) + WaveAcc (0:WaveField%NStepWave-1,jx,jy,kz,3) = WaveAcc0V (0:WaveField%NStepWave-1) + WaveDynP(WaveField%NStepWave,jx,jy,kz ) = WaveDynP(0,jx,jy,kz ) + WaveVel (WaveField%NStepWave,jx,jy,kz,:) = WaveVel (0,jx,jy,kz,:) + WaveAcc (WaveField%NStepWave,jx,jy,kz,:) = WaveAcc (0,jx,jy,kz,:) + IF ( doMCF ) THEN + WaveAccMCF (0:WaveField%NStepWave-1,jx,jy,kz,1) = WaveAcc0HxiMCF(0:WaveField%NStepWave-1) + WaveAccMCF (0:WaveField%NStepWave-1,jx,jy,kz,2) = WaveAcc0HyiMCF(0:WaveField%NStepWave-1) + WaveAccMCF (0:WaveField%NStepWave-1,jx,jy,kz,3) = WaveAcc0VMCF (0:WaveField%NStepWave-1) + WaveAccMCF (WaveField%NStepWave,jx,jy,kz,:) = WaveAccMCF(0,jx,jy,kz,:) + END IF + + END IF + + END DO ! kz - grid z levels + END DO ! jx - columns in x + END DO ! jy - columns in y + + CALL ExitFFT(FFT_Data, ErrStatTmp) + CALL SetErrStat(ErrStatTmp,'Error occurred while cleaning up after the FFTs.',ErrStat,ErrMsg,RoutineName) + +CONTAINS + + LOGICAL FUNCTION FailedFFT(txt) + CHARACTER(*), INTENT(IN) :: txt + IF (ErrStatTmp /= 0) THEN + CALL SetErrStat(ErrID_Fatal,'Error occurred while applying the FFT to '//TRIM(txt)//'.',ErrStat,ErrMsg,RoutineName) + FailedFFT = .TRUE. + CALL ExitFFT(FFT_Data, ErrStatTmp) + ELSE + FailedFFT = .FALSE. + END IF + END FUNCTION FailedFFT + +END SUBROUTINE WaveKinKernel_ComputeColumns + diff --git a/modules/seastate/src/Waves2.f90 b/modules/seastate/src/Waves2.f90 index b8c985dafb..d2680f4279 100644 --- a/modules/seastate/src/Waves2.f90 +++ b/modules/seastate/src/Waves2.f90 @@ -51,7 +51,9 @@ MODULE Waves2 ! ..... Public Subroutines ................................................................................................... - PUBLIC :: Waves2_Init !< Initialization routine + PUBLIC :: Waves2_Init !< Initialization routine (input checks + WaveElev2 surface correction) + PUBLIC :: Waves2_CaptureKernelSeeds !< Capture the seeds WaveKinKernel_AddSecondOrderColumns needs into a block store + PUBLIC :: WaveKinKernel_AddSecondOrderColumns !< Shared per-column second-order volume kernel (mode 0 full-domain add + mode 1 block population) CONTAINS @@ -59,11 +61,10 @@ MODULE Waves2 !> @brief !! This routine is called at the start of the simulation to perform initialization steps. !! The parameters that are set here are not changed during the simulation. -SUBROUTINE Waves2_Init( InitInp, InitOut, WaveField, ErrStat, ErrMsg ) +SUBROUTINE Waves2_Init( InitInp, WaveField, ErrStat, ErrMsg ) !.................................................................................................................................. TYPE(Waves2_InitInputType), INTENT(IN ) :: InitInp !< Input data for initialization routine - TYPE(Waves2_InitOutputType), INTENT( OUT) :: InitOut !< Output for initialization routine TYPE(SeaSt_WaveFieldType), INTENT(INOUT) :: WaveField !< WaveFieldType INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None @@ -72,56 +73,18 @@ SUBROUTINE Waves2_Init( InitInp, InitOut, WaveField, ErrStat, ErrMsg ) ! Local Variables INTEGER(IntKi) :: I,ii !< Generic counters INTEGER(IntKi) :: J, jj,k,kk !< Generic counters - integer(IntKi) :: masterCount !< Counter from 1 to NWaveKinGrid - INTEGER(IntKi) :: n !< Generic counter for calculations - INTEGER(IntKi) :: m !< Generic counter for calculations INTEGER(IntKi) :: mu_minus !< Generic counter for difference kinematics calculations INTEGER(IntKi) :: mu_plus !< Generic counter for sum kinematics calculations - REAL(SiKi) :: B_minus !< The value of the \f$ B^-_{nm} \f$ transfer function for the current n,m,z. - REAL(SiKi) :: B_plus !< The value of the \f$ B^+_{nm} \f$ transfer function for the current n,m,z. - - REAL(SiKi) :: Omega_n !< The frequency corresponding to index n - REAL(SiKi) :: Omega_m !< The frequency corresponding to index m REAL(SiKi) :: Omega_minus !< The difference frequency corresponding to \f$ \omega_{\mu^-} \f$ REAL(SiKi) :: Omega_plus !< The sum frequency corresponding to \f$ \omega_{\mu^+} \f$ - REAL(SiKi) :: k_n !< The wavenumber corresponding to \f$ \omega_n \f$ - REAL(SiKi) :: k_m !< The wavenumber corresponding to \f$ \omega_m \f$ - REAL(SiKi) :: k_nm !< Value of \f$ k_{nm}^{-} \f$ - COMPLEX(SiKi) :: WaveElevxyPrime0 !< The dot product of the wave vector differece and location \f$ \exp[ -i * (\vec{k_n}-\vec{k_m})\cdot\vec{x}] \f$ COMPLEX(SiKi) :: WaveElevC_n !< The complex wave elevation for the nth frequency component COMPLEX(SiKi) :: WaveElevC_m !< The complex wave elevation for the mth frequency component COMPLEX(SiKi), ALLOCATABLE :: WaveElevC0Norm(:) !< The complex wave amplitude, normalized for these equations. - ! Velocity calculations - REAL(SiKi) :: Ux_nm_minus !< The value of \f$ _xU^-_{nm} = B_{nm}^- \cdot (|\vec{k_n}|\cos \theta_n - |\vec{k_m}|\cos \theta_m) \f$ used in calculating the x-component of the second order wave velocity - REAL(SiKi) :: Ux_nm_plus !< The value of \f$ _xU^+_{nm} = B_{nm}^+ \cdot (|\vec{k_n}|\cos \theta_n + |\vec{k_m}|\cos \theta_m) \f$ used in calculating the x-component of the second order sum-frequency wave velocity - REAL(SiKi) :: Uy_nm_minus !< The value of \f$ _yU^-_{nm} = B_{nm}^- \cdot (|\vec{k_n}|\sin \theta_n - |\vec{k_m}|\sin \theta_m) \f$ used in calculating the y-component of the second order wave velocity - REAL(SiKi) :: Uy_nm_plus !< The value of \f$ _yU^+_{nm} = B_{nm}^+ \cdot (|\vec{k_n}|\sin \theta_n + |\vec{k_m}|\sin \theta_m) \f$ used in calculating the y-component of the second order sum-frequency wave velocity - COMPLEX(SiKi) :: Uz_nm_minus !< The value of \f$ _z{U}^-_{nm} = (\imath) \cdot {B}_{nm}^- \cdot k^-_{nm} \cdot \tanh[k^-_{nm}(h+z)] \f$ used in calculating the z-component of the second order wave velocity - COMPLEX(SiKi) :: Uz_nm_plus !< The value of \f$ _z{U}^+_{nm} = (\imath) \cdot {B}_{nm}^+ \cdot k^+_{nm} \cdot \tanh[k^+_{nm}(h+z)] \f$ used in calculating the z-component of the second order sum-frequency wave velocity - - ! Acceleration calculations - COMPLEX(SiKi) :: Accx_nm_minus !< The value of \f$ _xAcc^-_{nm} = (\imath) \cdot _xU^-_{nm} \omega_{\mu^-} \f$ - COMPLEX(SiKi) :: Accx_nm_plus !< The value of \f$ _xAcc^+_{nm} = (\imath) \cdot _xU^+_{nm} \omega_{\mu^+} \f$ - COMPLEX(SiKi) :: Accy_nm_minus !< The value of \f$ _yAcc^-_{nm} = (\imath) \cdot _yU^-_{nm} \omega_{\mu^-} \f$ - COMPLEX(SiKi) :: Accy_nm_plus !< The value of \f$ _yAcc^+_{nm} = (\imath) \cdot _yU^+_{nm} \omega_{\mu^+} \f$ - COMPLEX(SiKi) :: Accz_nm_minus !< The value of \f$ _z{Acc}^-_{nm} = (\imath) \cdot _zU^-_{nm} \omega_{\mu^-} \f$ - COMPLEX(SiKi) :: Accz_nm_plus !< The value of \f$ _z{Acc}^+_{nm} = (\imath) \cdot _zU^+_{nm} \omega_{\mu^+} \f$ - - ! Pressure calculations - REAL(SiKi) :: DynP_nm_minus !< The value of \f$ \rho_\mathrm{w} B_{nm}^- \omega_{\mu^-} \f$ - REAL(SiKi) :: DynP_nm_plus !< The value of \f$ \rho_\mathrm{w} B_{nm}^+ \omega_{\mu^+} \f$ - - ! Tracking of joints for which we are doing calculations - REAL(SiKi), ALLOCATABLE :: WaveKinzi0Prime(:) !< zi-coordinates for points where the incident wave kinematics will be computed before applying stretching; these are relative to the mean see level (meters) - INTEGER(IntKi), ALLOCATABLE :: WaveKinPrimeMap(:) !< Mapping function for the wave kinematics to calculate (based on depth) - INTEGER(IntKi) :: NWaveKin0Prime !< Number of points where the incident wave kinematics will be computed before applying stretching to the instantaneous free surface (-) - - ! Second order wave elevation calculations REAL(SiKi), ALLOCATABLE :: TmpTimeSeries(:) !< Temporary storage for a wave elevation time series for a single point. REAL(SiKi), ALLOCATABLE :: TmpTimeSeries2(:) !< Temporary storage for a wave elevation time series for a single point. @@ -129,52 +92,6 @@ SUBROUTINE Waves2_Init( InitInp, InitOut, WaveField, ErrStat, ErrMsg ) COMPLEX(SiKi), ALLOCATABLE :: TmpFreqSeries2(:) !< Temporary storage for a wave elevation frequency series for a single point. - ! Calculation of 2nd order particle acceleration, velocity, and pressure terms - COMPLEX(SiKi), ALLOCATABLE :: WaveVel2xCDiff(:) !< Frequency space difference frequency particle velocity term in the x direction - COMPLEX(SiKi), ALLOCATABLE :: WaveVel2yCDiff(:) !< Frequency space difference frequency particle velocity term in the y direction - COMPLEX(SiKi), ALLOCATABLE :: WaveVel2zCDiff(:) !< Frequency space difference frequency particle velocity term in the z direction - COMPLEX(SiKi), ALLOCATABLE :: WaveAcc2xCDiff(:) !< Frequency space difference frequency particle acceleration term in the x direction - COMPLEX(SiKi), ALLOCATABLE :: WaveAcc2yCDiff(:) !< Frequency space difference frequency particle acceleration term in the y direction - COMPLEX(SiKi), ALLOCATABLE :: WaveAcc2zCDiff(:) !< Frequency space difference frequency particle acceleration term in the z direction - REAL(SiKi), ALLOCATABLE :: WaveVel2xDiff(:) !< Time domain difference frequency particle velocity term in the x direction - REAL(SiKi), ALLOCATABLE :: WaveVel2yDiff(:) !< Time domain difference frequency particle velocity term in the y direction - REAL(SiKi), ALLOCATABLE :: WaveVel2zDiff(:) !< Time domain difference frequency particle velocity term in the z direction - REAL(SiKi), ALLOCATABLE :: WaveAcc2xDiff(:) !< Time domain difference frequency particle acceleration term in the x direction - REAL(SiKi), ALLOCATABLE :: WaveAcc2yDiff(:) !< Time domain difference frequency particle acceleration term in the y direction - REAL(SiKi), ALLOCATABLE :: WaveAcc2zDiff(:) !< Time domain difference frequency particle acceleration term in the z direction - COMPLEX(SiKi), ALLOCATABLE :: WaveDynP2CDiff(:) !< Frequency space difference frequency dynamic pressure term - REAL(SiKi), ALLOCATABLE :: WaveDynP2Diff(:) !< Time domain difference frequency dynamic pressure term - - COMPLEX(SiKi), ALLOCATABLE :: WaveVel2xCSumT1(:) !< Frequency space difference frequency particle velocity term 1 in the x direction - COMPLEX(SiKi), ALLOCATABLE :: WaveVel2yCSumT1(:) !< Frequency space difference frequency particle velocity term 1 in the y direction - COMPLEX(SiKi), ALLOCATABLE :: WaveVel2zCSumT1(:) !< Frequency space difference frequency particle velocity term 1 in the z direction - COMPLEX(SiKi), ALLOCATABLE :: WaveAcc2xCSumT1(:) !< Frequency space difference frequency particle acceleration term 1 in the x direction - COMPLEX(SiKi), ALLOCATABLE :: WaveAcc2yCSumT1(:) !< Frequency space difference frequency particle acceleration term 1 in the y direction - COMPLEX(SiKi), ALLOCATABLE :: WaveAcc2zCSumT1(:) !< Frequency space difference frequency particle acceleration term 1 in the z direction - REAL(SiKi), ALLOCATABLE :: WaveVel2xSumT1(:) !< Time domain difference frequency particle velocity term 1 in the x direction - REAL(SiKi), ALLOCATABLE :: WaveVel2ySumT1(:) !< Time domain difference frequency particle velocity term 1 in the y direction - REAL(SiKi), ALLOCATABLE :: WaveVel2zSumT1(:) !< Time domain difference frequency particle velocity term 1 in the z direction - REAL(SiKi), ALLOCATABLE :: WaveAcc2xSumT1(:) !< Time domain difference frequency particle acceleration term 1 in the x direction - REAL(SiKi), ALLOCATABLE :: WaveAcc2ySumT1(:) !< Time domain difference frequency particle acceleration term 1 in the y direction - REAL(SiKi), ALLOCATABLE :: WaveAcc2zSumT1(:) !< Time domain difference frequency particle acceleration term 1 in the z direction - COMPLEX(SiKi), ALLOCATABLE :: WaveDynP2CSumT1(:) !< Frequency space difference frequency dynamic pressure term 1 - REAL(SiKi), ALLOCATABLE :: WaveDynP2SumT1(:) !< Time domain difference frequency dynamic pressure term 1 - - COMPLEX(SiKi), ALLOCATABLE :: WaveVel2xCSumT2(:) !< Frequency space difference frequency particle velocity term 2 in the x direction - COMPLEX(SiKi), ALLOCATABLE :: WaveVel2yCSumT2(:) !< Frequency space difference frequency particle velocity term 2 in the y direction - COMPLEX(SiKi), ALLOCATABLE :: WaveVel2zCSumT2(:) !< Frequency space difference frequency particle velocity term 2 in the z direction - COMPLEX(SiKi), ALLOCATABLE :: WaveAcc2xCSumT2(:) !< Frequency space difference frequency particle acceleration term 2 in the x direction - COMPLEX(SiKi), ALLOCATABLE :: WaveAcc2yCSumT2(:) !< Frequency space difference frequency particle acceleration term 2 in the y direction - COMPLEX(SiKi), ALLOCATABLE :: WaveAcc2zCSumT2(:) !< Frequency space difference frequency particle acceleration term 2 in the z direction - REAL(SiKi), ALLOCATABLE :: WaveVel2xSumT2(:) !< Time domain difference frequency particle velocity term 2 in the x direction - REAL(SiKi), ALLOCATABLE :: WaveVel2ySumT2(:) !< Time domain difference frequency particle velocity term 2 in the y direction - REAL(SiKi), ALLOCATABLE :: WaveVel2zSumT2(:) !< Time domain difference frequency particle velocity term 2 in the z direction - REAL(SiKi), ALLOCATABLE :: WaveAcc2xSumT2(:) !< Time domain difference frequency particle acceleration term 2 in the x direction - REAL(SiKi), ALLOCATABLE :: WaveAcc2ySumT2(:) !< Time domain difference frequency particle acceleration term 2 in the y direction - REAL(SiKi), ALLOCATABLE :: WaveAcc2zSumT2(:) !< Time domain difference frequency particle acceleration term 2 in the z direction - COMPLEX(SiKi), ALLOCATABLE :: WaveDynP2CSumT2(:) !< Frequency space difference frequency dynamic pressure term 2 - REAL(SiKi), ALLOCATABLE :: WaveDynP2SumT2(:) !< Time domain difference frequency dynamic pressure term 2 - ! Stuff for the FFT calculations TYPE(FFT_DataType) :: FFT_Data !< the instance of the FFT module we're using @@ -244,117 +161,12 @@ SUBROUTINE Waves2_Init( InitInp, InitOut, WaveField, ErrStat, ErrMsg ) WaveElevC0Norm(I) = CMPLX( WaveField%WaveElevC0(1,I), WaveField%WaveElevC0(2,I), SiKi ) / REAL(WaveField%NStepWave2,SiKi) ENDDO - !-------------------------------------------------------------------------------- - ! Setup WaveKin0Prime -- points from the mesh that are passed in - !-------------------------------------------------------------------------------- - - !> @note Wave stretching will need to be incorporated here when we add it to - !! the waves module. - - ! Determine the number of, NWaveKin0Prime, and the zi-coordinates for, - ! WaveKinzi0Prime(:), points where the incident wave kinematics will be - ! computed before applying stretching to the instantaneous free surface. - ! The locations are relative to the mean see level. These depend on - ! which incident wave kinematics stretching method is being used: - - - ! SELECT CASE ( InitInp%WaveStMod ) ! Which model are we using to extrapolate the incident wave kinematics to the instantaneous free surface? - - ! CASE ( 0 ) ! None=no stretching. - - - ! Since we have no stretching, NWaveKin0Prime and WaveKinzi0Prime(:) are - ! equal to the number of, and the zi-coordinates for, the points in the - ! WaveKinGridzi(:) array between, and including, -EffWtrDpth and 0.0. - - ! Determine NWaveKin0Prime here: - - NWaveKin0Prime = 0 - DO J = 1,InitInp%NWaveKinGrid ! Loop through all mesh points where the incident wave kinematics will be computed - ! NOTE: We test to 0 instead of MSL2SWL because the locations of WaveKinGridzi and EffWtrDpth have already been adjusted using MSL2SWL - IF ( InitInp%WaveKinGridzi(J) >= -WaveField%EffWtrDpth .AND. InitInp%WaveKinGridzi(J) <= 0 ) THEN - NWaveKin0Prime = NWaveKin0Prime + 1 - END IF - END DO ! J - All Morison nodes where the incident wave kinematics will be computed - - - - ! ALLOCATE the WaveKinzi0Prime(:) array and compute its elements here: - - ALLOCATE ( WaveKinzi0Prime(NWaveKin0Prime) , STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveKinzi0Prime.',ErrStat,ErrMsg,RoutineName) - - ALLOCATE ( WaveKinPrimeMap(NWaveKin0Prime) , STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveKinPrimeMap.',ErrStat,ErrMsg,RoutineName) - - IF ( ErrStat >= AbortErrLev ) THEN - CALL CleanUp() - RETURN - END IF - - - I = 1 - - DO J = 1,InitInp%NWaveKinGrid ! Loop through all points where the incident wave kinematics will be computed without stretching - ! NOTE: We test to 0 instead of MSL2SWL because the locations of WaveKinGridzi and EffWtrDpth have already been adjusted using MSL2SWL - IF ( InitInp%WaveKinGridzi(J) >= -WaveField%EffWtrDpth .AND. InitInp%WaveKinGridzi(J) <= 0 ) THEN - - WaveKinzi0Prime(I) = InitInp%WaveKinGridzi(J) - WaveKinPrimeMap(I) = J - I = I + 1 - - END IF - - END DO ! J - All points where the incident wave kinematics will be computed without stretching - - - - !CASE ( 1, 2 ) ! Vertical stretching or extrapolation stretching. - ! CALL SetErrStat(ErrID_Fatal,' Vertical and extrapolation stretching not supported in second order calculations.',ErrStat,ErrMsg,RoutineName) - ! - ! - !CASE ( 3 ) ! Wheeler stretching. - ! CALL SetErrStat(ErrID_Fatal,' Wheeler stretching not supported in second order calculations.',ErrStat,ErrMsg,RoutineName) - ! - !CASE DEFAULT - ! CALL SetErrStat(ErrID_Fatal,' Stretching is not supported in the second order waves kinematics calculations.',ErrStat,ErrMsg,RoutineName) - ! - ! - !ENDSELECT - - - IF ( ErrStat >= AbortErrLev ) THEN - CALL CleanUp() - RETURN - END IF - - - - !-------------------------------------------------------------------------------- ! Setup the output arrays !-------------------------------------------------------------------------------- ALLOCATE ( WaveField%WaveElev2 (0:WaveField%NStepWave,InitInp%NGrid(1),InitInp%NGrid(2) ) , STAT=ErrStatTmp ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveField%WaveElev2.', ErrStat,ErrMsg,RoutineName) - ALLOCATE ( InitOut%WaveVel2D (0:WaveField%NStepWave,InitInp%NGrid(1),InitInp%NGrid(2),InitInp%NGrid(3),3), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array InitOut%WaveVel2D.', ErrStat,ErrMsg,RoutineName) - - ALLOCATE ( InitOut%WaveAcc2D (0:WaveField%NStepWave,InitInp%NGrid(1),InitInp%NGrid(2),InitInp%NGrid(3),3), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array InitOut%WaveAcc2D.', ErrStat,ErrMsg,RoutineName) - - ALLOCATE ( InitOut%WaveDynP2D (0:WaveField%NStepWave,InitInp%NGrid(1),InitInp%NGrid(2),InitInp%NGrid(3) ), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array InitOut%WaveDynP2D.', ErrStat,ErrMsg,RoutineName) - - ALLOCATE ( InitOut%WaveVel2S (0:WaveField%NStepWave,InitInp%NGrid(1),InitInp%NGrid(2),InitInp%NGrid(3),3), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array InitOut%WaveVel2S.', ErrStat,ErrMsg,RoutineName) - - ALLOCATE ( InitOut%WaveAcc2S (0:WaveField%NStepWave,InitInp%NGrid(1),InitInp%NGrid(2),InitInp%NGrid(3),3), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array InitOut%WaveAcc2S.', ErrStat,ErrMsg,RoutineName) - - ALLOCATE ( InitOut%WaveDynP2S (0:WaveField%NStepWave,InitInp%NGrid(1),InitInp%NGrid(2),InitInp%NGrid(3) ), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array InitOut%WaveDynP2S.', ErrStat,ErrMsg,RoutineName) - ! Now check if all the allocations worked properly IF ( ErrStat >= AbortErrLev ) THEN CALL CleanUp() @@ -363,12 +175,6 @@ SUBROUTINE Waves2_Init( InitInp, InitOut, WaveField, ErrStat, ErrMsg ) !Initialize the output arrays to zero. We will only fill it in for the points we calculate. WaveField%WaveElev2 = 0.0_SiKi - InitOut%WaveVel2D = 0.0_SiKi - InitOut%WaveAcc2D = 0.0_SiKi - InitOut%WaveDynP2D = 0.0_SiKi - InitOut%WaveVel2S = 0.0_SiKi - InitOut%WaveAcc2S = 0.0_SiKi - InitOut%WaveDynP2S = 0.0_SiKi @@ -424,62 +230,6 @@ SUBROUTINE Waves2_Init( InitInp, InitOut, WaveField, ErrStat, ErrMsg ) CALL WrScr ( ' Calculating second order difference frequency wave kinematics.' ) - !-------------------------------------------------------------------------------- - ! Setup arrays for the calculations - !-------------------------------------------------------------------------------- - - ! Frequency space arrays: - - ALLOCATE ( WaveVel2xCDiff (0:WaveField%NStepWave2), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveVel2xCDiff.', ErrStat,ErrMsg,RoutineName) - ALLOCATE ( WaveVel2yCDiff (0:WaveField%NStepWave2), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveVel2yCDiff.', ErrStat,ErrMsg,RoutineName) - ALLOCATE ( WaveVel2zCDiff (0:WaveField%NStepWave2), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveVel2zCDiff.', ErrStat,ErrMsg,RoutineName) - - ALLOCATE ( WaveAcc2xCDiff (0:WaveField%NStepWave2), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveAcc2xCDiff.', ErrStat,ErrMsg,RoutineName) - ALLOCATE ( WaveAcc2yCDiff (0:WaveField%NStepWave2), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveAcc2yCDiff.', ErrStat,ErrMsg,RoutineName) - ALLOCATE ( WaveAcc2zCDiff (0:WaveField%NStepWave2), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveAcc2zCDiff.', ErrStat,ErrMsg,RoutineName) - - ALLOCATE ( WaveDynP2CDiff (0:WaveField%NStepWave2), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveDynP2CDiff.', ErrStat,ErrMsg,RoutineName) - - ! Now check if all the allocations worked properly - IF ( ErrStat >= AbortErrLev ) THEN - CALL CleanUp() - RETURN - END IF - - - ! Time domain arrays: - ALLOCATE ( WaveVel2xDiff (0:WaveField%NStepWave), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveVel2xDiff.', ErrStat,ErrMsg,RoutineName) - ALLOCATE ( WaveVel2yDiff (0:WaveField%NStepWave), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveVel2yDiff.', ErrStat,ErrMsg,RoutineName) - ALLOCATE ( WaveVel2zDiff (0:WaveField%NStepWave), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveVel2zDiff.', ErrStat,ErrMsg,RoutineName) - - ALLOCATE ( WaveAcc2xDiff (0:WaveField%NStepWave), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveAcc2xDiff.', ErrStat,ErrMsg,RoutineName) - ALLOCATE ( WaveAcc2yDiff (0:WaveField%NStepWave), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveAcc2yDiff.', ErrStat,ErrMsg,RoutineName) - ALLOCATE ( WaveAcc2zDiff (0:WaveField%NStepWave), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveAcc2zDiff.', ErrStat,ErrMsg,RoutineName) - - ALLOCATE ( WaveDynP2Diff (0:WaveField%NStepWave), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveDynP2Diff.', ErrStat,ErrMsg,RoutineName) - - ! Now check if all the allocations worked properly - IF ( ErrStat >= AbortErrLev ) THEN - CALL CleanUp() - RETURN - END IF - - - !-------------------------------------------------------------------------------- !> ## Calculate the surface elevation corrections ## !! @@ -505,219 +255,6 @@ SUBROUTINE Waves2_Init( InitInp, InitOut, WaveField, ErrStat, ErrMsg ) - !-------------------------------------------------------------------------------- - !> ## Calculate the second order velocity, acceleration, and pressure corrections for all joints below surface. ## - !-------------------------------------------------------------------------------- - - - ! NWaveKin0Prime loop start - DO I=1,NWaveKin0Prime - masterCount = WaveKinPrimeMap(I) - - ! Reset the \f$ H_{\mu^-} \f$ terms to zero before calculating. - WaveVel2xCDiff = CMPLX(0.0_SiKi, 0.0_SiKi, SiKi) - WaveVel2yCDiff = CMPLX(0.0_SiKi, 0.0_SiKi, SiKi) - WaveVel2zCDiff = CMPLX(0.0_SiKi, 0.0_SiKi, SiKi) - WaveAcc2xCDiff = CMPLX(0.0_SiKi, 0.0_SiKi, SiKi) - WaveAcc2yCDiff = CMPLX(0.0_SiKi, 0.0_SiKi, SiKi) - WaveAcc2zCDiff = CMPLX(0.0_SiKi, 0.0_SiKi, SiKi) - WaveDynP2CDiff = CMPLX(0.0_SiKi, 0.0_SiKi, SiKi) - - - ! \f$ \mu^- \f$ loop. This loop is used to construct the full set of \f$ H_{\mu^-} \f$ terms used in the IFFT to find the timeseries. - !> * \f$ \mu^- = n -m \f$ - DO mu_minus=1,WaveField%NStepWave2-1 - - ! The frequency we are dealing with - !> * \f$ \omega^- = \mu^- \Delta \omega \f$ - Omega_minus = mu_minus * WaveField%WaveDOmega - - IF ( Omega_minus >= WaveField%WvLowCOffD .AND. Omega_minus <= WaveField%WvHiCOffD ) THEN - - ! The inner \f$ m \f$ loop for calculating the \f$ H_{\mu^-} \f$ terms at each frequency. - DO m=1,WaveField%NStepWave2-mu_minus - ! Calculate the value of the n index from \f$ \mu^- = n - m \f$. Calculate corresponding wavenumbers and frequencies. - n = mu_minus + m - Omega_n = n * WaveField%WaveDOmega - Omega_m = m * WaveField%WaveDOmega - k_n = WaveNumber( Omega_n, InitInp%Gravity, WaveField%EffWtrDpth ) - k_m = WaveNumber( Omega_m, InitInp%Gravity, WaveField%EffWtrDpth ) - k_nm = k_nm_minus( n, m, k_n, k_m ) - - - ! Calculate the terms \f$ n,m \f$ necessary for calculations - - !> Calculate the dot product of the wavenumbers with the (x,y) location - !! This is given by: - !! - !! * \f$ \exp\left(-\imath \left[\vec{k_n} - \vec{k_m} \right] \cdot \vec{x} \right) - !! = \exp \left( -\imath \left[ - !! \left( |\vec{k_n}| \cos \theta_n - |\vec{k_m}| cos \theta_m \right) ~ x - !! + \left( |\vec{k_n}| \sin \theta_n - |\vec{k_m}| sin \theta_m \right) ~ y \right] \right) \f$ - - WaveElevxyPrime0 = exp( - ImagNmbr & - * ( ( k_n * COS( D2R_S*WaveField%WaveDirArr(n) ) - k_m * COS( D2R_S*WaveField%WaveDirArr(m) ) ) * InitInp%WaveKinGridxi(masterCount) & - + ( k_n * SIN( D2R_S*WaveField%WaveDirArr(n) ) - k_m * SIN( D2R_S*WaveField%WaveDirArr(m) ) ) * InitInp%WaveKinGridyi(masterCount) )) - - - ! Get value for \f$ B^- \f$ for the n,m index pair - B_minus = TransFuncB_minus( n, m, k_n, k_m, WaveKinzi0Prime(I) ) - - - !> Calculate \f$ U^- \f$ terms for the velocity calculations (\f$B^-\f$ provided by waves2::transfuncb_minus) - ! NOTE: WaveField%EffWtrDpth + WaveKinzi0Prime(I) is the height above the ocean floor - !> * \f$ _x{U}_{nm}^- = B_{nm}^- \left(k_n \cos \theta_n - k_m \cos \theta_m \right) \f$ - Ux_nm_minus = B_minus * ( k_n * COS( D2R_S*WaveField%WaveDirArr(n) ) - k_m * COS( D2R_S*WaveField%WaveDirArr(m) ) ) - - !> * \f$ _y{U}_{nm}^- = B_{nm}^- \left(k_n \sin \theta_n - k_m \sin \theta_m \right) \f$ - Uy_nm_minus = B_minus * ( k_n * SIN( D2R_S*WaveField%WaveDirArr(n) ) - k_m * SIN( D2R_S*WaveField%WaveDirArr(m) ) ) - - !> * \f$ _z{U}_{nm}^- = \imath B_{nm}^- k_{nm} \tanh \left( k_{nm} ( h + z ) \right) \f$ - Uz_nm_minus = ImagNmbr * B_minus * k_nm * tanh( k_nm * ( WaveField%EffWtrDpth + WaveKinzi0Prime(I) ) ) - - - !> Acceleration calculations - Accx_nm_minus = ImagNmbr * Ux_nm_minus * Omega_minus !> * \f$ _x\dot{U}_{nm}^- = \imath * _xU_{nm}^- * \omega_{\mu^-} \f$ - Accy_nm_minus = ImagNmbr * Uy_nm_minus * Omega_minus !> * \f$ _y\dot{U}_{nm}^- = \imath * _yU_{nm}^- * \omega_{\mu^-} \f$ - Accz_nm_minus = ImagNmbr * Uz_nm_minus * Omega_minus !> * \f$ _z\dot{U}_{nm}^- = \imath * _zU_{nm}^- * \omega_{\mu^-} \f$ - - - !> Dynamic pressure - !> * \f$ P_{nm}^- = \rho_\mathrm{w} B_{nm}^- \omega_{\mu^-} \f$ - DynP_nm_minus = REAL(WaveField%WtrDens,SiKi) * B_minus * Omega_minus - - - - !> ### Calculate the inner summation \f$ H^-(\omega_{\mu^-}) \f$ terms for the velocity, acceleration, and pressure. ### - - - ! First get the wave amplitude -- must be reconstructed from the WaveElevC0 array. First index is the real (1) or - ! imaginary (2) part. Divide by NStepWave2 to remove the built in normalization in WaveElevC0. Note that the phase - ! shift associated with the (x,y) location is accounted for by the WaveElevxyPrime0 variable. - WaveElevC_n = WaveElevC0Norm(n) - WaveElevC_m = WaveElevC0Norm(m) - - !> Velocity terms: - !! * \f$ H^-(\omega_{\mu^-}) = {\sum_{m=1}^{\frac{N}{2}-\mu^{-}}} A_n A^*_m U_{nm}^- - !! \exp\left(-\imath (\vec{k_n} - \vec{k_m})\cdot\vec{x}\right) \f$ - WaveVel2xCDiff(mu_minus) = WaveVel2xCDiff(mu_minus) + WaveElevC_n * CONJG( WaveElevC_m ) * Ux_nm_minus * WaveElevxyPrime0 - WaveVel2yCDiff(mu_minus) = WaveVel2yCDiff(mu_minus) + WaveElevC_n * CONJG( WaveElevC_m ) * Uy_nm_minus * WaveElevxyPrime0 - WaveVel2zCDiff(mu_minus) = WaveVel2zCDiff(mu_minus) + WaveElevC_n * CONJG( WaveElevC_m ) * Uz_nm_minus * WaveElevxyPrime0 - - !> Acceleration terms: - !! * \f$ H^-(\omega_{\mu^-}) = {\sum_{m=1}^{\frac{N}{2}-\mu^{-}}} A_n A^*_m \dot{U}_{nm}^- - !! \exp\left(-\imath (\vec{k_n} - \vec{k_m})\cdot\vec{x}\right) \f$ - WaveAcc2xCDiff(mu_minus) = WaveAcc2xCDiff(mu_minus) + WaveElevC_n * CONJG( WaveElevC_m ) * Accx_nm_minus * WaveElevxyPrime0 - WaveAcc2yCDiff(mu_minus) = WaveAcc2yCDiff(mu_minus) + WaveElevC_n * CONJG( WaveElevC_m ) * Accy_nm_minus * WaveElevxyPrime0 - WaveAcc2zCDiff(mu_minus) = WaveAcc2zCDiff(mu_minus) + WaveElevC_n * CONJG( WaveElevC_m ) * Accz_nm_minus * WaveElevxyPrime0 - - !> Pressure term: - !! * \f$ H^-(\omega_{\mu^-}) = {\sum_{m=1}^{\frac{N}{2}-\mu^{-}}} A_n A^*_m P_{nm}^- - !! \exp\left(-\imath (\vec{k_n} - \vec{k_m})\cdot\vec{x}\right) \f$ - WaveDynP2CDiff(mu_minus) = WaveDynP2CDiff(mu_minus) + WaveElevC_n * CONJG( WaveElevC_m ) * DynP_nm_minus * WaveElevxyPrime0 - - - ENDDO ! m loop - - - ENDIF ! Check to see if WvLowCOffD <= mu_minus <= WvHiCOffD - - ENDDO ! mu_minus loop (diff frequency) - - ! Divide by two for the single sided FFT given in the documentation. - WaveVel2xCDiff = WaveVel2xCDiff / 2.0_SiKi - WaveVel2yCDiff = WaveVel2yCDiff / 2.0_SiKi - WaveVel2zCDiff = WaveVel2zCDiff / 2.0_SiKi - WaveAcc2xCDiff = WaveAcc2xCDiff / 2.0_SiKi - WaveAcc2yCDiff = WaveAcc2yCDiff / 2.0_SiKi - WaveAcc2zCDiff = WaveAcc2zCDiff / 2.0_SiKi - WaveDynP2CDiff = WaveDynP2CDiff / 2.0_SiKi - - - - - !> ### Apply the inverse FFT to each of the components to get the time domain result ### - !> * \f$ V(t) = 2 \operatorname{IFFT}\left[H^-\right] \f$ - CALL ApplyFFT_cx( WaveVel2xDiff(:), WaveVel2xCDiff(:), FFT_Data, ErrStatTmp ) - CALL SetErrStat(ErrStatTmp,'Error occurred while applying the FFT on V_x.',ErrStat,ErrMsg,RoutineName) - CALL ApplyFFT_cx( WaveVel2yDiff(:), WaveVel2yCDiff(:), FFT_Data, ErrStatTmp ) - CALL SetErrStat(ErrStatTmp,'Error occurred while applying the FFT on V_y.',ErrStat,ErrMsg,RoutineName) - CALL ApplyFFT_cx( WaveVel2zDiff(:), WaveVel2zCDiff(:), FFT_Data, ErrStatTmp ) - CALL SetErrStat(ErrStatTmp,'Error occurred while applying the FFT on V_z.',ErrStat,ErrMsg,RoutineName) - - CALL ApplyFFT_cx( WaveAcc2xDiff(:), WaveAcc2xCDiff(:), FFT_Data, ErrStatTmp ) - CALL SetErrStat(ErrStatTmp,'Error occurred while applying the FFT on Acc_x.',ErrStat,ErrMsg,RoutineName) - CALL ApplyFFT_cx( WaveAcc2yDiff(:), WaveAcc2yCDiff(:), FFT_Data, ErrStatTmp ) - CALL SetErrStat(ErrStatTmp,'Error occurred while applying the FFT on Acc_y.',ErrStat,ErrMsg,RoutineName) - CALL ApplyFFT_cx( WaveAcc2zDiff(:), WaveAcc2zCDiff(:), FFT_Data, ErrStatTmp ) - CALL SetErrStat(ErrStatTmp,'Error occurred while applying the FFT on Acc_z.',ErrStat,ErrMsg,RoutineName) - - CALL ApplyFFT_cx( WaveDynP2Diff(:), WaveDynP2CDiff(:), FFT_Data, ErrStatTmp ) - CALL SetErrStat(ErrStatTmp,'Error occurred while applying the FFT on DynP2.',ErrStat,ErrMsg,RoutineName) - - - - IF ( ErrStat >= AbortErrLev ) THEN - CALL CleanUp() - RETURN - END IF - - - ! Copy the results to the output - ii = mod(masterCount-1, InitInp%NGrid(1)) + 1 - jj = mod( (masterCount-1) /InitInp%NGrid(1), InitInp%NGrid(2) ) + 1 - kk = (masterCount-1) / (InitInp%NGrid(1)*InitInp%NGrid(2)) + 1 - - InitOut%WaveVel2D(:,ii,jj,kk,1) = 2.0_SiKi * WaveVel2xDiff(:) ! x-component of velocity - InitOut%WaveVel2D(:,ii,jj,kk,2) = 2.0_SiKi * WaveVel2yDiff(:) ! y-component of velocity - InitOut%WaveVel2D(:,ii,jj,kk,3) = 2.0_SiKi * WaveVel2zDiff(:) ! z-component of velocity - - InitOut%WaveAcc2D(:,ii,jj,kk,1) = 2.0_SiKi * WaveAcc2xDiff(:) ! x-component of acceleration - InitOut%WaveAcc2D(:,ii,jj,kk,2) = 2.0_SiKi * WaveAcc2yDiff(:) ! y-component of acceleration - InitOut%WaveAcc2D(:,ii,jj,kk,3) = 2.0_SiKi * WaveAcc2zDiff(:) ! z-component of acceleration - - InitOut%WaveDynP2D(:,ii,jj,kk) = 2.0_SiKi * WaveDynP2Diff(:) ! Dynamic pressure - - - ! Copy the first point to the last to make it easier. - ! TODO: Why don't these have the 2.0 multipler?? GJH 9/8/21 - InitOut%WaveVel2D(WaveField%NStepWave,ii,jj,kk,1) = WaveVel2xDiff(0) - InitOut%WaveVel2D(WaveField%NStepWave,ii,jj,kk,2) = WaveVel2yDiff(0) - InitOut%WaveVel2D(WaveField%NStepWave,ii,jj,kk,3) = WaveVel2zDiff(0) - - InitOut%WaveAcc2D(WaveField%NStepWave,ii,jj,kk,1) = WaveAcc2xDiff(0) - InitOut%WaveAcc2D(WaveField%NStepWave,ii,jj,kk,2) = WaveAcc2yDiff(0) - InitOut%WaveAcc2D(WaveField%NStepWave,ii,jj,kk,3) = WaveAcc2zDiff(0) - - InitOut%WaveDynP2D(WaveField%NStepWave,ii,jj,kk) = WaveDynP2Diff(0) - - - ENDDO ! I=1,NWaveKin0Prime loop end - - - ! Deallocate working arrays. - IF (ALLOCATED(WaveVel2xCDiff)) DEALLOCATE(WaveVel2xCDiff, STAT=ErrStatTmp) - IF (ALLOCATED(WaveVel2yCDiff)) DEALLOCATE(WaveVel2yCDiff, STAT=ErrStatTmp) - IF (ALLOCATED(WaveVel2zCDiff)) DEALLOCATE(WaveVel2zCDiff, STAT=ErrStatTmp) - IF (ALLOCATED(WaveAcc2xCDiff)) DEALLOCATE(WaveAcc2xCDiff, STAT=ErrStatTmp) - IF (ALLOCATED(WaveAcc2yCDiff)) DEALLOCATE(WaveAcc2yCDiff, STAT=ErrStatTmp) - IF (ALLOCATED(WaveAcc2zCDiff)) DEALLOCATE(WaveAcc2zCDiff, STAT=ErrStatTmp) - IF (ALLOCATED(WaveDynP2CDiff)) DEALLOCATE(WaveDynP2CDiff, STAT=ErrStatTmp) - - IF (ALLOCATED(WaveVel2xDiff)) DEALLOCATE(WaveVel2xDiff, STAT=ErrStatTmp) - IF (ALLOCATED(WaveVel2yDiff)) DEALLOCATE(WaveVel2yDiff, STAT=ErrStatTmp) - IF (ALLOCATED(WaveVel2zDiff)) DEALLOCATE(WaveVel2zDiff, STAT=ErrStatTmp) - IF (ALLOCATED(WaveAcc2xDiff)) DEALLOCATE(WaveAcc2xDiff, STAT=ErrStatTmp) - IF (ALLOCATED(WaveAcc2yDiff)) DEALLOCATE(WaveAcc2yDiff, STAT=ErrStatTmp) - IF (ALLOCATED(WaveAcc2zDiff)) DEALLOCATE(WaveAcc2zDiff, STAT=ErrStatTmp) - IF (ALLOCATED(WaveDynP2Diff)) DEALLOCATE(WaveDynP2Diff, STAT=ErrStatTmp) - - IF ( ErrStat >= AbortErrLev ) THEN - CALL CleanUp() - RETURN - END IF - - ENDIF ! WvDiffQTFF @@ -749,100 +286,6 @@ SUBROUTINE Waves2_Init( InitInp, InitOut, WaveField, ErrStat, ErrMsg ) CALL WrScr ( ' Calculating second order sum frequency wave kinematics.' ) - !-------------------------------------------------------------------------------- - ! Setup arrays for the calculations - !-------------------------------------------------------------------------------- - - ! Frequency space arrays: Term 1 (n=m term) - - ALLOCATE ( WaveVel2xCSumT1 (0:WaveField%NStepWave2), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveVel2xCSumT1.', ErrStat,ErrMsg,RoutineName) - ALLOCATE ( WaveVel2yCSumT1 (0:WaveField%NStepWave2), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveVel2yCSumT1.', ErrStat,ErrMsg,RoutineName) - ALLOCATE ( WaveVel2zCSumT1 (0:WaveField%NStepWave2), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveVel2zCSumT1.', ErrStat,ErrMsg,RoutineName) - - ALLOCATE ( WaveAcc2xCSumT1 (0:WaveField%NStepWave2), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveAcc2xCSumT1.', ErrStat,ErrMsg,RoutineName) - ALLOCATE ( WaveAcc2yCSumT1 (0:WaveField%NStepWave2), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveAcc2yCSumT1.', ErrStat,ErrMsg,RoutineName) - ALLOCATE ( WaveAcc2zCSumT1 (0:WaveField%NStepWave2), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveAcc2zCSumT1.', ErrStat,ErrMsg,RoutineName) - - ALLOCATE ( WaveDynP2CSumT1 (0:WaveField%NStepWave2), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveDynP2CSumT1.', ErrStat,ErrMsg,RoutineName) - - ! Term 2 (n/=m term) - ALLOCATE ( WaveVel2xCSumT2 (0:WaveField%NStepWave2), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveVel2xCSumT2.', ErrStat,ErrMsg,RoutineName) - ALLOCATE ( WaveVel2yCSumT2 (0:WaveField%NStepWave2), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveVel2yCSumT2.', ErrStat,ErrMsg,RoutineName) - ALLOCATE ( WaveVel2zCSumT2 (0:WaveField%NStepWave2), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveVel2zCSumT2.', ErrStat,ErrMsg,RoutineName) - - ALLOCATE ( WaveAcc2xCSumT2 (0:WaveField%NStepWave2), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveAcc2xCSumT2.', ErrStat,ErrMsg,RoutineName) - ALLOCATE ( WaveAcc2yCSumT2 (0:WaveField%NStepWave2), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveAcc2yCSumT2.', ErrStat,ErrMsg,RoutineName) - ALLOCATE ( WaveAcc2zCSumT2 (0:WaveField%NStepWave2), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveAcc2zCSumT2.', ErrStat,ErrMsg,RoutineName) - - ALLOCATE ( WaveDynP2CSumT2 (0:WaveField%NStepWave2), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveDynP2CSumT2.', ErrStat,ErrMsg,RoutineName) - - ! Now check if all the allocations worked properly - IF ( ErrStat >= AbortErrLev ) THEN - CALL CleanUp() - RETURN - END IF - - - ! Time domain arrays: Term 1 (n=m term) - - ALLOCATE ( WaveVel2xSumT1 (0:WaveField%NStepWave), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveVel2xSumT1.', ErrStat,ErrMsg,RoutineName) - ALLOCATE ( WaveVel2ySumT1 (0:WaveField%NStepWave), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveVel2ySumT1.', ErrStat,ErrMsg,RoutineName) - ALLOCATE ( WaveVel2zSumT1 (0:WaveField%NStepWave), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveVel2zSumT1.', ErrStat,ErrMsg,RoutineName) - - ALLOCATE ( WaveAcc2xSumT1 (0:WaveField%NStepWave), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveAcc2xSumT1.', ErrStat,ErrMsg,RoutineName) - ALLOCATE ( WaveAcc2ySumT1 (0:WaveField%NStepWave), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveAcc2ySumT1.', ErrStat,ErrMsg,RoutineName) - ALLOCATE ( WaveAcc2zSumT1 (0:WaveField%NStepWave), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveAcc2zSumT1.', ErrStat,ErrMsg,RoutineName) - - ALLOCATE ( WaveDynP2SumT1 (0:WaveField%NStepWave), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveDynP2SumT1.', ErrStat,ErrMsg,RoutineName) - - ! Term 2 (n/=m term) - ALLOCATE ( WaveVel2xSumT2 (0:WaveField%NStepWave), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveVel2xSumT2.', ErrStat,ErrMsg,RoutineName) - ALLOCATE ( WaveVel2ySumT2 (0:WaveField%NStepWave), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveVel2ySumT2.', ErrStat,ErrMsg,RoutineName) - ALLOCATE ( WaveVel2zSumT2 (0:WaveField%NStepWave), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveVel2zSumT2.', ErrStat,ErrMsg,RoutineName) - - ALLOCATE ( WaveAcc2xSumT2 (0:WaveField%NStepWave), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveAcc2xSumT2.', ErrStat,ErrMsg,RoutineName) - ALLOCATE ( WaveAcc2ySumT2 (0:WaveField%NStepWave), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveAcc2ySumT2.', ErrStat,ErrMsg,RoutineName) - ALLOCATE ( WaveAcc2zSumT2 (0:WaveField%NStepWave), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveAcc2zSumT2.', ErrStat,ErrMsg,RoutineName) - - ALLOCATE ( WaveDynP2SumT2 (0:WaveField%NStepWave), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveDynP2SumT2.', ErrStat,ErrMsg,RoutineName) - - ! Now check if all the allocations worked properly - IF ( ErrStat >= AbortErrLev ) THEN - CALL CleanUp() - RETURN - END IF - - - - !-------------------------------------------------------------------------------- !> ## Calculate the surface elevation corrections ## !! @@ -867,429 +310,68 @@ SUBROUTINE Waves2_Init( InitInp, InitOut, WaveField, ErrStat, ErrMsg ) WaveField%WaveElev2(:,I,J) = WaveField%WaveElev2(:,I,J) + TmpTimeSeries(:) ENDDO ! Wave elevation points requested - !-------------------------------------------------------------------------------- - !> ## Calculate the second order velocity, acceleration, and pressure corrections for all joints below surface. ## - !-------------------------------------------------------------------------------- - ! NWaveKin0Prime loop start - DO I=1,NWaveKin0Prime - masterCount = WaveKinPrimeMap(I) - - ! Reset the \f$ H_{\mu^+} \f$ terms to zero before calculating. - WaveVel2xCSumT1 = CMPLX(0.0_SiKi, 0.0_SiKi, SiKi) - WaveVel2yCSumT1 = CMPLX(0.0_SiKi, 0.0_SiKi, SiKi) - WaveVel2zCSumT1 = CMPLX(0.0_SiKi, 0.0_SiKi, SiKi) - WaveAcc2xCSumT1 = CMPLX(0.0_SiKi, 0.0_SiKi, SiKi) - WaveAcc2yCSumT1 = CMPLX(0.0_SiKi, 0.0_SiKi, SiKi) - WaveAcc2zCSumT1 = CMPLX(0.0_SiKi, 0.0_SiKi, SiKi) - WaveDynP2CSumT1 = CMPLX(0.0_SiKi, 0.0_SiKi, SiKi) - - WaveVel2xCSumT2 = CMPLX(0.0_SiKi, 0.0_SiKi, SiKi) - WaveVel2yCSumT2 = CMPLX(0.0_SiKi, 0.0_SiKi, SiKi) - WaveVel2zCSumT2 = CMPLX(0.0_SiKi, 0.0_SiKi, SiKi) - WaveAcc2xCSumT2 = CMPLX(0.0_SiKi, 0.0_SiKi, SiKi) - WaveAcc2yCSumT2 = CMPLX(0.0_SiKi, 0.0_SiKi, SiKi) - WaveAcc2zCSumT2 = CMPLX(0.0_SiKi, 0.0_SiKi, SiKi) - WaveDynP2CSumT2 = CMPLX(0.0_SiKi, 0.0_SiKi, SiKi) - - - !--------------- - !> ### First term ### - !! This term is only the FFT over the diagonal elements where \f$ \omega_n = \omega_m \f$ - !! (note that the sum frequency is \f$ 2 \omega_n \f$). The index for the sum frequency is - !! therefore \f$ 2 n \f$. Since we are placing the calculated value for the \f$ A_n A_n - !! H^+ \f$ term in the \f$ 2 \omega \f$ location, we will only run through the first - !! half of the frequencies (the sum frequency will exceed the bounds of the frequencies - !! used in the FFT otherwise). - !! The IFFT will be calculated later with the IFFT of the second term. - !--------------- - - ! The limits look a little funny. But remember we are placing the value in the 2*J location, - ! so we cannot overun the end of the array. The floor function is just in case NStepWave2 is - ! an odd number - DO n=1,FLOOR( REAL(WaveField%NStepWave2-1) / 2.0_SiKi ) ! Only - - Omega_n = n * WaveField%WaveDOmega + ENDIF ! WvSumQTFF - ! The frequency we are dealing with - !> * \f$ \omega^+ = \mu^+ \Delta \omega = 2 \omega_n \f$ - mu_plus = 2 * n - Omega_plus = 2.0_SiKi * Omega_n - IF ( Omega_plus >= WaveField%WvLowCOffS .AND. Omega_plus <= WaveField%WvHiCOffS ) THEN - k_n = WaveNumber( Omega_n, InitInp%Gravity, WaveField%EffWtrDpth ) - k_nm = k_nm_plus( n, n, k_n, k_n ) - ! Calculate the terms \f$ n,m \f$ necessary for calculations - !> Calculate the dot product of the wavenumbers with the (x,y) location - !! This is given by: - !! - !! * \f$ \exp\left(-\imath 2 \vec{k_n} \cdot \vec{x} \right) - !! = \exp \left( -\imath 2 \left[ - !! |\vec{k_n}| \cos \theta_n ~ x - !! + |\vec{k_n}| \sin \theta_n ~ y \right] \right) \f$ - WaveElevxyPrime0 = exp( - ImagNmbr & - * ( 2.0_SiKi * k_n * COS( D2R_S*WaveField%WaveDirArr(n) ) * InitInp%WaveKinGridxi(masterCount) & - + 2.0_SiKi * k_n * SIN( D2R_S*WaveField%WaveDirArr(n) ) * InitInp%WaveKinGridyi(masterCount) )) + CALL ExitFFT(FFT_Data, ErrStatTmp) + CALL SetErrStat(ErrStatTmp,'Error occurred while cleaning up after the FFTs.', ErrStat,ErrMsg,RoutineName) + IF ( ErrStat >= AbortErrLev ) THEN + CALL CleanUp() + RETURN + END IF - ! Get value for \f$ B+ \f$ for the n,m index pair - B_plus = TransFuncB_plus( n, n, k_n, k_n, WaveKinzi0Prime(I) ) + ! If we calculated any second order wave elevation corrections, the array TmpTimeSeries was used. Deallocate it. + IF (ALLOCATED(TmpTimeSeries)) DEALLOCATE(TmpTimeSeries, STAT=ErrStatTmp) + IF (ALLOCATED(TmpTimeSeries2)) DEALLOCATE(TmpTimeSeries2, STAT=ErrStatTmp) + IF (ALLOCATED(TmpFreqSeries)) DEALLOCATE(TmpFreqSeries, STAT=ErrStatTmp) + IF (ALLOCATED(TmpFreqSeries2)) DEALLOCATE(TmpFreqSeries2, STAT=ErrStatTmp) + RETURN - !> Calculate \f$ U^+ \f$ terms for the velocity calculations (\f$B^+\f$ provided by waves2::transfuncb_plus) - ! NOTE: WaveField%EffWtrDpth + WaveKinzi0Prime(I) is the height above the ocean floor - !> * \f$ _x{U}_{nn}^+ = B_{nn}^+ 2 k_n \cos \theta_n \f$ - Ux_nm_plus = B_plus * 2.0_SiKi * k_n * COS( D2R_S*WaveField%WaveDirArr(n) ) - !> * \f$ _y{U}_{nn}^+ = B_{nn}^+ 2 k_n \sin \theta_n \f$ - Uy_nm_plus = B_plus * 2.0_SiKi * k_n * SIN( D2R_S*WaveField%WaveDirArr(n) ) + CONTAINS - !> * \f$ _z{U}_{nn}^+ = \imath B_{nn}^+ k_{nn} \tanh \left( k_{nn} ( h + z ) \right) \f$ - Uz_nm_plus = ImagNmbr * B_plus * k_nm * tanh( k_nm * ( WaveField%EffWtrDpth + WaveKinzi0Prime(I) ) ) + + !> This subroutine calculates the second order difference frequency correction to the wave elevation. The transfer function + !! for the surface elevation is \f$ L^-_{nm} \f$, and is calculated within this subroutine rather than in a separate subroutine. + !! The calculations in this routine follow the same basic structure usind in ::Waves2_Init for the difference frequency + !! calculations. + !! + !! \f$ + !! \eta^{(2)-}(t) = 2 \Re \left[ \sum_{\mu^-=1}^{\frac{N}{2}-1} H^-(\omega_{\mu^-}) + !! \exp(\imath \omega_{\mu^-} t) \right] + !! = \operatorname{IFFT}\left[2 H^-\right] \f$ + !! + !! Notice that in the equations that follow, there is no term analagous to the mean + !! drift term in the WAMIT2 module. Rather, for \f$ \omega_{\mu^-} = 0 \f$, the + !! result is zero. So this term is not included. + !! + !! Also notice that the multiplier 2 is moved inside the IFFT. This was done purely to make the programming simpler. + SUBROUTINE WaveElevTimeSeriesAtXY_Diff(Xcoord,Ycoord, WaveElevSeriesAtXY, ErrStatLcl, ErrMsgLcl ) + + REAL(SiKi), INTENT(IN ) :: Xcoord + REAL(SiKi), INTENT(IN ) :: Ycoord + REAL(SiKi), INTENT( OUT) :: WaveElevSeriesAtXY(0:WaveField%NStepWave) + INTEGER(IntKi), INTENT( OUT) :: ErrStatLcl + INTEGER(IntKi) :: ErrStatLcl2 + CHARACTER(*), INTENT( OUT) :: ErrMsgLcl - - !> Acceleration calculations - Accx_nm_plus = ImagNmbr * Ux_nm_plus * Omega_plus !> * \f$ _x\dot{U}_{nn}^+ = \imath * _xU_{nn}^+ * \omega_{\mu^+} \f$ - Accy_nm_plus = ImagNmbr * Uy_nm_plus * Omega_plus !> * \f$ _y\dot{U}_{nn}^+ = \imath * _yU_{nn}^+ * \omega_{\mu^+} \f$ - Accz_nm_plus = ImagNmbr * Uz_nm_plus * Omega_plus !> * \f$ _z\dot{U}_{nn}^+ = \imath * _zU_{nn}^+ * \omega_{\mu^+} \f$ - - - !> Dynamic pressure - !> * \f$ P_{nn}^+ = \rho_\mathrm{w} B_{nn}^+ \omega_{\mu^+} \f$ - DynP_nm_plus = REAL(WaveField%WtrDens, SiKi) * B_plus * Omega_plus - - - - !> ### Calculate the array of \f$ K^+(\omega_n) \f$ for the first term of the velocity, acceleration, and pressure. ### - - ! First get the wave amplitude -- must be reconstructed from the WaveElevC0 array. First index is the real (1) or - ! imaginary (2) part. Divide by NStepWave2 to remove the built in normalization in WaveElevC0. Note that the phase - ! shift associated with the (x,y) location is accounted for by the WaveElevxyPrime0 variable. - WaveElevC_n = WaveElevC0Norm(n) - - !> Velocity terms: - !! * \f$ K^+(\omega_n) = A_n A_n U_{nn}^+ \exp\left(-\imath 2 \vec{k_n} \cdot\vec{x}\right) \f$ - WaveVel2xCSumT1(mu_plus) = WaveElevC_n * WaveElevC_n * Ux_nm_plus * WaveElevxyPrime0 - WaveVel2yCSumT1(mu_plus) = WaveElevC_n * WaveElevC_n * Uy_nm_plus * WaveElevxyPrime0 - WaveVel2zCSumT1(mu_plus) = WaveElevC_n * WaveElevC_n * Uz_nm_plus * WaveElevxyPrime0 - - !> Acceleration terms: - !! * \f$ K^+(\omega_n) = A_n A_n \dot{U}_{nn}^+ \exp\left(-\imath 2 \vec{k_n} \cdot\vec{x}\right) \f$ - WaveAcc2xCSumT1(mu_plus) = WaveElevC_n * WaveElevC_n * Accx_nm_plus * WaveElevxyPrime0 - WaveAcc2yCSumT1(mu_plus) = WaveElevC_n * WaveElevC_n * Accy_nm_plus * WaveElevxyPrime0 - WaveAcc2zCSumT1(mu_plus) = WaveElevC_n * WaveElevC_n * Accz_nm_plus * WaveElevxyPrime0 - - !> Pressure term: - !! * \f$ K^+(\omega_n) = A_n A_n P_{nn}^+ \exp\left(-\imath 2 \vec{k_n} \cdot\vec{x}\right) \f$ - WaveDynP2CSumT1(mu_plus) = WaveElevC_n * WaveElevC_n * DynP_nm_plus * WaveElevxyPrime0 - - - ENDIF ! Check to see if WvLowCOffS <= mu_plus <= WvHiCOffS - - ENDDO ! n loop (sum frequency) - - ! NOTE: The IFFT of the these terms is performed below. - - - !--------------- - !> ### Second term ### - !! In this term, we are are now stepping through the sum frequencies. The inner - !! sum essentially covers all the off diagonal terms (omega_m /= omega_n). The limits - !! on the outer integral that is the FFT run through the full frequency range that - !! we are using. - !--------------- - - ! \f$ \mu^+ \f$ loop. This loop is used to construct the full set of \f$ H_{\mu^+} \f$ terms used in the IFFT to find the timeseries. - !> * \f$ \mu^+ = n + m \f$ - DO mu_plus=2,WaveField%NStepWave2-1 - - ! The frequency we are dealing with - !> * \f$ \omega^+ = \mu^+ \Delta \omega \f$ - Omega_plus = mu_plus * WaveField%WaveDOmega - - IF ( Omega_plus >= WaveField%WvLowCOffS .AND. Omega_plus <= WaveField%WvHiCOffS ) THEN - ! The inner \f$ m \f$ loop for calculating the \f$ H_{\mu^+} \f$ terms at each frequency. - DO m=1,FLOOR( REAL(mu_plus - 1) / 2.0_SiKi ) - ! Calculate the value of the n index from \f$ \mu^+ = n + m \f$. Calculate corresponding wavenumbers and frequencies. - n = mu_plus - m - Omega_n = n * WaveField%WaveDOmega - Omega_m = m * WaveField%WaveDOmega - k_n = WaveNumber( Omega_n, InitInp%Gravity, WaveField%EffWtrDpth ) - k_m = WaveNumber( Omega_m, InitInp%Gravity, WaveField%EffWtrDpth ) - k_nm = k_nm_plus( n, m, k_n, k_m ) - - - ! Calculate the terms \f$ n,m \f$ necessary for calculations - - !> Calculate the dot product of the wavenumbers with the (x,y) location - !! This is given by: - !! - !! * \f$ \exp\left(-\imath \left[\vec{k_n} + \vec{k_m} \right] \cdot \vec{x} \right) - !! = \exp \left( -\imath \left[ - !! \left( |\vec{k_n}| \cos \theta_n + |\vec{k_m}| cos \theta_m \right) ~ x - !! + \left( |\vec{k_n}| \sin \theta_n + |\vec{k_m}| sin \theta_m \right) ~ y \right] \right) \f$ - - WaveElevxyPrime0 = exp( - ImagNmbr & - * ( ( k_n * COS( D2R_S*WaveField%WaveDirArr(n) ) + k_m * COS( D2R_S*WaveField%WaveDirArr(m) ) ) * InitInp%WaveKinGridxi(masterCount) & - + ( k_n * SIN( D2R_S*WaveField%WaveDirArr(n) ) + k_m * SIN( D2R_S*WaveField%WaveDirArr(m) ) ) * InitInp%WaveKinGridyi(masterCount) )) - - - ! Get value for \f$ B+ \f$ for the n,m index pair - B_plus = TransFuncB_plus( n, m, k_n, k_m, WaveKinzi0Prime(I) ) - - - !> Calculate \f$ U^+ \f$ terms for the velocity calculations (\f$B^+\f$ provided by waves2::transfuncb_plus) - ! NOTE: WaveField%EffWtrDpth + WaveKinzi0Prime(I) is the height above the ocean floor - !> * \f$ _x{U}_{nm}^+ = B_{nm}^+ \left(k_n \cos \theta_n + k_m \cos \theta_m \right) \f$ - Ux_nm_plus = B_plus * ( k_n * COS( D2R_S*WaveField%WaveDirArr(n) ) + k_m * COS( D2R_S*WaveField%WaveDirArr(m) ) ) - - !> * \f$ _y{U}_{nm}^+ = B_{nm}^+ \left(k_n \sin \theta_n + k_m \sin \theta_m \right) \f$ - Uy_nm_plus = B_plus * ( k_n * SIN( D2R_S*WaveField%WaveDirArr(n) ) + k_m * SIN( D2R_S*WaveField%WaveDirArr(m) ) ) - - !> * \f$ _z{U}_{nm}^+ = \imath B_{nm}^+ k_{nm} \tanh \left( k_{nm} ( h + z ) \right) \f$ - Uz_nm_plus = ImagNmbr * B_plus * k_nm * tanh( k_nm * ( WaveField%EffWtrDpth + WaveKinzi0Prime(I) ) ) - - - !> Acceleration calculations - Accx_nm_plus = ImagNmbr * Ux_nm_plus * Omega_plus !> * \f$ _x\dot{U}_{nm}^+ = \imath * _xU_{nm}^+ * \omega_{\mu^+} \f$ - Accy_nm_plus = ImagNmbr * Uy_nm_plus * Omega_plus !> * \f$ _y\dot{U}_{nm}^+ = \imath * _yU_{nm}^+ * \omega_{\mu^+} \f$ - Accz_nm_plus = ImagNmbr * Uz_nm_plus * Omega_plus !> * \f$ _z\dot{U}_{nm}^+ = \imath * _zU_{nm}^+ * \omega_{\mu^+} \f$ - - - !> Dynamic pressure - !> * \f$ P_{nm}^+ = \rho_\mathrm{w} B_{nm}^+ \omega_{\mu^+} \f$ - DynP_nm_plus = REAL(WaveField%WtrDens,SiKi) * B_plus * Omega_plus - - - - !> ### Calculate the inner summation \f$ H^+(\omega_{\mu^+}) \f$ terms for the velocity, acceleration, and pressure. ### - - - ! First get the wave amplitude -- must be reconstructed from the WaveElevC0 array. First index is the real (1) or - ! imaginary (2) part. Divide by NStepWave2 to remove the built in normalization in WaveElevC0. Note that the phase - ! shift associated with the (x,y) location is accounted for by the WaveElevxyPrime0 variable. - WaveElevC_n = WaveElevC0Norm(n) - WaveElevC_m = WaveElevC0Norm(m) - - - !> Velocity terms: - !! * \f$ H^+(\omega_{\mu^+}) = \sum_{m=1}^{\lfloor \frac{\mu^+-1}{2}\rfloor} A_n A_m U_{nm}^+ - !! \exp\left(-\imath (\vec{k_n} + \vec{k_m})\cdot\vec{x}\right) \f$ - WaveVel2xCSumT2(mu_plus) = WaveVel2xCSumT2(mu_plus) + WaveElevC_n * WaveElevC_m * Ux_nm_plus * WaveElevxyPrime0 - WaveVel2yCSumT2(mu_plus) = WaveVel2yCSumT2(mu_plus) + WaveElevC_n * WaveElevC_m * Uy_nm_plus * WaveElevxyPrime0 - WaveVel2zCSumT2(mu_plus) = WaveVel2zCSumT2(mu_plus) + WaveElevC_n * WaveElevC_m * Uz_nm_plus * WaveElevxyPrime0 - - !> Acceleration terms: - !! * \f$ H^+(\omega_{\mu^+}) = \sum_{m=1}^{\lfloor \frac{\mu^+-1}{2}\rfloor} A_n A_m \dot{U}_{nm}^+ - !! \exp\left(-\imath (\vec{k_n} + \vec{k_m})\cdot\vec{x}\right) \f$ - WaveAcc2xCSumT2(mu_plus) = WaveAcc2xCSumT2(mu_plus) + WaveElevC_n * WaveElevC_m * Accx_nm_plus * WaveElevxyPrime0 - WaveAcc2yCSumT2(mu_plus) = WaveAcc2yCSumT2(mu_plus) + WaveElevC_n * WaveElevC_m * Accy_nm_plus * WaveElevxyPrime0 - WaveAcc2zCSumT2(mu_plus) = WaveAcc2zCSumT2(mu_plus) + WaveElevC_n * WaveElevC_m * Accz_nm_plus * WaveElevxyPrime0 - - !> Pressure term: - !! * \f$ H^+(\omega_{\mu^+}) = \sum_{m=1}^{\lfloor \frac{\mu^+-1}{2}\rfloor} A_n A_m P_{nm}^+ - !! \exp\left(-\imath (\vec{k_n} + \vec{k_m})\cdot\vec{x}\right) \f$ - WaveDynP2CSumT2(mu_plus) = WaveDynP2CSumT2(mu_plus) + WaveElevC_n * WaveElevC_m * DynP_nm_plus * WaveElevxyPrime0 - - ENDDO ! m loop - - ENDIF ! Check to see if WvLowCOffS <= mu_plus <= WvHiCOffS - - ENDDO ! mu_plus loop (diff frequency) - - - ! Divide by two for the single sided FFT given in the documentation. - WaveVel2xCSumT1 = WaveVel2xCSumT1 / 2.0_SiKi - WaveVel2yCSumT1 = WaveVel2yCSumT1 / 2.0_SiKi - WaveVel2zCSumT1 = WaveVel2zCSumT1 / 2.0_SiKi - WaveAcc2xCSumT1 = WaveAcc2xCSumT1 / 2.0_SiKi - WaveAcc2yCSumT1 = WaveAcc2yCSumT1 / 2.0_SiKi - WaveAcc2zCSumT1 = WaveAcc2zCSumT1 / 2.0_SiKi - WaveDynP2CSumT1 = WaveDynP2CSumT1 / 2.0_SiKi - WaveVel2xCSumT2 = WaveVel2xCSumT2 / 2.0_SiKi - WaveVel2yCSumT2 = WaveVel2yCSumT2 / 2.0_SiKi - WaveVel2zCSumT2 = WaveVel2zCSumT2 / 2.0_SiKi - WaveAcc2xCSumT2 = WaveAcc2xCSumT2 / 2.0_SiKi - WaveAcc2yCSumT2 = WaveAcc2yCSumT2 / 2.0_SiKi - WaveAcc2zCSumT2 = WaveAcc2zCSumT2 / 2.0_SiKi - WaveDynP2CSumT2 = WaveDynP2CSumT2 / 2.0_SiKi - - - - - !> ### Apply the inverse FFT to the first and second terms of each of the components to get the time domain result ### - !> * \f$ V^{(2)+}(t) = \operatorname{IFFT}\left[K^+\right] - !! + 2\operatorname{IFFT}\left[H^+\right] \f$ - CALL ApplyFFT_cx( WaveVel2xSumT1(:), WaveVel2xCSumT1(:), FFT_Data, ErrStatTmp ) - CALL SetErrStat(ErrStatTmp,'Error occurred while applying the FFT on V_x.',ErrStat,ErrMsg,RoutineName) - CALL ApplyFFT_cx( WaveVel2ySumT1(:), WaveVel2yCSumT1(:), FFT_Data, ErrStatTmp ) - CALL SetErrStat(ErrStatTmp,'Error occurred while applying the FFT on V_y.',ErrStat,ErrMsg,RoutineName) - CALL ApplyFFT_cx( WaveVel2zSumT1(:), WaveVel2zCSumT1(:), FFT_Data, ErrStatTmp ) - CALL SetErrStat(ErrStatTmp,'Error occurred while applying the FFT on V_z.',ErrStat,ErrMsg,RoutineName) - - CALL ApplyFFT_cx( WaveAcc2xSumT1(:), WaveAcc2xCSumT1(:), FFT_Data, ErrStatTmp ) - CALL SetErrStat(ErrStatTmp,'Error occurred while applying the FFT on Acc_x.',ErrStat,ErrMsg,RoutineName) - CALL ApplyFFT_cx( WaveAcc2ySumT1(:), WaveAcc2yCSumT1(:), FFT_Data, ErrStatTmp ) - CALL SetErrStat(ErrStatTmp,'Error occurred while applying the FFT on Acc_y.',ErrStat,ErrMsg,RoutineName) - CALL ApplyFFT_cx( WaveAcc2zSumT1(:), WaveAcc2zCSumT1(:), FFT_Data, ErrStatTmp ) - CALL SetErrStat(ErrStatTmp,'Error occurred while applying the FFT on Acc_z.',ErrStat,ErrMsg,RoutineName) - - CALL ApplyFFT_cx( WaveDynP2SumT1(:), WaveDynP2CSumT1(:), FFT_Data, ErrStatTmp ) - CALL SetErrStat(ErrStatTmp,'Error occurred while applying the FFT on DynP2.',ErrStat,ErrMsg,RoutineName) - - CALL ApplyFFT_cx( WaveVel2xSumT2(:), WaveVel2xCSumT2(:), FFT_Data, ErrStatTmp ) - CALL SetErrStat(ErrStatTmp,'Error occurred while applying the FFT on V_x.',ErrStat,ErrMsg,RoutineName) - CALL ApplyFFT_cx( WaveVel2ySumT2(:), WaveVel2yCSumT2(:), FFT_Data, ErrStatTmp ) - CALL SetErrStat(ErrStatTmp,'Error occurred while applying the FFT on V_y.',ErrStat,ErrMsg,RoutineName) - CALL ApplyFFT_cx( WaveVel2zSumT2(:), WaveVel2zCSumT2(:), FFT_Data, ErrStatTmp ) - CALL SetErrStat(ErrStatTmp,'Error occurred while applying the FFT on V_z.',ErrStat,ErrMsg,RoutineName) - - CALL ApplyFFT_cx( WaveAcc2xSumT2(:), WaveAcc2xCSumT2(:), FFT_Data, ErrStatTmp ) - CALL SetErrStat(ErrStatTmp,'Error occurred while applying the FFT on Acc_x.',ErrStat,ErrMsg,RoutineName) - CALL ApplyFFT_cx( WaveAcc2ySumT2(:), WaveAcc2yCSumT2(:), FFT_Data, ErrStatTmp ) - CALL SetErrStat(ErrStatTmp,'Error occurred while applying the FFT on Acc_y.',ErrStat,ErrMsg,RoutineName) - CALL ApplyFFT_cx( WaveAcc2zSumT2(:), WaveAcc2zCSumT2(:), FFT_Data, ErrStatTmp ) - CALL SetErrStat(ErrStatTmp,'Error occurred while applying the FFT on Acc_z.',ErrStat,ErrMsg,RoutineName) - - CALL ApplyFFT_cx( WaveDynP2SumT2(:), WaveDynP2CSumT2(:), FFT_Data, ErrStatTmp ) - CALL SetErrStat(ErrStatTmp,'Error occurred while applying the FFT on DynP2.',ErrStat,ErrMsg,RoutineName) - - IF ( ErrStat >= AbortErrLev ) THEN - CALL CleanUp() - RETURN - END IF - - - ! Add the results to the output - ii = mod(masterCount-1, InitInp%NGrid(1)) + 1 - jj = mod( (masterCount-1) /InitInp%NGrid(1), InitInp%NGrid(2) ) + 1 - kk = (masterCount-1) / (InitInp%NGrid(1)*InitInp%NGrid(2)) + 1 - - InitOut%WaveVel2S(:,ii,jj,kk,1) = WaveVel2xSumT1(:) + 2.0_SiKi * WaveVel2xSumT2(:) ! x-component of velocity - InitOut%WaveVel2S(:,ii,jj,kk,2) = WaveVel2ySumT1(:) + 2.0_SiKi * WaveVel2ySumT2(:) ! y-component of velocity - InitOut%WaveVel2S(:,ii,jj,kk,3) = WaveVel2zSumT1(:) + 2.0_SiKi * WaveVel2zSumT2(:) ! z-component of velocity - - InitOut%WaveAcc2S(:,ii,jj,kk,1) = WaveAcc2xSumT1(:) + 2.0_SiKi * WaveAcc2xSumT2(:) ! x-component of acceleration - InitOut%WaveAcc2S(:,ii,jj,kk,2) = WaveAcc2ySumT1(:) + 2.0_SiKi * WaveAcc2ySumT2(:) ! y-component of acceleration - InitOut%WaveAcc2S(:,ii,jj,kk,3) = WaveAcc2zSumT1(:) + 2.0_SiKi * WaveAcc2zSumT2(:) ! z-component of acceleration - - InitOut%WaveDynP2S(:,ii,jj,kk) = WaveDynP2SumT1(:) + 2.0_SiKi * WaveDynP2SumT2(:) ! Dynamic pressure - - - ! Copy the first point to the last to make it easier. - InitOut%WaveVel2S(WaveField%NStepWave,ii,jj,kk,:) = InitOut%WaveVel2S(0,ii,jj,kk,:) - InitOut%WaveAcc2S(WaveField%NStepWave,ii,jj,kk,:) = InitOut%WaveAcc2S(0,ii,jj,kk,:) - InitOut%WaveDynP2S(WaveField%NStepWave,ii,jj,kk) = InitOut%WaveDynP2S(0,ii,jj,kk) - - - ENDDO ! I=1,NWaveKin0Prime loop end - - - ! Deallocate working arrays. - IF (ALLOCATED(WaveVel2xCSumT1)) DEALLOCATE(WaveVel2xCSumT1, STAT=ErrStatTmp) - IF (ALLOCATED(WaveVel2yCSumT1)) DEALLOCATE(WaveVel2yCSumT1, STAT=ErrStatTmp) - IF (ALLOCATED(WaveVel2zCSumT1)) DEALLOCATE(WaveVel2zCSumT1, STAT=ErrStatTmp) - IF (ALLOCATED(WaveAcc2xCSumT1)) DEALLOCATE(WaveAcc2xCSumT1, STAT=ErrStatTmp) - IF (ALLOCATED(WaveAcc2yCSumT1)) DEALLOCATE(WaveAcc2yCSumT1, STAT=ErrStatTmp) - IF (ALLOCATED(WaveAcc2zCSumT1)) DEALLOCATE(WaveAcc2zCSumT1, STAT=ErrStatTmp) - IF (ALLOCATED(WaveDynP2CSumT1)) DEALLOCATE(WaveDynP2CSumT1, STAT=ErrStatTmp) - - IF (ALLOCATED(WaveVel2xSumT1)) DEALLOCATE(WaveVel2xSumT1, STAT=ErrStatTmp) - IF (ALLOCATED(WaveVel2ySumT1)) DEALLOCATE(WaveVel2ySumT1, STAT=ErrStatTmp) - IF (ALLOCATED(WaveVel2zSumT1)) DEALLOCATE(WaveVel2zSumT1, STAT=ErrStatTmp) - IF (ALLOCATED(WaveAcc2xSumT1)) DEALLOCATE(WaveAcc2xSumT1, STAT=ErrStatTmp) - IF (ALLOCATED(WaveAcc2ySumT1)) DEALLOCATE(WaveAcc2ySumT1, STAT=ErrStatTmp) - IF (ALLOCATED(WaveAcc2zSumT1)) DEALLOCATE(WaveAcc2zSumT1, STAT=ErrStatTmp) - IF (ALLOCATED(WaveDynP2SumT1)) DEALLOCATE(WaveDynP2SumT1, STAT=ErrStatTmp) - - IF (ALLOCATED(WaveVel2xCSumT2)) DEALLOCATE(WaveVel2xCSumT2, STAT=ErrStatTmp) - IF (ALLOCATED(WaveVel2yCSumT2)) DEALLOCATE(WaveVel2yCSumT2, STAT=ErrStatTmp) - IF (ALLOCATED(WaveVel2zCSumT2)) DEALLOCATE(WaveVel2zCSumT2, STAT=ErrStatTmp) - IF (ALLOCATED(WaveAcc2xCSumT2)) DEALLOCATE(WaveAcc2xCSumT2, STAT=ErrStatTmp) - IF (ALLOCATED(WaveAcc2yCSumT2)) DEALLOCATE(WaveAcc2yCSumT2, STAT=ErrStatTmp) - IF (ALLOCATED(WaveAcc2zCSumT2)) DEALLOCATE(WaveAcc2zCSumT2, STAT=ErrStatTmp) - IF (ALLOCATED(WaveDynP2CSumT2)) DEALLOCATE(WaveDynP2CSumT2, STAT=ErrStatTmp) - - IF (ALLOCATED(WaveVel2xSumT2)) DEALLOCATE(WaveVel2xSumT2, STAT=ErrStatTmp) - IF (ALLOCATED(WaveVel2ySumT2)) DEALLOCATE(WaveVel2ySumT2, STAT=ErrStatTmp) - IF (ALLOCATED(WaveVel2zSumT2)) DEALLOCATE(WaveVel2zSumT2, STAT=ErrStatTmp) - IF (ALLOCATED(WaveAcc2xSumT2)) DEALLOCATE(WaveAcc2xSumT2, STAT=ErrStatTmp) - IF (ALLOCATED(WaveAcc2ySumT2)) DEALLOCATE(WaveAcc2ySumT2, STAT=ErrStatTmp) - IF (ALLOCATED(WaveAcc2zSumT2)) DEALLOCATE(WaveAcc2zSumT2, STAT=ErrStatTmp) - IF (ALLOCATED(WaveDynP2SumT2)) DEALLOCATE(WaveDynP2SumT2, STAT=ErrStatTmp) - - IF ( ErrStat >= AbortErrLev ) THEN - CALL CleanUp() - RETURN - END IF - - - - ENDIF ! WvSumQTFF - - - - - - - CALL ExitFFT(FFT_Data, ErrStatTmp) - CALL SetErrStat(ErrStatTmp,'Error occurred while cleaning up after the FFTs.', ErrStat,ErrMsg,RoutineName) - IF ( ErrStat >= AbortErrLev ) THEN - CALL CleanUp() - RETURN - END IF - - - ! If we calculated any second order wave elevation corrections, the array TmpTimeSeries was used. Deallocate it. - IF (ALLOCATED(TmpTimeSeries)) DEALLOCATE(TmpTimeSeries, STAT=ErrStatTmp) - IF (ALLOCATED(TmpTimeSeries2)) DEALLOCATE(TmpTimeSeries2, STAT=ErrStatTmp) - IF (ALLOCATED(TmpFreqSeries)) DEALLOCATE(TmpFreqSeries, STAT=ErrStatTmp) - IF (ALLOCATED(TmpFreqSeries2)) DEALLOCATE(TmpFreqSeries2, STAT=ErrStatTmp) - - RETURN - - - CONTAINS - - - !> This subroutine calculates the second order difference frequency correction to the wave elevation. The transfer function - !! for the surface elevation is \f$ L^-_{nm} \f$, and is calculated within this subroutine rather than in a separate subroutine. - !! The calculations in this routine follow the same basic structure usind in ::Waves2_Init for the difference frequency - !! calculations. - !! - !! \f$ - !! \eta^{(2)-}(t) = 2 \Re \left[ \sum_{\mu^-=1}^{\frac{N}{2}-1} H^-(\omega_{\mu^-}) - !! \exp(\imath \omega_{\mu^-} t) \right] - !! = \operatorname{IFFT}\left[2 H^-\right] \f$ - !! - !! Notice that in the equations that follow, there is no term analagous to the mean - !! drift term in the WAMIT2 module. Rather, for \f$ \omega_{\mu^-} = 0 \f$, the - !! result is zero. So this term is not included. - !! - !! Also notice that the multiplier 2 is moved inside the IFFT. This was done purely to make the programming simpler. - SUBROUTINE WaveElevTimeSeriesAtXY_Diff(Xcoord,Ycoord, WaveElevSeriesAtXY, ErrStatLcl, ErrMsgLcl ) - - REAL(SiKi), INTENT(IN ) :: Xcoord - REAL(SiKi), INTENT(IN ) :: Ycoord - REAL(SiKi), INTENT( OUT) :: WaveElevSeriesAtXY(0:WaveField%NStepWave) - INTEGER(IntKi), INTENT( OUT) :: ErrStatLcl - INTEGER(IntKi) :: ErrStatLcl2 - CHARACTER(*), INTENT( OUT) :: ErrMsgLcl - - ! Local variables - INTEGER(IntKi) :: n !< Index to the first frequency we are dealing with - INTEGER(IntKi) :: m !< Index to the second frequency we are dealing with - REAL(SiKi) :: k_n !< WaveNumber for Omega_n -- note no direction associated with this - REAL(SiKi) :: k_m !< WaveNumber for Omega_m -- note no direction associated with this - REAL(SiKi) :: L_minus !< Resulting \f$ L^{-}_{nm} \f$ value. Calculated in this routine. - REAL(SiKi) :: R_n !< Effect scaling relationship of depth and wavenumber - REAL(SiKi) :: R_m !< Effect scaling relationship of depth and wavenumber - REAL(SiKi) :: Omega_n !< First frequency of index n - REAL(SiKi) :: Omega_m !< Second frequency of index m - REAL(SiKi) :: D_minus !< Value of \f$ D^-_{nm} \f$ found by ::TransFuncD_minus + ! Local variables + INTEGER(IntKi) :: n !< Index to the first frequency we are dealing with + INTEGER(IntKi) :: m !< Index to the second frequency we are dealing with + REAL(SiKi) :: k_n !< WaveNumber for Omega_n -- note no direction associated with this + REAL(SiKi) :: k_m !< WaveNumber for Omega_m -- note no direction associated with this + REAL(SiKi) :: L_minus !< Resulting \f$ L^{-}_{nm} \f$ value. Calculated in this routine. + REAL(SiKi) :: R_n !< Effect scaling relationship of depth and wavenumber + REAL(SiKi) :: R_m !< Effect scaling relationship of depth and wavenumber + REAL(SiKi) :: Omega_n !< First frequency of index n + REAL(SiKi) :: Omega_m !< Second frequency of index m + REAL(SiKi) :: D_minus !< Value of \f$ D^-_{nm} \f$ found by ::TransFuncD_minus ! Initializations ErrMsgLcl = '' @@ -1477,110 +559,999 @@ SUBROUTINE WaveElevTimeSeriesAtXY_Sum(Xcoord,Ycoord, WaveElevSeriesAtXY, ErrStat !! * \f$ K^+(\omega_n) = A_n A_n L_{nn}^+ \exp\left(-\imath 2 \vec{k_n} \cdot\vec{x}\right) \f$ TmpFreqSeries(mu_plus) = WaveElevC_n * WaveElevC_n * L_plus * WaveElevxyPrime0 - ENDIF ! Check to see if WvLowCOffS <= mu_plus <= WvHiCOffS + ENDIF ! Check to see if WvLowCOffS <= mu_plus <= WvHiCOffS + + ENDDO ! n loop (diff frequency) + + ! NOTE: The IFFT of the these terms is performed below. + + + !--------------- + !> ## Second term ## + !! In this term, we are are now stepping through the sum frequencies. The inner + !! sum essentially covers all the off diagonal terms (omega_m /= omega_n). The limits + !! on the outer integral that is the FFT run through the full frequency range that + !! we are using. + !--------------- + ! The frequency information will be stored in TmpFreqSeries2 + + ! \f$ \mu^+ \f$ loop. This loop is used to construct the full set of \f$ H_{\mu^+} \f$ terms used in the IFFT to find the timeseries. + !> * \f$ \mu^+ = n + m \f$ + DO mu_plus=2,WaveField%NStepWave2-1 + + ! The frequency we are dealing with + !> * \f$ \omega^+ = \mu^+ \Delta \omega \f$ + Omega_plus = mu_plus * WaveField%WaveDOmega + + IF ( Omega_plus >= WaveField%WvLowCOffS .AND. Omega_plus <= WaveField%WvHiCOffS ) THEN + + ! The inner \f$ m \f$ loop for calculating the \f$ H_{\mu^+} \f$ terms at each frequency. + DO m=1,FLOOR( REAL(mu_plus - 1) / 2.0_SiKi ) + ! Calculate the value of the n index from \f$ \mu^+ = n + m \f$. Calculate corresponding wavenumbers and frequencies. + n = mu_plus - m + Omega_n = n * WaveField%WaveDOmega + Omega_m = m * WaveField%WaveDOmega + k_n = WaveNumber( Omega_n, InitInp%Gravity, WaveField%EffWtrDpth ) + k_m = WaveNumber( Omega_m, InitInp%Gravity, WaveField%EffWtrDpth ) + R_n = k_n * tanh( k_n * WaveField%EffWtrDpth ) + R_m = k_m * tanh( k_m * WaveField%EffWtrDpth ) + D_plus = TransFuncD_plus(n,m,k_n,k_m,R_n,R_m) + + !> Calculate the value of + !! \f$ L^+_{nm} = \frac{1}{4} \left[ + !! \frac{D^+_{nm} - |\vec{k}_n| |\vec{k}_m| \cos(\theta_n - \theta_m) + R_n R_m}{\sqrt{R_n R_m}} + !! + (R_n+R_m) \right] \f$ + !! + !! The value of \f$ D^-_{nm} \f$ is found from by the ::TransFuncD_plus routine. + L_plus = (( D_plus - k_n * k_m * COS(D2R_S*WaveField%WaveDirArr(n) - D2R_S*WaveField%WaveDirArr(m)) + R_n * R_m )/SQRT( R_n * R_m ) + R_n + R_m) / 4.0_SiKi + + !> Calculate the dot product of the wavenumbers with the (x,y) location + !! This is given by: + !! + !! * \f$ \exp\left(-\imath \left[\vec{k_n} + \vec{k_m} \right] \cdot \vec{x} \right) + !! = \exp \left( -\imath \left[ + !! \left( |\vec{k_n}| \cos \theta_n + |\vec{k_m}| cos \theta_m \right) ~ x + !! + \left( |\vec{k_n}| \sin \theta_n + |\vec{k_m}| sin \theta_m \right) ~ y \right] \right) \f$ + + WaveElevxyPrime0 = exp( - ImagNmbr & + * ( ( k_n * COS( D2R_S*WaveField%WaveDirArr(n) ) + k_m * COS( D2R_S*WaveField%WaveDirArr(m) ) ) * XCoord & + + ( k_n * SIN( D2R_S*WaveField%WaveDirArr(n) ) + k_m * SIN( D2R_S*WaveField%WaveDirArr(m) ) ) * YCoord )) + + + + ! First get the wave amplitude -- must be reconstructed from the WaveElevC0 array. First index is the real (1) or + ! imaginary (2) part. Divide by NStepWave2 to remove the built in normalization in WaveElevC0. Note that the phase + ! shift associated with the (x,y) location is accounted for by the WaveElevxyPrime0 variable. + WaveElevC_n = WaveElevC0Norm(n) + WaveElevC_m = WaveElevC0Norm(m) + + !> ### Calculate the inner summation \f$ H^+(\omega_{\mu^+}) \f$ term. ### + !! * \f$ H^+(\omega_{\mu^+}) = \sum_{m=1}^{\lfloor \frac{\mu^+-1}{2}\rfloor} A_n A_m L^+_{nm} + !! \exp\left(-\imath (\vec{k_n} + \vec{k_m})\cdot\vec{x}\right) \f$ + TmpFreqSeries2(mu_plus) = TmpFreqSeries2(mu_plus) + WaveElevC_n * WaveElevC_m * L_plus * WaveElevxyPrime0 + + ENDDO ! m loop + + ENDIF ! Check to see if WvLowCOffS <= mu_plus <= WvHiCOffS + + ENDDO ! mu_plus loop (diff frequency) + + + ! Divide by two for the single sided FFT given in the documentation. + TmpFreqSeries = TmpFreqSeries / 2.0_SiKi + TmpFreqSeries2 = TmpFreqSeries2 / 2.0_SiKi + + !> ## Apply the inverse FFT to the first and second terms to get the time domain result ## + !> * \f$ \eta^{(2)+}(t) = \operatorname{IFFT}\left[K^+\right] + !! + 2\operatorname{IFFT}\left[H^+\right] \f$ + CALL ApplyFFT_cx( WaveElevSeriesAtXY(:), TmpFreqSeries(:), FFT_Data, ErrStatLcl2 ) + CALL SetErrStat(ErrStatLcl2,'Error occurred while applying the FFT on WaveElevSeriesAtXY.',ErrStatLcl,ErrMsgLcl,'WaveElevSeriesAtXY_Sum') + CALL ApplyFFT_cx( TmpTimeSeries2(:), TmpFreqSeries2(:), FFT_Data, ErrStatLcl2 ) + CALL SetErrStat(ErrStatLcl2,'Error occurred while applying the FFT on WaveElevSeriesAtXY.',ErrStatLcl,ErrMsgLcl,'WaveElevSeriesAtXY_Sum') + + ! Add the two terms together + DO Ctr=0,WaveField%NStepWave + WaveElevSeriesAtXY(Ctr) = WaveElevSeriesAtXY(Ctr) + 2.0_SiKi * TmpTimeSeries2(Ctr) + ENDDO + + ! Append first datapoint as the last as aid for repeated wave data + WaveElevSeriesAtXY(WaveField%NStepWave) = WaveElevSeriesAtXY(0) + + + END SUBROUTINE WaveElevTimeSeriesAtXY_Sum + + + + + + + + + + + + + + + + + + + + + + !> This function calculates the term \f$ D^-_{nm} \f$ used in finding the transfer functions. + !! The equation is given by: + !! + !! \f$ {D}_{nm}^{-} = + !! \frac { \left(\sqrt{R_n} - \sqrt{R_m}\right) \left[ \sqrt{R_m} \left( k_n^2 - R_n^2 \right) - \sqrt{R_n} \left( k_m^{2} - R_m^2 \right) \right] + !! ~+~ 2 \left(\sqrt{R_n} - \sqrt{R_m}\right)^2 + !! \left[ \left|\vec{k_n}\right| \left|\vec{k_m}\right| \cos \left( \theta_n-\theta_m \right) + R_n R_m \right] } + !! { \left(\sqrt{R_n} - \sqrt{R_m}\right)^2 - k_{nm}^{-} \tanh \left( k_{nm}^{-} h \right) } \f$ + !! + !! where \f$ k_{nm}^{-} \f$ is handled by the function ::k_nm_minus and \f$R_n\f$ is given by + !! \f$ R_n = \left| \overrightarrow{k}_n \right| \tanh\left(\left| \overrightarrow{k}_n \right| h \right) \f$ + !! where \f$ h \f$ is the depth from MSL (or the still water line). + !! + !! To calculate this, we simplify some of the common pieces: + !! + !! \f$ {D}_{nm}^{-} = \frac { R_{nm} \left[ \sqrt{R_m} \left( k_n^2 - R_n^2 \right) - \sqrt{R_n} \left( k_m^2 -R_m^2 \right) \right] + !! ~+~ 2 R_{nm}^2 \left[ \left|\vec{k_n}\right| \left|\vec{k_m}\right| \cos \left( \theta_n-\theta_m \right) + R_n R_m \right] } + !! { R_{nm}^2 - k_{nm}^{-} \tanh \left( k_{nm}^- h \right) } \f$ + !! + !! where \f$ R_{nm} \equiv \sqrt{R_n} - \sqrt{R_m} \f$. + !! + !! The denominator goes to zero when \f$ n = m \f$, as does the numerator. So, using L'Hopital's rule to find the limit, it may be + !! possible to prove that \f$ \stackrel{\lim}{n \to m} D_{nm}^{-} = 0 \f$. It will take more than one derivative + !! to check this, so due to time, this has not been verified. For now we we simply assume this to be true and proceed to set + !! _TransFuncD_minus_ to zero for all \f$ n = m \f$ cases. _This should not be done!_ Plotting this cross sections of this function + !! shows that when \f$ n = m \f$, the result should converge to something non-zero, but close to zero. + !! + !! @note update this function when the limit has been derived. + !! + FUNCTION TransFuncD_minus(n,m,k_n,k_m,R_n,R_m) + + ! Passed variables + INTEGER(IntKi), INTENT(IN ) :: n !< Index to the first frequency we are dealing with + INTEGER(IntKi), INTENT(IN ) :: m !< Index to the second frequency we are dealing with + REAL(SiKi), INTENT(IN ) :: k_n !< WaveNumber for Omega_n -- note no direction associated with this + REAL(SiKi), INTENT(IN ) :: k_m !< WaveNumber for Omega_m -- note no direction associated with this + REAL(SiKi), INTENT(IN ) :: R_n !< Effect scaling relationship of depth and wavenumber + REAL(SiKi), INTENT(IN ) :: R_m !< Effect scaling relationship of depth and wavenumber + REAL(SiKi) :: TransFuncD_minus !< Resulting \f$ D^{-}_{nm} \f$ value. + + ! Local variables + REAL(SiKi) :: k_nm !< Value of \f$ k_{nm}^{-} \f$ + REAL(SiKi) :: SqrtRnMinusRm !< Value of \f$ \sqrt{R_n} - \sqrt{R_m} \f$ + + REAL(SiKi) :: Den !< Denominator + REAL(SiKi) :: Num1 !< Numerator first term + REAL(SiKi) :: Num2 !< Numerator second term + + + ! If n == m, D^- is set to zero. It should be set to the limit as n -> m. + IF ( n==m ) THEN + TransFuncD_minus = 0.0_SiKi + ELSE + + k_nm = k_nm_minus(n,m,k_n,k_m) + + ! Calculate R_nm that appears in multiple places + SqrtRnMinusRm = SQRT(R_n) - SQRT(R_m) + + ! Calculate the two pieces of the numerator + Num1 = SqrtRnMinusRm * ( SQRT(R_m) * ( k_n*k_n - R_n*R_n ) - SQRT(R_n) * ( k_m*k_m - R_m*R_m ) ) + + Num2 = 2*SqrtRnMinusRm*SqrtRnMinusRm*( k_n * k_m * COS( D2R_S*WaveField%WaveDirArr(n) - D2R_S*WaveField%WaveDirArr(m) ) + R_n*R_m ) + + ! Calculate the denominator + Den = SqrtRnMinusRm*SqrtRnMinusRm - k_nm * tanh( k_nm * WaveField%EffWtrDpth ) + + TransFuncD_minus = (Num1+Num2) / Den + + ENDIF + + RETURN + END FUNCTION TransFuncD_minus + + + + !> This function calculates the term \f$ D^+_{nm} \f$ used in finding the transfer functions. + !! The equation is given by: + !! + !! \f$ {D}_{nm}^{+} = + !! \frac { \left(\sqrt{R_n} + \sqrt{R_m}\right) \left[ \sqrt{R_m} \left( k_n^2 - R_n^2 \right) + \sqrt{R_n} \left( k_m^{2} - R_m^2 \right) \right] + !! ~+~ 2 \left(\sqrt{R_n} + \sqrt{R_m}\right)^2 + !! \left[ \left|\vec{k_n}\right| \left|\vec{k_m}\right| \cos \left( \theta_n-\theta_m \right) - R_n R_m \right] } + !! { \left(\sqrt{R_n} + \sqrt{R_m}\right)^2 - k_{nm}^{+} \tanh \left( k_{nm}^{+} h \right) } \f$ + !! + !! where \f$ k_{nm}^{+} \f$ is handled by the function ::k_nm_plus and \f$R_n\f$ is given by + !! \f$ R_n = \left| \overrightarrow{k}_n \right| \tanh\left(\left| \overrightarrow{k}_n \right| h \right) \f$ + !! where \f$ h \f$ is the depth from MSL (or the still water line). + !! + !! To calculate this, we simplify some of the common pieces: + !! + !! \f$ {D}_{nm}^{+} = \frac { R_{nm} \left[ \sqrt{R_m} \left( k_n^2 - R_n^2 \right) - \sqrt{R_n} \left( k_m^2 - R_m^2 \right) \right] + !! ~+~ 2 R_{nm}^2 \left[ \left|\vec{k_n}\right| \left|\vec{k_m}\right| \cos \left( \theta_n-\theta_m \right) + R_n R_m \right] } + !! { R_{nm}^2 - k_{nm}^{+} \tanh \left( k_{nm}^+ h \right) } \f$ + !! + !! where \f$ R_{nm} \equiv \sqrt{R_n} - \sqrt{R_m} \f$. + !! + FUNCTION TransFuncD_plus(n,m,k_n,k_m,R_n,R_m) + + ! Passed variables + INTEGER(IntKi), INTENT(IN ) :: n !< Index to the first frequency we are dealing with + INTEGER(IntKi), INTENT(IN ) :: m !< Index to the second frequency we are dealing with + REAL(SiKi), INTENT(IN ) :: k_n !< WaveNumber for Omega_n -- note no direction associated with this + REAL(SiKi), INTENT(IN ) :: k_m !< WaveNumber for Omega_m -- note no direction associated with this + REAL(SiKi), INTENT(IN ) :: R_n !< Effect scaling relationship of depth and wavenumber + REAL(SiKi), INTENT(IN ) :: R_m !< Effect scaling relationship of depth and wavenumber + REAL(SiKi) :: TransFuncD_plus !< Resulting \f$ D^{+}_{nm} \f$ value. + + ! Local variables + REAL(SiKi) :: k_nm !< Value of \f$ k_{nm}^{+} \f$ + REAL(SiKi) :: SqrtRnPlusRm !< Value of \f$ \sqrt{R_n} + \sqrt{R_m} \f$ + + REAL(SiKi) :: Den !< Denominator + REAL(SiKi) :: Num1 !< Numerator first term + REAL(SiKi) :: Num2 !< Numerator second term + + + + k_nm = k_nm_plus(n,m,k_n,k_m) + + ! Calculate R_nm that appears in multiple places + SqrtRnPlusRm = SQRT(R_n) + SQRT(R_m) + + ! Calculate the two pieces of the numerator + Num1 = SqrtRnPlusRm * ( SQRT(R_m) * ( k_n*k_n - R_n*R_n ) + SQRT(R_n) * ( k_m*k_m - R_m*R_m ) ) + + Num2 = 2*SqrtRnPlusRm*SqrtRnPlusRm*( k_n * k_m * COS( D2R_S*WaveField%WaveDirArr(n) - D2R_S*WaveField%WaveDirArr(m) ) - R_n*R_m ) + + ! Calculate the denominator + Den = SqrtRnPlusRm*SqrtRnPlusRm - k_nm * tanh( k_nm * WaveField%EffWtrDpth ) + + TransFuncD_plus = (Num1+Num2) / Den + + + RETURN + END FUNCTION TransFuncD_plus + + + + + + + !> This function calculates the amplitude of the combined WaveNumber, \f$ k^-_{nm} \f$ of the wave numbers + !! for \f$ k_n \f$ and \f$ k_m \f$ for the difference frequency. The equation is given by + !! \f$ {k}_{nm}^{-} = \sqrt{{k_n}^2 +{k_m}^2 - 2{k_n}{k_m}\cos(\theta_n-\theta_m)} \f$ + !! + !! @note \f$ \theta_n \f$ is given by _InitInp\%WaveDirArr(n)_ + FUNCTION k_nm_minus(n,m,k_n,k_m) + + ! Passed variables + INTEGER(IntKi), INTENT(IN ) :: n !< Index to the first frequency we are dealing with + INTEGER(IntKi), INTENT(IN ) :: m !< Index to the second frequency we are dealing with + REAL(SiKi), INTENT(IN ) :: k_n !< WaveNumber for \f$\omega_n\f$ -- note the direction is found in _InitInp\%WaveDirArr(n)_ + REAL(SiKi), INTENT(IN ) :: k_m !< WaveNumber for \f$\omega_m\f$ -- note the direction is found in _InitInp\%WaveDirArr(m)_ + REAL(SiKi) :: k_nm_minus + + IF (n == m ) THEN + k_nm_minus = 0.0_SiKi ! This is just to eliminate any numerical error + ELSE + !bjj: added abs() because we were getting very small negative numbers here (which should be 0). + k_nm_minus = sqrt( abs( k_n * k_n + k_m * k_m - 2 * k_n * k_m * cos( D2R_S*WaveField%WaveDirArr(n) - D2R_S*WaveField%WaveDirArr(m) ) ) ) + ENDIF + + END FUNCTION k_nm_minus + + + + + !> This function calculates the amplitude of the combined WaveNumber, \f$ k^+_{nm} \f$ of the wave numbers + !! for \f$ k_n \f$ and \f$ k_m \f$ for the difference frequency. The equation is given by + !! \f$ {k}_{nm}^{+} = \sqrt{{k_n}^2 +{k_m}^2 + 2{k_n}{k_m}\cos(\theta_n-\theta_m)} \f$ + !! + !! @note \f$ \theta_n \f$ is given by _InitInp\%WaveDirArr(n)_ + FUNCTION k_nm_plus(n,m,k_n,k_m) + + ! Passed variables + INTEGER(IntKi), INTENT(IN ) :: n !< Index to the first frequency we are dealing with + INTEGER(IntKi), INTENT(IN ) :: m !< Index to the second frequency we are dealing with + REAL(SiKi), INTENT(IN ) :: k_n !< WaveNumber for \f$\omega_n\f$ -- note the direction is found in _InitInp\%WaveDirArr(n)_ + REAL(SiKi), INTENT(IN ) :: k_m !< WaveNumber for \f$\omega_m\f$ -- note the direction is found in _InitInp\%WaveDirArr(m)_ + REAL(SiKi) :: k_nm_plus + + IF (n == m ) THEN + k_nm_plus = 2.0_SiKi * k_n ! This is just to eliminate any numerical error. + ELSE + k_nm_plus = sqrt( k_n * k_n + k_m * k_m + 2_SiKi * k_n * k_m * cos( D2R_S*WaveField%WaveDirArr(n) - D2R_S*WaveField%WaveDirArr(m) ) ) + ENDIF + + END FUNCTION k_nm_plus + + + + + + + + + + SUBROUTINE CleanUp() + + CALL ExitFFT(FFT_Data, ErrStatTmp) + + IF (ALLOCATED(TmpTimeSeries)) DEALLOCATE(TmpTimeSeries, STAT=ErrStatTmp) + IF (ALLOCATED(TmpTimeSeries2)) DEALLOCATE(TmpTimeSeries2, STAT=ErrStatTmp) + IF (ALLOCATED(TmpFreqSeries)) DEALLOCATE(TmpFreqSeries, STAT=ErrStatTmp) + IF (ALLOCATED(TmpFreqSeries2)) DEALLOCATE(TmpFreqSeries2, STAT=ErrStatTmp) + IF (ALLOCATED(WaveElevC0Norm)) DEALLOCATE(WaveElevC0Norm, STAT=ErrStatTmp) + + END SUBROUTINE CleanUp + + - ENDDO ! n loop (diff frequency) - ! NOTE: The IFFT of the these terms is performed below. +END SUBROUTINE Waves2_Init - !--------------- - !> ## Second term ## - !! In this term, we are are now stepping through the sum frequencies. The inner - !! sum essentially covers all the off diagonal terms (omega_m /= omega_n). The limits - !! on the outer integral that is the FFT run through the full frequency range that - !! we are using. - !--------------- - ! The frequency information will be stored in TmpFreqSeries2 +!---------------------------------------------------------------------------------------------------------------------------------- +!> Capture the seeds WaveKinKernel_AddSecondOrderColumns needs into a block store: the gravitational acceleration for the +!! per-pair dispersion solves, the second-order mode flags, and (when not already captured by VariousWaves_Init, i.e. in +!! full-domain mode 0 where the store is routine-local) the grid coordinate arrays. All values are pure copies of the +!! exact values the former Waves2_Init volume calculations used, so the kernel reproduces them bit-for-bit. +SUBROUTINE Waves2_CaptureKernelSeeds( InitInp, Store, ErrStat, ErrMsg ) + + TYPE(Waves2_InitInputType), INTENT(IN ) :: InitInp !< Waves2 initialization input data + TYPE(SeaSt_WaveBlockStoreType), INTENT(INOUT) :: Store !< Generation-seed store (block store or a mode-0 local) + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - ! \f$ \mu^+ \f$ loop. This loop is used to construct the full set of \f$ H_{\mu^+} \f$ terms used in the IFFT to find the timeseries. - !> * \f$ \mu^+ = n + m \f$ - DO mu_plus=2,WaveField%NStepWave2-1 + INTEGER(IntKi) :: I !< Generic counter + INTEGER(IntKi) :: ErrStatTmp !< Temporary error status + character(*), parameter :: RoutineName = 'Waves2_CaptureKernelSeeds' + + ErrStat = ErrID_None + ErrMsg = "" + + Store%Gravity = InitInp%Gravity + Store%SecondOrderDiff = InitInp%WvDiffQTFF + Store%SecondOrderSum = InitInp%WvSumQTFF + + ! The grid coordinates are already captured (from the same source values) when the store is the on-demand block + ! store wired before Waves_Init. Capture them here only for a fresh mode-0 local store. + ! The flat index of grid point (i,j,k) is i + (j-1)*NX + (k-1)*NX*NY (x fastest, z slowest). + IF ( .NOT. ALLOCATED(Store%xGrid) ) THEN + ALLOCATE ( Store%xGrid(InitInp%nGrid(1)), Store%yGrid(InitInp%nGrid(2)), Store%zGrid(InitInp%nGrid(3)), & + STAT=ErrStatTmp ) + IF ( ErrStatTmp /= 0 ) THEN + CALL SetErrStat(ErrID_Fatal,'Error allocating the grid seed arrays.',ErrStat,ErrMsg,RoutineName) + RETURN + END IF + DO I = 1, InitInp%nGrid(1) + Store%xGrid(I) = InitInp%WaveKinGridxi(I) + END DO + DO I = 1, InitInp%nGrid(2) + Store%yGrid(I) = InitInp%WaveKinGridyi(1 + (I-1)*InitInp%nGrid(1)) + END DO + DO I = 1, InitInp%nGrid(3) + Store%zGrid(I) = InitInp%WaveKinGridzi(1 + (I-1)*InitInp%nGrid(1)*InitInp%nGrid(2)) + END DO + END IF - ! The frequency we are dealing with - !> * \f$ \omega^+ = \mu^+ \Delta \omega \f$ - Omega_plus = mu_plus * WaveField%WaveDOmega +END SUBROUTINE Waves2_CaptureKernelSeeds - IF ( Omega_plus >= WaveField%WvLowCOffS .AND. Omega_plus <= WaveField%WvHiCOffS ) THEN - ! The inner \f$ m \f$ loop for calculating the \f$ H_{\mu^+} \f$ terms at each frequency. - DO m=1,FLOOR( REAL(mu_plus - 1) / 2.0_SiKi ) - ! Calculate the value of the n index from \f$ \mu^+ = n + m \f$. Calculate corresponding wavenumbers and frequencies. - n = mu_plus - m - Omega_n = n * WaveField%WaveDOmega - Omega_m = m * WaveField%WaveDOmega - k_n = WaveNumber( Omega_n, InitInp%Gravity, WaveField%EffWtrDpth ) - k_m = WaveNumber( Omega_m, InitInp%Gravity, WaveField%EffWtrDpth ) - R_n = k_n * tanh( k_n * WaveField%EffWtrDpth ) - R_m = k_m * tanh( k_m * WaveField%EffWtrDpth ) - D_plus = TransFuncD_plus(n,m,k_n,k_m,R_n,R_m) +!---------------------------------------------------------------------------------------------------------------------------------- +!> Add the second-order (difference-QTF and/or sum-QTF, per the store flags) wave kinematics into caller-provided +!! block-local volume arrays for grid-point columns x-index iPtX0..iPtX0+nPtX-1, y-index iPtY0..iPtY0+nPtY-1, all grid +!! z levels. The output arrays are block-local, i.e. dimensioned (0:NStepWave,nPtX,nPtY,NZ[,3]), and must already hold +!! the first-order kinematics: this routine ADDS, exactly like the former full-field AddArrays_4D/5D step in SeaState. +!! +!! The per-point calculations are verbatim copies of the second-order volume calculations formerly in Waves2_Init, +!! driven by the seeds captured through Waves2_CaptureKernelSeeds; per-point results are independent of the point set, +!! so full-domain (mode 0) and on-demand block (mode 1) population produce bit-identical values. +!! Grid points below the seabed or above the still water level get no second-order contribution (the former code only +!! computed the z levels in [-EffWtrDpth, 0] and added zeros elsewhere). +!! Note: the MacCamy-Fuchs scaled acceleration deliberately carries no second-order contribution. +SUBROUTINE WaveKinKernel_AddSecondOrderColumns( WaveField, Store, iPtX0, nPtX, iPtY0, nPtY, iPtZ0, nPtZ, & + WaveDynP, WaveVel, WaveAcc, ErrStat, ErrMsg ) + + TYPE(SeaSt_WaveFieldType), INTENT(IN ) :: WaveField !< Initialized wave field (WaveElevC0/WaveDirArr must be final) + TYPE(SeaSt_WaveBlockStoreType), INTENT(IN ) :: Store !< Generation seeds (grid coordinates, gravity, mode flags) + INTEGER(IntKi), INTENT(IN ) :: iPtX0 !< Global x-index of the first column to compute + INTEGER(IntKi), INTENT(IN ) :: nPtX !< Number of columns to compute in x + INTEGER(IntKi), INTENT(IN ) :: iPtY0 !< Global y-index of the first column to compute + INTEGER(IntKi), INTENT(IN ) :: nPtY !< Number of columns to compute in y + INTEGER(IntKi), INTENT(IN ) :: iPtZ0 !< Global z-index of the first grid level to compute + INTEGER(IntKi), INTENT(IN ) :: nPtZ !< Number of grid levels to compute in z + REAL(SiKi), INTENT(INOUT) :: WaveDynP(0:,1:,1:,1:) !< (0:NStepWave,nPtX,nPtY,nPtZ) + REAL(SiKi), INTENT(INOUT) :: WaveVel (0:,1:,1:,1:,1:) !< (0:NStepWave,nPtX,nPtY,nPtZ,3) + REAL(SiKi), INTENT(INOUT) :: WaveAcc (0:,1:,1:,1:,1:) !< (0:NStepWave,nPtX,nPtY,nPtZ,3) + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - !> Calculate the value of - !! \f$ L^+_{nm} = \frac{1}{4} \left[ - !! \frac{D^+_{nm} - |\vec{k}_n| |\vec{k}_m| \cos(\theta_n - \theta_m) + R_n R_m}{\sqrt{R_n R_m}} - !! + (R_n+R_m) \right] \f$ - !! - !! The value of \f$ D^-_{nm} \f$ is found from by the ::TransFuncD_plus routine. - L_plus = (( D_plus - k_n * k_m * COS(D2R_S*WaveField%WaveDirArr(n) - D2R_S*WaveField%WaveDirArr(m)) + R_n * R_m )/SQRT( R_n * R_m ) + R_n + R_m) / 4.0_SiKi + ! Local Variables + INTEGER(IntKi) :: I !< Generic counter + INTEGER(IntKi) :: n !< Generic counter for calculations + INTEGER(IntKi) :: m !< Generic counter for calculations + INTEGER(IntKi) :: mu_minus !< Generic counter for difference kinematics calculations + INTEGER(IntKi) :: mu_plus !< Generic counter for sum kinematics calculations - !> Calculate the dot product of the wavenumbers with the (x,y) location - !! This is given by: - !! - !! * \f$ \exp\left(-\imath \left[\vec{k_n} + \vec{k_m} \right] \cdot \vec{x} \right) - !! = \exp \left( -\imath \left[ - !! \left( |\vec{k_n}| \cos \theta_n + |\vec{k_m}| cos \theta_m \right) ~ x - !! + \left( |\vec{k_n}| \sin \theta_n + |\vec{k_m}| sin \theta_m \right) ~ y \right] \right) \f$ + REAL(ReKi) :: Gravity !< Gravitational acceleration (captured seed, kind-identical to the former InitInp%Gravity) - WaveElevxyPrime0 = exp( - ImagNmbr & - * ( ( k_n * COS( D2R_S*WaveField%WaveDirArr(n) ) + k_m * COS( D2R_S*WaveField%WaveDirArr(m) ) ) * XCoord & - + ( k_n * SIN( D2R_S*WaveField%WaveDirArr(n) ) + k_m * SIN( D2R_S*WaveField%WaveDirArr(m) ) ) * YCoord )) + REAL(SiKi) :: B_minus !< The value of the \f$ B^-_{nm} \f$ transfer function for the current n,m,z. + REAL(SiKi) :: B_plus !< The value of the \f$ B^+_{nm} \f$ transfer function for the current n,m,z. + REAL(SiKi) :: Omega_n !< The frequency corresponding to index n + REAL(SiKi) :: Omega_m !< The frequency corresponding to index m + REAL(SiKi) :: Omega_minus !< The difference frequency corresponding to \f$ \omega_{\mu^-} \f$ + REAL(SiKi) :: Omega_plus !< The sum frequency corresponding to \f$ \omega_{\mu^+} \f$ + REAL(SiKi) :: k_n !< The wavenumber corresponding to \f$ \omega_n \f$ + REAL(SiKi) :: k_m !< The wavenumber corresponding to \f$ \omega_m \f$ + REAL(SiKi) :: k_nm !< Value of \f$ k_{nm}^{-} \f$ - ! First get the wave amplitude -- must be reconstructed from the WaveElevC0 array. First index is the real (1) or - ! imaginary (2) part. Divide by NStepWave2 to remove the built in normalization in WaveElevC0. Note that the phase - ! shift associated with the (x,y) location is accounted for by the WaveElevxyPrime0 variable. - WaveElevC_n = WaveElevC0Norm(n) - WaveElevC_m = WaveElevC0Norm(m) - - !> ### Calculate the inner summation \f$ H^+(\omega_{\mu^+}) \f$ term. ### - !! * \f$ H^+(\omega_{\mu^+}) = \sum_{m=1}^{\lfloor \frac{\mu^+-1}{2}\rfloor} A_n A_m L^+_{nm} - !! \exp\left(-\imath (\vec{k_n} + \vec{k_m})\cdot\vec{x}\right) \f$ - TmpFreqSeries2(mu_plus) = TmpFreqSeries2(mu_plus) + WaveElevC_n * WaveElevC_m * L_plus * WaveElevxyPrime0 + COMPLEX(SiKi) :: WaveElevxyPrime0 !< The dot product of the wave vector differece and location \f$ \exp[ -i * (\vec{k_n}-\vec{k_m})\cdot\vec{x}] \f$ - ENDDO ! m loop + COMPLEX(SiKi) :: WaveElevC_n !< The complex wave elevation for the nth frequency component + COMPLEX(SiKi) :: WaveElevC_m !< The complex wave elevation for the mth frequency component + COMPLEX(SiKi), ALLOCATABLE :: WaveElevC0Norm(:) !< The complex wave amplitude, normalized for these equations. - ENDIF ! Check to see if WvLowCOffS <= mu_plus <= WvHiCOffS + ! Velocity calculations + REAL(SiKi) :: Ux_nm_minus !< The value of \f$ _xU^-_{nm} \f$ used in calculating the x-component of the second order wave velocity + REAL(SiKi) :: Ux_nm_plus !< The value of \f$ _xU^+_{nm} \f$ used in calculating the x-component of the second order sum-frequency wave velocity + REAL(SiKi) :: Uy_nm_minus !< The value of \f$ _yU^-_{nm} \f$ used in calculating the y-component of the second order wave velocity + REAL(SiKi) :: Uy_nm_plus !< The value of \f$ _yU^+_{nm} \f$ used in calculating the y-component of the second order sum-frequency wave velocity + COMPLEX(SiKi) :: Uz_nm_minus !< The value of \f$ _z{U}^-_{nm} \f$ used in calculating the z-component of the second order wave velocity + COMPLEX(SiKi) :: Uz_nm_plus !< The value of \f$ _z{U}^+_{nm} \f$ used in calculating the z-component of the second order sum-frequency wave velocity - ENDDO ! mu_plus loop (diff frequency) + ! Acceleration calculations + COMPLEX(SiKi) :: Accx_nm_minus !< The value of \f$ _xAcc^-_{nm} = (\imath) \cdot _xU^-_{nm} \omega_{\mu^-} \f$ + COMPLEX(SiKi) :: Accx_nm_plus !< The value of \f$ _xAcc^+_{nm} = (\imath) \cdot _xU^+_{nm} \omega_{\mu^+} \f$ + COMPLEX(SiKi) :: Accy_nm_minus !< The value of \f$ _yAcc^-_{nm} = (\imath) \cdot _yU^-_{nm} \omega_{\mu^-} \f$ + COMPLEX(SiKi) :: Accy_nm_plus !< The value of \f$ _yAcc^+_{nm} = (\imath) \cdot _yU^+_{nm} \omega_{\mu^+} \f$ + COMPLEX(SiKi) :: Accz_nm_minus !< The value of \f$ _z{Acc}^-_{nm} = (\imath) \cdot _zU^-_{nm} \omega_{\mu^-} \f$ + COMPLEX(SiKi) :: Accz_nm_plus !< The value of \f$ _z{Acc}^+_{nm} = (\imath) \cdot _zU^+_{nm} \omega_{\mu^+} \f$ + ! Pressure calculations + REAL(SiKi) :: DynP_nm_minus !< The value of \f$ \rho_\mathrm{w} B_{nm}^- \omega_{\mu^-} \f$ + REAL(SiKi) :: DynP_nm_plus !< The value of \f$ \rho_\mathrm{w} B_{nm}^+ \omega_{\mu^+} \f$ - ! Divide by two for the single sided FFT given in the documentation. - TmpFreqSeries = TmpFreqSeries / 2.0_SiKi - TmpFreqSeries2 = TmpFreqSeries2 / 2.0_SiKi + ! Calculation of 2nd order particle acceleration, velocity, and pressure terms + COMPLEX(SiKi), ALLOCATABLE :: WaveVel2xCDiff(:) !< Frequency space difference frequency particle velocity term in the x direction + COMPLEX(SiKi), ALLOCATABLE :: WaveVel2yCDiff(:) !< Frequency space difference frequency particle velocity term in the y direction + COMPLEX(SiKi), ALLOCATABLE :: WaveVel2zCDiff(:) !< Frequency space difference frequency particle velocity term in the z direction + COMPLEX(SiKi), ALLOCATABLE :: WaveAcc2xCDiff(:) !< Frequency space difference frequency particle acceleration term in the x direction + COMPLEX(SiKi), ALLOCATABLE :: WaveAcc2yCDiff(:) !< Frequency space difference frequency particle acceleration term in the y direction + COMPLEX(SiKi), ALLOCATABLE :: WaveAcc2zCDiff(:) !< Frequency space difference frequency particle acceleration term in the z direction + REAL(SiKi), ALLOCATABLE :: WaveVel2xDiff(:) !< Time domain difference frequency particle velocity term in the x direction + REAL(SiKi), ALLOCATABLE :: WaveVel2yDiff(:) !< Time domain difference frequency particle velocity term in the y direction + REAL(SiKi), ALLOCATABLE :: WaveVel2zDiff(:) !< Time domain difference frequency particle velocity term in the z direction + REAL(SiKi), ALLOCATABLE :: WaveAcc2xDiff(:) !< Time domain difference frequency particle acceleration term in the x direction + REAL(SiKi), ALLOCATABLE :: WaveAcc2yDiff(:) !< Time domain difference frequency particle acceleration term in the y direction + REAL(SiKi), ALLOCATABLE :: WaveAcc2zDiff(:) !< Time domain difference frequency particle acceleration term in the z direction + COMPLEX(SiKi), ALLOCATABLE :: WaveDynP2CDiff(:) !< Frequency space difference frequency dynamic pressure term + REAL(SiKi), ALLOCATABLE :: WaveDynP2Diff(:) !< Time domain difference frequency dynamic pressure term - !> ## Apply the inverse FFT to the first and second terms to get the time domain result ## - !> * \f$ \eta^{(2)+}(t) = \operatorname{IFFT}\left[K^+\right] - !! + 2\operatorname{IFFT}\left[H^+\right] \f$ - CALL ApplyFFT_cx( WaveElevSeriesAtXY(:), TmpFreqSeries(:), FFT_Data, ErrStatLcl2 ) - CALL SetErrStat(ErrStatLcl2,'Error occurred while applying the FFT on WaveElevSeriesAtXY.',ErrStatLcl,ErrMsgLcl,'WaveElevSeriesAtXY_Sum') - CALL ApplyFFT_cx( TmpTimeSeries2(:), TmpFreqSeries2(:), FFT_Data, ErrStatLcl2 ) - CALL SetErrStat(ErrStatLcl2,'Error occurred while applying the FFT on WaveElevSeriesAtXY.',ErrStatLcl,ErrMsgLcl,'WaveElevSeriesAtXY_Sum') + COMPLEX(SiKi), ALLOCATABLE :: WaveVel2xCSumT1(:) !< Frequency space sum frequency particle velocity term 1 in the x direction + COMPLEX(SiKi), ALLOCATABLE :: WaveVel2yCSumT1(:) !< Frequency space sum frequency particle velocity term 1 in the y direction + COMPLEX(SiKi), ALLOCATABLE :: WaveVel2zCSumT1(:) !< Frequency space sum frequency particle velocity term 1 in the z direction + COMPLEX(SiKi), ALLOCATABLE :: WaveAcc2xCSumT1(:) !< Frequency space sum frequency particle acceleration term 1 in the x direction + COMPLEX(SiKi), ALLOCATABLE :: WaveAcc2yCSumT1(:) !< Frequency space sum frequency particle acceleration term 1 in the y direction + COMPLEX(SiKi), ALLOCATABLE :: WaveAcc2zCSumT1(:) !< Frequency space sum frequency particle acceleration term 1 in the z direction + REAL(SiKi), ALLOCATABLE :: WaveVel2xSumT1(:) !< Time domain sum frequency particle velocity term 1 in the x direction + REAL(SiKi), ALLOCATABLE :: WaveVel2ySumT1(:) !< Time domain sum frequency particle velocity term 1 in the y direction + REAL(SiKi), ALLOCATABLE :: WaveVel2zSumT1(:) !< Time domain sum frequency particle velocity term 1 in the z direction + REAL(SiKi), ALLOCATABLE :: WaveAcc2xSumT1(:) !< Time domain sum frequency particle acceleration term 1 in the x direction + REAL(SiKi), ALLOCATABLE :: WaveAcc2ySumT1(:) !< Time domain sum frequency particle acceleration term 1 in the y direction + REAL(SiKi), ALLOCATABLE :: WaveAcc2zSumT1(:) !< Time domain sum frequency particle acceleration term 1 in the z direction + COMPLEX(SiKi), ALLOCATABLE :: WaveDynP2CSumT1(:) !< Frequency space sum frequency dynamic pressure term 1 + REAL(SiKi), ALLOCATABLE :: WaveDynP2SumT1(:) !< Time domain sum frequency dynamic pressure term 1 + + COMPLEX(SiKi), ALLOCATABLE :: WaveVel2xCSumT2(:) !< Frequency space sum frequency particle velocity term 2 in the x direction + COMPLEX(SiKi), ALLOCATABLE :: WaveVel2yCSumT2(:) !< Frequency space sum frequency particle velocity term 2 in the y direction + COMPLEX(SiKi), ALLOCATABLE :: WaveVel2zCSumT2(:) !< Frequency space sum frequency particle velocity term 2 in the z direction + COMPLEX(SiKi), ALLOCATABLE :: WaveAcc2xCSumT2(:) !< Frequency space sum frequency particle acceleration term 2 in the x direction + COMPLEX(SiKi), ALLOCATABLE :: WaveAcc2yCSumT2(:) !< Frequency space sum frequency particle acceleration term 2 in the y direction + COMPLEX(SiKi), ALLOCATABLE :: WaveAcc2zCSumT2(:) !< Frequency space sum frequency particle acceleration term 2 in the z direction + REAL(SiKi), ALLOCATABLE :: WaveVel2xSumT2(:) !< Time domain sum frequency particle velocity term 2 in the x direction + REAL(SiKi), ALLOCATABLE :: WaveVel2ySumT2(:) !< Time domain sum frequency particle velocity term 2 in the y direction + REAL(SiKi), ALLOCATABLE :: WaveVel2zSumT2(:) !< Time domain sum frequency particle velocity term 2 in the z direction + REAL(SiKi), ALLOCATABLE :: WaveAcc2xSumT2(:) !< Time domain sum frequency particle acceleration term 2 in the x direction + REAL(SiKi), ALLOCATABLE :: WaveAcc2ySumT2(:) !< Time domain sum frequency particle acceleration term 2 in the y direction + REAL(SiKi), ALLOCATABLE :: WaveAcc2zSumT2(:) !< Time domain sum frequency particle acceleration term 2 in the z direction + COMPLEX(SiKi), ALLOCATABLE :: WaveDynP2CSumT2(:) !< Frequency space sum frequency dynamic pressure term 2 + REAL(SiKi), ALLOCATABLE :: WaveDynP2SumT2(:) !< Time domain sum frequency dynamic pressure term 2 + + REAL(SiKi), ALLOCATABLE :: SumCol(:) !< Combined sum-frequency column, = T1 + 2*T2, rounded exactly like the former full-size InitOut store + + REAL(SiKi) :: xi !< x coordinate of this column + REAL(SiKi) :: yi !< y coordinate of this column + REAL(SiKi) :: zi !< z coordinate of this grid level + + INTEGER(IntKi) :: jx, jy !< Column-local x/y indices + INTEGER(IntKi) :: ixG, iyG !< Global grid x/y indices + INTEGER(IntKi) :: kz !< Block-local grid z-level index + INTEGER(IntKi) :: kzG !< Global grid z-level index + INTEGER(IntKi) :: NZgrid !< Number of grid z levels to compute - ! Add the two terms together - DO Ctr=0,WaveField%NStepWave - WaveElevSeriesAtXY(Ctr) = WaveElevSeriesAtXY(Ctr) + 2.0_SiKi * TmpTimeSeries2(Ctr) - ENDDO - - ! Append first datapoint as the last as aid for repeated wave data - WaveElevSeriesAtXY(WaveField%NStepWave) = WaveElevSeriesAtXY(0) - + ! Stuff for the FFT calculations + TYPE(FFT_DataType) :: FFT_Data !< the instance of the FFT module we're using - END SUBROUTINE WaveElevTimeSeriesAtXY_Sum + ! Temporary error trapping variables + INTEGER(IntKi) :: ErrStatTmp !< Temporary variable for holding the error status returned from a CALL statement + character(*), parameter :: RoutineName = 'WaveKinKernel_AddSecondOrderColumns' + + ErrStat = ErrID_None + ErrStatTmp = ErrID_None + ErrMsg = "" + + IF ( .NOT. ( Store%SecondOrderDiff .OR. Store%SecondOrderSum ) ) RETURN + + Gravity = Store%Gravity + NZgrid = nPtZ + + ! The wave elevation information in frequency space -- we need to normalize this by NStepWave2 + ! (identical to the normalization in Waves2_Init) + ALLOCATE ( WaveElevC0Norm(0:WaveField%NStepWave2) , STAT=ErrStatTmp ) + IF (ErrStatTmp /= 0) then + CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveElevC0Norm.',ErrStat,ErrMsg,RoutineName) + RETURN + END IF + DO I=0,WaveField%NStepWave2 + WaveElevC0Norm(I) = CMPLX( WaveField%WaveElevC0(1,I), WaveField%WaveElevC0(2,I), SiKi ) / REAL(WaveField%NStepWave2,SiKi) + ENDDO + CALL InitFFT ( WaveField%NStepWave, FFT_Data, .FALSE., ErrStatTmp ) + CALL SetErrStat(ErrStatTmp,'Error occurred while initializing the FFT.',ErrStat,ErrMsg,RoutineName) + IF ( ErrStat >= AbortErrLev ) RETURN + + IF ( Store%SecondOrderDiff ) THEN + ALLOCATE ( WaveVel2xCDiff (0:WaveField%NStepWave2), WaveVel2yCDiff(0:WaveField%NStepWave2), & + WaveVel2zCDiff (0:WaveField%NStepWave2), WaveAcc2xCDiff(0:WaveField%NStepWave2), & + WaveAcc2yCDiff (0:WaveField%NStepWave2), WaveAcc2zCDiff(0:WaveField%NStepWave2), & + WaveDynP2CDiff (0:WaveField%NStepWave2), & + WaveVel2xDiff (0:WaveField%NStepWave), WaveVel2yDiff (0:WaveField%NStepWave), & + WaveVel2zDiff (0:WaveField%NStepWave), WaveAcc2xDiff (0:WaveField%NStepWave), & + WaveAcc2yDiff (0:WaveField%NStepWave), WaveAcc2zDiff (0:WaveField%NStepWave), & + WaveDynP2Diff (0:WaveField%NStepWave), STAT=ErrStatTmp ) + IF (ErrStatTmp /= 0) THEN + CALL SetErrStat(ErrID_Fatal,'Cannot allocate the difference-frequency work arrays.',ErrStat,ErrMsg,RoutineName) + CALL CleanUp() + RETURN + END IF + END IF + IF ( Store%SecondOrderSum ) THEN + ALLOCATE ( WaveVel2xCSumT1(0:WaveField%NStepWave2), WaveVel2yCSumT1(0:WaveField%NStepWave2), & + WaveVel2zCSumT1(0:WaveField%NStepWave2), WaveAcc2xCSumT1(0:WaveField%NStepWave2), & + WaveAcc2yCSumT1(0:WaveField%NStepWave2), WaveAcc2zCSumT1(0:WaveField%NStepWave2), & + WaveDynP2CSumT1(0:WaveField%NStepWave2), & + WaveVel2xCSumT2(0:WaveField%NStepWave2), WaveVel2yCSumT2(0:WaveField%NStepWave2), & + WaveVel2zCSumT2(0:WaveField%NStepWave2), WaveAcc2xCSumT2(0:WaveField%NStepWave2), & + WaveAcc2yCSumT2(0:WaveField%NStepWave2), WaveAcc2zCSumT2(0:WaveField%NStepWave2), & + WaveDynP2CSumT2(0:WaveField%NStepWave2), & + WaveVel2xSumT1 (0:WaveField%NStepWave), WaveVel2ySumT1 (0:WaveField%NStepWave), & + WaveVel2zSumT1 (0:WaveField%NStepWave), WaveAcc2xSumT1 (0:WaveField%NStepWave), & + WaveAcc2ySumT1 (0:WaveField%NStepWave), WaveAcc2zSumT1 (0:WaveField%NStepWave), & + WaveDynP2SumT1 (0:WaveField%NStepWave), & + WaveVel2xSumT2 (0:WaveField%NStepWave), WaveVel2ySumT2 (0:WaveField%NStepWave), & + WaveVel2zSumT2 (0:WaveField%NStepWave), WaveAcc2xSumT2 (0:WaveField%NStepWave), & + WaveAcc2ySumT2 (0:WaveField%NStepWave), WaveAcc2zSumT2 (0:WaveField%NStepWave), & + WaveDynP2SumT2 (0:WaveField%NStepWave), & + SumCol (0:WaveField%NStepWave), STAT=ErrStatTmp ) + IF (ErrStatTmp /= 0) THEN + CALL SetErrStat(ErrID_Fatal,'Cannot allocate the sum-frequency work arrays.',ErrStat,ErrMsg,RoutineName) + CALL CleanUp() + RETURN + END IF + END IF + DO jy = 1, nPtY + iyG = iPtY0 + jy - 1 + yi = Store%yGrid(iyG) + DO jx = 1, nPtX + ixG = iPtX0 + jx - 1 + xi = Store%xGrid(ixG) + DO kz = 1, NZgrid + kzG = iPtZ0 + kz - 1 + zi = Store%zGrid(kzG) + + ! Only points between the seabed and the still water level (inclusive) carry second-order kinematics + ! (same selection as the former WaveKinzi0Prime array in Waves2_Init). + IF ( .NOT. ( zi >= -WaveField%EffWtrDpth .AND. zi <= 0.0 ) ) CYCLE + + IF ( Store%SecondOrderDiff ) THEN + + ! Reset the \f$ H_{\mu^-} \f$ terms to zero before calculating. + WaveVel2xCDiff = CMPLX(0.0_SiKi, 0.0_SiKi, SiKi) + WaveVel2yCDiff = CMPLX(0.0_SiKi, 0.0_SiKi, SiKi) + WaveVel2zCDiff = CMPLX(0.0_SiKi, 0.0_SiKi, SiKi) + WaveAcc2xCDiff = CMPLX(0.0_SiKi, 0.0_SiKi, SiKi) + WaveAcc2yCDiff = CMPLX(0.0_SiKi, 0.0_SiKi, SiKi) + WaveAcc2zCDiff = CMPLX(0.0_SiKi, 0.0_SiKi, SiKi) + WaveDynP2CDiff = CMPLX(0.0_SiKi, 0.0_SiKi, SiKi) + + ! \f$ \mu^- \f$ loop. This loop is used to construct the full set of \f$ H_{\mu^-} \f$ terms used in the IFFT to find the timeseries. + !> * \f$ \mu^- = n -m \f$ + DO mu_minus=1,WaveField%NStepWave2-1 + + ! The frequency we are dealing with + !> * \f$ \omega^- = \mu^- \Delta \omega \f$ + Omega_minus = mu_minus * WaveField%WaveDOmega + + IF ( Omega_minus >= WaveField%WvLowCOffD .AND. Omega_minus <= WaveField%WvHiCOffD ) THEN + + ! The inner \f$ m \f$ loop for calculating the \f$ H_{\mu^-} \f$ terms at each frequency. + DO m=1,WaveField%NStepWave2-mu_minus + ! Calculate the value of the n index from \f$ \mu^- = n - m \f$. Calculate corresponding wavenumbers and frequencies. + n = mu_minus + m + Omega_n = n * WaveField%WaveDOmega + Omega_m = m * WaveField%WaveDOmega + k_n = WaveNumber( Omega_n, Gravity, WaveField%EffWtrDpth ) + k_m = WaveNumber( Omega_m, Gravity, WaveField%EffWtrDpth ) + k_nm = k_nm_minus( n, m, k_n, k_m ) + + ! Calculate the dot product of the wavenumbers with the (x,y) location + WaveElevxyPrime0 = exp( - ImagNmbr & + * ( ( k_n * COS( D2R_S*WaveField%WaveDirArr(n) ) - k_m * COS( D2R_S*WaveField%WaveDirArr(m) ) ) * xi & + + ( k_n * SIN( D2R_S*WaveField%WaveDirArr(n) ) - k_m * SIN( D2R_S*WaveField%WaveDirArr(m) ) ) * yi )) + + ! Get value for \f$ B^- \f$ for the n,m index pair + B_minus = TransFuncB_minus( n, m, k_n, k_m, zi ) + + !> Calculate \f$ U^- \f$ terms for the velocity calculations (\f$B^-\f$ provided by ::TransFuncB_minus) + ! NOTE: WaveField%EffWtrDpth + zi is the height above the ocean floor + !> * \f$ _x{U}_{nm}^- = B_{nm}^- \left(k_n \cos \theta_n - k_m \cos \theta_m \right) \f$ + Ux_nm_minus = B_minus * ( k_n * COS( D2R_S*WaveField%WaveDirArr(n) ) - k_m * COS( D2R_S*WaveField%WaveDirArr(m) ) ) + + !> * \f$ _y{U}_{nm}^- = B_{nm}^- \left(k_n \sin \theta_n - k_m \sin \theta_m \right) \f$ + Uy_nm_minus = B_minus * ( k_n * SIN( D2R_S*WaveField%WaveDirArr(n) ) - k_m * SIN( D2R_S*WaveField%WaveDirArr(m) ) ) + + !> * \f$ _z{U}_{nm}^- = \imath B_{nm}^- k_{nm} \tanh \left( k_{nm} ( h + z ) \right) \f$ + Uz_nm_minus = ImagNmbr * B_minus * k_nm * tanh( k_nm * ( WaveField%EffWtrDpth + zi ) ) + + !> Acceleration calculations + Accx_nm_minus = ImagNmbr * Ux_nm_minus * Omega_minus + Accy_nm_minus = ImagNmbr * Uy_nm_minus * Omega_minus + Accz_nm_minus = ImagNmbr * Uz_nm_minus * Omega_minus + + !> Dynamic pressure + !> * \f$ P_{nm}^- = \rho_\mathrm{w} B_{nm}^- \omega_{\mu^-} \f$ + DynP_nm_minus = REAL(WaveField%WtrDens,SiKi) * B_minus * Omega_minus + + ! Get the wave amplitude -- reconstructed from the WaveElevC0 array (normalized) + WaveElevC_n = WaveElevC0Norm(n) + WaveElevC_m = WaveElevC0Norm(m) + + !> Velocity terms + WaveVel2xCDiff(mu_minus) = WaveVel2xCDiff(mu_minus) + WaveElevC_n * CONJG( WaveElevC_m ) * Ux_nm_minus * WaveElevxyPrime0 + WaveVel2yCDiff(mu_minus) = WaveVel2yCDiff(mu_minus) + WaveElevC_n * CONJG( WaveElevC_m ) * Uy_nm_minus * WaveElevxyPrime0 + WaveVel2zCDiff(mu_minus) = WaveVel2zCDiff(mu_minus) + WaveElevC_n * CONJG( WaveElevC_m ) * Uz_nm_minus * WaveElevxyPrime0 + + !> Acceleration terms + WaveAcc2xCDiff(mu_minus) = WaveAcc2xCDiff(mu_minus) + WaveElevC_n * CONJG( WaveElevC_m ) * Accx_nm_minus * WaveElevxyPrime0 + WaveAcc2yCDiff(mu_minus) = WaveAcc2yCDiff(mu_minus) + WaveElevC_n * CONJG( WaveElevC_m ) * Accy_nm_minus * WaveElevxyPrime0 + WaveAcc2zCDiff(mu_minus) = WaveAcc2zCDiff(mu_minus) + WaveElevC_n * CONJG( WaveElevC_m ) * Accz_nm_minus * WaveElevxyPrime0 + + !> Pressure term + WaveDynP2CDiff(mu_minus) = WaveDynP2CDiff(mu_minus) + WaveElevC_n * CONJG( WaveElevC_m ) * DynP_nm_minus * WaveElevxyPrime0 + + ENDDO ! m loop + + ENDIF ! Check to see if WvLowCOffD <= mu_minus <= WvHiCOffD + + ENDDO ! mu_minus loop (diff frequency) + + ! Divide by two for the single sided FFT given in the documentation. + WaveVel2xCDiff = WaveVel2xCDiff / 2.0_SiKi + WaveVel2yCDiff = WaveVel2yCDiff / 2.0_SiKi + WaveVel2zCDiff = WaveVel2zCDiff / 2.0_SiKi + WaveAcc2xCDiff = WaveAcc2xCDiff / 2.0_SiKi + WaveAcc2yCDiff = WaveAcc2yCDiff / 2.0_SiKi + WaveAcc2zCDiff = WaveAcc2zCDiff / 2.0_SiKi + WaveDynP2CDiff = WaveDynP2CDiff / 2.0_SiKi + + !> ### Apply the inverse FFT to each of the components to get the time domain result ### + !> * \f$ V(t) = 2 \operatorname{IFFT}\left[H^-\right] \f$ + CALL ApplyFFT_cx( WaveVel2xDiff(:), WaveVel2xCDiff(:), FFT_Data, ErrStatTmp ) + CALL SetErrStat(ErrStatTmp,'Error occurred while applying the FFT on V_x.',ErrStat,ErrMsg,RoutineName) + CALL ApplyFFT_cx( WaveVel2yDiff(:), WaveVel2yCDiff(:), FFT_Data, ErrStatTmp ) + CALL SetErrStat(ErrStatTmp,'Error occurred while applying the FFT on V_y.',ErrStat,ErrMsg,RoutineName) + CALL ApplyFFT_cx( WaveVel2zDiff(:), WaveVel2zCDiff(:), FFT_Data, ErrStatTmp ) + CALL SetErrStat(ErrStatTmp,'Error occurred while applying the FFT on V_z.',ErrStat,ErrMsg,RoutineName) + + CALL ApplyFFT_cx( WaveAcc2xDiff(:), WaveAcc2xCDiff(:), FFT_Data, ErrStatTmp ) + CALL SetErrStat(ErrStatTmp,'Error occurred while applying the FFT on Acc_x.',ErrStat,ErrMsg,RoutineName) + CALL ApplyFFT_cx( WaveAcc2yDiff(:), WaveAcc2yCDiff(:), FFT_Data, ErrStatTmp ) + CALL SetErrStat(ErrStatTmp,'Error occurred while applying the FFT on Acc_y.',ErrStat,ErrMsg,RoutineName) + CALL ApplyFFT_cx( WaveAcc2zDiff(:), WaveAcc2zCDiff(:), FFT_Data, ErrStatTmp ) + CALL SetErrStat(ErrStatTmp,'Error occurred while applying the FFT on Acc_z.',ErrStat,ErrMsg,RoutineName) + + CALL ApplyFFT_cx( WaveDynP2Diff(:), WaveDynP2CDiff(:), FFT_Data, ErrStatTmp ) + CALL SetErrStat(ErrStatTmp,'Error occurred while applying the FFT on DynP2.',ErrStat,ErrMsg,RoutineName) + + IF ( ErrStat >= AbortErrLev ) THEN + CALL CleanUp() + RETURN + END IF + + ! Add the doubled IFFT results into the block-local arrays: 2*x is exact in floating point, so + ! base + 2*diff reproduces the former InitOut store + AddArrays sequence bit-for-bit. The wrapped + ! last time step deliberately carries NO factor of 2 (historical quirk of the former code). + WaveVel (0:WaveField%NStepWave-1,jx,jy,kz,1) = WaveVel (0:WaveField%NStepWave-1,jx,jy,kz,1) + 2.0_SiKi * WaveVel2xDiff (0:WaveField%NStepWave-1) + WaveVel (0:WaveField%NStepWave-1,jx,jy,kz,2) = WaveVel (0:WaveField%NStepWave-1,jx,jy,kz,2) + 2.0_SiKi * WaveVel2yDiff (0:WaveField%NStepWave-1) + WaveVel (0:WaveField%NStepWave-1,jx,jy,kz,3) = WaveVel (0:WaveField%NStepWave-1,jx,jy,kz,3) + 2.0_SiKi * WaveVel2zDiff (0:WaveField%NStepWave-1) + WaveAcc (0:WaveField%NStepWave-1,jx,jy,kz,1) = WaveAcc (0:WaveField%NStepWave-1,jx,jy,kz,1) + 2.0_SiKi * WaveAcc2xDiff (0:WaveField%NStepWave-1) + WaveAcc (0:WaveField%NStepWave-1,jx,jy,kz,2) = WaveAcc (0:WaveField%NStepWave-1,jx,jy,kz,2) + 2.0_SiKi * WaveAcc2yDiff (0:WaveField%NStepWave-1) + WaveAcc (0:WaveField%NStepWave-1,jx,jy,kz,3) = WaveAcc (0:WaveField%NStepWave-1,jx,jy,kz,3) + 2.0_SiKi * WaveAcc2zDiff (0:WaveField%NStepWave-1) + WaveDynP(0:WaveField%NStepWave-1,jx,jy,kz ) = WaveDynP(0:WaveField%NStepWave-1,jx,jy,kz ) + 2.0_SiKi * WaveDynP2Diff (0:WaveField%NStepWave-1) + + WaveVel (WaveField%NStepWave,jx,jy,kz,1) = WaveVel (WaveField%NStepWave,jx,jy,kz,1) + WaveVel2xDiff (0) + WaveVel (WaveField%NStepWave,jx,jy,kz,2) = WaveVel (WaveField%NStepWave,jx,jy,kz,2) + WaveVel2yDiff (0) + WaveVel (WaveField%NStepWave,jx,jy,kz,3) = WaveVel (WaveField%NStepWave,jx,jy,kz,3) + WaveVel2zDiff (0) + WaveAcc (WaveField%NStepWave,jx,jy,kz,1) = WaveAcc (WaveField%NStepWave,jx,jy,kz,1) + WaveAcc2xDiff (0) + WaveAcc (WaveField%NStepWave,jx,jy,kz,2) = WaveAcc (WaveField%NStepWave,jx,jy,kz,2) + WaveAcc2yDiff (0) + WaveAcc (WaveField%NStepWave,jx,jy,kz,3) = WaveAcc (WaveField%NStepWave,jx,jy,kz,3) + WaveAcc2zDiff (0) + WaveDynP(WaveField%NStepWave,jx,jy,kz ) = WaveDynP(WaveField%NStepWave,jx,jy,kz ) + WaveDynP2Diff (0) + + END IF ! SecondOrderDiff + + IF ( Store%SecondOrderSum ) THEN + + ! Reset the \f$ H_{\mu^+} \f$ terms to zero before calculating. + WaveVel2xCSumT1 = CMPLX(0.0_SiKi, 0.0_SiKi, SiKi) + WaveVel2yCSumT1 = CMPLX(0.0_SiKi, 0.0_SiKi, SiKi) + WaveVel2zCSumT1 = CMPLX(0.0_SiKi, 0.0_SiKi, SiKi) + WaveAcc2xCSumT1 = CMPLX(0.0_SiKi, 0.0_SiKi, SiKi) + WaveAcc2yCSumT1 = CMPLX(0.0_SiKi, 0.0_SiKi, SiKi) + WaveAcc2zCSumT1 = CMPLX(0.0_SiKi, 0.0_SiKi, SiKi) + WaveDynP2CSumT1 = CMPLX(0.0_SiKi, 0.0_SiKi, SiKi) + + WaveVel2xCSumT2 = CMPLX(0.0_SiKi, 0.0_SiKi, SiKi) + WaveVel2yCSumT2 = CMPLX(0.0_SiKi, 0.0_SiKi, SiKi) + WaveVel2zCSumT2 = CMPLX(0.0_SiKi, 0.0_SiKi, SiKi) + WaveAcc2xCSumT2 = CMPLX(0.0_SiKi, 0.0_SiKi, SiKi) + WaveAcc2yCSumT2 = CMPLX(0.0_SiKi, 0.0_SiKi, SiKi) + WaveAcc2zCSumT2 = CMPLX(0.0_SiKi, 0.0_SiKi, SiKi) + WaveDynP2CSumT2 = CMPLX(0.0_SiKi, 0.0_SiKi, SiKi) + + !> ### First term ### + !! This term is only the FFT over the diagonal elements where \f$ \omega_n = \omega_m \f$ + DO n=1,FLOOR( REAL(WaveField%NStepWave2-1) / 2.0_SiKi ) ! Only + + Omega_n = n * WaveField%WaveDOmega + + ! The frequency we are dealing with + !> * \f$ \omega^+ = \mu^+ \Delta \omega = 2 \omega_n \f$ + mu_plus = 2 * n + Omega_plus = 2.0_SiKi * Omega_n + + IF ( Omega_plus >= WaveField%WvLowCOffS .AND. Omega_plus <= WaveField%WvHiCOffS ) THEN + k_n = WaveNumber( Omega_n, Gravity, WaveField%EffWtrDpth ) + k_nm = k_nm_plus( n, n, k_n, k_n ) + + ! Calculate the dot product of the wavenumbers with the (x,y) location + WaveElevxyPrime0 = exp( - ImagNmbr & + * ( 2.0_SiKi * k_n * COS( D2R_S*WaveField%WaveDirArr(n) ) * xi & + + 2.0_SiKi * k_n * SIN( D2R_S*WaveField%WaveDirArr(n) ) * yi )) + + ! Get value for \f$ B+ \f$ for the n,m index pair + B_plus = TransFuncB_plus( n, n, k_n, k_n, zi ) + + !> Calculate \f$ U^+ \f$ terms for the velocity calculations + ! NOTE: WaveField%EffWtrDpth + zi is the height above the ocean floor + !> * \f$ _x{U}_{nn}^+ = B_{nn}^+ 2 k_n \cos \theta_n \f$ + Ux_nm_plus = B_plus * 2.0_SiKi * k_n * COS( D2R_S*WaveField%WaveDirArr(n) ) + + !> * \f$ _y{U}_{nn}^+ = B_{nn}^+ 2 k_n \sin \theta_n \f$ + Uy_nm_plus = B_plus * 2.0_SiKi * k_n * SIN( D2R_S*WaveField%WaveDirArr(n) ) + + !> * \f$ _z{U}_{nn}^+ = \imath B_{nn}^+ k_{nn} \tanh \left( k_{nn} ( h + z ) \right) \f$ + Uz_nm_plus = ImagNmbr * B_plus * k_nm * tanh( k_nm * ( WaveField%EffWtrDpth + zi ) ) + + !> Acceleration calculations + Accx_nm_plus = ImagNmbr * Ux_nm_plus * Omega_plus + Accy_nm_plus = ImagNmbr * Uy_nm_plus * Omega_plus + Accz_nm_plus = ImagNmbr * Uz_nm_plus * Omega_plus + + !> Dynamic pressure + !> * \f$ P_{nn}^+ = \rho_\mathrm{w} B_{nn}^+ \omega_{\mu^+} \f$ + DynP_nm_plus = REAL(WaveField%WtrDens, SiKi) * B_plus * Omega_plus + + ! Get the wave amplitude -- reconstructed from the WaveElevC0 array (normalized) + WaveElevC_n = WaveElevC0Norm(n) + + !> Velocity terms + WaveVel2xCSumT1(mu_plus) = WaveElevC_n * WaveElevC_n * Ux_nm_plus * WaveElevxyPrime0 + WaveVel2yCSumT1(mu_plus) = WaveElevC_n * WaveElevC_n * Uy_nm_plus * WaveElevxyPrime0 + WaveVel2zCSumT1(mu_plus) = WaveElevC_n * WaveElevC_n * Uz_nm_plus * WaveElevxyPrime0 + + !> Acceleration terms + WaveAcc2xCSumT1(mu_plus) = WaveElevC_n * WaveElevC_n * Accx_nm_plus * WaveElevxyPrime0 + WaveAcc2yCSumT1(mu_plus) = WaveElevC_n * WaveElevC_n * Accy_nm_plus * WaveElevxyPrime0 + WaveAcc2zCSumT1(mu_plus) = WaveElevC_n * WaveElevC_n * Accz_nm_plus * WaveElevxyPrime0 + + !> Pressure term + WaveDynP2CSumT1(mu_plus) = WaveElevC_n * WaveElevC_n * DynP_nm_plus * WaveElevxyPrime0 + + ENDIF ! Check to see if WvLowCOffS <= mu_plus <= WvHiCOffS + + ENDDO ! n loop (sum frequency) + + !> ### Second term ### + !! In this term, we step through the sum frequencies (all the off-diagonal terms). + !> * \f$ \mu^+ = n + m \f$ + DO mu_plus=2,WaveField%NStepWave2-1 + + ! The frequency we are dealing with + !> * \f$ \omega^+ = \mu^+ \Delta \omega \f$ + Omega_plus = mu_plus * WaveField%WaveDOmega + + IF ( Omega_plus >= WaveField%WvLowCOffS .AND. Omega_plus <= WaveField%WvHiCOffS ) THEN + ! The inner \f$ m \f$ loop for calculating the \f$ H_{\mu^+} \f$ terms at each frequency. + DO m=1,FLOOR( REAL(mu_plus - 1) / 2.0_SiKi ) + ! Calculate the value of the n index from \f$ \mu^+ = n + m \f$. Calculate corresponding wavenumbers and frequencies. + n = mu_plus - m + Omega_n = n * WaveField%WaveDOmega + Omega_m = m * WaveField%WaveDOmega + k_n = WaveNumber( Omega_n, Gravity, WaveField%EffWtrDpth ) + k_m = WaveNumber( Omega_m, Gravity, WaveField%EffWtrDpth ) + k_nm = k_nm_plus( n, m, k_n, k_m ) + + ! Calculate the dot product of the wavenumbers with the (x,y) location + WaveElevxyPrime0 = exp( - ImagNmbr & + * ( ( k_n * COS( D2R_S*WaveField%WaveDirArr(n) ) + k_m * COS( D2R_S*WaveField%WaveDirArr(m) ) ) * xi & + + ( k_n * SIN( D2R_S*WaveField%WaveDirArr(n) ) + k_m * SIN( D2R_S*WaveField%WaveDirArr(m) ) ) * yi )) + + ! Get value for \f$ B+ \f$ for the n,m index pair + B_plus = TransFuncB_plus( n, m, k_n, k_m, zi ) + + !> Calculate \f$ U^+ \f$ terms for the velocity calculations + ! NOTE: WaveField%EffWtrDpth + zi is the height above the ocean floor + !> * \f$ _x{U}_{nm}^+ = B_{nm}^+ \left(k_n \cos \theta_n + k_m \cos \theta_m \right) \f$ + Ux_nm_plus = B_plus * ( k_n * COS( D2R_S*WaveField%WaveDirArr(n) ) + k_m * COS( D2R_S*WaveField%WaveDirArr(m) ) ) + + !> * \f$ _y{U}_{nm}^+ = B_{nm}^+ \left(k_n \sin \theta_n + k_m \sin \theta_m \right) \f$ + Uy_nm_plus = B_plus * ( k_n * SIN( D2R_S*WaveField%WaveDirArr(n) ) + k_m * SIN( D2R_S*WaveField%WaveDirArr(m) ) ) + + !> * \f$ _z{U}_{nm}^+ = \imath B_{nm}^+ k_{nm} \tanh \left( k_{nm} ( h + z ) \right) \f$ + Uz_nm_plus = ImagNmbr * B_plus * k_nm * tanh( k_nm * ( WaveField%EffWtrDpth + zi ) ) + + !> Acceleration calculations + Accx_nm_plus = ImagNmbr * Ux_nm_plus * Omega_plus + Accy_nm_plus = ImagNmbr * Uy_nm_plus * Omega_plus + Accz_nm_plus = ImagNmbr * Uz_nm_plus * Omega_plus + + !> Dynamic pressure + !> * \f$ P_{nm}^+ = \rho_\mathrm{w} B_{nm}^+ \omega_{\mu^+} \f$ + DynP_nm_plus = REAL(WaveField%WtrDens,SiKi) * B_plus * Omega_plus + + ! Get the wave amplitudes -- reconstructed from the WaveElevC0 array (normalized) + WaveElevC_n = WaveElevC0Norm(n) + WaveElevC_m = WaveElevC0Norm(m) + + !> Velocity terms + WaveVel2xCSumT2(mu_plus) = WaveVel2xCSumT2(mu_plus) + WaveElevC_n * WaveElevC_m * Ux_nm_plus * WaveElevxyPrime0 + WaveVel2yCSumT2(mu_plus) = WaveVel2yCSumT2(mu_plus) + WaveElevC_n * WaveElevC_m * Uy_nm_plus * WaveElevxyPrime0 + WaveVel2zCSumT2(mu_plus) = WaveVel2zCSumT2(mu_plus) + WaveElevC_n * WaveElevC_m * Uz_nm_plus * WaveElevxyPrime0 + + !> Acceleration terms + WaveAcc2xCSumT2(mu_plus) = WaveAcc2xCSumT2(mu_plus) + WaveElevC_n * WaveElevC_m * Accx_nm_plus * WaveElevxyPrime0 + WaveAcc2yCSumT2(mu_plus) = WaveAcc2yCSumT2(mu_plus) + WaveElevC_n * WaveElevC_m * Accy_nm_plus * WaveElevxyPrime0 + WaveAcc2zCSumT2(mu_plus) = WaveAcc2zCSumT2(mu_plus) + WaveElevC_n * WaveElevC_m * Accz_nm_plus * WaveElevxyPrime0 + + !> Pressure term + WaveDynP2CSumT2(mu_plus) = WaveDynP2CSumT2(mu_plus) + WaveElevC_n * WaveElevC_m * DynP_nm_plus * WaveElevxyPrime0 + + ENDDO ! m loop + + ENDIF ! Check to see if WvLowCOffS <= mu_plus <= WvHiCOffS + + ENDDO ! mu_plus loop (sum frequency) + + ! Divide by two for the single sided FFT given in the documentation. + WaveVel2xCSumT1 = WaveVel2xCSumT1 / 2.0_SiKi + WaveVel2yCSumT1 = WaveVel2yCSumT1 / 2.0_SiKi + WaveVel2zCSumT1 = WaveVel2zCSumT1 / 2.0_SiKi + WaveAcc2xCSumT1 = WaveAcc2xCSumT1 / 2.0_SiKi + WaveAcc2yCSumT1 = WaveAcc2yCSumT1 / 2.0_SiKi + WaveAcc2zCSumT1 = WaveAcc2zCSumT1 / 2.0_SiKi + WaveDynP2CSumT1 = WaveDynP2CSumT1 / 2.0_SiKi + WaveVel2xCSumT2 = WaveVel2xCSumT2 / 2.0_SiKi + WaveVel2yCSumT2 = WaveVel2yCSumT2 / 2.0_SiKi + WaveVel2zCSumT2 = WaveVel2zCSumT2 / 2.0_SiKi + WaveAcc2xCSumT2 = WaveAcc2xCSumT2 / 2.0_SiKi + WaveAcc2yCSumT2 = WaveAcc2yCSumT2 / 2.0_SiKi + WaveAcc2zCSumT2 = WaveAcc2zCSumT2 / 2.0_SiKi + WaveDynP2CSumT2 = WaveDynP2CSumT2 / 2.0_SiKi + + !> ### Apply the inverse FFT to the first and second terms of each of the components to get the time domain result ### + !> * \f$ V^{(2)+}(t) = \operatorname{IFFT}\left[K^+\right] + 2\operatorname{IFFT}\left[H^+\right] \f$ + CALL ApplyFFT_cx( WaveVel2xSumT1(:), WaveVel2xCSumT1(:), FFT_Data, ErrStatTmp ) + CALL SetErrStat(ErrStatTmp,'Error occurred while applying the FFT on V_x.',ErrStat,ErrMsg,RoutineName) + CALL ApplyFFT_cx( WaveVel2ySumT1(:), WaveVel2yCSumT1(:), FFT_Data, ErrStatTmp ) + CALL SetErrStat(ErrStatTmp,'Error occurred while applying the FFT on V_y.',ErrStat,ErrMsg,RoutineName) + CALL ApplyFFT_cx( WaveVel2zSumT1(:), WaveVel2zCSumT1(:), FFT_Data, ErrStatTmp ) + CALL SetErrStat(ErrStatTmp,'Error occurred while applying the FFT on V_z.',ErrStat,ErrMsg,RoutineName) + + CALL ApplyFFT_cx( WaveAcc2xSumT1(:), WaveAcc2xCSumT1(:), FFT_Data, ErrStatTmp ) + CALL SetErrStat(ErrStatTmp,'Error occurred while applying the FFT on Acc_x.',ErrStat,ErrMsg,RoutineName) + CALL ApplyFFT_cx( WaveAcc2ySumT1(:), WaveAcc2yCSumT1(:), FFT_Data, ErrStatTmp ) + CALL SetErrStat(ErrStatTmp,'Error occurred while applying the FFT on Acc_y.',ErrStat,ErrMsg,RoutineName) + CALL ApplyFFT_cx( WaveAcc2zSumT1(:), WaveAcc2zCSumT1(:), FFT_Data, ErrStatTmp ) + CALL SetErrStat(ErrStatTmp,'Error occurred while applying the FFT on Acc_z.',ErrStat,ErrMsg,RoutineName) + + CALL ApplyFFT_cx( WaveDynP2SumT1(:), WaveDynP2CSumT1(:), FFT_Data, ErrStatTmp ) + CALL SetErrStat(ErrStatTmp,'Error occurred while applying the FFT on DynP2.',ErrStat,ErrMsg,RoutineName) + + CALL ApplyFFT_cx( WaveVel2xSumT2(:), WaveVel2xCSumT2(:), FFT_Data, ErrStatTmp ) + CALL SetErrStat(ErrStatTmp,'Error occurred while applying the FFT on V_x.',ErrStat,ErrMsg,RoutineName) + CALL ApplyFFT_cx( WaveVel2ySumT2(:), WaveVel2yCSumT2(:), FFT_Data, ErrStatTmp ) + CALL SetErrStat(ErrStatTmp,'Error occurred while applying the FFT on V_y.',ErrStat,ErrMsg,RoutineName) + CALL ApplyFFT_cx( WaveVel2zSumT2(:), WaveVel2zCSumT2(:), FFT_Data, ErrStatTmp ) + CALL SetErrStat(ErrStatTmp,'Error occurred while applying the FFT on V_z.',ErrStat,ErrMsg,RoutineName) + + CALL ApplyFFT_cx( WaveAcc2xSumT2(:), WaveAcc2xCSumT2(:), FFT_Data, ErrStatTmp ) + CALL SetErrStat(ErrStatTmp,'Error occurred while applying the FFT on Acc_x.',ErrStat,ErrMsg,RoutineName) + CALL ApplyFFT_cx( WaveAcc2ySumT2(:), WaveAcc2yCSumT2(:), FFT_Data, ErrStatTmp ) + CALL SetErrStat(ErrStatTmp,'Error occurred while applying the FFT on Acc_y.',ErrStat,ErrMsg,RoutineName) + CALL ApplyFFT_cx( WaveAcc2zSumT2(:), WaveAcc2zCSumT2(:), FFT_Data, ErrStatTmp ) + CALL SetErrStat(ErrStatTmp,'Error occurred while applying the FFT on Acc_z.',ErrStat,ErrMsg,RoutineName) + + CALL ApplyFFT_cx( WaveDynP2SumT2(:), WaveDynP2CSumT2(:), FFT_Data, ErrStatTmp ) + CALL SetErrStat(ErrStatTmp,'Error occurred while applying the FFT on DynP2.',ErrStat,ErrMsg,RoutineName) + + IF ( ErrStat >= AbortErrLev ) THEN + CALL CleanUp() + RETURN + END IF + + ! Combine the two terms exactly as the former code stored them (T1 + 2*T2, rounded once in SiKi), + ! then add into the block-local arrays. The wrapped last time step carries the combined value at t=0. + SumCol(0:WaveField%NStepWave-1) = WaveVel2xSumT1(0:WaveField%NStepWave-1) + 2.0_SiKi * WaveVel2xSumT2(0:WaveField%NStepWave-1) + WaveVel (0:WaveField%NStepWave-1,jx,jy,kz,1) = WaveVel (0:WaveField%NStepWave-1,jx,jy,kz,1) + SumCol(0:WaveField%NStepWave-1) + WaveVel (WaveField%NStepWave,jx,jy,kz,1) = WaveVel (WaveField%NStepWave,jx,jy,kz,1) + SumCol(0) + + SumCol(0:WaveField%NStepWave-1) = WaveVel2ySumT1(0:WaveField%NStepWave-1) + 2.0_SiKi * WaveVel2ySumT2(0:WaveField%NStepWave-1) + WaveVel (0:WaveField%NStepWave-1,jx,jy,kz,2) = WaveVel (0:WaveField%NStepWave-1,jx,jy,kz,2) + SumCol(0:WaveField%NStepWave-1) + WaveVel (WaveField%NStepWave,jx,jy,kz,2) = WaveVel (WaveField%NStepWave,jx,jy,kz,2) + SumCol(0) + + SumCol(0:WaveField%NStepWave-1) = WaveVel2zSumT1(0:WaveField%NStepWave-1) + 2.0_SiKi * WaveVel2zSumT2(0:WaveField%NStepWave-1) + WaveVel (0:WaveField%NStepWave-1,jx,jy,kz,3) = WaveVel (0:WaveField%NStepWave-1,jx,jy,kz,3) + SumCol(0:WaveField%NStepWave-1) + WaveVel (WaveField%NStepWave,jx,jy,kz,3) = WaveVel (WaveField%NStepWave,jx,jy,kz,3) + SumCol(0) + + SumCol(0:WaveField%NStepWave-1) = WaveAcc2xSumT1(0:WaveField%NStepWave-1) + 2.0_SiKi * WaveAcc2xSumT2(0:WaveField%NStepWave-1) + WaveAcc (0:WaveField%NStepWave-1,jx,jy,kz,1) = WaveAcc (0:WaveField%NStepWave-1,jx,jy,kz,1) + SumCol(0:WaveField%NStepWave-1) + WaveAcc (WaveField%NStepWave,jx,jy,kz,1) = WaveAcc (WaveField%NStepWave,jx,jy,kz,1) + SumCol(0) + + SumCol(0:WaveField%NStepWave-1) = WaveAcc2ySumT1(0:WaveField%NStepWave-1) + 2.0_SiKi * WaveAcc2ySumT2(0:WaveField%NStepWave-1) + WaveAcc (0:WaveField%NStepWave-1,jx,jy,kz,2) = WaveAcc (0:WaveField%NStepWave-1,jx,jy,kz,2) + SumCol(0:WaveField%NStepWave-1) + WaveAcc (WaveField%NStepWave,jx,jy,kz,2) = WaveAcc (WaveField%NStepWave,jx,jy,kz,2) + SumCol(0) + + SumCol(0:WaveField%NStepWave-1) = WaveAcc2zSumT1(0:WaveField%NStepWave-1) + 2.0_SiKi * WaveAcc2zSumT2(0:WaveField%NStepWave-1) + WaveAcc (0:WaveField%NStepWave-1,jx,jy,kz,3) = WaveAcc (0:WaveField%NStepWave-1,jx,jy,kz,3) + SumCol(0:WaveField%NStepWave-1) + WaveAcc (WaveField%NStepWave,jx,jy,kz,3) = WaveAcc (WaveField%NStepWave,jx,jy,kz,3) + SumCol(0) + + SumCol(0:WaveField%NStepWave-1) = WaveDynP2SumT1(0:WaveField%NStepWave-1) + 2.0_SiKi * WaveDynP2SumT2(0:WaveField%NStepWave-1) + WaveDynP(0:WaveField%NStepWave-1,jx,jy,kz ) = WaveDynP(0:WaveField%NStepWave-1,jx,jy,kz ) + SumCol(0:WaveField%NStepWave-1) + WaveDynP(WaveField%NStepWave,jx,jy,kz ) = WaveDynP(WaveField%NStepWave,jx,jy,kz ) + SumCol(0) + + END IF ! SecondOrderSum + + END DO ! kz - grid z levels + END DO ! jx - columns in x + END DO ! jy - columns in y + + CALL CleanUp() +CONTAINS + SUBROUTINE CleanUp() + CALL ExitFFT(FFT_Data, ErrStatTmp) + IF (ALLOCATED(WaveElevC0Norm)) DEALLOCATE(WaveElevC0Norm, STAT=ErrStatTmp) + END SUBROUTINE CleanUp !> This function calculates the term \f$ B^-_{nm} \f$ used in calculating the veloicty, acceleration, and dynamic pressure terms. @@ -1636,7 +1607,7 @@ FUNCTION TransFuncB_minus(n,m,k_n,k_m,z) ! Calculation of B_minus - TransFuncB_minus = REAL(InitInp%Gravity*InitInp%Gravity,SiKi) / ( 4.0_SiKi * Omega_n * Omega_m ) & + TransFuncB_minus = REAL(Gravity*Gravity,SiKi) / ( 4.0_SiKi * Omega_n * Omega_m ) & * COSHNumOvrCOSHDen(k_nm, REAL(WaveField%EffWtrDpth,SiKi), z) * D_minus / ( Omega_n - Omega_m ) @@ -1697,7 +1668,7 @@ FUNCTION TransFuncB_plus(n,m,k_n,k_m,z) D_plus = TransFuncD_plus(n,m,k_n,k_m,R_n,R_m) ! Calculation of B_plus - TransFuncB_plus = REAL(InitInp%Gravity*InitInp%Gravity,SiKi) / ( 4.0_SiKi * Omega_n * Omega_m ) & + TransFuncB_plus = REAL(Gravity*Gravity,SiKi) / ( 4.0_SiKi * Omega_n * Omega_m ) & * COSHNumOvrCOSHDen(k_nm, REAL(WaveField%EffWtrDpth,SiKi), z) * D_plus / ( Omega_n + Omega_m ) @@ -1752,34 +1723,8 @@ END FUNCTION COSHNumOvrCOSHDen !> This function calculates the term \f$ D^-_{nm} \f$ used in finding the transfer functions. - !! The equation is given by: - !! - !! \f$ {D}_{nm}^{-} = - !! \frac { \left(\sqrt{R_n} - \sqrt{R_m}\right) \left[ \sqrt{R_m} \left( k_n^2 - R_n^2 \right) - \sqrt{R_n} \left( k_m^{2} - R_m^2 \right) \right] - !! ~+~ 2 \left(\sqrt{R_n} - \sqrt{R_m}\right)^2 - !! \left[ \left|\vec{k_n}\right| \left|\vec{k_m}\right| \cos \left( \theta_n-\theta_m \right) + R_n R_m \right] } - !! { \left(\sqrt{R_n} - \sqrt{R_m}\right)^2 - k_{nm}^{-} \tanh \left( k_{nm}^{-} h \right) } \f$ - !! - !! where \f$ k_{nm}^{-} \f$ is handled by the function ::k_nm_minus and \f$R_n\f$ is given by - !! \f$ R_n = \left| \overrightarrow{k}_n \right| \tanh\left(\left| \overrightarrow{k}_n \right| h \right) \f$ - !! where \f$ h \f$ is the depth from MSL (or the still water line). - !! - !! To calculate this, we simplify some of the common pieces: - !! - !! \f$ {D}_{nm}^{-} = \frac { R_{nm} \left[ \sqrt{R_m} \left( k_n^2 - R_n^2 \right) - \sqrt{R_n} \left( k_m^2 -R_m^2 \right) \right] - !! ~+~ 2 R_{nm}^2 \left[ \left|\vec{k_n}\right| \left|\vec{k_m}\right| \cos \left( \theta_n-\theta_m \right) + R_n R_m \right] } - !! { R_{nm}^2 - k_{nm}^{-} \tanh \left( k_{nm}^- h \right) } \f$ - !! - !! where \f$ R_{nm} \equiv \sqrt{R_n} - \sqrt{R_m} \f$. - !! - !! The denominator goes to zero when \f$ n = m \f$, as does the numerator. So, using L'Hopital's rule to find the limit, it may be - !! possible to prove that \f$ \stackrel{\lim}{n \to m} D_{nm}^{-} = 0 \f$. It will take more than one derivative - !! to check this, so due to time, this has not been verified. For now we we simply assume this to be true and proceed to set - !! _TransFuncD_minus_ to zero for all \f$ n = m \f$ cases. _This should not be done!_ Plotting this cross sections of this function - !! shows that when \f$ n = m \f$, the result should converge to something non-zero, but close to zero. - !! - !! @note update this function when the limit has been derived. - !! + !! Verbatim copy of the function of the same name contained in Waves2_Init (kept there for the + !! second-order wave elevation corrections). FUNCTION TransFuncD_minus(n,m,k_n,k_m,R_n,R_m) ! Passed variables @@ -1826,28 +1771,9 @@ FUNCTION TransFuncD_minus(n,m,k_n,k_m,R_n,R_m) END FUNCTION TransFuncD_minus - !> This function calculates the term \f$ D^+_{nm} \f$ used in finding the transfer functions. - !! The equation is given by: - !! - !! \f$ {D}_{nm}^{+} = - !! \frac { \left(\sqrt{R_n} + \sqrt{R_m}\right) \left[ \sqrt{R_m} \left( k_n^2 - R_n^2 \right) + \sqrt{R_n} \left( k_m^{2} - R_m^2 \right) \right] - !! ~+~ 2 \left(\sqrt{R_n} + \sqrt{R_m}\right)^2 - !! \left[ \left|\vec{k_n}\right| \left|\vec{k_m}\right| \cos \left( \theta_n-\theta_m \right) - R_n R_m \right] } - !! { \left(\sqrt{R_n} + \sqrt{R_m}\right)^2 - k_{nm}^{+} \tanh \left( k_{nm}^{+} h \right) } \f$ - !! - !! where \f$ k_{nm}^{+} \f$ is handled by the function ::k_nm_plus and \f$R_n\f$ is given by - !! \f$ R_n = \left| \overrightarrow{k}_n \right| \tanh\left(\left| \overrightarrow{k}_n \right| h \right) \f$ - !! where \f$ h \f$ is the depth from MSL (or the still water line). - !! - !! To calculate this, we simplify some of the common pieces: - !! - !! \f$ {D}_{nm}^{+} = \frac { R_{nm} \left[ \sqrt{R_m} \left( k_n^2 - R_n^2 \right) - \sqrt{R_n} \left( k_m^2 - R_m^2 \right) \right] - !! ~+~ 2 R_{nm}^2 \left[ \left|\vec{k_n}\right| \left|\vec{k_m}\right| \cos \left( \theta_n-\theta_m \right) + R_n R_m \right] } - !! { R_{nm}^2 - k_{nm}^{+} \tanh \left( k_{nm}^+ h \right) } \f$ - !! - !! where \f$ R_{nm} \equiv \sqrt{R_n} - \sqrt{R_m} \f$. - !! + !! Verbatim copy of the function of the same name contained in Waves2_Init (kept there for the + !! second-order wave elevation corrections). FUNCTION TransFuncD_plus(n,m,k_n,k_m,R_n,R_m) ! Passed variables @@ -1889,48 +1815,38 @@ FUNCTION TransFuncD_plus(n,m,k_n,k_m,R_n,R_m) END FUNCTION TransFuncD_plus - - - - !> This function calculates the amplitude of the combined WaveNumber, \f$ k^-_{nm} \f$ of the wave numbers - !! for \f$ k_n \f$ and \f$ k_m \f$ for the difference frequency. The equation is given by - !! \f$ {k}_{nm}^{-} = \sqrt{{k_n}^2 +{k_m}^2 - 2{k_n}{k_m}\cos(\theta_n-\theta_m)} \f$ - !! - !! @note \f$ \theta_n \f$ is given by _InitInp\%WaveDirArr(n)_ + !! for \f$ k_n \f$ and \f$ k_m \f$ for the difference frequency. + !! Verbatim copy of the function of the same name contained in Waves2_Init. FUNCTION k_nm_minus(n,m,k_n,k_m) ! Passed variables INTEGER(IntKi), INTENT(IN ) :: n !< Index to the first frequency we are dealing with INTEGER(IntKi), INTENT(IN ) :: m !< Index to the second frequency we are dealing with - REAL(SiKi), INTENT(IN ) :: k_n !< WaveNumber for \f$\omega_n\f$ -- note the direction is found in _InitInp\%WaveDirArr(n)_ - REAL(SiKi), INTENT(IN ) :: k_m !< WaveNumber for \f$\omega_m\f$ -- note the direction is found in _InitInp\%WaveDirArr(m)_ + REAL(SiKi), INTENT(IN ) :: k_n !< WaveNumber for \f$\omega_n\f$ + REAL(SiKi), INTENT(IN ) :: k_m !< WaveNumber for \f$\omega_m\f$ REAL(SiKi) :: k_nm_minus IF (n == m ) THEN k_nm_minus = 0.0_SiKi ! This is just to eliminate any numerical error ELSE - !bjj: added abs() because we were getting very small negative numbers here (which should be 0). + !bjj: added abs() because we were getting very small negative numbers here (which should be 0). k_nm_minus = sqrt( abs( k_n * k_n + k_m * k_m - 2 * k_n * k_m * cos( D2R_S*WaveField%WaveDirArr(n) - D2R_S*WaveField%WaveDirArr(m) ) ) ) ENDIF END FUNCTION k_nm_minus - - !> This function calculates the amplitude of the combined WaveNumber, \f$ k^+_{nm} \f$ of the wave numbers - !! for \f$ k_n \f$ and \f$ k_m \f$ for the difference frequency. The equation is given by - !! \f$ {k}_{nm}^{+} = \sqrt{{k_n}^2 +{k_m}^2 + 2{k_n}{k_m}\cos(\theta_n-\theta_m)} \f$ - !! - !! @note \f$ \theta_n \f$ is given by _InitInp\%WaveDirArr(n)_ + !! for \f$ k_n \f$ and \f$ k_m \f$ for the sum frequency. + !! Verbatim copy of the function of the same name contained in Waves2_Init. FUNCTION k_nm_plus(n,m,k_n,k_m) ! Passed variables INTEGER(IntKi), INTENT(IN ) :: n !< Index to the first frequency we are dealing with INTEGER(IntKi), INTENT(IN ) :: m !< Index to the second frequency we are dealing with - REAL(SiKi), INTENT(IN ) :: k_n !< WaveNumber for \f$\omega_n\f$ -- note the direction is found in _InitInp\%WaveDirArr(n)_ - REAL(SiKi), INTENT(IN ) :: k_m !< WaveNumber for \f$\omega_m\f$ -- note the direction is found in _InitInp\%WaveDirArr(m)_ + REAL(SiKi), INTENT(IN ) :: k_n !< WaveNumber for \f$\omega_n\f$ + REAL(SiKi), INTENT(IN ) :: k_m !< WaveNumber for \f$\omega_m\f$ REAL(SiKi) :: k_nm_plus IF (n == m ) THEN @@ -1942,71 +1858,7 @@ FUNCTION k_nm_plus(n,m,k_n,k_m) END FUNCTION k_nm_plus - - - - - - - - SUBROUTINE CleanUp() - - CALL ExitFFT(FFT_Data, ErrStatTmp) - - IF (ALLOCATED(TmpTimeSeries)) DEALLOCATE(TmpTimeSeries, STAT=ErrStatTmp) - - IF (ALLOCATED(WaveVel2xCDiff)) DEALLOCATE(WaveVel2xCDiff, STAT=ErrStatTmp) - IF (ALLOCATED(WaveVel2yCDiff)) DEALLOCATE(WaveVel2yCDiff, STAT=ErrStatTmp) - IF (ALLOCATED(WaveVel2zCDiff)) DEALLOCATE(WaveVel2zCDiff, STAT=ErrStatTmp) - IF (ALLOCATED(WaveAcc2xCDiff)) DEALLOCATE(WaveAcc2xCDiff, STAT=ErrStatTmp) - IF (ALLOCATED(WaveAcc2yCDiff)) DEALLOCATE(WaveAcc2yCDiff, STAT=ErrStatTmp) - IF (ALLOCATED(WaveAcc2zCDiff)) DEALLOCATE(WaveAcc2zCDiff, STAT=ErrStatTmp) - IF (ALLOCATED(WaveVel2xDiff)) DEALLOCATE(WaveVel2xDiff, STAT=ErrStatTmp) - IF (ALLOCATED(WaveVel2yDiff)) DEALLOCATE(WaveVel2yDiff, STAT=ErrStatTmp) - IF (ALLOCATED(WaveVel2zDiff)) DEALLOCATE(WaveVel2zDiff, STAT=ErrStatTmp) - IF (ALLOCATED(WaveAcc2xDiff)) DEALLOCATE(WaveAcc2xDiff, STAT=ErrStatTmp) - IF (ALLOCATED(WaveAcc2yDiff)) DEALLOCATE(WaveAcc2yDiff, STAT=ErrStatTmp) - IF (ALLOCATED(WaveAcc2zDiff)) DEALLOCATE(WaveAcc2zDiff, STAT=ErrStatTmp) - IF (ALLOCATED(WaveDynP2CDiff)) DEALLOCATE(WaveDynP2CDiff, STAT=ErrStatTmp) - IF (ALLOCATED(WaveDynP2Diff)) DEALLOCATE(WaveDynP2Diff, STAT=ErrStatTmp) - - IF (ALLOCATED(WaveVel2xCSumT1)) DEALLOCATE(WaveVel2xCSumT1, STAT=ErrStatTmp) - IF (ALLOCATED(WaveVel2yCSumT1)) DEALLOCATE(WaveVel2yCSumT1, STAT=ErrStatTmp) - IF (ALLOCATED(WaveVel2zCSumT1)) DEALLOCATE(WaveVel2zCSumT1, STAT=ErrStatTmp) - IF (ALLOCATED(WaveAcc2xCSumT1)) DEALLOCATE(WaveAcc2xCSumT1, STAT=ErrStatTmp) - IF (ALLOCATED(WaveAcc2yCSumT1)) DEALLOCATE(WaveAcc2yCSumT1, STAT=ErrStatTmp) - IF (ALLOCATED(WaveAcc2zCSumT1)) DEALLOCATE(WaveAcc2zCSumT1, STAT=ErrStatTmp) - IF (ALLOCATED(WaveVel2xSumT1)) DEALLOCATE(WaveVel2xSumT1, STAT=ErrStatTmp) - IF (ALLOCATED(WaveVel2ySumT1)) DEALLOCATE(WaveVel2ySumT1, STAT=ErrStatTmp) - IF (ALLOCATED(WaveVel2zSumT1)) DEALLOCATE(WaveVel2zSumT1, STAT=ErrStatTmp) - IF (ALLOCATED(WaveAcc2xSumT1)) DEALLOCATE(WaveAcc2xSumT1, STAT=ErrStatTmp) - IF (ALLOCATED(WaveAcc2ySumT1)) DEALLOCATE(WaveAcc2ySumT1, STAT=ErrStatTmp) - IF (ALLOCATED(WaveAcc2zSumT1)) DEALLOCATE(WaveAcc2zSumT1, STAT=ErrStatTmp) - IF (ALLOCATED(WaveDynP2CSumT1)) DEALLOCATE(WaveDynP2CSumT1, STAT=ErrStatTmp) - IF (ALLOCATED(WaveDynP2SumT1)) DEALLOCATE(WaveDynP2SumT1, STAT=ErrStatTmp) - - IF (ALLOCATED(WaveVel2xCSumT2)) DEALLOCATE(WaveVel2xCSumT2, STAT=ErrStatTmp) - IF (ALLOCATED(WaveVel2yCSumT2)) DEALLOCATE(WaveVel2yCSumT2, STAT=ErrStatTmp) - IF (ALLOCATED(WaveVel2zCSumT2)) DEALLOCATE(WaveVel2zCSumT2, STAT=ErrStatTmp) - IF (ALLOCATED(WaveAcc2xCSumT2)) DEALLOCATE(WaveAcc2xCSumT2, STAT=ErrStatTmp) - IF (ALLOCATED(WaveAcc2yCSumT2)) DEALLOCATE(WaveAcc2yCSumT2, STAT=ErrStatTmp) - IF (ALLOCATED(WaveAcc2zCSumT2)) DEALLOCATE(WaveAcc2zCSumT2, STAT=ErrStatTmp) - IF (ALLOCATED(WaveVel2xSumT2)) DEALLOCATE(WaveVel2xSumT2, STAT=ErrStatTmp) - IF (ALLOCATED(WaveVel2ySumT2)) DEALLOCATE(WaveVel2ySumT2, STAT=ErrStatTmp) - IF (ALLOCATED(WaveVel2zSumT2)) DEALLOCATE(WaveVel2zSumT2, STAT=ErrStatTmp) - IF (ALLOCATED(WaveAcc2xSumT2)) DEALLOCATE(WaveAcc2xSumT2, STAT=ErrStatTmp) - IF (ALLOCATED(WaveAcc2ySumT2)) DEALLOCATE(WaveAcc2ySumT2, STAT=ErrStatTmp) - IF (ALLOCATED(WaveAcc2zSumT2)) DEALLOCATE(WaveAcc2zSumT2, STAT=ErrStatTmp) - IF (ALLOCATED(WaveDynP2CSumT2)) DEALLOCATE(WaveDynP2CSumT2, STAT=ErrStatTmp) - IF (ALLOCATED(WaveDynP2SumT2)) DEALLOCATE(WaveDynP2SumT2, STAT=ErrStatTmp) - - END SUBROUTINE CleanUp - - - - -END SUBROUTINE Waves2_Init - +END SUBROUTINE WaveKinKernel_AddSecondOrderColumns !---------------------------------------------------------------------------------------------------------------------------------- diff --git a/modules/seastate/src/Waves2.txt b/modules/seastate/src/Waves2.txt index 0437fbe7f2..cc9095d93b 100644 --- a/modules/seastate/src/Waves2.txt +++ b/modules/seastate/src/Waves2.txt @@ -30,13 +30,9 @@ typedef ^ ^ LOGICAL WvDiffQTFF typedef ^ ^ LOGICAL WvSumQTFF - - - "Full sum QTF second order forces flag" (-) -# Define outputs from the initialization routine here: -# -typedef ^ InitOutputType SiKi WaveAcc2D {:}{:}{:}{:}{:} - - "Instantaneous 2nd-order difference frequency correction for the acceleration of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, at each of the NWaveKinGrid points where the incident wave kinematics will be computed" (m/s^2) -typedef ^ ^ SiKi WaveDynP2D {:}{:}{:}{:} - - "Instantaneous 2nd-order difference frequency correction for the dynamic pressure of incident waves , at each of the NWaveKinGrid points where the incident wave kinematics will be computed" (N/m^2) -typedef ^ ^ SiKi WaveAcc2S {:}{:}{:}{:}{:} - - "Instantaneous 2nd-order sum frequency correction for the acceleration of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, at each of the NWaveKinGrid points where the incident wave kinematics will be computed" (m/s^2) -typedef ^ ^ SiKi WaveDynP2S {:}{:}{:}{:} - - "Instantaneous 2nd-order sum frequency correction for the dynamic pressure of incident waves , at each of the NWaveKinGrid points where the incident wave kinematics will be computed" (N/m^2) -typedef ^ ^ SiKi WaveVel2D {:}{:}{:}{:}{:} - - "Instantaneous 2nd-order difference frequency correction for the velocity of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, at each of the NWaveKinGrid points where the incident wave kinematics will be computed (The values include both the velocity of incident waves and the velocity of current.)" (m/s) -typedef ^ ^ SiKi WaveVel2S {:}{:}{:}{:}{:} - - "Instantaneous 2nd-order sum frequency correction for the velocity of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, at each of the NWaveKinGrid points where the incident wave kinematics will be computed (The values include both the velocity of incident waves and the velocity of current.)" (m/s) +# NOTE: Waves2 no longer defines an InitOutputType. The second-order volume kinematics are computed per grid column +# by WaveKinKernel_AddSecondOrderColumns (module Waves2) and added directly into the SeaSt_WaveFieldType volume +# arrays (mode 0) or an on-demand block (mode 1), so the full-size init-time temporaries WaveVel2D/S, WaveAcc2D/S, +# WaveDynP2D/S are gone. Waves2_Init now only checks inputs and computes the WaveElev2 surface correction. diff --git a/modules/seastate/src/Waves2_Types.f90 b/modules/seastate/src/Waves2_Types.f90 index 34e1bb24f2..d48daaf83d 100644 --- a/modules/seastate/src/Waves2_Types.f90 +++ b/modules/seastate/src/Waves2_Types.f90 @@ -46,16 +46,6 @@ MODULE Waves2_Types LOGICAL :: WvSumQTFF = .false. !< Full sum QTF second order forces flag [(-)] END TYPE Waves2_InitInputType ! ======================= -! ========= Waves2_InitOutputType ======= - TYPE, PUBLIC :: Waves2_InitOutputType - REAL(SiKi) , DIMENSION(:,:,:,:,:), ALLOCATABLE :: WaveAcc2D !< Instantaneous 2nd-order difference frequency correction for the acceleration of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, at each of the NWaveKinGrid points where the incident wave kinematics will be computed [(m/s^2)] - REAL(SiKi) , DIMENSION(:,:,:,:), ALLOCATABLE :: WaveDynP2D !< Instantaneous 2nd-order difference frequency correction for the dynamic pressure of incident waves , at each of the NWaveKinGrid points where the incident wave kinematics will be computed [(N/m^2)] - REAL(SiKi) , DIMENSION(:,:,:,:,:), ALLOCATABLE :: WaveAcc2S !< Instantaneous 2nd-order sum frequency correction for the acceleration of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, at each of the NWaveKinGrid points where the incident wave kinematics will be computed [(m/s^2)] - REAL(SiKi) , DIMENSION(:,:,:,:), ALLOCATABLE :: WaveDynP2S !< Instantaneous 2nd-order sum frequency correction for the dynamic pressure of incident waves , at each of the NWaveKinGrid points where the incident wave kinematics will be computed [(N/m^2)] - REAL(SiKi) , DIMENSION(:,:,:,:,:), ALLOCATABLE :: WaveVel2D !< Instantaneous 2nd-order difference frequency correction for the velocity of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, at each of the NWaveKinGrid points where the incident wave kinematics will be computed (The values include both the velocity of incident waves and the velocity of current.) [(m/s)] - REAL(SiKi) , DIMENSION(:,:,:,:,:), ALLOCATABLE :: WaveVel2S !< Instantaneous 2nd-order sum frequency correction for the velocity of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, at each of the NWaveKinGrid points where the incident wave kinematics will be computed (The values include both the velocity of incident waves and the velocity of current.) [(m/s)] - END TYPE Waves2_InitOutputType -! ======================= contains @@ -168,148 +158,6 @@ subroutine Waves2_UnPackInitInput(RF, OutData) call RegUnpack(RF, OutData%WvSumQTFF); if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine Waves2_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) - type(Waves2_InitOutputType), intent(in) :: SrcInitOutputData - type(Waves2_InitOutputType), intent(inout) :: DstInitOutputData - integer(IntKi), intent(in ) :: CtrlCode - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - integer(B4Ki) :: LB(5), UB(5) - integer(IntKi) :: ErrStat2 - character(*), parameter :: RoutineName = 'Waves2_CopyInitOutput' - ErrStat = ErrID_None - ErrMsg = '' - if (allocated(SrcInitOutputData%WaveAcc2D)) then - LB(1:5) = lbound(SrcInitOutputData%WaveAcc2D) - UB(1:5) = ubound(SrcInitOutputData%WaveAcc2D) - if (.not. allocated(DstInitOutputData%WaveAcc2D)) then - allocate(DstInitOutputData%WaveAcc2D(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveAcc2D.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstInitOutputData%WaveAcc2D = SrcInitOutputData%WaveAcc2D - end if - if (allocated(SrcInitOutputData%WaveDynP2D)) then - LB(1:4) = lbound(SrcInitOutputData%WaveDynP2D) - UB(1:4) = ubound(SrcInitOutputData%WaveDynP2D) - if (.not. allocated(DstInitOutputData%WaveDynP2D)) then - allocate(DstInitOutputData%WaveDynP2D(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveDynP2D.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstInitOutputData%WaveDynP2D = SrcInitOutputData%WaveDynP2D - end if - if (allocated(SrcInitOutputData%WaveAcc2S)) then - LB(1:5) = lbound(SrcInitOutputData%WaveAcc2S) - UB(1:5) = ubound(SrcInitOutputData%WaveAcc2S) - if (.not. allocated(DstInitOutputData%WaveAcc2S)) then - allocate(DstInitOutputData%WaveAcc2S(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveAcc2S.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstInitOutputData%WaveAcc2S = SrcInitOutputData%WaveAcc2S - end if - if (allocated(SrcInitOutputData%WaveDynP2S)) then - LB(1:4) = lbound(SrcInitOutputData%WaveDynP2S) - UB(1:4) = ubound(SrcInitOutputData%WaveDynP2S) - if (.not. allocated(DstInitOutputData%WaveDynP2S)) then - allocate(DstInitOutputData%WaveDynP2S(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveDynP2S.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstInitOutputData%WaveDynP2S = SrcInitOutputData%WaveDynP2S - end if - if (allocated(SrcInitOutputData%WaveVel2D)) then - LB(1:5) = lbound(SrcInitOutputData%WaveVel2D) - UB(1:5) = ubound(SrcInitOutputData%WaveVel2D) - if (.not. allocated(DstInitOutputData%WaveVel2D)) then - allocate(DstInitOutputData%WaveVel2D(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveVel2D.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstInitOutputData%WaveVel2D = SrcInitOutputData%WaveVel2D - end if - if (allocated(SrcInitOutputData%WaveVel2S)) then - LB(1:5) = lbound(SrcInitOutputData%WaveVel2S) - UB(1:5) = ubound(SrcInitOutputData%WaveVel2S) - if (.not. allocated(DstInitOutputData%WaveVel2S)) then - allocate(DstInitOutputData%WaveVel2S(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveVel2S.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstInitOutputData%WaveVel2S = SrcInitOutputData%WaveVel2S - end if -end subroutine - -subroutine Waves2_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) - type(Waves2_InitOutputType), intent(inout) :: InitOutputData - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - character(*), parameter :: RoutineName = 'Waves2_DestroyInitOutput' - ErrStat = ErrID_None - ErrMsg = '' - if (allocated(InitOutputData%WaveAcc2D)) then - deallocate(InitOutputData%WaveAcc2D) - end if - if (allocated(InitOutputData%WaveDynP2D)) then - deallocate(InitOutputData%WaveDynP2D) - end if - if (allocated(InitOutputData%WaveAcc2S)) then - deallocate(InitOutputData%WaveAcc2S) - end if - if (allocated(InitOutputData%WaveDynP2S)) then - deallocate(InitOutputData%WaveDynP2S) - end if - if (allocated(InitOutputData%WaveVel2D)) then - deallocate(InitOutputData%WaveVel2D) - end if - if (allocated(InitOutputData%WaveVel2S)) then - deallocate(InitOutputData%WaveVel2S) - end if -end subroutine - -subroutine Waves2_PackInitOutput(RF, Indata) - type(RegFile), intent(inout) :: RF - type(Waves2_InitOutputType), intent(in) :: InData - character(*), parameter :: RoutineName = 'Waves2_PackInitOutput' - if (RF%ErrStat >= AbortErrLev) return - call RegPackAlloc(RF, InData%WaveAcc2D) - call RegPackAlloc(RF, InData%WaveDynP2D) - call RegPackAlloc(RF, InData%WaveAcc2S) - call RegPackAlloc(RF, InData%WaveDynP2S) - call RegPackAlloc(RF, InData%WaveVel2D) - call RegPackAlloc(RF, InData%WaveVel2S) - if (RegCheckErr(RF, RoutineName)) return -end subroutine - -subroutine Waves2_UnPackInitOutput(RF, OutData) - type(RegFile), intent(inout) :: RF - type(Waves2_InitOutputType), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'Waves2_UnPackInitOutput' - integer(B4Ki) :: LB(5), UB(5) - integer(IntKi) :: stat - logical :: IsAllocAssoc - if (RF%ErrStat /= ErrID_None) return - call RegUnpackAlloc(RF, OutData%WaveAcc2D); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%WaveDynP2D); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%WaveAcc2S); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%WaveDynP2S); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%WaveVel2D); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%WaveVel2S); if (RegCheckErr(RF, RoutineName)) return -end subroutine - END MODULE Waves2_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/openfast_io/openfast_io/FAST_reader.py b/openfast_io/openfast_io/FAST_reader.py index d7809d5782..6d35b77563 100644 --- a/openfast_io/openfast_io/FAST_reader.py +++ b/openfast_io/openfast_io/FAST_reader.py @@ -2459,6 +2459,9 @@ def read_SeaState(self, ss_file): self.fst_vt['SeaState']['NX'] = int_read(f.readline().split()[0]) self.fst_vt['SeaState']['NY'] = int_read(f.readline().split()[0]) self.fst_vt['SeaState']['NZ'] = int_read(f.readline().split()[0]) + self.fst_vt['SeaState']['WvKinBlockMod'] = int_read(f.readline().split()[0]) + self.fst_vt['SeaState']['WvKinBlockSize'] = float_read(f.readline().split()[0]) + self.fst_vt['SeaState']['WvKinBlockFreeT'] = float_read(f.readline().split()[0]) # WAVES f.readline() diff --git a/openfast_io/openfast_io/FAST_writer.py b/openfast_io/openfast_io/FAST_writer.py index fffd63910e..b105272fe5 100644 --- a/openfast_io/openfast_io/FAST_writer.py +++ b/openfast_io/openfast_io/FAST_writer.py @@ -2019,6 +2019,9 @@ def write_SeaState(self): f.write('{:<22d} {:<11} {:}'.format(self.fst_vt['SeaState']['NX'], 'NX', '– Number of nodes in half of the X-direction domain (-) [>=2]\n')) f.write('{:<22d} {:<11} {:}'.format(self.fst_vt['SeaState']['NY'], 'NY', '– Number of nodes in half of the Y-direction domain (-) [>=2]\n')) f.write('{:<22d} {:<11} {:}'.format(self.fst_vt['SeaState']['NZ'], 'NZ', '– Number of nodes in the Z direction (-) [>=2]\n')) + f.write('{:<22d} {:<11} {:}'.format(self.fst_vt['SeaState']['WvKinBlockMod'], 'WvKinBlockMod', '- Wave kinematics volume-data mode {0: precompute full domain, 1: on-demand block partitioning} (switch)\n')) + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['SeaState']['WvKinBlockSize'], 'WvKinBlockSize', '- Target edge length of an on-demand cube block (m) [used only when WvKinBlockMod=1; DEFAULT=100]\n')) + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['SeaState']['WvKinBlockFreeT'], 'WvKinBlockFreeT', '- Free a block after this much simulation time without an access (s) [used only when WvKinBlockMod=1; <=0 disables freeing; DEFAULT=600]\n')) f.write('---------------------- WAVES ---------------------------------------------------\n') f.write('{:<22} {:<11} {:}'.format(self.fst_vt['SeaState']['WaveMod'], 'WaveMod', '- Incident wave kinematics model {0: none=still water, 1: regular (periodic), 1P#: regular with user-specified phase, 2: JONSWAP/Pierson-Moskowitz spectrum (irregular), 3: White noise spectrum (irregular), 4: user-defined spectrum from routine UserWaveSpctrm (irregular), 5: Externally generated wave-elevation time series, 6: Externally generated full wave-kinematics time series [option 6 is invalid for PotMod/=0]} (switch)\n')) diff --git a/reg_tests/r-test b/reg_tests/r-test index 77b2e6c381..d4f65324b4 160000 --- a/reg_tests/r-test +++ b/reg_tests/r-test @@ -1 +1 @@ -Subproject commit 77b2e6c38169697d8d9a6ea3776a7474de5a38f0 +Subproject commit d4f65324b484f014f96b05be3e3905278db578b9