diff --git a/modules/hydrodyn/src/Morison.f90 b/modules/hydrodyn/src/Morison.f90 index 57bb88f075..bd5533dda4 100644 --- a/modules/hydrodyn/src/Morison.f90 +++ b/modules/hydrodyn/src/Morison.f90 @@ -23,7 +23,6 @@ MODULE Morison USE Waves USE Morison_Types USE Morison_Output - USE SeaState_Interp USE SeaSt_WaveField ! USE HydroDyn_Output_Types USE NWTC_Library @@ -2603,7 +2602,7 @@ SUBROUTINE Morison_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, errStat, !=============================================================================================== ! Calculate the fluid kinematics at all mesh nodes and store for use in the equations below - CALL WaveField_GetWaveKin( p%WaveField, m%SeaSt_Interp_m, Time, m%DispNodePosHdn, .FALSE., m%nodeInWater, m%WaveElev1, m%WaveElev2, m%WaveElev, m%FDynP, m%FV, m%FA, m%FAMCF, ErrStat2, ErrMsg2 ) + CALL WaveField_GetWaveKin( p%WaveField, m%WaveField_m, Time, m%DispNodePosHdn, .FALSE., m%nodeInWater, m%WaveElev1, m%WaveElev2, m%WaveElev, m%FDynP, m%FV, m%FA, m%FAMCF, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ! Compute fluid velocity relative to the structure DO j = 1, p%NNodes @@ -3037,7 +3036,7 @@ SUBROUTINE Morison_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, errStat, ! Compute the distributed loads at the point of intersection between the member and the free surface ! !----------------------------------------------------------------------------------------------------! ! Get wave kinematics at the free-surface intersection. Set forceNodeInWater=.TRUE. to guarantee the free-surface intersection is in water. - CALL WaveField_GetNodeWaveKin( p%WaveField, m%SeaSt_Interp_m, Time, FSInt, .TRUE., nodeInWater, WaveElev1, WaveElev2, WaveElev, FDynP, FV, FA, FAMCF, ErrStat2, ErrMsg2 ) + CALL WaveField_GetNodeWaveKin( p%WaveField, m%WaveField_m, Time, FSInt, .TRUE., nodeInWater, WaveElev1, WaveElev2, WaveElev, FDynP, FV, FA, FAMCF, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) FDynPFSInt = REAL(FDynP,ReKi) FVFSInt = REAL(FV, ReKi) @@ -3579,7 +3578,7 @@ SUBROUTINE GetTotalWaveElev( Time, pos, Zeta, ErrStat, ErrMsg ) ErrStat = ErrID_None ErrMsg = "" - Zeta = WaveField_GetNodeTotalWaveElev( p%WaveField, m%SeaSt_Interp_m, Time, pos, ErrStat2, ErrMsg2 ) + Zeta = WaveField_GetNodeTotalWaveElev( p%WaveField, m%WaveField_m, Time, pos, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END SUBROUTINE GetTotalWaveElev @@ -3597,7 +3596,7 @@ SUBROUTINE GetFreeSurfaceNormal( Time, pos, r, n, ErrStat, ErrMsg) ErrStat = ErrID_None ErrMsg = "" - CALL WaveField_GetNodeWaveNormal( p%WaveField, m%SeaSt_Interp_m, Time, pos, r, n, ErrStat2, ErrMsg2 ) + CALL WaveField_GetNodeWaveNormal( p%WaveField, m%WaveField_m, Time, pos, r, n, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END SUBROUTINE GetFreeSurfaceNormal @@ -4212,7 +4211,7 @@ SUBROUTINE Morison_UpdateDiscState( Time, u, p, x, xd, z, OtherState, m, errStat END IF ! Get fluid velocity at the joint - CALL WaveField_GetNodeWaveVel( p%WaveField, m%SeaSt_Interp_m, Time, pos, .FALSE., nodeInWater, FVTmp, ErrStat2, ErrMsg2 ) + CALL WaveField_GetNodeWaveVel( p%WaveField, m%WaveField_m, Time, pos, .FALSE., nodeInWater, FVTmp, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) FV = REAL(FVTmp, ReKi) vrel = ( FV - u%Mesh%TranslationVel(:,J) ) * nodeInWater diff --git a/modules/hydrodyn/src/Morison.txt b/modules/hydrodyn/src/Morison.txt index e47b40c867..43ff0ab18c 100644 --- a/modules/hydrodyn/src/Morison.txt +++ b/modules/hydrodyn/src/Morison.txt @@ -13,7 +13,6 @@ # ...... Include files (definitions from NWTC Library) ............................................................................ # make sure that the file name does not have any trailing white spaces! include Registry_NWTC_Library.txt -usefrom SeaState_Interp.txt usefrom SeaSt_WaveField.txt # # @@ -323,7 +322,7 @@ typedef ^ ^ ReKi typedef ^ ^ ReKi V_rel_n {:} - - "Normal relative flow velocity at joints" m/s typedef ^ ^ ReKi V_rel_n_HiPass {:} - - "High-pass filtered normal relative flow velocity at joints" m/s typedef ^ ^ MeshMapType VisMeshMap - - - "Mesh mapping for visualization mesh" - -typedef ^ ^ SeaSt_Interp_MiscVarType SeaSt_Interp_m - - - "misc var information from the SeaState Interpolation module" - +typedef ^ ^ SeaSt_WaveField_MiscVarType WaveField_m - - - "misc var information from the SeaState Interpolation module" - # ..... Parameters ................................................................................................................ # Define parameters here: diff --git a/modules/hydrodyn/src/Morison_Types.f90 b/modules/hydrodyn/src/Morison_Types.f90 index d63aaef883..c68757261d 100644 --- a/modules/hydrodyn/src/Morison_Types.f90 +++ b/modules/hydrodyn/src/Morison_Types.f90 @@ -31,7 +31,6 @@ !! unpack routines associated with each defined data type. This code is automatically generated by the FAST Registry. MODULE Morison_Types !--------------------------------------------------------------------------------------------------------------------------------- -USE SeaState_Interp_Types USE SeaSt_WaveField_Types USE NWTC_Library IMPLICIT NONE @@ -386,7 +385,7 @@ MODULE Morison_Types REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: V_rel_n !< Normal relative flow velocity at joints [m/s] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: V_rel_n_HiPass !< High-pass filtered normal relative flow velocity at joints [m/s] TYPE(MeshMapType) :: VisMeshMap !< Mesh mapping for visualization mesh [-] - TYPE(SeaSt_Interp_MiscVarType) :: SeaSt_Interp_m !< misc var information from the SeaState Interpolation module [-] + TYPE(SeaSt_WaveField_MiscVarType) :: WaveField_m !< misc var information from the SeaState Interpolation module [-] END TYPE Morison_MiscVarType ! ======================= ! ========= Morison_ParameterType ======= @@ -3570,7 +3569,7 @@ subroutine Morison_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) call NWTC_Library_CopyMeshMapType(SrcMiscData%VisMeshMap, DstMiscData%VisMeshMap, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return - call SeaSt_Interp_CopyMisc(SrcMiscData%SeaSt_Interp_m, DstMiscData%SeaSt_Interp_m, CtrlCode, ErrStat2, ErrMsg2) + call SeaSt_WaveField_CopyMisc(SrcMiscData%WaveField_m, DstMiscData%WaveField_m, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end subroutine @@ -3654,7 +3653,7 @@ subroutine Morison_DestroyMisc(MiscData, ErrStat, ErrMsg) end if call NWTC_Library_DestroyMeshMapType(MiscData%VisMeshMap, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call SeaSt_Interp_DestroyMisc(MiscData%SeaSt_Interp_m, ErrStat2, ErrMsg2) + call SeaSt_WaveField_DestroyMisc(MiscData%WaveField_m, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine @@ -3694,7 +3693,7 @@ subroutine Morison_PackMisc(RF, Indata) call RegPackAlloc(RF, InData%V_rel_n) call RegPackAlloc(RF, InData%V_rel_n_HiPass) call NWTC_Library_PackMeshMapType(RF, InData%VisMeshMap) - call SeaSt_Interp_PackMisc(RF, InData%SeaSt_Interp_m) + call SeaSt_WaveField_PackMisc(RF, InData%WaveField_m) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -3740,7 +3739,7 @@ subroutine Morison_UnPackMisc(RF, OutData) call RegUnpackAlloc(RF, OutData%V_rel_n); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%V_rel_n_HiPass); if (RegCheckErr(RF, RoutineName)) return call NWTC_Library_UnpackMeshMapType(RF, OutData%VisMeshMap) ! VisMeshMap - call SeaSt_Interp_UnpackMisc(RF, OutData%SeaSt_Interp_m) ! SeaSt_Interp_m + call SeaSt_WaveField_UnpackMisc(RF, OutData%WaveField_m) ! WaveField_m end subroutine subroutine Morison_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) diff --git a/modules/hydrodyn/src/SS_Excitation.f90 b/modules/hydrodyn/src/SS_Excitation.f90 index 9cc0bf72ff..125217fb3e 100644 --- a/modules/hydrodyn/src/SS_Excitation.f90 +++ b/modules/hydrodyn/src/SS_Excitation.f90 @@ -20,8 +20,8 @@ ! !********************************************************************************************************************************** MODULE SS_Excitation - USE SeaState_Interp - USE SS_Excitation_Types + USE SS_Excitation_Types + use SeaSt_WaveField, only: WaveField_GetNodeTotalWaveElev USE NWTC_Library IMPLICIT NONE @@ -110,8 +110,9 @@ function GetWaveElevation ( time, u_in, t_in, p, m, ErrStat, ErrMsg ) call SS_Exc_Input_ExtrapInterp(u_in, t_in, u_out, time, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - do iBody = 1, p%NBody - GetWaveElevation(iBody) = SeaSt_Interp_3D( time, u_out%PtfmPos(1:2,iBody), p%WaveField%WaveElev1, p%WaveField%SeaSt_interp_p, m%SeaSt_Interp_m%FirstWarn_Clamp, ErrStat2, ErrMsg2 ) + do iBody = 1, p%NBody +!FIXME: this is the total wave elevation. Should it include second order, or should it only include first order? + GetWaveElevation(iBody) = WaveField_GetNodeTotalWaveElev(p%WaveField, m%WaveField_m, time, u_out%PtfmPos(1:2,iBody), ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do diff --git a/modules/hydrodyn/src/SS_Excitation.txt b/modules/hydrodyn/src/SS_Excitation.txt index f5b9311d60..1372e9a823 100644 --- a/modules/hydrodyn/src/SS_Excitation.txt +++ b/modules/hydrodyn/src/SS_Excitation.txt @@ -14,7 +14,6 @@ # (File) Revision #: $Rev$ # URL: $HeadURL$ ################################################################################################################################### -usefrom SeaState_Interp.txt usefrom SeaSt_WaveField.txt typedef SS_Excitation/SS_Exc InitInputType CHARACTER(1024) InputFile - - - "Name of the input file" - @@ -24,14 +23,14 @@ typedef ^ ^ R8Ki typedef ^ ^ SeaSt_WaveFieldType *WaveField - - - "Pointer to SeaState wave field" - - + typedef ^ InitOutputType CHARACTER(10) WriteOutputHdr {:} - - "Header of the output" - typedef ^ InitOutputType CHARACTER(10) WriteOutputUnt {:} - - "Units of the output" - - + typedef ^ ContinuousStateType R8Ki x {:} - - "Continuous States" - - + typedef ^ DiscreteStateType SiKi DummyDiscState - - - "" - - + # Define constraint states here: typedef ^ ConstraintStateType SiKi DummyConstrState - - - "" - @@ -44,7 +43,7 @@ typedef ^ ^ SS_Exc_ContinuousStateType # Define any data that are used only for efficiency purposes (these variables are not associated with time): # e.g. indices for searching in an array, large arrays that are local variables in any routine called multiple times, etc. typedef ^ MiscVarType INTEGER LastIndWave - 1 - "last used index in the WaveTime array" - -typedef ^ ^ SeaSt_Interp_MiscVarType SeaSt_Interp_m - - - "misc var information from the SeaState Interpolation module" - +typedef ^ ^ SeaSt_WaveField_MiscVarType WaveField_m - - - "misc var information from the SeaState Interpolation module" - # ..... Parameters ......................... diff --git a/modules/hydrodyn/src/SS_Excitation_Types.f90 b/modules/hydrodyn/src/SS_Excitation_Types.f90 index 08bfc7e05f..3e7179fe5a 100644 --- a/modules/hydrodyn/src/SS_Excitation_Types.f90 +++ b/modules/hydrodyn/src/SS_Excitation_Types.f90 @@ -31,7 +31,6 @@ !! unpack routines associated with each defined data type. This code is automatically generated by the FAST Registry. MODULE SS_Excitation_Types !--------------------------------------------------------------------------------------------------------------------------------- -USE SeaState_Interp_Types USE SeaSt_WaveField_Types USE NWTC_Library IMPLICIT NONE @@ -74,7 +73,7 @@ MODULE SS_Excitation_Types ! ========= SS_Exc_MiscVarType ======= TYPE, PUBLIC :: SS_Exc_MiscVarType INTEGER(IntKi) :: LastIndWave = 1 !< last used index in the WaveTime array [-] - TYPE(SeaSt_Interp_MiscVarType) :: SeaSt_Interp_m !< misc var information from the SeaState Interpolation module [-] + TYPE(SeaSt_WaveField_MiscVarType) :: WaveField_m !< misc var information from the SeaState Interpolation module [-] END TYPE SS_Exc_MiscVarType ! ======================= ! ========= SS_Exc_ParameterType ======= @@ -495,7 +494,7 @@ subroutine SS_Exc_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) ErrStat = ErrID_None ErrMsg = '' DstMiscData%LastIndWave = SrcMiscData%LastIndWave - call SeaSt_Interp_CopyMisc(SrcMiscData%SeaSt_Interp_m, DstMiscData%SeaSt_Interp_m, CtrlCode, ErrStat2, ErrMsg2) + call SeaSt_WaveField_CopyMisc(SrcMiscData%WaveField_m, DstMiscData%WaveField_m, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end subroutine @@ -509,7 +508,7 @@ subroutine SS_Exc_DestroyMisc(MiscData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'SS_Exc_DestroyMisc' ErrStat = ErrID_None ErrMsg = '' - call SeaSt_Interp_DestroyMisc(MiscData%SeaSt_Interp_m, ErrStat2, ErrMsg2) + call SeaSt_WaveField_DestroyMisc(MiscData%WaveField_m, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine @@ -519,7 +518,7 @@ subroutine SS_Exc_PackMisc(RF, Indata) character(*), parameter :: RoutineName = 'SS_Exc_PackMisc' if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, InData%LastIndWave) - call SeaSt_Interp_PackMisc(RF, InData%SeaSt_Interp_m) + call SeaSt_WaveField_PackMisc(RF, InData%WaveField_m) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -529,7 +528,7 @@ subroutine SS_Exc_UnPackMisc(RF, OutData) character(*), parameter :: RoutineName = 'SS_Exc_UnPackMisc' if (RF%ErrStat /= ErrID_None) return call RegUnpack(RF, OutData%LastIndWave); if (RegCheckErr(RF, RoutineName)) return - call SeaSt_Interp_UnpackMisc(RF, OutData%SeaSt_Interp_m) ! SeaSt_Interp_m + call SeaSt_WaveField_UnpackMisc(RF, OutData%WaveField_m) ! WaveField_m end subroutine subroutine SS_Exc_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) diff --git a/modules/hydrodyn/src/WAMIT.f90 b/modules/hydrodyn/src/WAMIT.f90 index b740b6cd35..d73dd5c2c3 100644 --- a/modules/hydrodyn/src/WAMIT.f90 +++ b/modules/hydrodyn/src/WAMIT.f90 @@ -25,12 +25,10 @@ MODULE WAMIT USE WAMIT_Types USE WAMIT_Interp USE NWTC_Library - ! USE Waves_Types USE Conv_Radiation USE SS_Radiation USE SS_Excitation USE NWTC_FFTPACK - use SeaState_Interp IMPLICIT NONE @@ -976,13 +974,13 @@ SUBROUTINE WAMIT_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, ErrS END IF if (p%ExctnDisp > 0 ) then - ALLOCATE ( WaveExctnCGrid(0:p%WaveField%NStepWave2 ,p%WaveField%SeaSt_Interp_p%n(2)*p%WaveField%SeaSt_Interp_p%n(3),6*p%NBody) , STAT=ErrStat2 ) + ALLOCATE ( WaveExctnCGrid(0:p%WaveField%NStepWave2 ,p%WaveField%GridParams%n(2)*p%WaveField%GridParams%n(3),6*p%NBody) , STAT=ErrStat2 ) IF ( ErrStat2 /= 0 ) THEN CALL SetErrStat( ErrID_Fatal, 'Error allocating memory for the WaveExctnC array.', ErrStat, ErrMsg, RoutineName) CALL Cleanup() RETURN END IF - ALLOCATE ( p%WaveExctnGrid (0:p%WaveField%NStepWave,p%WaveField%SeaSt_Interp_p%n(2),p%WaveField%SeaSt_Interp_p%n(3), 6*p%NBody) , STAT=ErrStat2 ) + ALLOCATE ( p%WaveExctnGrid (0:p%WaveField%NStepWave,p%WaveField%GridParams%n(2),p%WaveField%GridParams%n(3), 6*p%NBody) , STAT=ErrStat2 ) IF ( ErrStat2 /= 0 ) THEN CALL SetErrStat( ErrID_Fatal, 'Error allocating memory for the WaveExctn array.', ErrStat, ErrMsg, RoutineName) CALL Cleanup() @@ -1141,7 +1139,7 @@ SUBROUTINE WAMIT_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, ErrS CALL Cleanup() RETURN END IF - do iGrid = 1, p%WaveField%SeaSt_Interp_p%n(2)*p%WaveField%SeaSt_Interp_p%n(3) + do iGrid = 1, p%WaveField%GridParams%n(2)*p%WaveField%GridParams%n(3) WaveExctnCGrid(I,iGrid,J) = WaveExctnC(I,J) * CMPLX(p%WaveField%WaveElevC(1,I,iGrid), p%WaveField%WaveElevC(2,I,iGrid)) end do END DO ! J - All wave excitation forces and moments @@ -1158,9 +1156,9 @@ SUBROUTINE WAMIT_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, ErrS END IF DO J = 1,6*p%NBody ! Loop through all wave excitation forces and moments - do iGrid = 1, p%WaveField%SeaSt_Interp_p%n(2)*p%WaveField%SeaSt_Interp_p%n(3) - iX = mod(iGrid-1, p%WaveField%SeaSt_Interp_p%n(2)) + 1 ! 1st n index is time - iY = (iGrid-1) / p%WaveField%SeaSt_Interp_p%n(2) + 1 + do iGrid = 1, p%WaveField%GridParams%n(2)*p%WaveField%GridParams%n(3) + iX = mod(iGrid-1, p%WaveField%GridParams%n(2)) + 1 ! 1st n index is time + iY = (iGrid-1) / p%WaveField%GridParams%n(2) + 1 CALL ApplyFFT_cx ( p%WaveExctnGrid(0:p%WaveField%NStepWave-1,iX,iY,J), WaveExctnCGrid(:,iGrid,J), FFT_Data, ErrStat2 ) CALL SetErrStat( ErrStat2, ' An error occured while applying an FFT to WaveExctnC.', ErrStat, ErrMsg, RoutineName) IF ( ErrStat >= AbortErrLev) THEN @@ -1842,7 +1840,7 @@ SUBROUTINE WAMIT_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, ErrStat, Er END IF iStart = (iBody-1)*6+1 ! WaveExctnGrid dimensions are: 1st: wavetime, 2nd: X, 3rd: Y, 4th: Force component for each WAMIT Body - m%F_Waves1(iStart:iStart+5) = SeaSt_Interp_3D_Vec6( Time, bodyPosition, p%WaveExctnGrid(:,:,:,iStart:iStart+5), p%WaveField%SeaSt_interp_p, m%seast_interp_m%FirstWarn_Clamp, ErrStat2, ErrMsg2 ) + m%F_Waves1(iStart:iStart+5) = WAMIT_ForceWaves_Interp( Time, bodyPosition, p%WaveExctnGrid(:,:,:,iStart:iStart+5), p%WaveField%GridParams, m%WaveField_m, ErrStat2, ErrMsg2 ) call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'SeaState_CalcOutput' ) END DO end if @@ -1931,8 +1929,9 @@ SUBROUTINE WAMIT_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, ErrStat, Er ! Output channels will be dealt with by the HydroDyn module - END SUBROUTINE WAMIT_CalcOutput + + !---------------------------------------------------------------------------------------------------------------------------------- !> Tight coupling routine for computing derivatives of continuous states SUBROUTINE WAMIT_CalcContStateDeriv( Time, u, p, x, xd, z, OtherState, m, dxdt, ErrStat, ErrMsg ) diff --git a/modules/hydrodyn/src/WAMIT.txt b/modules/hydrodyn/src/WAMIT.txt index 51c0294603..608afe87b4 100644 --- a/modules/hydrodyn/src/WAMIT.txt +++ b/modules/hydrodyn/src/WAMIT.txt @@ -16,7 +16,6 @@ include Registry_NWTC_Library.txt usefrom Conv_Radiation.txt usefrom SS_Radiation.txt usefrom SS_Excitation.txt -usefrom SeaState_Interp.txt usefrom SeaSt_WaveField.txt typedef WAMIT/WAMIT InitInputType INTEGER NBody - - - "[>=1; only used when PotMod=1. If NBodyMod=1, the WAMIT data contains a vector of size 6*NBody x 1 and matrices of size 6*NBody x 6*NBody; if NBodyMod>1, there are NBody sets of WAMIT data each with a vector of size 6 x 1 and matrices of size 6 x 6]" - @@ -93,7 +92,7 @@ typedef ^ ^ SS_Exc_Outp typedef ^ ^ Conv_Rdtn_MiscVarType Conv_Rdtn - - - "" - typedef ^ ^ Conv_Rdtn_InputType Conv_Rdtn_u - - - "" - typedef ^ ^ Conv_Rdtn_OutputType Conv_Rdtn_y - - - "" - -typedef ^ ^ SeaSt_Interp_MiscVarType SeaSt_Interp_m - - - "misc var information from the SeaState Interpolation module" - +typedef ^ ^ SeaSt_WaveField_MiscVarType WaveField_m - - - "misc var information from the SeaState Interpolation module" - # ..... Parameters ................................................................................................................ # Define parameters here: diff --git a/modules/hydrodyn/src/WAMIT_Interp.f90 b/modules/hydrodyn/src/WAMIT_Interp.f90 index 7e7ce8cfaa..585867a33a 100644 --- a/modules/hydrodyn/src/WAMIT_Interp.f90 +++ b/modules/hydrodyn/src/WAMIT_Interp.f90 @@ -29,6 +29,8 @@ MODULE WAMIT_Interp USE NWTC_Library + use SeaSt_WaveField_Types, only: SeaSt_WaveField_ParameterType, SeaSt_WaveField_MiscVarType + use SeaSt_WaveField, only: WaveField_Interp_Setup3D, WaveField_Interp_Setup4D IMPLICIT NONE PRIVATE @@ -37,8 +39,16 @@ MODULE WAMIT_Interp PUBLIC :: WAMIT_Interp2D_Cplx PUBLIC :: WAMIT_Interp3D_Cplx PUBLIC :: WAMIT_Interp4D_Cplx + public :: WAMIT_ForceWaves_Interp + + ! 3D and 4D interpolations using WaveField indexing + interface WAMIT_ForceWaves_Interp + module procedure WAMIT_ForceWaves_Interp_3D_vec6 + module procedure WAMIT_ForceWaves_Interp_4D_vec6 + end interface + CONTAINS !---------------------------------------------------------------------------------------------------------------------------------- @@ -621,5 +631,80 @@ SUBROUTINE CalcIsoparCoords( InCoord, posLo, posHi, isopc ) END SUBROUTINE CalcIsoparCoords + +!> retrieve indices from the WaveField info, and do interpolation for this point. +!! NOTE: the WAMIT field passed in here through pKinXX is based on WaveField sizing, which is why we can do this. +function WAMIT_ForceWaves_Interp_3D_vec6(Time, pos, pKinXX, WF_p, WF_m, ErrStat3, ErrMsg3) + real(DbKi), intent(in ) :: Time + real(ReKi), intent(in ) :: pos(2) !< position + real(SiKi), intent(in ) :: pKinXX(0:,:,:,:) !< 3D Wave excitation data (SiKi for storage space reasons) + type(SeaSt_WaveField_ParameterType), intent(in ) :: WF_p !< wavefield parameters + type(SeaSt_WaveField_MiscVarType), intent(inout) :: WF_m !< wavefield misc/optimization variables + integer(IntKi), intent( out) :: ErrStat3 + character(*), intent( out) :: ErrMsg3 + + real(SiKi) :: WAMIT_ForceWaves_Interp_3D_vec6(6) + real(SiKi) :: u(8) + integer(IntKi) :: i + + ! get the bounding indices from the WaveField info (same indexing used in WAMIT) + call WaveField_Interp_Setup3D( Time, pos, WF_p, WF_m, ErrStat3, ErrMsg3 ) + + ! interpolate + do i = 1,6 + u(1) = pKinXX( WF_m%Indx_Hi(1), WF_m%Indx_Lo(2), WF_m%Indx_Lo(3), i ) + u(2) = pKinXX( WF_m%Indx_Hi(1), WF_m%Indx_Hi(2), WF_m%Indx_Lo(3), i ) + u(3) = pKinXX( WF_m%Indx_Lo(1), WF_m%Indx_Hi(2), WF_m%Indx_Lo(3), i ) + u(4) = pKinXX( WF_m%Indx_Lo(1), WF_m%Indx_Lo(2), WF_m%Indx_Lo(3), i ) + u(5) = pKinXX( WF_m%Indx_Hi(1), WF_m%Indx_Lo(2), WF_m%Indx_Hi(3), i ) + u(6) = pKinXX( WF_m%Indx_Hi(1), WF_m%Indx_Hi(2), WF_m%Indx_Hi(3), i ) + u(7) = pKinXX( WF_m%Indx_Lo(1), WF_m%Indx_Hi(2), WF_m%Indx_Hi(3), i ) + u(8) = pKinXX( WF_m%Indx_Lo(1), WF_m%Indx_Lo(2), WF_m%Indx_Hi(3), i ) + WAMIT_ForceWaves_Interp_3D_vec6(i) = SUM ( WF_m%N3D * u ) + end do +end function + + +!> retrieve indices from the WaveField info, and do interpolation for this point. This is for interpolating on 4D +!! NOTE: the WAMIT field passed in here through pKinXX is based on WaveField sizing, which is why we can do this. +function WAMIT_ForceWaves_Interp_4D_vec6(Time, pos, pKinXX, WF_p, WF_m, ErrStat3, ErrMsg3) + real(DbKi), intent(in ) :: Time + real(ReKi), intent(in ) :: pos(3) !< position + real(SiKi), intent(in ) :: pKinXX(0:,:,:,:,:) !< 4D Wave excitation data (SiKi for storage space reasons) + type(SeaSt_WaveField_ParameterType), intent(in ) :: WF_p !< wavefield parameters + type(SeaSt_WaveField_MiscVarType), intent(inout) :: WF_m !< wavefield misc/optimization variables + integer(IntKi), intent( out) :: ErrStat3 + character(*), intent( out) :: ErrMsg3 + + real(SiKi) :: WAMIT_ForceWaves_Interp_4D_vec6(6) + real(SiKi) :: u(16) + integer(IntKi) :: i + + ! get the bounding indices from the WaveField info (same indexing used in WAMIT) + call WaveField_Interp_Setup4D( Time, pos, WF_p, WF_m, ErrStat3, ErrMsg3 ) + + ! interpolate + do i = 1,6 + u( 1) = pKinXX( WF_m%Indx_Lo(1), WF_m%Indx_Lo(2), WF_m%Indx_Lo(3), WF_m%Indx_Lo(4), i ) + u( 2) = pKinXX( WF_m%Indx_Lo(1), WF_m%Indx_Lo(2), WF_m%Indx_Lo(3), WF_m%Indx_Hi(4), i ) + u( 3) = pKinXX( WF_m%Indx_Lo(1), WF_m%Indx_Lo(2), WF_m%Indx_Hi(3), WF_m%Indx_Lo(4), i ) + u( 4) = pKinXX( WF_m%Indx_Lo(1), WF_m%Indx_Lo(2), WF_m%Indx_Hi(3), WF_m%Indx_Hi(4), i ) + u( 5) = pKinXX( WF_m%Indx_Lo(1), WF_m%Indx_Hi(2), WF_m%Indx_Lo(3), WF_m%Indx_Lo(4), i ) + u( 6) = pKinXX( WF_m%Indx_Lo(1), WF_m%Indx_Hi(2), WF_m%Indx_Lo(3), WF_m%Indx_Hi(4), i ) + u( 7) = pKinXX( WF_m%Indx_Lo(1), WF_m%Indx_Hi(2), WF_m%Indx_Hi(3), WF_m%Indx_Lo(4), i ) + u( 8) = pKinXX( WF_m%Indx_Lo(1), WF_m%Indx_Hi(2), WF_m%Indx_Hi(3), WF_m%Indx_Hi(4), i ) + u( 9) = pKinXX( WF_m%Indx_Hi(1), WF_m%Indx_Lo(2), WF_m%Indx_Lo(3), WF_m%Indx_Lo(4), i ) + u(10) = pKinXX( WF_m%Indx_Hi(1), WF_m%Indx_Lo(2), WF_m%Indx_Lo(3), WF_m%Indx_Hi(4), i ) + u(11) = pKinXX( WF_m%Indx_Hi(1), WF_m%Indx_Lo(2), WF_m%Indx_Hi(3), WF_m%Indx_Lo(4), i ) + u(12) = pKinXX( WF_m%Indx_Hi(1), WF_m%Indx_Lo(2), WF_m%Indx_Hi(3), WF_m%Indx_Hi(4), i ) + u(13) = pKinXX( WF_m%Indx_Hi(1), WF_m%Indx_Hi(2), WF_m%Indx_Lo(3), WF_m%Indx_Lo(4), i ) + u(14) = pKinXX( WF_m%Indx_Hi(1), WF_m%Indx_Hi(2), WF_m%Indx_Lo(3), WF_m%Indx_Hi(4), i ) + u(15) = pKinXX( WF_m%Indx_Hi(1), WF_m%Indx_Hi(2), WF_m%Indx_Hi(3), WF_m%Indx_Lo(4), i ) + u(16) = pKinXX( WF_m%Indx_Hi(1), WF_m%Indx_Hi(2), WF_m%Indx_Hi(3), WF_m%Indx_Hi(4), i ) + WAMIT_ForceWaves_Interp_4D_vec6(i) = SUM ( WF_m%N4D * u ) + end do +end function + + !---------------------------------------------------------------------------------------------------------------------------------- END MODULE WAMIT_Interp diff --git a/modules/hydrodyn/src/WAMIT_Types.f90 b/modules/hydrodyn/src/WAMIT_Types.f90 index 0c82e5c2d8..1f1bbd75dd 100644 --- a/modules/hydrodyn/src/WAMIT_Types.f90 +++ b/modules/hydrodyn/src/WAMIT_Types.f90 @@ -105,7 +105,7 @@ MODULE WAMIT_Types TYPE(Conv_Rdtn_MiscVarType) :: Conv_Rdtn !< [-] TYPE(Conv_Rdtn_InputType) :: Conv_Rdtn_u !< [-] TYPE(Conv_Rdtn_OutputType) :: Conv_Rdtn_y !< [-] - TYPE(SeaSt_Interp_MiscVarType) :: SeaSt_Interp_m !< misc var information from the SeaState Interpolation module [-] + TYPE(SeaSt_WaveField_MiscVarType) :: WaveField_m !< misc var information from the SeaState Interpolation module [-] END TYPE WAMIT_MiscVarType ! ======================= ! ========= WAMIT_ParameterType ======= @@ -722,7 +722,7 @@ subroutine WAMIT_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) call Conv_Rdtn_CopyOutput(SrcMiscData%Conv_Rdtn_y, DstMiscData%Conv_Rdtn_y, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return - call SeaSt_Interp_CopyMisc(SrcMiscData%SeaSt_Interp_m, DstMiscData%SeaSt_Interp_m, CtrlCode, ErrStat2, ErrMsg2) + call SeaSt_WaveField_CopyMisc(SrcMiscData%WaveField_m, DstMiscData%WaveField_m, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end subroutine @@ -766,7 +766,7 @@ subroutine WAMIT_DestroyMisc(MiscData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call Conv_Rdtn_DestroyOutput(MiscData%Conv_Rdtn_y, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call SeaSt_Interp_DestroyMisc(MiscData%SeaSt_Interp_m, ErrStat2, ErrMsg2) + call SeaSt_WaveField_DestroyMisc(MiscData%WaveField_m, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine @@ -789,7 +789,7 @@ subroutine WAMIT_PackMisc(RF, Indata) call Conv_Rdtn_PackMisc(RF, InData%Conv_Rdtn) call Conv_Rdtn_PackInput(RF, InData%Conv_Rdtn_u) call Conv_Rdtn_PackOutput(RF, InData%Conv_Rdtn_y) - call SeaSt_Interp_PackMisc(RF, InData%SeaSt_Interp_m) + call SeaSt_WaveField_PackMisc(RF, InData%WaveField_m) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -815,7 +815,7 @@ subroutine WAMIT_UnPackMisc(RF, OutData) call Conv_Rdtn_UnpackMisc(RF, OutData%Conv_Rdtn) ! Conv_Rdtn call Conv_Rdtn_UnpackInput(RF, OutData%Conv_Rdtn_u) ! Conv_Rdtn_u call Conv_Rdtn_UnpackOutput(RF, OutData%Conv_Rdtn_y) ! Conv_Rdtn_y - call SeaSt_Interp_UnpackMisc(RF, OutData%SeaSt_Interp_m) ! SeaSt_Interp_m + call SeaSt_WaveField_UnpackMisc(RF, OutData%WaveField_m) ! WaveField_m end subroutine subroutine WAMIT_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) diff --git a/modules/seastate/CMakeLists.txt b/modules/seastate/CMakeLists.txt index d30787e698..f0860e89ef 100644 --- a/modules/seastate/CMakeLists.txt +++ b/modules/seastate/CMakeLists.txt @@ -18,7 +18,6 @@ if (GENERATE_TYPES) generate_f90_types(src/Current.txt ${CMAKE_CURRENT_LIST_DIR}/src/Current_Types.f90 -noextrap) generate_f90_types(src/Waves.txt ${CMAKE_CURRENT_LIST_DIR}/src/Waves_Types.f90 -noextrap) generate_f90_types(src/Waves2.txt ${CMAKE_CURRENT_LIST_DIR}/src/Waves2_Types.f90 -noextrap) - generate_f90_types(src/SeaState_Interp.txt ${CMAKE_CURRENT_LIST_DIR}/src/SeaState_Interp_Types.f90 -noextrap) generate_f90_types(src/SeaSt_WaveField.txt ${CMAKE_CURRENT_LIST_DIR}/src/SeaSt_WaveField_Types.f90 -noextrap) generate_f90_types(src/SeaState.txt ${CMAKE_CURRENT_LIST_DIR}/src/SeaState_Types.f90 -noextrap) endif() @@ -28,7 +27,6 @@ add_library(seastlib STATIC src/Waves.f90 src/Waves2.f90 src/UserWaves.f90 - src/SeaState_Interp.f90 src/SeaSt_WaveField.f90 src/SeaState_Input.f90 src/SeaState.f90 @@ -36,7 +34,6 @@ add_library(seastlib STATIC src/Current_Types.f90 src/Waves_Types.f90 src/Waves2_Types.f90 - src/SeaState_Interp_Types.f90 src/SeaSt_WaveField_Types.f90 src/SeaState_Types.f90 ) diff --git a/modules/seastate/src/SeaSt_WaveField.f90 b/modules/seastate/src/SeaSt_WaveField.f90 index c8ffabbc84..a117d3db79 100644 --- a/modules/seastate/src/SeaSt_WaveField.f90 +++ b/modules/seastate/src/SeaSt_WaveField.f90 @@ -1,10 +1,9 @@ MODULE SeaSt_WaveField -USE SeaState_Interp USE SeaSt_WaveField_Types IMPLICIT NONE - + PRIVATE ! Public functions and subroutines @@ -17,150 +16,162 @@ MODULE SeaSt_WaveField PUBLIC WaveField_GetWaveKin +public WaveField_Interp_Setup3D, WaveField_Interp_Setup4D + CONTAINS !-------------------- Subroutine for wave elevation ------------------! -FUNCTION WaveField_GetNodeWaveElev1( WaveField, SeaSt_Interp_m, Time, pos, ErrStat, ErrMsg ) - TYPE(SeaSt_WaveFieldType), INTENT( IN ) :: WaveField - TYPE(SeaSt_Interp_MiscVarType), INTENT(INOUT) :: SeaSt_Interp_m - REAL(DbKi), INTENT( IN ) :: Time - REAL(ReKi), INTENT( IN ) :: pos(*) ! Position at which free-surface elevation is to be calculated. Third entry ignored if present. - INTEGER(IntKi), INTENT( OUT ) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT ) :: ErrMsg ! Error message if errStat /= ErrID_None - - REAL(SiKi) :: WaveField_GetNodeWaveElev1 - REAL(SiKi) :: Zeta - CHARACTER(*), PARAMETER :: RoutineName = 'WaveField_GetNodeWaveElev1' - INTEGER(IntKi) :: errStat2 - CHARACTER(ErrMsgLen) :: errMsg2 - +function WaveField_GetNodeWaveElev1( WaveField, WaveField_m, Time, pos, ErrStat, ErrMsg ) + type(SeaSt_WaveFieldType), intent(in ) :: WaveField + type(SeaSt_WaveField_MiscVarType), intent(inout) :: WaveField_m + real(DbKi), intent(in ) :: Time + real(ReKi), intent(in ) :: pos(*) ! Position at which free-surface elevation is to be calculated. Third entry ignored if present. + integer(IntKi), intent( out) :: ErrStat ! Error status of the operation + character(*), intent( out) :: ErrMsg ! Error message if errStat /= ErrID_None + + real(SiKi) :: WaveField_GetNodeWaveElev1 + real(SiKi) :: Zeta + character(*), parameter :: RoutineName = 'WaveField_GetNodeWaveElev1' + integer(IntKi) :: errStat2 + character(ErrMsgLen) :: errMsg2 + ErrStat = ErrID_None ErrMsg = "" - + IF (ALLOCATED(WaveField%WaveElev1)) THEN - Zeta = SeaSt_Interp_3D( Time, pos(1:2), WaveField%WaveElev1, WaveField%seast_interp_p, seast_interp_m%FirstWarn_Clamp, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL WaveField_Interp_Setup3D( Time, pos, WaveField%GridParams, WaveField_m, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + Zeta = WaveField_Interp_3D( WaveField%WaveElev1, WaveField_m ) ELSE Zeta = 0.0_SiKi END IF - + WaveField_GetNodeWaveElev1 = Zeta -END FUNCTION WaveField_GetNodeWaveElev1 - -FUNCTION WaveField_GetNodeWaveElev2( WaveField, SeaSt_Interp_m, Time, pos, ErrStat, ErrMsg ) - TYPE(SeaSt_WaveFieldType), INTENT( IN ) :: WaveField - TYPE(SeaSt_Interp_MiscVarType), INTENT(INOUT) :: SeaSt_Interp_m - REAL(DbKi), INTENT( IN ) :: Time - REAL(ReKi), INTENT( IN ) :: pos(*) ! Position at which free-surface elevation is to be calculated. Third entry ignored if present. - INTEGER(IntKi), INTENT( OUT ) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT ) :: ErrMsg ! Error message if errStat /= ErrID_None - - REAL(SiKi) :: WaveField_GetNodeWaveElev2 - REAL(SiKi) :: Zeta - CHARACTER(*), PARAMETER :: RoutineName = 'WaveField_GetNodeWaveElev2' - INTEGER(IntKi) :: errStat2 - CHARACTER(ErrMsgLen) :: errMsg2 - +end function WaveField_GetNodeWaveElev1 + + +function WaveField_GetNodeWaveElev2( WaveField, WaveField_m, Time, pos, ErrStat, ErrMsg ) + type(SeaSt_WaveFieldType), intent(in ) :: WaveField + type(SeaSt_WaveField_MiscVarType), intent(inout) :: WaveField_m + real(DbKi), intent(in ) :: Time + real(ReKi), intent(in ) :: pos(*) ! Position at which free-surface elevation is to be calculated. Third entry ignored if present. + integer(IntKi), intent( out) :: ErrStat ! Error status of the operation + character(*), intent( out) :: ErrMsg ! Error message if errStat /= ErrID_None + + real(SiKi) :: WaveField_GetNodeWaveElev2 + real(SiKi) :: Zeta + character(*), parameter :: RoutineName = 'WaveField_GetNodeWaveElev2' + integer(IntKi) :: errStat2 + character(ErrMsgLen) :: errMsg2 + ErrStat = ErrID_None ErrMsg = "" - + IF (ALLOCATED(WaveField%WaveElev2)) THEN - Zeta = SeaSt_Interp_3D( Time, pos(1:2), WaveField%WaveElev2, WaveField%seast_interp_p, seast_interp_m%FirstWarn_Clamp, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL WaveField_Interp_Setup3D( Time, pos, WaveField%GridParams, WaveField_m, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + Zeta = WaveField_Interp_3D( WaveField%WaveElev2, WaveField_m ) ELSE Zeta = 0.0_SiKi END IF WaveField_GetNodeWaveElev2 = Zeta -END FUNCTION WaveField_GetNodeWaveElev2 +end function WaveField_GetNodeWaveElev2 -FUNCTION WaveField_GetNodeTotalWaveElev( WaveField, SeaSt_Interp_m, Time, pos, ErrStat, ErrMsg ) - TYPE(SeaSt_WaveFieldType), INTENT( IN ) :: WaveField - TYPE(SeaSt_Interp_MiscVarType), INTENT(INOUT) :: SeaSt_Interp_m - REAL(DbKi), INTENT( IN ) :: Time - REAL(ReKi), INTENT( IN ) :: pos(*) ! Position at which free-surface elevation is to be calculated. Third entry ignored if present. - INTEGER(IntKi), INTENT( OUT ) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT ) :: ErrMsg ! Error message if errStat /= ErrID_None - REAL(SiKi) :: WaveField_GetNodeTotalWaveElev - REAL(SiKi) :: Zeta1, Zeta2 - CHARACTER(*), PARAMETER :: RoutineName = 'WaveField_GetNodeTotalWaveElev' - INTEGER(IntKi) :: errStat2 - CHARACTER(ErrMsgLen) :: errMsg2 +FUNCTION WaveField_GetNodeTotalWaveElev( WaveField, WaveField_m, Time, pos, ErrStat, ErrMsg ) + type(SeaSt_WaveFieldType), intent(in ) :: WaveField + type(SeaSt_WaveField_MiscVarType), intent(inout) :: WaveField_m + real(DbKi), intent(in ) :: Time + real(ReKi), intent(in ) :: pos(*) ! Position at which free-surface elevation is to be calculated. Third entry ignored if present. + integer(IntKi), intent( out) :: ErrStat ! Error status of the operation + character(*), intent( out) :: ErrMsg ! Error message if errStat /= ErrID_None + + real(SiKi) :: WaveField_GetNodeTotalWaveElev + real(SiKi) :: Zeta1, Zeta2 + character(*), parameter :: RoutineName = 'WaveField_GetNodeTotalWaveElev' + integer(IntKi) :: errStat2 + character(ErrMsgLen) :: errMsg2 ErrStat = ErrID_None ErrMsg = "" - - Zeta1 = WaveField_GetNodeWaveElev1( WaveField, SeaSt_Interp_m, Time, pos, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - Zeta2 = WaveField_GetNodeWaveElev2( WaveField, SeaSt_Interp_m, Time, pos, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + Zeta1 = WaveField_GetNodeWaveElev1( WaveField, WaveField_m, Time, pos, ErrStat2, ErrMsg2 ); if (Failed()) return; + Zeta2 = WaveField_GetNodeWaveElev2( WaveField, WaveField_m, Time, pos, ErrStat2, ErrMsg2 ); if (Failed()) return; WaveField_GetNodeTotalWaveElev = Zeta1 + Zeta2 - + +contains + logical function Failed() + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + Failed = ErrStat >= AbortErrLev + end function END FUNCTION WaveField_GetNodeTotalWaveElev -SUBROUTINE WaveField_GetNodeWaveNormal( WaveField, SeaSt_Interp_m, Time, pos, r, n, ErrStat, ErrMsg ) - - TYPE(SeaSt_WaveFieldType), INTENT( IN ) :: WaveField - TYPE(SeaSt_Interp_MiscVarType), INTENT(INOUT) :: SeaSt_Interp_m - REAL(DbKi), INTENT( IN ) :: Time - REAL(ReKi), INTENT( IN ) :: pos(*) ! Position at which free-surface normal is to be calculated. Third entry ignored if present. - REAL(ReKi), INTENT( IN ) :: r ! Distance for central differencing - REAL(ReKi), INTENT( OUT ) :: n(3) ! Free-surface normal vector - INTEGER(IntKi), INTENT( OUT ) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT ) :: ErrMsg ! Error message if errStat /= ErrID_None - REAL(SiKi) :: ZetaP,ZetaM - REAL(ReKi) :: r1,dZetadx,dZetady - CHARACTER(*), PARAMETER :: RoutineName = 'WaveField_GetNodeWaveNormal' - INTEGER(IntKi) :: errStat2 - CHARACTER(ErrMsgLen) :: errMsg2 + +SUBROUTINE WaveField_GetNodeWaveNormal( WaveField, WaveField_m, Time, pos, r, n, ErrStat, ErrMsg ) + type(SeaSt_WaveFieldType), intent(in ) :: WaveField + type(SeaSt_WaveField_MiscVarType), intent(inout) :: WaveField_m + real(DbKi), intent(in ) :: Time + real(ReKi), intent(in ) :: pos(*) ! Position at which free-surface normal is to be calculated. Third entry ignored if present. + real(ReKi), intent(in ) :: r ! Distance for central differencing + real(ReKi), intent( out) :: n(3) ! Free-surface normal vector + integer(IntKi), intent( out) :: ErrStat ! Error status of the operation + character(*), intent( out) :: ErrMsg ! Error message if errStat /= ErrID_None + + real(SiKi) :: ZetaP,ZetaM + real(ReKi) :: r1,dZetadx,dZetady + character(*), parameter :: RoutineName = 'WaveField_GetNodeWaveNormal' + integer(IntKi) :: errStat2 + character(ErrMsgLen) :: errMsg2 + ErrStat = ErrID_None ErrMsg = "" r1 = MAX(r,real(1.0e-6,ReKi)) ! In case r is zero - ZetaP = WaveField_GetNodeTotalWaveElev( WaveField, SeaSt_Interp_m, Time, (/pos(1)+r1,pos(2)/), ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - ZetaM = WaveField_GetNodeTotalWaveElev( WaveField, SeaSt_Interp_m, Time, (/pos(1)-r1,pos(2)/), ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ZetaP = WaveField_GetNodeTotalWaveElev( WaveField, WaveField_m, Time, (/pos(1)+r1,pos(2)/), ErrStat2, ErrMsg2 ); if (Failed()) return; + ZetaM = WaveField_GetNodeTotalWaveElev( WaveField, WaveField_m, Time, (/pos(1)-r1,pos(2)/), ErrStat2, ErrMsg2 ); if (Failed()) return; dZetadx = REAL(ZetaP-ZetaM,ReKi)/(2.0_ReKi*r1) - - ZetaP = WaveField_GetNodeTotalWaveElev( WaveField, SeaSt_Interp_m, Time, (/pos(1),pos(2)+r1/), ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - ZetaM = WaveField_GetNodeTotalWaveElev( WaveField, SeaSt_Interp_m, Time, (/pos(1),pos(2)-r1/), ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + ZetaP = WaveField_GetNodeTotalWaveElev( WaveField, WaveField_m, Time, (/pos(1),pos(2)+r1/), ErrStat2, ErrMsg2 ); if (Failed()) return; + ZetaM = WaveField_GetNodeTotalWaveElev( WaveField, WaveField_m, Time, (/pos(1),pos(2)-r1/), ErrStat2, ErrMsg2 ); if (Failed()) return; dZetady = REAL(ZetaP-ZetaM,ReKi)/(2.0_ReKi*r1) - + n = (/-dZetadx,-dZetady,1.0_ReKi/) n = n / SQRT(Dot_Product(n,n)) +contains + logical function Failed() + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + Failed = ErrStat >= AbortErrLev + end function END SUBROUTINE WaveField_GetNodeWaveNormal + !-------------------- Subroutine for full wave field kinematics --------------------! -SUBROUTINE WaveField_GetNodeWaveKin( WaveField, SeaSt_Interp_m, Time, pos, forceNodeInWater, nodeInWater, WaveElev1, WaveElev2, WaveElev, FDynP, FV, FA, FAMCF, ErrStat, ErrMsg ) - TYPE(SeaSt_WaveFieldType), INTENT( IN ) :: WaveField - TYPE(SeaSt_Interp_MiscVarType), INTENT( INOUT ) :: SeaSt_Interp_m - REAL(DbKi), INTENT( IN ) :: Time - REAL(ReKi), INTENT( IN ) :: pos(3) - LOGICAL, INTENT( IN ) :: forceNodeInWater - REAL(SiKi), INTENT( OUT ) :: WaveElev1 - REAL(SiKi), INTENT( OUT ) :: WaveElev2 - REAL(SiKi), INTENT( OUT ) :: WaveElev - REAL(SiKi), INTENT( OUT ) :: FV(3) - REAL(SiKi), INTENT( OUT ) :: FA(3) - REAL(SiKi), INTENT( OUT ) :: FAMCF(3) - REAL(SiKi), INTENT( OUT ) :: FDynP - INTEGER(IntKi), INTENT( OUT ) :: nodeInWater - - INTEGER(IntKi), INTENT( OUT ) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT ) :: ErrMsg ! Error message if errStat /= ErrID_None - - REAL(ReKi) :: posXY(2), posPrime(3), posXY0(3) - CHARACTER(*), PARAMETER :: RoutineName = 'WaveField_GetNodeWaveKin' - INTEGER(IntKi) :: errStat2 - CHARACTER(ErrMsgLen) :: errMsg2 +SUBROUTINE WaveField_GetNodeWaveKin( WaveField, WaveField_m, Time, pos, forceNodeInWater, nodeInWater, WaveElev1, WaveElev2, WaveElev, FDynP, FV, FA, FAMCF, ErrStat, ErrMsg ) + type(SeaSt_WaveFieldType), intent(in ) :: WaveField + type(SeaSt_WaveField_MiscVarType), intent(inout) :: WaveField_m + real(DbKi), intent(in ) :: Time + real(ReKi), intent(in ) :: pos(3) + logical, intent(in ) :: forceNodeInWater + real(SiKi), intent( out) :: WaveElev1 + real(SiKi), intent( out) :: WaveElev2 + real(SiKi), intent( out) :: WaveElev + real(SiKi), intent( out) :: FV(3) + real(SiKi), intent( out) :: FA(3) + real(SiKi), intent( out) :: FAMCF(3) + real(SiKi), intent( out) :: FDynP + integer(IntKi), intent( out) :: nodeInWater + integer(IntKi), intent( out) :: ErrStat ! Error status of the operation + character(*), intent( out) :: ErrMsg ! Error message if errStat /= ErrID_None + + real(ReKi) :: posXY(2), posPrime(3), posXY0(3) + character(*), parameter :: RoutineName = 'WaveField_GetNodeWaveKin' + integer(IntKi) :: errStat2 + character(ErrMsgLen) :: errMsg2 ErrStat = ErrID_None ErrMsg = "" @@ -170,28 +181,21 @@ SUBROUTINE WaveField_GetNodeWaveKin( WaveField, SeaSt_Interp_m, Time, pos, force FAMCF(:) = 0.0 ! Wave elevation - WaveElev1 = WaveField_GetNodeWaveElev1( WaveField, SeaSt_Interp_m, Time, pos, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - WaveElev2 = WaveField_GetNodeWaveElev2( WaveField, SeaSt_Interp_m, Time, pos, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + WaveElev1 = WaveField_GetNodeWaveElev1( WaveField, WaveField_m, Time, pos, ErrStat2, ErrMsg2 ); if (Failed()) return; + WaveElev2 = WaveField_GetNodeWaveElev2( WaveField, WaveField_m, Time, pos, ErrStat2, ErrMsg2 ); if (Failed()) return; WaveElev = WaveElev1 + WaveElev2 - + IF (WaveField%WaveStMod == 0) THEN ! No wave stretching - + IF ( pos(3) <= 0.0_ReKi) THEN ! Node is at or below the SWL nodeInWater = 1_IntKi - ! Use location to obtain interpolated values of kinematics - CALL SeaSt_Interp_Setup( Time, pos, WaveField%seast_interp_p, SeaSt_Interp_m, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - FV(:) = SeaSt_Interp_4D_Vec( WaveField%WaveVel, SeaSt_Interp_m, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - FA(:) = SeaSt_Interp_4D_Vec( WaveField%WaveAcc, SeaSt_Interp_m, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - FDynP = SeaSt_Interp_4D ( WaveField%WaveDynP, SeaSt_Interp_m, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ! Use location to obtain interpolated values of kinematics + CALL WaveField_Interp_Setup4D( Time, pos, WaveField%GridParams, WaveField_m, ErrStat2, ErrMsg2 ); if (Failed()) return; + FV(:) = WaveField_Interp_4D_Vec( WaveField%WaveVel, WaveField_m ) + FA(:) = WaveField_Interp_4D_Vec( WaveField%WaveAcc, WaveField_m ) + FDynP = WaveField_Interp_4D ( WaveField%WaveDynP, WaveField_m ) IF ( ALLOCATED(WaveField%WaveAccMCF) ) THEN - FAMCF(:) = SeaSt_Interp_4D_Vec( WaveField%WaveAccMCF, SeaSt_Interp_m, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + FAMCF(:) = WaveField_Interp_4D_Vec( WaveField%WaveAccMCF, WaveField_m ) END IF ELSE ! Node is above the SWL nodeInWater = 0_IntKi @@ -200,116 +204,104 @@ SUBROUTINE WaveField_GetNodeWaveKin( WaveField, SeaSt_Interp_m, Time, pos, force FDynP = 0.0 FAMCF(:) = 0.0 END IF - + ELSE ! Wave stretching enabled - + IF ( (pos(3) <= WaveElev) .OR. forceNodeInWater ) THEN ! Node is submerged - + nodeInWater = 1_IntKi - + IF ( WaveField%WaveStMod < 3 ) THEN ! Vertical or extrapolated wave stretching - + 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 SeaSt_Interp_Setup( Time, pos, WaveField%seast_interp_p, SeaSt_Interp_m, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - FV(:) = SeaSt_Interp_4D_Vec( WaveField%WaveVel, SeaSt_Interp_m, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - FA(:) = SeaSt_Interp_4D_Vec( WaveField%WaveAcc, SeaSt_Interp_m, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - FDynP = SeaSt_Interp_4D ( WaveField%WaveDynP, SeaSt_Interp_m, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + ! Use location to obtain interpolated values of kinematics + CALL WaveField_Interp_Setup4D( Time, pos, WaveField%GridParams, WaveField_m, ErrStat2, ErrMsg2 ); if (Failed()) return; + FV(:) = WaveField_Interp_4D_Vec( WaveField%WaveVel, WaveField_m ) + FA(:) = WaveField_Interp_4D_Vec( WaveField%WaveAcc, WaveField_m ) + FDynP = WaveField_Interp_4D ( WaveField%WaveDynP, WaveField_m ) IF ( ALLOCATED(WaveField%WaveAccMCF) ) THEN - FAMCF(:) = SeaSt_Interp_4D_Vec( WaveField%WaveAccMCF, SeaSt_Interp_m, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + FAMCF(:) = WaveField_Interp_4D_Vec( WaveField%WaveAccMCF, WaveField_m ) END IF ELSE ! Node is above SWL - need wave stretching - + ! Vertical wave stretching - CALL SeaSt_Interp_Setup( Time, posXY0, WaveField%seast_interp_p, SeaSt_Interp_m, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - FV(:) = SeaSt_Interp_4D_vec( WaveField%WaveVel, seast_interp_m, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - FA(:) = SeaSt_Interp_4D_vec( WaveField%WaveAcc, seast_interp_m, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - FDynP = SeaSt_Interp_4D ( WaveField%WaveDynP, seast_interp_m, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL WaveField_Interp_Setup4D( Time, posXY0, WaveField%GridParams, WaveField_m, ErrStat2, ErrMsg2 ); if (Failed()) return; + FV(:) = WaveField_Interp_4D_vec( WaveField%WaveVel, WaveField_m ) + FA(:) = WaveField_Interp_4D_vec( WaveField%WaveAcc, WaveField_m ) + FDynP = WaveField_Interp_4D ( WaveField%WaveDynP, WaveField_m ) IF ( ALLOCATED(WaveField%WaveAccMCF) ) THEN - FAMCF(:) = SeaSt_Interp_4D_vec( WaveField%WaveAccMCF, seast_interp_m, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + FAMCF(:) = WaveField_Interp_4D_vec( WaveField%WaveAccMCF, WaveField_m ) END IF - + ! Extrapoled wave stretching - IF (WaveField%WaveStMod == 2) THEN - FV(:) = FV(:) + SeaSt_Interp_3D_vec( Time, posXY, WaveField%PWaveVel0, WaveField%seast_interp_p, SeaSt_Interp_m%FirstWarn_Clamp, ErrStat2, ErrMsg2 ) * pos(3) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - FA(:) = FA(:) + SeaSt_Interp_3D_vec( Time, posXY, WaveField%PWaveAcc0, WaveField%seast_interp_p, SeaSt_Interp_m%FirstWarn_Clamp, ErrStat2, ErrMsg2 ) * pos(3) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - FDynP = FDynP + SeaSt_Interp_3D ( Time, posXY, WaveField%PWaveDynP0, WaveField%seast_interp_p, SeaSt_Interp_m%FirstWarn_Clamp, ErrStat2, ErrMsg2 ) * pos(3) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + IF (WaveField%WaveStMod == 2) THEN + CALL WaveField_Interp_Setup3D( Time, posXY, WaveField%GridParams, WaveField_m, ErrStat2, ErrMsg2 ); if (Failed()) return; + FV(:) = FV(:) + WaveField_Interp_3D_vec( WaveField%PWaveVel0, WaveField_m ) * pos(3) + FA(:) = FA(:) + WaveField_Interp_3D_vec( WaveField%PWaveAcc0, WaveField_m ) * pos(3) + FDynP = FDynP + WaveField_Interp_3D ( WaveField%PWaveDynP0, WaveField_m ) * pos(3) IF ( ALLOCATED(WaveField%WaveAccMCF) ) THEN - FAMCF(:) = FAMCF(:) + SeaSt_Interp_3D_vec( Time, posXY, WaveField%PWaveAccMCF0, WaveField%seast_interp_p, SeaSt_Interp_m%FirstWarn_Clamp, ErrStat2, ErrMsg2 ) * pos(3) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + FAMCF(:) = FAMCF(:) + WaveField_Interp_3D_vec( WaveField%PWaveAccMCF0, WaveField_m ) * pos(3) END IF END IF - + END IF ! Node is submerged - + ELSE ! Wheeler stretching - no need to check whether the node is above or below SWL - - ! Map the node z-position linearly from [-EffWtrDpth,m%WaveElev(j)] to [-EffWtrDpth,0] + + ! Map the node z-position linearly from [-EffWtrDpth,m%WaveElev(j)] to [-EffWtrDpth,0] posPrime = pos posPrime(3) = WaveField%EffWtrDpth*(WaveField%EffWtrDpth+pos(3))/(WaveField%EffWtrDpth+WaveElev)-WaveField%EffWtrDpth - posPrime(3) = MIN( posPrime(3), 0.0_ReKi) ! Clamp z-position to zero. Needed when forceNodeInWater=.TRUE. - + posPrime(3) = MIN( posPrime(3), 0.0_ReKi) ! Clamp z-position to zero. Needed when forceNodeInWater=.TRUE. + ! Obtain the wave-field variables by interpolation with the mapped position. - CALL SeaSt_Interp_Setup( Time, posPrime, WaveField%seast_interp_p, seast_interp_m, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - FV(:) = SeaSt_Interp_4D_Vec( WaveField%WaveVel, seast_interp_m, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - FA(:) = SeaSt_Interp_4D_Vec( WaveField%WaveAcc, seast_interp_m, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - FDynP = SeaSt_Interp_4D ( WaveField%WaveDynP, seast_interp_m, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL WaveField_Interp_Setup4D( Time, posPrime, WaveField%GridParams, WaveField_m, ErrStat2, ErrMsg2 ); if (Failed()) return; + FV(:) = WaveField_Interp_4D_Vec( WaveField%WaveVel, WaveField_m ) + FA(:) = WaveField_Interp_4D_Vec( WaveField%WaveAcc, WaveField_m ) + FDynP = WaveField_Interp_4D ( WaveField%WaveDynP, WaveField_m ) IF ( ALLOCATED(WaveField%WaveAccMCF) ) THEN - FAMCF(:) = SeaSt_Interp_4D_Vec( WaveField%WaveAccMCF, seast_interp_m, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + FAMCF(:) = WaveField_Interp_4D_Vec( WaveField%WaveAccMCF, WaveField_m ) END IF END IF - + ELSE ! Node is out of water - zero-out all wave dynamics - - nodeInWater = 0_IntKi + + nodeInWater = 0_IntKi FV(:) = 0.0 FA(:) = 0.0 FDynP = 0.0 FAMCF(:) = 0.0 - + END IF ! If node is in or out of water - + END IF ! If wave stretching is on or off - + +contains + logical function Failed() + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + Failed = ErrStat >= AbortErrLev + end function END SUBROUTINE WaveField_GetNodeWaveKin + !-------------------- Subroutine for wave field velocity only --------------------! -SUBROUTINE WaveField_GetNodeWaveVel( WaveField, SeaSt_Interp_m, Time, pos, forceNodeInWater, nodeInWater, FV, ErrStat, ErrMsg ) - TYPE(SeaSt_WaveFieldType), INTENT( IN ) :: WaveField - TYPE(SeaSt_Interp_MiscVarType), INTENT(INOUT) :: SeaSt_Interp_m - REAL(DbKi), INTENT( IN ) :: Time - REAL(ReKi), INTENT( IN ) :: pos(3) - LOGICAL, INTENT( IN ) :: forceNodeInWater - INTEGER(IntKi), INTENT( OUT ) :: nodeInWater - REAL(SiKi), INTENT( OUT ) :: FV(3) - INTEGER(IntKi), INTENT( OUT ) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT ) :: ErrMsg ! Error message if errStat /= ErrID_None - - REAL(SiKi) :: WaveElev - REAL(ReKi) :: posXY(2), posPrime(3), posXY0(3) - CHARACTER(*), PARAMETER :: RoutineName = 'WaveField_GetNodeWaveVel' - INTEGER(IntKi) :: errStat2 - CHARACTER(ErrMsgLen) :: errMsg2 +SUBROUTINE WaveField_GetNodeWaveVel( WaveField, WaveField_m, Time, pos, forceNodeInWater, nodeInWater, FV, ErrStat, ErrMsg ) + type(SeaSt_WaveFieldType), intent(in ) :: WaveField + type(SeaSt_WaveField_MiscVarType), intent(inout) :: WaveField_m + real(DbKi), intent(in ) :: Time + real(ReKi), intent(in ) :: pos(3) + logical, intent(in ) :: forceNodeInWater + integer(IntKi), intent( out) :: nodeInWater + real(SiKi), intent( out) :: FV(3) + integer(IntKi), intent( out) :: ErrStat ! Error status of the operation + character(*), intent( out) :: ErrMsg ! Error message if errStat /= ErrID_None + + real(SiKi) :: WaveElev + real(ReKi) :: posXY(2), posPrime(3), posXY0(3) + character(*), parameter :: RoutineName = 'WaveField_GetNodeWaveVel' + integer(IntKi) :: errStat2 + character(ErrMsgLen) :: errMsg2 ErrStat = ErrID_None ErrMsg = "" @@ -318,112 +310,109 @@ SUBROUTINE WaveField_GetNodeWaveVel( WaveField, SeaSt_Interp_m, Time, pos, force posXY0 = (/pos(1),pos(2),0.0_ReKi/) ! Wave elevation - WaveElev = WaveField_GetNodeTotalWaveElev( WaveField, SeaSt_Interp_m, Time, pos, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - + WaveElev = WaveField_GetNodeTotalWaveElev( WaveField, WaveField_m, Time, pos, ErrStat2, ErrMsg2 ); if (Failed()) return; + IF (WaveField%WaveStMod == 0) THEN ! No wave stretching - + IF ( pos(3) <= 0.0_ReKi) THEN ! Node is at or below the SWL nodeInWater = 1_IntKi - ! Use location to obtain interpolated values of kinematics - CALL SeaSt_Interp_Setup( Time, pos, WaveField%seast_interp_p, seast_interp_m, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - FV(:) = SeaSt_Interp_4D_Vec( WaveField%WaveVel, seast_interp_m, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ! Use location to obtain interpolated values of kinematics + CALL WaveField_Interp_Setup4D( Time, pos, WaveField%GridParams, WaveField_m, ErrStat2, ErrMsg2 ); if (Failed()) return; + FV(:) = WaveField_Interp_4D_Vec( WaveField%WaveVel, WaveField_m ) ELSE ! Node is above the SWL nodeInWater = 0_IntKi FV(:) = 0.0 END IF - + ELSE ! Wave stretching enabled - + IF ( (pos(3) <= WaveElev) .OR. forceNodeInWater ) THEN ! Node is submerged - + nodeInWater = 1_IntKi - + IF ( WaveField%WaveStMod < 3 ) THEN ! Vertical or extrapolated wave stretching - + 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 SeaSt_Interp_Setup( Time, pos, WaveField%seast_interp_p, seast_interp_m, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - FV(:) = SeaSt_Interp_4D_Vec( WaveField%WaveVel, seast_interp_m, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + ! Use location to obtain interpolated values of kinematics + CALL WaveField_Interp_Setup4D( Time, pos, WaveField%GridParams, WaveField_m, ErrStat2, ErrMsg2 ); if (Failed()) return; + FV(:) = WaveField_Interp_4D_Vec( WaveField%WaveVel, WaveField_m ) ELSE ! Node is above SWL - need wave stretching - + ! Vertical wave stretching - CALL SeaSt_Interp_Setup( Time, posXY0, WaveField%seast_interp_p, seast_interp_m, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - FV(:) = SeaSt_Interp_4D_vec( WaveField%WaveVel, seast_interp_m, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - + CALL WaveField_Interp_Setup4D( Time, posXY0, WaveField%GridParams, WaveField_m, ErrStat2, ErrMsg2 ); if (Failed()) return; + FV(:) = WaveField_Interp_4D_vec( WaveField%WaveVel, WaveField_m ) + ! Extrapoled wave stretching - IF (WaveField%WaveStMod == 2) THEN - FV(:) = FV(:) + SeaSt_Interp_3D_vec( Time, posXY, WaveField%PWaveVel0, WaveField%seast_interp_p, seast_interp_m%FirstWarn_Clamp, ErrStat2, ErrMsg2 ) * pos(3) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + IF (WaveField%WaveStMod == 2) THEN + CALL WaveField_Interp_Setup3D( Time, posXY, WaveField%GridParams, WaveField_m, ErrStat2, ErrMsg2 ); if (Failed()) return; + FV(:) = FV(:) + WaveField_Interp_3D_vec( WaveField%PWaveVel0, WaveField_m ) * pos(3) END IF - + END IF ! Node is submerged - + ELSE ! Wheeler stretching - no need to check whether the node is above or below SWL - - ! Map the node z-position linearly from [-EffWtrDpth,m%WaveElev(j)] to [-EffWtrDpth,0] + + ! Map the node z-position linearly from [-EffWtrDpth,m%WaveElev(j)] to [-EffWtrDpth,0] posPrime = pos posPrime(3) = WaveField%EffWtrDpth*(WaveField%EffWtrDpth+pos(3))/(WaveField%EffWtrDpth+WaveElev)-WaveField%EffWtrDpth - posPrime(3) = MIN( posPrime(3), 0.0_ReKi) ! Clamp z-position to zero. Needed when forceNodeInWater=.TRUE. - + posPrime(3) = MIN( posPrime(3), 0.0_ReKi) ! Clamp z-position to zero. Needed when forceNodeInWater=.TRUE. + ! Obtain the wave-field variables by interpolation with the mapped position. - CALL SeaSt_Interp_Setup( Time, posPrime, WaveField%seast_interp_p, seast_interp_m, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - FV(:) = SeaSt_Interp_4D_Vec( WaveField%WaveVel, seast_interp_m, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - + CALL WaveField_Interp_Setup4D( Time, posPrime, WaveField%GridParams, WaveField_m, ErrStat2, ErrMsg2 ); if (Failed()) return; + FV(:) = WaveField_Interp_4D_Vec( WaveField%WaveVel, WaveField_m ) + END IF - + ELSE ! Node is out of water - zero-out all wave dynamics - - nodeInWater = 0_IntKi + + nodeInWater = 0_IntKi FV(:) = 0.0 - + END IF ! If node is in or out of water - + END IF ! If wave stretching is on or off - + +contains + logical function Failed() + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + Failed = ErrStat >= AbortErrLev + end function END SUBROUTINE WaveField_GetNodeWaveVel -SUBROUTINE WaveField_GetWaveKin( WaveField, SeaSt_Interp_m, Time, pos, forceNodeInWater, nodeInWater, WaveElev1, WaveElev2, WaveElev, FDynP, FV, FA, FAMCF, ErrStat, ErrMsg ) - TYPE(SeaSt_WaveFieldType), INTENT( IN ) :: WaveField - TYPE(SeaSt_Interp_MiscVarType), INTENT(INOUT) :: SeaSt_Interp_m - REAL(DbKi), INTENT( IN ) :: Time - REAL(ReKi), INTENT( IN ) :: pos(:,:) - LOGICAL, INTENT( IN ) :: forceNodeInWater - REAL(SiKi), INTENT( OUT ) :: WaveElev1(:) - REAL(SiKi), INTENT( OUT ) :: WaveElev2(:) - REAL(SiKi), INTENT( OUT ) :: WaveElev(:) - REAL(ReKi), INTENT( OUT ) :: FV(:,:) - REAL(ReKi), INTENT( OUT ) :: FA(:,:) - REAL(ReKi), INTENT( OUT ) :: FAMCF(:,:) - REAL(ReKi), INTENT( OUT ) :: FDynP(:) - INTEGER(IntKi), INTENT( OUT ) :: nodeInWater(:) - INTEGER(IntKi), INTENT( OUT ) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT ) :: ErrMsg ! Error message if errStat /= ErrID_None - - CHARACTER(*), PARAMETER :: RoutineName = 'WaveField_GetWaveKin' - INTEGER(IntKi) :: errStat2 - CHARACTER(ErrMsgLen) :: errMsg2 - - INTEGER(IntKi) :: NumPoints, i - REAL(SiKi) :: FDynP_node, FV_node(3), FA_node(3), FAMCF_node(3) + +SUBROUTINE WaveField_GetWaveKin( WaveField, WaveField_m, Time, pos, forceNodeInWater, nodeInWater, WaveElev1, WaveElev2, WaveElev, FDynP, FV, FA, FAMCF, ErrStat, ErrMsg ) + type(SeaSt_WaveFieldType), intent(in ) :: WaveField + type(SeaSt_WaveField_MiscVarType), intent(inout) :: WaveField_m + real(DbKi), intent(in ) :: Time + real(ReKi), intent(in ) :: pos(:,:) + logical, intent(in ) :: forceNodeInWater + real(SiKi), intent( out) :: WaveElev1(:) + real(SiKi), intent( out) :: WaveElev2(:) + real(SiKi), intent( out) :: WaveElev(:) + real(ReKi), intent( out) :: FV(:,:) + real(ReKi), intent( out) :: FA(:,:) + real(ReKi), intent( out) :: FAMCF(:,:) + real(ReKi), intent( out) :: FDynP(:) + integer(IntKi), intent( out) :: nodeInWater(:) + integer(IntKi), intent( out) :: ErrStat ! Error status of the operation + character(*), intent( out) :: ErrMsg ! Error message if errStat /= ErrID_None + + character(*), parameter :: RoutineName = 'WaveField_GetWaveKin' + integer(IntKi) :: errStat2 + character(ErrMsgLen) :: errMsg2 + + integer(IntKi) :: NumPoints, i + real(SiKi) :: FDynP_node, FV_node(3), FA_node(3), FAMCF_node(3) ErrStat = ErrID_None ErrMsg = "" NumPoints = size(pos, dim=2) DO i = 1, NumPoints - CALL WaveField_GetNodeWaveKin( WaveField, SeaSt_Interp_m, Time, pos(:,i), forceNodeInWater, nodeInWater(i), WaveElev1(i), WaveElev2(i), WaveElev(i), FDynP_node, FV_node, FA_node, FAMCF_node, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL WaveField_GetNodeWaveKin( WaveField, WaveField_m, Time, pos(:,i), forceNodeInWater, nodeInWater(i), WaveElev1(i), WaveElev2(i), WaveElev(i), FDynP_node, FV_node, FA_node, FAMCF_node, ErrStat2, ErrMsg2 ) + if (Failed()) return; FDynP(i) = REAL(FDynP_node,ReKi) FV(:, i) = REAL(FV_node, ReKi) FA(:, i) = REAL(FA_node, ReKi) @@ -432,6 +421,461 @@ SUBROUTINE WaveField_GetWaveKin( WaveField, SeaSt_Interp_m, Time, pos, forceNode END IF END DO -END SUBROUTINE WaveField_GetWaveKin +contains + logical function Failed() + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + Failed = ErrStat >= AbortErrLev + end function +end subroutine WaveField_GetWaveKin + + +!---------------------------------------------------------------------------------------------------- +! Interpolation related functions +!---------------------------------------------------------------------------------------------------- + +subroutine SetCartesianXYIndex(p, pZero, delta, nMax, Indx_Lo, Indx_Hi, isopc, FirstWarn, ErrStat, ErrMsg) + REAL(ReKi), intent(in ) :: p + REAL(ReKi), intent(in ) :: pZero + REAL(ReKi), intent(in ) :: delta + INTEGER(IntKi), intent(in ) :: nMax + INTEGER(IntKi), intent(inout) :: Indx_Lo + INTEGER(IntKi), intent(inout) :: Indx_Hi + real(SiKi), intent(inout) :: isopc + logical, intent(inout) :: FirstWarn + INTEGER(IntKi), intent( out) :: ErrStat + CHARACTER(*), intent( out) :: ErrMsg + + real(ReKi) :: Tmp + + ErrStat = ErrID_None + ErrMsg = "" + + isopc = -1.0 + Indx_Lo = 0 + Indx_Hi = 0 + + + Tmp = (p-pZero) / delta + Indx_Lo = INT( Tmp ) + 1 ! convert REAL to INTEGER, then add one since our grid indices start at 1, not 0 + isopc = 2.0_ReKi * (Tmp - REAL(Indx_Lo - 1, ReKi)) - 1.0_ReKi ! convert to value between -1 and 1 + + if ( Indx_Lo < 1 ) then + Indx_Lo = 1 + isopc = -1.0 + if (FirstWarn) then + call SetErrStat(ErrID_Warn,'Position has been clamped to the grid boundary. Warning will not be repeated though condition may persist.',ErrStat,ErrMsg,'SetCartesianXYIndex') !error out if time is outside the lower bounds + FirstWarn = .false. + end if + end if + + Indx_Hi = min( Indx_Lo + 1, nMax ) ! make sure it's a valid index, zero-based + + if ( Indx_Lo >= Indx_Hi ) then + ! Need to clamp to grid boundary + if (FirstWarn .and. Indx_Lo /= Indx_Hi) then ! don't warn if we are exactly at the boundary + call SetErrStat(ErrID_Warn,'Position has been clamped to the grid boundary. Warning will not be repeated though condition may persist.',ErrStat,ErrMsg,'SetCartesianXYIndex') !error out if time is outside the lower bounds + FirstWarn = .false. + end if + Indx_Lo = max(Indx_Hi - 1, 1) + isopc = 1.0 + end if + + !------------------------------------------------------------------------------------------------- + ! to verify that we don't extrapolate, make sure isopc is bound between -1 and 1 (effectively nearest neighbor) + !------------------------------------------------------------------------------------------------- + isopc = min( 1.0_SiKi, isopc ) + isopc = max(-1.0_SiKi, isopc ) + +end subroutine SetCartesianXYIndex + + +subroutine SetCartesianZIndex(p, z_depth, delta, nMax, Indx_Lo, Indx_Hi, isopc, FirstWarn, ErrStat, ErrMsg) + real(ReKi), intent(in ) :: p + real(ReKi), intent(in ) :: z_depth + real(ReKi), intent(in ) :: delta + integer(IntKi), intent(in ) :: nMax + integer(IntKi), intent(inout) :: Indx_Lo + integer(IntKi), intent(inout) :: Indx_Hi + real(SiKi), intent(inout) :: isopc + logical, intent(inout) :: FirstWarn + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + + real(ReKi) :: Tmp + + ErrStat = ErrID_None + ErrMsg = "" + + isopc = -1.0 + Indx_Lo = 0 + Indx_Hi = 0 + + + !Tmp = acos(-p / z_depth) / delta + Tmp = acos( max(-1.0_ReKi, min(1.0_ReKi, 1+(p / z_depth)) ) ) / delta + Tmp = nmax - 1 - Tmp + Indx_Lo = INT( Tmp ) + 1 ! convert REAL to INTEGER, then add one since our grid indices start at 1, not 0 + isopc = 2.0_ReKi * (Tmp - REAL(Indx_Lo - 1, ReKi)) - 1.0_ReKi ! convert to value between -1 and 1 + + if ( Indx_Lo < 1 ) then + Indx_Lo = 1 + isopc = -1.0 + if (FirstWarn) then + call SetErrStat(ErrID_Warn,'Position has been clamped to the grid boundary. Warning will not be repeated though condition may persist.',ErrStat,ErrMsg,'SetCartesianZIndex') !error out if z is outside the lower bounds + FirstWarn = .false. + end if + end if + + Indx_Hi = min( Indx_Lo + 1, nMax ) ! make sure it's a valid index, one-based + + if ( Indx_Lo >= Indx_Hi ) then + ! Need to clamp to grid boundary + if (FirstWarn .and. Indx_Lo /= Indx_Hi) then ! don't warn if we are exactly at the boundary + call SetErrStat(ErrID_Warn,'Position has been clamped to the grid boundary. Warning will not be repeated though condition may persist.',ErrStat,ErrMsg,'SetCartesianZIndex') !error out if z is outside the upper bounds + FirstWarn = .false. + end if + Indx_Lo = max(Indx_Hi - 1, 1) + isopc = 1.0 + end if + + !------------------------------------------------------------------------------------------------- + ! to verify that we don't extrapolate, make sure isopc is bound between -1 and 1 (effectively nearest neighbor) + !------------------------------------------------------------------------------------------------- + isopc = min( 1.0_SiKi, isopc ) + isopc = max(-1.0_SiKi, isopc ) + +end subroutine SetCartesianZIndex + + +subroutine SetTimeIndex(Time, deltaT, nMax, Indx_Lo, Indx_Hi, isopc, ErrStat, ErrMsg) + real(DbKi), intent(in ) :: Time !< time from the start of the simulation + real(ReKi), intent(in ) :: deltaT + integer(IntKi), intent(in ) :: nMax + integer(IntKi), intent(inout) :: Indx_Lo + integer(IntKi), intent(inout) :: Indx_Hi + real(SiKi), intent(inout) :: isopc + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + + real(ReKi) :: Tmp + + ErrStat = ErrID_None + ErrMsg = "" + + isopc = -1.0 + Indx_Lo = 0 + Indx_Hi = 0 + if ( Time < 0.0_DbKi ) then + CALL SetErrStat(ErrID_Fatal,'Time value must be greater than or equal to zero!',ErrStat,ErrMsg,'SetTimeIndex') !error out if time is outside the lower bounds + RETURN + end if + + ! if there are no timesteps, don't proceed + if (EqualRealNos(deltaT,0.0_ReKi) .or. deltaT < 0.0_ReKi) return; + +! NOTE: nMax is the total number of time values in the grid, since this is zero-based indexing, the max index is nMax-1 +! for example: in a time grid with 11 grid points, the indices run from 0,1,2,3,4,5,6,7,8,9,10 +! for the repeating waves feature, index 10 is the same as index 0, so if Indx_Lo = 10 then we want to +! wrap it back to index 0, if Indx_Lo = 11 we want to wrap back to index 1. + + Tmp = real( (Time/ real(deltaT,DbKi)) ,ReKi) + Tmp = MOD(Tmp,real((nMax), ReKi)) + Indx_Lo = INT( Tmp ) ! convert REAL to INTEGER + + isopc = 2.0_ReKi * (Tmp - REAL(Indx_Lo , ReKi)) - 1.0_ReKi ! convert to value between -1 and 1 + + !------------------------------------------------------------------------------------------------- + ! to verify that we don't extrapolate, make sure isopc is bound between -1 and 1 (effectively nearest neighbor) + !------------------------------------------------------------------------------------------------- + isopc = min( 1.0_SiKi, isopc ) + isopc = max(-1.0_SiKi, isopc ) + + Indx_Hi = min( Indx_Lo + 1, nMax ) ! make sure it's a valid index, zero-based + +end subroutine SetTimeIndex + + +!==================================================================================================== +!> This routine sets up interpolation of a 3-d or 4-d dataset. +!! This method is described here: http://rjwagner49.com/Mathematics/Interpolation.pdf +subroutine WaveField_Interp_Setup4D( Time, Position, p, m, ErrStat, ErrMsg ) + real(DbKi), intent(in ) :: Time !< time from the start of the simulation + real(ReKi), intent(in ) :: Position(3) !< Array of XYZ coordinates, 3 + type(SeaSt_WaveField_ParameterType), intent(in ) :: p !< Parameters + type(SeaSt_WaveField_MiscVarType), intent(inout) :: m !< MiscVars + integer(IntKi), intent( out) :: ErrStat !< Error status + character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + + character(*), parameter :: RoutineName = 'WaveField_Interp_Setup4D' + integer(IntKi) :: i + real(SiKi) :: isopc(4) ! isoparametric coordinates + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + + ErrStat = ErrID_None + ErrMsg = "" + + ! Find the bounding indices for time + call SetTimeIndex(Time, p%delta(1), p%n(1), m%Indx_Lo(1), m%Indx_Hi(1), isopc(1), ErrStat2, ErrMsg2) + if (Failed()) return; + + ! Find the bounding indices for XY position + do i=2,3 ! x and y components + call SetCartesianXYIndex(Position(i-1), p%pZero(i), p%delta(i), p%n(i), m%Indx_Lo(i), m%Indx_Hi(i), isopc(i), m%FirstWarn_Clamp, ErrStat2, ErrMsg2) + if (Failed()) return; + enddo + + ! Find the bounding indices for Z position + i=4 ! z component + call SetCartesianZIndex(Position(i-1), p%Z_Depth, p%delta(i), p%n(i), m%Indx_Lo(i), m%Indx_Hi(i), isopc(i), m%FirstWarn_Clamp, ErrStat2, ErrMsg2) + if (Failed()) return; + + ! compute weighting factors + m%N4D( 1) = ( 1.0_SiKi - isopc(1) ) * ( 1.0_SiKi - isopc(2) ) * ( 1.0_SiKi - isopc(3) ) * ( 1.0_SiKi - isopc(4) ) + m%N4D( 2) = ( 1.0_SiKi - isopc(1) ) * ( 1.0_SiKi - isopc(2) ) * ( 1.0_SiKi - isopc(3) ) * ( 1.0_SiKi + isopc(4) ) + m%N4D( 3) = ( 1.0_SiKi - isopc(1) ) * ( 1.0_SiKi - isopc(2) ) * ( 1.0_SiKi + isopc(3) ) * ( 1.0_SiKi - isopc(4) ) + m%N4D( 4) = ( 1.0_SiKi - isopc(1) ) * ( 1.0_SiKi - isopc(2) ) * ( 1.0_SiKi + isopc(3) ) * ( 1.0_SiKi + isopc(4) ) + m%N4D( 5) = ( 1.0_SiKi - isopc(1) ) * ( 1.0_SiKi + isopc(2) ) * ( 1.0_SiKi - isopc(3) ) * ( 1.0_SiKi - isopc(4) ) + m%N4D( 6) = ( 1.0_SiKi - isopc(1) ) * ( 1.0_SiKi + isopc(2) ) * ( 1.0_SiKi - isopc(3) ) * ( 1.0_SiKi + isopc(4) ) + m%N4D( 7) = ( 1.0_SiKi - isopc(1) ) * ( 1.0_SiKi + isopc(2) ) * ( 1.0_SiKi + isopc(3) ) * ( 1.0_SiKi - isopc(4) ) + m%N4D( 8) = ( 1.0_SiKi - isopc(1) ) * ( 1.0_SiKi + isopc(2) ) * ( 1.0_SiKi + isopc(3) ) * ( 1.0_SiKi + isopc(4) ) + m%N4D( 9) = ( 1.0_SiKi + isopc(1) ) * ( 1.0_SiKi - isopc(2) ) * ( 1.0_SiKi - isopc(3) ) * ( 1.0_SiKi - isopc(4) ) + m%N4D(10) = ( 1.0_SiKi + isopc(1) ) * ( 1.0_SiKi - isopc(2) ) * ( 1.0_SiKi - isopc(3) ) * ( 1.0_SiKi + isopc(4) ) + m%N4D(11) = ( 1.0_SiKi + isopc(1) ) * ( 1.0_SiKi - isopc(2) ) * ( 1.0_SiKi + isopc(3) ) * ( 1.0_SiKi - isopc(4) ) + m%N4D(12) = ( 1.0_SiKi + isopc(1) ) * ( 1.0_SiKi - isopc(2) ) * ( 1.0_SiKi + isopc(3) ) * ( 1.0_SiKi + isopc(4) ) + m%N4D(13) = ( 1.0_SiKi + isopc(1) ) * ( 1.0_SiKi + isopc(2) ) * ( 1.0_SiKi - isopc(3) ) * ( 1.0_SiKi - isopc(4) ) + m%N4D(14) = ( 1.0_SiKi + isopc(1) ) * ( 1.0_SiKi + isopc(2) ) * ( 1.0_SiKi - isopc(3) ) * ( 1.0_SiKi + isopc(4) ) + m%N4D(15) = ( 1.0_SiKi + isopc(1) ) * ( 1.0_SiKi + isopc(2) ) * ( 1.0_SiKi + isopc(3) ) * ( 1.0_SiKi - isopc(4) ) + m%N4D(16) = ( 1.0_SiKi + isopc(1) ) * ( 1.0_SiKi + isopc(2) ) * ( 1.0_SiKi + isopc(3) ) * ( 1.0_SiKi + isopc(4) ) + m%N4D = m%N4D / REAL( SIZE(m%N4D), SiKi ) ! normalize + +contains + logical function Failed() + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + Failed = ErrStat >= AbortErrLev + end function +END Subroutine WaveField_Interp_Setup4D + + +subroutine WaveField_Interp_Setup3D( Time, Position, p, m, ErrStat, ErrMsg ) + real(DbKi), intent(in ) :: Time !< time from the start of the simulation + real(ReKi), intent(in ) :: Position(2) !< Array of XYZ coordinates, 3 + type(SeaSt_WaveField_ParameterType), intent(in ) :: p !< Parameters + type(SeaSt_WaveField_MiscVarType), intent(inout) :: m !< MiscVars + integer(IntKi), intent( out) :: ErrStat !< Error status + character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + character(*), parameter :: RoutineName = 'WaveField_Interp_Setup3D' + integer(IntKi) :: i + real(SiKi) :: isopc(4) ! isoparametric coordinates + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + + ErrStat = ErrID_None + ErrMsg = "" + + ! Find the bounding indices for time + call SetTimeIndex(Time, p%delta(1), p%n(1), m%Indx_Lo(1), m%Indx_Hi(1), isopc(1), ErrStat2, ErrMsg2) + if (Failed()) return; + + ! Find the bounding indices for XY position + do i=2,3 ! x and y components + call SetCartesianXYIndex(Position(i-1), p%pZero(i), p%delta(i), p%n(i), m%Indx_Lo(i), m%Indx_Hi(i), isopc(i), m%FirstWarn_Clamp, ErrStat2, ErrMsg2) + if (Failed()) return; + enddo + + ! compute weighting factors + m%N3D(1) = ( 1.0_ReKi + isopc(1) )*( 1.0_ReKi - isopc(2) )*( 1.0_ReKi - isopc(3) ) + m%N3D(2) = ( 1.0_ReKi + isopc(1) )*( 1.0_ReKi + isopc(2) )*( 1.0_ReKi - isopc(3) ) + m%N3D(3) = ( 1.0_ReKi - isopc(1) )*( 1.0_ReKi + isopc(2) )*( 1.0_ReKi - isopc(3) ) + m%N3D(4) = ( 1.0_ReKi - isopc(1) )*( 1.0_ReKi - isopc(2) )*( 1.0_ReKi - isopc(3) ) + m%N3D(5) = ( 1.0_ReKi + isopc(1) )*( 1.0_ReKi - isopc(2) )*( 1.0_ReKi + isopc(3) ) + m%N3D(6) = ( 1.0_ReKi + isopc(1) )*( 1.0_ReKi + isopc(2) )*( 1.0_ReKi + isopc(3) ) + m%N3D(7) = ( 1.0_ReKi - isopc(1) )*( 1.0_ReKi + isopc(2) )*( 1.0_ReKi + isopc(3) ) + m%N3D(8) = ( 1.0_ReKi - isopc(1) )*( 1.0_ReKi - isopc(2) )*( 1.0_ReKi + isopc(3) ) + m%N3D = m%N3D / REAL( SIZE(m%N3D), ReKi ) ! normalize + +contains + logical function Failed() + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + Failed = ErrStat >= AbortErrLev + end function +END Subroutine WaveField_Interp_Setup3D + + +!==================================================================================================== +!> This routine interpolates a 4-d dataset. +!! This method is described here: http://rjwagner49.com/Mathematics/WaveFieldolation.pdf +function WaveField_Interp_4D( pKinXX, m ) + real(SiKi), intent(in ) :: pKinXX(0:,:,:,:) + type(SeaSt_WaveField_MiscVarType), intent(in ) :: m + + real(SiKi) :: WaveField_Interp_4D + real(SiKi) :: u(16) ! size 2^n + + ! interpolate + u( 1) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Lo(3), m%Indx_Lo(4) ) + u( 2) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Lo(3), m%Indx_Hi(4) ) + u( 3) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Hi(3), m%Indx_Lo(4) ) + u( 4) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Hi(3), m%Indx_Hi(4) ) + u( 5) = pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Lo(3), m%Indx_Lo(4) ) + u( 6) = pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Lo(3), m%Indx_Hi(4) ) + u( 7) = pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Hi(3), m%Indx_Lo(4) ) + u( 8) = pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Hi(3), m%Indx_Hi(4) ) + u( 9) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Lo(3), m%Indx_Lo(4) ) + u(10) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Lo(3), m%Indx_Hi(4) ) + u(11) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Hi(3), m%Indx_Lo(4) ) + u(12) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Hi(3), m%Indx_Hi(4) ) + u(13) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Lo(3), m%Indx_Lo(4) ) + u(14) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Lo(3), m%Indx_Hi(4) ) + u(15) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Hi(3), m%Indx_Lo(4) ) + u(16) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Hi(3), m%Indx_Hi(4) ) + WaveField_Interp_4D = SUM ( m%N4D * u ) +end function WaveField_Interp_4D + + +!==================================================================================================== +!> This routine interpolates a 4-d dataset. +!! This method is described here: http://rjwagner49.com/Mathematics/Interpolation.pdf +function WaveField_Interp_4D_Vec( pKinXX, m) + real(SiKi), intent(in ) :: pKinXX(0:,:,:,:,:) + type(SeaSt_WaveField_MiscVarType), intent(in ) :: m !< misc vars for interpolation + + real(SiKi) :: WaveField_Interp_4D_Vec(3) + real(SiKi) :: u(16) ! size 2^n + integer(IntKi) :: iDir + + ! interpolate + do iDir = 1,3 + u( 1) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Lo(3), m%Indx_Lo(4), iDir ) + u( 2) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Lo(3), m%Indx_Hi(4), iDir ) + u( 3) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Hi(3), m%Indx_Lo(4), iDir ) + u( 4) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Hi(3), m%Indx_Hi(4), iDir ) + u( 5) = pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Lo(3), m%Indx_Lo(4), iDir ) + u( 6) = pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Lo(3), m%Indx_Hi(4), iDir ) + u( 7) = pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Hi(3), m%Indx_Lo(4), iDir ) + u( 8) = pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Hi(3), m%Indx_Hi(4), iDir ) + u( 9) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Lo(3), m%Indx_Lo(4), iDir ) + u(10) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Lo(3), m%Indx_Hi(4), iDir ) + u(11) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Hi(3), m%Indx_Lo(4), iDir ) + u(12) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Hi(3), m%Indx_Hi(4), iDir ) + u(13) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Lo(3), m%Indx_Lo(4), iDir ) + u(14) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Lo(3), m%Indx_Hi(4), iDir ) + u(15) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Hi(3), m%Indx_Lo(4), iDir ) + u(16) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Hi(3), m%Indx_Hi(4), iDir ) + WaveField_Interp_4D_Vec(iDir) = SUM ( m%N4D * u ) + end do +END FUNCTION WaveField_Interp_4D_Vec + + +!==================================================================================================== +!> This routine interpolates a 4-d dataset. +!! This method is described here: http://rjwagner49.com/Mathematics/Interpolation.pdf +function WaveField_Interp_4D_Vec6( pKinXX, m) + real(SiKi), intent(in ) :: pKinXX(0:,:,:,:,:) + type(SeaSt_WaveField_MiscVarType), intent(in ) :: m !< misc vars for interpolation + + real(SiKi) :: WaveField_Interp_4D_Vec6(6) + real(SiKi) :: u(16) ! size 2^n + integer(IntKi) :: iDir + + ! interpolate + do iDir = 1,6 + u( 1) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Lo(3), m%Indx_Lo(4), iDir ) + u( 2) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Lo(3), m%Indx_Hi(4), iDir ) + u( 3) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Hi(3), m%Indx_Lo(4), iDir ) + u( 4) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Hi(3), m%Indx_Hi(4), iDir ) + u( 5) = pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Lo(3), m%Indx_Lo(4), iDir ) + u( 6) = pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Lo(3), m%Indx_Hi(4), iDir ) + u( 7) = pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Hi(3), m%Indx_Lo(4), iDir ) + u( 8) = pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Hi(3), m%Indx_Hi(4), iDir ) + u( 9) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Lo(3), m%Indx_Lo(4), iDir ) + u(10) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Lo(3), m%Indx_Hi(4), iDir ) + u(11) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Hi(3), m%Indx_Lo(4), iDir ) + u(12) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Hi(3), m%Indx_Hi(4), iDir ) + u(13) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Lo(3), m%Indx_Lo(4), iDir ) + u(14) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Lo(3), m%Indx_Hi(4), iDir ) + u(15) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Hi(3), m%Indx_Lo(4), iDir ) + u(16) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Hi(3), m%Indx_Hi(4), iDir ) + WaveField_Interp_4D_Vec6(iDir) = SUM ( m%N4D * u ) + end do +END FUNCTION WaveField_Interp_4D_Vec6 + + +!==================================================================================================== +!> This routine interpolates a 3-d dataset with index 1 = time (zero-based indexing), 2 = x-coordinate (1-based indexing), 3 = y-coordinate (1-based indexing) +!! This method is described here: http://rjwagner49.com/Mathematics/Interpolation.pdf +!FIXME: do like the above and call the WaveField_Interp_Setup3D routine ahead +function WaveField_Interp_3D( pKinXX, m ) + real(SiKi), intent(in ) :: pKinXX(0:,:,:) !< 3D Wave elevation data (SiKi for storage space reasons) + type(SeaSt_WaveField_MiscVarType), intent(inout) :: m !< MiscVars + + character(*), parameter :: RoutineName = 'WaveField_Interp_3D' + real(SiKi) :: WaveField_Interp_3D + real(SiKi) :: u(8) + integer(IntKi) :: i + + ! interpolate + u(1) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Lo(3) ) + u(2) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Lo(3) ) + u(3) = pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Lo(3) ) + u(4) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Lo(3) ) + u(5) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Hi(3) ) + u(6) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Hi(3) ) + u(7) = pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Hi(3) ) + u(8) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Hi(3) ) + WaveField_Interp_3D = SUM ( m%N3D * u ) +end function WaveField_Interp_3D + + +FUNCTION WaveField_Interp_3D_VEC( pKinXX, m ) + real(SiKi), intent(in ) :: pKinXX(0:,:,:,:) !< 3D Wave excitation data (SiKi for storage space reasons) + type(SeaSt_WaveField_MiscVarType), intent(inout) :: m !< MiscVars + + character(*), parameter :: RoutineName = 'WaveField_Interp_3D_VEC' + real(SiKi) :: WaveField_Interp_3D_VEC(3) + real(SiKi) :: u(8) + integer(IntKi) :: i + + ! interpolate + do i = 1,3 + u(1) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Lo(3), i ) + u(2) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Lo(3), i ) + u(3) = pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Lo(3), i ) + u(4) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Lo(3), i ) + u(5) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Hi(3), i ) + u(6) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Hi(3), i ) + u(7) = pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Hi(3), i ) + u(8) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Hi(3), i ) + WaveField_Interp_3D_VEC(i) = SUM ( m%N3D * u ) + end do +end function WaveField_Interp_3D_VEC + + +function Wavefield_Interp_3D_VEC6( pKinXX, m ) + real(SiKi), intent(in ) :: pKinXX(0:,:,:,:) !< 3D Wave excitation data (SiKi for storage space reasons) + type(SeaSt_WaveField_MiscVarType), intent(inout) :: m !< Miscvars + + character(*), parameter :: RoutineName = 'Wavefield_Interp_3D_VEC6' + real(SiKi) :: Wavefield_Interp_3D_VEC6(6) + real(SiKi) :: u(8) + integer(IntKi) :: i + + ! interpolate + do i = 1,6 + u(1) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Lo(3), i ) + u(2) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Lo(3), i ) + u(3) = pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Lo(3), i ) + u(4) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Lo(3), i ) + u(5) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Hi(3), i ) + u(6) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Hi(3), i ) + u(7) = pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Hi(3), i ) + u(8) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Hi(3), i ) + Wavefield_Interp_3D_VEC6(i) = SUM ( m%N3D * u ) + end do +end function Wavefield_Interp_3D_VEC6 + + END MODULE SeaSt_WaveField diff --git a/modules/seastate/src/SeaSt_WaveField.txt b/modules/seastate/src/SeaSt_WaveField.txt index 9d5c659752..f0b4aeaf14 100644 --- a/modules/seastate/src/SeaSt_WaveField.txt +++ b/modules/seastate/src/SeaSt_WaveField.txt @@ -1,8 +1,6 @@ #--------------------------------------------------------------------------------------------------------------------------------------------------------- # Data structures for representing wave fields. # -usefrom SeaState_Interp.txt - param SeaSt_WaveField - INTEGER WaveDirMod_None - 0 - "WaveDirMod = 0 [Directional spreading function is NONE]" - param SeaSt_WaveField - INTEGER WaveDirMod_COS2S - 1 - "WaveDirMod = 1 [Directional spreading function is COS2S]" - @@ -19,6 +17,18 @@ param SeaSt_WaveField - INTEGER WaveMod_User #--------------------------------------------------------------------------------------------------------------------------------------------------------- # #--------------------------------------------------------------------------------------------------------------------------------------------------------- +typedef ^ ParameterType IntKi n 4 - - "number of evenly-spaced grid points in the t, x, y, and z directions" - +typedef ^ ParameterType ReKi delta 4 - - "size between 2 consecutive grid points in each grid direction" "s,m,m,m" +typedef ^ ParameterType ReKi pZero 4 - - "fixed position of the XYZ grid (i.e., XYZ coordinates of m%V(:,1,1,1,:))" "m" +typedef ^ ParameterType ReKi Z_Depth - - - "grid depth" m + +typedef ^ MiscVarType SiKi N3D {8} - - "this is the weighting function for 3-d velocity field" - +typedef ^ MiscVarType SiKi N4D {16} - - "this is the weighting function for 4-d velocity field" - +typedef ^ MiscVarType integer Indx_Lo 4 - - "this is the index into the 4-d velocity field for each wave component" - +typedef ^ MiscVarType integer Indx_Hi 4 - - "this is the index into the 4-d velocity field for each wave component" - +typedef ^ MiscVarType logical FirstWarn_Clamp - .true. - "used to avoid too many 'Position has been clamped to the grid boundary' warning messages " - + + 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) @@ -31,7 +41,7 @@ typedef ^ ^ SiKi PWaveVel0 typedef ^ ^ SiKi WaveElev0 {:} - - "Instantaneous elevation time-series of incident waves at the platform reference point (NOTE THAT THIS CAN GET MODIFIED IN WAMIT)" (m) typedef ^ ^ SiKi WaveElev1 {:}{:}{:} - - "First order wave elevation" (m) typedef ^ ^ SiKi WaveElev2 {:}{:}{:} - - "Second order wave elevation" (m) -typedef ^ ^ SeaSt_Interp_ParameterType SeaSt_Interp_p - - - "Parameter information from the SeaState Interpolation module" (-) +typedef ^ ^ SeaSt_WaveField_ParameterType GridParams - - - "Parameters for grid spacing" (-) typedef ^ ^ IntKi WaveStMod - - - "Wave stretching model" typedef ^ ^ ReKi EffWtrDpth - - - "Water depth" (-) typedef ^ ^ ReKi MSL2SWL - - - "Vertical distance from mean sea level to still water level" (m) diff --git a/modules/seastate/src/SeaSt_WaveField_Types.f90 b/modules/seastate/src/SeaSt_WaveField_Types.f90 index 656e7f8460..869882a3aa 100644 --- a/modules/seastate/src/SeaSt_WaveField_Types.f90 +++ b/modules/seastate/src/SeaSt_WaveField_Types.f90 @@ -31,7 +31,6 @@ !! unpack routines associated with each defined data type. This code is automatically generated by the FAST Registry. MODULE SeaSt_WaveField_Types !--------------------------------------------------------------------------------------------------------------------------------- -USE SeaState_Interp_Types USE NWTC_Library IMPLICIT NONE INTEGER(IntKi), PUBLIC, PARAMETER :: WaveDirMod_None = 0 ! WaveDirMod = 0 [Directional spreading function is NONE] [-] @@ -45,6 +44,23 @@ MODULE SeaSt_WaveField_Types INTEGER(IntKi), PUBLIC, PARAMETER :: WaveMod_ExtElev = 5 ! WaveMod = 5 [Incident wave kinematics model: Externally generated wave-elevation time series] [-] INTEGER(IntKi), PUBLIC, PARAMETER :: WaveMod_ExtFull = 6 ! WaveMod = 6 [Incident wave kinematics model: Externally generated full wave-kinematics time series (invalid for PotMod/=0)] [-] INTEGER(IntKi), PUBLIC, PARAMETER :: WaveMod_UserFreq = 7 ! WaveMod = 7 [Incident wave kinematics model: user-defined wave frequency components] [-] +! ========= SeaSt_WaveField_ParameterType ======= + TYPE, PUBLIC :: SeaSt_WaveField_ParameterType + INTEGER(IntKi) , DIMENSION(1:4) :: n = 0_IntKi !< number of evenly-spaced grid points in the t, x, y, and z directions [-] + REAL(ReKi) , DIMENSION(1:4) :: delta = 0.0_ReKi !< size between 2 consecutive grid points in each grid direction [s,m,m,m] + REAL(ReKi) , DIMENSION(1:4) :: pZero = 0.0_ReKi !< fixed position of the XYZ grid (i.e., XYZ coordinates of m%V(:,1,1,1,:)) [m] + REAL(ReKi) :: Z_Depth = 0.0_ReKi !< grid depth [m] + END TYPE SeaSt_WaveField_ParameterType +! ======================= +! ========= SeaSt_WaveField_MiscVarType ======= + TYPE, PUBLIC :: SeaSt_WaveField_MiscVarType + REAL(SiKi) , DIMENSION(1:8) :: N3D = 0.0_R4Ki !< this is the weighting function for 3-d velocity field [-] + REAL(SiKi) , DIMENSION(1:16) :: N4D = 0.0_R4Ki !< this is the weighting function for 4-d velocity field [-] + INTEGER(IntKi) , DIMENSION(1:4) :: Indx_Lo = 0_IntKi !< this is the index into the 4-d velocity field for each wave component [-] + INTEGER(IntKi) , DIMENSION(1:4) :: Indx_Hi = 0_IntKi !< this is the index into the 4-d velocity field for each wave component [-] + 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_WaveFieldType ======= TYPE, PUBLIC :: SeaSt_WaveFieldType REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveTime !< Time array [(s)] @@ -59,7 +75,7 @@ MODULE SeaSt_WaveField_Types REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveElev0 !< Instantaneous elevation time-series of incident waves at the platform reference point (NOTE THAT THIS CAN GET MODIFIED IN WAMIT) [(m)] REAL(SiKi) , DIMENSION(:,:,:), ALLOCATABLE :: WaveElev1 !< First order wave elevation [(m)] REAL(SiKi) , DIMENSION(:,:,:), ALLOCATABLE :: WaveElev2 !< Second order wave elevation [(m)] - TYPE(SeaSt_Interp_ParameterType) :: SeaSt_Interp_p !< Parameter information from the SeaState Interpolation module [(-)] + TYPE(SeaSt_WaveField_ParameterType) :: GridParams !< Parameters for grid spacing [(-)] INTEGER(IntKi) :: WaveStMod = 0_IntKi !< Wave stretching model [-] REAL(ReKi) :: EffWtrDpth = 0.0_ReKi !< Water depth [(-)] REAL(ReKi) :: MSL2SWL = 0.0_ReKi !< Vertical distance from mean sea level to still water level [(m)] @@ -88,6 +104,103 @@ MODULE SeaSt_WaveField_Types ! ======================= CONTAINS +subroutine SeaSt_WaveField_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) + type(SeaSt_WaveField_ParameterType), intent(in) :: SrcParamData + type(SeaSt_WaveField_ParameterType), intent(inout) :: DstParamData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SeaSt_WaveField_CopyParam' + ErrStat = ErrID_None + ErrMsg = '' + DstParamData%n = SrcParamData%n + DstParamData%delta = SrcParamData%delta + DstParamData%pZero = SrcParamData%pZero + DstParamData%Z_Depth = SrcParamData%Z_Depth +end subroutine + +subroutine SeaSt_WaveField_DestroyParam(ParamData, ErrStat, ErrMsg) + type(SeaSt_WaveField_ParameterType), intent(inout) :: ParamData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SeaSt_WaveField_DestroyParam' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine SeaSt_WaveField_PackParam(RF, Indata) + type(RegFile), intent(inout) :: RF + type(SeaSt_WaveField_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SeaSt_WaveField_PackParam' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%n) + call RegPack(RF, InData%delta) + call RegPack(RF, InData%pZero) + call RegPack(RF, InData%Z_Depth) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SeaSt_WaveField_UnPackParam(RF, OutData) + type(RegFile), intent(inout) :: RF + type(SeaSt_WaveField_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SeaSt_WaveField_UnPackParam' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%n); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%delta); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%pZero); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Z_Depth); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SeaSt_WaveField_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) + type(SeaSt_WaveField_MiscVarType), intent(in) :: SrcMiscData + type(SeaSt_WaveField_MiscVarType), intent(inout) :: DstMiscData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SeaSt_WaveField_CopyMisc' + ErrStat = ErrID_None + ErrMsg = '' + DstMiscData%N3D = SrcMiscData%N3D + DstMiscData%N4D = SrcMiscData%N4D + DstMiscData%Indx_Lo = SrcMiscData%Indx_Lo + DstMiscData%Indx_Hi = SrcMiscData%Indx_Hi + DstMiscData%FirstWarn_Clamp = SrcMiscData%FirstWarn_Clamp +end subroutine + +subroutine SeaSt_WaveField_DestroyMisc(MiscData, ErrStat, ErrMsg) + type(SeaSt_WaveField_MiscVarType), intent(inout) :: MiscData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SeaSt_WaveField_DestroyMisc' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine SeaSt_WaveField_PackMisc(RF, Indata) + type(RegFile), intent(inout) :: RF + type(SeaSt_WaveField_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SeaSt_WaveField_PackMisc' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%N3D) + call RegPack(RF, InData%N4D) + call RegPack(RF, InData%Indx_Lo) + call RegPack(RF, InData%Indx_Hi) + call RegPack(RF, InData%FirstWarn_Clamp) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SeaSt_WaveField_UnPackMisc(RF, OutData) + type(RegFile), intent(inout) :: RF + type(SeaSt_WaveField_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SeaSt_WaveField_UnPackMisc' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%N3D); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%N4D); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Indx_Lo); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Indx_Hi); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FirstWarn_Clamp); 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 @@ -244,7 +357,7 @@ subroutine SeaSt_WaveField_CopySeaSt_WaveFieldType(SrcSeaSt_WaveFieldTypeData, D end if DstSeaSt_WaveFieldTypeData%WaveElev2 = SrcSeaSt_WaveFieldTypeData%WaveElev2 end if - call SeaSt_Interp_CopyParam(SrcSeaSt_WaveFieldTypeData%SeaSt_Interp_p, DstSeaSt_WaveFieldTypeData%SeaSt_Interp_p, CtrlCode, ErrStat2, ErrMsg2) + call SeaSt_WaveField_CopyParam(SrcSeaSt_WaveFieldTypeData%GridParams, DstSeaSt_WaveFieldTypeData%GridParams, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return DstSeaSt_WaveFieldTypeData%WaveStMod = SrcSeaSt_WaveFieldTypeData%WaveStMod @@ -351,7 +464,7 @@ subroutine SeaSt_WaveField_DestroySeaSt_WaveFieldType(SeaSt_WaveFieldTypeData, E if (allocated(SeaSt_WaveFieldTypeData%WaveElev2)) then deallocate(SeaSt_WaveFieldTypeData%WaveElev2) end if - call SeaSt_Interp_DestroyParam(SeaSt_WaveFieldTypeData%SeaSt_Interp_p, ErrStat2, ErrMsg2) + call SeaSt_WaveField_DestroyParam(SeaSt_WaveFieldTypeData%GridParams, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(SeaSt_WaveFieldTypeData%WaveElevC)) then deallocate(SeaSt_WaveFieldTypeData%WaveElevC) @@ -381,7 +494,7 @@ subroutine SeaSt_WaveField_PackSeaSt_WaveFieldType(RF, Indata) call RegPackAlloc(RF, InData%WaveElev0) call RegPackAlloc(RF, InData%WaveElev1) call RegPackAlloc(RF, InData%WaveElev2) - call SeaSt_Interp_PackParam(RF, InData%SeaSt_Interp_p) + call SeaSt_WaveField_PackParam(RF, InData%GridParams) call RegPack(RF, InData%WaveStMod) call RegPack(RF, InData%EffWtrDpth) call RegPack(RF, InData%MSL2SWL) @@ -429,7 +542,7 @@ subroutine SeaSt_WaveField_UnPackSeaSt_WaveFieldType(RF, OutData) call RegUnpackAlloc(RF, OutData%WaveElev0); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%WaveElev1); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%WaveElev2); if (RegCheckErr(RF, RoutineName)) return - call SeaSt_Interp_UnpackParam(RF, OutData%SeaSt_Interp_p) ! SeaSt_Interp_p + call SeaSt_WaveField_UnpackParam(RF, OutData%GridParams) ! GridParams call RegUnpack(RF, OutData%WaveStMod); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%EffWtrDpth); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%MSL2SWL); if (RegCheckErr(RF, RoutineName)) return diff --git a/modules/seastate/src/SeaState.f90 b/modules/seastate/src/SeaState.f90 index 0e3e27033d..a0d1424ac6 100644 --- a/modules/seastate/src/SeaState.f90 +++ b/modules/seastate/src/SeaState.f90 @@ -30,7 +30,6 @@ MODULE SeaState USE SeaSt_WaveField USE SeaState_Input USE SeaState_Output - use SeaState_Interp USE Current USE Waves2 @@ -90,7 +89,6 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init 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(SeaSt_Interp_InitInputType) :: SeaSt_Interp_InitInp TYPE(Current_InitOutputType) :: Current_InitOut ! Initialization Outputs from the Current module initialization INTEGER :: I ! Generic counters INTEGER :: it ! Generic counters @@ -123,103 +121,54 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init x%UnusedStates = 0.0 xd%UnusedStates = 0.0 OtherState%UnusedStates = 0.0 - m%SeaSt_Interp_m%FirstWarn_Clamp = .true. + m%WaveField_m%FirstWarn_Clamp = .true. - - ! Initialize the NWTC Subroutine Library - CALL NWTC_Init( ) - ! Display the module information - CALL DispNVD( SeaSt_ProgDesc ) - IF ( InitInp%UseInputFile ) THEN - CALL ProcessComFile( InitInp%InputFile, InFileInfo, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - IF ( ErrStat >= AbortErrLev ) THEN - CALL Cleanup() - RETURN - ENDIF + CALL ProcessComFile( InitInp%InputFile, InFileInfo, ErrStat2, ErrMsg2 ); if(Failed()) return; ELSE - CALL NWTC_Library_CopyFileInfoType( InitInp%PassedFileData, InFileInfo, MESH_NEWCOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - IF ( ErrStat >= AbortErrLev ) THEN - CALL Cleanup() - RETURN - ENDIF + CALL NWTC_Library_CopyFileInfoType( InitInp%PassedFileData, InFileInfo, MESH_NEWCOPY, ErrStat2, ErrMsg2 ); if(Failed()) return; ENDIF ! For diagnostic purposes, the following can be used to display the contents ! of the InFileInfo data structure. ! call Print_FileInfo_Struct( CU, InFileInfo ) ! CU is the screen -- different number on different systems. - ! Parse all SeaState-related input and populate the InputFileData structure - CALL SeaSt_ParseInput( InitInp%InputFile, InitInp%OutRootName, InitInp%defWtrDens, InitInp%defWtrDpth, InitInp%defMSL2SWL, InFileInfo, InputFileData, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - IF ( ErrStat >= AbortErrLev ) THEN - CALL CleanUp() - RETURN - END IF + CALL SeaSt_ParseInput( InitInp%InputFile, InitInp%OutRootName, InitInp%defWtrDens, InitInp%defWtrDpth, InitInp%defMSL2SWL, InFileInfo, InputFileData, ErrStat2, ErrMsg2 ); if(Failed()) return; + ! Verify all the necessary initialization data. Do this at the HydroDynInput module-level + ! because the HydroDynInput module is also responsible for parsing all this + ! initialization data from a file + CALL SeaStateInput_ProcessInitData( InitInp, p, InputFileData, ErrStat2, ErrMsg2 ); if(Failed()) return; - ! Verify all the necessary initialization data. Do this at the HydroDynInput module-level - ! because the HydroDynInput module is also responsible for parsing all this - ! initialization data from a file - - CALL SeaStateInput_ProcessInitData( InitInp, p, InputFileData, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - IF ( ErrStat >= AbortErrLev ) THEN - CALL CleanUp() - RETURN - END IF - - - ! Now call each sub-module's *_Init subroutine - ! to fully initialize each sub-module based on the necessary initialization data + ! Now call each sub-module's *_Init subroutine + ! to fully initialize each sub-module based on the necessary initialization data - - ! Initialize Current module - - CALL Current_Init(InputFileData%Current, Current_InitOut, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - IF ( ErrStat >= AbortErrLev ) THEN - CALL CleanUp() - RETURN - END IF + ! Initialize Current module + CALL Current_Init(InputFileData%Current, Current_InitOut, ErrStat2, ErrMsg2 ); if(Failed()) return; - ! Move initialization output data from Current module into the initialization input data for the Waves module - + ! Move initialization output data from Current module into the initialization input data for the Waves module IF (ALLOCATED(Current_InitOut%CurrVxi)) CALL Move_Alloc( Current_InitOut%CurrVxi, InputFileData%Waves%CurrVxi ) IF (ALLOCATED(Current_InitOut%CurrVyi)) CALL Move_Alloc( Current_InitOut%CurrVyi, InputFileData%Waves%CurrVyi ) InputFileData%Waves%PCurrVxiPz0 = Current_InitOut%PCurrVxiPz0 InputFileData%Waves%PCurrVyiPz0 = Current_InitOut%PCurrVyiPz0 - - - ! distribute wave field and turbine location variables as needed to submodule initInputs + ! distribute wave field and turbine location variables as needed to submodule initInputs InputFileData%Waves%WaveFieldMod = InitInp%WaveFieldMod InputFileData%Waves%PtfmLocationX = InitInp%PtfmLocationX InputFileData%Waves%PtfmLocationY = InitInp%PtfmLocationY + ! Initialize Waves module (Note that this may change InputFileData%Waves%WaveDT) + CALL Waves_Init(InputFileData%Waves, Waves_InitOut, p%WaveField, ErrStat2, ErrMsg2 ); if(Failed()) return; - ! Initialize Waves module (Note that this may change InputFileData%Waves%WaveDT) - CALL Waves_Init(InputFileData%Waves, Waves_InitOut, p%WaveField, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! note that we DO NOT RETURN on error until AFTER the pointers modified, below - - - ! check error - IF ( ErrStat >= AbortErrLev ) THEN - CALL CleanUp() - RETURN - END IF - ! Copy Waves initialization output into the initialization input type for the WAMIT module p%WaveDT = InputFileData%Waves%WaveDT @@ -260,60 +209,40 @@ 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 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - IF ( ErrStat >= AbortErrLev ) THEN - CALL CleanUp() - RETURN - END IF + 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 + ! 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; - ! Dynamic pressure -- difference frequency terms - CALL AddArrays_4D(p%WaveField%WaveDynP, Waves2_InitOut%WaveDynP2D,'WaveDynP_D', ErrStat2, ErrMsg2) ! WaveDynP = WaveDynP + WaveDynP2D - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - ! Particle velocity -- difference frequency terms - CALL AddArrays_5D(p%WaveField%WaveVel, Waves2_InitOut%WaveVel2D,'WaveVel_D', ErrStat2, ErrMsg2) ! WaveVel = WaveVel + WaveVel2D - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - ! Particle acceleration -- difference frequency terms - CALL AddArrays_5D(p%WaveField%WaveAcc, Waves2_InitOut%WaveAcc2D,'WaveAcc_D', ErrStat2, ErrMsg2) ! WaveAcc = WaveAcc + WaveAcc2D - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - + ! 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; - ! Dynamic pressure -- sum frequency terms - CALL AddArrays_4D(p%WaveField%WaveDynP, Waves2_InitOut%WaveDynP2S,'WaveDynP_S', ErrStat2, ErrMsg2) ! WaveDynP = WaveDynP + WaveDynP2S - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - ! Particle velocity -- sum frequency terms - CALL AddArrays_5D(p%WaveField%WaveVel, Waves2_InitOut%WaveVel2S,'WaveVel_S', ErrStat2, ErrMsg2) ! WaveVel = WaveVel + WaveVel2S - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - ! Particle acceleration -- sum frequency terms - ! Note: MacCamy-Fuchs scaled accleration should not contain second-order contributions - CALL AddArrays_5D(p%WaveField%WaveAcc, Waves2_InitOut%WaveAcc2S,'WaveAcc_S', ErrStat2, ErrMsg2) ! WaveAcc = WaveAcc + WaveAcc2S - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + ! 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 ELSE - ! these need to be set to zero since we don't have a UseWaves2 flag: - InputFileData%Waves2%NWaveElevGrid = 0 - + ! these need to be set to zero since we don't have a UseWaves2 flag: + InputFileData%Waves2%NWaveElevGrid = 0 ENDIF ! InputFileData%Waves2%WvDiffQTFF .OR. InputFileData%Waves2%WvSumQTFF - END IF ! Check for WaveMod = 6 (WaveMod_ExtFull) ! Create the Output file if requested @@ -325,31 +254,21 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init ! Define initialization-routine output here: InitOut%Ver = SeaSt_ProgDesc - ! These three come directly from processing the inputs, and so will exist even if not using Morison elements: - CALL SeaStOut_Init( SeaSt_ProgDesc, InitInp%OutRootName, InputFileData, y, p, m, InitOut, ErrStat2, ErrMsg2 ); CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - IF ( ErrStat >= AbortErrLev ) THEN - CALL CleanUp() - RETURN - END IF - -!=============================================== + CALL SeaStOut_Init( SeaSt_ProgDesc, InitInp%OutRootName, InputFileData, y, p, m, InitOut, ErrStat2, ErrMsg2 ); if(Failed()) return; - CALL SeaStOut_WrSummaryFile(InitInp, InputFileData, p, ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + CALL SeaStOut_WrSummaryFile(InitInp, InputFileData, p, ErrStat2, ErrMsg2); if(Failed()) return; ! Setup the 4D grid information for the Interpolation Module - SeaSt_Interp_InitInp%n = (/p%WaveField%NStepWave,p%nGrid(1),p%nGrid(2),p%nGrid(3)/) - SeaSt_Interp_InitInp%delta = (/real(p%WaveDT,ReKi),p%deltaGrid(1),p%deltaGrid(2),p%deltaGrid(3)/) - SeaSt_Interp_InitInp%pZero(1) = 0.0 !Time - SeaSt_Interp_InitInp%pZero(2) = -InputFileData%X_HalfWidth - SeaSt_Interp_InitInp%pZero(3) = -InputFileData%Y_HalfWidth - SeaSt_Interp_InitInp%pZero(4) = -InputFileData%Z_Depth ! zi - SeaSt_Interp_InitInp%Z_Depth = InputFileData%Z_Depth - call SeaSt_Interp_Init(SeaSt_Interp_InitInp, p%WaveField%seast_interp_p, ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + p%WaveField%GridParams%n = (/p%WaveField%NStepWave,p%nGrid(1),p%nGrid(2),p%nGrid(3)/) + p%WaveField%GridParams%delta = (/real(p%WaveDT,ReKi),p%deltaGrid(1),p%deltaGrid(2),p%deltaGrid(3)/) + p%WaveField%GridParams%pZero(1) = 0.0 !Time + p%WaveField%GridParams%pZero(2) = -InputFileData%X_HalfWidth + p%WaveField%GridParams%pZero(3) = -InputFileData%Y_HalfWidth + p%WaveField%GridParams%pZero(4) = -InputFileData%Z_Depth ! zi + p%WaveField%GridParams%Z_Depth = InputFileData%Z_Depth IF ( p%OutSwtch == 1 ) THEN ! Only HD-level output writing ! HACK WE can tell FAST not to write any HD outputs by simply deallocating the WriteOutputHdr array! @@ -359,22 +278,22 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init InitOut%WaveField => p%WaveField ! Tell HydroDyn if state-space wave excitation is not allowed: - InitOut%InvalidWithSSExctn = InputFileData%WaveMod == WaveMod_ExtFull .or. & !call SetErrStat( ErrID_Fatal, 'Externally generated full wave-kinematics time series cannot be used with state-space wave excitations. Set WaveMod 0, 1, 1P#, 2, 3, 4, or 5.', ErrStat, ErrMsg, RoutineName ) - InputFileData%WaveDirMod /= WaveDirMod_None .or. & !call SetErrStat( ErrID_Fatal, 'Directional spreading cannot be used with state-space wave excitations. Set WaveDirMod=0.', ErrStat, ErrMsg, RoutineName ) - InputFileData%Waves2%WvDiffQTFF .or. & !call SetErrStat( ErrID_Fatal, 'Cannot use full difference-frequency 2nd-order wave kinematics with state-space wave excitations. Set WvDiffQTF=FALSE.', ErrStat, ErrMsg, RoutineName ) - InputFileData%Waves2%WvSumQTFF !call SetErrStat( ErrID_Fatal, 'Cannot use full summation-frequency 2nd-order wave kinematics with state-space wave excitations. Set WvSumQTF=FALSE.', ErrStat, ErrMsg, RoutineName ) + InitOut%InvalidWithSSExctn = InputFileData%WaveMod == WaveMod_ExtFull .or. & ! 'Externally generated full wave-kinematics time series cannot be used with state-space wave excitations. Set WaveMod 0, 1, 1P#, 2, 3, 4, or 5.' + InputFileData%WaveDirMod /= WaveDirMod_None .or. & ! 'Directional spreading cannot be used with state-space wave excitations. Set WaveDirMod=0.' + InputFileData%Waves2%WvDiffQTFF .or. & ! 'Cannot use full difference-frequency 2nd-order wave kinematics with state-space wave excitations. Set WvDiffQTF=FALSE.' + InputFileData%Waves2%WvSumQTFF ! 'Cannot use full summation-frequency 2nd-order wave kinematics with state-space wave excitations. Set WvSumQTF=FALSE.' ! Write Wave Kinematics? if ( InputFileData%WaveMod /= WaveMod_ExtFull ) then if ( InitInp%WrWvKinMod == 2 ) then call SeaStOut_WriteWvKinFiles( InitInp%OutRootname, SeaSt_ProgDesc, p%WaveField, p%WaveDT, InputFileData%X_HalfWidth, InputFileData%Y_HalfWidth, & p%deltaGrid, p%NGrid, ErrStat2, ErrMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + if(Failed()) return; else if ( InitInp%WrWvKinMod == 1 ) then call SeaStOut_WriteWaveElev0(InitInp%OutRootname, p%WaveField%NStepWave, & p%NGrid, p%WaveField%WaveElev1, p%WaveField%WaveElev2, & p%WaveField%WaveTime, ErrStat2, ErrMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + if(Failed()) return; end if end if @@ -382,9 +301,7 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init ! If requested, output wave elevation data for VTK visualization if (InitInp%SurfaceVis) then - call SurfaceVisGenerate(ErrStat2, ErrMsg2) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - if (ErrStat >= AbortErrLev) return + call SurfaceVisGenerate(ErrStat2, ErrMsg2); if(Failed()) return; endif @@ -420,6 +337,11 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init CALL CleanUp() CONTAINS + logical function Failed() + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + Failed = ErrStat >= AbortErrLev + if (Failed) call CleanUp() + end function !................................ SUBROUTINE CleanUp() @@ -458,15 +380,15 @@ subroutine SurfaceVisGenerate(ErrStat3, ErrMsg3) ErrMsg3 = "" ! Grid half width from the WaveField - HWidX = (real(p%WaveField%SeaSt_Interp_p%n(2)-1,SiKi)) / 2.0_SiKi * p%WaveField%SeaSt_Interp_p%delta(2) - HWidY = (real(p%WaveField%SeaSt_Interp_p%n(3)-1,SiKi)) / 2.0_SiKi * p%WaveField%SeaSt_Interp_p%delta(3) + HWidX = (real(p%WaveField%GridParams%n(2)-1,SiKi)) / 2.0_SiKi * p%WaveField%GridParams%delta(2) + HWidY = (real(p%WaveField%GridParams%n(3)-1,SiKi)) / 2.0_SiKi * p%WaveField%GridParams%delta(3) if ((InitInp%SurfaceVisNx <= 0) .or. (InitInp%SurfaceVisNy <= 0))then ! use the SeaState points exactly ! Set number of points to the number of seastate grid points in each direction - Nx = p%WaveField%SeaSt_Interp_p%n(2) - Ny = p%WaveField%SeaSt_Interp_p%n(3) - dx = p%WaveField%SeaSt_Interp_p%delta(2) - dy = p%WaveField%SeaSt_Interp_p%delta(3) + Nx = p%WaveField%GridParams%n(2) + Ny = p%WaveField%GridParams%n(3) + dx = p%WaveField%GridParams%delta(2) + dy = p%WaveField%GridParams%delta(3) call SetErrStat(ErrID_Info,"Setting wavefield visualization grid to "//trim(Num2LStr(Nx))//" x "//trim(Num2LStr(Ny))//"points",ErrStat3,ErrMsg3,RoutineName) elseif ((InitInp%SurfaceVisNx < 3) .or. (InitInp%SurfaceVisNx < 3)) then ! Set to 3 for minimum Nx = 3 @@ -500,31 +422,19 @@ subroutine SurfaceVisGenerate(ErrStat3, ErrMsg3) InitOut%WaveElevVisY(i2) = -HWidY + real(i2-1,SiKi)*dy enddo -!FIXME: calculate from the FFT of the data. + !TODO: sometime in the future, we might want larger grids than is stored in the WaveField. When + ! we want that, we will need to add a WaveField routine to generate for arbitrary points from an + ! FFT of the whole complex series. do it = 0,size(p%WaveField%WaveTime)-1 do i1 = 1, nx loc(1) = InitOut%WaveElevVisX(i1) do i2 = 1, ny loc(2) = InitOut%WaveElevVisX(i2) - InitOut%WaveElevVisGrid(it,i1,i2) = SeaSt_Interp_3D( real(p%WaveField%WaveTime(it),DbKi), real(loc,ReKi), p%WaveField%WaveElev1, p%WaveField%seast_interp_p, m%seast_interp_m%FirstWarn_Clamp, ErrStat4, ErrMsg4 ) + InitOut%WaveElevVisGrid(it,i1,i2) = WaveField_GetNodeTotalWaveElev(p%WaveField, m%WaveField_m, real(p%WaveField%WaveTime(it),DbKi), real(loc,ReKi), ErrStat4, ErrMsg4 ) call SetErrStat( ErrStat4, ErrMsg4, ErrStat3, ErrMsg3, RoutineName ) enddo end do end do - - if (allocated(p%WaveField%WaveElev2)) then - do it = 0,size(p%WaveField%WaveTime)-1 - do i1 = 1, nx - loc(1) = InitOut%WaveElevVisX(i1) - do i2 = 1, ny - loc(2) = InitOut%WaveElevVisX(i2) - TmpElev = SeaSt_Interp_3D( real(p%WaveField%WaveTime(it),DbKi), real(loc,ReKi), p%WaveField%WaveElev2, p%WaveField%seast_interp_p, m%seast_interp_m%FirstWarn_Clamp, ErrStat4, ErrMsg4 ) - call SetErrStat( ErrStat4, ErrMsg4, ErrStat3, ErrMsg3, RoutineName ) - InitOut%WaveElevVisGrid(it,i1,i2) = InitOut%WaveElevVisGrid(it,i1,i2) + TmpElev - end do - end do - end do - end if end subroutine SurfaceVisGenerate END SUBROUTINE SeaSt_Init @@ -764,7 +674,7 @@ SUBROUTINE SeaSt_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, ErrStat, Er DO i = 1, p%NWaveKin positionXYZ = (/p%WaveKinxi(i),p%WaveKinyi(i),p%WaveKinzi(i)/) - CALL WaveField_GetNodeWaveKin( p%WaveField, m%seast_interp_m, Time, positionXYZ, .FALSE., nodeInWater, zeta1, zeta2, zeta, WaveDynP(i), WaveVel(:,i), WaveAcc(:,i), WaveAccMCF(:,i), ErrStat2, ErrMsg2 ) + CALL WaveField_GetNodeWaveKin( p%WaveField, m%WaveField_m, Time, positionXYZ, .FALSE., nodeInWater, zeta1, zeta2, zeta, WaveDynP(i), WaveVel(:,i), WaveAcc(:,i), WaveAccMCF(:,i), ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END DO @@ -772,9 +682,9 @@ SUBROUTINE SeaSt_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, ErrStat, Er DO i = 1, p%NWaveElev positionXY = (/p%WaveElevxi(i),p%WaveElevyi(i)/) - WaveElev1(i) = WaveField_GetNodeWaveElev1( p%WaveField, m%SeaSt_Interp_m, Time, positionXY, ErrStat2, ErrMsg2 ) + WaveElev1(i) = WaveField_GetNodeWaveElev1( p%WaveField, m%WaveField_m, Time, positionXY, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - WaveElev2(i) = WaveField_GetNodeWaveElev2( p%WaveField, m%SeaSt_Interp_m, Time, positionXY, ErrStat2, ErrMsg2 ) + WaveElev2(i) = WaveField_GetNodeWaveElev2( p%WaveField, m%WaveField_m, Time, positionXY, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) WaveElev(i) = WaveElev1(i) + WaveElev2(i) END DO diff --git a/modules/seastate/src/SeaState.txt b/modules/seastate/src/SeaState.txt index 1ef0d93440..5b50752f8a 100644 --- a/modules/seastate/src/SeaState.txt +++ b/modules/seastate/src/SeaState.txt @@ -17,7 +17,6 @@ include Registry_NWTC_Library.txt usefrom Current.txt usefrom Waves.txt usefrom Waves2.txt -usefrom SeaState_Interp.txt usefrom SeaSt_WaveField.txt # # @@ -120,7 +119,7 @@ typedef ^ OtherStateType R8Ki Unu typedef ^ MiscVarType INTEGER Decimate - - - "The output decimation counter" - 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 ^ ^ SeaSt_Interp_MiscVarType SeaSt_Interp_m - - - "misc var information from the SeaState Interpolation module" - +typedef ^ ^ SeaSt_WaveField_MiscVarType WaveField_m - - - "misc var information from the SeaState Interpolation module" - # ..... Parameters ................................................................................................................ # Define parameters here: diff --git a/modules/seastate/src/SeaState_Interp.f90 b/modules/seastate/src/SeaState_Interp.f90 deleted file mode 100644 index 143ad80180..0000000000 --- a/modules/seastate/src/SeaState_Interp.f90 +++ /dev/null @@ -1,715 +0,0 @@ -!> This module is an interpolator for SeaState pointer arrays based on a 3D grid and time. -!! @note This module does not need to exactly conform to the FAST Modularization Framework standards. Three routines are required -!! though: -!! -- SeaSt_Interp_Init -- Load or create any wind data. Only called at the start of FAST. -!! -- SeaSt_Interp_CalcOutput -- This will be called at each timestep with a series of data points to give the wave kinematics. -!! -- SeaSt_Interp_End -- clear out any stored stuff. Only called at the end of FAST. -MODULE SeaState_Interp -!********************************************************************************************************************************** -! LICENSING -! Copyright (C) 2016 National Renewable Energy Laboratory -! -! This file is part of SeaState. -! -! Licensed under the Apache License, Version 2.0 (the "License"); -! you may not use this file except in compliance with the License. -! You may obtain a copy of the License at -! -! http://www.apache.org/licenses/LICENSE-2.0 -! -! Unless required by applicable law or agreed to in writing, software -! distributed under the License is distributed on an "AS IS" BASIS, -! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -! See the License for the specific language governing permissions and -! limitations under the License. -! -!********************************************************************************************************************************** - - USE NWTC_Library - USE SeaState_Interp_Types - - IMPLICIT NONE - PRIVATE - - TYPE(ProgDesc), PARAMETER :: SeaSt_Interp_Ver = ProgDesc( 'SeaSt_Interp', '', '' ) - - PUBLIC :: SeaSt_Interp_Init - PUBLIC :: SeaSt_Interp_End - PUBLIC :: SeaSt_Interp_3D - PUBLIC :: SeaSt_Interp_3D_Vec - PUBLIC :: SeaSt_Interp_3D_Vec6 - PUBLIC :: SeaSt_Interp_4D - PUBLIC :: SeaSt_Interp_4D_Vec - PUBLIC :: SeaSt_Interp_Setup - -CONTAINS - -!==================================================================================================== - -!---------------------------------------------------------------------------------------------------- -!> A subroutine to initialize the SeaState 4D interpolator module. -!---------------------------------------------------------------------------------------------------- -SUBROUTINE SeaSt_Interp_Init(InitInp, p, ErrStat, ErrMsg) - - - IMPLICIT NONE - - ! Passed Variables - - TYPE(SeaSt_Interp_InitInputType), INTENT(IN ) :: InitInp !< Input data for initialization - TYPE(SeaSt_Interp_ParameterType), INTENT( OUT) :: p !< Parameters - ! TYPE(SeaSt_Interp_InitOutputType), INTENT( OUT) :: InitOut !< Initial output - - ! REAL(DbKi), INTENT(IN ) :: Interval !< Do not change this!! - - - - ! Error handling - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< determines if an error has been encountered - CHARACTER(*), INTENT( OUT) :: ErrMsg !< A message about the error. See NWTC_Library info for ErrID_* levels. - - ! local variables - ! Put local variables used during initializing your wind here. DO NOT USE GLOBAL VARIABLES EVER! - ! INTEGER(IntKi) :: UnitWind ! Use this unit number if you need to read in a file. - - ! Temporary variables for error handling -! INTEGER(IntKi) :: ErrStat2 ! Temp variable for the error status -! CHARACTER(ErrMsgLen) :: ErrMsg2 ! temporary error message - CHARACTER(*), PARAMETER :: RoutineName = 'SeaSt_Interp_Init' - - !------------------------------------------------------------------------------------------------- - ! Set the Error handling variables - !------------------------------------------------------------------------------------------------- - - ErrStat = ErrID_None - ErrMsg = "" - - - !------------------------------------------------------------------------------------------------- - ! Copy things from the InitData to the ParamData. - !------------------------------------------------------------------------------------------------- - p%n = InitInp%n ! number of points on the evenly-spaced grid (in each direction) - p%delta = InitInp%delta ! distance between consecutive grid points in each direction (s,m,m,m) - p%pZero = InitInp%pZero ! fixed location of first time-XYZ grid point (i.e., XYZ coordinates of m%V(:,1,1,1,:)) - p%Z_Depth = InitInp%Z_Depth - - - !------------------------------------------------------------------------------------------------- - ! Set the InitOutput information. Set any outputs here. - !------------------------------------------------------------------------------------------------- - - ! InitOut%Ver = SeaSt_Interp_Ver - - RETURN - -END SUBROUTINE SeaSt_Interp_Init - -!==================================================================================================== - - -subroutine SetCartesianXYIndex(p, pZero, delta, nMax, Indx_Lo, Indx_Hi, isopc, FirstWarn, ErrStat, ErrMsg) - REAL(ReKi), INTENT(IN ) :: p !< - REAL(ReKi), INTENT(IN ) :: pZero - REAL(ReKi), INTENT(IN ) :: delta - INTEGER(IntKi), INTENT(in ) :: nMax - INTEGER(IntKi), intent(inout) :: Indx_Lo - INTEGER(IntKi), intent(inout) :: Indx_Hi - real(SiKi), intent(inout) :: isopc - logical, intent(inout) :: FirstWarn - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - real(ReKi) :: Tmp - - ErrStat = ErrID_None - ErrMsg = "" - - isopc = -1.0 - Indx_Lo = 0 - Indx_Hi = 0 - - - Tmp = (p-pZero) / delta - Indx_Lo = INT( Tmp ) + 1 ! convert REAL to INTEGER, then add one since our grid indices start at 1, not 0 - isopc = 2.0_ReKi * (Tmp - REAL(Indx_Lo - 1, ReKi)) - 1.0_ReKi ! convert to value between -1 and 1 - - if ( Indx_Lo < 1 ) then - Indx_Lo = 1 - isopc = -1.0 - if (FirstWarn) then - call SetErrStat(ErrID_Warn,'Position has been clamped to the grid boundary. Warning will not be repeated though condition may persist.',ErrStat,ErrMsg,'SetCartesianXYIndex') !error out if time is outside the lower bounds - FirstWarn = .false. - end if - end if - - Indx_Hi = min( Indx_Lo + 1, nMax ) ! make sure it's a valid index, zero-based - - if ( Indx_Lo >= Indx_Hi ) then - ! Need to clamp to grid boundary - if (FirstWarn .and. Indx_Lo /= Indx_Hi) then ! don't warn if we are exactly at the boundary - call SetErrStat(ErrID_Warn,'Position has been clamped to the grid boundary. Warning will not be repeated though condition may persist.',ErrStat,ErrMsg,'SetCartesianXYIndex') !error out if time is outside the lower bounds - FirstWarn = .false. - end if - Indx_Lo = max(Indx_Hi - 1, 1) - isopc = 1.0 - end if - - - - !------------------------------------------------------------------------------------------------- - ! to verify that we don't extrapolate, make sure isopc is bound between -1 and 1 (effectively nearest neighbor) - !------------------------------------------------------------------------------------------------- - isopc = min( 1.0_SiKi, isopc ) - isopc = max(-1.0_SiKi, isopc ) - - -end subroutine SetCartesianXYIndex - -subroutine SetCartesianZIndex(p, z_depth, delta, nMax, Indx_Lo, Indx_Hi, isopc, FirstWarn, ErrStat, ErrMsg) - REAL(ReKi), INTENT(IN ) :: p !< time from the start of the simulation - REAL(ReKi), INTENT(IN ) :: z_depth - REAL(ReKi), INTENT(IN ) :: delta - INTEGER(IntKi), INTENT(in ) :: nMax - INTEGER(IntKi), intent(inout) :: Indx_Lo - INTEGER(IntKi), intent(inout) :: Indx_Hi - real(SiKi), intent(inout) :: isopc - logical, intent(inout) :: FirstWarn - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - real(ReKi) :: Tmp - - ErrStat = ErrID_None - ErrMsg = "" - - isopc = -1.0 - Indx_Lo = 0 - Indx_Hi = 0 - - - !Tmp = acos(-p / z_depth) / delta - Tmp = acos( max(-1.0_ReKi, min(1.0_ReKi, 1+(p / z_depth)) ) ) / delta - Tmp = nmax - 1 - Tmp - Indx_Lo = INT( Tmp ) + 1 ! convert REAL to INTEGER, then add one since our grid indices start at 1, not 0 - isopc = 2.0_ReKi * (Tmp - REAL(Indx_Lo - 1, ReKi)) - 1.0_ReKi ! convert to value between -1 and 1 - - if ( Indx_Lo < 1 ) then - Indx_Lo = 1 - isopc = -1.0 - if (FirstWarn) then - call SetErrStat(ErrID_Warn,'Position has been clamped to the grid boundary. Warning will not be repeated though condition may persist.',ErrStat,ErrMsg,'SetCartesianZIndex') !error out if z is outside the lower bounds - FirstWarn = .false. - end if - end if - - Indx_Hi = min( Indx_Lo + 1, nMax ) ! make sure it's a valid index, one-based - - if ( Indx_Lo >= Indx_Hi ) then - ! Need to clamp to grid boundary - if (FirstWarn .and. Indx_Lo /= Indx_Hi) then ! don't warn if we are exactly at the boundary - call SetErrStat(ErrID_Warn,'Position has been clamped to the grid boundary. Warning will not be repeated though condition may persist.',ErrStat,ErrMsg,'SetCartesianZIndex') !error out if z is outside the upper bounds - FirstWarn = .false. - end if - Indx_Lo = max(Indx_Hi - 1, 1) - isopc = 1.0 - end if - - - !------------------------------------------------------------------------------------------------- - ! to verify that we don't extrapolate, make sure isopc is bound between -1 and 1 (effectively nearest neighbor) - !------------------------------------------------------------------------------------------------- - isopc = min( 1.0_SiKi, isopc ) - isopc = max(-1.0_SiKi, isopc ) - - -end subroutine SetCartesianZIndex - -subroutine SetTimeIndex(Time, deltaT, nMax, Indx_Lo, Indx_Hi, isopc, ErrStat, ErrMsg) - REAL(DbKi), INTENT(IN ) :: Time !< time from the start of the simulation - REAL(ReKi), INTENT(IN ) :: deltaT - INTEGER(IntKi), INTENT(in ) :: nMax - INTEGER(IntKi), intent(inout) :: Indx_Lo - INTEGER(IntKi), intent(inout) :: Indx_Hi - real(SiKi), intent(inout) :: isopc - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - real(ReKi) :: Tmp - - ErrStat = ErrID_None - ErrMsg = "" - - isopc = -1.0 - Indx_Lo = 0 - Indx_Hi = 0 - if ( Time < 0.0_DbKi ) then - CALL SetErrStat(ErrID_Fatal,'Time value must be greater than or equal to zero!',ErrStat,ErrMsg,'SetTimeLoIndex') !error out if time is outside the lower bounds - RETURN - end if - -! NOTE: nMax is the total number of time values in the grid, since this is zero-based indexing, the max index is nMax-1 -! for example: in a time grid with 11 grid points, the indices run from 0,1,2,3,4,5,6,7,8,9,10 -! for the repeating waves feature, index 10 is the same as index 0, so if Indx_Lo = 10 then we want to -! wrap it back to index 0, if Indx_Lo = 11 we want to wrap back to index 1. - - Tmp = real( (Time/ real(deltaT,DbKi)) ,ReKi) - Tmp = MOD(Tmp,real((nMax), ReKi)) - Indx_Lo = INT( Tmp ) ! convert REAL to INTEGER - - isopc = 2.0_ReKi * (Tmp - REAL(Indx_Lo , ReKi)) - 1.0_ReKi ! convert to value between -1 and 1 - - !------------------------------------------------------------------------------------------------- - ! to verify that we don't extrapolate, make sure isopc is bound between -1 and 1 (effectively nearest neighbor) - !------------------------------------------------------------------------------------------------- - isopc = min( 1.0_SiKi, isopc ) - isopc = max(-1.0_SiKi, isopc ) - - Indx_Hi = min( Indx_Lo + 1, nMax ) ! make sure it's a valid index, zero-based - -end subroutine SetTimeIndex - - -!==================================================================================================== -!> This routine sets up interpolation of a 3-d or 4-d dataset. -!! This method is described here: http://rjwagner49.com/Mathematics/Interpolation.pdf -subroutine SeaSt_Interp_Setup( Time, Position, p, m, ErrStat, ErrMsg ) - - ! I/O variables - - REAL(DbKi), INTENT(IN ) :: Time !< time from the start of the simulation - REAL(ReKi), INTENT(IN ) :: Position(3) !< Array of XYZ coordinates, 3 - TYPE(SeaSt_Interp_ParameterType), INTENT(IN ) :: p !< Parameters - TYPE(SeaSt_Interp_MiscVarType), INTENT(INOUT) :: m !< MiscVars - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - - CHARACTER(*), PARAMETER :: RoutineName = 'SeaSt_Interp_Setup' - - ! Local variables - - INTEGER(IntKi) :: i ! loop counter - - REAL(SiKi) :: isopc(4) ! isoparametric coordinates - - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - - ErrStat = ErrID_None - ErrMsg = "" - - - !------------------------------------------------------------------------------------------------- - ! Find the bounding indices for time - !------------------------------------------------------------------------------------------------- - call SetTimeIndex(Time, p%delta(1), p%n(1), m%Indx_Lo(1), m%Indx_Hi(1), isopc(1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) !warning if time is outside the bounds - if (ErrStat >= AbortErrLev ) return - - - !------------------------------------------------------------------------------------------------- - ! Find the bounding indices for XY position - !------------------------------------------------------------------------------------------------- - do i=2,3 ! x and y components - call SetCartesianXYIndex(Position(i-1), p%pZero(i), p%delta(i), p%n(i), m%Indx_Lo(i), m%Indx_Hi(i), isopc(i), m%FirstWarn_Clamp, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) !warning if x,y is outside the bounds - enddo - - - if (ErrStat >= AbortErrLev ) return - - !------------------------------------------------------------------------------------------------- - ! Find the bounding indices for Z position - !------------------------------------------------------------------------------------------------- - i=4 ! z component - call SetCartesianZIndex(Position(i-1), p%Z_Depth, p%delta(i), p%n(i), m%Indx_Lo(i), m%Indx_Hi(i), isopc(i), m%FirstWarn_Clamp, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) !warning if z is outside the bounds - if (ErrStat >= AbortErrLev ) return - - !------------------------------------------------------------------------------------------------- - ! compute weighting factors - !------------------------------------------------------------------------------------------------- - - m%N4D( 1) = ( 1.0_SiKi - isopc(1) ) * ( 1.0_SiKi - isopc(2) ) * ( 1.0_SiKi - isopc(3) ) * ( 1.0_SiKi - isopc(4) ) - m%N4D( 2) = ( 1.0_SiKi - isopc(1) ) * ( 1.0_SiKi - isopc(2) ) * ( 1.0_SiKi - isopc(3) ) * ( 1.0_SiKi + isopc(4) ) - m%N4D( 3) = ( 1.0_SiKi - isopc(1) ) * ( 1.0_SiKi - isopc(2) ) * ( 1.0_SiKi + isopc(3) ) * ( 1.0_SiKi - isopc(4) ) - m%N4D( 4) = ( 1.0_SiKi - isopc(1) ) * ( 1.0_SiKi - isopc(2) ) * ( 1.0_SiKi + isopc(3) ) * ( 1.0_SiKi + isopc(4) ) - m%N4D( 5) = ( 1.0_SiKi - isopc(1) ) * ( 1.0_SiKi + isopc(2) ) * ( 1.0_SiKi - isopc(3) ) * ( 1.0_SiKi - isopc(4) ) - m%N4D( 6) = ( 1.0_SiKi - isopc(1) ) * ( 1.0_SiKi + isopc(2) ) * ( 1.0_SiKi - isopc(3) ) * ( 1.0_SiKi + isopc(4) ) - m%N4D( 7) = ( 1.0_SiKi - isopc(1) ) * ( 1.0_SiKi + isopc(2) ) * ( 1.0_SiKi + isopc(3) ) * ( 1.0_SiKi - isopc(4) ) - m%N4D( 8) = ( 1.0_SiKi - isopc(1) ) * ( 1.0_SiKi + isopc(2) ) * ( 1.0_SiKi + isopc(3) ) * ( 1.0_SiKi + isopc(4) ) - m%N4D( 9) = ( 1.0_SiKi + isopc(1) ) * ( 1.0_SiKi - isopc(2) ) * ( 1.0_SiKi - isopc(3) ) * ( 1.0_SiKi - isopc(4) ) - m%N4D(10) = ( 1.0_SiKi + isopc(1) ) * ( 1.0_SiKi - isopc(2) ) * ( 1.0_SiKi - isopc(3) ) * ( 1.0_SiKi + isopc(4) ) - m%N4D(11) = ( 1.0_SiKi + isopc(1) ) * ( 1.0_SiKi - isopc(2) ) * ( 1.0_SiKi + isopc(3) ) * ( 1.0_SiKi - isopc(4) ) - m%N4D(12) = ( 1.0_SiKi + isopc(1) ) * ( 1.0_SiKi - isopc(2) ) * ( 1.0_SiKi + isopc(3) ) * ( 1.0_SiKi + isopc(4) ) - m%N4D(13) = ( 1.0_SiKi + isopc(1) ) * ( 1.0_SiKi + isopc(2) ) * ( 1.0_SiKi - isopc(3) ) * ( 1.0_SiKi - isopc(4) ) - m%N4D(14) = ( 1.0_SiKi + isopc(1) ) * ( 1.0_SiKi + isopc(2) ) * ( 1.0_SiKi - isopc(3) ) * ( 1.0_SiKi + isopc(4) ) - m%N4D(15) = ( 1.0_SiKi + isopc(1) ) * ( 1.0_SiKi + isopc(2) ) * ( 1.0_SiKi + isopc(3) ) * ( 1.0_SiKi - isopc(4) ) - m%N4D(16) = ( 1.0_SiKi + isopc(1) ) * ( 1.0_SiKi + isopc(2) ) * ( 1.0_SiKi + isopc(3) ) * ( 1.0_SiKi + isopc(4) ) - m%N4D = m%N4D / REAL( SIZE(m%N4D), SiKi ) ! normalize - - -END Subroutine SeaSt_Interp_Setup - -!==================================================================================================== -!> This routine interpolates a 4-d dataset. -!! This method is described here: http://rjwagner49.com/Mathematics/Interpolation.pdf -FUNCTION SeaSt_Interp_4D( pKinXX, m, ErrStat, ErrMsg ) - - ! I/O variables - - real(SiKi), intent(in ) :: pKinXX(0:,:,:,:) - TYPE(SeaSt_Interp_MiscVarType), INTENT(IN ) :: m !< Parameters - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - - CHARACTER(*), PARAMETER :: RoutineName = 'SeaSt_Interp_PointSetup' - Real(SiKi) :: SeaSt_Interp_4D - ! Local variables - - REAL(SiKi) :: u(16) ! size 2^n - - - SeaSt_Interp_4D = 0.0_SiKi - ErrStat = ErrID_None - ErrMsg = "" - - !------------------------------------------------------------------------------------------------- - ! interpolate - !------------------------------------------------------------------------------------------------- - - u( 1) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Lo(3), m%Indx_Lo(4) ) - u( 2) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Lo(3), m%Indx_Hi(4) ) - u( 3) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Hi(3), m%Indx_Lo(4) ) - u( 4) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Hi(3), m%Indx_Hi(4) ) - u( 5) = pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Lo(3), m%Indx_Lo(4) ) - u( 6) = pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Lo(3), m%Indx_Hi(4) ) - u( 7) = pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Hi(3), m%Indx_Lo(4) ) - u( 8) = pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Hi(3), m%Indx_Hi(4) ) - u( 9) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Lo(3), m%Indx_Lo(4) ) - u(10) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Lo(3), m%Indx_Hi(4) ) - u(11) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Hi(3), m%Indx_Lo(4) ) - u(12) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Hi(3), m%Indx_Hi(4) ) - u(13) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Lo(3), m%Indx_Lo(4) ) - u(14) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Lo(3), m%Indx_Hi(4) ) - u(15) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Hi(3), m%Indx_Lo(4) ) - u(16) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Hi(3), m%Indx_Hi(4) ) - - SeaSt_Interp_4D = SUM ( m%N4D * u ) - -END FUNCTION SeaSt_Interp_4D - -!==================================================================================================== -!> This routine interpolates a 4-d dataset. -!! This method is described here: http://rjwagner49.com/Mathematics/Interpolation.pdf -FUNCTION SeaSt_Interp_4D_Vec( pKinXX, m, ErrStat, ErrMsg ) - - ! I/O variables - - real(SiKi), intent(in ) :: pKinXX(0:,:,:,:,:) - TYPE(SeaSt_Interp_MiscVarType), INTENT(IN ) :: m !< misc vars for interpolation - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - - CHARACTER(*), PARAMETER :: RoutineName = 'SeaSt_Interp_PointSetup' - Real(SiKi) :: SeaSt_Interp_4D_Vec(3) - ! Local variables - - REAL(SiKi) :: u(16) ! size 2^n - integer(IntKi) :: iDir - - SeaSt_Interp_4D_Vec = 0.0_SiKi - ErrStat = ErrID_None - ErrMsg = "" - - !------------------------------------------------------------------------------------------------- - ! interpolate - !------------------------------------------------------------------------------------------------- - do iDir = 1,3 - u( 1) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Lo(3), m%Indx_Lo(4), iDir ) - u( 2) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Lo(3), m%Indx_Hi(4), iDir ) - u( 3) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Hi(3), m%Indx_Lo(4), iDir ) - u( 4) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Hi(3), m%Indx_Hi(4), iDir ) - u( 5) = pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Lo(3), m%Indx_Lo(4), iDir ) - u( 6) = pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Lo(3), m%Indx_Hi(4), iDir ) - u( 7) = pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Hi(3), m%Indx_Lo(4), iDir ) - u( 8) = pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Hi(3), m%Indx_Hi(4), iDir ) - u( 9) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Lo(3), m%Indx_Lo(4), iDir ) - u(10) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Lo(3), m%Indx_Hi(4), iDir ) - u(11) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Hi(3), m%Indx_Lo(4), iDir ) - u(12) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Hi(3), m%Indx_Hi(4), iDir ) - u(13) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Lo(3), m%Indx_Lo(4), iDir ) - u(14) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Lo(3), m%Indx_Hi(4), iDir ) - u(15) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Hi(3), m%Indx_Lo(4), iDir ) - u(16) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Hi(3), m%Indx_Hi(4), iDir ) - - SeaSt_Interp_4D_Vec(iDir) = SUM ( m%N4D * u ) - end do -END FUNCTION SeaSt_Interp_4D_Vec - - !==================================================================================================== -!> This routine interpolates a 3-d dataset with index 1 = time (zero-based indexing), 2 = x-coordinate (1-based indexing), 3 = y-coordinate (1-based indexing) -!! This method is described here: http://rjwagner49.com/Mathematics/Interpolation.pdf -FUNCTION SeaSt_Interp_3D( Time, Position, pKinXX, p, FirstWarn_Clamp, ErrStat, ErrMsg ) - - ! I/O variables - REAL(DbKi), INTENT(IN ) :: Time !< time from the start of the simulation - REAL(ReKi), INTENT(IN ) :: Position(2) !< Array of XYZ coordinates, 3 - real(SiKi), intent(in ) :: pKinXX(0:,:,:) !< 3D Wave elevation data (SiKi for storage space reasons) - TYPE(SeaSt_Interp_ParameterType), INTENT(IN ) :: p !< Parameters - logical, INTENT(INOUT) :: FirstWarn_Clamp !< first warning - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - - CHARACTER(*), PARAMETER :: RoutineName = 'SeaSt_Interp_3D' - Real(SiKi) :: SeaSt_Interp_3D - ! Local variables - - REAL(SiKi) :: u(8) ! size 2^n - real(ReKi) :: N3D(8) - integer(IntKi) :: Indx_Lo(3), Indx_Hi(3) - INTEGER(IntKi) :: i ! loop counter - REAL(SiKi) :: isopc(3) ! isoparametric coordinates - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - - SeaSt_Interp_3D = 0.0_SiKi - ErrStat = ErrID_None - ErrMsg = "" - - !------------------------------------------------------------------------------------------------- - ! Find the bounding indices for time - !------------------------------------------------------------------------------------------------- - call SetTimeIndex(Time, p%delta(1), p%n(1), Indx_Lo(1), Indx_Hi(1), isopc(1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) !warning if time is outside the bounds - if (ErrStat >= AbortErrLev ) return - - !------------------------------------------------------------------------------------------------- - ! Find the bounding indices for XY position - !------------------------------------------------------------------------------------------------- - do i=2,3 - call SetCartesianXYIndex(Position(i-1), p%pZero(i), p%delta(i), p%n(i), Indx_Lo(i), Indx_Hi(i), isopc(i), FirstWarn_Clamp, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) !warning if x,y is outside the bounds - end do - if (ErrStat >= AbortErrLev ) return - - - - N3D(1) = ( 1.0_ReKi + isopc(1) )*( 1.0_ReKi - isopc(2) )*( 1.0_ReKi - isopc(3) ) - N3D(2) = ( 1.0_ReKi + isopc(1) )*( 1.0_ReKi + isopc(2) )*( 1.0_ReKi - isopc(3) ) - N3D(3) = ( 1.0_ReKi - isopc(1) )*( 1.0_ReKi + isopc(2) )*( 1.0_ReKi - isopc(3) ) - N3D(4) = ( 1.0_ReKi - isopc(1) )*( 1.0_ReKi - isopc(2) )*( 1.0_ReKi - isopc(3) ) - N3D(5) = ( 1.0_ReKi + isopc(1) )*( 1.0_ReKi - isopc(2) )*( 1.0_ReKi + isopc(3) ) - N3D(6) = ( 1.0_ReKi + isopc(1) )*( 1.0_ReKi + isopc(2) )*( 1.0_ReKi + isopc(3) ) - N3D(7) = ( 1.0_ReKi - isopc(1) )*( 1.0_ReKi + isopc(2) )*( 1.0_ReKi + isopc(3) ) - N3D(8) = ( 1.0_ReKi - isopc(1) )*( 1.0_ReKi - isopc(2) )*( 1.0_ReKi + isopc(3) ) - N3D = N3D / REAL( SIZE(N3D), ReKi ) ! normalize - - !------------------------------------------------------------------------------------------------- - ! interpolate - !------------------------------------------------------------------------------------------------- - - u(1) = pKinXX( Indx_Hi(1), Indx_Lo(2), Indx_Lo(3) ) - u(2) = pKinXX( Indx_Hi(1), Indx_Hi(2), Indx_Lo(3) ) - u(3) = pKinXX( Indx_Lo(1), Indx_Hi(2), Indx_Lo(3) ) - u(4) = pKinXX( Indx_Lo(1), Indx_Lo(2), Indx_Lo(3) ) - u(5) = pKinXX( Indx_Hi(1), Indx_Lo(2), Indx_Hi(3) ) - u(6) = pKinXX( Indx_Hi(1), Indx_Hi(2), Indx_Hi(3) ) - u(7) = pKinXX( Indx_Lo(1), Indx_Hi(2), Indx_Hi(3) ) - u(8) = pKinXX( Indx_Lo(1), Indx_Lo(2), Indx_Hi(3) ) - - SeaSt_Interp_3D = SUM ( N3D * u ) - -END FUNCTION SeaSt_Interp_3D - -FUNCTION SeaSt_Interp_3D_VEC ( Time, Position, pKinXX, p, FirstWarn_Clamp, ErrStat, ErrMsg ) - ! I/O variables - REAL(DbKi), INTENT(IN ) :: Time !< time from the start of the simulation - REAL(ReKi), INTENT(IN ) :: Position(2) !< Array of XYZ coordinates, 3 - real(SiKi), INTENT(in ) :: pKinXX(0:,:,:,:) !< 3D Wave excitation data (SiKi for storage space reasons) - TYPE(SeaSt_Interp_ParameterType), INTENT(IN ) :: p !< Parameters - LOGICAL, INTENT(INOUT) :: FirstWarn_Clamp !< first warning - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - - CHARACTER(*), PARAMETER :: RoutineName = 'SeaSt_Interp_3D_VEC' - Real(SiKi) :: SeaSt_Interp_3D_VEC(3) - ! Local variables - - REAL(SiKi) :: u(8) ! size 2^n - real(ReKi) :: N3D(8) - integer(IntKi) :: Indx_Lo(3), Indx_Hi(3) - INTEGER(IntKi) :: i ! loop counter - REAL(SiKi) :: isopc(3) ! isoparametric coordinates - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - - SeaSt_Interp_3D_VEC = 0.0_SiKi - ErrStat = ErrID_None - ErrMsg = "" - - !------------------------------------------------------------------------------------------------- - ! Find the bounding indices for time - !------------------------------------------------------------------------------------------------- - call SetTimeIndex(Time, p%delta(1), p%n(1), Indx_Lo(1), Indx_Hi(1), isopc(1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) !warning if time is outside the bounds - if (ErrStat >= AbortErrLev ) return - - !------------------------------------------------------------------------------------------------- - ! Find the bounding indices for XY position - !------------------------------------------------------------------------------------------------- - do i=2,3 - call SetCartesianXYIndex(Position(i-1), p%pZero(i), p%delta(i), p%n(i), Indx_Lo(i), Indx_Hi(i), isopc(i), FirstWarn_Clamp, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) !warning if x,y is outside the bounds - end do - if (ErrStat >= AbortErrLev ) return - - - - N3D(1) = ( 1.0_ReKi + isopc(1) )*( 1.0_ReKi - isopc(2) )*( 1.0_ReKi - isopc(3) ) - N3D(2) = ( 1.0_ReKi + isopc(1) )*( 1.0_ReKi + isopc(2) )*( 1.0_ReKi - isopc(3) ) - N3D(3) = ( 1.0_ReKi - isopc(1) )*( 1.0_ReKi + isopc(2) )*( 1.0_ReKi - isopc(3) ) - N3D(4) = ( 1.0_ReKi - isopc(1) )*( 1.0_ReKi - isopc(2) )*( 1.0_ReKi - isopc(3) ) - N3D(5) = ( 1.0_ReKi + isopc(1) )*( 1.0_ReKi - isopc(2) )*( 1.0_ReKi + isopc(3) ) - N3D(6) = ( 1.0_ReKi + isopc(1) )*( 1.0_ReKi + isopc(2) )*( 1.0_ReKi + isopc(3) ) - N3D(7) = ( 1.0_ReKi - isopc(1) )*( 1.0_ReKi + isopc(2) )*( 1.0_ReKi + isopc(3) ) - N3D(8) = ( 1.0_ReKi - isopc(1) )*( 1.0_ReKi - isopc(2) )*( 1.0_ReKi + isopc(3) ) - N3D = N3D / REAL( SIZE(N3D), ReKi ) ! normalize - - !------------------------------------------------------------------------------------------------- - ! interpolate - !------------------------------------------------------------------------------------------------- - do i = 1,3 - u(1) = pKinXX( Indx_Hi(1), Indx_Lo(2), Indx_Lo(3), i ) - u(2) = pKinXX( Indx_Hi(1), Indx_Hi(2), Indx_Lo(3), i ) - u(3) = pKinXX( Indx_Lo(1), Indx_Hi(2), Indx_Lo(3), i ) - u(4) = pKinXX( Indx_Lo(1), Indx_Lo(2), Indx_Lo(3), i ) - u(5) = pKinXX( Indx_Hi(1), Indx_Lo(2), Indx_Hi(3), i ) - u(6) = pKinXX( Indx_Hi(1), Indx_Hi(2), Indx_Hi(3), i ) - u(7) = pKinXX( Indx_Lo(1), Indx_Hi(2), Indx_Hi(3), i ) - u(8) = pKinXX( Indx_Lo(1), Indx_Lo(2), Indx_Hi(3), i ) - - SeaSt_Interp_3D_VEC(i) = SUM ( N3D * u ) - end do -END FUNCTION SeaSt_Interp_3D_VEC - -FUNCTION SeaSt_Interp_3D_VEC6 ( Time, Position, pKinXX, p, FirstWarn_Clamp, ErrStat, ErrMsg ) - ! I/O variables - REAL(DbKi), INTENT(IN ) :: Time !< time from the start of the simulation - REAL(ReKi), INTENT(IN ) :: Position(2) !< Array of XYZ coordinates, 3 - real(SiKi), INTENT(in ) :: pKinXX(0:,:,:,:) !< 3D Wave excitation data (SiKi for storage space reasons) - TYPE(SeaSt_Interp_ParameterType), INTENT(IN ) :: p !< Parameters - LOGICAL, INTENT(INOUT) :: FirstWarn_Clamp !< first warning - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - - CHARACTER(*), PARAMETER :: RoutineName = 'SeaSt_Interp_3D' - Real(SiKi) :: SeaSt_Interp_3D_VEC6(6) - ! Local variables - - REAL(SiKi) :: u(8) ! size 2^n - real(ReKi) :: N3D(8) - integer(IntKi) :: Indx_Lo(3), Indx_Hi(3) - INTEGER(IntKi) :: i ! loop counter - REAL(SiKi) :: isopc(3) ! isoparametric coordinates - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - - SeaSt_Interp_3D_VEC6 = 0.0_SiKi - ErrStat = ErrID_None - ErrMsg = "" - - !------------------------------------------------------------------------------------------------- - ! Find the bounding indices for time - !------------------------------------------------------------------------------------------------- - call SetTimeIndex(Time, p%delta(1), p%n(1), Indx_Lo(1), Indx_Hi(1), isopc(1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) !warning if time is outside the bounds - if (ErrStat >= AbortErrLev ) return - - !------------------------------------------------------------------------------------------------- - ! Find the bounding indices for XY position - !------------------------------------------------------------------------------------------------- - do i=2,3 - call SetCartesianXYIndex(Position(i-1), p%pZero(i), p%delta(i), p%n(i), Indx_Lo(i), Indx_Hi(i), isopc(i), FirstWarn_Clamp, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) !warning if x,y is outside the bounds - end do - if (ErrStat >= AbortErrLev ) return - - - - N3D(1) = ( 1.0_ReKi + isopc(1) )*( 1.0_ReKi - isopc(2) )*( 1.0_ReKi - isopc(3) ) - N3D(2) = ( 1.0_ReKi + isopc(1) )*( 1.0_ReKi + isopc(2) )*( 1.0_ReKi - isopc(3) ) - N3D(3) = ( 1.0_ReKi - isopc(1) )*( 1.0_ReKi + isopc(2) )*( 1.0_ReKi - isopc(3) ) - N3D(4) = ( 1.0_ReKi - isopc(1) )*( 1.0_ReKi - isopc(2) )*( 1.0_ReKi - isopc(3) ) - N3D(5) = ( 1.0_ReKi + isopc(1) )*( 1.0_ReKi - isopc(2) )*( 1.0_ReKi + isopc(3) ) - N3D(6) = ( 1.0_ReKi + isopc(1) )*( 1.0_ReKi + isopc(2) )*( 1.0_ReKi + isopc(3) ) - N3D(7) = ( 1.0_ReKi - isopc(1) )*( 1.0_ReKi + isopc(2) )*( 1.0_ReKi + isopc(3) ) - N3D(8) = ( 1.0_ReKi - isopc(1) )*( 1.0_ReKi - isopc(2) )*( 1.0_ReKi + isopc(3) ) - N3D = N3D / REAL( SIZE(N3D), ReKi ) ! normalize - - !------------------------------------------------------------------------------------------------- - ! interpolate - !------------------------------------------------------------------------------------------------- - do i = 1,6 - u(1) = pKinXX( Indx_Hi(1), Indx_Lo(2), Indx_Lo(3), i ) - u(2) = pKinXX( Indx_Hi(1), Indx_Hi(2), Indx_Lo(3), i ) - u(3) = pKinXX( Indx_Lo(1), Indx_Hi(2), Indx_Lo(3), i ) - u(4) = pKinXX( Indx_Lo(1), Indx_Lo(2), Indx_Lo(3), i ) - u(5) = pKinXX( Indx_Hi(1), Indx_Lo(2), Indx_Hi(3), i ) - u(6) = pKinXX( Indx_Hi(1), Indx_Hi(2), Indx_Hi(3), i ) - u(7) = pKinXX( Indx_Lo(1), Indx_Hi(2), Indx_Hi(3), i ) - u(8) = pKinXX( Indx_Lo(1), Indx_Lo(2), Indx_Hi(3), i ) - - SeaSt_Interp_3D_VEC6(i) = SUM ( N3D * u ) - end do -END FUNCTION SeaSt_Interp_3D_VEC6 -!---------------------------------------------------------------------------------------------------- -!> This routine deallocates any memory in the FDext module. -SUBROUTINE SeaSt_Interp_End( ParamData, MiscVars, ErrStat, ErrMsg) - - - IMPLICIT NONE - - CHARACTER(*), PARAMETER :: RoutineName="SeaSt_Interp_End" - - - ! Passed Variables - TYPE(SeaSt_Interp_ParameterType), INTENT(INOUT) :: ParamData !< Parameters - TYPE(SeaSt_Interp_MiscVarType), INTENT(INOUT) :: MiscVars !< Misc variables for optimization (not copied in glue code) - - - ! Error Handling - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< determines if an error has been encountered - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Message about errors - - - ! Local Variables - INTEGER(IntKi) :: TmpErrStat ! temporary error status - CHARACTER(ErrMsgLen) :: TmpErrMsg ! temporary error message - - - ErrMsg = '' - ErrStat = ErrID_None - - - - ! Destroy parameter data - - CALL SeaSt_Interp_DestroyParam( ParamData, TmpErrStat, TmpErrMsg ) - CALL SetErrStat( TmpErrStat, TmpErrMsg, ErrStat, ErrMsg, RoutineName ) - - - ! Destroy the misc data - - CALL SeaSt_Interp_DestroyMisc( MiscVars, TmpErrStat, TmpErrMsg ) - CALL SetErrStat( TmpErrStat, TmpErrMsg, ErrStat, ErrMsg, RoutineName ) - - -END SUBROUTINE SeaSt_Interp_End -!==================================================================================================== -END MODULE SeaState_Interp diff --git a/modules/seastate/src/SeaState_Interp.txt b/modules/seastate/src/SeaState_Interp.txt deleted file mode 100644 index 5f12cd5a6a..0000000000 --- a/modules/seastate/src/SeaState_Interp.txt +++ /dev/null @@ -1,42 +0,0 @@ -################################################################################################################################### -# Registry for SeaState_Interp, creates MODULE SeaState_Interp_Types -# Module SeaState_Interp_Types contains all of the user-defined types needed in SeaState_Interp. It also contains copy, destroy, pack, and -# unpack routines associated with each defined data types. -################################################################################################################################### -# Entries are of the form -# keyword -################################################################################################################################### - -include Registry_NWTC_Library.txt - - -######################### - -typedef SeaState_Interp/SeaSt_Interp InitInputType IntKi n 4 - - "number of grid points in the t, x, y, and z directions" - -typedef ^ InitInputType ReKi delta 4 - - "size between 2 consecutive grid points in each grid direction (time, x, y, z)" "s,m,m,m" -typedef ^ InitInputType ReKi pZero 4 - - "fixed position of the time-X-Y-Z grid (i.e., XYZ coordinates of m%V(:,1,1,1,:))" "m" -typedef ^ InitInputType ReKi Z_Depth - - - "grid depth" m - -# Init Output -typedef ^ InitOutputType ProgDesc Ver - - - "Version information of this submodule" - - - -# ..... Misc/Optimization variables................................................................................................. -# Define any data that are used only for efficiency purposes (these variables are not associated with time): -# e.g. indices for searching in an array, large arrays that are local variables in any routine called multiple times, etc. -typedef ^ MiscVarType SiKi N3D {8} - - "this is the weighting function for 3-d velocity field" - -typedef ^ MiscVarType SiKi N4D {16} - - "this is the weighting function for 4-d velocity field" - -typedef ^ MiscVarType integer Indx_Lo 4 - - "this is the index into the 4-d velocity field for each wave component" - -typedef ^ MiscVarType integer Indx_Hi 4 - - "this is the index into the 4-d velocity field for each wave component" - -typedef ^ MiscVarType logical FirstWarn_Clamp - .true. - "used to avoid too many 'Position has been clamped to the grid boundary' warning messages " - - -# ..... Parameters ................................................................................................................ -# Define parameters here: -# Time step for integration of continuous states (if a fixed-step integrator is used) and update of discrete states: -typedef ^ ParameterType IntKi n 4 - - "number of evenly-spaced grid points in the t, x, y, and z directions" - -typedef ^ ParameterType ReKi delta 4 - - "size between 2 consecutive grid points in each grid direction" "s,m,m,m" -typedef ^ ParameterType ReKi pZero 4 - - "fixed position of the XYZ grid (i.e., XYZ coordinates of m%V(:,1,1,1,:))" "m" -typedef ^ ParameterType ReKi Z_Depth - - - "grid depth" m - - - diff --git a/modules/seastate/src/SeaState_Interp_Types.f90 b/modules/seastate/src/SeaState_Interp_Types.f90 deleted file mode 100644 index 3322b030fc..0000000000 --- a/modules/seastate/src/SeaState_Interp_Types.f90 +++ /dev/null @@ -1,258 +0,0 @@ -!STARTOFREGISTRYGENERATEDFILE 'SeaState_Interp_Types.f90' -! -! WARNING This file is generated automatically by the FAST registry. -! Do not edit. Your changes to this file will be lost. -! -! FAST Registry -!********************************************************************************************************************************* -! SeaState_Interp_Types -!................................................................................................................................. -! This file is part of SeaState_Interp. -! -! Copyright (C) 2012-2016 National Renewable Energy Laboratory -! -! Licensed under the Apache License, Version 2.0 (the "License"); -! you may not use this file except in compliance with the License. -! You may obtain a copy of the License at -! -! http://www.apache.org/licenses/LICENSE-2.0 -! -! Unless required by applicable law or agreed to in writing, software -! distributed under the License is distributed on an "AS IS" BASIS, -! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -! See the License for the specific language governing permissions and -! limitations under the License. -! -! -! W A R N I N G : This file was automatically generated from the FAST registry. Changes made to this file may be lost. -! -!********************************************************************************************************************************* -!> This module contains the user-defined types needed in SeaState_Interp. It also contains copy, destroy, pack, and -!! unpack routines associated with each defined data type. This code is automatically generated by the FAST Registry. -MODULE SeaState_Interp_Types -!--------------------------------------------------------------------------------------------------------------------------------- -USE NWTC_Library -IMPLICIT NONE -! ========= SeaSt_Interp_InitInputType ======= - TYPE, PUBLIC :: SeaSt_Interp_InitInputType - INTEGER(IntKi) , DIMENSION(1:4) :: n = 0_IntKi !< number of grid points in the t, x, y, and z directions [-] - REAL(ReKi) , DIMENSION(1:4) :: delta = 0.0_ReKi !< size between 2 consecutive grid points in each grid direction (time, x, y, z) [s,m,m,m] - REAL(ReKi) , DIMENSION(1:4) :: pZero = 0.0_ReKi !< fixed position of the time-X-Y-Z grid (i.e., XYZ coordinates of m%V(:,1,1,1,:)) [m] - REAL(ReKi) :: Z_Depth = 0.0_ReKi !< grid depth [m] - END TYPE SeaSt_Interp_InitInputType -! ======================= -! ========= SeaSt_Interp_InitOutputType ======= - TYPE, PUBLIC :: SeaSt_Interp_InitOutputType - TYPE(ProgDesc) :: Ver !< Version information of this submodule [-] - END TYPE SeaSt_Interp_InitOutputType -! ======================= -! ========= SeaSt_Interp_MiscVarType ======= - TYPE, PUBLIC :: SeaSt_Interp_MiscVarType - REAL(SiKi) , DIMENSION(1:8) :: N3D = 0.0_R4Ki !< this is the weighting function for 3-d velocity field [-] - REAL(SiKi) , DIMENSION(1:16) :: N4D = 0.0_R4Ki !< this is the weighting function for 4-d velocity field [-] - INTEGER(IntKi) , DIMENSION(1:4) :: Indx_Lo = 0_IntKi !< this is the index into the 4-d velocity field for each wave component [-] - INTEGER(IntKi) , DIMENSION(1:4) :: Indx_Hi = 0_IntKi !< this is the index into the 4-d velocity field for each wave component [-] - LOGICAL :: FirstWarn_Clamp = .true. !< used to avoid too many 'Position has been clamped to the grid boundary' warning messages [-] - END TYPE SeaSt_Interp_MiscVarType -! ======================= -! ========= SeaSt_Interp_ParameterType ======= - TYPE, PUBLIC :: SeaSt_Interp_ParameterType - INTEGER(IntKi) , DIMENSION(1:4) :: n = 0_IntKi !< number of evenly-spaced grid points in the t, x, y, and z directions [-] - REAL(ReKi) , DIMENSION(1:4) :: delta = 0.0_ReKi !< size between 2 consecutive grid points in each grid direction [s,m,m,m] - REAL(ReKi) , DIMENSION(1:4) :: pZero = 0.0_ReKi !< fixed position of the XYZ grid (i.e., XYZ coordinates of m%V(:,1,1,1,:)) [m] - REAL(ReKi) :: Z_Depth = 0.0_ReKi !< grid depth [m] - END TYPE SeaSt_Interp_ParameterType -! ======================= -CONTAINS - -subroutine SeaSt_Interp_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) - type(SeaSt_Interp_InitInputType), intent(in) :: SrcInitInputData - type(SeaSt_Interp_InitInputType), intent(inout) :: DstInitInputData - integer(IntKi), intent(in ) :: CtrlCode - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - character(*), parameter :: RoutineName = 'SeaSt_Interp_CopyInitInput' - ErrStat = ErrID_None - ErrMsg = '' - DstInitInputData%n = SrcInitInputData%n - DstInitInputData%delta = SrcInitInputData%delta - DstInitInputData%pZero = SrcInitInputData%pZero - DstInitInputData%Z_Depth = SrcInitInputData%Z_Depth -end subroutine - -subroutine SeaSt_Interp_DestroyInitInput(InitInputData, ErrStat, ErrMsg) - type(SeaSt_Interp_InitInputType), intent(inout) :: InitInputData - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - character(*), parameter :: RoutineName = 'SeaSt_Interp_DestroyInitInput' - ErrStat = ErrID_None - ErrMsg = '' -end subroutine - -subroutine SeaSt_Interp_PackInitInput(RF, Indata) - type(RegFile), intent(inout) :: RF - type(SeaSt_Interp_InitInputType), intent(in) :: InData - character(*), parameter :: RoutineName = 'SeaSt_Interp_PackInitInput' - if (RF%ErrStat >= AbortErrLev) return - call RegPack(RF, InData%n) - call RegPack(RF, InData%delta) - call RegPack(RF, InData%pZero) - call RegPack(RF, InData%Z_Depth) - if (RegCheckErr(RF, RoutineName)) return -end subroutine - -subroutine SeaSt_Interp_UnPackInitInput(RF, OutData) - type(RegFile), intent(inout) :: RF - type(SeaSt_Interp_InitInputType), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'SeaSt_Interp_UnPackInitInput' - if (RF%ErrStat /= ErrID_None) return - call RegUnpack(RF, OutData%n); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%delta); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%pZero); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%Z_Depth); if (RegCheckErr(RF, RoutineName)) return -end subroutine - -subroutine SeaSt_Interp_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) - type(SeaSt_Interp_InitOutputType), intent(in) :: SrcInitOutputData - type(SeaSt_Interp_InitOutputType), intent(inout) :: DstInitOutputData - integer(IntKi), intent(in ) :: CtrlCode - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'SeaSt_Interp_CopyInitOutput' - ErrStat = ErrID_None - ErrMsg = '' - call NWTC_Library_CopyProgDesc(SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return -end subroutine - -subroutine SeaSt_Interp_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) - type(SeaSt_Interp_InitOutputType), intent(inout) :: InitOutputData - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'SeaSt_Interp_DestroyInitOutput' - ErrStat = ErrID_None - ErrMsg = '' - call NWTC_Library_DestroyProgDesc(InitOutputData%Ver, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -end subroutine - -subroutine SeaSt_Interp_PackInitOutput(RF, Indata) - type(RegFile), intent(inout) :: RF - type(SeaSt_Interp_InitOutputType), intent(in) :: InData - character(*), parameter :: RoutineName = 'SeaSt_Interp_PackInitOutput' - if (RF%ErrStat >= AbortErrLev) return - call NWTC_Library_PackProgDesc(RF, InData%Ver) - if (RegCheckErr(RF, RoutineName)) return -end subroutine - -subroutine SeaSt_Interp_UnPackInitOutput(RF, OutData) - type(RegFile), intent(inout) :: RF - type(SeaSt_Interp_InitOutputType), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'SeaSt_Interp_UnPackInitOutput' - if (RF%ErrStat /= ErrID_None) return - call NWTC_Library_UnpackProgDesc(RF, OutData%Ver) ! Ver -end subroutine - -subroutine SeaSt_Interp_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) - type(SeaSt_Interp_MiscVarType), intent(in) :: SrcMiscData - type(SeaSt_Interp_MiscVarType), intent(inout) :: DstMiscData - integer(IntKi), intent(in ) :: CtrlCode - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - character(*), parameter :: RoutineName = 'SeaSt_Interp_CopyMisc' - ErrStat = ErrID_None - ErrMsg = '' - DstMiscData%N3D = SrcMiscData%N3D - DstMiscData%N4D = SrcMiscData%N4D - DstMiscData%Indx_Lo = SrcMiscData%Indx_Lo - DstMiscData%Indx_Hi = SrcMiscData%Indx_Hi - DstMiscData%FirstWarn_Clamp = SrcMiscData%FirstWarn_Clamp -end subroutine - -subroutine SeaSt_Interp_DestroyMisc(MiscData, ErrStat, ErrMsg) - type(SeaSt_Interp_MiscVarType), intent(inout) :: MiscData - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - character(*), parameter :: RoutineName = 'SeaSt_Interp_DestroyMisc' - ErrStat = ErrID_None - ErrMsg = '' -end subroutine - -subroutine SeaSt_Interp_PackMisc(RF, Indata) - type(RegFile), intent(inout) :: RF - type(SeaSt_Interp_MiscVarType), intent(in) :: InData - character(*), parameter :: RoutineName = 'SeaSt_Interp_PackMisc' - if (RF%ErrStat >= AbortErrLev) return - call RegPack(RF, InData%N3D) - call RegPack(RF, InData%N4D) - call RegPack(RF, InData%Indx_Lo) - call RegPack(RF, InData%Indx_Hi) - call RegPack(RF, InData%FirstWarn_Clamp) - if (RegCheckErr(RF, RoutineName)) return -end subroutine - -subroutine SeaSt_Interp_UnPackMisc(RF, OutData) - type(RegFile), intent(inout) :: RF - type(SeaSt_Interp_MiscVarType), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'SeaSt_Interp_UnPackMisc' - if (RF%ErrStat /= ErrID_None) return - call RegUnpack(RF, OutData%N3D); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%N4D); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%Indx_Lo); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%Indx_Hi); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%FirstWarn_Clamp); if (RegCheckErr(RF, RoutineName)) return -end subroutine - -subroutine SeaSt_Interp_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) - type(SeaSt_Interp_ParameterType), intent(in) :: SrcParamData - type(SeaSt_Interp_ParameterType), intent(inout) :: DstParamData - integer(IntKi), intent(in ) :: CtrlCode - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - character(*), parameter :: RoutineName = 'SeaSt_Interp_CopyParam' - ErrStat = ErrID_None - ErrMsg = '' - DstParamData%n = SrcParamData%n - DstParamData%delta = SrcParamData%delta - DstParamData%pZero = SrcParamData%pZero - DstParamData%Z_Depth = SrcParamData%Z_Depth -end subroutine - -subroutine SeaSt_Interp_DestroyParam(ParamData, ErrStat, ErrMsg) - type(SeaSt_Interp_ParameterType), intent(inout) :: ParamData - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - character(*), parameter :: RoutineName = 'SeaSt_Interp_DestroyParam' - ErrStat = ErrID_None - ErrMsg = '' -end subroutine - -subroutine SeaSt_Interp_PackParam(RF, Indata) - type(RegFile), intent(inout) :: RF - type(SeaSt_Interp_ParameterType), intent(in) :: InData - character(*), parameter :: RoutineName = 'SeaSt_Interp_PackParam' - if (RF%ErrStat >= AbortErrLev) return - call RegPack(RF, InData%n) - call RegPack(RF, InData%delta) - call RegPack(RF, InData%pZero) - call RegPack(RF, InData%Z_Depth) - if (RegCheckErr(RF, RoutineName)) return -end subroutine - -subroutine SeaSt_Interp_UnPackParam(RF, OutData) - type(RegFile), intent(inout) :: RF - type(SeaSt_Interp_ParameterType), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'SeaSt_Interp_UnPackParam' - if (RF%ErrStat /= ErrID_None) return - call RegUnpack(RF, OutData%n); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%delta); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%pZero); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%Z_Depth); if (RegCheckErr(RF, RoutineName)) return -end subroutine -END MODULE SeaState_Interp_Types -!ENDOFREGISTRYGENERATEDFILE diff --git a/modules/seastate/src/SeaState_Output.f90 b/modules/seastate/src/SeaState_Output.f90 index b18e2c2726..55f529f490 100644 --- a/modules/seastate/src/SeaState_Output.f90 +++ b/modules/seastate/src/SeaState_Output.f90 @@ -273,7 +273,7 @@ SUBROUTINE SeaStOut_WriteWvKinFiles( Rootname, SeaSt_Prog, WaveField, WaveDT, X_ y_gridPts(i+1) = -Y_HalfWidth + deltaGrid(2)*i end do do i = 0, NGrid(3)-1 - z_gridPts(i+1) = - ( 1.0 - cos( real((NGrid(3) - 1) - i, ReKi) * deltaGrid(3) ) ) * WaveField%SeaSt_Interp_p%Z_Depth + z_gridPts(i+1) = - ( 1.0 - cos( real((NGrid(3) - 1) - i, ReKi) * deltaGrid(3) ) ) * WaveField%GridParams%Z_Depth end do ! Write the increments from [0, NStepWave] even though for OpenFAST data, NStepWave = 0, but for arbitrary user data this may not be true. diff --git a/modules/seastate/src/SeaState_Types.f90 b/modules/seastate/src/SeaState_Types.f90 index f2807fdb04..8f87fc33c4 100644 --- a/modules/seastate/src/SeaState_Types.f90 +++ b/modules/seastate/src/SeaState_Types.f90 @@ -34,7 +34,6 @@ MODULE SeaState_Types USE Current_Types USE Waves_Types USE Waves2_Types -USE SeaState_Interp_Types USE SeaSt_WaveField_Types USE NWTC_Library IMPLICIT NONE @@ -142,7 +141,7 @@ MODULE SeaState_Types INTEGER(IntKi) :: Decimate = 0_IntKi !< The output decimation counter [-] 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(SeaSt_Interp_MiscVarType) :: SeaSt_Interp_m !< misc var information from the SeaState Interpolation module [-] + TYPE(SeaSt_WaveField_MiscVarType) :: WaveField_m !< misc var information from the SeaState Interpolation module [-] END TYPE SeaSt_MiscVarType ! ======================= ! ========= SeaSt_ParameterType ======= @@ -874,7 +873,7 @@ subroutine SeaSt_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%Decimate = SrcMiscData%Decimate DstMiscData%LastOutTime = SrcMiscData%LastOutTime DstMiscData%LastIndWave = SrcMiscData%LastIndWave - call SeaSt_Interp_CopyMisc(SrcMiscData%SeaSt_Interp_m, DstMiscData%SeaSt_Interp_m, CtrlCode, ErrStat2, ErrMsg2) + call SeaSt_WaveField_CopyMisc(SrcMiscData%WaveField_m, DstMiscData%WaveField_m, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end subroutine @@ -888,7 +887,7 @@ subroutine SeaSt_DestroyMisc(MiscData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'SeaSt_DestroyMisc' ErrStat = ErrID_None ErrMsg = '' - call SeaSt_Interp_DestroyMisc(MiscData%SeaSt_Interp_m, ErrStat2, ErrMsg2) + call SeaSt_WaveField_DestroyMisc(MiscData%WaveField_m, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine @@ -900,7 +899,7 @@ subroutine SeaSt_PackMisc(RF, Indata) call RegPack(RF, InData%Decimate) call RegPack(RF, InData%LastOutTime) call RegPack(RF, InData%LastIndWave) - call SeaSt_Interp_PackMisc(RF, InData%SeaSt_Interp_m) + call SeaSt_WaveField_PackMisc(RF, InData%WaveField_m) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -912,7 +911,7 @@ subroutine SeaSt_UnPackMisc(RF, OutData) 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 SeaSt_Interp_UnpackMisc(RF, OutData%SeaSt_Interp_m) ! SeaSt_Interp_m + call SeaSt_WaveField_UnpackMisc(RF, OutData%WaveField_m) ! WaveField_m end subroutine subroutine SeaSt_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) diff --git a/modules/seastate/src/Waves.f90 b/modules/seastate/src/Waves.f90 index fd1efff906..15998ac18f 100644 --- a/modules/seastate/src/Waves.f90 +++ b/modules/seastate/src/Waves.f90 @@ -585,34 +585,33 @@ SUBROUTINE StillWaterWaves_Init ( InitInp, InitOut, WaveField, ErrStat, ErrMsg ) ! Initialize everything to zero: - !>>>>>> COMPUTE INITOUT SCALARS WaveField%NStepWave, WaveField%NStepWave2, InitOut%WaveTMax, and InitOut%WaveDOmega for WAVEMOD = 0 (WaveMod_None) - WaveField%NStepWave = 2 ! We must have at least two elements in order to interpolate later on - WaveField%NStepWave2 = 1 - InitOut%WaveTMax = InitInp%WaveTMax - WaveField%WaveDOmega = 0.0 - - ! >>> Allocate and initialize (set to 0) InitOut arrays - call Initial_InitOut_Arrays(InitOut, WaveField, InitInp, 1.0_DbKi, ErrStatTmp, ErrMsgTmp); CALL SetErrStat(ErrStatTmp,ErrMsgTmp, ErrStat,ErrMsg,RoutineName) - !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< - - IF ( ErrStat >= AbortErrLev ) RETURN - - - ! Add the current velocities to the wave velocities: - count = 0 - - !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) - count = count + 1 - WaveField%WaveVel(:,i,j,k,1) = InitInp%CurrVxi(count) ! xi-direction - WaveField%WaveVel(:,i,j,k,2) = InitInp%CurrVyi(count) ! yi-direction - end do + !>>>>>> COMPUTE INITOUT SCALARS WaveField%NStepWave, WaveField%NStepWave2, InitOut%WaveTMax, and InitOut%WaveDOmega for WAVEMOD = 0 (WaveMod_None) + WaveField%NStepWave = 2 ! We must have at least two elements in order to interpolate later on + WaveField%NStepWave2 = 1 + InitOut%WaveTMax = InitInp%WaveTMax + WaveField%WaveDOmega = 0.0 + + ! >>> Allocate and initialize (set to 0) InitOut arrays + call Initial_InitOut_Arrays(InitOut, WaveField, InitInp, 1.0_DbKi, ErrStatTmp, ErrMsgTmp) + CALL SetErrStat(ErrStatTmp,ErrMsgTmp, ErrStat,ErrMsg,RoutineName) + IF ( ErrStat >= AbortErrLev ) RETURN + + + ! Add the current velocities to the wave velocities: + count = 0 + + !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) + count = count + 1 + WaveField%WaveVel(:,i,j,k,1) = InitInp%CurrVxi(count) ! xi-direction + WaveField%WaveVel(:,i,j,k,2) = InitInp%CurrVyi(count) ! yi-direction end do end do + end do - ! END DO ! J - All points where the incident wave kinematics will be computed + ! END DO ! J - All points where the incident wave kinematics will be computed END SUBROUTINE StillWaterWaves_Init @@ -629,8 +628,6 @@ SUBROUTINE VariousWaves_Init ( InitInp, InitOut, WaveField, ErrStat, ErrMsg ) INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None - - ! Local Variables COMPLEX(SiKi) :: ImagOmega ! = ImagNmbr*Omega (rad/s) COMPLEX(SiKi), ALLOCATABLE :: PWaveAccC0HxiPz0(:,:) ! Partial derivative of WaveAccC0Hxi(:) with respect to zi at zi = 0 (1/s^2) @@ -714,377 +711,259 @@ SUBROUTINE VariousWaves_Init ( InitInp, InitOut, WaveField, ErrStat, ErrMsg ) ErrStat = ErrID_None ErrMsg = "" - ! Tell our users what is about to happen that may take a while: - CALL WrScr ( ' Generating incident wave kinematics and current time history.' ) + ! Tell our users what is about to happen that may take a while: + CALL WrScr ( ' Generating incident wave kinematics and current time history.' ) - ! 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 + ! 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 (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveKinzi0Prime.',ErrStat,ErrMsg,RoutineName) + ! ALLOCATE the WaveKinzi0Prime(:) array and compute its elements here: - 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 + 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 + 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 + I = 1 - WaveKinzi0Prime(I) = InitInp%WaveKinGridzi(J) - WaveKinPrimeMap(I) = J - I = 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 - END IF + WaveKinzi0Prime(I) = InitInp%WaveKinGridzi(J) + WaveKinPrimeMap(I) = J + I = I + 1 - END DO ! J - All points where the incident wave kinematics will be computed without stretching + 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 - ! component nearest to WaveTp, and ALLOCATing the arrays: - ! NOTE: WaveDOmega = 2*Pi/WaveTMax since, in the FFT: - ! Omega = (K-1)*WaveDOmega - ! Time = (J-1)*WaveDT - ! and therefore: - ! Omega*Time = (K-1)*(J-1)*WaveDOmega*WaveDT - ! = (K-1)*(J-1)*2*Pi/NStepWave [see NWTC_FFTPACK] - ! or: - ! WaveDOmega = 2*Pi/(NStepWave*WaveDT) - ! = 2*Pi/WaveTMax + ! 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 + ! component nearest to WaveTp, and ALLOCATing the arrays: + ! NOTE: WaveDOmega = 2*Pi/WaveTMax since, in the FFT: + ! Omega = (K-1)*WaveDOmega + ! Time = (J-1)*WaveDT + ! and therefore: + ! Omega*Time = (K-1)*(J-1)*WaveDOmega*WaveDT + ! = (K-1)*(J-1)*2*Pi/NStepWave [see NWTC_FFTPACK] + ! or: + ! WaveDOmega = 2*Pi/(NStepWave*WaveDT) + ! = 2*Pi/WaveTMax - ! Set new value for NStepWave so that the FFT algorithms are efficient. Note that if this method is changed, the method - ! used to calculate the number of multidirectional wave directions (WaveNDir) and the UserWaveElevations_Init subroutine - ! will need to be updated. - !>>>>>> COMPUTE INITOUT SCALARS WaveField%NStepWave, WaveField%NStepWave2, InitOut%WaveTMax, and InitOut%WaveDOmega for WAVEMOD = 1,2,3,4,10 (5 and 7 also call this routine, but have been set already) - ! NOTE: For WaveMod = 5, NStepWave and several other things were already set in the UserWaveElevations_Init routine - ! using file information (an FFT was performed there, so the information was needed before now). - ! Same with WaveMod = 7 (WaveMod_UserFreq). With WaveMod = 7, WaveDirArr is also populated in UserWaveComponents_Init routine. - ! Need to make sure the wave-direction in formation is not overwritten later. - IF (WaveField%WaveMod /= WaveMod_ExtElev .AND. WaveField%WaveMod /= WaveMod_UserFreq) THEN - WaveField%NStepWave = CEILING ( InitInp%WaveTMax/InitInp%WaveDT ) ! Set NStepWave to an even integer ... - IF ( MOD(WaveField%NStepWave,2) == 1 ) WaveField%NStepWave = WaveField%NStepWave + 1 ! ... larger or equal to WaveTMax/WaveDT. - - WaveField%NStepWave2 = MAX( WaveField%NStepWave/2, 1 ) ! Make sure that NStepWave is an even product of small factors (PSF) that is - WaveField%NStepWave = 2 * PSF( WaveField%NStepWave2, 9 ) ! greater or equal to WaveTMax/WaveDT to ensure that the FFT is efficient. + ! Set new value for NStepWave so that the FFT algorithms are efficient. Note that if this method is changed, the method + ! used to calculate the number of multidirectional wave directions (WaveNDir) and the UserWaveElevations_Init subroutine + ! will need to be updated. - WaveField%NStepWave2 = WaveField%NStepWave/2 ! Update the value of NStepWave2 based on the value needed for NStepWave. - InitOut%WaveTMax = WaveField%NStepWave*InitInp%WaveDT ! Update the value of WaveTMax based on the value needed for NStepWave. - WaveField%WaveDOmega = TwoPi/InitOut%WaveTMax ! Compute the frequency step for incident wave calculations. + !>>>>>> COMPUTE INITOUT SCALARS WaveField%NStepWave, WaveField%NStepWave2, InitOut%WaveTMax, and InitOut%WaveDOmega for WAVEMOD = 1,2,3,4,10 (5 and 7 also call this routine, but have been set already) + ! NOTE: For WaveMod = 5, NStepWave and several other things were already set in the UserWaveElevations_Init routine + ! using file information (an FFT was performed there, so the information was needed before now). + ! Same with WaveMod = 7 (WaveMod_UserFreq). With WaveMod = 7, WaveDirArr is also populated in UserWaveComponents_Init routine. + ! Need to make sure the wave-direction in formation is not overwritten later. + IF (WaveField%WaveMod /= WaveMod_ExtElev .AND. WaveField%WaveMod /= WaveMod_UserFreq) THEN + WaveField%NStepWave = CEILING ( InitInp%WaveTMax/InitInp%WaveDT ) ! Set NStepWave to an even integer ... + IF ( MOD(WaveField%NStepWave,2) == 1 ) WaveField%NStepWave = WaveField%NStepWave + 1 ! ... larger or equal to WaveTMax/WaveDT. - ! >>> Allocate and initialize (set to 0) InitOut arrays - call Initial_InitOut_Arrays(InitOut, WaveField, InitInp, InitInp%WaveDT, ErrStatTmp, ErrMsgTmp); CALL SetErrStat(ErrStatTmp,ErrMsgTmp, ErrStat,ErrMsg,RoutineName) - ENDIF - !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< - - - ! Allocate all the arrays we need. - ALLOCATE ( tmpComplexArr(0:WaveField%NStepWave2 ), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array tmpComplexArr.', ErrStat,ErrMsg,RoutineName) - - ALLOCATE ( WaveDynPC0 (0:WaveField%NStepWave2 ,NWaveKin0Prime ), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveDynPC0.', ErrStat,ErrMsg,RoutineName) - - ALLOCATE ( WaveVelC0Hxi (0:WaveField%NStepWave2 ,NWaveKin0Prime ), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveVelC0Hxi.', ErrStat,ErrMsg,RoutineName) - - ALLOCATE ( WaveVelC0Hyi (0:WaveField%NStepWave2 ,NWaveKin0Prime ), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveVelC0Hyi.', ErrStat,ErrMsg,RoutineName) - - ALLOCATE ( WaveVelC0V (0:WaveField%NStepWave2 ,NWaveKin0Prime ), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveVelC0V.', ErrStat,ErrMsg,RoutineName) - - ALLOCATE ( WaveAccC0Hxi (0:WaveField%NStepWave2 ,NWaveKin0Prime ), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveAccC0Hxi.', ErrStat,ErrMsg,RoutineName) - - ALLOCATE ( WaveAccC0Hyi (0:WaveField%NStepWave2 ,NWaveKin0Prime ), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveAccC0Hyi.', ErrStat,ErrMsg,RoutineName) + WaveField%NStepWave2 = MAX( WaveField%NStepWave/2, 1 ) ! Make sure that NStepWave is an even product of small factors (PSF) that is + WaveField%NStepWave = 2 * PSF( WaveField%NStepWave2, 9 ) ! greater or equal to WaveTMax/WaveDT to ensure that the FFT is efficient. - ALLOCATE ( WaveAccC0V (0:WaveField%NStepWave2 ,NWaveKin0Prime ), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveAccC0V.', ErrStat,ErrMsg,RoutineName) - - - ALLOCATE ( WaveDynP0B (0:WaveField%NStepWave-1,NWaveKin0Prime ), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveDynP0B.', ErrStat,ErrMsg,RoutineName) - - ALLOCATE ( WaveVel0Hxi (0:WaveField%NStepWave-1,NWaveKin0Prime ), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveVel0Hxi.', ErrStat,ErrMsg,RoutineName) - - ALLOCATE ( WaveVel0Hyi (0:WaveField%NStepWave-1,NWaveKin0Prime ), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveVel0Hyi.', ErrStat,ErrMsg,RoutineName) - - ALLOCATE ( WaveVel0V (0:WaveField%NStepWave-1,NWaveKin0Prime ), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveVel0V.', ErrStat,ErrMsg,RoutineName) - - ALLOCATE ( WaveAcc0Hxi (0:WaveField%NStepWave-1,NWaveKin0Prime ), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveAcc0Hxi.', ErrStat,ErrMsg,RoutineName) + WaveField%NStepWave2 = WaveField%NStepWave/2 ! Update the value of NStepWave2 based on the value needed for NStepWave. + InitOut%WaveTMax = WaveField%NStepWave*InitInp%WaveDT ! Update the value of WaveTMax based on the value needed for NStepWave. + WaveField%WaveDOmega = TwoPi/InitOut%WaveTMax ! Compute the frequency step for incident wave calculations. + + ! >>> Allocate and initialize (set to 0) InitOut arrays + call Initial_InitOut_Arrays(InitOut, WaveField, InitInp, InitInp%WaveDT, ErrStatTmp, ErrMsgTmp); CALL SetErrStat(ErrStatTmp,ErrMsgTmp, ErrStat,ErrMsg,RoutineName) + ENDIF + + + ! 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; + 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 + + + IF (WaveField%WaveStMod .EQ. 2_IntKi) THEN ! Extrapolation Wave Stretching + ALLOCATE ( PWaveDynPC0BPz0 (0:WaveField%NStepWave2 ,InitInp%NWaveElevGrid), STAT=ErrStatTmp ); if (Failed0('PWaveDynPC0BPz0 ')) return; + ALLOCATE ( PWaveVelC0HxiPz0 (0:WaveField%NStepWave2 ,InitInp%NWaveElevGrid), STAT=ErrStatTmp ); if (Failed0('PWaveVelC0HxiPz0')) return; + ALLOCATE ( PWaveVelC0HyiPz0 (0:WaveField%NStepWave2 ,InitInp%NWaveElevGrid), STAT=ErrStatTmp ); if (Failed0('PWaveVelC0HyiPz0')) return; + ALLOCATE ( PWaveVelC0VPz0 (0:WaveField%NStepWave2 ,InitInp%NWaveElevGrid), STAT=ErrStatTmp ); if (Failed0('PWaveVelC0VPz0 ')) return; + ALLOCATE ( PWaveAccC0HxiPz0 (0:WaveField%NStepWave2 ,InitInp%NWaveElevGrid), STAT=ErrStatTmp ); if (Failed0('PWaveAccC0HxiPz0')) return; + ALLOCATE ( PWaveAccC0HyiPz0 (0:WaveField%NStepWave2 ,InitInp%NWaveElevGrid), STAT=ErrStatTmp ); if (Failed0('PWaveAccC0HyiPz0')) return; + ALLOCATE ( PWaveAccC0VPz0 (0:WaveField%NStepWave2 ,InitInp%NWaveElevGrid), STAT=ErrStatTmp ); if (Failed0('PWaveAccC0VPz0 ')) return; + ALLOCATE ( PWaveDynP0BPz0 (0:WaveField%NStepWave-1,InitInp%NWaveElevGrid), STAT=ErrStatTmp ); if (Failed0('PWaveDynP0BPz0 ')) return; + ALLOCATE ( PWaveVel0HxiPz0 (0:WaveField%NStepWave-1,InitInp%NWaveElevGrid), STAT=ErrStatTmp ); if (Failed0('PWaveVel0HxiPz0 ')) return; + ALLOCATE ( PWaveVel0HyiPz0 (0:WaveField%NStepWave-1,InitInp%NWaveElevGrid), STAT=ErrStatTmp ); if (Failed0('PWaveVel0HyiPz0 ')) return; + ALLOCATE ( PWaveVel0VPz0 (0:WaveField%NStepWave-1,InitInp%NWaveElevGrid), STAT=ErrStatTmp ); if (Failed0('PWaveVel0VPz0 ')) return; + ALLOCATE ( PWaveAcc0HxiPz0 (0:WaveField%NStepWave-1,InitInp%NWaveElevGrid), STAT=ErrStatTmp ); if (Failed0('PWaveAcc0HxiPz0 ')) return; + ALLOCATE ( PWaveAcc0HyiPz0 (0:WaveField%NStepWave-1,InitInp%NWaveElevGrid), STAT=ErrStatTmp ); if (Failed0('PWaveAcc0HyiPz0 ')) return; + ALLOCATE ( PWaveAcc0VPz0 (0:WaveField%NStepWave-1,InitInp%NWaveElevGrid), STAT=ErrStatTmp ); if (Failed0('PWaveAcc0VPz0 ')) return; + ALLOCATE ( WaveField%PWaveDynP0 (0:WaveField%NStepWave,InitInp%NGrid(1),InitInp%NGrid(2) ), STAT=ErrStatTmp ); if (Failed0('WaveField%PWaveDynP0')) return; + ALLOCATE ( WaveField%PWaveVel0 (0:WaveField%NStepWave,InitInp%NGrid(1),InitInp%NGrid(2),3), STAT=ErrStatTmp ); if (Failed0('WaveField%PWaveVel0 ')) return; + ALLOCATE ( WaveField%PWaveAcc0 (0:WaveField%NStepWave,InitInp%NGrid(1),InitInp%NGrid(2),3), STAT=ErrStatTmp ); if (Failed0('WaveField%PWaveAcc0 ')) return; + IF (WaveField%MCFD > 0.0_ReKi) THEN ! MacCamy-Fuchs model + ALLOCATE ( PWaveAccC0HxiMCFPz0 (0:WaveField%NStepWave2 ,InitInp%NWaveElevGrid), STAT=ErrStatTmp ); if (Failed0('PWaveAccC0HxiMCFPz0')) return; + ALLOCATE ( PWaveAccC0HyiMCFPz0 (0:WaveField%NStepWave2 ,InitInp%NWaveElevGrid), STAT=ErrStatTmp ); if (Failed0('PWaveAccC0HyiMCFPz0')) return; + ALLOCATE ( PWaveAccC0VMCFPz0 (0:WaveField%NStepWave2 ,InitInp%NWaveElevGrid), STAT=ErrStatTmp ); if (Failed0('PWaveAccC0VMCFPz0 ')) return; + ALLOCATE ( PWaveAcc0HxiMCFPz0 (0:WaveField%NStepWave-1,InitInp%NWaveElevGrid), STAT=ErrStatTmp ); if (Failed0('PWaveAcc0HxiMCFPz0 ')) return; + ALLOCATE ( PWaveAcc0HyiMCFPz0 (0:WaveField%NStepWave-1,InitInp%NWaveElevGrid), STAT=ErrStatTmp ); if (Failed0('PWaveAcc0HyiMCFPz0 ')) return; + ALLOCATE ( PWaveAcc0VMCFPz0 (0:WaveField%NStepWave-1,InitInp%NWaveElevGrid), STAT=ErrStatTmp ); if (Failed0('PWaveAcc0VMCFPz0 ')) return; + ALLOCATE ( WaveField%PWaveAccMCF0 (0:WaveField%NStepWave,InitInp%NGrid(1),InitInp%NGrid(2),3), STAT=ErrStatTmp ); if (Failed0('WaveField%PWaveAccMCF0')) return; + END IF + END IF - ALLOCATE ( WaveAcc0Hyi (0:WaveField%NStepWave-1,NWaveKin0Prime ), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveAcc0Hyi.', ErrStat,ErrMsg,RoutineName) - ALLOCATE ( WaveAcc0V (0:WaveField%NStepWave-1,NWaveKin0Prime ), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveAcc0V.', ErrStat,ErrMsg,RoutineName) - - - IF (WaveField%MCFD > 0.0_SiKi) THEN ! MacCamy-Fuchs model - - ALLOCATE ( WaveAccC0HxiMCF(0:WaveField%NStepWave2 ,NWaveKin0Prime ), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveAccC0HxiMCF.', ErrStat,ErrMsg,RoutineName) - ALLOCATE ( WaveAccC0HyiMCF(0:WaveField%NStepWave2 ,NWaveKin0Prime ), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveAccC0HyiMCF.', ErrStat,ErrMsg,RoutineName) + ! Arrays for the Sin and Cos of the wave direction for each frequency. Used in calculating wave elevation, velocity, acceleration etc. + ALLOCATE ( CosWaveDir( 0:WaveField%NStepWave2 ), STAT=ErrStatTmp ); if (Failed0('CosWaveDir')) return; + ALLOCATE ( SinWaveDir( 0:WaveField%NStepWave2 ), STAT=ErrStatTmp ); if (Failed0('SinWaveDir')) return; + ALLOCATE ( OmegaArr( 0:WaveField%NStepWave2 ), STAT=ErrStatTmp ); if (Failed0('OmegaArr ')) return; + + ! Arrays for the constrained wave + ALLOCATE ( WaveS1SddArr( 0:WaveField%NStepWave2 ), STAT=ErrStatTmp ); if (Failed0('WaveS1SddArr')) return; - ALLOCATE ( WaveAccC0VMCF (0:WaveField%NStepWave2 ,NWaveKin0Prime ), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveAccC0VMCF.', ErrStat,ErrMsg,RoutineName) - - ALLOCATE ( WaveAcc0HxiMCF (0:WaveField%NStepWave-1,NWaveKin0Prime ), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveAcc0HxiMCF.', ErrStat,ErrMsg,RoutineName) + ! Now check if all the allocations worked properly + IF ( ErrStat >= AbortErrLev ) THEN + CALL CleanUp() + RETURN + END IF - ALLOCATE ( WaveAcc0HyiMCF (0:WaveField%NStepWave-1,NWaveKin0Prime ), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveAcc0HyiMCF.', ErrStat,ErrMsg,RoutineName) - ALLOCATE ( WaveAcc0VMCF (0:WaveField%NStepWave-1,NWaveKin0Prime ), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveAcc0VMCF.', ErrStat,ErrMsg,RoutineName) - - ALLOCATE ( WaveField%WaveAccMCF (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 WaveField%WaveAccMCF.', ErrStat,ErrMsg,RoutineName) - END IF - - - IF (WaveField%WaveStMod .EQ. 2_IntKi) THEN ! Extrapolation Wave Stretching - ALLOCATE ( PWaveDynPC0BPz0 (0:WaveField%NStepWave2 ,InitInp%NWaveElevGrid), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array PWaveDynPC0BPz0.', ErrStat,ErrMsg,RoutineName) - - ALLOCATE ( PWaveVelC0HxiPz0 (0:WaveField%NStepWave2 ,InitInp%NWaveElevGrid), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array PWaveVelC0HxiPz0.', ErrStat,ErrMsg,RoutineName) - - ALLOCATE ( PWaveVelC0HyiPz0 (0:WaveField%NStepWave2 ,InitInp%NWaveElevGrid), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array PWaveVelC0HyiPz0.', ErrStat,ErrMsg,RoutineName) - - ALLOCATE ( PWaveVelC0VPz0 (0:WaveField%NStepWave2 ,InitInp%NWaveElevGrid), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array PWaveVelC0VPz0.', ErrStat,ErrMsg,RoutineName) - - ALLOCATE ( PWaveAccC0HxiPz0 (0:WaveField%NStepWave2 ,InitInp%NWaveElevGrid), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array PWaveAccC0HxiPz0.', ErrStat,ErrMsg,RoutineName) - - ALLOCATE ( PWaveAccC0HyiPz0 (0:WaveField%NStepWave2 ,InitInp%NWaveElevGrid), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array PWaveAccC0HyiPz0.', ErrStat,ErrMsg,RoutineName) - - ALLOCATE ( PWaveAccC0VPz0 (0:WaveField%NStepWave2 ,InitInp%NWaveElevGrid), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array PWaveAccC0VPz0.', ErrStat,ErrMsg,RoutineName) + ! Compute the positive-frequency components (including zero) of the discrete + ! Fourier transforms of the wave kinematics: + DO I = 0,WaveField%NStepWave2 ! Loop through the positive frequency components (including zero) of the discrete Fourier transforms + OmegaArr(I) = I*WaveField%WaveDOmega + END DO - ALLOCATE ( PWaveDynP0BPz0 (0:WaveField%NStepWave-1,InitInp%NWaveElevGrid), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array PWaveDynP0BPz0.', ErrStat,ErrMsg,RoutineName) - - ALLOCATE ( PWaveVel0HxiPz0 (0:WaveField%NStepWave-1,InitInp%NWaveElevGrid), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array PWaveVel0HxiPz0.', ErrStat,ErrMsg,RoutineName) - - ALLOCATE ( PWaveVel0HyiPz0 (0:WaveField%NStepWave-1,InitInp%NWaveElevGrid), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array PWaveVel0HyiPz0.', ErrStat,ErrMsg,RoutineName) - - ALLOCATE ( PWaveVel0VPz0 (0:WaveField%NStepWave-1,InitInp%NWaveElevGrid), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array PWaveVel0Pz0.', ErrStat,ErrMsg,RoutineName) - - ALLOCATE ( PWaveAcc0HxiPz0 (0:WaveField%NStepWave-1,InitInp%NWaveElevGrid), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array PWaveAcc0HxiPz0.', ErrStat,ErrMsg,RoutineName) - - ALLOCATE ( PWaveAcc0HyiPz0 (0:WaveField%NStepWave-1,InitInp%NWaveElevGrid), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array PWaveAcc0HyiPz0.', ErrStat,ErrMsg,RoutineName) - - ALLOCATE ( PWaveAcc0VPz0 (0:WaveField%NStepWave-1,InitInp%NWaveElevGrid), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array PWaveAcc0VPz0.', ErrStat,ErrMsg,RoutineName) + call Get_1Spsd_and_WaveElevC0(InitInp, InitOut, WaveField, OmegaArr, WaveS1SddArr) - ALLOCATE ( WaveField%PWaveDynP0 (0:WaveField%NStepWave,InitInp%NGrid(1),InitInp%NGrid(2) ), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveField%PWaveDynP0.', ErrStat,ErrMsg,RoutineName) - - ALLOCATE ( WaveField%PWaveVel0 (0:WaveField%NStepWave,InitInp%NGrid(1),InitInp%NGrid(2),3), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveField%PWaveVel0.', ErrStat,ErrMsg,RoutineName) - - ALLOCATE ( WaveField%PWaveAcc0 (0:WaveField%NStepWave,InitInp%NGrid(1),InitInp%NGrid(2),3), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveField%PWaveAcc0.', ErrStat,ErrMsg,RoutineName) - - IF (WaveField%MCFD > 0.0_ReKi) THEN ! MacCamy-Fuchs model - - ALLOCATE ( PWaveAccC0HxiMCFPz0 (0:WaveField%NStepWave2 ,InitInp%NWaveElevGrid), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array PWaveAccC0HxiMCFPz0.', ErrStat,ErrMsg,RoutineName) - - ALLOCATE ( PWaveAccC0HyiMCFPz0 (0:WaveField%NStepWave2 ,InitInp%NWaveElevGrid), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array PWaveAccC0HyiMCFPz0.', ErrStat,ErrMsg,RoutineName) - - ALLOCATE ( PWaveAccC0VMCFPz0 (0:WaveField%NStepWave2 ,InitInp%NWaveElevGrid), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array PWaveAccC0VMCFPz0.', ErrStat,ErrMsg,RoutineName) - ALLOCATE ( PWaveAcc0HxiMCFPz0 (0:WaveField%NStepWave-1,InitInp%NWaveElevGrid), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array PWaveAcc0HxiMCFPz0.', ErrStat,ErrMsg,RoutineName) + !> # Multi Directional Waves + call CalculateWaveDirection(InitInp, InitOut, WaveField, ErrStatTmp, ErrMsgTmp); if (Failed()) return; - ALLOCATE ( PWaveAcc0HyiMCFPz0 (0:WaveField%NStepWave-1,InitInp%NWaveElevGrid), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array PWaveAcc0HyiMCFPz0.', ErrStat,ErrMsg,RoutineName) + ! Store the minimum and maximum wave directions + WaveField%WaveDirMin = MINVAL(WaveField%WaveDirArr) + WaveField%WaveDirMax = MAXVAL(WaveField%WaveDirArr) - ALLOCATE ( PWaveAcc0VMCFPz0 (0:WaveField%NStepWave-1,InitInp%NWaveElevGrid), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array PWaveAcc0VMCFPz0.', ErrStat,ErrMsg,RoutineName) - - ALLOCATE ( WaveField%PWaveAccMCF0 (0:WaveField%NStepWave,InitInp%NGrid(1),InitInp%NGrid(2),3), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveField%PWaveAccMCF0.', ErrStat,ErrMsg,RoutineName) - - END IF - - END IF -! END TODO SECTION + ! Set the CosWaveDir and SinWaveDir arrays + CosWaveDir=COS(D2R*WaveField%WaveDirArr) + SinWaveDir=SIN(D2R*WaveField%WaveDirArr) - - ! Arrays for the Sin and Cos of the wave direction for each frequency. Used in calculating wave elevation, velocity, acceleration etc. - ALLOCATE ( CosWaveDir( 0:WaveField%NStepWave2 ), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array CosWaveDir.', ErrStat,ErrMsg,RoutineName) - - ALLOCATE ( SinWaveDir( 0:WaveField%NStepWave2 ), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array SinWaveDir.', ErrStat,ErrMsg,RoutineName) - - ALLOCATE ( OmegaArr( 0:WaveField%NStepWave2 ), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array OmegaArr.', ErrStat,ErrMsg,RoutineName) - - - ! Arrays for the constrained wave - ALLOCATE ( WaveS1SddArr( 0:WaveField%NStepWave2 ), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveS1SddArr.', ErrStat,ErrMsg,RoutineName) - - ! Now check if all the allocations worked properly + + ! make sure this is called before calling ConstrainedNewWaves + CALL InitFFT ( WaveField%NStepWave, FFT_Data, .TRUE., ErrStatTmp ) + CALL SetErrStat(ErrStatTmp,'Error occured while initializing the FFT.',ErrStat,ErrMsg,RoutineName) IF ( ErrStat >= AbortErrLev ) THEN CALL CleanUp() RETURN END IF - - - - ! Compute the positive-frequency components (including zero) of the discrete - ! Fourier transforms of the wave kinematics: - DO I = 0,WaveField%NStepWave2 ! Loop through the positive frequency components (including zero) of the discrete Fourier transforms - OmegaArr(I) = I*WaveField%WaveDOmega - END DO - - call Get_1Spsd_and_WaveElevC0(InitInp, InitOut, WaveField, OmegaArr, WaveS1SddArr) - - !> # Multi Directional Waves - call CalculateWaveDirection(InitInp, InitOut, WaveField, ErrStatTmp, ErrMsgTmp) - call SetErrStat(ErrStatTmp, ErrMsgTmp, ErrStat, ErrMsg, RoutineName) - IF ( ErrStat >= AbortErrLev ) THEN - CALL CleanUp() - RETURN - END IF + !-------------------------------------------------------------------------------- + !=== Constrained New Waves === + ! Modify the wave components to implement the constrained wave + ! Only do this if WaveMod = 2 (JONSWAP/Pierson-Moskowitz Spectrum) and ConstWaveMod > 0 + IF ( WaveField%WaveMod == WaveMod_JONSWAP .AND. InitInp%ConstWaveMod > 0) THEN + ! adjust InitOut%WaveElevC0 for constrained wave: + call ConstrainedNewWaves(InitInp, InitOut, WaveField, OmegaArr, WaveS1SddArr, CosWaveDir, SinWaveDir, FFT_Data, ErrStatTmp, ErrMsgTmp) + call SetErrStat(ErrStatTmp,ErrMsgTmp, ErrStat,ErrMsg,RoutineName) + if (ErrStat >= AbortErrLev) then + call cleanup() + return + end if + ENDIF + ! End of Constrained Wave + + !-------------------------------------------------------------------------------- + !> ## Phase shift the discrete Fourier transform of wave elevations at the WRP + !> This changes the phasing of all wave kinematics and loads to reflect the turbine's + !! location in the larger farm, in the case of FAST.Farm simulations, based on + !! specified PtfmLocationX and PtfmLocationY. + + IF (InitInp%WaveFieldMod == 2) THEN ! case 2: adjust wave phases based on turbine offsets from farm origin + + CALL WrScr ( ' Adjusting incident wave kinematics for turbine offset from array origin.' ) + + DO I = 0,WaveField%NStepWave2 + + tmpComplex = CMPLX( WaveField%WaveElevC0(1,I), WaveField%WaveElevC0(2,I)) - ! Store the minimum and maximum wave directions - WaveField%WaveDirMin = MINVAL(WaveField%WaveDirArr) - WaveField%WaveDirMax = MAXVAL(WaveField%WaveDirArr) + ! some redundant calculations with later, but insignificant + WaveNmbr = WaveNumber ( OmegaArr(I), InitInp%Gravity, WaveField%EffWtrDpth ) + ! apply the phase shift + tmpComplex = tmpComplex * EXP( -ImagNmbr*WaveNmbr*( InitInp%PtfmLocationX*CosWaveDir(I) + InitInp%PtfmLocationY*SinWaveDir(I) )) + + ! put shifted complex amplitudes back into the array for use in the remainder of this module and other modules (Waves2, WAMIT, WAMIT2) + WaveField%WaveElevC0 (1,I) = REAL( tmpComplex) + WaveField%WaveElevC0 (2,I) = AIMAG(tmpComplex) + + END DO + END IF - ! Set the CosWaveDir and SinWaveDir arrays - CosWaveDir=COS(D2R*WaveField%WaveDirArr) - SinWaveDir=SIN(D2R*WaveField%WaveDirArr) - - - ! make sure this is called before calling ConstrainedNewWaves - CALL InitFFT ( WaveField%NStepWave, FFT_Data, .TRUE., ErrStatTmp ) - CALL SetErrStat(ErrStatTmp,'Error occured while initializing the FFT.',ErrStat,ErrMsg,RoutineName) - IF ( ErrStat >= AbortErrLev ) THEN - CALL CleanUp() - RETURN - END IF - - !-------------------------------------------------------------------------------- - !=== Constrained New Waves === - ! Modify the wave components to implement the constrained wave - ! Only do this if WaveMod = 2 (JONSWAP/Pierson-Moskowitz Spectrum) and ConstWaveMod > 0 - IF ( WaveField%WaveMod == WaveMod_JONSWAP .AND. InitInp%ConstWaveMod > 0) THEN - ! adjust InitOut%WaveElevC0 for constrained wave: - call ConstrainedNewWaves(InitInp, InitOut, WaveField, OmegaArr, WaveS1SddArr, CosWaveDir, SinWaveDir, FFT_Data, ErrStatTmp, ErrMsgTmp) - call SetErrStat(ErrStatTmp,ErrMsgTmp, ErrStat,ErrMsg,RoutineName) - if (ErrStat >= AbortErrLev) then - call cleanup() - return - end if - ENDIF - ! End of Constrained Wave - - !-------------------------------------------------------------------------------- - !> ## Phase shift the discrete Fourier transform of wave elevations at the WRP - !> This changes the phasing of all wave kinematics and loads to reflect the turbine's - !! location in the larger farm, in the case of FAST.Farm simulations, based on - !! specified PtfmLocationX and PtfmLocationY. - - IF (InitInp%WaveFieldMod == 2) THEN ! case 2: adjust wave phases based on turbine offsets from farm origin - - CALL WrScr ( ' Adjusting incident wave kinematics for turbine offset from array origin.' ) - - DO I = 0,WaveField%NStepWave2 - - tmpComplex = CMPLX( WaveField%WaveElevC0(1,I), WaveField%WaveElevC0(2,I)) - - ! some redundant calculations with later, but insignificant - WaveNmbr = WaveNumber ( OmegaArr(I), InitInp%Gravity, WaveField%EffWtrDpth ) - - ! apply the phase shift - tmpComplex = tmpComplex * EXP( -ImagNmbr*WaveNmbr*( InitInp%PtfmLocationX*CosWaveDir(I) + InitInp%PtfmLocationY*SinWaveDir(I) )) - - ! put shifted complex amplitudes back into the array for use in the remainder of this module and other modules (Waves2, WAMIT, WAMIT2) - WaveField%WaveElevC0 (1,I) = REAL( tmpComplex) - WaveField%WaveElevC0 (2,I) = AIMAG(tmpComplex) - - END DO - END IF - - - !-------------------------------------------------------------------------------- - !> ## Compute IFFTs - !> Compute the discrete Fourier transform of the instantaneous elevation of - !! incident waves at each desired point on the still water level plane - !! where it can be output: - - 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)) + !-------------------------------------------------------------------------------- + !> ## Compute IFFTs + !> Compute the discrete Fourier transform of the instantaneous elevation of + !! incident waves at each desired point on the still water level plane + !! where it can be output: + 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)) ! Compute the frequency of this component and its imaginary value: - - ImagOmega = ImagNmbr*OmegaArr(I) + ImagOmega = ImagNmbr*OmegaArr(I) ! Compute the wavenumber: - - WaveNmbr = WaveNumber ( OmegaArr(I), InitInp%Gravity, WaveField%EffWtrDpth ) + WaveNmbr = WaveNumber ( OmegaArr(I), InitInp%Gravity, WaveField%EffWtrDpth ) ! Wavenumber-dependent acceleration scaling for MacCamy-Fuchs model MCFC = 0.0_ReKi @@ -1100,424 +979,350 @@ SUBROUTINE VariousWaves_Init ( InitInp, InitOut, WaveField, ErrStat, ErrMsg ) ! before applying stretching at the zi-coordinates for the WAMIT reference point, and all ! points where are Morison loads will be calculated. - DO J = 1,NWaveKin0Prime ! Loop through all points where the incident wave kinematics will be computed without stretching + 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) )) + 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) ) + WaveDynPC0 (I,J) = WaveField%RhoXg*tmpComplex*WaveElevxiPrime0 * COSHNumOvrCOSHDen ( WaveNmbr, WaveField%EffWtrDpth, WaveKinzi0Prime(J) ) - WaveVelC0Hxi (I,J) = CosWaveDir(I)*OmegaArr(I)*tmpComplex* WaveElevxiPrime0 * COSHNumOvrSINHDen ( WaveNmbr, WaveField%EffWtrDpth, WaveKinzi0Prime(J) ) - WaveVelC0Hyi (I,J) = SinWaveDir(I)*OmegaArr(I)*tmpComplex* WaveElevxiPrime0 * COSHNumOvrSINHDen ( WaveNmbr, WaveField%EffWtrDpth, WaveKinzi0Prime(J) ) + WaveVelC0Hxi (I,J) = CosWaveDir(I)*OmegaArr(I)*tmpComplex* WaveElevxiPrime0 * COSHNumOvrSINHDen ( WaveNmbr, WaveField%EffWtrDpth, WaveKinzi0Prime(J) ) + WaveVelC0Hyi (I,J) = SinWaveDir(I)*OmegaArr(I)*tmpComplex* WaveElevxiPrime0 * COSHNumOvrSINHDen ( WaveNmbr, WaveField%EffWtrDpth, WaveKinzi0Prime(J) ) - WaveVelC0V (I,J) = ImagOmega*tmpComplex* WaveElevxiPrime0 * SINHNumOvrSINHDen ( WaveNmbr, WaveField%EffWtrDpth, WaveKinzi0Prime(J) ) - WaveAccC0Hxi (I,J) = ImagOmega* WaveVelC0Hxi (I,J) + WaveVelC0V (I,J) = ImagOmega*tmpComplex* WaveElevxiPrime0 * SINHNumOvrSINHDen ( WaveNmbr, WaveField%EffWtrDpth, WaveKinzi0Prime(J) ) + WaveAccC0Hxi (I,J) = ImagOmega* WaveVelC0Hxi (I,J) - WaveAccC0Hyi (I,J) = ImagOmega* WaveVelC0Hyi (I,J) - WaveAccC0V (I,J) = ImagOmega* WaveVelC0V (I,J) + WaveAccC0Hyi (I,J) = ImagOmega* WaveVelC0Hyi (I,J) + WaveAccC0V (I,J) = ImagOmega* 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 + 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 - !=================================== - IF (WaveField%WaveStMod .EQ. 2_IntKi) THEN ! Extrapolation wave stretching - DO J = 1,InitInp%NWaveElevGrid ! Loop through all points on the SWL - WaveElevxiPrime0 = EXP( -ImagNmbr*WaveNmbr*( InitInp%WaveKinGridxi(J)*CosWaveDir(I) + & - InitInp%WaveKinGridyi(J)*SinWaveDir(I) )) - ! Partial derivatives at zi = 0 - PWaveDynPC0BPz0 (I,J) = WaveField%RhoXg* tmpComplex*WaveElevxiPrime0*WaveNmbr*TANH ( WaveNmbr*WaveField%EffWtrDpth ) - PWaveVelC0HxiPz0(I,J) = CosWaveDir(I)*OmegaArr(I)*tmpComplex*WaveElevxiPrime0*WaveNmbr - PWaveVelC0HyiPz0(I,J) = SinWaveDir(I)*OmegaArr(I)*tmpComplex*WaveElevxiPrime0*WaveNmbr + IF (WaveField%WaveStMod .EQ. 2_IntKi) THEN ! Extrapolation wave stretching + DO J = 1,InitInp%NWaveElevGrid ! Loop through all points on the SWL + WaveElevxiPrime0 = EXP( -ImagNmbr*WaveNmbr*( InitInp%WaveKinGridxi(J)*CosWaveDir(I) + & + InitInp%WaveKinGridyi(J)*SinWaveDir(I) )) + ! Partial derivatives at zi = 0 + PWaveDynPC0BPz0 (I,J) = WaveField%RhoXg* tmpComplex*WaveElevxiPrime0*WaveNmbr*TANH ( WaveNmbr*WaveField%EffWtrDpth ) + PWaveVelC0HxiPz0(I,J) = CosWaveDir(I)*OmegaArr(I)*tmpComplex*WaveElevxiPrime0*WaveNmbr + PWaveVelC0HyiPz0(I,J) = SinWaveDir(I)*OmegaArr(I)*tmpComplex*WaveElevxiPrime0*WaveNmbr + + IF (I == 0_IntKi) THEN ! Zero frequency component - Need to avoid division by zero. + PWaveVelC0VPz0 (I,J) = 0.0_ReKi + ELSE + PWaveVelC0VPz0 (I,J) = ImagOmega*tmpComplex*WaveElevxiPrime0*WaveNmbr/TANH ( WaveNmbr*WaveField%EffWtrDpth ) + END IF + + PWaveAccC0HxiPz0(I,J) = ImagOmega*PWaveVelC0HxiPz0(I,J) + PWaveAccC0HyiPz0(I,J) = ImagOmega*PWaveVelC0HyiPz0(I,J) + PWaveAccC0VPz0 (I,J) = ImagOmega*PWaveVelC0VPz0 (I,J) - IF (I == 0_IntKi) THEN ! Zero frequency component - Need to avoid division by zero. - PWaveVelC0VPz0 (I,J) = 0.0_ReKi - ELSE - PWaveVelC0VPz0 (I,J) = ImagOmega*tmpComplex*WaveElevxiPrime0*WaveNmbr/TANH ( WaveNmbr*WaveField%EffWtrDpth ) - END IF - PWaveAccC0HxiPz0(I,J) = ImagOmega*PWaveVelC0HxiPz0(I,J) - PWaveAccC0HyiPz0(I,J) = ImagOmega*PWaveVelC0HyiPz0(I,J) - PWaveAccC0VPz0 (I,J) = ImagOmega*PWaveVelC0VPz0 (I,J) - - - IF (WaveField%MCFD > 0.0_SiKi) THEN - PWaveAccC0HxiMCFPz0(I,J) = PWaveAccC0HxiPz0(I,J) * MCFC - PWaveAccC0HyiMCFPz0(I,J) = PWaveAccC0HyiPz0(I,J) * MCFC - PWaveAccC0VMCFPz0(I,J) = PWaveAccC0VPz0(I,J) * MCFC - END IF - - END DO ! J - All points where the incident wave kinematics will be computed without stretching - END IF - !=================================== - - END DO ! I - The positive frequency components (including zero) of the discrete Fourier transforms - - ! Calculate the array of simulation times at which the instantaneous - ! elevation of, velocity of, acceleration of, and loads associated with - ! the incident waves are to be determined: - DO I = 0,WaveField%NStepWave ! Loop through all time steps - WaveField%WaveTime(I) = I*REAL(InitInp%WaveDT,SiKi) - END DO ! I - All time steps - - - DO I = 0,WaveField%NStepWave2 ! Loop through the positive frequency components (including zero) of the discrete Fourier transform - tmpComplexArr(I) = CMPLX(WaveField%WaveElevC0(1,I), WaveField%WaveElevC0(2,I)) - END DO - - ! Compute the inverse discrete Fourier transforms to find the time-domain - ! representations of the wave kinematics without stretcing: - - CALL ApplyFFT_cx ( WaveField%WaveElev0 (0:WaveField%NStepWave-1), tmpComplexArr (: ), FFT_Data, ErrStatTmp ) - CALL SetErrStat(ErrStatTmp,'Error occured while applying the FFT to WaveElev0.',ErrStat,ErrMsg,RoutineName) - IF ( ErrStat >= AbortErrLev ) THEN - CALL CleanUp() - RETURN + IF (WaveField%MCFD > 0.0_SiKi) THEN + PWaveAccC0HxiMCFPz0(I,J) = PWaveAccC0HxiPz0(I,J) * MCFC + PWaveAccC0HyiMCFPz0(I,J) = PWaveAccC0HyiPz0(I,J) * MCFC + PWaveAccC0VMCFPz0(I,J) = PWaveAccC0VPz0(I,J) * MCFC + END IF + + END DO ! J - All points where the incident wave kinematics will be computed without stretching END IF -!NOTE: For all grid points - DO k = 1,InitInp%NWaveElevGrid ! Loop through all points where the incident wave elevations are to be computed (normally all the XY grid points) - ! This subroutine call applies the FFT at the correct location. - i = mod(k-1, InitInp%NGrid(1)) + 1 - j = (k-1) / InitInp%NGrid(1) + 1 - ! note that this subroutine resets tmpComplexArr - CALL WaveElevTimeSeriesAtXY( InitInp%WaveKinGridxi(k), InitInp%WaveKinGridyi(k), WaveField%WaveElev1(:,i,j), WaveField%WaveElevC(:,:,k), tmpComplexArr, ErrStatTmp, ErrMsgTmp ) ! Note this sets tmpComplexArr - CALL SetErrStat(ErrStatTmp,'Error occured while applying the FFT to WaveField%WaveElev1.',ErrStat,ErrMsg,RoutineName) - IF ( ErrStat >= AbortErrLev ) THEN - CALL CleanUp() - RETURN - END IF - END DO ! J - All points where the incident wave elevations can be output - - + END DO ! I - The positive frequency components (including zero) of the discrete Fourier transforms - ! 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 ) - CALL SetErrStat(ErrStatTmp,'Error occured while applying the FFT to WaveDynP0B.', ErrStat,ErrMsg,RoutineName) + ! Calculate the array of simulation times at which the instantaneous + ! elevation of, velocity of, acceleration of, and loads associated with + ! the incident waves are to be determined: + DO I = 0,WaveField%NStepWave ! Loop through all time steps + WaveField%WaveTime(I) = I*REAL(InitInp%WaveDT,SiKi) + END DO ! I - All time steps + + + DO I = 0,WaveField%NStepWave2 ! Loop through the positive frequency components (including zero) of the discrete Fourier transform + tmpComplexArr(I) = CMPLX(WaveField%WaveElevC0(1,I), WaveField%WaveElevC0(2,I)) + END DO - CALL ApplyFFT_cx ( WaveVel0Hxi (:,J), WaveVelC0Hxi (:,J), FFT_Data, ErrStatTmp ) - CALL SetErrStat(ErrStatTmp,'Error occured while applying the FFT to WaveVel0Hxi.', ErrStat,ErrMsg,RoutineName) + ! Compute the inverse discrete Fourier transforms to find the time-domain + ! representations of the wave kinematics without stretcing: - CALL ApplyFFT_cx ( WaveVel0Hyi (:,J), WaveVelC0Hyi (:,J), FFT_Data, ErrStatTmp ) - CALL SetErrStat(ErrStatTmp,'Error occured while applying the FFT to WaveVel0Hyi.', ErrStat,ErrMsg,RoutineName) + CALL ApplyFFT_cx ( WaveField%WaveElev0 (0:WaveField%NStepWave-1), tmpComplexArr (: ), FFT_Data, ErrStatTmp ) + if (FailedFFT('WaveField%WaveElev0' )) return; +!NOTE: For all grid points + DO k = 1,InitInp%NWaveElevGrid ! Loop through all points where the incident wave elevations are to be computed (normally all the XY grid points) + ! This subroutine call applies the FFT at the correct location. + i = mod(k-1, InitInp%NGrid(1)) + 1 + j = (k-1) / InitInp%NGrid(1) + 1 - CALL ApplyFFT_cx ( WaveVel0V (:,J), WaveVelC0V (:,J), FFT_Data, ErrStatTmp ) - CALL SetErrStat(ErrStatTmp,'Error occured while applying the FFT to WaveVel0V.', ErrStat,ErrMsg,RoutineName) + ! note that this subroutine resets tmpComplexArr + CALL WaveElevTimeSeriesAtXY( InitInp%WaveKinGridxi(k), InitInp%WaveKinGridyi(k), WaveField%WaveElev1(:,i,j), WaveField%WaveElevC(:,:,k), tmpComplexArr, ErrStatTmp, ErrMsgTmp ) ! Note this sets tmpComplexArr + if (FailedFFT('WaveField%WaveElev1' )) return; + END DO ! J - All points where the incident wave elevations can be output - CALL ApplyFFT_cx ( WaveAcc0Hxi (:,J), WaveAccC0Hxi (:,J), FFT_Data, ErrStatTmp ) - CALL SetErrStat(ErrStatTmp,'Error occured while applying the FFT to WaveAcc0Hxi.', ErrStat,ErrMsg,RoutineName) - CALL ApplyFFT_cx ( WaveAcc0Hyi (:,J), WaveAccC0Hyi (:,J), FFT_Data, ErrStatTmp ) - CALL SetErrStat(ErrStatTmp,'Error occured while applying the FFT to WaveAcc0Hyi.', ErrStat,ErrMsg,RoutineName) - CALL ApplyFFT_cx ( WaveAcc0V (:,J), WaveAccC0V (:,J), FFT_Data, ErrStatTmp ) - CALL SetErrStat(ErrStatTmp,'Error occured while applying the FFT to WaveAcc0V.', ErrStat,ErrMsg,RoutineName) - IF ( ErrStat >= AbortErrLev ) THEN - CALL CleanUp() - RETURN - END IF + ! 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 + CALL ApplyFFT_cx ( PWaveDynP0BPz0(:,J ), PWaveDynPC0BPz0(:,J ), FFT_Data, ErrStatTmp ); if (FailedFFT('PWaveDynP0BPz0 ')) return; + CALL ApplyFFT_cx ( PWaveVel0HxiPz0 (:,J ), PWaveVelC0HxiPz0( :,J ),FFT_Data, ErrStatTmp ); if (FailedFFT('PWaveVel0HxiPz0')) return; + CALL ApplyFFT_cx ( PWaveVel0HyiPz0 (:,J ), PWaveVelC0HyiPz0( :,J ),FFT_Data, ErrStatTmp ); if (FailedFFT('PWaveVel0HyiPz0')) return; + CALL ApplyFFT_cx ( PWaveVel0VPz0 (:,J ), PWaveVelC0VPz0 (:,J ), FFT_Data, ErrStatTmp ); if (FailedFFT('PWaveVel0VPz0 ')) return; + CALL ApplyFFT_cx ( PWaveAcc0HxiPz0 (:,J ), PWaveAccC0HxiPz0(:,J ),FFT_Data, ErrStatTmp ); if (FailedFFT('PWaveAcc0HxiPz0')) return; + CALL ApplyFFT_cx ( PWaveAcc0HyiPz0 (:,J ), PWaveAccC0HyiPz0(:,J ),FFT_Data, ErrStatTmp ); if (FailedFFT('PWaveAcc0HyiPz0')) return; + CALL ApplyFFT_cx ( PWaveAcc0VPz0 (:,J ), PWaveAccC0VPz0( :,J ), FFT_Data, ErrStatTmp ); if (FailedFFT('PWaveAcc0VPz0 ')) 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 ) - CALL SetErrStat(ErrStatTmp,'Error occured while applying the FFT to WaveAcc0HxiMCF.', ErrStat,ErrMsg,RoutineName) - - CALL ApplyFFT_cx ( WaveAcc0HyiMCF (:,J), WaveAccC0HyiMCF (:,J), FFT_Data, ErrStatTmp ) - CALL SetErrStat(ErrStatTmp,'Error occured while applying the FFT to WaveAcc0HyiMCF.', ErrStat,ErrMsg,RoutineName) - - CALL ApplyFFT_cx ( WaveAcc0VMCF (:,J), WaveAccC0VMCF (:,J), FFT_Data, ErrStatTmp ) - CALL SetErrStat(ErrStatTmp,'Error occured while applying the FFT to WaveAcc0VMCF.', ErrStat,ErrMsg,RoutineName) - - IF ( ErrStat >= AbortErrLev ) THEN - CALL CleanUp() - RETURN - END IF + + IF (WaveField%MCFD > 0.0_SiKi) THEN ! MacCamy-Fuchs scaled acceleration field + DO J = 1,InitInp%NWaveElevGrid + CALL ApplyFFT_cx ( PWaveAcc0HxiMCFPz0 (:,J ), PWaveAccC0HxiMCFPz0(:,J ),FFT_Data, ErrStatTmp ); if (FailedFFT('PWaveAcc0HxiMCFPz0')) return; + CALL ApplyFFT_cx ( PWaveAcc0HyiMCFPz0 (:,J ), PWaveAccC0HyiMCFPz0(:,J ),FFT_Data, ErrStatTmp ); if (FailedFFT('PWaveAcc0HyiMCFPz0')) return; + CALL ApplyFFT_cx ( PWaveAcc0VMCFPz0 (:,J ), PWaveAccC0VMCFPz0( :,J ), FFT_Data, ErrStatTmp ); if (FailedFFT('PWaveAcc0VMCFPz0 ')) 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 - CALL ApplyFFT_cx ( PWaveDynP0BPz0(:,J ), PWaveDynPC0BPz0(:,J ), FFT_Data, ErrStatTmp ) - CALL SetErrStat(ErrStatTmp,'Error occured while applying the FFT to PWaveDynP0BPz0.', ErrStat,ErrMsg,RoutineName) - - CALL ApplyFFT_cx ( PWaveVel0HxiPz0 (:,J ), PWaveVelC0HxiPz0( :,J ),FFT_Data, ErrStatTmp ) - CALL SetErrStat(ErrStatTmp,'Error occured while applying the FFT to PWaveVel0HxiPz0.', ErrStat,ErrMsg,RoutineName) - - CALL ApplyFFT_cx ( PWaveVel0HyiPz0 (:,J ), PWaveVelC0HyiPz0( :,J ),FFT_Data, ErrStatTmp ) - CALL SetErrStat(ErrStatTmp,'Error occured while applying the FFT to PWaveVel0HyiPz0.', ErrStat,ErrMsg,RoutineName) - - CALL ApplyFFT_cx ( PWaveVel0VPz0 (:,J ), PWaveVelC0VPz0 (:,J ), FFT_Data, ErrStatTmp ) - CALL SetErrStat(ErrStatTmp,'Error occured while applying the FFT to PWaveVel0VPz0.', ErrStat,ErrMsg,RoutineName) - - CALL ApplyFFT_cx ( PWaveAcc0HxiPz0 (:,J ), PWaveAccC0HxiPz0(:,J ),FFT_Data, ErrStatTmp ) - CALL SetErrStat(ErrStatTmp,'Error occured while applying the FFT to PWaveAcc0HxiPz0.', ErrStat,ErrMsg,RoutineName) - - CALL ApplyFFT_cx ( PWaveAcc0HyiPz0 (:,J ), PWaveAccC0HyiPz0(:,J ),FFT_Data, ErrStatTmp ) - CALL SetErrStat(ErrStatTmp,'Error occured while applying the FFT to PWaveAcc0HyiPz0.', ErrStat,ErrMsg,RoutineName) - - CALL ApplyFFT_cx ( PWaveAcc0VPz0 (:,J ), PWaveAccC0VPz0( :,J ), FFT_Data, ErrStatTmp ) - CALL SetErrStat(ErrStatTmp,'Error occured while applying the FFT to PWaveAcc0VPz0.', ErrStat,ErrMsg,RoutineName) - - IF ( ErrStat >= AbortErrLev ) THEN - CALL CleanUp() - RETURN - END IF - - END DO ! J - All points where the incident wave kinematics will be computed without stretching - - IF (WaveField%MCFD > 0.0_SiKi) THEN ! MacCamy-Fuchs scaled acceleration field - DO J = 1,InitInp%NWaveElevGrid - - CALL ApplyFFT_cx ( PWaveAcc0HxiMCFPz0 (:,J ), PWaveAccC0HxiMCFPz0(:,J ),FFT_Data, ErrStatTmp ) - CALL SetErrStat(ErrStatTmp,'Error occured while applying the FFT to PWaveAcc0HxiMCFPz0.', ErrStat,ErrMsg,RoutineName) - - CALL ApplyFFT_cx ( PWaveAcc0HyiMCFPz0 (:,J ), PWaveAccC0HyiMCFPz0(:,J ),FFT_Data, ErrStatTmp ) - CALL SetErrStat(ErrStatTmp,'Error occured while applying the FFT to PWaveAcc0HyiMCFPz0.', ErrStat,ErrMsg,RoutineName) - CALL ApplyFFT_cx ( PWaveAcc0VMCFPz0 (:,J ), PWaveAccC0VMCFPz0( :,J ), FFT_Data, ErrStatTmp ) - CALL SetErrStat(ErrStatTmp,'Error occured while applying the FFT to PWaveAcc0VMCFPz0.', ErrStat,ErrMsg,RoutineName) - - IF ( ErrStat >= AbortErrLev ) THEN - CALL CleanUp() - RETURN - END IF - - END DO - END IF - - END IF -!=================================== + END IF + CALL ExitFFT(FFT_Data, ErrStatTmp) + CALL SetErrStat(ErrStatTmp,'Error occured while cleaning up after the FFTs.', ErrStat,ErrMsg,RoutineName) + IF ( ErrStat >= AbortErrLev ) THEN + CALL CleanUp() + RETURN + END IF - CALL ExitFFT(FFT_Data, ErrStatTmp) - CALL SetErrStat(ErrStatTmp,'Error occured while cleaning up after the FFTs.', ErrStat,ErrMsg,RoutineName) - IF ( ErrStat >= AbortErrLev ) THEN - CALL CleanUp() - RETURN - END IF + ! 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. - ! 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 there is a current, we need to add that (the current module was called prior to calling this module + IF(ALLOCATED(InitInp%CurrVxi)) THEN - IF(ALLOCATED(InitInp%CurrVxi)) THEN + DO J = 1,NWaveKin0Prime ! Loop through all points where the incident wave kinematics will be computed without stretching - 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 - 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 - 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 - ! 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 - 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: - ! 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. - ! 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 - ! 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: + 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) - ! InitOut%PWaveDynP0(:,:,:,:) = 0.0 + ! 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 + + ! MacCamy-Fuchs scaled fluid acceleration + IF (WaveField%MCFD > 0.0_SiKi) THEN 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 - + 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%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) + 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 + END IF - ! MacCamy-Fuchs scaled fluid acceleration + IF (WaveField%WaveStMod .EQ. 2_IntKi) THEN ! Extrapolation Wave Stretching + + primeCount = 1 + DO j = 1, InitInp%NGrid(2) ! Loop through all points on the SWL where partial derivatives about z were computed + DO i = 1, InitInp%NGrid(1) + WaveField%PWaveDynP0(0:WaveField%NStepWave-1,i,j ) = PWaveDynP0BPz0( 0:WaveField%NStepWave-1,primeCount) + WaveField%PWaveVel0 (0:WaveField%NStepWave-1,i,j,1) = PWaveVel0HxiPz0(0:WaveField%NStepWave-1,primeCount) + WaveField%PWaveVel0 (0:WaveField%NStepWave-1,i,j,2) = PWaveVel0HyiPz0(0:WaveField%NStepWave-1,primeCount) + WaveField%PWaveVel0 (0:WaveField%NStepWave-1,i,j,3) = PWaveVel0VPz0( 0:WaveField%NStepWave-1,primeCount) + WaveField%PWaveAcc0 (0:WaveField%NStepWave-1,i,j,1) = pWaveAcc0HxiPz0(0:WaveField%NStepWave-1,primeCount) + WaveField%PWaveAcc0 (0:WaveField%NStepWave-1,i,j,2) = pWaveAcc0HyiPz0(0:WaveField%NStepWave-1,primeCount) + WaveField%PWaveAcc0 (0:WaveField%NStepWave-1,i,j,3) = PWaveAcc0VPz0( 0:WaveField%NStepWave-1,primeCount) + primeCount = primeCount + 1 + END DO + END DO + 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 - END IF - - IF (WaveField%WaveStMod .EQ. 2_IntKi) THEN ! Extrapolation Wave Stretching - primeCount = 1 DO j = 1, InitInp%NGrid(2) ! Loop through all points on the SWL where partial derivatives about z were computed DO i = 1, InitInp%NGrid(1) - WaveField%PWaveDynP0(0:WaveField%NStepWave-1,i,j ) = PWaveDynP0BPz0( 0:WaveField%NStepWave-1,primeCount) - WaveField%PWaveVel0 (0:WaveField%NStepWave-1,i,j,1) = PWaveVel0HxiPz0(0:WaveField%NStepWave-1,primeCount) - WaveField%PWaveVel0 (0:WaveField%NStepWave-1,i,j,2) = PWaveVel0HyiPz0(0:WaveField%NStepWave-1,primeCount) - WaveField%PWaveVel0 (0:WaveField%NStepWave-1,i,j,3) = PWaveVel0VPz0( 0:WaveField%NStepWave-1,primeCount) - WaveField%PWaveAcc0 (0:WaveField%NStepWave-1,i,j,1) = pWaveAcc0HxiPz0(0:WaveField%NStepWave-1,primeCount) - WaveField%PWaveAcc0 (0:WaveField%NStepWave-1,i,j,2) = pWaveAcc0HyiPz0(0:WaveField%NStepWave-1,primeCount) - WaveField%PWaveAcc0 (0:WaveField%NStepWave-1,i,j,3) = PWaveAcc0VPz0( 0:WaveField%NStepWave-1,primeCount) + WaveField%PWaveAccMCF0 (0:WaveField%NStepWave-1,i,j,1) = pWaveAcc0HxiMCFPz0(0:WaveField%NStepWave-1,primeCount) + WaveField%PWaveAccMCF0 (0:WaveField%NStepWave-1,i,j,2) = pWaveAcc0HyiMCFPz0(0:WaveField%NStepWave-1,primeCount) + WaveField%PWaveAccMCF0 (0:WaveField%NStepWave-1,i,j,3) = PWaveAcc0VMCFPz0( 0:WaveField%NStepWave-1,primeCount) primeCount = primeCount + 1 END DO END DO - - IF (WaveField%MCFD > 0.0_SiKi) THEN - primeCount = 1 - DO j = 1, InitInp%NGrid(2) ! Loop through all points on the SWL where partial derivatives about z were computed - DO i = 1, InitInp%NGrid(1) - WaveField%PWaveAccMCF0 (0:WaveField%NStepWave-1,i,j,1) = pWaveAcc0HxiMCFPz0(0:WaveField%NStepWave-1,primeCount) - WaveField%PWaveAccMCF0 (0:WaveField%NStepWave-1,i,j,2) = pWaveAcc0HyiMCFPz0(0:WaveField%NStepWave-1,primeCount) - WaveField%PWaveAccMCF0 (0:WaveField%NStepWave-1,i,j,3) = PWaveAcc0VMCFPz0( 0:WaveField%NStepWave-1,primeCount) - primeCount = primeCount + 1 - END DO - END DO - END IF - END IF + END IF - ! END DO ! J - All points where the incident wave kinematics will be computed - - ! CASE ( 1 ) ! Vertical stretching. - - - ! Vertical stretching says that the wave kinematics above the mean sea level - ! equal the wave kinematics at the mean sea level. The wave kinematics - ! below the mean sea level are left unchanged: + ! CASE ( 1 ) ! Vertical stretching. + ! Vertical stretching says that the wave kinematics above the mean sea level + ! equal the wave kinematics at the mean sea level. The wave kinematics + ! below the mean sea level are left unchanged: + ! CASE ( 2 ) ! Extrapolation stretching. + ! Extrapolation stretching uses a linear Taylor expansion of the wave + ! kinematics (and their partial derivatives with respect to z) at the mean + ! sea level to find the wave kinematics above the mean sea level. The + ! wave kinematics below the mean sea level are left unchanged: - - ! CASE ( 2 ) ! Extrapolation stretching. - - - ! Extrapolation stretching uses a linear Taylor expansion of the wave - ! kinematics (and their partial derivatives with respect to z) at the mean - ! sea level to find the wave kinematics above the mean sea level. The - ! wave kinematics below the mean sea level are left unchanged: - - - - - - ! CASE ( 3 ) ! Wheeler stretching. - - - ! Wheeler stretching says that wave kinematics calculated using Airy theory - ! at the mean sea level should actually be applied at the instantaneous - ! free surface and that Airy wave kinematics computed at locations between - ! the seabed and the mean sea level should be shifted vertically to new - ! locations in proportion to their elevation above the seabed. - ! - ! Computing the wave kinematics with Wheeler stretching requires that first - ! say that the wave kinematics we computed at the elevations defined by - ! the WaveKinzi0Prime(:) array are actual applied at the elevations found - ! by stretching the elevations in the WaveKinzi0Prime(:) array using the - ! instantaneous wave elevation--these new elevations are stored in the - ! WaveKinzi0St(:) array. Next, we interpolate the wave kinematics - ! computed without stretching to the desired elevations (defined in the - ! WaveKinGridzi(:) array) using the WaveKinzi0St(:) array: - - - - - ! ENDSELECT - - ! Set the ending timestep to the same as the first timestep - 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,:,:,:,:) + ! CASE ( 3 ) ! Wheeler stretching. + ! Wheeler stretching says that wave kinematics calculated using Airy theory + ! at the mean sea level should actually be applied at the instantaneous + ! free surface and that Airy wave kinematics computed at locations between + ! the seabed and the mean sea level should be shifted vertically to new + ! locations in proportion to their elevation above the seabed. + ! + ! Computing the wave kinematics with Wheeler stretching requires that first + ! say that the wave kinematics we computed at the elevations defined by + ! the WaveKinzi0Prime(:) array are actual applied at the elevations found + ! by stretching the elevations in the WaveKinzi0Prime(:) array using the + ! instantaneous wave elevation--these new elevations are stored in the + ! WaveKinzi0St(:) array. Next, we interpolate the wave kinematics + ! computed without stretching to the desired elevations (defined in the + ! WaveKinGridzi(:) array) using the WaveKinzi0St(:) array: + + ! ENDSELECT + + ! Set the ending timestep to the same as the first timestep + 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,:,:,:) + WaveField%PWaveAcc0 (WaveField%NStepWave,:,:,:) = WaveField%PWaveAcc0 (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,:,:,:) - WaveField%PWaveAcc0 (WaveField%NStepWave,:,:,:) = WaveField%PWaveAcc0 (0,:,:,:) - IF (WaveField%MCFD > 0.0_SiKi) THEN - WaveField%PWaveAccMCF0 (WaveField%NStepWave,:,:,:) = WaveField%PWaveAccMCF0(0,:,:,:) - END IF + WaveField%PWaveAccMCF0 (WaveField%NStepWave,:,:,:) = WaveField%PWaveAccMCF0(0,:,:,:) END IF + END IF CALL CleanUp ( ) CONTAINS - + logical function Failed() + CALL SetErrStat( ErrStatTmp, ErrMsgTmp, ErrStat, ErrMsg, RoutineName ) + Failed = ErrStat >= AbortErrLev + if (Failed) CALL Cleanup() + end function + logical function Failed0(TmpName) + character(*), intent(in) :: TmpName + if (ErrStatTmp /= 0) then + ErrStatTmp = ErrID_Fatal + CALL SetErrStat( ErrStatTmp, 'Error while allocating '//trim(TmpName), ErrStat, ErrMsg, RoutineName ) + endif + Failed0 = ErrStat >= AbortErrLev + if (Failed0) CALL Cleanup() + end function + logical function FailedFFT(TmpName) + character(*), intent(in) :: TmpName + CALL SetErrStat( ErrStatTmp, 'Error occured while applying the FFT to '//trim(TmpName), ErrStat, ErrMsg, RoutineName ) + FailedFFT = ErrStat >= AbortErrLev + if (FailedFFT) CALL Cleanup() + end function !-------------------------------------------------------------------------------- SUBROUTINE WaveElevTimeSeriesAtXY(Xcoord,Ycoord, WaveElevAtXY, WaveElevCAtXY, tmpComplexArr, ErrStatLcl, ErrMsgLcl ) @@ -1630,23 +1435,18 @@ END SUBROUTINE VariousWaves_Init !> This routine is called at the start of the simulation to perform initialization steps. !! The initial states and initial guess for the input are defined. SUBROUTINE Waves_Init( InitInp, InitOut, WaveField, ErrStat, ErrMsg ) -!.................................................................................................................................. - TYPE(Waves_InitInputType), INTENT(INOUT) :: InitInp !< Input data for initialization routine !NOTE: We are making this INOUT because UserWaveComponents_Init changes the value of InitInp%WaveDT TYPE(Waves_InitOutputType), INTENT( OUT) :: InitOut !< Output for initialization routine TYPE(SeaSt_WaveFieldType), INTENT(INOUT) :: WaveField ! SeaState wave field type containing the wave field data INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - ! Local Variables: INTEGER(IntKi) :: ErrStatTmp ! Temporary error status for processing CHARACTER(ErrMsgLen) :: ErrMsgTmp ! Temporary error message for procesing ! Initialize ErrStat - ErrStat = ErrID_None ErrStatTmp = ErrID_None ErrMsg = "" @@ -1657,19 +1457,15 @@ SUBROUTINE Waves_Init( InitInp, InitOut, WaveField, ErrStat, ErrMsg ) CALL RandNum_Init(InitInp%RNG, ErrStat, ErrMsg) IF ( ErrStat >= AbortErrLev ) RETURN - ! Define initialization-routine output here: - - - - ! Initialize the variables associated with the incident wave: + ! Initialize the variables associated with the incident wave: SELECT CASE ( WaveField%WaveMod ) ! Which incident wave kinematics model are we using? CASE ( WaveMod_None ) ! None=still water. CALL StillWaterWaves_Init( InitInp, InitOut, WaveField, ErrStatTmp, ErrMsgTmp ) - CALL SetErrStat(ErrStatTmp,ErrMsgTmp,ErrStat,ErrMsg,'Waves_Init') + CALL SetErrStat(ErrStatTmp,ErrMsgTmp,ErrStat,ErrMsg,'Waves_Init') IF ( ErrStat >= AbortErrLev ) RETURN @@ -1678,8 +1474,8 @@ SUBROUTINE Waves_Init( InitInp, InitOut, WaveField, ErrStat, ErrMsg ) ! Now call the init with all the zi locations for the Morrison member nodes CALL VariousWaves_Init( InitInp, InitOut, WaveField, ErrStatTmp, ErrMsgTmp ) - CALL SetErrStat(ErrStatTmp,ErrMsgTmp,ErrStat,ErrMsg,'Waves_Init') - IF ( ErrStat >= AbortErrLev ) RETURN + CALL SetErrStat(ErrStatTmp,ErrMsgTmp,ErrStat,ErrMsg,'Waves_Init') + IF ( ErrStat >= AbortErrLev ) RETURN CASE ( WaveMod_ExtElev ) ! User-supplied wave elevation time history; HD derives full wave kinematics from this elevation time series data. @@ -1691,7 +1487,7 @@ SUBROUTINE Waves_Init( InitInp, InitOut, WaveField, ErrStat, ErrMsg ) ! Now call VariousWaves to continue using the wave elevation and derived frequency information from the file CALL VariousWaves_Init( InitInp, InitOut, WaveField, ErrStatTmp, ErrMsgTmp ) - CALL SetErrStat(ErrStatTmp,ErrMsgTmp,ErrStat,ErrMsg,'Waves_Init') + CALL SetErrStat(ErrStatTmp,ErrMsgTmp,ErrStat,ErrMsg,'Waves_Init') IF ( ErrStat >= AbortErrLev ) RETURN @@ -1705,12 +1501,12 @@ SUBROUTINE Waves_Init( InitInp, InitOut, WaveField, ErrStat, ErrMsg ) ! Get the wave frequency information from the file (by reading in wave frequency components) CALL UserWaveComponents_Init( InitInp, InitOut, WaveField, ErrStatTmp, ErrMsgTmp ) - CALL SetErrStat(ErrStatTmp,ErrMsgTmp,ErrStat,ErrMsg,'Waves_Init') + CALL SetErrStat(ErrStatTmp,ErrMsgTmp,ErrStat,ErrMsg,'Waves_Init') IF ( ErrStat >= AbortErrLev ) RETURN ! Now call VariousWaves to continue using the wave frequency information from the file CALL VariousWaves_Init( InitInp, InitOut, WaveField, ErrStatTmp, ErrMsgTmp ) - CALL SetErrStat(ErrStatTmp,ErrMsgTmp,ErrStat,ErrMsg,'Waves_Init') + CALL SetErrStat(ErrStatTmp,ErrMsgTmp,ErrStat,ErrMsg,'Waves_Init') IF ( ErrStat >= AbortErrLev ) RETURN ENDSELECT diff --git a/vs-build/FASTlib/FASTlib.vfproj b/vs-build/FASTlib/FASTlib.vfproj index 9325e85b01..afd7a04d23 100644 --- a/vs-build/FASTlib/FASTlib.vfproj +++ b/vs-build/FASTlib/FASTlib.vfproj @@ -2179,44 +2179,6 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - @@ -2306,7 +2268,6 @@ - diff --git a/vs-build/HydroDyn/HydroDynDriver.vfproj b/vs-build/HydroDyn/HydroDynDriver.vfproj index 82488ba7a2..91a7989cbf 100644 --- a/vs-build/HydroDyn/HydroDynDriver.vfproj +++ b/vs-build/HydroDyn/HydroDynDriver.vfproj @@ -558,30 +558,6 @@ - - - - - - - - - - - - - - - - - - - - - - - - @@ -641,7 +617,6 @@ - diff --git a/vs-build/HydroDyn_c_binding/HydroDyn_c_binding.vfproj b/vs-build/HydroDyn_c_binding/HydroDyn_c_binding.vfproj index 4481a2cde7..f447d872ac 100644 --- a/vs-build/HydroDyn_c_binding/HydroDyn_c_binding.vfproj +++ b/vs-build/HydroDyn_c_binding/HydroDyn_c_binding.vfproj @@ -318,30 +318,6 @@ - - - - - - - - - - - - - - - - - - - - - - - - @@ -401,7 +377,6 @@ - diff --git a/vs-build/RunRegistry.bat b/vs-build/RunRegistry.bat index adbc861f41..28964ae6dc 100644 --- a/vs-build/RunRegistry.bat +++ b/vs-build/RunRegistry.bat @@ -224,7 +224,6 @@ GOTO checkError :Current :Waves :Waves2 -:SeaState_Interp :SeaSt_WaveField SET CURR_LOC=%SEAST_Loc% diff --git a/vs-build/SeaState/SeaStateDriver.vfproj b/vs-build/SeaState/SeaStateDriver.vfproj index 208b6ce568..2d598d9e7c 100644 --- a/vs-build/SeaState/SeaStateDriver.vfproj +++ b/vs-build/SeaState/SeaStateDriver.vfproj @@ -295,29 +295,6 @@ - - - - - - - - - - - - - - - - - - - - - - - @@ -358,7 +335,6 @@ -