diff --git a/modules/seastate/src/SeaState.f90 b/modules/seastate/src/SeaState.f90 index 3cd3b9dde..2b863f07a 100644 --- a/modules/seastate/src/SeaState.f90 +++ b/modules/seastate/src/SeaState.f90 @@ -225,7 +225,6 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init p%WaveElev1 => p%WaveField%WaveElev1 p%WaveVel => p%WaveField%WaveVel p%WaveAcc => p%WaveField%WaveAcc - p%WaveDynP => p%WaveField%WaveDynP p%PWaveVel0 => p%WaveField%PWaveVel0 p%PWaveAcc0 => p%WaveField%PWaveAcc0 p%PWaveDynP0 => p%WaveField%PWaveDynP0 @@ -313,64 +312,18 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init ! Difference frequency results IF ( p%Waves2%WvDiffQTFF ) THEN - ! Dynamic pressure -- difference frequency terms - IF ( SIZE(p%WaveDynP,DIM=1) /= SIZE(Waves2_InitOut%WaveDynP2D,DIM=1) .OR. & - SIZE(p%WaveDynP,DIM=2) /= SIZE(Waves2_InitOut%WaveDynP2D,DIM=2).OR. & - SIZE(p%WaveDynP,DIM=3) /= SIZE(Waves2_InitOut%WaveDynP2D,DIM=3).OR. & - SIZE(p%WaveDynP,DIM=4) /= SIZE(Waves2_InitOut%WaveDynP2D,DIM=4)) THEN - CALL SetErrStat(ErrID_Fatal, & - ' WaveDynP arrays for first and second order wave elevations are of different sizes. '//NewLine// & - 'Waves: '// TRIM(Num2LStr(SIZE(p%WaveDynP,DIM=1)))//'x'// & - TRIM(Num2LStr(SIZE(p%WaveDynP,DIM=2)))//'x'// & - TRIM(Num2LStr(SIZE(p%WaveDynP,DIM=3)))//'x'// & - TRIM(Num2LStr(SIZE(p%WaveDynP,DIM=4)))//NewLine// & - 'Waves2: '// TRIM(Num2LStr(SIZE(Waves2_InitOut%WaveDynP2D,DIM=1)))//'x'// & - TRIM(Num2LStr(SIZE(Waves2_InitOut%WaveDynP2D,DIM=2)))//'x'// & - TRIM(Num2LStr(SIZE(Waves2_InitOut%WaveDynP2D,DIM=3)))//'x'// & - TRIM(Num2LStr(SIZE(Waves2_InitOut%WaveDynP2D,DIM=4))), & - ErrStat,ErrMsg,RoutineName) - CALL CleanUp() - RETURN - ELSE - p%WaveField%WaveDynP = p%WaveField%WaveDynP + Waves2_InitOut%WaveDynP2D - !IF (InputFileData%Waves%WaveStMod > 0 ) WaveDynP0 = WaveDynP0 + WaveDynP2D0 - ENDIF + ! Dynamic pressure -- difference frequency terms + CALL AddArrays_4D(p%WaveField%WaveDynP, Waves2_InitOut%WaveDynP2D,'WaveDynP', ErrStat2, ErrMsg2) ! WaveDynP = WaveDynP + WaveDynP2D + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! Particle velocity -- difference frequency terms - IF ( SIZE(p%WaveVel,DIM=1) /= SIZE(Waves2_InitOut%WaveVel2D,DIM=1) .OR. & - SIZE(p%WaveVel,DIM=2) /= SIZE(Waves2_InitOut%WaveVel2D,DIM=2) .OR. & - SIZE(p%WaveVel,DIM=3) /= SIZE(Waves2_InitOut%WaveVel2D,DIM=3) .OR. & - SIZE(p%WaveVel,DIM=4) /= SIZE(Waves2_InitOut%WaveVel2D,DIM=4) .OR. & - SIZE(p%WaveVel,DIM=5) /= SIZE(Waves2_InitOut%WaveVel2D,DIM=5)) THEN - CALL SetErrStat(ErrID_Fatal, & - ' WaveVel arrays for first and second order wave elevations are of different sizes.',ErrStat,ErrMsg,RoutineName) - CALL CleanUp() - RETURN - ELSE - p%WaveField%WaveVel = p%WaveField%WaveVel + Waves2_InitOut%WaveVel2D - !IF (InputFileData%Waves%WaveStMod > 0 ) WaveVel0 = WaveVel0 + WaveVel2D0 - ENDIF - + CALL AddArrays_5D(p%WaveField%WaveVel, Waves2_InitOut%WaveVel2D,'WaveVel', ErrStat2, ErrMsg2) ! WaveVel = WaveVel + WaveVel2D + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! Particle acceleration -- difference frequency terms - IF ( SIZE(p%WaveAcc,DIM=1) /= SIZE(Waves2_InitOut%WaveAcc2D,DIM=1) .OR. & - SIZE(p%WaveAcc,DIM=2) /= SIZE(Waves2_InitOut%WaveAcc2D,DIM=2) .OR. & - SIZE(p%WaveAcc,DIM=3) /= SIZE(Waves2_InitOut%WaveAcc2D,DIM=3) .OR. & - SIZE(p%WaveAcc,DIM=4) /= SIZE(Waves2_InitOut%WaveAcc2D,DIM=4) .OR. & - SIZE(p%WaveAcc,DIM=5) /= SIZE(Waves2_InitOut%WaveAcc2D,DIM=5)) THEN - CALL SetErrStat(ErrID_Fatal, & - ' WaveAcc arrays for first and second order wave elevations are of different sizes.',ErrStat,ErrMsg,RoutineName) - CALL CleanUp() - RETURN - ELSE - p%WaveField%WaveAcc = p%WaveField%WaveAcc + Waves2_InitOut%WaveAcc2D - !IF (InputFileData%Waves%WaveStMod > 0 ) WaveAcc0 = WaveAcc0 + WaveAcc2D0 - ! MacCamy-Fuchs scaled acceleration should not contain second-order contributions - !IF (InputFileData%Waves%MCFD > 0) THEN - ! p%WaveAccMCF = p%WaveAccMCF + Waves2_InitOut%WaveAcc2D - !END IF - - ENDIF + CALL AddArrays_5D(p%WaveField%WaveAcc, Waves2_InitOut%WaveAcc2D,'WaveAcc', ErrStat2, ErrMsg2) ! WaveAcc = WaveAcc + WaveAcc2D + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + ENDIF ! second order wave kinematics difference frequency results @@ -378,63 +331,20 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init IF ( p%Waves2%WvSumQTFF ) THEN ! Dynamic pressure -- sum frequency terms - IF ( SIZE(p%WaveDynP,DIM=1) /= SIZE(Waves2_InitOut%WaveDynP2S,DIM=1) .OR. & - SIZE(p%WaveDynP,DIM=2) /= SIZE(Waves2_InitOut%WaveDynP2S,DIM=2) .OR. & - SIZE(p%WaveDynP,DIM=3) /= SIZE(Waves2_InitOut%WaveDynP2S,DIM=3) .OR. & - SIZE(p%WaveDynP,DIM=4) /= SIZE(Waves2_InitOut%WaveDynP2S,DIM=4)) THEN - CALL SetErrStat(ErrID_Fatal, & - ' WaveDynP arrays for first and second order wave elevations are of different sizes. '//NewLine// & - 'Waves: '// TRIM(Num2LStr(SIZE(p%WaveDynP,DIM=1)))//'x'// & - TRIM(Num2LStr(SIZE(p%WaveDynP,DIM=2)))//'x'// & - TRIM(Num2LStr(SIZE(p%WaveDynP,DIM=3)))//'x'// & - TRIM(Num2LStr(SIZE(p%WaveDynP,DIM=4)))//NewLine// & - 'Waves2: '// TRIM(Num2LStr(SIZE(Waves2_InitOut%WaveDynP2D,DIM=1)))//'x'// & - TRIM(Num2LStr(SIZE(Waves2_InitOut%WaveDynP2D,DIM=2)))//'x'// & - TRIM(Num2LStr(SIZE(Waves2_InitOut%WaveDynP2D,DIM=3)))//'x'// & - TRIM(Num2LStr(SIZE(Waves2_InitOut%WaveDynP2D,DIM=4))), & - ErrStat,ErrMsg,RoutineName) - CALL CleanUp() - RETURN - ELSE - p%WaveField%WaveDynP = p%WaveField%WaveDynP + Waves2_InitOut%WaveDynP2S - !IF (InputFileData%Waves%WaveStMod > 0 ) WaveDynP0 = WaveDynP0 + WaveDynP2S0 - ENDIF + CALL AddArrays_4D(p%WaveField%WaveDynP, Waves2_InitOut%WaveDynP2S,'WaveDynP', ErrStat2, ErrMsg2) ! WaveDynP = WaveDynP + WaveDynP2S + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! Particle velocity -- sum frequency terms - IF ( SIZE(p%WaveVel,DIM=1) /= SIZE(Waves2_InitOut%WaveVel2S,DIM=1) .OR. & - SIZE(p%WaveVel,DIM=2) /= SIZE(Waves2_InitOut%WaveVel2S,DIM=2) .OR. & - SIZE(p%WaveVel,DIM=3) /= SIZE(Waves2_InitOut%WaveVel2S,DIM=3) .OR. & - SIZE(p%WaveVel,DIM=4) /= SIZE(Waves2_InitOut%WaveVel2S,DIM=4) .OR. & - SIZE(p%WaveVel,DIM=5) /= SIZE(Waves2_InitOut%WaveVel2S,DIM=5)) THEN - CALL SetErrStat(ErrID_Fatal, & - ' WaveVel arrays for first and second order wave elevations are of different sizes.',ErrStat,ErrMsg,RoutineName) - CALL CleanUp() - RETURN - ELSE - p%WaveField%WaveVel = p%WaveField%WaveVel + Waves2_InitOut%WaveVel2S - !IF (InputFileData%Waves%WaveStMod > 0 ) WaveVel0 = WaveVel0 + WaveVel2S0 - ENDIF + CALL AddArrays_5D(p%WaveField%WaveVel, Waves2_InitOut%WaveVel2S,'WaveVel', ErrStat2, ErrMsg2) ! WaveVel = WaveVel + WaveVel2S + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - ! Particle velocity -- sum frequency terms - IF ( SIZE(p%WaveAcc,DIM=1) /= SIZE(Waves2_InitOut%WaveAcc2S,DIM=1) .OR. & - SIZE(p%WaveAcc,DIM=2) /= SIZE(Waves2_InitOut%WaveAcc2S,DIM=2) .OR. & - SIZE(p%WaveAcc,DIM=3) /= SIZE(Waves2_InitOut%WaveAcc2S,DIM=3) .OR. & - SIZE(p%WaveAcc,DIM=4) /= SIZE(Waves2_InitOut%WaveAcc2S,DIM=4) .OR. & - SIZE(p%WaveAcc,DIM=5) /= SIZE(Waves2_InitOut%WaveAcc2S,DIM=5)) THEN - CALL SetErrStat(ErrID_Fatal, & - ' WaveAcc arrays for first and second order wave elevations are of different sizes.',ErrStat,ErrMsg,RoutineName) - CALL CleanUp() - RETURN - ELSE - p%WaveField%WaveAcc = p%WaveField%WaveAcc + Waves2_InitOut%WaveAcc2S - !IF (InputFileData%Waves%WaveStMod > 0 ) WaveAcc0 = WaveAcc0 + WaveAcc2S0 - ! MacCamy-Fuchs scaled accleration should not contain second-order contributions - !IF (InputFileData%Waves%MCFD > 0) THEN - ! p%WaveAccMCF = p%WaveAccMCF + Waves2_InitOut%WaveAcc2S - !END IF - ENDIF + ! 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', ErrStat2, ErrMsg2) ! WaveAcc = WaveAcc + WaveAcc2S + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) 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 @@ -500,7 +410,6 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init ! Copy Waves InitOut data to SeaState InitOut ! ... pointer data: InitOut%WaveElev1 => p%WaveField%WaveElev1 - InitOut%WaveDynP => p%WaveField%WaveDynP ! For Morison InitOut%WaveAcc => p%WaveField%WaveAcc ! For Morison InitOut%WaveVel => p%WaveField%WaveVel ! For Morison InitOut%PWaveDynP0 => p%WaveField%PWaveDynP0 ! For Morison @@ -543,7 +452,6 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init ! p%WaveField%WaveElev1 => Waves_InitOut%WaveElev ! p%WaveField%WaveVel => Waves_InitOut%WaveVel ! p%WaveField%WaveAcc => Waves_InitOut%WaveAcc - ! p%WaveField%WaveDynP => Waves_InitOut%WaveDynP ! p%WaveField%PWaveVel0 => Waves_InitOut%PWaveVel0 ! p%WaveField%PWaveAcc0 => Waves_InitOut%PWaveAcc0 ! p%WaveField%PWaveDynP0 => Waves_InitOut%PWaveDynP0 @@ -562,13 +470,15 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init ! Write Wave Kinematics? if ( InputFileData%Waves%WaveMod /= 6 ) then if ( InitInp%WrWvKinMod == 2 ) then - call SeaStOut_WriteWvKinFiles( InitInp%OutRootname, SeaSt_ProgDesc, p%NStepWave, p%WaveDT, p%X_HalfWidth, p%Y_HalfWidth, & + call SeaStOut_WriteWvKinFiles( InitInp%OutRootname, SeaSt_ProgDesc, p%WaveField, p%NStepWave, p%WaveDT, p%X_HalfWidth, p%Y_HalfWidth, & p%Z_Depth, p%deltaGrid, p%NGrid, InitOut%WaveElev1, InitOut%WaveElev2, & - InitOut%WaveVel, InitOut%WaveAcc, InitOut%WaveDynP, ErrStat, ErrMsg ) + InitOut%WaveVel, InitOut%WaveAcc, ErrStat2, ErrMsg2 ) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) else if ( InitInp%WrWvKinMod == 1 ) then call SeaStOut_WriteWaveElev0(InitInp%OutRootname, p%NStepWave, & p%NGrid, InitOut%WaveElev1, InitOut%WaveElev2, & - p%WaveField%WaveTime, ErrStat, ErrMsg ) + p%WaveField%WaveTime, ErrStat2, ErrMsg2 ) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) end if end if @@ -666,9 +576,73 @@ SUBROUTINE CleanUp() END SUBROUTINE CleanUp !................................ + END SUBROUTINE SeaSt_Init +!---------------------------------------------------------------------------------------------------------------------------------- +SUBROUTINE AddArrays_4D(Array1, Array2, ArrayName, ErrStat, ErrMsg) + REAL(SiKi), INTENT(INOUT) :: Array1(:,:,:,:) + REAL(SiKi), INTENT(IN ) :: Array2(:,:,:,:) + CHARACTER(*), INTENT(IN ) :: ArrayName + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + IF ( SIZE(Array1,DIM=1) /= SIZE(Array2,DIM=1) .OR. & + SIZE(Array1,DIM=2) /= SIZE(Array2,DIM=2) .OR. & + SIZE(Array1,DIM=3) /= SIZE(Array2,DIM=3) .OR. & + SIZE(Array1,DIM=4) /= SIZE(Array2,DIM=4)) THEN + + ErrStat = ErrID_Fatal + ErrMsg = TRIM(ArrayName)//' arrays for first and second order wave elevations are of different sizes: '//NewLine// & + 'Waves: '// TRIM(Num2LStr(SIZE(Array1,DIM=1)))//'x'// & + TRIM(Num2LStr(SIZE(Array1,DIM=2)))//'x'// & + TRIM(Num2LStr(SIZE(Array1,DIM=3)))//'x'// & + TRIM(Num2LStr(SIZE(Array1,DIM=4)))//NewLine// & + 'Waves2: '// TRIM(Num2LStr(SIZE(Array2,DIM=1)))//'x'// & + TRIM(Num2LStr(SIZE(Array2,DIM=2)))//'x'// & + TRIM(Num2LStr(SIZE(Array2,DIM=3)))//'x'// & + TRIM(Num2LStr(SIZE(Array2,DIM=4))) + ELSE + ErrStat = ErrID_None + ErrMsg = "" + Array1 = Array1 + Array2 + ENDIF + +END SUBROUTINE AddArrays_4D +!---------------------------------------------------------------------------------------------------------------------------------- +SUBROUTINE AddArrays_5D(Array1, Array2, ArrayName, ErrStat, ErrMsg) + REAL(SiKi), INTENT(INOUT) :: Array1(:,:,:,:,:) + REAL(SiKi), INTENT(IN ) :: Array2(:,:,:,:,:) + CHARACTER(*), INTENT(IN ) :: ArrayName + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + IF ( SIZE(Array1,DIM=1) /= SIZE(Array2,DIM=1) .OR. & + SIZE(Array1,DIM=2) /= SIZE(Array2,DIM=2) .OR. & + SIZE(Array1,DIM=3) /= SIZE(Array2,DIM=3) .OR. & + SIZE(Array1,DIM=3) /= SIZE(Array2,DIM=4) .OR. & + SIZE(Array1,DIM=4) /= SIZE(Array2,DIM=5)) THEN + + ErrStat = ErrID_Fatal + ErrMsg = TRIM(ArrayName)//' arrays for first and second order wave elevations are of different sizes: '//NewLine// & + 'Waves: '// TRIM(Num2LStr(SIZE(Array1,DIM=1)))//'x'// & + TRIM(Num2LStr(SIZE(Array1,DIM=2)))//'x'// & + TRIM(Num2LStr(SIZE(Array1,DIM=3)))//'x'// & + TRIM(Num2LStr(SIZE(Array1,DIM=4)))//'x'// & + TRIM(Num2LStr(SIZE(Array1,DIM=5)))//NewLine// & + 'Waves2: '// TRIM(Num2LStr(SIZE(Array2,DIM=1)))//'x'// & + TRIM(Num2LStr(SIZE(Array2,DIM=2)))//'x'// & + TRIM(Num2LStr(SIZE(Array2,DIM=3)))//'x'// & + TRIM(Num2LStr(SIZE(Array2,DIM=4)))//'x'// & + TRIM(Num2LStr(SIZE(Array2,DIM=5))) + ELSE + ErrStat = ErrID_None + ErrMsg = "" + Array1 = Array1 + Array2 + ENDIF + +END SUBROUTINE AddArrays_5D !---------------------------------------------------------------------------------------------------------------------------------- !> This routine is called at the end of the simulation. SUBROUTINE SeaSt_End( u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) diff --git a/modules/seastate/src/SeaState.txt b/modules/seastate/src/SeaState.txt index c2e104891..5196e3c93 100644 --- a/modules/seastate/src/SeaState.txt +++ b/modules/seastate/src/SeaState.txt @@ -82,7 +82,6 @@ typedef ^ ^ SiKi WaveDirMax typedef ^ ^ SiKi WaveDir - - - "Incident wave propagation heading direction" (degrees) typedef ^ ^ LOGICAL WaveMultiDir - - - "Indicates the waves are multidirectional -- set by HydroDyn_Input" - typedef ^ ^ SiKi WaveDOmega - - - "Frequency step for incident wave calculations" (rad/s) -typedef ^ ^ SiKi WaveDynP {*}{*}{*}{*} - - "Instantaneous dynamic pressure of incident waves , accounting for stretching, at each of the NWaveKin (grid) points where the incident wave kinematics will be computed" (N/m^2) typedef ^ ^ SiKi WaveAcc {*}{*}{*}{*}{*} - - "Instantaneous acceleration of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, accounting for stretching, at each of the NWaveKin (grid) points where the incident wave kinematics will be computed" (m/s^2) typedef ^ ^ SiKi WaveAccMCF {*}{*}{*}{*}{*} - - "Instantaneous acceleration of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, accounting for stretching, at each of the NWaveKin (grid) points where the incident wave kinematics will be computed" (m/s^2) typedef ^ ^ SiKi WaveVel {*}{*}{*}{*}{*} - - "Instantaneous velocity of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, accounting for stretching, at each of the NWaveKin (grid) points where the incident wave kinematics will be computed (The values include both the velocity of incident waves and the velocity of current.)" (m/s) @@ -155,7 +154,6 @@ typedef ^ ^ SiKi Wav typedef ^ ^ SiKi WaveElev1 {*}{*}{*} - - "First order wave elevation" - typedef ^ ^ SiKi WaveElev2 {*}{*}{*} - - "Second order wave elevation" - typedef ^ ^ SiKi PWaveDynP0 {*}{*}{*} - - "Instantaneous dynamic pressure of incident waves , at the location (xi,yi,0), at each of the NWaveKin points where the incident wave kinematics will be computed" (N/m^2) -typedef ^ ^ SiKi WaveDynP {*}{*}{*}{*} - - "Instantaneous dynamic pressure of incident waves , accounting for stretching, at each of the NWaveKin points where the incident wave kinematics will be computed" (N/m^2) typedef ^ ^ SiKi WaveAcc {*}{*}{*}{*}{*} - - "Instantaneous acceleration of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, accounting for stretching, at each of the NWaveKin points where the incident wave kinematics will be computed" (m/s^2) typedef ^ ^ SiKi PWaveAcc0 {*}{*}{*}{*} - - "Instantaneous acceleration of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, at the location (xi,yi,0), at each of the NWaveKin points where the incident wave kinematics will be computed" (m/s^2) typedef ^ ^ SiKi WaveVel {*}{*}{*}{*}{*} - - "Instantaneous velocity of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, accounting for stretching, at each of the NWaveKin points where the incident wave kinematics will be computed (The values include both the velocity of incident waves and the velocity of current.)" (m/s) diff --git a/modules/seastate/src/SeaState_Output.f90 b/modules/seastate/src/SeaState_Output.f90 index 79bc15c46..f845f440b 100644 --- a/modules/seastate/src/SeaState_Output.f90 +++ b/modules/seastate/src/SeaState_Output.f90 @@ -232,13 +232,14 @@ MODULE SeaState_Output CONTAINS !==================================================================================================== -SUBROUTINE SeaStOut_WriteWvKinFiles( Rootname, SeaSt_Prog, NStepWave, WaveDT, X_HalfWidth, Y_HalfWidth, & +SUBROUTINE SeaStOut_WriteWvKinFiles( Rootname, SeaSt_Prog, WaveField, NStepWave, WaveDT, X_HalfWidth, Y_HalfWidth, & Z_Depth, deltaGrid, NGrid, WaveElev1, WaveElev2, & - WaveVel, WaveAcc, WaveDynP, ErrStat, ErrMsg ) + WaveVel, WaveAcc, ErrStat, ErrMsg ) ! Passed variables CHARACTER(*), INTENT( IN ) :: Rootname ! filename including full path, minus any file extension. TYPE(ProgDesc), INTENT( IN ) :: SeaSt_Prog ! the name/version/date of the SeaState program + TYPE(SeaSt_WaveFieldType), INTENT( IN ) :: WaveField !< WaveFieldType INTEGER, INTENT( IN ) :: NStepWave ! Number of time steps for the wave kinematics arrays real(DbKi), intent( in ) :: WaveDT real(ReKi), intent( in ) :: X_HalfWidth @@ -250,7 +251,6 @@ SUBROUTINE SeaStOut_WriteWvKinFiles( Rootname, SeaSt_Prog, NStepWave, WaveDT, X_ REAL(SiKi), pointer, INTENT( IN ) :: WaveElev2 (:,:,: ) ! Instantaneous wave elevations at requested locations - 2nd order REAL(SiKi), pointer, INTENT( IN ) :: WaveVel (:,:,:,:,:) ! The wave velocities (time,node,component) REAL(SiKi), pointer, INTENT( IN ) :: WaveAcc (:,:,:,:,:) ! The wave accelerations (time,node,component) - REAL(SiKi), pointer, INTENT( IN ) :: WaveDynP(:,:,:,:) ! The wave dynamic pressure (time,node) INTEGER, INTENT( OUT ) :: ErrStat ! returns a non-zero value when an error occurs CHARACTER(*), INTENT( OUT ) :: ErrMsg ! Error message if ErrStat /= ErrID_None @@ -319,7 +319,7 @@ SUBROUTINE SeaStOut_WriteWvKinFiles( Rootname, SeaSt_Prog, NStepWave, WaveDT, X_ CASE (6) WRITE(UnWv,Frmt,ADVANCE='no') Delim, WaveAcc (m,i,j,k,3) CASE (7) - WRITE(UnWv,Frmt,ADVANCE='no') Delim, WaveDynP(m,i,j,k ) + WRITE(UnWv,Frmt,ADVANCE='no') Delim, WaveField%WaveDynP(m,i,j,k ) END SELECT !END IF END DO ! for i diff --git a/modules/seastate/src/SeaState_Types.f90 b/modules/seastate/src/SeaState_Types.f90 index cb414aa92..3699be0fc 100644 --- a/modules/seastate/src/SeaState_Types.f90 +++ b/modules/seastate/src/SeaState_Types.f90 @@ -103,7 +103,6 @@ MODULE SeaState_Types REAL(SiKi) :: WaveDir = 0.0_R4Ki !< Incident wave propagation heading direction [(degrees)] LOGICAL :: WaveMultiDir = .false. !< Indicates the waves are multidirectional -- set by HydroDyn_Input [-] REAL(SiKi) :: WaveDOmega = 0.0_R4Ki !< Frequency step for incident wave calculations [(rad/s)] - REAL(SiKi) , DIMENSION(:,:,:,:), POINTER :: WaveDynP => NULL() !< Instantaneous dynamic pressure of incident waves , accounting for stretching, at each of the NWaveKin (grid) points where the incident wave kinematics will be computed [(N/m^2)] REAL(SiKi) , DIMENSION(:,:,:,:,:), POINTER :: WaveAcc => NULL() !< Instantaneous acceleration of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, accounting for stretching, at each of the NWaveKin (grid) points where the incident wave kinematics will be computed [(m/s^2)] REAL(SiKi) , DIMENSION(:,:,:,:,:), POINTER :: WaveAccMCF => NULL() !< Instantaneous acceleration of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, accounting for stretching, at each of the NWaveKin (grid) points where the incident wave kinematics will be computed [(m/s^2)] REAL(SiKi) , DIMENSION(:,:,:,:,:), POINTER :: WaveVel => NULL() !< Instantaneous velocity of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, accounting for stretching, at each of the NWaveKin (grid) points where the incident wave kinematics will be computed (The values include both the velocity of incident waves and the velocity of current.) [(m/s)] @@ -178,7 +177,6 @@ MODULE SeaState_Types REAL(SiKi) , DIMENSION(:,:,:), POINTER :: WaveElev1 => NULL() !< First order wave elevation [-] REAL(SiKi) , DIMENSION(:,:,:), POINTER :: WaveElev2 => NULL() !< Second order wave elevation [-] REAL(SiKi) , DIMENSION(:,:,:), POINTER :: PWaveDynP0 => NULL() !< Instantaneous dynamic pressure of incident waves , at the location (xi,yi,0), at each of the NWaveKin points where the incident wave kinematics will be computed [(N/m^2)] - REAL(SiKi) , DIMENSION(:,:,:,:), POINTER :: WaveDynP => NULL() !< Instantaneous dynamic pressure of incident waves , accounting for stretching, at each of the NWaveKin points where the incident wave kinematics will be computed [(N/m^2)] REAL(SiKi) , DIMENSION(:,:,:,:,:), POINTER :: WaveAcc => NULL() !< Instantaneous acceleration of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, accounting for stretching, at each of the NWaveKin points where the incident wave kinematics will be computed [(m/s^2)] REAL(SiKi) , DIMENSION(:,:,:,:), POINTER :: PWaveAcc0 => NULL() !< Instantaneous acceleration of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, at the location (xi,yi,0), at each of the NWaveKin points where the incident wave kinematics will be computed [(m/s^2)] REAL(SiKi) , DIMENSION(:,:,:,:,:), POINTER :: WaveVel => NULL() !< Instantaneous velocity of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, accounting for stretching, at each of the NWaveKin points where the incident wave kinematics will be computed (The values include both the velocity of incident waves and the velocity of current.) [(m/s)] @@ -742,7 +740,6 @@ subroutine SeaSt_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, DstInitOutputData%WaveDir = SrcInitOutputData%WaveDir DstInitOutputData%WaveMultiDir = SrcInitOutputData%WaveMultiDir DstInitOutputData%WaveDOmega = SrcInitOutputData%WaveDOmega - DstInitOutputData%WaveDynP => SrcInitOutputData%WaveDynP DstInitOutputData%WaveAcc => SrcInitOutputData%WaveAcc DstInitOutputData%WaveAccMCF => SrcInitOutputData%WaveAccMCF DstInitOutputData%WaveVel => SrcInitOutputData%WaveVel @@ -803,7 +800,6 @@ subroutine SeaSt_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) call NWTC_Library_DestroyProgDesc(InitOutputData%Ver, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) nullify(InitOutputData%WaveElevC) - nullify(InitOutputData%WaveDynP) nullify(InitOutputData%WaveAcc) nullify(InitOutputData%WaveAccMCF) nullify(InitOutputData%WaveVel) @@ -856,14 +852,6 @@ subroutine SeaSt_PackInitOutput(Buf, Indata) call RegPack(Buf, InData%WaveDir) call RegPack(Buf, InData%WaveMultiDir) call RegPack(Buf, InData%WaveDOmega) - call RegPack(Buf, associated(InData%WaveDynP)) - if (associated(InData%WaveDynP)) then - call RegPackBounds(Buf, 4, lbound(InData%WaveDynP), ubound(InData%WaveDynP)) - call RegPackPointer(Buf, c_loc(InData%WaveDynP), PtrInIndex) - if (.not. PtrInIndex) then - call RegPack(Buf, InData%WaveDynP) - end if - end if call RegPack(Buf, associated(InData%WaveAcc)) if (associated(InData%WaveAcc)) then call RegPackBounds(Buf, 5, lbound(InData%WaveAcc), ubound(InData%WaveAcc)) @@ -1055,30 +1043,6 @@ subroutine SeaSt_UnPackInitOutput(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%WaveDOmega) if (RegCheckErr(Buf, RoutineName)) return - if (associated(OutData%WaveDynP)) deallocate(OutData%WaveDynP) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 4, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpackPointer(Buf, Ptr, PtrIdx) - if (RegCheckErr(Buf, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%WaveDynP, UB(1:4)-LB(1:4)) - OutData%WaveDynP(LB(1):,LB(2):,LB(3):,LB(4):) => OutData%WaveDynP - else - allocate(OutData%WaveDynP(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveDynP.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - Buf%Pointers(PtrIdx) = c_loc(OutData%WaveDynP) - call RegUnpack(Buf, OutData%WaveDynP) - if (RegCheckErr(Buf, RoutineName)) return - end if - else - OutData%WaveDynP => null() - end if if (associated(OutData%WaveAcc)) deallocate(OutData%WaveAcc) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1650,7 +1614,6 @@ subroutine SeaSt_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg DstParamData%WaveElev1 => SrcParamData%WaveElev1 DstParamData%WaveElev2 => SrcParamData%WaveElev2 DstParamData%PWaveDynP0 => SrcParamData%PWaveDynP0 - DstParamData%WaveDynP => SrcParamData%WaveDynP DstParamData%WaveAcc => SrcParamData%WaveAcc DstParamData%PWaveAcc0 => SrcParamData%PWaveAcc0 DstParamData%WaveVel => SrcParamData%WaveVel @@ -1760,7 +1723,6 @@ subroutine SeaSt_DestroyParam(ParamData, ErrStat, ErrMsg) nullify(ParamData%WaveElev1) nullify(ParamData%WaveElev2) nullify(ParamData%PWaveDynP0) - nullify(ParamData%WaveDynP) nullify(ParamData%WaveAcc) nullify(ParamData%PWaveAcc0) nullify(ParamData%WaveVel) @@ -1847,14 +1809,6 @@ subroutine SeaSt_PackParam(Buf, Indata) call RegPack(Buf, InData%PWaveDynP0) end if end if - call RegPack(Buf, associated(InData%WaveDynP)) - if (associated(InData%WaveDynP)) then - call RegPackBounds(Buf, 4, lbound(InData%WaveDynP), ubound(InData%WaveDynP)) - call RegPackPointer(Buf, c_loc(InData%WaveDynP), PtrInIndex) - if (.not. PtrInIndex) then - call RegPack(Buf, InData%WaveDynP) - end if - end if call RegPack(Buf, associated(InData%WaveAcc)) if (associated(InData%WaveAcc)) then call RegPackBounds(Buf, 5, lbound(InData%WaveAcc), ubound(InData%WaveAcc)) @@ -2080,30 +2034,6 @@ subroutine SeaSt_UnPackParam(Buf, OutData) else OutData%PWaveDynP0 => null() end if - if (associated(OutData%WaveDynP)) deallocate(OutData%WaveDynP) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 4, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpackPointer(Buf, Ptr, PtrIdx) - if (RegCheckErr(Buf, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%WaveDynP, UB(1:4)-LB(1:4)) - OutData%WaveDynP(LB(1):,LB(2):,LB(3):,LB(4):) => OutData%WaveDynP - else - allocate(OutData%WaveDynP(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveDynP.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - Buf%Pointers(PtrIdx) = c_loc(OutData%WaveDynP) - call RegUnpack(Buf, OutData%WaveDynP) - if (RegCheckErr(Buf, RoutineName)) return - end if - else - OutData%WaveDynP => null() - end if if (associated(OutData%WaveAcc)) deallocate(OutData%WaveAcc) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return diff --git a/modules/seastate/src/Waves.txt b/modules/seastate/src/Waves.txt index f7a96cb9a..0d0de1800 100644 --- a/modules/seastate/src/Waves.txt +++ b/modules/seastate/src/Waves.txt @@ -72,7 +72,6 @@ typedef ^ ^ SiKi WaveDirMin typedef ^ ^ SiKi WaveDirMax - - - "Maximum wave direction." (degrees) typedef ^ ^ INTEGER WaveNDir - - - "Number of wave directions [only used if WaveDirMod = 1] [Must be an odd number -- will be adjusted within the waves module]" (-) typedef ^ ^ SiKi WaveDOmega - - - "Frequency step for incident wave calculations" (rad/s) -typedef ^ ^ SiKi WaveDynP {*}{*}{*}{*} - - "Instantaneous dynamic pressure of incident waves , accounting for stretching, at each of the NWaveKinGrid points where the incident wave kinematics will be computed" (N/m^2) typedef ^ ^ SiKi WaveAcc {*}{*}{*}{*}{*} - - "Instantaneous acceleration of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, accounting for stretching, at each of the NWaveKinGrid points where the incident wave kinematics will be computed" (m/s^2) typedef ^ ^ SiKi WaveAccMCF {*}{*}{*}{*}{*} - - "Instantaneous acceleration of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, accounting for stretching, at each of the NWaveKinGrid points where the incident wave kinematics will be computed" (m/s^2) typedef ^ ^ SiKi WaveVel {*}{*}{*}{*}{*} - - "Instantaneous velocity of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, accounting for stretching, at each of the NWaveKinGrid points where the incident wave kinematics will be computed (The values include both the velocity of incident waves and the velocity of current.)" (m/s) diff --git a/modules/seastate/src/Waves_Types.f90 b/modules/seastate/src/Waves_Types.f90 index f52ce2c47..3de955195 100644 --- a/modules/seastate/src/Waves_Types.f90 +++ b/modules/seastate/src/Waves_Types.f90 @@ -90,7 +90,6 @@ MODULE Waves_Types REAL(SiKi) :: WaveDirMax = 0.0_R4Ki !< Maximum wave direction. [(degrees)] INTEGER(IntKi) :: WaveNDir = 0_IntKi !< Number of wave directions [only used if WaveDirMod = 1] [Must be an odd number -- will be adjusted within the waves module] [(-)] REAL(SiKi) :: WaveDOmega = 0.0_R4Ki !< Frequency step for incident wave calculations [(rad/s)] - REAL(SiKi) , DIMENSION(:,:,:,:), POINTER :: WaveDynP => NULL() !< Instantaneous dynamic pressure of incident waves , accounting for stretching, at each of the NWaveKinGrid points where the incident wave kinematics will be computed [(N/m^2)] REAL(SiKi) , DIMENSION(:,:,:,:,:), POINTER :: WaveAcc => NULL() !< Instantaneous acceleration of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, accounting for stretching, at each of the NWaveKinGrid points where the incident wave kinematics will be computed [(m/s^2)] REAL(SiKi) , DIMENSION(:,:,:,:,:), POINTER :: WaveAccMCF => NULL() !< Instantaneous acceleration of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, accounting for stretching, at each of the NWaveKinGrid points where the incident wave kinematics will be computed [(m/s^2)] REAL(SiKi) , DIMENSION(:,:,:,:,:), POINTER :: WaveVel => NULL() !< Instantaneous velocity of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, accounting for stretching, at each of the NWaveKinGrid points where the incident wave kinematics will be computed (The values include both the velocity of incident waves and the velocity of current.) [(m/s)] @@ -515,7 +514,6 @@ subroutine Waves_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, DstInitOutputData%WaveDirMax = SrcInitOutputData%WaveDirMax DstInitOutputData%WaveNDir = SrcInitOutputData%WaveNDir DstInitOutputData%WaveDOmega = SrcInitOutputData%WaveDOmega - DstInitOutputData%WaveDynP => SrcInitOutputData%WaveDynP DstInitOutputData%WaveAcc => SrcInitOutputData%WaveAcc DstInitOutputData%WaveAccMCF => SrcInitOutputData%WaveAccMCF DstInitOutputData%WaveVel => SrcInitOutputData%WaveVel @@ -552,7 +550,6 @@ subroutine Waves_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) if (allocated(InitOutputData%WaveElevC)) then deallocate(InitOutputData%WaveElevC) end if - nullify(InitOutputData%WaveDynP) nullify(InitOutputData%WaveAcc) nullify(InitOutputData%WaveAccMCF) nullify(InitOutputData%WaveVel) @@ -581,14 +578,6 @@ subroutine Waves_PackInitOutput(Buf, Indata) call RegPack(Buf, InData%WaveDirMax) call RegPack(Buf, InData%WaveNDir) call RegPack(Buf, InData%WaveDOmega) - call RegPack(Buf, associated(InData%WaveDynP)) - if (associated(InData%WaveDynP)) then - call RegPackBounds(Buf, 4, lbound(InData%WaveDynP), ubound(InData%WaveDynP)) - call RegPackPointer(Buf, c_loc(InData%WaveDynP), PtrInIndex) - if (.not. PtrInIndex) then - call RegPack(Buf, InData%WaveDynP) - end if - end if call RegPack(Buf, associated(InData%WaveAcc)) if (associated(InData%WaveAcc)) then call RegPackBounds(Buf, 5, lbound(InData%WaveAcc), ubound(InData%WaveAcc)) @@ -697,30 +686,6 @@ subroutine Waves_UnPackInitOutput(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%WaveDOmega) if (RegCheckErr(Buf, RoutineName)) return - if (associated(OutData%WaveDynP)) deallocate(OutData%WaveDynP) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 4, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpackPointer(Buf, Ptr, PtrIdx) - if (RegCheckErr(Buf, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%WaveDynP, UB(1:4)-LB(1:4)) - OutData%WaveDynP(LB(1):,LB(2):,LB(3):,LB(4):) => OutData%WaveDynP - else - allocate(OutData%WaveDynP(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveDynP.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - Buf%Pointers(PtrIdx) = c_loc(OutData%WaveDynP) - call RegUnpack(Buf, OutData%WaveDynP) - if (RegCheckErr(Buf, RoutineName)) return - end if - else - OutData%WaveDynP => null() - end if if (associated(OutData%WaveAcc)) deallocate(OutData%WaveAcc) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return